WIP

IntersectMBO · Jan 31, 2025 · c03622f · c03622f
1 parent a16d8c3
commit c03622f
Show file tree

Hide file tree

Showing 18 changed files with 405 additions and 200 deletions.
diff --git 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
@@ -121,9 +121,11 @@ library
     Cardano.CLI.EraBased.Script.Certificate.Types
     Cardano.CLI.EraBased.Script.Mint.Read
     Cardano.CLI.EraBased.Script.Mint.Types
+    Cardano.CLI.EraBased.Script.Read.Common
     Cardano.CLI.EraBased.Script.Spend.Read
     Cardano.CLI.EraBased.Script.Spend.Types
     Cardano.CLI.EraBased.Script.Types
+    Cardano.CLI.EraBased.Script.Vote.Read
     Cardano.CLI.EraBased.Script.Vote.Types
     Cardano.CLI.EraBased.Transaction.HashCheck
     Cardano.CLI.Helpers

diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs
@@ -25,6 +25,8 @@ 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.Types
+import           Cardano.CLI.EraBased.Script.Vote.Types (CliVoteScriptRequirements,
+                   VoteScriptWitness (..))
 import           Cardano.CLI.Parser
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
@@ -182,7 +184,7 @@ data CompatibleTransactionCmds era
       [TxOutAnyEra]
       !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)))
       !(Maybe (Featured ConwayEraOnwards era [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]))
-      ![(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
+      ![(VoteFile In, Maybe CliVoteScriptRequirements)]
       [WitnessSigningData]
       -- ^ Signing keys
       (Maybe NetworkId)
@@ -272,7 +274,7 @@ runCompatibleTransactionCmd
                 readVotingProceduresFiles w mVotes
             votingProcedures <-
               firstExceptT CompatibleVoteMergeError . hoistEither $
-                mkTxVotingProcedures votesAndWits
+                mkTxVotingProcedures [(v, vswScriptWitness <$> mSwit) | (v, mSwit) <- votesAndWits]
             return (prop, VotingProcedures w votingProcedures)
         )
         sbe

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs
@@ -28,6 +28,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.Spend.Types (CliSpendScriptRequirements)
+import           Cardano.CLI.EraBased.Script.Vote.Types
 import           Cardano.CLI.Orphans ()
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Governance
@@ -82,7 +83,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs
   , metadataFiles :: ![MetadataFile]
   , mProtocolParamsFile :: !(Maybe ProtocolParamsFile)
   , mUpdateProprosalFile :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)))
-  , voteFiles :: ![(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
+  , voteFiles :: ![(VoteFile In, Maybe CliVoteScriptRequirements)]
   , proposalFiles :: ![(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
   , currentTreasuryValueAndDonation :: !(Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
   , txBodyOutFile :: !(TxBodyFile Out)
@@ -128,7 +129,7 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs
   -- ^ Auxiliary scripts
   , metadataFiles :: ![MetadataFile]
   , mUpdateProposalFile :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)))
-  , voteFiles :: ![(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
+  , voteFiles :: ![(VoteFile In, Maybe CliVoteScriptRequirements)]
   , proposalFiles :: ![(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
   , treasuryDonation :: !(Maybe TxTreasuryDonation)
   , buildOutputOptions :: !TxBuildOutputOptions
@@ -178,7 +179,7 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs
   -- ^ Auxiliary scripts
   , metadataFiles :: ![MetadataFile]
   , mUpdateProposalFile :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)))
-  , voteFiles :: ![(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
+  , voteFiles :: ![(VoteFile In, Maybe CliVoteScriptRequirements)]
   , proposalFiles :: ![(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
   , currentTreasuryValueAndDonation :: !(Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
   , txBodyOutFile :: !(TxBodyFile Out)

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs
@@ -23,6 +23,8 @@ import qualified Cardano.CLI.EraBased.Script.Certificate.Types as Certifying
 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.EraBased.Script.Vote.Types (CliVoteScriptRequirements)
+import qualified Cardano.CLI.EraBased.Script.Vote.Types as Voting
 import           Cardano.CLI.Parser
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
@@ -1277,7 +1279,7 @@ pScriptDataOrFile dataFlagPrefix helpTextForValue helpTextForFile =
 pVoteFiles
   :: ShelleyBasedEra era
   -> BalanceTxExecUnits
-  -> Parser [(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
+  -> Parser [(VoteFile In, Maybe CliVoteScriptRequirements)]
 pVoteFiles sbe bExUnits =
   caseShelleyToBabbageOrConwayEraOnwards
     (const $ pure [])
@@ -1286,22 +1288,50 @@ pVoteFiles sbe bExUnits =
 
 pVoteFile
   :: BalanceTxExecUnits
-  -> Parser (VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))
+  -> Parser (VoteFile In, Maybe CliVoteScriptRequirements)
 pVoteFile balExUnits =
   (,)
     <$> pFileInDirection "vote-file" "Filepath of the vote."
     <*> optional (pVoteScriptOrReferenceScriptWitness balExUnits)
  where
   pVoteScriptOrReferenceScriptWitness
-    :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
+    :: BalanceTxExecUnits -> Parser CliVoteScriptRequirements
   pVoteScriptOrReferenceScriptWitness bExUnits =
-    pScriptWitnessFiles
-      WitCtxStake
+    pVoteScriptWitness
       bExUnits
       "vote"
       Nothing
       "a vote"
-      <|> pPlutusStakeReferenceScriptWitnessFilesVotingProposing "vote-" balExUnits
+      <|> pVoteReferencePlutusScriptWitness "vote-" balExUnits
+
+pVoteScriptWitness
+  :: BalanceTxExecUnits -> String -> Maybe String -> String -> Parser CliVoteScriptRequirements
+pVoteScriptWitness bExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help =
+  Voting.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
+              )
+      )
+
+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"
+        )
 
 pProposalFiles
   :: ShelleyBasedEra era

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs
@@ -16,7 +16,7 @@ import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Shelley
 
 import qualified Cardano.CLI.EraBased.Commands.Governance.Vote as Cmd
-import           Cardano.CLI.Read (readSingleVote)
+import           Cardano.CLI.EraBased.Script.Vote.Read
 import           Cardano.CLI.Run.Hash (carryHashChecks)
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.CmdError
@@ -108,8 +108,9 @@ runGovernanceVoteViewCmd
 
     shelleyBasedEraConstraints sbe $ do
       voteProcedures <-
-        fmap fst . firstExceptT GovernanceVoteCmdReadVoteFileError . newExceptT $
-          readSingleVote eon (voteFile, Nothing)
+        fmap fst $
+          firstExceptT GovernanceVoteCmdReadVoteFileError $
+            readVoteScriptWitness eon (voteFile, Nothing)
       firstExceptT GovernanceVoteCmdWriteError
         . newExceptT
         . ( case outFormat of

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
@@ -44,16 +44,17 @@ import           Cardano.Api.Shelley
 
 import qualified Cardano.Binary as CBOR
 import           Cardano.CLI.EraBased.Commands.Transaction
-                   (TransactionCalculateMinFeeCmdArgs (txBodyFile))
 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.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.Read.Common
 import           Cardano.CLI.EraBased.Script.Spend.Read
 import           Cardano.CLI.EraBased.Script.Spend.Types (SpendScriptWitness (..))
+import           Cardano.CLI.EraBased.Script.Vote.Types
 import           Cardano.CLI.EraBased.Transaction.HashCheck (checkCertificateHashes,
                    checkProposalHashes, checkVotingProcedureHashes)
 import           Cardano.CLI.Orphans ()
@@ -261,7 +262,7 @@ runTransactionBuildCmd
             (map mswScriptWitness $ snd usedToGetReferenceInputs)
             (mapMaybe snd certsAndMaybeScriptWits)
             withdrawalsAndMaybeScriptWits
-            votingProceduresAndMaybeScriptWits
+            (mapMaybe snd votingProceduresAndMaybeScriptWits)
             proposals
             readOnlyReferenceInputs
 
@@ -778,7 +779,7 @@ runTxBuildRaw
   -> TxMetadataInEra era
   -> Maybe (LedgerProtocolParameters era)
   -> TxUpdateProposal era
-  -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
+  -> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
   -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
   -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
   -> Either TxCmdError (TxBody era)
@@ -866,7 +867,7 @@ constructTxBodyContent
   -> TxAuxScripts era
   -> TxMetadataInEra era
   -> TxUpdateProposal era
-  -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
+  -> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
   -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
   -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
   -- ^ The current treasury value and the donation. This is a stop gap as the
@@ -903,7 +904,7 @@ constructTxBodyContent
               (map mswScriptWitness $ snd valuesWithScriptWits)
               (mapMaybe snd certsAndMaybeScriptWits)
               withdrawals
-              votingProcedures
+              (mapMaybe snd votingProcedures)
               proposals
               readOnlyRefIns
 
@@ -921,9 +922,9 @@ constructTxBodyContent
       validatedMintValue <- createTxMintValue sbe valuesWithScriptWits
       validatedTxScriptValidity <-
         first TxCmdNotSupportedInEraValidationError $ validateTxScriptValidity sbe mScriptValidity
-      validatedVotingProcedures <-
+      validatedVotingProcedures :: TxVotingProcedures BuildTx era <-
         first (TxCmdTxGovDuplicateVotes . TxGovDuplicateVotes) $
-          mkTxVotingProcedures @BuildTx (fromList votingProcedures)
+          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
@@ -1008,7 +1009,7 @@ runTxBuild
   -> TxMetadataInEra era
   -> TxUpdateProposal era
   -> Maybe Word
-  -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
+  -> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
   -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
   -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
   -- ^ The current treasury value and the donation.
@@ -1050,7 +1051,7 @@ runTxBuild
               (map mswScriptWitness $ snd valuesWithScriptWits)
               (mapMaybe snd certsAndMaybeScriptWits)
               withdrawals
-              votingProcedures
+              (mapMaybe snd votingProcedures)
               proposals
               readOnlyRefIns
 
@@ -1217,7 +1218,7 @@ getAllReferenceInputs
   -> [ScriptWitness WitCtxMint era]
   -> [ScriptWitness WitCtxStake era]
   -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
-  -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
+  -> [VoteScriptWitness era]
   -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
   -> [TxIn]
   -- ^ Read only reference inputs
@@ -1234,7 +1235,7 @@ getAllReferenceInputs
         mintingRefInputs = map getScriptWitnessReferenceInput mintWitnesses
         certsWitByRefInputs = map getScriptWitnessReferenceInput certScriptWitnesses
         withdrawalsWitByRefInputs = [getScriptWitnessReferenceInput sWit | (_, _, Just sWit) <- withdrawals]
-        votesWitByRefInputs = [getScriptWitnessReferenceInput sWit | (_, Just sWit) <- votingProceduresAndMaybeScriptWits]
+        votesWitByRefInputs = map (getScriptWitnessReferenceInput . vswScriptWitness) votingProceduresAndMaybeScriptWits
         propsWitByRefInputs = [getScriptWitnessReferenceInput sWit | (_, Just sWit) <- propProceduresAnMaybeScriptWits]
 
     concatMap

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs
@@ -13,9 +13,9 @@ import           Cardano.Api
 import           Cardano.Api.Shelley
 
 import           Cardano.CLI.EraBased.Script.Certificate.Types
+import           Cardano.CLI.EraBased.Script.Read.Common
 import           Cardano.CLI.EraBased.Script.Types
-import           Cardano.CLI.Read
-import           Cardano.CLI.Types.Common
+import           Cardano.CLI.Types.Common (CertificateFile)
 
 import           Control.Monad
 

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs
@@ -11,6 +11,7 @@ import           Cardano.Api
 import           Cardano.Api.Shelley
 
 import           Cardano.CLI.EraBased.Script.Mint.Types
+import           Cardano.CLI.EraBased.Script.Read.Common
 import           Cardano.CLI.EraBased.Script.Types
 import           Cardano.CLI.Read