Try to reduce this diff

IntersectMBO · Jan 20, 2025 · 590c710 · 590c710
1 parent 20ba3eb
commit 590c710
Show file tree

Hide file tree

Showing 11 changed files with 416 additions and 120 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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,38 +1031,66 @@ 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
   -- ^ Script flag prefix
   -> Maybe String
   -> String
   -> Parser (ScriptWitnessFiles witctx)
-pScriptWitnessFiles sbe witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help =
+pScriptWitnessFiles witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help =
   toScriptWitnessFiles
     <$> pScriptFor
       (scriptFlagPrefix ++ "-script-file")
       ((++ "-script-file") <$> scriptFlagPrefixDeprecated)
       ("The file containing the script to witness " ++ help)
     <*> optional
       ( (,,)
-          <$> cip69Modification sbe
+          <$> pure (excludeTxInScriptWitnesses witctx)
           <*> pScriptRedeemerOrFile scriptFlagPrefix
           <*> ( case autoBalanceExecUnits of
                   AutoBalance -> pure (ExecutionUnits 0 0)
                   ManualBalance -> pExecutionUnits scriptFlagPrefix
               )
       )
  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")