Propagate ProposalScriptWitness amongst the parser result types

IntersectMBO · Feb 6, 2025 · 9ad2eb8 · 9ad2eb8
1 parent 3ad103d
commit 9ad2eb8
Show file tree

Hide file tree

Showing 4 changed files with 22 additions and 25 deletions.
diff --git a/cardano-cli/cardano-cli.cabal b/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

diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs b/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]
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/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)
   }

diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs
@@ -103,6 +103,9 @@ import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Shelley as Api
 
 import qualified Cardano.Binary as CBOR
+import           Cardano.CLI.EraBased.Script.Proposal.Read
+import           Cardano.CLI.EraBased.Script.Proposal.Types (CliProposalScriptRequirements,
+                   ProposalScriptWitness)
 import           Cardano.CLI.EraBased.Script.Read.Common
 import           Cardano.CLI.EraBased.Script.Types
 import           Cardano.CLI.EraBased.Script.Vote.Read
@@ -854,16 +857,14 @@ data ConstitutionError
   deriving Show
 
 data ProposalError
-  = ProposalErrorFile (FileError TextEnvelopeError)
+  = ProposalErrorFile (FileError CliScriptWitnessError)
   | ProposalNotSupportedInEra AnyCardanoEra
-  | ProposalNotUnicodeError Text.UnicodeException
-  | ProposalErrorScriptWitness ScriptWitnessError
   deriving Show
 
 readTxGovernanceActions
   :: ShelleyBasedEra era
-  -> [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
-  -> IO (Either ProposalError [(Proposal era, Maybe (ScriptWitness WitCtxStake era))])
+  -> [(ProposalFile In, Maybe CliProposalScriptRequirements)]
+  -> IO (Either ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))])
 readTxGovernanceActions _ [] = return $ Right []
 readTxGovernanceActions era files = runExceptT $ do
   w <-
@@ -877,21 +878,12 @@ readTxGovernanceActions era files = runExceptT $ do
 
 readProposal
   :: ConwayEraOnwards era
-  -> (ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))
-  -> IO (Either ProposalError (Proposal era, Maybe (ScriptWitness WitCtxStake era)))
+  -> (ProposalFile In, Maybe CliProposalScriptRequirements)
+  -> IO (Either ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
 readProposal w (fp, mScriptWit) = do
-  prop <-
-    conwayEraOnwardsConstraints w $
-      first ProposalErrorFile <$> readFileTextEnvelope AsProposal fp
-  case mScriptWit of
-    Nothing -> pure $ (,Nothing) <$> prop
-    sWitFile -> do
-      let sbe = convert w
-      runExceptT $ do
-        sWit <-
-          firstExceptT ProposalErrorScriptWitness $
-            mapM (readScriptWitness sbe) sWitFile
-        hoistEither $ (,sWit) <$> prop
+  runExceptT $
+    firstExceptT ProposalErrorFile $
+      readProposalScriptWitness w (fp, mScriptWit)
 
 constitutionHashSourceToHash
   :: ()