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,7 @@ 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 (..), poolParamsCount)
 import Cardano.Ledger.Val ((<+>), (<×>))
 import Control.DeepSeq (NFData (..), rwhnf)
 import Data.Aeson (ToJSON (..), (.=))
@@ -434,9 +431,9 @@ encodeShelleyDelegCert = \case
 encodePoolCert :: PoolCert -> Encoding
 encodePoolCert = \case
   RegPool poolParams ->
-    encodeListLen (1 + listLen poolParams)
+    encodeListLen (1 + poolParamsCount)
       <> encodeWord8 3
-      <> encCBORGroup poolParams
+      <> encCBOR poolParams
   RetirePool vk epoch ->
     encodeListLen 3
       <> encodeWord8 4
@@ -504,8 +501,8 @@ shelleyTxCertDelegDecoder = \case
 poolTxCertDecoder :: EraTxCert era => Word -> Decoder s (Int, TxCert era)
 poolTxCertDecoder = \case
   3 -> do
-    group <- decCBORGroup
-    pure (1 + listLenInt group, RegPoolTxCert group)
+    poolParams <- decCBOR
+    pure (1 + (fromIntegral poolParamsCount), RegPoolTxCert poolParams)
   4 -> do
     a <- decCBOR
     b <- decCBOR

libs/cardano-ledger-core/CHANGELOG.md

@@ -2,6 +2,8 @@
 
 ## 1.19.0.0
 
+* Add `poolParamsCount` 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,7 @@
 module Cardano.Ledger.State.StakePool (
   -- * Stake Pool State
   StakePoolState (..),
+  poolParamsCount,
 
   -- * Lenses
   spsVrfL,
@@ -68,12 +70,9 @@ import Cardano.Ledger.BaseTypes (
   strictMaybeToMaybe,
  )
 import Cardano.Ledger.Binary (
-  CBORGroup (..),
   DecCBOR (..),
-  DecCBORGroup (..),
   DecShareCBOR (..),
   EncCBOR (..),
-  EncCBORGroup (..),
   decodeNullMaybe,
   decodeRecordNamed,
   decodeRecordSum,
@@ -381,8 +380,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 +449,47 @@ 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
-        }
+poolParamsCount :: Word
+poolParamsCount = 9
+
+instance EncCBOR PoolParams where
+  encCBOR PoolParams {..} =
+    encodeListLen poolParamsCount
+      <> encCBOR ppId
+      <> encCBOR ppVrf
+      <> encCBOR ppPledge
+      <> encCBOR ppCost
+      <> encCBOR ppMargin
+      <> encCBOR ppRewardAccount
+      <> encCBOR ppOwners
+      <> encCBOR ppRelays
+      <> encodeNullMaybe encCBOR (strictMaybeToMaybe ppMetadata)
+
+instance DecCBOR PoolParams where
+  decCBOR =
+    decodeRecordNamed
+      "CBORGroup"
+      (const (fromIntegral poolParamsCount))
+      ( 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
+              }
+      )