Skip to content

Commit

Permalink
Propagate HashableScriptData in bench folder
Browse files Browse the repository at this point in the history
  • Loading branch information
Jimbo4350 committed Feb 27, 2023
1 parent dfa1ec8 commit 5457bd9
Show file tree
Hide file tree
Showing 6 changed files with 24 additions and 24 deletions.
4 changes: 2 additions & 2 deletions bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
14 changes: 7 additions & 7 deletions bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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. "
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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"

Expand All @@ -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

Expand Down
14 changes: 7 additions & 7 deletions bench/tx-generator/src/Cardano/TxGenerator/PlutusContext.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 <-
Expand Down Expand Up @@ -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.
Expand All @@ -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]

Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
]

Expand Down Expand Up @@ -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
]

Expand Down
2 changes: 1 addition & 1 deletion bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 5 additions & 5 deletions bench/tx-generator/test/ApiTest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand All @@ -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
Expand Down

0 comments on commit 5457bd9

Please sign in to comment.