Skip to content

Commit f1532d5

Browse files
Jimbo4350Jimbo4350
authored
Merge pull request #4886 from input-output-hk/jordan/preserve-original-bytes
Preserve `ScriptData` bytes with `HashableScriptData`
2 parents 048e331 + 5457bd9 commit f1532d5

File tree

22 files changed

+284
-155
lines changed

22 files changed

+284
-155
lines changed

Diff for: ‎bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -79,10 +79,10 @@ instance FromJSON ProtocolParametersSource where
7979

8080
-- Orphan instance used in the tx-generator
8181
instance ToJSON ScriptData where
82-
toJSON = scriptDataToJson ScriptDataJsonNoSchema
82+
toJSON = scriptDataToJson ScriptDataJsonNoSchema . unsafeHashableScriptData
8383
instance FromJSON ScriptData where
8484
parseJSON v = case scriptDataFromJson ScriptDataJsonNoSchema v of
85-
Right r -> return r
85+
Right r -> return $ getScriptData r
8686
Left err -> fail $ show err
8787

8888
instance ToJSON Generator where

Diff for: ‎bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs

+7-7
Original file line numberDiff line numberDiff line change
@@ -425,10 +425,10 @@ makePlutusContext ScriptSpec{..} = do
425425

426426
(scriptData, scriptRedeemer, executionUnits) <- case scriptSpecBudget of
427427
StaticScriptBudget sDataFile redeemerFile units withCheck -> do
428-
sData <- liftIOSafe $ readScriptData sDataFile
429-
redeemer <-liftIOSafe $ readScriptData redeemerFile
428+
sData <- liftIOSafe (readScriptData sDataFile)
429+
redeemer <- liftIOSafe (readScriptData redeemerFile)
430430
when withCheck $ do
431-
unitsPreRun <- preExecuteScriptAction protocolParameters script sData redeemer
431+
unitsPreRun <- preExecuteScriptAction protocolParameters script (getScriptData sData) (getScriptData redeemer)
432432
unless (units == unitsPreRun) $
433433
throwE $ WalletError $ concat [
434434
" Stated execution Units do not match result of pre execution. "
@@ -451,7 +451,7 @@ makePlutusContext ScriptSpec{..} = do
451451
autoBudget = PlutusAutoBudget
452452
{ autoBudgetUnits = perTxBudget
453453
, autoBudgetDatum = ScriptDataNumber 0
454-
, autoBudgetRedeemer = scriptDataModifyNumber (const 1_000_000) redeemer
454+
, autoBudgetRedeemer = unsafeHashableScriptData $ scriptDataModifyNumber (const 1_000_000) (getScriptData redeemer)
455455
}
456456
traceDebug $ "Plutus auto mode : Available budget per Tx: " ++ show perTxBudget
457457
++ " -- split between inputs per Tx: " ++ show txInputs
@@ -461,7 +461,7 @@ makePlutusContext ScriptSpec{..} = do
461461
Right (summary, PlutusAutoBudget{..}, preRun) -> do
462462
setEnvSummary summary
463463
dumpBudgetSummaryIfExisting
464-
return (autoBudgetDatum, autoBudgetRedeemer, preRun)
464+
return (unsafeHashableScriptData autoBudgetDatum, autoBudgetRedeemer, preRun)
465465

466466
let msg = mconcat [ "Plutus Benchmark :"
467467
, " Script: ", scriptSpecFile
@@ -494,7 +494,7 @@ makePlutusContext ScriptSpec{..} = do
494494
(ScriptDatumForTxIn scriptData)
495495
scriptRedeemer
496496
executionUnits
497-
in return (ScriptWitness ScriptWitnessForSpending scriptWitness, script, scriptData, scriptFee)
497+
in return (ScriptWitness ScriptWitnessForSpending scriptWitness, script, getScriptData scriptData, scriptFee)
498498
_ ->
499499
liftTxGenError $ TxGenError "runPlutusBenchmark: only Plutus scripts supported"
500500

@@ -505,7 +505,7 @@ preExecuteScriptAction ::
505505
-> ScriptData
506506
-> ActionM ExecutionUnits
507507
preExecuteScriptAction protocolParameters script scriptData redeemer
508-
= case Plutus.preExecutePlutusScript protocolParameters script scriptData redeemer of
508+
= case Plutus.preExecutePlutusScript protocolParameters script scriptData (unsafeHashableScriptData redeemer) of
509509
Left err -> throwE $ WalletError ( "makePlutusContext preExecuteScript failed: " ++ show err )
510510
Right costs -> return costs
511511

Diff for: ‎bench/tx-generator/src/Cardano/TxGenerator/PlutusContext.hs

+7-7
Original file line numberDiff line numberDiff line change
@@ -70,13 +70,13 @@ data PlutusBudgetFittingStrategy
7070
deriving (Generic, Eq, Show, ToJSON)
7171

7272
instance ToJSON ScriptData where
73-
toJSON = scriptDataToJson ScriptDataJsonDetailedSchema
73+
toJSON = scriptDataToJson ScriptDataJsonDetailedSchema . unsafeHashableScriptData
7474

7575

7676
-- | load serialized ScriptData, filling in an empty value if no .json file is given
77-
readScriptData :: FilePath -> IO (Either TxGenError ScriptData)
77+
readScriptData :: FilePath -> IO (Either TxGenError HashableScriptData)
7878
readScriptData ""
79-
= pure $ Right $ ScriptDataNumber 0 -- TODO: make sure this is an adequate empty value
79+
= pure $ Right $ unsafeHashableScriptData $ ScriptDataNumber 0 -- TODO: make sure this is an adequate empty value
8080
readScriptData jsonFilePath
8181
= runExceptT $ do
8282
sData :: Aeson.Value <-
@@ -154,7 +154,7 @@ plutusAutoBudgetMaxOut
154154
txInputs
155155
= do
156156
(n, limitFactors) <- binarySearch isInLimits 0 searchUpperBound
157-
let pab' = pab {autoBudgetUnits = targetBudget, autoBudgetRedeemer = toLoopArgument n}
157+
let pab' = pab {autoBudgetUnits = targetBudget, autoBudgetRedeemer = unsafeHashableScriptData $ toLoopArgument n}
158158
pure (pab', fromIntegral n, limitFactors)
159159
where
160160
-- The highest loop counter that is tried - this is about 10 times the current mainnet limit.
@@ -173,12 +173,12 @@ plutusAutoBudgetMaxOut
173173
TargetBlockExpenditure (Just s) -> calc budgetPerBlock div (targetTxPerBlock s * txInputs)
174174
TargetBlockExpenditure Nothing -> error "plutusAutoBudgetMaxOut : TargetBlockExpenditure Nothing should be unreachable. This is an implementation error in tx-generator."
175175

176-
toLoopArgument n = scriptDataModifyNumber (+ n) autoBudgetRedeemer
176+
toLoopArgument n = scriptDataModifyNumber (+ n) $ getScriptData autoBudgetRedeemer
177177

178178
-- the execution is considered within limits when there's no limiting factor, i.e. the list is empty
179179
isInLimits :: Integer -> Either TxGenError [PlutusAutoLimitingFactor]
180180
isInLimits n = do
181-
used <- preExecutePlutusScript protocolParams script autoBudgetDatum (toLoopArgument n)
181+
used <- preExecutePlutusScript protocolParams script autoBudgetDatum (unsafeHashableScriptData $ toLoopArgument n)
182182
pure $ [ExceededStepLimit | executionSteps used > executionSteps targetBudget]
183183
++ [ExceededMemoryLimit | executionMemory used > executionMemory targetBudget]
184184

@@ -208,7 +208,7 @@ plutusBudgetSummary
208208
projectedTxSize = Nothing -- we defer this value until after splitting phase
209209
strategyMessage = Nothing
210210
scriptArgDatum = autoBudgetDatum
211-
scriptArgRedeemer = autoBudgetRedeemer
211+
scriptArgRedeemer = getScriptData autoBudgetRedeemer
212212
budgetPerTxInput = calc budgetPerTx div txInputs
213213
budgetTarget = autoBudgetUnits
214214
projectedTxPerBlock = fromIntegral $ min

Diff for: ‎bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -92,7 +92,7 @@ preExecutePlutusV1 protocolVersion_ (PlutusScript _ (PlutusScriptSerialised scri
9292
hoistEither $
9393
snd $ PlutusV1.evaluateScriptCounting protocolVersion PlutusV1.Verbose evaluationContext script
9494
[ toPlutusData datum
95-
, toPlutusData redeemer
95+
, toPlutusData (getScriptData redeemer)
9696
, PlutusV1.toData dummyContext
9797
]
9898

@@ -140,7 +140,7 @@ preExecutePlutusV2 protocolVersion_ (PlutusScript _ (PlutusScriptSerialised scri
140140
hoistEither $
141141
snd $ PlutusV2.evaluateScriptCounting protocolVersion PlutusV2.Verbose evaluationContext script
142142
[ toPlutusData datum
143-
, toPlutusData redeemer
143+
, toPlutusData (getScriptData redeemer)
144144
, PlutusV2.toData dummyContext
145145
]
146146

Diff for: ‎bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,7 @@ mkUTxOScript networkId (script, txOutDatum) witness value
7070
Just tag -> TxOut
7171
plutusScriptAddr
7272
(lovelaceToTxOutValue v)
73-
(TxOutDatumHash tag $ hashScriptData txOutDatum)
73+
(TxOutDatumHash tag $ hashScriptDataBytes $ unsafeHashableScriptData txOutDatum)
7474
ReferenceScriptNone
7575

7676
mkNewFund :: Lovelace -> TxIx -> TxId -> Fund

Diff for: ‎bench/tx-generator/test/ApiTest.hs

+5-5
Original file line numberDiff line numberDiff line change
@@ -131,11 +131,11 @@ checkPlutusBuiltin
131131

132132
protocolParameters <- readProtocolParametersOrDie
133133
forM_ bArgs $ \bArg -> do
134-
let apiData = toApiData bArg
134+
let apiData = unsafeHashableScriptData $ toApiData bArg
135135
putStrLn $ "* executing with mode: " ++ show (fst bArg)
136136
putStrLn "* custom script data in Cardano API format:"
137137
BSL.putStrLn $ encode $ scriptDataToJson ScriptDataJsonDetailedSchema apiData
138-
case preExecutePlutusScript protocolParameters script apiData apiData of
138+
case preExecutePlutusScript protocolParameters script (getScriptData apiData) apiData of
139139
Left err -> putStrLn $ "--> execution failed: " ++ show err
140140
Right units -> putStrLn $ "--> execution successful; got budget: " ++ show units
141141
where
@@ -165,9 +165,9 @@ checkPlutusLoop (Just PlutusOn{..})
165165
Left err -> die (show err)
166166
Right redeemer -> do
167167
putStrLn $ "--> read redeemer: " ++ redeemerFile
168-
return $ scriptDataModifyNumber (+ count) redeemer
168+
return $ scriptDataModifyNumber (+ count) $ getScriptData redeemer
169169

170-
case preExecutePlutusScript protocolParameters script (ScriptDataNumber 0) redeemer of
170+
case preExecutePlutusScript protocolParameters script (ScriptDataNumber 0) (unsafeHashableScriptData redeemer) of
171171
Left err -> putStrLn $ "--> execution failed: " ++ show err
172172
Right units -> putStrLn $ "--> execution successful; got budget: " ++ show units
173173

@@ -178,7 +178,7 @@ checkPlutusLoop (Just PlutusOn{..})
178178
autoBudget = PlutusAutoBudget
179179
{ autoBudgetUnits = budget
180180
, autoBudgetDatum = ScriptDataNumber 0
181-
, autoBudgetRedeemer = scriptDataModifyNumber (const 1_000_000) redeemer
181+
, autoBudgetRedeemer = unsafeHashableScriptData $ scriptDataModifyNumber (const 1_000_000) redeemer
182182
}
183183

184184
pparamsStepFraction d = case protocolParamMaxBlockExUnits protocolParameters of

Diff for: ‎cardano-api/ChangeLog.md

+4-1
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,10 @@
1616

1717
- **Breaking change** - `deserialiseFromRawBytes` method of the `SerialiseAsRawBytes` type class to return `Either` instead of `Maybe`. Deprecate `eitherDeserialiseFromRawBytes`. Use `deserialiseFromRawBytes` instead.
1818

19-
- The `cardano-cli governance create-update-proposal` command to reject empty cost model.
19+
- The `cardano-cli governance create-update-proposal` command to reject empty cost model ([PR4885](https://github.com/input-output-hk/cardano-node/pull/4885))
20+
21+
- **Breaking change** - Preserve ScriptData bytes with HashableScriptData ([PR4886](https://github.com/input-output-hk/cardano-node/pull/4886))
22+
2023

2124
- **Breaking change** - `determineEraExpr` to return `IO (Either UnsupportedNtcVersionError AnyCardanoEra)` instead of `IO AnyCardanoEra`.
2225
([PR4788](https://github.com/input-output-hk/cardano-node/pull/4788))

Diff for: ‎cardano-api/cardano-api.cabal

+3-1
Original file line numberDiff line numberDiff line change
@@ -196,9 +196,9 @@ library gen
196196
, cardano-ledger-alonzo-test
197197
, cardano-ledger-byron-test ^>= 1.4
198198
, cardano-ledger-core ^>= 0.1
199+
, cardano-ledger-shelley ^>= 0.1
199200
, containers
200201
, hedgehog
201-
, cardano-ledger-shelley ^>= 0.1
202202
, text
203203

204204
test-suite cardano-api-test
@@ -216,11 +216,13 @@ test-suite cardano-api-test
216216
, cardano-crypto-class ^>= 2.0
217217
, cardano-crypto-test ^>= 1.4
218218
, cardano-crypto-tests ^>= 2.0
219+
, cardano-ledger-alonzo ^>= 0.1
219220
, cardano-ledger-core ^>= 0.1
220221
, cardano-slotting ^>= 0.1
221222
, containers
222223
, hedgehog
223224
, hedgehog-extras
225+
, mtl
224226
, ouroboros-consensus
225227
, ouroboros-consensus-shelley
226228
, QuickCheck

Diff for: ‎cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

+20-5
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ module Test.Gen.Cardano.Api.Typed
2727
, genUTxO
2828

2929
-- * Scripts
30+
, genHashableScriptData
3031
, genReferenceScript
3132
, genScript
3233
, genSimpleScript
@@ -35,6 +36,7 @@ module Test.Gen.Cardano.Api.Typed
3536
, genScriptInEra
3637
, genScriptHash
3738
, genScriptData
39+
, genScriptDataSchema
3840
, genScriptValidity
3941

4042
, genAssetName
@@ -109,13 +111,14 @@ import Cardano.Api hiding (txIns)
109111
import qualified Cardano.Api as Api
110112
import Cardano.Api.Byron (KeyWitness (ByronKeyWitness),
111113
WitnessNetworkIdOrByronAddress (..))
112-
import Cardano.Api.Shelley (Hash (ScriptDataHash), KESPeriod (KESPeriod),
114+
import Cardano.Api.Shelley (Hash (..), KESPeriod (KESPeriod),
113115
OperationalCertificateIssueCounter (OperationalCertificateIssueCounter),
114116
PlutusScript (PlutusScriptSerialised), ProtocolParameters (ProtocolParameters),
115117
ReferenceScript (..), ReferenceTxInsScriptsInlineDatumsSupportedInEra (..),
116118
StakeCredential (StakeCredentialByKey), StakePoolKey,
117119
refInsScriptsAndInlineDatsSupportedInEra)
118120

121+
119122
import Data.ByteString (ByteString)
120123
import qualified Data.ByteString as BS
121124
import qualified Data.ByteString.Short as SBS
@@ -220,6 +223,18 @@ genPlutusScript _ =
220223
-- We make no attempt to create a valid script
221224
PlutusScriptSerialised . SBS.toShort <$> Gen.bytes (Range.linear 0 32)
222225

226+
genScriptDataSchema :: Gen ScriptDataJsonSchema
227+
genScriptDataSchema = Gen.element [ScriptDataJsonNoSchema, ScriptDataJsonDetailedSchema]
228+
229+
genHashableScriptData :: Gen HashableScriptData
230+
genHashableScriptData = do
231+
sd <- genScriptData
232+
case deserialiseFromCBOR AsHashableScriptData $ serialiseToCBOR sd of
233+
Left e -> error $ "genHashableScriptData: " <> show e
234+
Right r -> return r
235+
236+
237+
{-# DEPRECATED genScriptData "Use genHashableScriptData" #-}
223238
genScriptData :: Gen ScriptData
224239
genScriptData =
225240
Gen.recursive
@@ -891,13 +906,13 @@ genTxOutDatumHashTxContext era = case era of
891906
AlonzoEra -> Gen.choice
892907
[ pure TxOutDatumNone
893908
, TxOutDatumHash ScriptDataInAlonzoEra <$> genHashScriptData
894-
, TxOutDatumInTx ScriptDataInAlonzoEra <$> genScriptData
909+
, TxOutDatumInTx ScriptDataInAlonzoEra <$> genHashableScriptData
895910
]
896911
BabbageEra -> Gen.choice
897912
[ pure TxOutDatumNone
898913
, TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData
899-
, TxOutDatumInTx ScriptDataInBabbageEra <$> genScriptData
900-
, TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genScriptData
914+
, TxOutDatumInTx ScriptDataInBabbageEra <$> genHashableScriptData
915+
, TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genHashableScriptData
901916
]
902917

903918
genTxOutDatumHashUTxOContext :: CardanoEra era -> Gen (TxOutDatum CtxUTxO era)
@@ -913,7 +928,7 @@ genTxOutDatumHashUTxOContext era = case era of
913928
BabbageEra -> Gen.choice
914929
[ pure TxOutDatumNone
915930
, TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData
916-
, TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genScriptData
931+
, TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genHashableScriptData
917932
]
918933

919934
mkDummyHash :: forall h a. CRYPTO.HashAlgorithm h => Int -> CRYPTO.Hash h a

Diff for: ‎cardano-api/src/Cardano/Api.hs

+7
Original file line numberDiff line numberDiff line change
@@ -399,6 +399,11 @@ module Cardano.Api (
399399
examplePlutusScriptAlwaysFails,
400400

401401
-- ** Script data
402+
HashableScriptData,
403+
hashScriptDataBytes,
404+
getOriginalScriptDataBytes,
405+
getScriptData,
406+
unsafeHashableScriptData,
402407
ScriptData(..),
403408
hashScriptData,
404409

@@ -412,6 +417,8 @@ module Cardano.Api (
412417
scriptDataToJson,
413418
ScriptDataJsonError (..),
414419
ScriptDataJsonSchemaError (..),
420+
ScriptDataJsonBytesError,
421+
scriptDataJsonToHashable,
415422

416423
-- ** Script execution units
417424
ExecutionUnits(..),

Diff for: ‎cardano-api/src/Cardano/Api/Script.hs

+5-5
Original file line numberDiff line numberDiff line change
@@ -792,13 +792,13 @@ instance Eq (ScriptWitness witctx era) where
792792

793793
(==) _ _ = False
794794

795-
type ScriptRedeemer = ScriptData
795+
type ScriptRedeemer = HashableScriptData
796796

797797
data ScriptDatum witctx where
798-
ScriptDatumForTxIn :: ScriptData -> ScriptDatum WitCtxTxIn
799-
InlineScriptDatum :: ScriptDatum WitCtxTxIn
800-
NoScriptDatumForMint :: ScriptDatum WitCtxMint
801-
NoScriptDatumForStake :: ScriptDatum WitCtxStake
798+
ScriptDatumForTxIn :: HashableScriptData -> ScriptDatum WitCtxTxIn
799+
InlineScriptDatum :: ScriptDatum WitCtxTxIn
800+
NoScriptDatumForMint :: ScriptDatum WitCtxMint
801+
NoScriptDatumForStake :: ScriptDatum WitCtxStake
802802

803803
deriving instance Eq (ScriptDatum witctx)
804804
deriving instance Show (ScriptDatum witctx)

0 commit comments

Comments
 (0)