From 27f66b9431191e8dd595d451919ddd199d9a1695 Mon Sep 17 00:00:00 2001
From: Mateusz Galazyn <mateusz.galazyn@iohk.io>
Date: Wed, 12 Jul 2023 15:56:11 +0200
Subject: [PATCH] Add setting of votes and proposals in TxBody

---
 .../Governance/Actions/ProposalProcedure.hs   |  2 +-
 cardano-api/internal/Cardano/Api/TxBody.hs    | 67 +++++++++++--------
 2 files changed, 39 insertions(+), 30 deletions(-)

diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs
index fe5432d36a..6763f8d4cb 100644
--- a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs
+++ b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs
@@ -57,7 +57,7 @@ data TxGovernanceActionSupportedInEra era where
 deriving instance Show (TxGovernanceActionSupportedInEra era)
 deriving instance Eq (TxGovernanceActionSupportedInEra era)
 
-governanceActionsSupportedInEra :: ShelleyBasedEra  era -> Maybe (TxGovernanceActionSupportedInEra era)
+governanceActionsSupportedInEra :: ShelleyBasedEra era -> Maybe (TxGovernanceActionSupportedInEra era)
 governanceActionsSupportedInEra ShelleyBasedEraShelley = Nothing
 governanceActionsSupportedInEra ShelleyBasedEraAllegra = Nothing
 governanceActionsSupportedInEra ShelleyBasedEraMary    = Nothing
diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs
index 9b52830371..ed2be776e2 100644
--- a/cardano-api/internal/Cardano/Api/TxBody.hs
+++ b/cardano-api/internal/Cardano/Api/TxBody.hs
@@ -2712,46 +2712,55 @@ fromLedgerTxBody
   -> TxBodyContent ViewTx era
 fromLedgerTxBody sbe scriptValidity body scriptdata mAux =
     TxBodyContent
-      { txIns              = fromLedgerTxIns               sbe body
-      , txInsCollateral    = fromLedgerTxInsCollateral     sbe body
-      , txInsReference     = fromLedgerTxInsReference      sbe body
-      , txOuts             = fromLedgerTxOuts              sbe body scriptdata
-      , txTotalCollateral  = fromLedgerTxTotalCollateral   sbe body
-      , txReturnCollateral = fromLedgerTxReturnCollateral  sbe body
-      , txFee              = fromLedgerTxFee               sbe body
-      , txValidityRange    = fromLedgerTxValidityRange     sbe body
-      , txWithdrawals      = fromLedgerTxWithdrawals       sbe body
-      , txCertificates     = fromLedgerTxCertificates      sbe body
-      , txUpdateProposal   = fromLedgerTxUpdateProposal    sbe body
-      , txMintValue        = fromLedgerTxMintValue         sbe body
-      , txExtraKeyWits     = fromLedgerTxExtraKeyWitnesses sbe body
-      , txProtocolParams   = ViewTx
+      { txIns               = fromLedgerTxIns               sbe body
+      , txInsCollateral     = fromLedgerTxInsCollateral     sbe body
+      , txInsReference      = fromLedgerTxInsReference      sbe body
+      , txOuts              = fromLedgerTxOuts              sbe body scriptdata
+      , txTotalCollateral   = fromLedgerTxTotalCollateral   sbe body
+      , txReturnCollateral  = fromLedgerTxReturnCollateral  sbe body
+      , txFee               = fromLedgerTxFee               sbe body
+      , txValidityRange     = fromLedgerTxValidityRange     sbe body
+      , txWithdrawals       = fromLedgerTxWithdrawals       sbe body
+      , txCertificates      = fromLedgerTxCertificates      sbe body
+      , txUpdateProposal    = fromLedgerTxUpdateProposal    sbe body
+      , txMintValue         = fromLedgerTxMintValue         sbe body
+      , txExtraKeyWits      = fromLedgerTxExtraKeyWitnesses sbe body
+      , txProtocolParams    = ViewTx
       , txMetadata
       , txAuxScripts
-      , txScriptValidity   = scriptValidity
+      , txScriptValidity    = scriptValidity
       , txGovernanceActions = fromLedgerProposalProcedure sbe body
-      , txVotes = error "fromLedgerTxBody.txVotes: TODO: Conway"
+      , txVotes             = fromLedgerTxVotes sbe body
       }
   where
     (txMetadata, txAuxScripts) = fromLedgerTxAuxiliaryData sbe mAux
 
--- TODO: Conway
+
 fromLedgerProposalProcedure
   :: ShelleyBasedEra era
   -> Ledger.TxBody (ShelleyLedgerEra era)
   -> TxGovernanceActions era
-fromLedgerProposalProcedure _ _bdy = TxGovernanceActionsNone
- where
-   _proposalProcedures
-     :: ShelleyBasedEra era
-     -> Ledger.TxBody (ShelleyLedgerEra era)
-     -> Seq.StrictSeq (Conway.ProposalProcedure era)
-   _proposalProcedures ShelleyBasedEraShelley _bdy = mempty
-   _proposalProcedures ShelleyBasedEraAllegra _bdy = mempty
-   _proposalProcedures ShelleyBasedEraMary _bdy = mempty
-   _proposalProcedures ShelleyBasedEraAlonzo _bdy = mempty
-   _proposalProcedures ShelleyBasedEraBabbage _bdy = mempty
-   _proposalProcedures ShelleyBasedEraConway _bdy = mempty
+fromLedgerProposalProcedure sbe body =
+  case governanceActionsSupportedInEra sbe of
+    Nothing     -> TxGovernanceActionsNone
+    Just gasice -> TxGovernanceActions gasice (getProposals gasice body)
+  where
+    getProposals :: TxGovernanceActionSupportedInEra era
+                 -> Ledger.TxBody (ShelleyLedgerEra era)
+                 -> [Proposal era]
+    getProposals GovernanceActionsSupportedInConwayEra body_ = fmap Proposal . toList $ body_ ^. L.proposalProceduresTxBodyL
+
+
+fromLedgerTxVotes :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) -> TxVotes era
+fromLedgerTxVotes sbe body =
+  case votesSupportedInEra sbe of
+    Nothing    -> TxVotesNone
+    Just vsice -> TxVotes vsice (getVotes vsice body)
+  where
+    getVotes :: TxVotesSupportedInEra era
+             -> Ledger.TxBody (ShelleyLedgerEra era)
+             -> [Vote era]
+    getVotes VotesSupportedInConwayEra body_ = fmap Vote . toList $ body_ ^. L.votingProceduresTxBodyL
 
 fromLedgerTxIns
   :: forall era.