Add HashableScriptData

The `ScriptData` type can be used to build Plutus scripts, but if we store user supplied script data in it directly we will lose their original encoding of the data. `HashableScriptData` attempts to fix this issue by pairing `ScriptData` with the bytes used to represent it. In an attempt to minimise the breakage to code which depends on the API, functions which depended on the value of `ScriptData`, but doesn't need the original bytes now accept both `ScriptData` and `HashableScriptData` via the new `IsScriptData` class.
IntersectMBO · Oct 31, 2022 · b2ca75d · b2ca75d
1 parent d3869a1
commit b2ca75d
Show file tree

Hide file tree

Showing 8 changed files with 129 additions and 70 deletions.
diff --git a/cardano-api/gen/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Gen/Cardano/Api/Typed.hs
@@ -217,20 +217,22 @@ genPlutusScript _ =
     -- We make no attempt to create a valid script
     PlutusScriptSerialised . SBS.toShort <$> Gen.bytes (Range.linear 0 32)
 
-genScriptData :: Gen ScriptData
-genScriptData =
-    Gen.recursive
-      Gen.choice
-        [ ScriptDataNumber <$> genInteger
-        , ScriptDataBytes  <$> genByteString
-        ]
-        -- The Gen.recursive combinator calls these with the size halved
-        [ ScriptDataConstructor <$> genInteger
-                                <*> genScriptDataList
-        , ScriptDataList <$> genScriptDataList
-        , ScriptDataMap  <$> genScriptDataMap
-        ]
+genScriptData :: Gen HashableScriptData
+genScriptData = unsafeScriptDataToHashable <$> genScriptData'
   where
+    genScriptData' :: Gen ScriptData
+    genScriptData' =
+      Gen.recursive
+        Gen.choice
+          [ ScriptDataNumber <$> genInteger
+          , ScriptDataBytes  <$> genByteString
+          ]
+          -- The Gen.recursive combinator calls these with the size halved
+          [ ScriptDataConstructor <$> genInteger
+                                  <*> genScriptDataList
+          , ScriptDataList <$> genScriptDataList
+          , ScriptDataMap  <$> genScriptDataMap
+          ]
     genInteger :: Gen Integer
     genInteger = Gen.integral
                   (Range.linear
@@ -245,13 +247,13 @@ genScriptData =
     genScriptDataList :: Gen [ScriptData]
     genScriptDataList =
       Gen.sized $ \sz ->
-        Gen.list (Range.linear 0 (fromIntegral sz)) genScriptData
+        Gen.list (Range.linear 0 (fromIntegral sz)) genScriptData'
 
     genScriptDataMap  :: Gen [(ScriptData, ScriptData)]
     genScriptDataMap =
       Gen.sized $ \sz ->
         Gen.list (Range.linear 0 (fromIntegral sz)) $
-          (,) <$> genScriptData <*> genScriptData
+          (,) <$> genScriptData' <*> genScriptData'
 
 
 -- ----------------------------------------------------------------------------

diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
@@ -397,6 +397,11 @@ module Cardano.Api (
 
     -- ** Script data
     ScriptData(..),
+    IsScriptData,
+    toScriptData,
+    HashableScriptData,
+    asHashableScriptData,
+    unsafeScriptDataToHashable,
     hashScriptData,
 
     -- ** Validation
@@ -430,6 +435,11 @@ module Cardano.Api (
     FromCBOR,
     serialiseToCBOR,
     deserialiseFromCBOR,
+    WithCBOR,
+    getCBOR,
+    getCBORShort,
+    withoutCBOR,
+    withCBORViaRoundtrip,
 
     -- ** JSON
     ToJSON,
@@ -710,6 +720,7 @@ module Cardano.Api (
 
 import           Cardano.Api.Address
 import           Cardano.Api.Block
+import           Cardano.Api.CBOR
 import           Cardano.Api.Certificate
 import           Cardano.Api.Convenience.Constraints
 import           Cardano.Api.Convenience.Construction

diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs
@@ -155,6 +155,7 @@ import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
 
 import qualified Plutus.V1.Ledger.Examples as Plutus
 
+import           Cardano.Api.CBOR
 import           Cardano.Api.EraCast
 import           Cardano.Api.Eras
 import           Cardano.Api.Error
@@ -794,13 +795,13 @@ instance Eq (ScriptWitness witctx era) where
 
     (==)  _ _ = False
 
-type ScriptRedeemer = ScriptData
+type ScriptRedeemer = HashableScriptData
 
 data ScriptDatum witctx where
-     ScriptDatumForTxIn    :: ScriptData -> ScriptDatum WitCtxTxIn
-     InlineScriptDatum     ::               ScriptDatum WitCtxTxIn
-     NoScriptDatumForMint  ::               ScriptDatum WitCtxMint
-     NoScriptDatumForStake ::               ScriptDatum WitCtxStake
+     ScriptDatumForTxIn    :: HashableScriptData -> ScriptDatum WitCtxTxIn
+     InlineScriptDatum     :: ScriptDatum WitCtxTxIn
+     NoScriptDatumForMint  :: ScriptDatum WitCtxMint
+     NoScriptDatumForStake :: ScriptDatum WitCtxStake
 
 deriving instance Eq   (ScriptDatum witctx)
 deriving instance Show (ScriptDatum witctx)

diff --git a/cardano-api/src/Cardano/Api/ScriptData.hs b/cardano-api/src/Cardano/Api/ScriptData.hs
@@ -7,6 +7,12 @@
 module Cardano.Api.ScriptData (
     -- * Script data
     ScriptData(..),
+    HashableScriptData,
+    unsafeScriptDataToHashable,
+
+    -- * Class for functions that accept both ScriptData and HashableScriptData
+    IsScriptData,
+    toScriptData,
 
     -- * Script data hashes
     hashScriptData,
@@ -32,6 +38,7 @@ module Cardano.Api.ScriptData (
 
     -- * Data family instances
     AsType(..),
+    asHashableScriptData,
     Hash(..),
   ) where
 
@@ -42,6 +49,7 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base16 as Base16
 import qualified Data.ByteString.Char8 as BSC
 import qualified Data.ByteString.Lazy.Char8 as LBS
+import           Data.ByteString.Short (ShortByteString)
 import qualified Data.Char as Char
 import qualified Data.List as List
 import           Data.Maybe (fromMaybe)
@@ -65,9 +73,10 @@ import           Control.Applicative (Alternative (..))
 import qualified Cardano.Crypto.Hash.Class as Crypto
 import qualified Cardano.Ledger.Alonzo.Data as Alonzo
 import qualified Cardano.Ledger.SafeHash as Ledger
-import           Ouroboros.Consensus.Shelley.Eras (StandardAlonzo, StandardCrypto)
+import           Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
 import qualified Plutus.V1.Ledger.Api as Plutus
 
+import           Cardano.Api.CBOR (AsType(..), WithCBOR, getCBORShort, withCBORViaRoundtrip, withoutCBOR)
 import           Cardano.Api.Eras
 import           Cardano.Api.Error
 import           Cardano.Api.HasTypeProxy
@@ -131,34 +140,67 @@ instance ToCBOR ScriptData where
 instance FromCBOR ScriptData where
   fromCBOR = fromPlutusData <$> decode @Plutus.Data
 
-hashScriptData :: ScriptData -> Hash ScriptData
-hashScriptData = ScriptDataHash
-               . Alonzo.hashData
-               . (toAlonzoData :: ScriptData -> Alonzo.Data StandardAlonzo)
+-- | If we want to send 'ScriptData' to a node, we need to keep the original
+-- binary representation with it so that the hash is correct.
+type HashableScriptData = WithCBOR ScriptData
+
+-- | The 'IsScriptData' class exists to make it easier to write functions which
+-- accept both 'ScriptData' and 'HashableScriptData' so the caller isn't burdended
+-- with doing the conversion themselves.
+class IsScriptData a where
+  toScriptData :: a -> ScriptData
+
+instance IsScriptData ScriptData where
+  toScriptData = id
+
+instance IsScriptData HashableScriptData where
+  toScriptData = withoutCBOR
 
+-- | A type proxy for use with 'deserialiseFromCBOR' for 'HashableScriptData'
+asHashableScriptData :: AsType HashableScriptData
+asHashableScriptData = AsWithCBOR AsScriptData
+
+-- | Convert 'ScriptData' to 'HashableScriptData'. The unsafe in the name is
+-- to make the user think twice before using this. It's necessary if the script
+-- data hasn't been provided in CBOR form either because the user provided it in
+-- another format like JSON, or because it's been generated programatically.
+-- This serialises the provided 'ScriptData' to CBOR and treats the result of
+-- that as the original representation.
+unsafeScriptDataToHashable :: ScriptData -> HashableScriptData
+unsafeScriptDataToHashable = withCBORViaRoundtrip
+
+hashScriptData :: HashableScriptData -> Hash ScriptData
+hashScriptData = ScriptDataHash . Ledger.castSafeHash . Ledger.hashAnnotated
+
+unsafeMakeBinaryData :: ShortByteString -> Alonzo.BinaryData era
+unsafeMakeBinaryData = either (error "unsafeMakeBinaryData: invalid") id . Alonzo.makeBinaryData
 
 -- ----------------------------------------------------------------------------
 -- Conversion functions
 --
 
-toAlonzoData :: ScriptData -> Alonzo.Data ledgerera
-toAlonzoData = Alonzo.Data . toPlutusData
+toAlonzoData :: HashableScriptData -> Alonzo.Data ledgerera
+toAlonzoData = Alonzo.binaryDataToData . unsafeMakeBinaryData . getCBORShort
 
-fromAlonzoData :: Alonzo.Data ledgerera -> ScriptData
-fromAlonzoData = fromPlutusData . Alonzo.getPlutusData
+fromAlonzoData :: Alonzo.Data ledgerera -> HashableScriptData
+fromAlonzoData d = case deserialiseFromCBOR asHashableScriptData $ Ledger.originalBytes d of
+    Left err -> error $ "fromAlonzoData: " ++ show err
+    Right x -> x
 
 
-toPlutusData :: ScriptData -> Plutus.Data
-toPlutusData (ScriptDataConstructor int xs)
-                                  = Plutus.Constr int
-                                      [ toPlutusData x | x <- xs ]
-toPlutusData (ScriptDataMap  kvs) = Plutus.Map
-                                      [ (toPlutusData k, toPlutusData v)
+toPlutusData :: IsScriptData a => a -> Plutus.Data
+toPlutusData = go . toScriptData
+  where
+    go (ScriptDataConstructor int xs)
+                            = Plutus.Constr int
+                                      [ go x | x <- xs ]
+    go (ScriptDataMap  kvs) = Plutus.Map
+                                      [ (go k, go v)
                                       | (k,v) <- kvs ]
-toPlutusData (ScriptDataList  xs) = Plutus.List
-                                      [ toPlutusData x | x <- xs ]
-toPlutusData (ScriptDataNumber n) = Plutus.I n
-toPlutusData (ScriptDataBytes bs) = Plutus.B bs
+    go (ScriptDataList  xs) = Plutus.List
+                                      [ go x | x <- xs ]
+    go (ScriptDataNumber n) = Plutus.I n
+    go (ScriptDataBytes bs) = Plutus.B bs
 
 
 fromPlutusData :: Plutus.Data -> ScriptData
@@ -181,9 +223,9 @@ fromPlutusData (Plutus.B    bs) = ScriptDataBytes bs
 -- | Validate script data. This is for use with existing constructed script
 -- data values, e.g. constructed manually or decoded from CBOR directly.
 --
-validateScriptData :: ScriptData -> Either ScriptDataRangeError ()
+validateScriptData :: IsScriptData a => a -> Either ScriptDataRangeError ()
 validateScriptData d =
-    case collect d of
+    case collect (toScriptData d) of
       []    -> Right ()
       err:_ -> Left err
   where
@@ -325,11 +367,11 @@ data ScriptDataJsonSchema =
 --
 scriptDataFromJson :: ScriptDataJsonSchema
                    -> Aeson.Value
-                   -> Either ScriptDataJsonError ScriptData
+                   -> Either ScriptDataJsonError HashableScriptData
 scriptDataFromJson schema v = do
     d <- first (ScriptDataJsonSchemaError v) (scriptDataFromJson' v)
     first (ScriptDataRangeError v) (validateScriptData d)
-    return d
+    return (unsafeScriptDataToHashable d)
   where
     scriptDataFromJson' =
       case schema of
@@ -344,8 +386,9 @@ scriptDataFromJson schema v = do
 -- This conversion is total but is not necessarily invertible.
 -- See 'ScriptDataJsonSchema' for the details.
 --
-scriptDataToJson :: ScriptDataJsonSchema
-                 -> ScriptData
+scriptDataToJson :: IsScriptData a
+                 => ScriptDataJsonSchema
+                 -> a
                  -> Aeson.Value
 scriptDataToJson schema =
     case schema of
@@ -357,8 +400,8 @@ scriptDataToJson schema =
 -- JSON conversion using the the "no schema" style
 --
 
-scriptDataToJsonNoSchema :: ScriptData -> Aeson.Value
-scriptDataToJsonNoSchema = conv
+scriptDataToJsonNoSchema :: IsScriptData a => a -> Aeson.Value
+scriptDataToJsonNoSchema = conv . toScriptData
   where
     conv :: ScriptData -> Aeson.Value
     conv (ScriptDataNumber n) = Aeson.Number (fromInteger n)
@@ -449,8 +492,8 @@ bytesPrefix = "0x"
 -- JSON conversion using the "detailed schema" style
 --
 
-scriptDataToJsonDetailedSchema :: ScriptData -> Aeson.Value
-scriptDataToJsonDetailedSchema = conv
+scriptDataToJsonDetailedSchema :: IsScriptData a => a -> Aeson.Value
+scriptDataToJsonDetailedSchema = conv . toScriptData
   where
     conv :: ScriptData -> Aeson.Value
     conv (ScriptDataNumber n) = singleFieldObject "int"

diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs
@@ -245,6 +245,7 @@ import           Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardAlon
                    StandardMary, StandardShelley)
 
 import           Cardano.Api.Address
+import           Cardano.Api.CBOR
 import           Cardano.Api.Certificate
 import           Cardano.Api.Convenience.Constraints
 import           Cardano.Api.EraCast
@@ -431,7 +432,7 @@ txOutToJsonValue era (TxOut addr val dat refScript) =
        TxOutDatumInTx' _ h _ ->
          "datumhash" .= toJSON h
        TxOutDatumInline _ datum ->
-         "inlineDatumhash"  .= toJSON (hashScriptData datum)
+         "inlineDatumhash"  .= toJSON (SafeHash.extractHash $ SafeHash.hashAnnotated datum)
 
    datJsonVal :: TxOutDatum ctx era -> Aeson.Value
    datJsonVal d =
@@ -1339,15 +1340,15 @@ data TxOutDatum ctx era where
      --
      TxOutDatumInTx'  :: ScriptDataSupportedInEra era
                       -> Hash ScriptData
-                      -> ScriptData
+                      -> HashableScriptData
                       -> TxOutDatum CtxTx era
 
      -- | A transaction output that specifies the whole datum instead of the
      -- datum hash. Note that the datum map will not be updated with this datum,
      -- it only exists at the transaction output.
      --
      TxOutDatumInline :: ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-                      -> ScriptData
+                      -> HashableScriptData
                       -> TxOutDatum ctx era
 
 deriving instance Eq   (TxOutDatum ctx era)
@@ -1374,7 +1375,7 @@ instance EraCast (TxOutDatum ctx)  where
 
 pattern TxOutDatumInTx
   :: ScriptDataSupportedInEra era
-  -> ScriptData
+  -> HashableScriptData
   -> TxOutDatum CtxTx era
 pattern TxOutDatumInTx s d <- TxOutDatumInTx' s _ d
   where
@@ -3161,7 +3162,7 @@ convScriptData era txOuts scriptWitnesses =
                 , let d' = toAlonzoData d
                 ]
 
-          scriptdata :: [ScriptData]
+          scriptdata :: [HashableScriptData]
           scriptdata =
               [ d | TxOut _ _ (TxOutDatumInTx _ d) _ <- txOuts ]
            ++ [ d | (_, AnyScriptWitness
@@ -3448,7 +3449,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo
           , let d' = toAlonzoData d
           ]
 
-    scriptdata :: [ScriptData]
+    scriptdata :: [HashableScriptData]
     scriptdata =
         [ d | TxOut _ _ (TxOutDatumInTx _ d) _ <- txOuts ]
      ++ [ d | (_, AnyScriptWitness
@@ -3557,7 +3558,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraBabbage
           , let d' = toAlonzoData d
           ]
 
-    scriptdata :: [ScriptData]
+    scriptdata :: [HashableScriptData]
     scriptdata =
         [ d | TxOut _ _ (TxOutDatumInTx _ d) _ <- txOuts ]
      ++ [ d | (_, AnyScriptWitness
@@ -3887,12 +3888,13 @@ calculateExecutionUnitsLovelace euPrices eUnits =
 -- onchain within a transaction output.
 --
 
-scriptDataToInlineDatum :: ScriptData -> Babbage.Datum ledgerera
-scriptDataToInlineDatum = Babbage.Datum . Alonzo.dataToBinaryData . toAlonzoData
+scriptDataToInlineDatum :: HashableScriptData -> Babbage.Datum ledgerera
+scriptDataToInlineDatum
+    = either (error "scriptDataToInlineDatum: invalid script data") Babbage.Datum
+    . Alonzo.makeBinaryData
+    . getCBORShort
 
 binaryDataToScriptData
-  :: ReferenceTxInsScriptsInlineDatumsSupportedInEra era -> Alonzo.BinaryData ledgerera -> ScriptData
-binaryDataToScriptData ReferenceTxInsScriptsInlineDatumsInBabbageEra  d =
+  :: ReferenceTxInsScriptsInlineDatumsSupportedInEra era -> Alonzo.BinaryData ledgerera -> HashableScriptData
+binaryDataToScriptData ReferenceTxInsScriptsInlineDatumsInBabbageEra d =
   fromAlonzoData $ Alonzo.binaryDataToData d
-
-
diff --git a/cardano-api/test/Test/Cardano/Api/Json.hs b/cardano-api/test/Test/Cardano/Api/Json.hs
@@ -79,7 +79,7 @@ prop_json_roundtrip_eraInMode = H.property $ do
 
 prop_json_roundtrip_scriptdata_detailed_json :: Property
 prop_json_roundtrip_scriptdata_detailed_json = H.property $ do
-  sData <- forAll genScriptData
+  sData <- toScriptData <$> forAll genScriptData
   tripping sData scriptDataToJsonDetailedSchema scriptDataFromJsonDetailedSchema
 
 tests :: TestTree