From 529ffa93d03795aecd3341af423e145637dcb6bc Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 16 Jan 2025 09:05:32 -0400 Subject: [PATCH 1/3] Everything builds. Run tests --- cabal.project | 4 +- cardano-cli/cardano-cli.cabal | 2 + .../CLI/EraBased/Commands/Transaction.hs | 7 +- .../Cardano/CLI/EraBased/Options/Common.hs | 115 ++++++++++++---- .../Cardano/CLI/EraBased/Run/Transaction.hs | 69 ++++++---- .../Cardano/CLI/EraBased/Script/Mint/Read.hs | 15 +-- .../Cardano/CLI/EraBased/Script/Mint/Types.hs | 2 +- .../Cardano/CLI/EraBased/Script/Spend/Read.hs | 125 ++++++++++++++++++ .../CLI/EraBased/Script/Spend/Types.hs | 87 ++++++++++++ .../Cardano/CLI/Types/Errors/TxCmdError.hs | 4 + 10 files changed, 367 insertions(+), 63 deletions(-) create mode 100644 cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs create mode 100644 cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Types.hs diff --git a/cabal.project b/cabal.project index 8d34ceba70..9222001652 100644 --- a/cabal.project +++ b/cabal.project @@ -19,8 +19,8 @@ index-state: packages: cardano-cli -program-options - ghc-options: -Werror +-- program-options +-- ghc-options: -Werror package cryptonite -- Using RDRAND instead of /dev/urandom as an entropy source for key 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/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index f6898c8c30..d07b7d4443 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 qualified Cardano.CLI.EraBased.Script.Spend.Types as PlutusSpend 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 PlutusSpend.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 PlutusSpend.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 PlutusSpend.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..17aea8ce8e 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -15,6 +15,8 @@ module Cardano.CLI.EraBased.Options.Common where import Cardano.Api import qualified Cardano.Api.Ledger as L import qualified Cardano.Api.Network as Consensus +import Cardano.CLI.EraBased.Script.Spend.Types (CliSpendScriptRequirements) +import qualified Cardano.CLI.EraBased.Script.Spend.Types as PlutusSpend import Cardano.Api.Shelley import Cardano.CLI.Environment (EnvCli (..), envCliAnyEon) @@ -1029,6 +1031,38 @@ pPlutusMintScriptWitnessData _sbe _witctx autoBalanceExecUnits = ) ) + + +pPlutusSpendingScriptWitness + :: BalanceTxExecUnits + -- ^ Use the @execution-units@ flag. + -> String + -- ^ Script flag prefix + -> Maybe String + -> String + -> Parser CliSpendScriptRequirements +pPlutusSpendingScriptWitness autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help = + PlutusSpend.createPlutusScriptFromCliArgs + <$> pScriptFor + (scriptFlagPrefix ++ "-script-file") + ((++ "-script-file") <$> scriptFlagPrefixDeprecated) + ("The file containing the script to witness " ++ help) + <*> + ( optional ((,,) + <$> pScriptDatumOrFileSpendingCipi69 scriptFlagPrefix + <*> pScriptRedeemerOrFile scriptFlagPrefix + <*> ( case autoBalanceExecUnits of + AutoBalance -> pure (ExecutionUnits 0 0) + ManualBalance -> pExecutionUnits scriptFlagPrefix + )) + ) + + + + + + + pScriptWitnessFiles :: forall witctx era . ShelleyBasedEra era @@ -1138,6 +1172,44 @@ pScriptDatumOrFile scriptFlagPrefix witctx = , Opt.help "Inline datum present at transaction input." ] +pScriptDatumOrFileSpending :: String -> Parser PlutusSpend.ScriptDatumOrFileSpending +pScriptDatumOrFileSpending 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." + ] + +pScriptDatumOrFileSpendingCipi69 :: String -> Parser PlutusSpend.ScriptDatumOrFileSpending +pScriptDatumOrFileSpendingCipi69 scriptFlagPrefix = + asum + [ PlutusSpend.PotentialDatum <$> optional (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." + ] + + + pScriptDataOrFile :: String -- ^ data flag prefix @@ -1935,7 +2007,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,33 +2016,32 @@ pTxIn sbe balance = <> Opt.metavar "TX-IN" <> Opt.help "TxId#TxIx" ) - <*> optional - ( pPlutusReferenceScriptWitness sbe balance + <*> + ( optional (pPlutusReferenceScriptWitness sbe balance <|> pSimpleReferenceSpendingScriptWitess - <|> pEmbeddedPlutusScriptWitness + <|> pOnDiskPlutusScriptWitness) ) 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 + -- TODO: Left off here. You can keep the era switching behaviour + -- for now but use createPlutusReferenceScriptFromCliArgs. Resolve + -- type errors and pScriptDatumOrFile issue. You likely need + -- a newtype that represents the possibility of a datum, no datum + -- or inline datum. The other contructors will eventually become irrelevant + -- once you remove the script witness files type pPlutusReferenceScriptWitness - :: ShelleyBasedEra era -> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn) + :: ShelleyBasedEra era -> BalanceTxExecUnits -> Parser CliSpendScriptRequirements pPlutusReferenceScriptWitness sbe' autoBalanceExecUnits = caseShelleyToBabbageOrConwayEraOnwards ( const $ - PlutusReferenceScriptWitnessFiles + PlutusSpend.createPlutusReferenceScriptFromCliArgs <$> pReferenceTxIn "spending-" "plutus" <*> pPlutusScriptLanguage "spending-" - <*> pScriptDatumOrFile "spending-reference-tx-in" WitCtxTxIn + <*> pScriptDatumOrFileSpending "spending-reference-tx-in" <*> pScriptRedeemerOrFile "spending-reference-tx-in" <*> ( case autoBalanceExecUnits of AutoBalance -> pure (ExecutionUnits 0 0) @@ -1978,10 +2049,10 @@ pTxIn sbe balance = ) ) ( const $ - PlutusReferenceScriptWitnessFiles + PlutusSpend.createPlutusReferenceScriptFromCliArgs <$> pReferenceTxIn "spending-" "plutus" <*> pPlutusScriptLanguage "spending-" - <*> pScriptDatumOrFileCip69 "spending-reference-tx-in" WitCtxTxIn + <*> pScriptDatumOrFileSpendingCipi69 "spending-reference-tx-in" <*> pScriptRedeemerOrFile "spending-reference-tx-in" <*> ( case autoBalanceExecUnits of AutoBalance -> pure (ExecutionUnits 0 0) @@ -1990,11 +2061,9 @@ pTxIn sbe balance = ) sbe' - pEmbeddedPlutusScriptWitness :: Parser (ScriptWitnessFiles WitCtxTxIn) - pEmbeddedPlutusScriptWitness = - pScriptWitnessFiles - sbe - WitCtxTxIn + pOnDiskPlutusScriptWitness :: Parser CliSpendScriptRequirements + pOnDiskPlutusScriptWitness = + pPlutusSpendingScriptWitness balance "tx-in" (Just "txin") 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..ec92563660 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.EraBased.Script.Spend.Read + ( CliSpendScriptWitnessError + , readSpendScriptWitness + ) +where + +import Cardano.Api +import Cardano.Api.Shelley + +import Cardano.CLI.EraBased.Script.Spend.Types +import Cardano.CLI.EraBased.Script.Mint.Types (CliScriptWitnessError(..)) +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 (OnDiskSimpleOrPlutusScriptCliArgs 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 \ No newline at end of file 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..ac6902d273 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Types.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.EraBased.Script.Spend.Types + ( CliSpendScriptRequirements(..) + , PlutusRefScriptCliArgs(..) + , SimpleOrPlutusScriptCliArgs(..) + , ScriptDatumOrFileSpending(..) + , SimpleRefScriptCliArgs(..) + , SpendScriptWitness(..) + , createPlutusScriptFromCliArgs + , 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 + | OnDiskSimpleOrPlutusScriptCliArgs + (File ScriptInAnyLang In) + + deriving Show + + +createPlutusScriptFromCliArgs + :: File ScriptInAnyLang In + -> Maybe (ScriptDatumOrFileSpending, ScriptDataOrFile, ExecutionUnits) + -> CliSpendScriptRequirements +createPlutusScriptFromCliArgs scriptFp (Just (datumFile, redeemerFile, execUnits)) = + OnDiskSimpleOrPlutusScript $ OnDiskPlutusScriptCliArgs scriptFp datumFile redeemerFile execUnits +createPlutusScriptFromCliArgs scriptFp Nothing = OnDiskSimpleOrPlutusScript $ OnDiskSimpleOrPlutusScriptCliArgs 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 -> From e59973ca9211c7a13fbcbe54d838117636a90743 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 17 Jan 2025 16:23:13 -0400 Subject: [PATCH 2/3] small change --- cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs | 2 +- cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Types.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs index ec92563660..2c3fe4dc7a 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs @@ -34,7 +34,7 @@ readSpendScriptWitness => ShelleyBasedEra era -> CliSpendScriptRequirements -> t m (SpendScriptWitness era) readSpendScriptWitness sbe spendScriptReq = case spendScriptReq of - OnDiskSimpleOrPlutusScript (OnDiskSimpleOrPlutusScriptCliArgs simpleFp) -> do + OnDiskSimpleOrPlutusScript (OnDiskSimpleCliArgs simpleFp) -> do let sFp = unFile simpleFp s <- modifyError (fmap (CliScriptWitnessError . SimpleScriptWitnessDecodeError)) $ readFileSimpleScript sFp diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Types.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Types.hs index ac6902d273..9298a7e726 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Types.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Types.hs @@ -37,7 +37,7 @@ data SimpleOrPlutusScriptCliArgs (ScriptDatumOrFileSpending) -- ^ Optional Datum (CIP-69) ScriptDataOrFile -- ^ Redeemer ExecutionUnits - | OnDiskSimpleOrPlutusScriptCliArgs + | OnDiskSimpleCliArgs (File ScriptInAnyLang In) deriving Show @@ -49,7 +49,7 @@ createPlutusScriptFromCliArgs -> CliSpendScriptRequirements createPlutusScriptFromCliArgs scriptFp (Just (datumFile, redeemerFile, execUnits)) = OnDiskSimpleOrPlutusScript $ OnDiskPlutusScriptCliArgs scriptFp datumFile redeemerFile execUnits -createPlutusScriptFromCliArgs scriptFp Nothing = OnDiskSimpleOrPlutusScript $ OnDiskSimpleOrPlutusScriptCliArgs scriptFp +createPlutusScriptFromCliArgs scriptFp Nothing = OnDiskSimpleOrPlutusScript $ OnDiskSimpleCliArgs scriptFp newtype SimpleRefScriptCliArgs = SimpleRefScriptArgs TxIn deriving Show From 3e41196d120815bcccf1b348a4ec9b2d1164f545 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 17 Jan 2025 16:53:23 -0400 Subject: [PATCH 3/3] Try to reduce this diff --- .../Cardano/CLI/EraBased/Options/Common.hs | 58 +++++++++++-------- 1 file changed, 34 insertions(+), 24 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index 17aea8ce8e..d2d3ed1d75 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -1034,14 +1034,15 @@ pPlutusMintScriptWitnessData _sbe _witctx autoBalanceExecUnits = pPlutusSpendingScriptWitness - :: BalanceTxExecUnits + :: ShelleyBasedEra era + -> BalanceTxExecUnits -- ^ Use the @execution-units@ flag. -> String -- ^ Script flag prefix -> Maybe String -> String -> Parser CliSpendScriptRequirements -pPlutusSpendingScriptWitness autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help = +pPlutusSpendingScriptWitness sbe autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help = PlutusSpend.createPlutusScriptFromCliArgs <$> pScriptFor (scriptFlagPrefix ++ "-script-file") @@ -1049,7 +1050,7 @@ pPlutusSpendingScriptWitness autoBalanceExecUnits scriptFlagPrefix scriptFlagPre ("The file containing the script to witness " ++ help) <*> ( optional ((,,) - <$> pScriptDatumOrFileSpendingCipi69 scriptFlagPrefix + <$> pScriptDatumOrFileSpendingCip69 sbe scriptFlagPrefix <*> pScriptRedeemerOrFile scriptFlagPrefix <*> ( case autoBalanceExecUnits of AutoBalance -> pure (ExecutionUnits 0 0) @@ -1057,12 +1058,6 @@ pPlutusSpendingScriptWitness autoBalanceExecUnits scriptFlagPrefix scriptFlagPre )) ) - - - - - - pScriptWitnessFiles :: forall witctx era . ShelleyBasedEra era @@ -1082,7 +1077,7 @@ pScriptWitnessFiles sbe witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagP ("The file containing the script to witness " ++ help) <*> optional ( (,,) - <$> cip69Modification sbe + <$> cip69Modification sbe witctx scriptFlagPrefix <*> pScriptRedeemerOrFile scriptFlagPrefix <*> ( case autoBalanceExecUnits of AutoBalance -> pure (ExecutionUnits 0 0) @@ -1090,12 +1085,6 @@ pScriptWitnessFiles sbe witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagP ) ) where - cip69Modification :: ShelleyBasedEra era -> Parser (ScriptDatumOrFile witctx) - cip69Modification = - caseShelleyToBabbageOrConwayEraOnwards - (const $ pScriptDatumOrFile scriptFlagPrefix witctx) - (const $ pScriptDatumOrFileCip69 scriptFlagPrefix witctx) - toScriptWitnessFiles :: ScriptFile -> Maybe @@ -1107,6 +1096,14 @@ pScriptWitnessFiles sbe witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagP toScriptWitnessFiles sf Nothing = SimpleScriptWitnessFile sf toScriptWitnessFiles sf (Just (d, r, e)) = PlutusScriptWitnessFiles sf d r e + +cip69Modification :: ShelleyBasedEra era -> WitCtx witctx -> String -> Parser (ScriptDatumOrFile witctx) +cip69Modification sbe witctx scriptFlagPrefix = + caseShelleyToBabbageOrConwayEraOnwards + (const $ pScriptDatumOrFile scriptFlagPrefix witctx) + (const $ pScriptDatumOrFileCip69 scriptFlagPrefix witctx) + sbe + pExecutionUnits :: String -> Parser ExecutionUnits pExecutionUnits scriptFlagPrefix = fmap (uncurry ExecutionUnits) $ @@ -1172,8 +1169,8 @@ pScriptDatumOrFile scriptFlagPrefix witctx = , Opt.help "Inline datum present at transaction input." ] -pScriptDatumOrFileSpending :: String -> Parser PlutusSpend.ScriptDatumOrFileSpending -pScriptDatumOrFileSpending scriptFlagPrefix = +pScriptDatumOrFileSpendingNotOptional :: String -> Parser PlutusSpend.ScriptDatumOrFileSpending +pScriptDatumOrFileSpendingNotOptional scriptFlagPrefix = asum [ PlutusSpend.PotentialDatum . Just <$> (pScriptDataOrFile (scriptFlagPrefix ++ "-datum") @@ -1190,16 +1187,28 @@ pScriptDatumOrFileSpending scriptFlagPrefix = , Opt.help "Inline datum present at transaction input." ] -pScriptDatumOrFileSpendingCipi69 :: String -> Parser PlutusSpend.ScriptDatumOrFileSpending -pScriptDatumOrFileSpendingCipi69 scriptFlagPrefix = - asum +pScriptDatumOrFileSpendingCip69 :: ShelleyBasedEra era -> String -> Parser PlutusSpend.ScriptDatumOrFileSpending +pScriptDatumOrFileSpendingCip69 sbe scriptFlagPrefix = + caseShelleyToBabbageOrConwayEraOnwards + (const $ datumMandatory) + (const $ datumOptional) + sbe + where + datumMandatory = + asum + [ PlutusSpend.PotentialDatum . Just <$> (pScriptDataOrFile + (scriptFlagPrefix ++ "-datum") + "The script datum." + "The script datum file.") + , pInlineDatumPresent + ] + datumOptional = asum [ PlutusSpend.PotentialDatum <$> optional (pScriptDataOrFile (scriptFlagPrefix ++ "-datum") "The script datum." "The script datum file.") , pInlineDatumPresent ] - where pInlineDatumPresent :: Parser PlutusSpend.ScriptDatumOrFileSpending pInlineDatumPresent = flag' PlutusSpend.InlineDatum $ @@ -2041,7 +2050,7 @@ pTxIn sbe balance = PlutusSpend.createPlutusReferenceScriptFromCliArgs <$> pReferenceTxIn "spending-" "plutus" <*> pPlutusScriptLanguage "spending-" - <*> pScriptDatumOrFileSpending "spending-reference-tx-in" + <*> pScriptDatumOrFileSpendingNotOptional "spending-reference-tx-in" <*> pScriptRedeemerOrFile "spending-reference-tx-in" <*> ( case autoBalanceExecUnits of AutoBalance -> pure (ExecutionUnits 0 0) @@ -2052,7 +2061,7 @@ pTxIn sbe balance = PlutusSpend.createPlutusReferenceScriptFromCliArgs <$> pReferenceTxIn "spending-" "plutus" <*> pPlutusScriptLanguage "spending-" - <*> pScriptDatumOrFileSpendingCipi69 "spending-reference-tx-in" + <*> pScriptDatumOrFileSpendingCip69 sbe "spending-reference-tx-in" <*> pScriptRedeemerOrFile "spending-reference-tx-in" <*> ( case autoBalanceExecUnits of AutoBalance -> pure (ExecutionUnits 0 0) @@ -2064,6 +2073,7 @@ pTxIn sbe balance = pOnDiskPlutusScriptWitness :: Parser CliSpendScriptRequirements pOnDiskPlutusScriptWitness = pPlutusSpendingScriptWitness + sbe balance "tx-in" (Just "txin")