From 3f00293d98f438b798248e6e3007ac72ba7a5807 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 7 Jun 2022 14:49:51 -0500 Subject: [PATCH] Update cardano-cli build and build-raw commands to allow creation of simple reference scripts --- .../src/Cardano/CLI/Shelley/Parsers.hs | 63 ++++++++++++------- .../Cardano/CLI/Shelley/Run/Transaction.hs | 31 +++++++-- cardano-cli/src/Cardano/CLI/Types.hs | 11 ++-- 3 files changed, 72 insertions(+), 33 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index 6a0a2ef6bfa..9d6df161282 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -229,6 +229,32 @@ pScriptFor name (Just deprecated) help = <> Opt.internal ) +pSimpleReferenceScriptWitnessFiles + :: Parser (ScriptWitnessFiles witctx) +pSimpleReferenceScriptWitnessFiles = + toReferenceScriptWitnessFiles + <$> ((,) <$> pReferenceTxIn + <*> pSimpleScriptLang + ) + where + toReferenceScriptWitnessFiles + :: (TxIn, AnyScriptLanguage) + -> ScriptWitnessFiles witctx + toReferenceScriptWitnessFiles (txin, sLang) = SimpleReferenceScriptWitnessFiles txin sLang + + pSimpleScriptLang :: Parser AnyScriptLanguage + pSimpleScriptLang = + Opt.flag' (AnyScriptLanguage $ SimpleScriptLanguage SimpleScriptV1) + ( Opt.long "simple-script-v1" + <> Opt.help "Specify a simple script v1 reference script. \ + \See documentation at doc/reference/simple-scripts.md" + ) <|> + Opt.flag' (AnyScriptLanguage $ SimpleScriptLanguage SimpleScriptV2) + ( Opt.long "simple-script-v2" + <> Opt.help "Specify a simple script v2 reference script. \ + \See documentation at doc/reference/simple-scripts.md" + ) + pPlutusReferenceScriptWitnessFiles :: WitCtx witctx -> BalanceTxExecUnits -- ^ Use the @execution-units@ flag. @@ -236,7 +262,7 @@ pPlutusReferenceScriptWitnessFiles pPlutusReferenceScriptWitnessFiles witctx autoBalanceExecUnits = toReferenceScriptWitnessFiles <$> ( (,,,,) <$> pReferenceTxIn - <*> pAnyScriptLang + <*> pPlutusScriptLanguage <*> pScriptDatumOrFile "reference-tx-in" witctx <*> pScriptRedeemerOrFile "reference-tx-in" <*> (case autoBalanceExecUnits of @@ -244,37 +270,27 @@ pPlutusReferenceScriptWitnessFiles witctx autoBalanceExecUnits = ManualBalance -> pExecutionUnits "reference-tx-in") ) where - pReferenceTxIn :: Parser TxIn - pReferenceTxIn = - Opt.option (readerFromParsecParser parseTxIn) - ( Opt.long "tx-in-reference" - <> Opt.metavar "TX-IN" - <> Opt.help "TxId#TxIx - Specify a reference input. The reference input may or may not have\ - \ a plutus reference script attached." - ) - pAnyScriptLang :: Parser AnyScriptLanguage - pAnyScriptLang = - Opt.flag' (AnyScriptLanguage $ SimpleScriptLanguage SimpleScriptV1) - ( Opt.long "simple-script-v1" - <> Opt.help "Specify a simple script v1 reference script. \ - \See documentation at doc/reference/simple-scripts.md" - ) <|> - Opt.flag' (AnyScriptLanguage $ SimpleScriptLanguage SimpleScriptV2) - ( Opt.long "simple-script-v2" - <> Opt.help "Specify a simple script v2 reference script. \ - \See documentation at doc/reference/simple-scripts.md" - ) <|> + pPlutusScriptLanguage :: Parser AnyScriptLanguage + pPlutusScriptLanguage = Opt.flag' (AnyScriptLanguage $ PlutusScriptLanguage PlutusScriptV2) ( Opt.long "plutus-script-v2" <> Opt.help "Specify a plutus script v2 reference script." ) - toReferenceScriptWitnessFiles :: (TxIn, AnyScriptLanguage, ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits) -> ScriptWitnessFiles witctx toReferenceScriptWitnessFiles (txin, sLang, d,r, e) = PlutusReferenceScriptWitnessFiles txin sLang d r e +pReferenceTxIn :: Parser TxIn +pReferenceTxIn = + Opt.option (readerFromParsecParser parseTxIn) + ( Opt.long "tx-in-reference" + <> Opt.metavar "TX-IN" + <> Opt.help "TxId#TxIx - Specify a reference input. The reference input may or may not have\ + \ a plutus reference script attached." + ) + pScriptWitnessFiles :: forall witctx. WitCtx witctx -> BalanceTxExecUnits -- ^ Use the @execution-units@ flag. @@ -2077,7 +2093,8 @@ pTxIn balance = pScriptWitnessFiles WitCtxTxIn balance "tx-in" (Just "txin") "the spending of the transaction input." <|> - pPlutusReferenceScriptWitnessFiles WitCtxTxIn balance + pPlutusReferenceScriptWitnessFiles WitCtxTxIn balance <|> + pSimpleReferenceScriptWitnessFiles pTxInCollateral :: Parser TxIn pTxInCollateral = diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index 88dc8bdc8b5..eb9382f4c73 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -1063,8 +1063,8 @@ createScriptWitness era (SimpleScriptWitnessFile (ScriptFile scriptFile)) = do ScriptInEra langInEra script' <- validateScriptSupportedInEra era script case script' of SimpleScript version sscript -> - return $ SimpleScriptWitness - langInEra version sscript + return . SimpleScriptWitness + langInEra version $ SScript sscript -- If the supplied cli flags were for a simple script (i.e. the user did -- not supply the datum, redeemer or ex units), but the script file turns @@ -1107,13 +1107,17 @@ createScriptWitness era (PlutusReferenceScriptWitnessFiles refTxIn Nothing -> left $ ShelleyTxCmdReferenceScriptsNotSupportedInEra $ getIsCardanoEraConstraint era (AnyCardanoEra era) Just _ -> do - datum <- readScriptDatumOrFile datumOrFile - redeemer <- readScriptRedeemerOrFile redeemerOrFile + case scriptLanguageSupportedInEra era anyScriptLanguage of Just sLangInEra -> case languageOfScriptLanguageInEra sLangInEra of - SimpleScriptLanguage _v -> panic "TODO: createScriptWitness: SimpleScriptLanguage" - PlutusScriptLanguage version -> + SimpleScriptLanguage _v -> + -- TODO: We likely need another datatype eg data ReferenceScriptWitness lang + -- in order to make this branch unrepresentable. + panic "createScriptWitness: Should not be possible to specify a simple script" + PlutusScriptLanguage version -> do + datum <- readScriptDatumOrFile datumOrFile + redeemer <- readScriptRedeemerOrFile redeemerOrFile return $ PlutusScriptWitness sLangInEra version @@ -1121,6 +1125,21 @@ createScriptWitness era (PlutusReferenceScriptWitnessFiles refTxIn datum redeemer execUnits Nothing -> left $ ShelleyTxCmdScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra era) +createScriptWitness era (SimpleReferenceScriptWitnessFiles refTxIn + anyScrLang@(AnyScriptLanguage anyScriptLanguage)) = do + case refInsScriptsAndInlineDatsSupportedInEra era of + Nothing -> left $ ShelleyTxCmdReferenceScriptsNotSupportedInEra + $ getIsCardanoEraConstraint era (AnyCardanoEra era) + Just _ -> do + case scriptLanguageSupportedInEra era anyScriptLanguage of + Just sLangInEra -> + case languageOfScriptLanguageInEra sLangInEra of + SimpleScriptLanguage v -> + return . SimpleScriptWitness sLangInEra v $ SReferenceScript refTxIn + PlutusScriptLanguage{} -> + panic "createScriptWitness: Should not be possible to specify a plutus script" + Nothing -> + left $ ShelleyTxCmdScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra era) getIsCardanoEraConstraint :: CardanoEra era -> (IsCardanoEra era => a) -> a diff --git a/cardano-cli/src/Cardano/CLI/Types.hs b/cardano-cli/src/Cardano/CLI/Types.hs index 40b163ca564..9ceef9d0cb2 100644 --- a/cardano-cli/src/Cardano/CLI/Types.hs +++ b/cardano-cli/src/Cardano/CLI/Types.hs @@ -288,21 +288,24 @@ data ScriptWitnessFiles witctx where -> ScriptWitnessFiles witctx PlutusScriptWitnessFiles :: ScriptFile - -> ScriptDatumOrFile witctx -- TODO: Babbage Modify to allow specification of inline datums + -> ScriptDatumOrFile witctx -> ScriptRedeemerOrFile -> ExecutionUnits -> ScriptWitnessFiles witctx - -- TODO: SimpleReferenceScriptWitnessFiles :: ScriptWitnessFiles witctx - PlutusReferenceScriptWitnessFiles :: TxIn -> AnyScriptLanguage - -> ScriptDatumOrFile witctx -- TODO: Babbage Modify to allow specification of inline datums + -> ScriptDatumOrFile witctx -> ScriptRedeemerOrFile -> ExecutionUnits -> ScriptWitnessFiles witctx + SimpleReferenceScriptWitnessFiles + :: TxIn + -> AnyScriptLanguage + -> ScriptWitnessFiles witctx + deriving instance Show (ScriptWitnessFiles witctx)