Updated makeShelleyTransactionBody with votes and governance actions

IntersectMBO · Jun 27, 2023 · 274112b · 274112b
1 parent 05acccc
commit 274112b
Showing 1 changed file with 48 additions and 1 deletion.
diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs
@@ -180,6 +180,10 @@ module Cardano.Api.TxBody (
 
     -- * Data family instances
     AsType(AsTxId, AsTxBody, AsByronTxBody, AsShelleyTxBody, AsMaryTxBody),
+
+    -- * Constraints
+    getCBORConstraint,
+    getLedgerEraConstraint,
   ) where
 
 import           Cardano.Api.Address
@@ -225,6 +229,7 @@ import qualified Cardano.Ledger.Block as Ledger
 import qualified Cardano.Ledger.Conway.Core as L
 import qualified Cardano.Ledger.Conway.Delegation.Certificates as Conway
 import qualified Cardano.Ledger.Conway.Governance as Conway
+import qualified Cardano.Ledger.Conway.Governance as Gov
 import qualified Cardano.Ledger.Core as Core
 import qualified Cardano.Ledger.Core as Ledger
 import qualified Cardano.Ledger.Credential as Shelley
@@ -3617,6 +3622,44 @@ convReferenceInputs txInsReference =
     TxInsReferenceNone -> mempty
     TxInsReference _ refTxins -> Set.fromList $ map toShelleyTxIn refTxins
 
+convGovActions :: ShelleyBasedEra era -> TxGovernanceActions era -> Seq.StrictSeq (Gov.ProposalProcedure (ShelleyLedgerEra era))
+convGovActions _ TxGovernanceActionsNone = Seq.empty
+convGovActions sbe (TxGovernanceActions _ govActions) =
+  Seq.fromList
+    [ createProposalProcedure sbe deposit stakeCred action
+    | (deposit, stakeCred, action) <- govActions
+    ]
+
+convVotes :: ShelleyBasedEra era -> TxVotes era -> Seq.StrictSeq (Gov.VotingProcedure (ShelleyLedgerEra era))
+convVotes _ TxVotesNone = Seq.empty
+convVotes sbe (TxVotes _ votes) =
+  Seq.fromList
+    [ createVotingProcedure sbe voteChoice voterType govActionIdentifier votingCred
+    | (voteChoice, voterType, govActionIdentifier, votingCred) <- votes
+    ]
+
+getCBORConstraint
+  :: ShelleyBasedEra era
+  -> (ToCBOR (Ledger.TxOut (ShelleyLedgerEra era)) => a)
+  -> a
+getCBORConstraint ShelleyBasedEraShelley f = f
+getCBORConstraint ShelleyBasedEraAllegra f = f
+getCBORConstraint ShelleyBasedEraMary f = f
+getCBORConstraint ShelleyBasedEraAlonzo f = f
+getCBORConstraint ShelleyBasedEraBabbage f = f
+getCBORConstraint ShelleyBasedEraConway f = f
+
+getLedgerEraConstraint
+  :: ShelleyBasedEra era
+  -> (Ledger.Era (ShelleyLedgerEra era) => a)
+  -> a
+getLedgerEraConstraint ShelleyBasedEraShelley f = f
+getLedgerEraConstraint ShelleyBasedEraAllegra f = f
+getLedgerEraConstraint ShelleyBasedEraMary f = f
+getLedgerEraConstraint ShelleyBasedEraAlonzo f = f
+getLedgerEraConstraint ShelleyBasedEraBabbage f = f
+getLedgerEraConstraint ShelleyBasedEraConway f = f
+
 guardShelleyTxInsOverflow :: [TxIn] -> Either TxBodyError ()
 guardShelleyTxInsOverflow txIns = do
     for_ txIns $ \txin@(TxIn _ (TxIx txix)) ->
@@ -3963,7 +4006,9 @@ makeShelleyTransactionBody era@ShelleyBasedEraConway
                              txWithdrawals,
                              txCertificates,
                              txMintValue,
-                             txScriptValidity
+                             txScriptValidity,
+                             txVotes,
+                             txGovernanceActions
                            } = do
 
     validateTxBodyContent era txbodycontent
@@ -3983,6 +4028,8 @@ makeShelleyTransactionBody era@ShelleyBasedEraConway
            & L.reqSignerHashesTxBodyL     .~ convExtraKeyWitnesses txExtraKeyWits
            & L.mintTxBodyL                .~ convMintValue txMintValue
            & L.scriptIntegrityHashTxBodyL .~ scriptIntegrityHash
+           & L.votingProceduresTxBodyL    .~ convVotes era txVotes
+           & L.proposalProceduresTxBodyL  .~ convGovActions era txGovernanceActions
            -- TODO Conway: support optional network id in TxBodyContent
            -- & L.networkIdTxBodyL .~ SNothing
         )