Add reference script flags for proposing and voting scripts

IntersectMBO · Jul 15, 2024 · 67acb40 · 67acb40
1 parent 809460e
commit 67acb40
Show file tree

Hide file tree

Showing 3 changed files with 80 additions and 40 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs
@@ -1190,31 +1190,38 @@ pPollNonce =
 --------------------------------------------------------------------------------
 
 pScriptWitnessFiles
-  :: forall witctx
-   . WitCtx witctx
+  :: forall witctx era
+   . ShelleyBasedEra era
+  -> WitCtx witctx
   -> BalanceTxExecUnits
   -- ^ Use the @execution-units@ flag.
   -> String
   -- ^ Script flag prefix
   -> Maybe String
   -> String
   -> Parser (ScriptWitnessFiles witctx)
-pScriptWitnessFiles witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help =
+pScriptWitnessFiles sbe witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help =
   toScriptWitnessFiles
     <$> pScriptFor
       (scriptFlagPrefix ++ "-script-file")
       ((++ "-script-file") <$> scriptFlagPrefixDeprecated)
       ("The file containing the script to witness " ++ help)
     <*> optional
       ( (,,)
-          <$> pScriptDatumOrFile scriptFlagPrefix witctx
+          <$> cip69Modification sbe
           <*> 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)
+
   toScriptWitnessFiles
     :: ScriptFile
     -> Maybe
@@ -1361,11 +1368,14 @@ pVoteFiles
 pVoteFiles sbe bExUnits =
   caseShelleyToBabbageOrConwayEraOnwards
     (const $ pure [])
-    (const . many $ pVoteFile bExUnits)
+    (const . many $ pVoteFile sbe bExUnits)
     sbe
 
-pVoteFile :: BalanceTxExecUnits -> Parser (VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))
-pVoteFile balExUnits =
+pVoteFile
+  :: ShelleyBasedEra era
+  -> BalanceTxExecUnits
+  -> Parser (VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))
+pVoteFile sbe balExUnits =
   (,)
     <$> pFileInDirection "vote-file" "Filepath of the vote."
     <*> optional (pVoteScriptOrReferenceScriptWitness balExUnits)
@@ -1374,11 +1384,13 @@ pVoteFile balExUnits =
     :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
   pVoteScriptOrReferenceScriptWitness bExUnits =
     pScriptWitnessFiles
+      sbe
       WitCtxStake
       bExUnits
       "vote"
       Nothing
       "a vote"
+      <|> pPlutusStakeReferenceScriptWitnessFilesVotingProposing "vote-" balExUnits
 
 pProposalFiles
   :: ShelleyBasedEra era
@@ -1387,12 +1399,14 @@ pProposalFiles
 pProposalFiles sbe balExUnits =
   caseShelleyToBabbageOrConwayEraOnwards
     (const $ pure [])
-    (const $ many (pProposalFile balExUnits))
+    (const $ many (pProposalFile sbe balExUnits))
     sbe
 
 pProposalFile
-  :: BalanceTxExecUnits -> Parser (ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))
-pProposalFile balExUnits =
+  :: ShelleyBasedEra era
+  -> BalanceTxExecUnits
+  -> Parser (ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))
+pProposalFile sbe balExUnits =
   (,)
     <$> pFileInDirection "proposal-file" "Filepath of the proposal."
     <*> optional (pProposingScriptOrReferenceScriptWitness balExUnits)
@@ -1401,11 +1415,13 @@ pProposalFile balExUnits =
     :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
   pProposingScriptOrReferenceScriptWitness bExUnits =
     pScriptWitnessFiles
+      sbe
       WitCtxStake
       bExUnits
       "proposal"
       Nothing
       "a proposal"
+      <|> pPlutusStakeReferenceScriptWitnessFilesVotingProposing "proposal-" balExUnits
 
 pCurrentTreasuryValueAndDonation
   :: ShelleyBasedEra era -> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
@@ -1567,9 +1583,10 @@ pTxBuildOutputOptions =
         )
 
 pCertificateFile
-  :: BalanceTxExecUnits
+  :: ShelleyBasedEra era
+  -> BalanceTxExecUnits
   -> Parser (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
-pCertificateFile balanceExecUnits =
+pCertificateFile sbe balanceExecUnits =
   (,)
     <$> ( fmap CertificateFile $
             asum
@@ -1589,6 +1606,7 @@ pCertificateFile balanceExecUnits =
     :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
   pCertifyingScriptOrReferenceScriptWit bExecUnits =
     pScriptWitnessFiles
+      sbe
       WitCtxStake
       balanceExecUnits
       "certificate"
@@ -1666,13 +1684,14 @@ pMetadataFile =
     ]
 
 pWithdrawal
-  :: BalanceTxExecUnits
+  :: ShelleyBasedEra era
+  -> BalanceTxExecUnits
   -> Parser
       ( StakeAddress
       , L.Coin
       , Maybe (ScriptWitnessFiles WitCtxStake)
       )
-pWithdrawal balance =
+pWithdrawal sbe balance =
   (\(stakeAddr, lovelace) maybeScriptFp -> (stakeAddr, lovelace, maybeScriptFp))
     <$> Opt.option
       (readerFromParsecParser parseWithdrawal)
@@ -1685,6 +1704,7 @@ pWithdrawal balance =
   pWithdrawalScriptOrReferenceScriptWit :: Parser (ScriptWitnessFiles WitCtxStake)
   pWithdrawalScriptOrReferenceScriptWit =
     pScriptWitnessFiles
+      sbe
       WitCtxStake
       balance
       "withdrawal"
@@ -1704,6 +1724,23 @@ pWithdrawal balance =
   parseWithdrawal =
     (,) <$> parseStakeAddress <* Parsec.char '+' <*> parseLovelace
 
+pPlutusStakeReferenceScriptWitnessFilesVotingProposing
+  :: String
+  -> BalanceTxExecUnits
+  -- ^ Use the @execution-units@ flag.
+  -> Parser (ScriptWitnessFiles WitCtxStake)
+pPlutusStakeReferenceScriptWitnessFilesVotingProposing prefix autoBalanceExecUnits =
+  PlutusReferenceScriptWitnessFiles
+    <$> pReferenceTxIn prefix "plutus"
+    <*> plutusP prefix PlutusScriptV3 "v3"
+    <*> pure NoScriptDatumOrFileForStake
+    <*> pScriptRedeemerOrFile (prefix ++ "reference-tx-in")
+    <*> ( case autoBalanceExecUnits of
+            AutoBalance -> pure (ExecutionUnits 0 0)
+            ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in"
+        )
+    <*> pure Nothing
+
 pPlutusStakeReferenceScriptWitnessFiles
   :: String
   -> BalanceTxExecUnits
@@ -1722,15 +1759,15 @@ pPlutusStakeReferenceScriptWitnessFiles prefix autoBalanceExecUnits =
     <*> pure Nothing
 
 pPlutusScriptLanguage :: String -> Parser AnyScriptLanguage
-pPlutusScriptLanguage prefix = plutusP PlutusScriptV2 "v2" <|> plutusP PlutusScriptV3 "v3"
- where
-  plutusP :: PlutusScriptVersion lang -> String -> Parser AnyScriptLanguage
-  plutusP plutusVersion versionString =
-    Opt.flag'
-      (AnyScriptLanguage $ PlutusScriptLanguage plutusVersion)
-      ( Opt.long (prefix <> "plutus-script-" <> versionString)
-          <> Opt.help ("Specify a plutus script " <> versionString <> " reference script.")
-      )
+pPlutusScriptLanguage prefix = plutusP prefix PlutusScriptV2 "v2" <|> plutusP prefix PlutusScriptV3 "v3"
+
+plutusP :: String -> PlutusScriptVersion lang -> String -> Parser AnyScriptLanguage
+plutusP prefix plutusVersion versionString =
+  Opt.flag'
+    (AnyScriptLanguage $ PlutusScriptLanguage plutusVersion)
+    ( Opt.long (prefix <> "plutus-script-" <> versionString)
+        <> Opt.help ("Specify a plutus script " <> versionString <> " reference script.")
+    )
 
 pUpdateProposalFile :: Parser UpdateProposalFile
 pUpdateProposalFile =
@@ -2236,6 +2273,7 @@ pTxIn sbe balance =
   pEmbeddedPlutusScriptWitness :: Parser (ScriptWitnessFiles WitCtxTxIn)
   pEmbeddedPlutusScriptWitness =
     pScriptWitnessFiles
+      sbe
       WitCtxTxIn
       balance
       "tx-in"
@@ -2405,9 +2443,10 @@ pRefScriptFp =
       <|> pure ReferenceScriptAnyEraNone
 
 pMintMultiAsset
-  :: BalanceTxExecUnits
+  :: ShelleyBasedEra era
+  -> BalanceTxExecUnits
   -> Parser (Value, [ScriptWitnessFiles WitCtxMint])
-pMintMultiAsset balanceExecUnits =
+pMintMultiAsset sbe balanceExecUnits =
   (,)
     <$> Opt.option
       (readerFromParsecParser parseValue)
@@ -2425,6 +2464,7 @@ pMintMultiAsset balanceExecUnits =
     :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint)
   pMintingScriptOrReferenceScriptWit bExecUnits =
     pScriptWitnessFiles
+      sbe
       WitCtxMint
       bExecUnits
       "mint"

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs
@@ -181,11 +181,11 @@ pTransactionBuildCmd era envCli = do
         <*> optional pTotalCollateral
         <*> many pTxOut
         <*> pChangeAddress
-        <*> optional (pMintMultiAsset AutoBalance)
+        <*> optional (pMintMultiAsset sbe AutoBalance)
         <*> optional pInvalidBefore
         <*> pInvalidHereafter sbe
-        <*> many (pCertificateFile AutoBalance)
-        <*> many (pWithdrawal AutoBalance)
+        <*> many (pCertificateFile sbe AutoBalance)
+        <*> many (pWithdrawal sbe AutoBalance)
         <*> pTxMetadataJsonSchema
         <*> many
           ( pScriptFor
@@ -239,11 +239,11 @@ pTransactionBuildEstimateCmd era _envCli = do
         <*> optional pReturnCollateral
         <*> many pTxOut
         <*> pChangeAddress
-        <*> optional (pMintMultiAsset ManualBalance)
+        <*> optional (pMintMultiAsset sbe ManualBalance)
         <*> optional pInvalidBefore
         <*> pInvalidHereafter sbe
-        <*> many (pCertificateFile ManualBalance)
-        <*> many (pWithdrawal ManualBalance)
+        <*> many (pCertificateFile sbe ManualBalance)
+        <*> many (pWithdrawal sbe ManualBalance)
         <*> optional pTotalCollateral
         <*> optional pReferenceScriptSize
         <*> pTxMetadataJsonSchema
@@ -282,12 +282,12 @@ pTransactionBuildRaw era =
       <*> optional pTotalCollateral
       <*> many pRequiredSigner
       <*> many pTxOut
-      <*> optional (pMintMultiAsset ManualBalance)
+      <*> optional (pMintMultiAsset era ManualBalance)
       <*> optional pInvalidBefore
       <*> pInvalidHereafter era
       <*> pTxFee
-      <*> many (pCertificateFile ManualBalance)
-      <*> many (pWithdrawal ManualBalance)
+      <*> many (pCertificateFile era ManualBalance)
+      <*> many (pWithdrawal era ManualBalance)
       <*> pTxMetadataJsonSchema
       <*> many (pScriptFor "auxiliary-script-file" Nothing "Filepath of auxiliary script(s)")
       <*> many pMetadataFile

diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs
@@ -361,11 +361,11 @@ pTransaction envCli =
       <*> optional pTotalCollateral
       <*> many pTxOut
       <*> pChangeAddress
-      <*> optional (pMintMultiAsset AutoBalance)
+      <*> optional (pMintMultiAsset ShelleyBasedEraConway AutoBalance)
       <*> optional pInvalidBefore
       <*> optional pLegacyInvalidHereafter
-      <*> many (pCertificateFile AutoBalance)
-      <*> many (pWithdrawal AutoBalance)
+      <*> many (pCertificateFile ShelleyBasedEraConway AutoBalance)
+      <*> many (pWithdrawal ShelleyBasedEraConway AutoBalance)
       <*> pTxMetadataJsonSchema
       <*> many
         ( pScriptFor
@@ -402,12 +402,12 @@ pTransaction envCli =
       <*> optional pTotalCollateral
       <*> many pRequiredSigner
       <*> many pTxOut
-      <*> optional (pMintMultiAsset ManualBalance)
+      <*> optional (pMintMultiAsset ShelleyBasedEraConway ManualBalance)
       <*> optional pInvalidBefore
       <*> optional pLegacyInvalidHereafter
       <*> pTxFee
-      <*> many (pCertificateFile ManualBalance)
-      <*> many (pWithdrawal ManualBalance)
+      <*> many (pCertificateFile ShelleyBasedEraConway ManualBalance)
+      <*> many (pWithdrawal ShelleyBasedEraConway ManualBalance)
       <*> pTxMetadataJsonSchema
       <*> many (pScriptFor "auxiliary-script-file" Nothing "Filepath of auxiliary script(s)")
       <*> many pMetadataFile