Added ToCBOR and FromCBOR instances to Vote and GovernanceAction

IntersectMBO · Dec 2, 2022 · 52017ce · 52017ce
1 parent c9bf3e6
commit 52017ce
Show file tree

Hide file tree

Showing 4 changed files with 176 additions and 33 deletions.
diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Core.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Core.hs
@@ -1,34 +1,53 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Cardano.Ledger.Conway.Core
   ( ConwayEraTxBody (..),
     GovernanceActionInfo (..),
     GovernanceAction (..),
+    GovernanceActionIx,
     Vote (..),
     VoteDecision (..),
   )
 where
 
 import Cardano.Ledger.Babbage.Core (BabbageEraTxBody, Era (..), EraTxBody (..))
+import Cardano.Ledger.BaseTypes (ProtVer (..))
 import Cardano.Ledger.Binary (FromCBOR (..), ToCBOR (..))
+import Cardano.Ledger.Binary.Coders
+  ( Decode (..),
+    Encode (..),
+    decode,
+    encode,
+    (!>),
+    (<!),
+  )
+import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Core (EraPParams (..))
+import Cardano.Ledger.Credential (Credential)
+import Cardano.Ledger.Crypto (Crypto)
+import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
+import Cardano.Ledger.SafeHash (SafeHash)
+import Cardano.Ledger.Shelley.TxBody (Url)
+import Cardano.Ledger.TxIn (TxId)
 import Control.DeepSeq (NFData)
+import Data.ByteString (ByteString)
+import Data.Map.Strict (Map)
 import Data.Sequence.Strict (StrictSeq)
+import Data.Word (Word64)
 import GHC.Generics (Generic)
 import Lens.Micro (Lens')
 import NoThunks.Class (NoThunks)
-import Cardano.Ledger.Coin (Coin(..))
-import Cardano.Ledger.Keys (KeyHash(..), KeyRole (..))
-import Cardano.Ledger.Shelley.TxBody (Url)
-import Cardano.Ledger.SafeHash (SafeHash)
-import Data.ByteString (ByteString)
-import Cardano.Ledger.Core (EraPParams(..))
-import Cardano.Ledger.BaseTypes (TxIx(..), ProtVer (..))
-import Data.Map.Strict (Map)
-import Cardano.Ledger.Credential (Credential)
 
 class BabbageEraTxBody era => ConwayEraTxBody era where
   govActionsL :: Lens' (TxBody era) (StrictSeq (GovernanceActionInfo era))
@@ -53,8 +72,20 @@ instance NoThunks (PParamsUpdate era) => NoThunks (GovernanceActionInfo era)
 
 instance NFData (PParamsUpdate era) => NFData (GovernanceActionInfo era)
 
-instance Era era => FromCBOR (GovernanceActionInfo era) where
-  fromCBOR = undefined
+instance
+  ( Era era,
+    FromCBOR (PParamsUpdate era)
+  ) =>
+  FromCBOR (GovernanceActionInfo era)
+  where
+  fromCBOR =
+    decode $
+      RecD GovernanceActionInfo
+        <! From
+        <! From
+        <! From
+        <! From
+        <! From
 
 instance Era era => ToCBOR (GovernanceActionInfo era) where
   toCBOR = undefined
@@ -73,45 +104,148 @@ instance NoThunks (PParamsUpdate era) => NoThunks (GovernanceAction era)
 
 instance NFData (PParamsUpdate era) => NFData (GovernanceAction era)
 
+instance
+  ( Era era,
+    FromCBOR (PParamsUpdate era)
+  ) =>
+  FromCBOR (GovernanceAction era)
+  where
+  fromCBOR =
+    decode $
+      Summands "GovernanceAction" dec
+    where
+      dec 0 = ParameterChange <$> From
+      dec 1 = HardForkInitiation <$> From
+      dec 2 = TreasuryWithdrawals <$> From
+      dec k = Invalid k
+
+newtype GovernanceActionIx = GovernanceActionIx Word64
+  deriving (Generic, Eq, Show)
+
+instance NoThunks GovernanceActionIx
+
+instance NFData GovernanceActionIx
+
+deriving newtype instance FromCBOR GovernanceActionIx
+
+deriving newtype instance ToCBOR GovernanceActionIx
+
+data GovernanceActionId c = GovernanceActionId
+  { gaidTransactionId :: TxId c,
+    gaidGovActionIx :: GovernanceActionIx
+  }
+  deriving (Generic, Eq, Show)
+
+instance Crypto c => FromCBOR (GovernanceActionId c) where
+  fromCBOR =
+    decode $
+      RecD GovernanceActionId
+        <! From
+        <! From
+
+instance NoThunks (GovernanceActionId c)
+
+instance Crypto c => NFData (GovernanceActionId c)
+
 data Vote era = Vote
-  { voteGovActionID :: TxIx,
+  { voteGovActionId :: GovernanceActionId (EraCrypto era),
     voteRole :: VoterRole,
     voteRoleKeyHash :: KeyHash 'Voting (EraCrypto era),
     voteMetadataURL :: Url,
     voteMetadataHash :: SafeHash (EraCrypto era) ByteString,
     voteDecision :: VoteDecision
   }
-  deriving (Generic, Eq)
+  deriving (Generic, Eq, Show)
+
+instance NoThunks (Vote era)
+
+instance Crypto (EraCrypto era) => NFData (Vote era)
+
+instance
+  ( Era era,
+    Crypto (EraCrypto era)
+  ) =>
+  FromCBOR (Vote era)
+  where
+  fromCBOR =
+    decode $
+      RecD Vote
+        <! From
+        <! From
+        <! From
+        <! From
+        <! From
+        <! From
+
+instance Crypto c => ToCBOR (GovernanceActionId c) where
+  toCBOR GovernanceActionId {..} =
+    encode $
+      Rec GovernanceActionId
+        !> To gaidTransactionId
+        !> To gaidGovActionIx
+
+instance
+  ( Era era,
+    Crypto (EraCrypto era)
+  ) =>
+  ToCBOR (Vote era)
+  where
+  toCBOR Vote {..} =
+    encode $
+      Rec (Vote @era)
+        !> To voteGovActionId
+        !> To voteRole
+        !> To voteRoleKeyHash
+        !> To voteMetadataURL
+        !> To voteMetadataHash
+        !> To voteDecision
 
 data VoterRole
   = ConstitutionalCommittee
   | DRep
   | SPO
-  deriving (Generic, Eq)
+  deriving (Generic, Eq, Show, Enum)
+
+instance FromCBOR VoterRole where
+  fromCBOR =
+    decode $
+      Summands "VoterRole" dec
+    where
+      dec 0 = SumD ConstitutionalCommittee
+      dec 1 = SumD DRep
+      dec 2 = SumD SPO
+      dec k = Invalid k
+
+instance ToCBOR VoterRole where
+  toCBOR x =
+    encode $
+      Sum x (fromIntegral $ fromEnum x)
 
 instance NoThunks VoterRole
 
 instance NFData VoterRole
 
 data VoteDecision
-  = Yes
-  | No
+  = No
+  | Yes
   | Abstain
-  deriving (Generic, Eq)
+  deriving (Generic, Eq, Show, Enum)
 
 instance NoThunks VoteDecision
 
 instance NFData VoteDecision
 
-instance NoThunks (Vote era)
-
-instance NFData (Vote era)
-
-instance Show (Vote era) where
-  show = undefined
-
-instance Era era => FromCBOR (Vote era) where
-  fromCBOR = undefined
-
-instance Era era => ToCBOR (Vote era) where
-  toCBOR = undefined
+instance FromCBOR VoteDecision where
+  fromCBOR =
+    decode $
+      Summands "VoteDecision" dec
+    where
+      dec 0 = SumD No
+      dec 1 = SumD Yes
+      dec 2 = SumD Abstain
+      dec k = Invalid k
+
+instance ToCBOR VoteDecision where
+  toCBOR x =
+    encode $
+      Sum x (fromIntegral $ fromEnum x)
diff --git a/eras/conway/test-suite/cddl-files/conway.cddl b/eras/conway/test-suite/cddl-files/conway.cddl
@@ -90,6 +90,15 @@ hard_fork_initiation_action = protocol_version
 
 treasury_withdrawals_action = $addr_keyhash => coin
 
+vote =
+  [ governance_action_id : governance_action_id
+  ]
+
+governance_action_id =
+  [ transaction_id : $hash32
+  , governance_action_index : uint
+  ]
+
 required_signers = set<$addr_keyhash>
 
 transaction_input = [ transaction_id : $hash32

diff --git a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty/Conway.hs b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty/Conway.hs
@@ -15,7 +15,7 @@ where
 
 import Cardano.Ledger.Babbage.TxBody (BabbageEraTxBody (..))
 import Cardano.Ledger.Babbage.TxOut (BabbageTxOut (..))
-import Cardano.Ledger.Conway.Core (ConwayEraTxBody, Vote, GovernanceActionInfo (..))
+import Cardano.Ledger.Conway.Core (ConwayEraTxBody, GovernanceActionInfo (..), Vote)
 import Cardano.Ledger.Conway.Delegation.Certificates (ConwayDCert (..))
 import Cardano.Ledger.Conway.TxBody (ConwayTxBody (..))
 import Cardano.Ledger.Core (EraTxBody (..), EraTxOut (..), Value)

diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Fields.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Fields.hs
@@ -59,7 +59,7 @@ import Cardano.Ledger.BaseTypes
   )
 import Cardano.Ledger.Binary (sizedValue)
 import Cardano.Ledger.Coin (Coin (..))
-import Cardano.Ledger.Conway.Core (Vote, GovernanceActionInfo (..))
+import Cardano.Ledger.Conway.Core (GovernanceActionInfo (..), Vote)
 import Cardano.Ledger.Conway.Delegation.Certificates (transDCert)
 import Cardano.Ledger.Conway.TxBody (ConwayTxBody (..))
 import Cardano.Ledger.Core