Merge pull request #1047 from IntersectMBO/jordan/remove-use-of-ScriptWitnessFiles-in-proposing-scripts

 Remove use of ScriptWitnessFiles in proposal scripts

Author: Jimbo4350

cardano-cli/cardano-cli.cabal

@@ -121,6 +121,8 @@ library
     Cardano.CLI.EraBased.Script.Certificate.Types
     Cardano.CLI.EraBased.Script.Mint.Read
     Cardano.CLI.EraBased.Script.Mint.Types
+    Cardano.CLI.EraBased.Script.Proposal.Read
+    Cardano.CLI.EraBased.Script.Proposal.Types
     Cardano.CLI.EraBased.Script.Read.Common
     Cardano.CLI.EraBased.Script.Spend.Read
     Cardano.CLI.EraBased.Script.Spend.Types

cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs

@@ -24,6 +24,7 @@ import           Cardano.CLI.EraBased.Options.Common hiding (pRefScriptFp, pTxOu
 import           Cardano.CLI.EraBased.Run.Transaction
 import           Cardano.CLI.EraBased.Script.Certificate.Read
 import           Cardano.CLI.EraBased.Script.Certificate.Types
+import           Cardano.CLI.EraBased.Script.Proposal.Types
 import           Cardano.CLI.EraBased.Script.Types
 import           Cardano.CLI.EraBased.Script.Vote.Types (CliVoteScriptRequirements,
                    VoteScriptWitness (..))
@@ -182,7 +183,7 @@ data CompatibleTransactionCmds era
       [TxIn]
       [TxOutAnyEra]
       !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)))
-      !(Maybe (Featured ConwayEraOnwards era [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]))
+      !(Maybe (Featured ConwayEraOnwards era [(ProposalFile In, Maybe CliProposalScriptRequirements)]))
       ![(VoteFile In, Maybe CliVoteScriptRequirements)]
       [WitnessSigningData]
       -- ^ Signing keys
@@ -354,7 +355,7 @@ readUpdateProposalFile (Featured sToB (Just updateProposalFile)) = do
     TxUpdateProposal _ proposal -> return $ ProtocolUpdate sToB proposal
 
 readProposalProcedureFile
-  :: Featured ConwayEraOnwards era [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
+  :: Featured ConwayEraOnwards era [(ProposalFile In, Maybe CliProposalScriptRequirements)]
   -> ExceptT CompatibleTransactionError IO (AnyProtocolUpdate era)
 readProposalProcedureFile (Featured cEraOnwards []) =
   let sbe = convert cEraOnwards
@@ -367,4 +368,5 @@ readProposalProcedureFile (Featured cEraOnwards proposals) = do
   return $
     conwayEraOnwardsConstraints cEraOnwards $
       ProposalProcedures cEraOnwards $
-        mkTxProposalProcedures [(govProp, mScriptWit) | (Proposal govProp, mScriptWit) <- props]
+        mkTxProposalProcedures
+          [(govProp, pswScriptWitness <$> mScriptWit) | (Proposal govProp, mScriptWit) <- props]

cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs

@@ -27,6 +27,7 @@ import           Cardano.Api.Shelley
 
 import           Cardano.CLI.EraBased.Script.Certificate.Types (CliCertificateScriptRequirements)
 import           Cardano.CLI.EraBased.Script.Mint.Types
+import           Cardano.CLI.EraBased.Script.Proposal.Types (CliProposalScriptRequirements)
 import           Cardano.CLI.EraBased.Script.Spend.Types (CliSpendScriptRequirements)
 import           Cardano.CLI.EraBased.Script.Vote.Types
 import           Cardano.CLI.Orphans ()
@@ -84,7 +85,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs
   , mProtocolParamsFile :: !(Maybe ProtocolParamsFile)
   , mUpdateProprosalFile :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)))
   , voteFiles :: ![(VoteFile In, Maybe CliVoteScriptRequirements)]
-  , proposalFiles :: ![(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
+  , proposalFiles :: ![(ProposalFile In, Maybe CliProposalScriptRequirements)]
   , currentTreasuryValueAndDonation :: !(Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
   , txBodyOutFile :: !(TxBodyFile Out)
   }
@@ -130,7 +131,7 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs
   , metadataFiles :: ![MetadataFile]
   , mUpdateProposalFile :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)))
   , voteFiles :: ![(VoteFile In, Maybe CliVoteScriptRequirements)]
-  , proposalFiles :: ![(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
+  , proposalFiles :: ![(ProposalFile In, Maybe CliProposalScriptRequirements)]
   , treasuryDonation :: !(Maybe TxTreasuryDonation)
   , buildOutputOptions :: !TxBuildOutputOptions
   }
@@ -180,7 +181,7 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs
   , metadataFiles :: ![MetadataFile]
   , mUpdateProposalFile :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)))
   , voteFiles :: ![(VoteFile In, Maybe CliVoteScriptRequirements)]
-  , proposalFiles :: ![(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
+  , proposalFiles :: ![(ProposalFile In, Maybe CliProposalScriptRequirements)]
   , currentTreasuryValueAndDonation :: !(Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
   , txBodyOutFile :: !(TxBodyFile Out)
   }

cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs

@@ -21,6 +21,8 @@ import           Cardano.CLI.Environment (EnvCli (..), envCliAnyEon)
 import           Cardano.CLI.EraBased.Script.Certificate.Types (CliCertificateScriptRequirements)
 import qualified Cardano.CLI.EraBased.Script.Certificate.Types as Certifying
 import           Cardano.CLI.EraBased.Script.Mint.Types
+import           Cardano.CLI.EraBased.Script.Proposal.Types (CliProposalScriptRequirements)
+import qualified Cardano.CLI.EraBased.Script.Proposal.Types as Proposing
 import           Cardano.CLI.EraBased.Script.Spend.Types (CliSpendScriptRequirements)
 import qualified Cardano.CLI.EraBased.Script.Spend.Types as PlutusSpend
 import           Cardano.CLI.EraBased.Script.Vote.Types (CliVoteScriptRequirements)
@@ -1302,7 +1304,7 @@ pVoteFile balExUnits =
       "vote"
       Nothing
       "a vote"
-      <|> pVoteReferencePlutusScriptWitness "vote-" balExUnits
+      <|> pVoteReferencePlutusScriptWitness "vote" balExUnits
 
 pVoteScriptWitness
   :: BalanceTxExecUnits -> String -> Maybe String -> String -> Parser CliVoteScriptRequirements
@@ -1324,19 +1326,20 @@ pVoteScriptWitness bExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help =
 pVoteReferencePlutusScriptWitness
   :: String -> BalanceTxExecUnits -> Parser CliVoteScriptRequirements
 pVoteReferencePlutusScriptWitness prefix autoBalanceExecUnits =
-  Voting.createPlutusReferenceScriptFromCliArgs
-    <$> pReferenceTxIn prefix "plutus"
-    <*> plutusP prefix PlutusScriptV3 "v3"
-    <*> pScriptRedeemerOrFile (prefix ++ "reference-tx-in")
-    <*> ( case autoBalanceExecUnits of
-            AutoBalance -> pure (ExecutionUnits 0 0)
-            ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in"
-        )
+  let appendedPrefix = prefix ++ "-"
+   in Voting.createPlutusReferenceScriptFromCliArgs
+        <$> pReferenceTxIn appendedPrefix "plutus"
+        <*> plutusP appendedPrefix PlutusScriptV3 "v3"
+        <*> pScriptRedeemerOrFile (appendedPrefix ++ "reference-tx-in")
+        <*> ( case autoBalanceExecUnits of
+                AutoBalance -> pure (ExecutionUnits 0 0)
+                ManualBalance -> pExecutionUnits $ appendedPrefix ++ "reference-tx-in"
+            )
 
 pProposalFiles
   :: ShelleyBasedEra era
   -> BalanceTxExecUnits
-  -> Parser [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
+  -> Parser [(ProposalFile In, Maybe CliProposalScriptRequirements)]
 pProposalFiles sbe balExUnits =
   caseShelleyToBabbageOrConwayEraOnwards
     (const $ pure [])
@@ -1345,22 +1348,51 @@ pProposalFiles sbe balExUnits =
 
 pProposalFile
   :: BalanceTxExecUnits
-  -> Parser (ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))
+  -> Parser (ProposalFile In, Maybe CliProposalScriptRequirements)
 pProposalFile balExUnits =
   (,)
     <$> pFileInDirection "proposal-file" "Filepath of the proposal."
     <*> optional (pProposingScriptOrReferenceScriptWitness balExUnits)
  where
   pProposingScriptOrReferenceScriptWitness
-    :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
+    :: BalanceTxExecUnits -> Parser CliProposalScriptRequirements
   pProposingScriptOrReferenceScriptWitness bExUnits =
-    pScriptWitnessFiles
-      WitCtxStake
+    pProposalScriptWitness
       bExUnits
       "proposal"
       Nothing
       "a proposal"
-      <|> pPlutusStakeReferenceScriptWitnessFilesVotingProposing "proposal-" balExUnits
+      <|> pProposalReferencePlutusScriptWitness "proposal" balExUnits
+
+pProposalScriptWitness
+  :: BalanceTxExecUnits -> String -> Maybe String -> String -> Parser CliProposalScriptRequirements
+pProposalScriptWitness bExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help =
+  Proposing.createSimpleOrPlutusScriptFromCliArgs
+    <$> pScriptFor
+      (scriptFlagPrefix ++ "-script-file")
+      ((++ "-script-file") <$> scriptFlagPrefixDeprecated)
+      ("The file containing the script to witness " ++ help)
+    <*> optional
+      ( (,)
+          <$> pScriptRedeemerOrFile scriptFlagPrefix
+          <*> ( case bExecUnits of
+                  AutoBalance -> pure (ExecutionUnits 0 0)
+                  ManualBalance -> pExecutionUnits scriptFlagPrefix
+              )
+      )
+
+pProposalReferencePlutusScriptWitness
+  :: String -> BalanceTxExecUnits -> Parser CliProposalScriptRequirements
+pProposalReferencePlutusScriptWitness prefix autoBalanceExecUnits =
+  let appendedPrefix = prefix ++ "-"
+   in Proposing.createPlutusReferenceScriptFromCliArgs
+        <$> pReferenceTxIn appendedPrefix "plutus"
+        <*> plutusP appendedPrefix PlutusScriptV3 "v3"
+        <*> pScriptRedeemerOrFile (appendedPrefix ++ "reference-tx-in")
+        <*> ( case autoBalanceExecUnits of
+                AutoBalance -> pure (ExecutionUnits 0 0)
+                ManualBalance -> pExecutionUnits $ appendedPrefix ++ "reference-tx-in"
+            )
 
 pCurrentTreasuryValueAndDonation
   :: ShelleyBasedEra era -> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
@@ -1527,7 +1559,7 @@ pCertificateFile balanceExecUnits =
       "certificate"
       Nothing
       "the use of the certificate."
-      <|> pCertificateReferencePlutusScriptWitness "certificate-" bExecUnits
+      <|> pCertificateReferencePlutusScriptWitness "certificate" bExecUnits
 
   helpText =
     mconcat
@@ -1556,14 +1588,15 @@ pCertificatePlutusScriptWitness bExecUnits scriptFlagPrefix scriptFlagPrefixDepr
 pCertificateReferencePlutusScriptWitness
   :: String -> BalanceTxExecUnits -> Parser CliCertificateScriptRequirements
 pCertificateReferencePlutusScriptWitness prefix autoBalanceExecUnits =
-  Certifying.createPlutusReferenceScriptFromCliArgs
-    <$> pReferenceTxIn prefix "plutus"
-    <*> pPlutusScriptLanguage prefix
-    <*> pScriptRedeemerOrFile (prefix ++ "reference-tx-in")
-    <*> ( case autoBalanceExecUnits of
-            AutoBalance -> pure (ExecutionUnits 0 0)
-            ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in"
-        )
+  let appendedPrefix = prefix ++ "-"
+   in Certifying.createPlutusReferenceScriptFromCliArgs
+        <$> pReferenceTxIn appendedPrefix "plutus"
+        <*> pPlutusScriptLanguage appendedPrefix
+        <*> pScriptRedeemerOrFile (appendedPrefix ++ "reference-tx-in")
+        <*> ( case autoBalanceExecUnits of
+                AutoBalance -> pure (ExecutionUnits 0 0)
+                ManualBalance -> pExecutionUnits $ appendedPrefix ++ "reference-tx-in"
+            )
 
 pPoolMetadataFile :: Parser (StakePoolMetadataFile In)
 pPoolMetadataFile =
@@ -1633,7 +1666,7 @@ pWithdrawal balance =
       "withdrawal"
       Nothing
       "the withdrawal of rewards."
-      <|> pPlutusStakeReferenceScriptWitnessFiles "withdrawal-" balance
+      <|> pPlutusStakeReferenceScriptWitnessFiles "withdrawal" balance
 
   helpText =
     mconcat
@@ -1667,15 +1700,16 @@ pPlutusStakeReferenceScriptWitnessFiles
   -> BalanceTxExecUnits
   -> Parser (ScriptWitnessFiles WitCtxStake)
 pPlutusStakeReferenceScriptWitnessFiles prefix autoBalanceExecUnits =
-  PlutusReferenceScriptWitnessFiles
-    <$> pReferenceTxIn prefix "plutus"
-    <*> pPlutusScriptLanguage prefix
-    <*> pure NoScriptDatumOrFileForStake
-    <*> pScriptRedeemerOrFile (prefix ++ "reference-tx-in")
-    <*> ( case autoBalanceExecUnits of
-            AutoBalance -> pure (ExecutionUnits 0 0)
-            ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in"
-        )
+  let appendedPrefix = prefix ++ "-"
+   in PlutusReferenceScriptWitnessFiles
+        <$> pReferenceTxIn appendedPrefix "plutus"
+        <*> pPlutusScriptLanguage appendedPrefix
+        <*> pure NoScriptDatumOrFileForStake
+        <*> pScriptRedeemerOrFile (appendedPrefix ++ "reference-tx-in")
+        <*> ( case autoBalanceExecUnits of
+                AutoBalance -> pure (ExecutionUnits 0 0)
+                ManualBalance -> pExecutionUnits $ appendedPrefix ++ "reference-tx-in"
+            )
 
 pPlutusScriptLanguage :: String -> Parser AnyPlutusScriptVersion
 pPlutusScriptLanguage prefix = plutusP prefix PlutusScriptV2 "v2" <|> plutusP prefix PlutusScriptV3 "v3"

cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs

@@ -51,6 +51,7 @@ import           Cardano.CLI.EraBased.Script.Certificate.Read
 import           Cardano.CLI.EraBased.Script.Certificate.Types (CertificateScriptWitness (..))
 import           Cardano.CLI.EraBased.Script.Mint.Read
 import           Cardano.CLI.EraBased.Script.Mint.Types
+import           Cardano.CLI.EraBased.Script.Proposal.Types (ProposalScriptWitness (..))
 import           Cardano.CLI.EraBased.Script.Read.Common
 import           Cardano.CLI.EraBased.Script.Spend.Read
 import           Cardano.CLI.EraBased.Script.Spend.Types (SpendScriptWitness (..))
@@ -263,7 +264,7 @@ runTransactionBuildCmd
             (mapMaybe snd certsAndMaybeScriptWits)
             withdrawalsAndMaybeScriptWits
             (mapMaybe snd votingProceduresAndMaybeScriptWits)
-            proposals
+            (mapMaybe snd proposals)
             readOnlyReferenceInputs
 
     let inputsThatRequireWitnessing = [input | (input, _) <- txins]
@@ -780,7 +781,7 @@ runTxBuildRaw
   -> Maybe (LedgerProtocolParameters era)
   -> TxUpdateProposal era
   -> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-  -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
+  -> [(Proposal era, Maybe (ProposalScriptWitness era))]
   -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
   -> Either TxCmdError (TxBody era)
 runTxBuildRaw
@@ -868,7 +869,7 @@ constructTxBodyContent
   -> TxMetadataInEra era
   -> TxUpdateProposal era
   -> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-  -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
+  -> [(Proposal era, Maybe (ProposalScriptWitness era))]
   -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
   -- ^ The current treasury value and the donation. This is a stop gap as the
   -- semantics of the donation and treasury value depend on the script languages
@@ -905,7 +906,7 @@ constructTxBodyContent
               (mapMaybe snd certsAndMaybeScriptWits)
               withdrawals
               (mapMaybe snd votingProcedures)
-              proposals
+              (mapMaybe snd proposals)
               readOnlyRefIns
 
       validatedCollateralTxIns <- validateTxInsCollateral sbe txinsc
@@ -927,7 +928,10 @@ constructTxBodyContent
           mkTxVotingProcedures [(v, vswScriptWitness <$> mSwit) | (v, mSwit) <- votingProcedures]
       let txProposals = forShelleyBasedEraInEonMaybe sbe $ \w -> do
             let txp :: TxProposalProcedures BuildTx era
-                txp = conwayEraOnwardsConstraints w $ mkTxProposalProcedures $ map (first unProposal) proposals
+                txp =
+                  conwayEraOnwardsConstraints w $
+                    mkTxProposalProcedures $
+                      [(unProposal prop, pswScriptWitness <$> mSwit) | (prop, mSwit) <- proposals]
             Featured w txp
       validatedCurrentTreasuryValue <-
         first
@@ -1010,7 +1014,7 @@ runTxBuild
   -> TxUpdateProposal era
   -> Maybe Word
   -> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-  -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
+  -> [(Proposal era, Maybe (ProposalScriptWitness era))]
   -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
   -- ^ The current treasury value and the donation.
   -> ExceptT TxCmdError IO (BalancedTxBody era)
@@ -1052,7 +1056,7 @@ runTxBuild
               (mapMaybe snd certsAndMaybeScriptWits)
               withdrawals
               (mapMaybe snd votingProcedures)
-              proposals
+              (mapMaybe snd proposals)
               readOnlyRefIns
 
       let allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ txinsc
@@ -1196,7 +1200,7 @@ getAllReferenceInputs
   -> [ScriptWitness WitCtxStake era]
   -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
   -> [VoteScriptWitness era]
-  -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
+  -> [ProposalScriptWitness era]
   -> [TxIn]
   -- ^ Read only reference inputs
   -> [TxIn]
@@ -1213,7 +1217,7 @@ getAllReferenceInputs
         certsWitByRefInputs = map getScriptWitnessReferenceInput certScriptWitnesses
         withdrawalsWitByRefInputs = [getScriptWitnessReferenceInput sWit | (_, _, Just sWit) <- withdrawals]
         votesWitByRefInputs = map (getScriptWitnessReferenceInput . vswScriptWitness) votingProceduresAndMaybeScriptWits
-        propsWitByRefInputs = [getScriptWitnessReferenceInput sWit | (_, Just sWit) <- propProceduresAnMaybeScriptWits]
+        propsWitByRefInputs = map (getScriptWitnessReferenceInput . pswScriptWitness) propProceduresAnMaybeScriptWits
 
     concatMap
       catMaybes