Implement Enc/DecCBOR for PoolParams explicitly

rather than via `Enc/DecCBORGroup`

Author: teodanciu

eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs

@@ -77,10 +77,8 @@ module Cardano.Ledger.Shelley.TxCert (
 import Cardano.Ledger.BaseTypes (invalidKey, kindObject)
 import Cardano.Ledger.Binary (
   DecCBOR (decCBOR),
-  DecCBORGroup (..),
   Decoder,
   EncCBOR (..),
-  EncCBORGroup (..),
   Encoding,
   FromCBOR (..),
   ToCBOR (..),
@@ -90,7 +88,6 @@ import Cardano.Ledger.Binary (
   decodeWord,
   encodeListLen,
   encodeWord8,
-  listLenInt,
   peekTokenType,
  )
 import Cardano.Ledger.Coin (Coin (..), DeltaCoin)
@@ -105,7 +102,12 @@ import Cardano.Ledger.Internal.Era (AllegraEra, AlonzoEra, BabbageEra, MaryEra)
 import Cardano.Ledger.Keys (asWitness)
 import Cardano.Ledger.Shelley.Era (ShelleyEra)
 import Cardano.Ledger.Shelley.PParams ()
-import Cardano.Ledger.State (PoolParams (..))
+import Cardano.Ledger.State (
+  PoolParams (..),
+  decCBORGroupPoolParams,
+  encCBORGroupPoolParams,
+  poolParamsCount,
+ )
 import Cardano.Ledger.Val ((<+>), (<×>))
 import Control.DeepSeq (NFData (..), rwhnf)
 import Data.Aeson (ToJSON (..), (.=))
@@ -434,9 +436,9 @@ encodeShelleyDelegCert = \case
 encodePoolCert :: PoolCert -> Encoding
 encodePoolCert = \case
   RegPool poolParams ->
-    encodeListLen (1 + listLen poolParams)
+    encodeListLen (1 + fromIntegral poolParamsCount)
       <> encodeWord8 3
-      <> encCBORGroup poolParams
+      <> encCBORGroupPoolParams poolParams
   RetirePool vk epoch ->
     encodeListLen 3
       <> encodeWord8 4
@@ -504,8 +506,8 @@ shelleyTxCertDelegDecoder = \case
 poolTxCertDecoder :: EraTxCert era => Word -> Decoder s (Int, TxCert era)
 poolTxCertDecoder = \case
   3 -> do
-    group <- decCBORGroup
-    pure (1 + listLenInt group, RegPoolTxCert group)
+    group <- decCBORGroupPoolParams
+    pure (1 + fromIntegral poolParamsCount, RegPoolTxCert group)
   4 -> do
     a <- decCBOR
     b <- decCBOR

libs/cardano-ledger-core/CHANGELOG.md

@@ -2,6 +2,8 @@
 
 ## 1.19.0.0
 
+* Add `poolParamsCount`, `decCBORGroupPoolParams`, `encCBORGroupPoolParams` to `StakePool` module
+* Remove `DecCBORGroup` and `EncCBORGroup` instances for `PoolParams`
 * Remove the `UMap` module and the `umap` benchmarks cabal target.
 * Export `dRepToText`
 * Deprecated `bheader` and `bbody`

libs/cardano-ledger-core/src/Cardano/Ledger/State/StakePool.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -26,6 +27,9 @@
 module Cardano.Ledger.State.StakePool (
   -- * Stake Pool State
   StakePoolState (..),
+  decCBORGroupPoolParams,
+  encCBORGroupPoolParams,
+  poolParamsCount,
 
   -- * Lenses
   spsVrfL,
@@ -68,12 +72,11 @@ import Cardano.Ledger.BaseTypes (
   strictMaybeToMaybe,
  )
 import Cardano.Ledger.Binary (
-  CBORGroup (..),
   DecCBOR (..),
-  DecCBORGroup (..),
   DecShareCBOR (..),
+  Decoder,
   EncCBOR (..),
-  EncCBORGroup (..),
+  Encoding,
   decodeNullMaybe,
   decodeRecordNamed,
   decodeRecordSum,
@@ -381,8 +384,6 @@ data PoolParams = PoolParams
   , ppMetadata :: !(StrictMaybe PoolMetadata)
   }
   deriving (Show, Generic, Eq, Ord)
-  deriving (EncCBOR) via CBORGroup PoolParams
-  deriving (DecCBOR) via CBORGroup PoolParams
 
 ppVrfL :: Lens' PoolParams (VRFVerKeyHash 'StakePoolVRF)
 ppVrfL = lens ppVrf (\pp u -> pp {ppVrf = u})
@@ -452,40 +453,53 @@ data SizeOfPoolRelays = SizeOfPoolRelays
 instance EncCBOR SizeOfPoolRelays where
   encCBOR = error "The `SizeOfPoolRelays` type cannot be encoded!"
 
-instance EncCBORGroup PoolParams where
-  encCBORGroup poolParams =
-    encCBOR (ppId poolParams)
-      <> encCBOR (ppVrf poolParams)
-      <> encCBOR (ppPledge poolParams)
-      <> encCBOR (ppCost poolParams)
-      <> encCBOR (ppMargin poolParams)
-      <> encCBOR (ppRewardAccount poolParams)
-      <> encCBOR (ppOwners poolParams)
-      <> encCBOR (ppRelays poolParams)
-      <> encodeNullMaybe encCBOR (strictMaybeToMaybe (ppMetadata poolParams))
-  listLen _ = 9
-  listLenBound _ = 9
-
-instance DecCBORGroup PoolParams where
-  decCBORGroup = do
-    hk <- decCBOR
-    vrf <- decCBOR
-    pledge <- decCBOR
-    cost <- decCBOR
-    margin <- decCBOR
-    ra <- decCBOR
-    owners <- decCBOR
-    relays <- decCBOR
-    md <- decodeNullMaybe decCBOR
-    pure $
-      PoolParams
-        { ppId = hk
-        , ppVrf = vrf
-        , ppPledge = pledge
-        , ppCost = cost
-        , ppMargin = margin
-        , ppRewardAccount = ra
-        , ppOwners = owners
-        , ppRelays = relays
-        , ppMetadata = maybeToStrictMaybe md
-        }
+instance EncCBOR PoolParams where
+  encCBOR poolParams =
+    encodeListLen poolParamsCount
+      <> encCBORGroupPoolParams poolParams
+
+instance DecCBOR PoolParams where
+  decCBOR =
+    decodeRecordNamed
+      "CBORGroup"
+      (const (fromIntegral poolParamsCount))
+      decCBORGroupPoolParams
+
+poolParamsCount :: Word
+poolParamsCount = 9
+
+encCBORGroupPoolParams :: PoolParams -> Encoding
+encCBORGroupPoolParams PoolParams {..} =
+  encCBOR ppId
+    <> encCBOR ppVrf
+    <> encCBOR ppPledge
+    <> encCBOR ppCost
+    <> encCBOR ppMargin
+    <> encCBOR ppRewardAccount
+    <> encCBOR ppOwners
+    <> encCBOR ppRelays
+    <> encodeNullMaybe encCBOR (strictMaybeToMaybe ppMetadata)
+
+decCBORGroupPoolParams :: Decoder s PoolParams
+decCBORGroupPoolParams = do
+  hk <- decCBOR
+  vrf <- decCBOR
+  pledge <- decCBOR
+  cost <- decCBOR
+  margin <- decCBOR
+  ra <- decCBOR
+  owners <- decCBOR
+  relays <- decCBOR
+  md <- decodeNullMaybe decCBOR
+  pure $
+    PoolParams
+      { ppId = hk
+      , ppVrf = vrf
+      , ppPledge = pledge
+      , ppCost = cost
+      , ppMargin = margin
+      , ppRewardAccount = ra
+      , ppOwners = owners
+      , ppRelays = relays
+      , ppMetadata = maybeToStrictMaybe md
+      }