[ADP-3212] Add voting certificates to primitive lib

lib/primitive/cardano-wallet-primitive.cabal

@@ -164,6 +164,7 @@ library
     Cardano.Wallet.Primitive.Types.Coin
     Cardano.Wallet.Primitive.Types.Coin.Gen
     Cardano.Wallet.Primitive.Types.DecentralizationLevel
+    Cardano.Wallet.Primitive.Types.DRep
     Cardano.Wallet.Primitive.Types.EpochNo
     Cardano.Wallet.Primitive.Types.EraInfo
     Cardano.Wallet.Primitive.Types.ExecutionUnitPrices

lib/primitive/lib/Cardano/Wallet/Primitive/Ledger/Read/Block.hs

@@ -87,7 +87,7 @@ pickWalletCertificates
 pickWalletCertificates xs = partitionEithers $ do
     x <- xs
     case x of
-        W.CertificateOfDelegation cert -> pure $ Left cert
+        W.CertificateOfDelegation _ cert -> pure $ Left cert
         W.CertificateOfPool cert -> pure $ Right cert
         _otherCerts -> []
 

lib/primitive/lib/Cardano/Wallet/Primitive/Ledger/Read/Tx/Features/Certificates.hs

@@ -40,10 +40,18 @@ import Cardano.Slotting.Slot
     ( EpochNo (..)
     )
 import Cardano.Wallet.Primitive.Types.Certificates
-    ( PoolCertificate (..)
+    ( Certificate (..)
+    , NonWalletCertificate (..)
+    , PoolCertificate (..)
     , PoolRegistrationCertificate (..)
     , PoolRetirementCertificate (..)
     )
+import Cardano.Wallet.Primitive.Types.DRep
+    ( DRep (..)
+    , DRepID (..)
+    , DRepKeyHash (..)
+    , DRepScriptHash (..)
+    )
 import Cardano.Wallet.Primitive.Types.Pool
     ( PoolId (PoolId)
     , PoolOwner (PoolOwner)
@@ -86,7 +94,9 @@ import GHC.Stack
 
 import qualified Cardano.Ledger.Api as Ledger
 import qualified Cardano.Ledger.BaseTypes as SL
+import qualified Cardano.Ledger.Conway.TxCert as Ledger
 import qualified Cardano.Ledger.Credential as SL
+import qualified Cardano.Ledger.DRep as Ledger
 import qualified Cardano.Ledger.Shelley.API as SL
 import qualified Cardano.Wallet.Primitive.Types.Certificates as W
 import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
@@ -124,24 +134,29 @@ fromConwayCert
 fromConwayCert = \case
     Ledger.RegPoolTxCert pp -> mkPoolRegistrationCertificate pp
     Ledger.RetirePoolTxCert pid en -> mkPoolRetirementCertificate pid en
-    Ledger.RegTxCert cred -> mkRegisterKeyCertificate cred
-    Ledger.UnRegTxCert cred -> mkDelegationNone cred
-    Ledger.RegDepositTxCert _ _ -> error "TODO: Conway, ADP-3065"
-    Ledger.UnRegDepositTxCert _ _ -> error "TODO: Conway, ADP-3065"
-    Ledger.DelegTxCert _ _ -> error "TODO: Conway delegation, ADP-3065"
-    {-
-        Ledger.DelegStakeTxCert delegator pool ->
-        W.CertificateOfDelegation
-            $ W.CertDelegateFull
-                (fromStakeCredential delegator)
-                (fromPoolKeyHash pool)
-    -}
-    Ledger.RegDepositDelegTxCert {} -> error "TODO: Conway, ADP-3065"
-    Ledger.AuthCommitteeHotKeyTxCert _ _ -> error "TODO: Conway other, ADP-3065"
-    Ledger.ResignCommitteeColdTxCert _ _ -> error "TODO: Conway other, ADP-3065"
-    Ledger.RegDRepTxCert {} -> error "TODO: Conway other, ADP-3065"
-    Ledger.UnRegDRepTxCert _ _ -> error "TODO: Conway other, ADP-3065"
-    _ -> error "impossible pattern"
+    Ledger.RegTxCert cred -> mkRegisterKeyCertificate Nothing cred
+    Ledger.UnRegTxCert cred -> mkDelegationNone Nothing cred
+    Ledger.RegDepositTxCert cred coin ->
+        mkRegisterKeyCertificate (Just $ fromLedgerCoin coin) cred
+    Ledger.UnRegDepositTxCert cred coin ->
+        mkDelegationNone (Just $ fromLedgerCoin coin) cred
+    Ledger.DelegTxCert cred delegatee ->
+        mkDelegationVoting Nothing cred delegatee
+    Ledger.RegDepositDelegTxCert cred delegatee coin ->
+        mkDelegationVoting (Just $ fromLedgerCoin coin) cred delegatee
+    Ledger.AuthCommitteeHotKeyTxCert _ _ ->
+        CertificateOther AuthCommitteeHotKey
+    Ledger.ResignCommitteeColdTxCert _ _ ->
+        CertificateOther ResignCommitteeColdKey
+    Ledger.RegDRepTxCert {} ->
+        CertificateOther RegDRep
+    Ledger.UnRegDRepTxCert _ _ ->
+        CertificateOther UnRegDRep
+    Ledger.UpdateDRepTxCert {} ->
+        CertificateOther UpdateDRep
+
+fromLedgerCoin :: HasCallStack => SL.Coin -> W.Coin
+fromLedgerCoin (SL.Coin c) = Coin.unsafeFromIntegral c
 
 mkShelleyCertsK
     :: ( Foldable t
@@ -178,17 +193,51 @@ mkPoolRetirementCertificate pid (EpochNo e) =
             , retirementEpoch = W.EpochNo $ fromIntegral e
             }
 
-mkRegisterKeyCertificate :: SL.Credential 'SL.Staking crypto -> W.Certificate
-mkRegisterKeyCertificate =
-    W.CertificateOfDelegation
+mkRegisterKeyCertificate
+    :: Maybe W.Coin
+    -> SL.Credential 'SL.Staking crypto
+    -> W.Certificate
+mkRegisterKeyCertificate deposit =
+    W.CertificateOfDelegation deposit
         . W.CertRegisterKey
         . fromStakeCredential
 
-mkDelegationNone :: SL.Credential 'SL.Staking crypto -> W.Certificate
-mkDelegationNone credentials =
-    W.CertificateOfDelegation
+mkDelegationNone
+    :: Maybe W.Coin
+    -> SL.Credential 'SL.Staking crypto
+    -> W.Certificate
+mkDelegationNone deposit credentials =
+    W.CertificateOfDelegation deposit
         $ W.CertDelegateNone (fromStakeCredential credentials)
 
+mkDelegationVoting
+    :: Maybe W.Coin
+    -> SL.Credential 'SL.Staking crypto
+    -> Ledger.Delegatee crypto
+    -> W.Certificate
+mkDelegationVoting deposit cred = \case
+    Ledger.DelegStake pool ->
+        W.CertificateOfDelegation deposit
+            $ W.CertVoteAndDelegate (fromStakeCredential cred)
+            (Just $ fromPoolKeyHash pool) Nothing
+    Ledger.DelegVote vote ->
+        W.CertificateOfDelegation deposit
+            $ W.CertVoteAndDelegate (fromStakeCredential cred)
+            Nothing (Just $ fromLedgerDRep vote)
+    Ledger.DelegStakeVote pool vote ->
+        W.CertificateOfDelegation deposit
+            $ W.CertVoteAndDelegate (fromStakeCredential cred)
+            (Just $ fromPoolKeyHash pool) (Just $ fromLedgerDRep vote)
+
+fromLedgerDRep :: Ledger.DRep crypto -> DRep
+fromLedgerDRep = \case
+    Ledger.DRepAlwaysAbstain -> Abstain
+    Ledger.DRepAlwaysNoConfidence -> NoConfidence
+    Ledger.DRepCredential (SL.ScriptHashObj (SL.ScriptHash scripthash)) ->
+        FromDRepID (DRepFromScriptHash (DRepScriptHash $ hashToBytes scripthash))
+    Ledger.DRepCredential (SL.KeyHashObj (SL.KeyHash keyhash)) ->
+        FromDRepID (DRepFromKeyHash (DRepKeyHash $ hashToBytes keyhash))
+
 fromShelleyCert
     :: ( Ledger.ShelleyEraTxCert era
        , Ledger.ProtVerAtMost era 8
@@ -197,12 +246,12 @@ fromShelleyCert
     => Ledger.TxCert era -> W.Certificate
 fromShelleyCert = \case
     Ledger.DelegStakeTxCert delegator pool ->
-        W.CertificateOfDelegation
-            $ W.CertDelegateFull
+        W.CertificateOfDelegation Nothing
+            $ W.CertVoteAndDelegate
                 (fromStakeCredential delegator)
-                (fromPoolKeyHash pool)
-    Ledger.RegTxCert cred -> mkRegisterKeyCertificate cred
-    Ledger.UnRegTxCert cred -> mkDelegationNone cred
+                (Just $ fromPoolKeyHash pool) Nothing
+    Ledger.RegTxCert cred -> mkRegisterKeyCertificate Nothing cred
+    Ledger.UnRegTxCert cred -> mkDelegationNone Nothing cred
     Ledger.RegPoolTxCert pp -> mkPoolRegistrationCertificate pp
     Ledger.RetirePoolTxCert pid en -> mkPoolRetirementCertificate pid en
     Ledger.GenesisDelegTxCert {} -> W.CertificateOther W.GenesisCertificate

lib/primitive/lib/Cardano/Wallet/Primitive/Types/Certificates.hs

@@ -8,6 +8,7 @@ module Cardano.Wallet.Primitive.Types.Certificates
     ( DelegationCertificate (..)
     , dlgCertAccount
     , dlgCertPoolId
+    , dlgCertVote
     , StakeKeyCertificate (..)
     , PoolCertificate (..)
     , getPoolCertificatePoolId
@@ -31,6 +32,9 @@ import Cardano.Slotting.Slot
 import Cardano.Wallet.Primitive.Types.Coin
     ( Coin
     )
+import Cardano.Wallet.Primitive.Types.DRep
+    ( DRep
+    )
 import Cardano.Wallet.Primitive.Types.EpochNo
     ( EpochNo
     )
@@ -74,23 +78,29 @@ import GHC.Generics
 
 data DelegationCertificate
     = CertDelegateNone RewardAccount
-    | CertDelegateFull RewardAccount PoolId
     | CertRegisterKey RewardAccount
+    | CertVoteAndDelegate RewardAccount (Maybe PoolId) (Maybe DRep)
     deriving (Generic, Show, Eq, Ord)
 
 instance NFData DelegationCertificate
 
 dlgCertAccount :: DelegationCertificate -> RewardAccount
 dlgCertAccount = \case
     CertDelegateNone acc -> acc
-    CertDelegateFull acc _ -> acc
     CertRegisterKey acc -> acc
+    CertVoteAndDelegate acc _ _ -> acc
 
 dlgCertPoolId :: DelegationCertificate -> Maybe PoolId
 dlgCertPoolId = \case
     CertDelegateNone{} -> Nothing
-    CertDelegateFull _ poolId -> Just poolId
     CertRegisterKey _ -> Nothing
+    CertVoteAndDelegate _ poolIdM _ -> poolIdM
+
+dlgCertVote :: DelegationCertificate -> Maybe DRep
+dlgCertVote = \case
+    CertDelegateNone{} -> Nothing
+    CertRegisterKey _ -> Nothing
+    CertVoteAndDelegate _ _ voteM -> voteM
 
 data StakeKeyCertificate
     = StakeKeyRegistration
@@ -165,24 +175,41 @@ instance Buildable PoolRetirementCertificate where
 data NonWalletCertificate
     = GenesisCertificate
     | MIRCertificate
+    | AuthCommitteeHotKey
+    | ResignCommitteeColdKey
+    | RegDRep
+    | UnRegDRep
+    | UpdateDRep
     deriving (Generic, Show, Read, Eq)
 
 instance ToText NonWalletCertificate where
     toText GenesisCertificate = "genesis"
     toText MIRCertificate = "mir"
+    toText AuthCommitteeHotKey = "auth_committee_hot_key"
+    toText ResignCommitteeColdKey = "resign_committee_cold_key"
+    toText RegDRep = "reg_DRep"
+    toText UnRegDRep = "unreg_DRep"
+    toText UpdateDRep = "update_DRep"
 
 instance FromText NonWalletCertificate where
     fromText "genesis" = Right GenesisCertificate
     fromText "mir" = Right MIRCertificate
+    fromText "auth_committee_hot_key" = Right AuthCommitteeHotKey
+    fromText "resign_committee_cold_key" = Right ResignCommitteeColdKey
+    fromText "reg_DRep" = Right RegDRep
+    fromText "unreg_DRep" = Right UnRegDRep
+    fromText "update_DRep" =  Right UpdateDRep
     fromText _ =
         Left
             $ TextDecodingError
-                "expecting either 'genesis' or 'mir' for NonWalletCertificate text value"
+                "expecting one of 'genesis', 'mir', 'auth_committee_hot_key'\
+                \, 'resign_committee_cold_key', 'reg_DRep', 'update_DRep' or \
+                \'unreg_DRep' for NonWalletCertificate text value"
 
 instance NFData NonWalletCertificate
 
 data Certificate
-    = CertificateOfDelegation DelegationCertificate
+    = CertificateOfDelegation (Maybe Coin) DelegationCertificate
     | CertificateOfPool PoolCertificate
     | CertificateOther NonWalletCertificate
     deriving (Generic, Show, Eq)