Merge pull request #4886 from input-output-hk/jordan/preserve-origina…

…l-bytes

Preserve `ScriptData` bytes with `HashableScriptData`

bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs

@@ -79,10 +79,10 @@ instance FromJSON ProtocolParametersSource where
 
 -- Orphan instance used in the tx-generator
 instance ToJSON ScriptData where
-  toJSON = scriptDataToJson ScriptDataJsonNoSchema
+  toJSON = scriptDataToJson ScriptDataJsonNoSchema . unsafeHashableScriptData
 instance FromJSON ScriptData where
   parseJSON v = case scriptDataFromJson ScriptDataJsonNoSchema v of
-    Right r -> return r
+    Right r -> return $ getScriptData r
     Left err -> fail $ show err
 
 instance ToJSON Generator where

bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs

@@ -425,10 +425,10 @@ makePlutusContext ScriptSpec{..} = do
 
   (scriptData, scriptRedeemer, executionUnits) <- case scriptSpecBudget of
     StaticScriptBudget sDataFile redeemerFile units withCheck -> do
-      sData <- liftIOSafe $ readScriptData sDataFile
-      redeemer <-liftIOSafe $ readScriptData redeemerFile
+      sData <- liftIOSafe (readScriptData sDataFile)
+      redeemer <- liftIOSafe (readScriptData redeemerFile)
       when withCheck $ do
-        unitsPreRun <- preExecuteScriptAction protocolParameters script sData redeemer
+        unitsPreRun <- preExecuteScriptAction protocolParameters script (getScriptData sData) (getScriptData redeemer)
         unless (units == unitsPreRun) $
           throwE $ WalletError $ concat [
               " Stated execution Units do not match result of pre execution. "
@@ -451,7 +451,7 @@ makePlutusContext ScriptSpec{..} = do
         autoBudget = PlutusAutoBudget
           { autoBudgetUnits = perTxBudget
           , autoBudgetDatum = ScriptDataNumber 0
-          , autoBudgetRedeemer = scriptDataModifyNumber (const 1_000_000) redeemer
+          , autoBudgetRedeemer = unsafeHashableScriptData $ scriptDataModifyNumber (const 1_000_000) (getScriptData redeemer)
           }
       traceDebug $ "Plutus auto mode : Available budget per Tx: " ++ show perTxBudget
                    ++ " -- split between inputs per Tx: " ++ show txInputs
@@ -461,7 +461,7 @@ makePlutusContext ScriptSpec{..} = do
         Right (summary, PlutusAutoBudget{..}, preRun) -> do
           setEnvSummary summary
           dumpBudgetSummaryIfExisting
-          return (autoBudgetDatum, autoBudgetRedeemer, preRun)
+          return (unsafeHashableScriptData autoBudgetDatum, autoBudgetRedeemer, preRun)
 
   let msg = mconcat [ "Plutus Benchmark :"
                     , " Script: ", scriptSpecFile
@@ -494,7 +494,7 @@ makePlutusContext ScriptSpec{..} = do
                               (ScriptDatumForTxIn scriptData)
                               scriptRedeemer
                               executionUnits
-      in return (ScriptWitness ScriptWitnessForSpending scriptWitness, script, scriptData, scriptFee)
+      in return (ScriptWitness ScriptWitnessForSpending scriptWitness, script, getScriptData scriptData, scriptFee)
     _ ->
       liftTxGenError $ TxGenError "runPlutusBenchmark: only Plutus scripts supported"
 
@@ -505,7 +505,7 @@ preExecuteScriptAction ::
   -> ScriptData
   -> ActionM ExecutionUnits
 preExecuteScriptAction protocolParameters script scriptData redeemer
-  = case Plutus.preExecutePlutusScript protocolParameters script scriptData redeemer of
+  = case Plutus.preExecutePlutusScript protocolParameters script scriptData (unsafeHashableScriptData redeemer) of
       Left err -> throwE $ WalletError ( "makePlutusContext preExecuteScript failed: " ++ show err )
       Right costs -> return costs
 

bench/tx-generator/src/Cardano/TxGenerator/PlutusContext.hs

@@ -70,13 +70,13 @@ data PlutusBudgetFittingStrategy
   deriving (Generic, Eq, Show, ToJSON)
 
 instance ToJSON ScriptData where
-  toJSON = scriptDataToJson ScriptDataJsonDetailedSchema
+  toJSON = scriptDataToJson ScriptDataJsonDetailedSchema . unsafeHashableScriptData
 
 
 -- | load serialized ScriptData, filling in an empty value if no .json file is given
-readScriptData :: FilePath -> IO (Either TxGenError ScriptData)
+readScriptData :: FilePath -> IO (Either TxGenError HashableScriptData)
 readScriptData ""
-  = pure $ Right $ ScriptDataNumber 0             -- TODO: make sure this is an adequate empty value
+  = pure $ Right $ unsafeHashableScriptData $ ScriptDataNumber 0             -- TODO: make sure this is an adequate empty value
 readScriptData jsonFilePath
   = runExceptT $ do
     sData :: Aeson.Value <-
@@ -154,7 +154,7 @@ plutusAutoBudgetMaxOut
   txInputs
   = do
     (n, limitFactors) <- binarySearch isInLimits 0 searchUpperBound
-    let pab' = pab {autoBudgetUnits = targetBudget, autoBudgetRedeemer = toLoopArgument n}
+    let pab' = pab {autoBudgetUnits = targetBudget, autoBudgetRedeemer = unsafeHashableScriptData $ toLoopArgument n}
     pure (pab', fromIntegral n, limitFactors)
   where
     -- The highest loop counter that is tried - this is about 10 times the current mainnet limit.
@@ -173,12 +173,12 @@ plutusAutoBudgetMaxOut
       TargetBlockExpenditure (Just s) -> calc budgetPerBlock div (targetTxPerBlock s * txInputs)
       TargetBlockExpenditure Nothing  -> error "plutusAutoBudgetMaxOut : TargetBlockExpenditure Nothing should be unreachable. This is an implementation error in tx-generator."
 
-    toLoopArgument n = scriptDataModifyNumber (+ n) autoBudgetRedeemer
+    toLoopArgument n = scriptDataModifyNumber (+ n) $ getScriptData autoBudgetRedeemer
 
     -- the execution is considered within limits when there's no limiting factor, i.e. the list is empty
     isInLimits :: Integer -> Either TxGenError [PlutusAutoLimitingFactor]
     isInLimits n = do
-      used <- preExecutePlutusScript protocolParams script autoBudgetDatum (toLoopArgument n)
+      used <- preExecutePlutusScript protocolParams script autoBudgetDatum (unsafeHashableScriptData $ toLoopArgument n)
       pure $   [ExceededStepLimit   | executionSteps used > executionSteps targetBudget]
             ++ [ExceededMemoryLimit | executionMemory used > executionMemory targetBudget]
 
@@ -208,7 +208,7 @@ plutusBudgetSummary
     projectedTxSize         = Nothing           -- we defer this value until after splitting phase
     strategyMessage         = Nothing
     scriptArgDatum          = autoBudgetDatum
-    scriptArgRedeemer       = autoBudgetRedeemer
+    scriptArgRedeemer       = getScriptData autoBudgetRedeemer
     budgetPerTxInput        = calc budgetPerTx div txInputs
     budgetTarget            = autoBudgetUnits
     projectedTxPerBlock     = fromIntegral $ min

bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs

@@ -92,7 +92,7 @@ preExecutePlutusV1 protocolVersion_ (PlutusScript _ (PlutusScriptSerialised scri
         hoistEither $
           snd $ PlutusV1.evaluateScriptCounting protocolVersion PlutusV1.Verbose evaluationContext script
             [ toPlutusData datum
-            , toPlutusData redeemer
+            , toPlutusData (getScriptData redeemer)
             , PlutusV1.toData dummyContext
             ]
 
@@ -140,7 +140,7 @@ preExecutePlutusV2 protocolVersion_ (PlutusScript _ (PlutusScriptSerialised scri
         hoistEither $
           snd $ PlutusV2.evaluateScriptCounting protocolVersion PlutusV2.Verbose evaluationContext script
             [ toPlutusData datum
-            , toPlutusData redeemer
+            , toPlutusData (getScriptData redeemer)
             , PlutusV2.toData dummyContext
             ]
 

bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs

@@ -70,7 +70,7 @@ mkUTxOScript networkId (script, txOutDatum) witness value
     Just tag -> TxOut
                   plutusScriptAddr
                   (lovelaceToTxOutValue v)
-                  (TxOutDatumHash tag $ hashScriptData txOutDatum)
+                  (TxOutDatumHash tag $ hashScriptDataBytes $ unsafeHashableScriptData txOutDatum)
                   ReferenceScriptNone
 
   mkNewFund :: Lovelace -> TxIx -> TxId -> Fund

bench/tx-generator/test/ApiTest.hs

@@ -131,11 +131,11 @@ checkPlutusBuiltin
 
     protocolParameters <- readProtocolParametersOrDie
     forM_ bArgs $ \bArg -> do
-      let apiData = toApiData bArg
+      let apiData = unsafeHashableScriptData $ toApiData bArg
       putStrLn $ "* executing with mode: " ++ show (fst bArg)
       putStrLn "* custom script data in Cardano API format:"
       BSL.putStrLn $ encode $ scriptDataToJson ScriptDataJsonDetailedSchema apiData
-      case preExecutePlutusScript protocolParameters script apiData apiData of
+      case preExecutePlutusScript protocolParameters script (getScriptData apiData) apiData of
         Left err -> putStrLn $ "--> execution failed: " ++ show err
         Right units -> putStrLn $ "--> execution successful; got budget: " ++ show units
   where
@@ -165,9 +165,9 @@ checkPlutusLoop (Just PlutusOn{..})
       Left err -> die (show err)
       Right redeemer -> do
         putStrLn $ "--> read redeemer: " ++ redeemerFile
-        return $ scriptDataModifyNumber (+ count) redeemer
+        return $ scriptDataModifyNumber (+ count) $ getScriptData redeemer
 
-    case preExecutePlutusScript protocolParameters script (ScriptDataNumber 0) redeemer of
+    case preExecutePlutusScript protocolParameters script (ScriptDataNumber 0) (unsafeHashableScriptData redeemer) of
       Left err -> putStrLn $ "--> execution failed: " ++ show err
       Right units -> putStrLn $ "--> execution successful; got budget: " ++ show units
 
@@ -178,7 +178,7 @@ checkPlutusLoop (Just PlutusOn{..})
         autoBudget = PlutusAutoBudget
           { autoBudgetUnits = budget
           , autoBudgetDatum = ScriptDataNumber 0
-          , autoBudgetRedeemer = scriptDataModifyNumber (const 1_000_000) redeemer
+          , autoBudgetRedeemer = unsafeHashableScriptData $ scriptDataModifyNumber (const 1_000_000) redeemer
           }
 
         pparamsStepFraction d = case protocolParamMaxBlockExUnits protocolParameters of

cardano-api/ChangeLog.md

@@ -16,7 +16,10 @@
 
 - **Breaking change** - `deserialiseFromRawBytes` method of the `SerialiseAsRawBytes` type class to return `Either` instead of `Maybe`.  Deprecate `eitherDeserialiseFromRawBytes`.  Use `deserialiseFromRawBytes` instead.
 
-- The `cardano-cli governance create-update-proposal` command to reject empty cost model.
+- The `cardano-cli governance create-update-proposal` command to reject empty cost model ([PR4885](https://github.com/input-output-hk/cardano-node/pull/4885))
+
+- **Breaking change** - Preserve ScriptData bytes with HashableScriptData ([PR4886](https://github.com/input-output-hk/cardano-node/pull/4886))
+
 
 - **Breaking change** - `determineEraExpr` to return `IO (Either UnsupportedNtcVersionError AnyCardanoEra)` instead of `IO AnyCardanoEra`.
   ([PR4788](https://github.com/input-output-hk/cardano-node/pull/4788))

cardano-api/cardano-api.cabal

@@ -196,9 +196,9 @@ library gen
                       , cardano-ledger-alonzo-test
                       , cardano-ledger-byron-test ^>= 1.4
                       , cardano-ledger-core ^>= 0.1
+                      , cardano-ledger-shelley ^>= 0.1
                       , containers
                       , hedgehog
-                      , cardano-ledger-shelley ^>= 0.1
                       , text
 
 test-suite cardano-api-test
@@ -216,11 +216,13 @@ test-suite cardano-api-test
                       , cardano-crypto-class ^>= 2.0
                       , cardano-crypto-test ^>= 1.4
                       , cardano-crypto-tests ^>= 2.0
+                      , cardano-ledger-alonzo ^>= 0.1
                       , cardano-ledger-core ^>= 0.1
                       , cardano-slotting ^>= 0.1
                       , containers
                       , hedgehog
                       , hedgehog-extras
+                      , mtl
                       , ouroboros-consensus
                       , ouroboros-consensus-shelley
                       , QuickCheck

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -27,6 +27,7 @@ module Test.Gen.Cardano.Api.Typed
   , genUTxO
 
     -- * Scripts
+  , genHashableScriptData
   , genReferenceScript
   , genScript
   , genSimpleScript
@@ -35,6 +36,7 @@ module Test.Gen.Cardano.Api.Typed
   , genScriptInEra
   , genScriptHash
   , genScriptData
+  , genScriptDataSchema
   , genScriptValidity
 
   , genAssetName
@@ -109,13 +111,14 @@ import           Cardano.Api hiding (txIns)
 import qualified Cardano.Api as Api
 import           Cardano.Api.Byron (KeyWitness (ByronKeyWitness),
                    WitnessNetworkIdOrByronAddress (..))
-import           Cardano.Api.Shelley (Hash (ScriptDataHash), KESPeriod (KESPeriod),
+import           Cardano.Api.Shelley (Hash (..), KESPeriod (KESPeriod),
                    OperationalCertificateIssueCounter (OperationalCertificateIssueCounter),
                    PlutusScript (PlutusScriptSerialised), ProtocolParameters (ProtocolParameters),
                    ReferenceScript (..), ReferenceTxInsScriptsInlineDatumsSupportedInEra (..),
                    StakeCredential (StakeCredentialByKey), StakePoolKey,
                    refInsScriptsAndInlineDatsSupportedInEra)
 
+
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Short as SBS
@@ -220,6 +223,18 @@ genPlutusScript _ =
     -- We make no attempt to create a valid script
     PlutusScriptSerialised . SBS.toShort <$> Gen.bytes (Range.linear 0 32)
 
+genScriptDataSchema :: Gen ScriptDataJsonSchema
+genScriptDataSchema = Gen.element [ScriptDataJsonNoSchema, ScriptDataJsonDetailedSchema]
+
+genHashableScriptData :: Gen HashableScriptData
+genHashableScriptData = do
+  sd <- genScriptData
+  case deserialiseFromCBOR AsHashableScriptData $ serialiseToCBOR sd of
+    Left e -> error $ "genHashableScriptData: " <> show e
+    Right r -> return r
+
+
+{-# DEPRECATED genScriptData "Use genHashableScriptData" #-}
 genScriptData :: Gen ScriptData
 genScriptData =
     Gen.recursive
@@ -891,13 +906,13 @@ genTxOutDatumHashTxContext era = case era of
     AlonzoEra  -> Gen.choice
                     [ pure TxOutDatumNone
                     , TxOutDatumHash ScriptDataInAlonzoEra <$> genHashScriptData
-                    , TxOutDatumInTx ScriptDataInAlonzoEra <$> genScriptData
+                    , TxOutDatumInTx ScriptDataInAlonzoEra <$> genHashableScriptData
                     ]
     BabbageEra -> Gen.choice
                     [ pure TxOutDatumNone
                     , TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData
-                    , TxOutDatumInTx ScriptDataInBabbageEra <$> genScriptData
-                    , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genScriptData
+                    , TxOutDatumInTx ScriptDataInBabbageEra <$> genHashableScriptData
+                    , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genHashableScriptData
                     ]
 
 genTxOutDatumHashUTxOContext :: CardanoEra era -> Gen (TxOutDatum CtxUTxO era)
@@ -913,7 +928,7 @@ genTxOutDatumHashUTxOContext era = case era of
     BabbageEra -> Gen.choice
                     [ pure TxOutDatumNone
                     , TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData
-                    , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genScriptData
+                    , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genHashableScriptData
                     ]
 
 mkDummyHash :: forall h a. CRYPTO.HashAlgorithm h => Int -> CRYPTO.Hash h a

cardano-api/src/Cardano/Api.hs

@@ -399,6 +399,11 @@ module Cardano.Api (
     examplePlutusScriptAlwaysFails,
 
     -- ** Script data
+    HashableScriptData,
+    hashScriptDataBytes,
+    getOriginalScriptDataBytes,
+    getScriptData,
+    unsafeHashableScriptData,
     ScriptData(..),
     hashScriptData,
 
@@ -412,6 +417,8 @@ module Cardano.Api (
     scriptDataToJson,
     ScriptDataJsonError (..),
     ScriptDataJsonSchemaError (..),
+    ScriptDataJsonBytesError,
+    scriptDataJsonToHashable,
 
     -- ** Script execution units
     ExecutionUnits(..),

cardano-api/src/Cardano/Api/Script.hs

@@ -792,13 +792,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)