diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 3b2060459c..4309cca425 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -119,6 +119,8 @@ library Cardano.CLI.EraBased.Run.Transaction Cardano.CLI.EraBased.Script.Mint.Read Cardano.CLI.EraBased.Script.Mint.Types + Cardano.CLI.EraBased.Script.Spend.Read + Cardano.CLI.EraBased.Script.Spend.Types Cardano.CLI.EraBased.Transaction.HashCheck Cardano.CLI.Helpers Cardano.CLI.IO.Lazy diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs index 52d169d10a..1406c0bee8 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs @@ -59,7 +59,7 @@ pCompatibleSignedTransaction env sbe = <$> many pTxInOnly <*> many (pTxOutEraAware sbe) <*> pFeatured (toCardanoEra sbe) (optional pUpdateProposalFile) - <*> pFeatured (toCardanoEra sbe) (many (pProposalFile sbe ManualBalance)) + <*> pFeatured (toCardanoEra sbe) (many (pProposalFile ManualBalance)) <*> pVoteFiles sbe ManualBalance <*> many pWitnessSigningData <*> optional (pNetworkId env) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index f6898c8c30..457a4a1e58 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs @@ -26,6 +26,7 @@ import Cardano.Api.Ledger (Coin) import Cardano.Api.Shelley import Cardano.CLI.EraBased.Script.Mint.Types +import Cardano.CLI.EraBased.Script.Spend.Types (CliSpendScriptRequirements) import Cardano.CLI.Types.Common import Cardano.CLI.Types.Governance @@ -49,7 +50,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs { eon :: !(ShelleyBasedEra era) , mScriptValidity :: !(Maybe ScriptValidity) -- ^ Mark script as expected to pass or fail validation - , txIns :: ![(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))] + , txIns :: ![(TxIn, Maybe CliSpendScriptRequirements)] -- ^ Transaction inputs with optional spending scripts , readOnlyRefIns :: ![TxIn] -- ^ Read only reference inputs @@ -96,7 +97,7 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs -- ^ Mark script as expected to pass or fail validation , mOverrideWitnesses :: !(Maybe Word) -- ^ Override the required number of tx witnesses - , txins :: ![(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))] + , txins :: ![(TxIn, Maybe CliSpendScriptRequirements)] -- ^ Transaction inputs with optional spending scripts , readOnlyReferenceInputs :: ![TxIn] -- ^ Read only reference inputs @@ -144,7 +145,7 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs , mByronWitnesses :: !(Maybe Int) , protocolParamsFile :: !ProtocolParamsFile , totalUTxOValue :: !Value - , txins :: ![(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))] + , txins :: ![(TxIn, Maybe CliSpendScriptRequirements)] -- ^ Transaction inputs with optional spending scripts , readOnlyReferenceInputs :: ![TxIn] -- ^ Read only reference inputs diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index 4d113ffa75..544addd1c0 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -19,6 +19,8 @@ import Cardano.Api.Shelley import Cardano.CLI.Environment (EnvCli (..), envCliAnyEon) import Cardano.CLI.EraBased.Script.Mint.Types +import Cardano.CLI.EraBased.Script.Spend.Types (CliSpendScriptRequirements) +import qualified Cardano.CLI.EraBased.Script.Spend.Types as PlutusSpend import Cardano.CLI.Parser import Cardano.CLI.Read import Cardano.CLI.Types.Common @@ -1029,10 +1031,34 @@ pPlutusMintScriptWitnessData _sbe _witctx autoBalanceExecUnits = ) ) +pSimpleScriptOrPlutusSpendingScriptWitness + :: ShelleyBasedEra era + -> BalanceTxExecUnits + -- ^ Use the @execution-units@ flag. + -> String + -- ^ Script flag prefix + -> Maybe String + -> String + -> Parser CliSpendScriptRequirements +pSimpleScriptOrPlutusSpendingScriptWitness sbe autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help = + PlutusSpend.createSimpleOrPlutusScriptFromCliArgs + <$> pScriptFor + (scriptFlagPrefix ++ "-script-file") + ((++ "-script-file") <$> scriptFlagPrefixDeprecated) + ("The file containing the script to witness " ++ help) + <*> optional + ( (,,) + <$> pScriptDatumOrFileSpendingCip69 sbe scriptFlagPrefix + <*> pScriptRedeemerOrFile scriptFlagPrefix + <*> ( case autoBalanceExecUnits of + AutoBalance -> pure (ExecutionUnits 0 0) + ManualBalance -> pExecutionUnits scriptFlagPrefix + ) + ) + pScriptWitnessFiles - :: forall witctx era - . ShelleyBasedEra era - -> WitCtx witctx + :: forall witctx + . WitCtx witctx -> BalanceTxExecUnits -- ^ Use the @execution-units@ flag. -> String @@ -1040,7 +1066,7 @@ pScriptWitnessFiles -> Maybe String -> String -> Parser (ScriptWitnessFiles witctx) -pScriptWitnessFiles sbe witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help = +pScriptWitnessFiles witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help = toScriptWitnessFiles <$> pScriptFor (scriptFlagPrefix ++ "-script-file") @@ -1048,7 +1074,7 @@ pScriptWitnessFiles sbe witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagP ("The file containing the script to witness " ++ help) <*> optional ( (,,) - <$> cip69Modification sbe + <$> pure (excludeTxInScriptWitnesses witctx) <*> pScriptRedeemerOrFile scriptFlagPrefix <*> ( case autoBalanceExecUnits of AutoBalance -> pure (ExecutionUnits 0 0) @@ -1056,11 +1082,15 @@ pScriptWitnessFiles sbe witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagP ) ) where - cip69Modification :: ShelleyBasedEra era -> Parser (ScriptDatumOrFile witctx) - cip69Modification = - caseShelleyToBabbageOrConwayEraOnwards - (const $ pScriptDatumOrFile scriptFlagPrefix witctx) - (const $ pScriptDatumOrFileCip69 scriptFlagPrefix witctx) + excludeTxInScriptWitnesses :: WitCtx witctx -> ScriptDatumOrFile witctx + excludeTxInScriptWitnesses WitCtxMint = NoScriptDatumOrFileForMint + excludeTxInScriptWitnesses WitCtxStake = NoScriptDatumOrFileForStake + excludeTxInScriptWitnesses WitCtxTxIn = + error $ + mconcat + [ "pScriptWitnessFiles.excludeTxInScriptWitnesses: Should be impossible as " + , "tx in script witnesses are handled by the pSimpleScriptOrPlutusSpendingScriptWitness parser." + ] toScriptWitnessFiles :: ScriptFile @@ -1138,6 +1168,61 @@ pScriptDatumOrFile scriptFlagPrefix witctx = , Opt.help "Inline datum present at transaction input." ] +pScriptDatumOrFileSpendingMandatory :: String -> Parser PlutusSpend.ScriptDatumOrFileSpending +pScriptDatumOrFileSpendingMandatory scriptFlagPrefix = + asum + [ PlutusSpend.PotentialDatum . Just + <$> pScriptDataOrFile + (scriptFlagPrefix ++ "-datum") + "The script datum." + "The script datum file." + , pInlineDatumPresent + ] + where + pInlineDatumPresent :: Parser PlutusSpend.ScriptDatumOrFileSpending + pInlineDatumPresent = + flag' PlutusSpend.InlineDatum $ + mconcat + [ long (scriptFlagPrefix ++ "-inline-datum-present") + , Opt.help "Inline datum present at transaction input." + ] + +pScriptDatumOrFileSpendingCip69 + :: ShelleyBasedEra era -> String -> Parser PlutusSpend.ScriptDatumOrFileSpending +pScriptDatumOrFileSpendingCip69 sbe scriptFlagPrefix = + caseShelleyToBabbageOrConwayEraOnwards + (const datumMandatory) + (const datumOptional) + sbe + where + datumMandatory = + asum + [ PlutusSpend.PotentialDatum . Just + <$> datumParser + , pInlineDatumPresent + ] + + datumOptional = + asum + [ PlutusSpend.PotentialDatum + <$> optional datumParser + , pInlineDatumPresent + ] + + datumParser = + pScriptDataOrFile + (scriptFlagPrefix ++ "-datum") + "The script datum." + "The script datum file." + + pInlineDatumPresent :: Parser PlutusSpend.ScriptDatumOrFileSpending + pInlineDatumPresent = + flag' PlutusSpend.InlineDatum $ + mconcat + [ long (scriptFlagPrefix ++ "-inline-datum-present") + , Opt.help "Inline datum present at transaction input." + ] + pScriptDataOrFile :: String -- ^ data flag prefix @@ -1208,14 +1293,13 @@ pVoteFiles pVoteFiles sbe bExUnits = caseShelleyToBabbageOrConwayEraOnwards (const $ pure []) - (const . many $ pVoteFile sbe bExUnits) + (const . many $ pVoteFile bExUnits) sbe pVoteFile - :: ShelleyBasedEra era - -> BalanceTxExecUnits + :: BalanceTxExecUnits -> Parser (VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake)) -pVoteFile sbe balExUnits = +pVoteFile balExUnits = (,) <$> pFileInDirection "vote-file" "Filepath of the vote." <*> optional (pVoteScriptOrReferenceScriptWitness balExUnits) @@ -1224,7 +1308,6 @@ pVoteFile sbe balExUnits = :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake) pVoteScriptOrReferenceScriptWitness bExUnits = pScriptWitnessFiles - sbe WitCtxStake bExUnits "vote" @@ -1239,14 +1322,13 @@ pProposalFiles pProposalFiles sbe balExUnits = caseShelleyToBabbageOrConwayEraOnwards (const $ pure []) - (const $ many (pProposalFile sbe balExUnits)) + (const $ many (pProposalFile balExUnits)) sbe pProposalFile - :: ShelleyBasedEra era - -> BalanceTxExecUnits + :: BalanceTxExecUnits -> Parser (ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake)) -pProposalFile sbe balExUnits = +pProposalFile balExUnits = (,) <$> pFileInDirection "proposal-file" "Filepath of the proposal." <*> optional (pProposingScriptOrReferenceScriptWitness balExUnits) @@ -1255,7 +1337,6 @@ pProposalFile sbe balExUnits = :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake) pProposingScriptOrReferenceScriptWitness bExUnits = pScriptWitnessFiles - sbe WitCtxStake bExUnits "proposal" @@ -1408,10 +1489,9 @@ pTxBuildOutputOptions = "Where to write the script cost information." pCertificateFile - :: ShelleyBasedEra era - -> BalanceTxExecUnits + :: BalanceTxExecUnits -> Parser (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake)) -pCertificateFile sbe balanceExecUnits = +pCertificateFile balanceExecUnits = (,) <$> ( fmap CertificateFile $ asum @@ -1425,7 +1505,6 @@ pCertificateFile sbe balanceExecUnits = :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake) pCertifyingScriptOrReferenceScriptWit bExecUnits = pScriptWitnessFiles - sbe WitCtxStake balanceExecUnits "certificate" @@ -1484,14 +1563,13 @@ pMetadataFile = ] pWithdrawal - :: ShelleyBasedEra era - -> BalanceTxExecUnits + :: BalanceTxExecUnits -> Parser ( StakeAddress , Lovelace , Maybe (ScriptWitnessFiles WitCtxStake) ) -pWithdrawal sbe balance = +pWithdrawal balance = (\(stakeAddr, lovelace) maybeScriptFp -> (stakeAddr, lovelace, maybeScriptFp)) <$> Opt.option (readerFromParsecParser parseWithdrawal) @@ -1504,7 +1582,6 @@ pWithdrawal sbe balance = pWithdrawalScriptOrReferenceScriptWit :: Parser (ScriptWitnessFiles WitCtxStake) pWithdrawalScriptOrReferenceScriptWit = pScriptWitnessFiles - sbe WitCtxStake balance "withdrawal" @@ -1935,7 +2012,7 @@ pTxSubmitFile = parseFilePath "tx-file" "Filepath of the transaction you intend pTxIn :: ShelleyBasedEra era -> BalanceTxExecUnits - -> Parser (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn)) + -> Parser (TxIn, Maybe PlutusSpend.CliSpendScriptRequirements) pTxIn sbe balance = (,) <$> Opt.option @@ -1944,57 +2021,35 @@ pTxIn sbe balance = <> Opt.metavar "TX-IN" <> Opt.help "TxId#TxIx" ) - <*> optional - ( pPlutusReferenceScriptWitness sbe balance - <|> pSimpleReferenceSpendingScriptWitess - <|> pEmbeddedPlutusScriptWitness - ) + <*> ( optional + ( pPlutusReferenceSpendScriptWitness balance + <|> pSimpleReferenceSpendingScriptWitess + <|> pOnDiskSimpleOrPlutusScriptWitness + ) + ) where - pSimpleReferenceSpendingScriptWitess :: Parser (ScriptWitnessFiles WitCtxTxIn) + pSimpleReferenceSpendingScriptWitess :: Parser CliSpendScriptRequirements pSimpleReferenceSpendingScriptWitess = - createSimpleReferenceScriptWitnessFiles + PlutusSpend.createSimpleReferenceScriptFromCliArgs <$> pReferenceTxIn "simple-script-" "simple" - where - createSimpleReferenceScriptWitnessFiles - :: TxIn - -> ScriptWitnessFiles WitCtxTxIn - createSimpleReferenceScriptWitnessFiles refTxIn = - let simpleLang = AnyScriptLanguage SimpleScriptLanguage - in SimpleReferenceScriptWitnessFiles refTxIn simpleLang - - pPlutusReferenceScriptWitness - :: ShelleyBasedEra era -> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn) - pPlutusReferenceScriptWitness sbe' autoBalanceExecUnits = - caseShelleyToBabbageOrConwayEraOnwards - ( const $ - PlutusReferenceScriptWitnessFiles - <$> pReferenceTxIn "spending-" "plutus" - <*> pPlutusScriptLanguage "spending-" - <*> pScriptDatumOrFile "spending-reference-tx-in" WitCtxTxIn - <*> pScriptRedeemerOrFile "spending-reference-tx-in" - <*> ( case autoBalanceExecUnits of - AutoBalance -> pure (ExecutionUnits 0 0) - ManualBalance -> pExecutionUnits "spending-reference-tx-in" - ) - ) - ( const $ - PlutusReferenceScriptWitnessFiles - <$> pReferenceTxIn "spending-" "plutus" - <*> pPlutusScriptLanguage "spending-" - <*> pScriptDatumOrFileCip69 "spending-reference-tx-in" WitCtxTxIn - <*> pScriptRedeemerOrFile "spending-reference-tx-in" - <*> ( case autoBalanceExecUnits of - AutoBalance -> pure (ExecutionUnits 0 0) - ManualBalance -> pExecutionUnits "spending-reference-tx-in" - ) - ) - sbe' - pEmbeddedPlutusScriptWitness :: Parser (ScriptWitnessFiles WitCtxTxIn) - pEmbeddedPlutusScriptWitness = - pScriptWitnessFiles + pPlutusReferenceSpendScriptWitness + :: BalanceTxExecUnits -> Parser CliSpendScriptRequirements + pPlutusReferenceSpendScriptWitness autoBalanceExecUnits = + PlutusSpend.createPlutusReferenceScriptFromCliArgs + <$> pReferenceTxIn "spending-" "plutus" + <*> pPlutusScriptLanguage "spending-" + <*> pScriptDatumOrFileSpendingCip69 sbe "spending-reference-tx-in" + <*> pScriptRedeemerOrFile "spending-reference-tx-in" + <*> ( case autoBalanceExecUnits of + AutoBalance -> pure (ExecutionUnits 0 0) + ManualBalance -> pExecutionUnits "spending-reference-tx-in" + ) + + pOnDiskSimpleOrPlutusScriptWitness :: Parser CliSpendScriptRequirements + pOnDiskSimpleOrPlutusScriptWitness = + pSimpleScriptOrPlutusSpendingScriptWitness sbe - WitCtxTxIn balance "tx-in" (Just "txin") diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs index 9dc963024b..d8432e4ae7 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs @@ -185,8 +185,8 @@ pTransactionBuildCmd sbe envCli = do <*> optional (pMintMultiAsset sbe AutoBalance) <*> optional pInvalidBefore <*> pInvalidHereafter sbe - <*> many (pCertificateFile sbe AutoBalance) - <*> many (pWithdrawal sbe AutoBalance) + <*> many (pCertificateFile AutoBalance) + <*> many (pWithdrawal AutoBalance) <*> pTxMetadataJsonSchema <*> many ( pScriptFor @@ -245,8 +245,8 @@ pTransactionBuildEstimateCmd eon' _envCli = do <*> optional (pMintMultiAsset sbe ManualBalance) <*> optional pInvalidBefore <*> pInvalidHereafter sbe - <*> many (pCertificateFile sbe ManualBalance) - <*> many (pWithdrawal sbe ManualBalance) + <*> many (pCertificateFile ManualBalance) + <*> many (pWithdrawal ManualBalance) <*> optional pTotalCollateral <*> optional pReferenceScriptSize <*> pTxMetadataJsonSchema @@ -289,8 +289,8 @@ pTransactionBuildRaw era' = <*> optional pInvalidBefore <*> pInvalidHereafter era' <*> pTxFee - <*> many (pCertificateFile era' ManualBalance) - <*> many (pWithdrawal era' ManualBalance) + <*> many (pCertificateFile ManualBalance) + <*> many (pWithdrawal ManualBalance) <*> pTxMetadataJsonSchema <*> many (pScriptFor "auxiliary-script-file" Nothing "Filepath of auxiliary script(s)") <*> many pMetadataFile diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 56f4247f8b..3ab241b034 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -49,6 +49,8 @@ import qualified Cardano.CLI.EraBased.Commands.Transaction as Cmd import Cardano.CLI.EraBased.Run.Genesis.Common (readProtocolParameters) import Cardano.CLI.EraBased.Run.Query import Cardano.CLI.EraBased.Script.Mint.Read +import Cardano.CLI.EraBased.Script.Spend.Read +import Cardano.CLI.EraBased.Script.Spend.Types (SpendScriptWitness(..)) import Cardano.CLI.EraBased.Script.Mint.Types import Cardano.CLI.EraBased.Transaction.HashCheck (checkCertificateHashes, checkProposalHashes, checkVotingProcedureHashes) @@ -154,7 +156,16 @@ runTransactionBuildCmd , localNodeSocketPath = nodeSocketPath } - inputsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles eon txins + txinsAndMaybeScriptWits <- + mapM (\(txin, mSWit) -> do + case mSWit of + Nothing -> return (txin, Nothing) + Just sWit -> do + f <- firstExceptT TxCmdCliSpendingScriptWitnessError $ readSpendScriptWitness eon sWit + return (txin, Just f) + ) txins + + let spendingScriptWitnesses = mapMaybe (fmap sswScriptWitness . snd) txinsAndMaybeScriptWits certFilesAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles eon certificates @@ -257,7 +268,7 @@ runTransactionBuildCmd let allReferenceInputs = getAllReferenceInputs - inputsAndMaybeScriptWits + spendingScriptWitnesses (map mswScriptWitness $ snd usedToGetReferenceInputs) certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits @@ -265,7 +276,7 @@ runTransactionBuildCmd proposals readOnlyReferenceInputs - let inputsThatRequireWitnessing = [input | (input, _) <- inputsAndMaybeScriptWits] + let inputsThatRequireWitnessing = [input | (input, _) <- txins] allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ filteredTxinsc AnyCardanoEra nodeEra <- @@ -298,7 +309,7 @@ runTransactionBuildCmd nodeSocketPath networkId mScriptValidity - inputsAndMaybeScriptWits + txinsAndMaybeScriptWits readOnlyReferenceInputs filteredTxinsc mReturnCollateral @@ -401,9 +412,15 @@ runTransactionBuildEstimateCmd -- TODO change type ledgerPParams <- firstExceptT TxCmdProtocolParamsError $ readProtocolParameters sbe protocolParamsFile - inputsAndMaybeScriptWits <- - firstExceptT TxCmdScriptWitnessError $ - readScriptWitnessFiles sbe txins + txInsAndMaybeScriptWits <- + mapM (\(txin, mSWit) -> do + case mSWit of + Nothing -> return (txin, Nothing) + Just sWit -> do + f <- firstExceptT TxCmdCliSpendingScriptWitnessError $ readSpendScriptWitness sbe sWit + return (txin, Just f) + ) txins + certFilesAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles sbe certificates @@ -473,7 +490,7 @@ runTransactionBuildEstimateCmd -- TODO change type sbe mScriptValidity (Just ledgerPParams) - inputsAndMaybeScriptWits + txInsAndMaybeScriptWits readOnlyRefIns filteredTxinsc mReturnCollateral @@ -642,9 +659,15 @@ runTransactionBuildRawCmd , currentTreasuryValueAndDonation , txBodyOutFile } = do - inputsAndMaybeScriptWits <- - firstExceptT TxCmdScriptWitnessError $ - readScriptWitnessFiles eon txIns + + txInsAndMaybeScriptWits <- + mapM (\(txin, mSWit) -> do + case mSWit of + Nothing -> return (txin, Nothing) + Just sWit -> do + f <- firstExceptT TxCmdCliSpendingScriptWitnessError $ readSpendScriptWitness eon sWit + return (txin, Just f) + ) txIns certFilesAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles eon certificates @@ -717,7 +740,7 @@ runTransactionBuildRawCmd runTxBuildRaw eon mScriptValidity - inputsAndMaybeScriptWits + txInsAndMaybeScriptWits readOnlyRefIns filteredTxinsc mReturnCollateral @@ -747,7 +770,7 @@ runTxBuildRaw => ShelleyBasedEra era -> Maybe ScriptValidity -- ^ Mark script as expected to pass or fail validation - -> [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))] + -> [(TxIn, Maybe (SpendScriptWitness era))] -- ^ TxIn with potential script witness -> [TxIn] -- ^ Read only reference inputs @@ -834,7 +857,7 @@ constructTxBodyContent . ShelleyBasedEra era -> Maybe ScriptValidity -> Maybe (L.PParams (ShelleyLedgerEra era)) - -> [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))] + -> [(TxIn, Maybe (SpendScriptWitness era))] -- ^ TxIn with potential script witness -> [TxIn] -- ^ Read only reference inputs @@ -896,7 +919,7 @@ constructTxBodyContent do let allReferenceInputs = getAllReferenceInputs - inputsAndMaybeScriptWits + (map sswScriptWitness $ catMaybes $ map snd inputsAndMaybeScriptWits) (map mswScriptWitness $ snd valuesWithScriptWits) certsAndMaybeScriptWits withdrawals @@ -976,7 +999,7 @@ runTxBuild -> NetworkId -> Maybe ScriptValidity -- ^ Mark script as expected to pass or fail validation - -> [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))] + -> [(TxIn, Maybe (SpendScriptWitness era))] -- ^ Read only reference inputs -> [TxIn] -- ^ TxIn with potential script witness @@ -1043,7 +1066,7 @@ runTxBuild let allReferenceInputs = getAllReferenceInputs - inputsAndMaybeScriptWits + (map sswScriptWitness $ catMaybes $ map snd inputsAndMaybeScriptWits) (map mswScriptWitness $ snd valuesWithScriptWits) certsAndMaybeScriptWits withdrawals @@ -1177,17 +1200,17 @@ txFeatureMismatchPure era feature = Left (TxCmdTxFeatureMismatch (anyCardanoEra era) feature) validateTxIns - :: [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))] + :: [(TxIn, Maybe (SpendScriptWitness era))] -> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))] validateTxIns = map convertTxIn where convertTxIn - :: (TxIn, Maybe (ScriptWitness WitCtxTxIn era)) + :: (TxIn, Maybe (SpendScriptWitness era)) -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)) convertTxIn (txin, mScriptWitness) = case mScriptWitness of Just sWit -> - (txin, BuildTxWith $ ScriptWitness ScriptWitnessForSpending sWit) + (txin, BuildTxWith $ ScriptWitness ScriptWitnessForSpending $ sswScriptWitness sWit) Nothing -> (txin, BuildTxWith $ KeyWitness KeyWitnessForSpending) @@ -1210,7 +1233,7 @@ validateTxInsReference sbe allRefIns = do & maybe (txFeatureMismatchPure (toCardanoEra sbe) TxFeatureReferenceInputs) Right getAllReferenceInputs - :: [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))] + :: [ScriptWitness WitCtxTxIn era] -> [ScriptWitness WitCtxMint era] -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))] @@ -1220,14 +1243,14 @@ getAllReferenceInputs -- ^ Read only reference inputs -> [TxIn] getAllReferenceInputs - txins + spendingWitnesses mintWitnesses certFiles withdrawals votingProceduresAndMaybeScriptWits propProceduresAnMaybeScriptWits readOnlyRefIns = do - let txinsWitByRefInputs = [getScriptWitnessReferenceInput sWit | (_, Just sWit) <- txins] + let txinsWitByRefInputs = map getScriptWitnessReferenceInput spendingWitnesses mintingRefInputs = map getScriptWitnessReferenceInput mintWitnesses certsWitByRefInputs = [getScriptWitnessReferenceInput sWit | (_, Just sWit) <- certFiles] withdrawalsWitByRefInputs = [getScriptWitnessReferenceInput sWit | (_, _, Just sWit) <- withdrawals] diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs index 5b40eb1690..b82404edf8 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs @@ -27,7 +27,7 @@ readMintScriptWitness sbe (OnDiskSimpleOrPlutusScript simpleOrPlutus) = let polId = PolicyId $ hashScript s return $ MintScriptWitnessWithPolicyId polId $ - SimpleScriptWitness (sbeToSimpleScriptLangInEra sbe) $ + SimpleScriptWitness (sbeToSimpleScriptLanguageInEra sbe) $ SScript ss OnDiskPlutusScriptCliArgs plutusScriptFp redeemerFile execUnits -> do let sFp = unFile plutusScriptFp @@ -65,7 +65,7 @@ readMintScriptWitness sbe (OnDiskSimpleRefScript (SimpleRefScriptCliArgs refTxIn return $ MintScriptWitnessWithPolicyId polId $ SimpleScriptWitness - (sbeToSimpleScriptLangInEra sbe) + (sbeToSimpleScriptLanguageInEra sbe) (SReferenceScript refTxIn) readMintScriptWitness sbe @@ -101,12 +101,5 @@ readMintScriptWitness redeemer execUnits --- TODO: Remove me when exposed from cardano-api -sbeToSimpleScriptLangInEra - :: ShelleyBasedEra era -> ScriptLanguageInEra SimpleScript' era -sbeToSimpleScriptLangInEra ShelleyBasedEraShelley = SimpleScriptInShelley -sbeToSimpleScriptLangInEra ShelleyBasedEraAllegra = SimpleScriptInAllegra -sbeToSimpleScriptLangInEra ShelleyBasedEraMary = SimpleScriptInMary -sbeToSimpleScriptLangInEra ShelleyBasedEraAlonzo = SimpleScriptInAlonzo -sbeToSimpleScriptLangInEra ShelleyBasedEraBabbage = SimpleScriptInBabbage -sbeToSimpleScriptLangInEra ShelleyBasedEraConway = SimpleScriptInConway + + diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs index 192e4ed0f3..d9901ebc8a 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs @@ -44,7 +44,7 @@ data SimpleOrPlutusScriptCliArgs (File ScriptInAnyLang In) | OnDiskPlutusScriptCliArgs (File ScriptInAnyLang In) - ScriptDataOrFile + ScriptDataOrFile -- ^ Redeemer ExecutionUnits deriving Show diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs new file mode 100644 index 0000000000..8eed8f02da --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.EraBased.Script.Spend.Read + ( CliSpendScriptWitnessError + , readSpendScriptWitness + ) +where + +import Cardano.Api +import Cardano.Api.Shelley + +import Cardano.CLI.EraBased.Script.Mint.Types (CliScriptWitnessError (..)) +import Cardano.CLI.EraBased.Script.Spend.Types +import Cardano.CLI.Read + +data CliSpendScriptWitnessError + = CliScriptWitnessError CliScriptWitnessError + | CliSpendScriptWitnessDatumError ScriptDataError + +instance Error CliSpendScriptWitnessError where + prettyError = \case + CliScriptWitnessError e -> prettyError e + CliSpendScriptWitnessDatumError e -> renderScriptDataError e + +readSpendScriptWitness + :: MonadIOTransError (FileError CliSpendScriptWitnessError) t m + => ShelleyBasedEra era -> CliSpendScriptRequirements -> t m (SpendScriptWitness era) +readSpendScriptWitness sbe spendScriptReq = + case spendScriptReq of + OnDiskSimpleOrPlutusScript (OnDiskSimpleCliArgs simpleFp) -> do + let sFp = unFile simpleFp + s <- + modifyError (fmap (CliScriptWitnessError . SimpleScriptWitnessDecodeError)) $ + readFileSimpleScript sFp + case s of + SimpleScript ss -> do + return $ + SpendScriptWitness $ + SimpleScriptWitness (sbeToSimpleScriptLanguageInEra sbe) $ + SScript ss + OnDiskSimpleOrPlutusScript + (OnDiskPlutusScriptCliArgs plutusScriptFp mScriptDatum redeemerFile execUnits) -> do + let sFp = unFile plutusScriptFp + plutusScript <- + modifyError (fmap (CliScriptWitnessError . PlutusScriptWitnessDecodeError)) $ + readFilePlutusScript $ + unFile plutusScriptFp + redeemer <- + modifyError (FileError sFp . (CliScriptWitnessError . PlutusScriptWitnessRedeemerError)) $ + readScriptDataOrFile redeemerFile + case plutusScript of + AnyPlutusScript lang script -> do + let pScript = PScript script + sLangSupported <- + modifyError (FileError sFp) + $ hoistMaybe + ( CliScriptWitnessError $ + PlutusScriptWitnessLanguageNotSupportedInEra + (AnyPlutusScriptVersion lang) + (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) + ) + $ scriptLanguageSupportedInEra sbe + $ PlutusScriptLanguage lang + mDatum <- handlePotentialScriptDatum mScriptDatum + return $ + SpendScriptWitness $ + PlutusScriptWitness + sLangSupported + lang + pScript + mDatum + redeemer + execUnits + OnDiskSimpleRefScript (SimpleRefScriptArgs refTxIn) -> + return $ + SpendScriptWitness $ + SimpleScriptWitness + (sbeToSimpleScriptLanguageInEra sbe) + (SReferenceScript refTxIn) + OnDiskPlutusRefScript + (PlutusRefScriptCliArgs refTxIn anyPlutusScriptVersion mScriptDatum redeemerFile execUnits) -> + case anyPlutusScriptVersion of + AnyPlutusScriptVersion lang -> do + let pScript = PReferenceScript refTxIn + redeemer <- + -- TODO: Implement a new error type to capture this. FileError is not representative of cases + -- where we do not have access to the script. + modifyError + ( FileError "Reference script filepath not available" + . CliScriptWitnessError + . PlutusScriptWitnessRedeemerError + ) + $ readScriptDataOrFile redeemerFile + sLangSupported <- + -- TODO: Implement a new error type to capture this. FileError is not representative of cases + -- where we do not have access to the script. + modifyError (FileError "Reference script filepath not available") + $ hoistMaybe + ( CliScriptWitnessError $ + PlutusScriptWitnessLanguageNotSupportedInEra + (AnyPlutusScriptVersion lang) + (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) + ) + $ scriptLanguageSupportedInEra sbe + $ PlutusScriptLanguage lang + + mDatum <- handlePotentialScriptDatum mScriptDatum + return $ + SpendScriptWitness $ + PlutusScriptWitness + sLangSupported + lang + pScript + mDatum + redeemer + execUnits + +handlePotentialScriptDatum + :: MonadIOTransError (FileError CliSpendScriptWitnessError) t m + => ScriptDatumOrFileSpending + -> t m (ScriptDatum WitCtxTxIn) +handlePotentialScriptDatum InlineDatum = return InlineScriptDatum +handlePotentialScriptDatum (PotentialDatum mDatum) = + case mDatum of + Just datumFp -> do + sDatum <- + modifyError (FileError (show datumFp) . CliSpendScriptWitnessDatumError) $ + readScriptDataOrFile datumFp + return . ScriptDatumForTxIn $ Just sDatum + Nothing -> return $ ScriptDatumForTxIn Nothing diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Types.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Types.hs new file mode 100644 index 0000000000..127d7bb940 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Types.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.EraBased.Script.Spend.Types + ( CliSpendScriptRequirements (..) + , PlutusRefScriptCliArgs (..) + , SimpleOrPlutusScriptCliArgs (..) + , ScriptDatumOrFileSpending (..) + , SimpleRefScriptCliArgs (..) + , SpendScriptWitness (..) + , createSimpleOrPlutusScriptFromCliArgs + , createPlutusReferenceScriptFromCliArgs + , createSimpleReferenceScriptFromCliArgs + ) +where + +import Cardano.Api + +import Cardano.CLI.Types.Common (ScriptDataOrFile) + +data SpendScriptWitness era + = SpendScriptWitness {sswScriptWitness :: ScriptWitness WitCtxTxIn era} + deriving Show + +data CliSpendScriptRequirements + = OnDiskSimpleOrPlutusScript SimpleOrPlutusScriptCliArgs + | OnDiskSimpleRefScript SimpleRefScriptCliArgs + | OnDiskPlutusRefScript PlutusRefScriptCliArgs + deriving Show + +data SimpleOrPlutusScriptCliArgs + = OnDiskPlutusScriptCliArgs + (File ScriptInAnyLang In) + (ScriptDatumOrFileSpending) + -- ^ Optional Datum (CIP-69) + ScriptDataOrFile + -- ^ Redeemer + ExecutionUnits + | OnDiskSimpleCliArgs + (File ScriptInAnyLang In) + deriving Show + +createSimpleOrPlutusScriptFromCliArgs + :: File ScriptInAnyLang In + -> Maybe (ScriptDatumOrFileSpending, ScriptDataOrFile, ExecutionUnits) + -> CliSpendScriptRequirements +createSimpleOrPlutusScriptFromCliArgs scriptFp (Just (datumFile, redeemerFile, execUnits)) = + OnDiskSimpleOrPlutusScript $ OnDiskPlutusScriptCliArgs scriptFp datumFile redeemerFile execUnits +createSimpleOrPlutusScriptFromCliArgs scriptFp Nothing = OnDiskSimpleOrPlutusScript $ OnDiskSimpleCliArgs scriptFp + +newtype SimpleRefScriptCliArgs = SimpleRefScriptArgs TxIn deriving Show + +createSimpleReferenceScriptFromCliArgs :: TxIn -> CliSpendScriptRequirements +createSimpleReferenceScriptFromCliArgs = OnDiskSimpleRefScript . SimpleRefScriptArgs + +-- TODO: How to handle ScriptDatumOrFile type? You need to express that the datum +-- could also be inline! +data PlutusRefScriptCliArgs + = PlutusRefScriptCliArgs + TxIn + -- ^ TxIn with reference script + AnyPlutusScriptVersion + ScriptDatumOrFileSpending + -- ^ Optional Datum (CIP-69) + ScriptDataOrFile + -- ^ Redeemer + ExecutionUnits + deriving Show + +createPlutusReferenceScriptFromCliArgs + :: TxIn + -> AnyPlutusScriptVersion + -> ScriptDatumOrFileSpending + -> ScriptDataOrFile + -> ExecutionUnits + -> CliSpendScriptRequirements +createPlutusReferenceScriptFromCliArgs txin v mDatum redeemer execUnits = + OnDiskPlutusRefScript $ PlutusRefScriptCliArgs txin v mDatum redeemer execUnits + +data ScriptDatumOrFileSpending + = PotentialDatum (Maybe ScriptDataOrFile) + | InlineDatum + deriving Show diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs index 4e57677428..c0e227ef2d 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs @@ -20,6 +20,7 @@ import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley import Cardano.CLI.EraBased.Script.Mint.Types +import Cardano.CLI.EraBased.Script.Spend.Read import Cardano.CLI.Read import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.BootstrapWitnessError @@ -52,6 +53,7 @@ data TxCmdError | TxCmdProtocolParamsError ProtocolParamsError | TxCmdScriptFileError (FileError ScriptDecodeError) | TxCmdCliScriptWitnessError !(FileError CliScriptWitnessError) + | TxCmdCliSpendingScriptWitnessError !(FileError CliSpendScriptWitnessError) | TxCmdKeyFileError (FileError InputDecodeError) | TxCmdReadTextViewFileError !(FileError TextEnvelopeError) | TxCmdReadWitnessSigningDataError !ReadWitnessSigningDataError @@ -109,6 +111,8 @@ renderTxCmdError = \case prettyError fileErr TxCmdCliScriptWitnessError cliScriptWitnessErr -> prettyError cliScriptWitnessErr + TxCmdCliSpendingScriptWitnessError cliSpendScriptWitnessErr -> + prettyError cliSpendScriptWitnessErr TxCmdKeyFileError fileErr -> prettyError fileErr TxCmdReadWitnessSigningDataError witSignDataErr ->