From a2873b3225582ba3524cc52c8492a41afc47887b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= <clement.hurlin@moduscreate.com>
Date: Thu, 23 May 2024 14:42:10 +0200
Subject: [PATCH] Transaction view: show proposals and votes

---
 cardano-cli/cardano-cli.cabal                |  1 +
 cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 47 +++++++++++++++++++-
 2 files changed, 46 insertions(+), 2 deletions(-)

diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
index 487dd75fd4..960508c0db 100644
--- a/cardano-cli/cardano-cli.cabal
+++ b/cardano-cli/cardano-cli.cabal
@@ -241,6 +241,7 @@ library
                       , transformers-except ^>= 0.1.3
                       , unliftio-core
                       , utf8-string
+                      , vector
                       , yaml
 
 executable cardano-cli
diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs
index 310694a03f..b6935cd3e0 100644
--- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs
+++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators #-}
 
 -- | User-friendly pretty-printing for textual user interfaces (TUI)
@@ -36,7 +37,7 @@ import           Cardano.Api.Shelley (Address (ShelleyAddress), Hash (..),
                    fromShelleyStakeReference, toShelleyStakeCredential)
 
 import           Cardano.CLI.Types.MonadWarning (MonadWarning, eitherToWarning, runWarningIO)
-import           Cardano.Prelude (first)
+import           Cardano.Prelude (Foldable (..), first)
 
 import           Codec.CBOR.Encoding (Encoding)
 import           Codec.CBOR.FlatTerm (fromFlatTerm, toFlatTerm)
@@ -56,12 +57,16 @@ import qualified Data.Map.Strict as Map
 import           Data.Maybe (catMaybes, isJust, maybeToList)
 import           Data.Ratio (numerator)
 import qualified Data.Text as Text
+import qualified Data.Vector as Vector
 import           Data.Yaml (array)
 import           Data.Yaml.Pretty (setConfCompare)
 import qualified Data.Yaml.Pretty as Yaml
 import           GHC.Real (denominator)
 import           GHC.Unicode (isAlphaNum)
 
+{- HLINT ignore "Redundant bracket" -}
+{- HLINT ignore "Move brackets to avoid $" -}
+
 data FriendlyFormat = FriendlyJson | FriendlyYaml
 
 friendly ::
@@ -175,6 +180,8 @@ friendlyTxBodyImpl
       , txTotalCollateral
       , txReturnCollateral
       , txInsReference
+      , txProposalProcedures
+      , txVotingProcedures
       , txUpdateProposal
       , txValidityLowerBound
       , txValidityUpperBound
@@ -200,7 +207,43 @@ friendlyTxBodyImpl
                   , "update proposal" .= friendlyUpdateProposal txUpdateProposal
                   , "validity range" .= friendlyValidityRange era (txValidityLowerBound, txValidityUpperBound)
                   , "withdrawals" .= friendlyWithdrawals txWithdrawals
-                  ])
+                  ]) ++
+                (inEonForEra
+                  []
+                  (\(cOnwards :: ConwayEraOnwards era) ->
+                      case txProposalProcedures of
+                       Nothing -> []
+                       Just (Featured _ TxProposalProceduresNone) -> []
+                       Just (Featured _ (TxProposalProcedures lProposals _witnesses)) ->
+                         ["governance actions" .= (friendlyLedgerProposals cOnwards $ toList lProposals)])
+                      era)
+                    ++
+                (inEonForEra
+                  []
+                  (\cOnwards ->
+                    case txVotingProcedures of
+                       Nothing -> []
+                       Just (Featured _ TxVotingProceduresNone) -> []
+                       Just (Featured _ (TxVotingProcedures votes _witnesses)) ->
+                             ["votes" .= (friendlyVotingProcedures cOnwards votes)])
+                  era)
+  where
+    friendlyLedgerProposals :: ConwayEraOnwards era -> [L.ProposalProcedure (ShelleyLedgerEra era)] -> Aeson.Value
+    friendlyLedgerProposals cOnwards proposalProcedures =
+      Array $ Vector.fromList $ map (friendlyLedgerProposal cOnwards) proposalProcedures
+
+friendlyLedgerProposal :: ConwayEraOnwards era -> L.ProposalProcedure (ShelleyLedgerEra era) -> Aeson.Value
+friendlyLedgerProposal cOnwards proposalProcedure = object $ friendlyProposalImpl cOnwards (Proposal proposalProcedure)
+
+friendlyVotingProcedures :: ConwayEraOnwards era -> L.VotingProcedures (ShelleyLedgerEra era) -> Aeson.Value
+friendlyVotingProcedures cOnwards x = conwayEraOnwardsConstraints cOnwards $ toJSON x -- (L.VotingProcedures { L.unVotingProcedures = votesMap }) =
+  -- conwayEraOnwardsConstraints cOnwards $ array $ [
+  --   object $ [
+  --       "voter" .= toJSON voter
+  --     , "votes" .= undefined
+  --   ]
+  --   | (voter, votes) <- Map.toList votesMap
+  -- ]
 
 redeemerIfShelleyBased :: MonadWarning m => CardanoEra era -> TxBody era -> m [Aeson.Pair]
 redeemerIfShelleyBased era tb =