Remove listLenBound from EncCBORGroup class

f-f · f-f · commit cb5da85c2faf · 2025-11-05T15:23:38.000+02:00
diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/BlockBody/Internal.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/BlockBody/Internal.hs
@@ -177,7 +177,6 @@ instance Era era => EncCBORGroup (AlonzoBlockBody era) where
       BSL.toStrict $
         bodyBytes <> witsBytes <> metadataBytes <> invalidBytes
   listLen _ = 4
-  listLenBound _ = 4
 
 hashAlonzoSegWits ::
   BSL.ByteString ->
diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs
@@ -336,7 +336,6 @@ instance
   EncCBORGroup (AlonzoPlutusPurpose f era)
   where
   listLen _ = 2
-  listLenBound _ = 2
   encCBORGroup = \case
     AlonzoSpending p -> encodeWord8 0 <> encCBOR p
     AlonzoMinting p -> encodeWord8 1 <> encCBOR p
diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs
@@ -7,7 +7,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
@@ -126,6 +125,7 @@ import qualified Data.MapExtras as Map (fromElems)
 import Data.Maybe (mapMaybe)
 import Data.Set (Set)
 import qualified Data.Set as Set
+import Data.Typeable (Proxy (Proxy))
 import GHC.Generics (Generic)
 import Lens.Micro
 import NoThunks.Class (NoThunks)
@@ -152,8 +152,9 @@ instance AlonzoEraScript era => EncCBOR (RedeemersRaw era) where
       (encCBOR rs)
       (encodeFoldableEncoder keyValueEncoder $ Map.toAscList rs)
     where
+      keyValueEncoder :: (PlutusPurpose AsIx era, (Data era, ExUnits)) -> Encoding
       keyValueEncoder (ptr, (dats, exs)) =
-        encodeListLen (listLen ptr + 2)
+        encodeListLen (listLen (Proxy @(PlutusPurpose AsIx era)) + 2)
           <> encCBORGroup ptr
           <> encCBOR dats
           <> encCBOR exs
@@ -556,11 +557,14 @@ instance AlonzoEraScript era => DecCBOR (Annotator (RedeemersRaw era)) where
       decodeElement ::
         forall s. Decoder s (PlutusPurpose AsIx era, Annotator (Data era), ExUnits)
       decodeElement = do
-        decodeRecordNamed "Redeemer" (\(rdmrPtr, _, _) -> fromIntegral (listLen rdmrPtr) + 2) $ do
-          !redeemerPtr <- decCBORGroup
-          !redeemerData <- decCBOR
-          !redeemerExUnits <- decCBOR
-          pure (redeemerPtr, redeemerData, redeemerExUnits)
+        decodeRecordNamed
+          "Redeemer"
+          (\(_, _, _) -> fromIntegral (listLen (Proxy @(PlutusPurpose AsIx era))) + 2)
+          $ do
+            !redeemerPtr <- decCBORGroup
+            !redeemerData <- decCBOR
+            !redeemerExUnits <- decCBOR
+            pure (redeemerPtr, redeemerData, redeemerExUnits)
       {-# INLINE decodeElement #-}
   {-# INLINE decCBOR #-}
 
diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Annotator.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Annotator.hs
@@ -37,7 +37,7 @@ import Data.Maybe.Strict (maybeToStrictMaybe)
 import qualified Data.Sequence as Seq
 import qualified Data.Sequence.Strict as StrictSeq
 import qualified Data.Set as Set
-import Data.Typeable (Typeable)
+import Data.Typeable (Proxy (Proxy), Typeable)
 import Lens.Micro
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Mary.Binary.Annotator
@@ -235,11 +235,14 @@ instance AlonzoEraScript era => DecCBOR (RedeemersRaw era) where
       {-# INLINE decodeListRedeemers #-}
       decodeElement :: Decoder s (PlutusPurpose AsIx era, (Data era, ExUnits))
       decodeElement = do
-        decodeRecordNamed "Redeemer" (\(redeemerPtr, _) -> fromIntegral (listLen redeemerPtr) + 2) $ do
-          !redeemerPtr <- decCBORGroup
-          !redeemerData <- decCBOR
-          !redeemerExUnits <- decCBOR
-          pure (redeemerPtr, (redeemerData, redeemerExUnits))
+        decodeRecordNamed
+          "Redeemer"
+          (\(_, _) -> fromIntegral (listLen (Proxy @(PlutusPurpose AsIx era))) + 2)
+          $ do
+            !redeemerPtr <- decCBORGroup
+            !redeemerData <- decCBOR
+            !redeemerExUnits <- decCBOR
+            pure (redeemerPtr, (redeemerData, redeemerExUnits))
       {-# INLINE decodeElement #-}
   {-# INLINE decCBOR #-}
 
diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs
@@ -270,7 +270,6 @@ instance
   EncCBORGroup (ConwayPlutusPurpose f era)
   where
   listLen _ = 2
-  listLenBound _ = 2
   encCBORGroup = \case
     ConwaySpending p -> encodeWord8 0 <> encCBOR p
     ConwayMinting p -> encodeWord8 1 <> encCBOR p
diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Scripts.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Scripts.hs
@@ -157,7 +157,6 @@ instance
   EncCBORGroup (DijkstraPlutusPurpose f era)
   where
   listLen _ = 2
-  listLenBound _ = 2
   encCBORGroup = \case
     DijkstraSpending p -> encodeWord8 0 <> encCBOR p
     DijkstraMinting p -> encodeWord8 1 <> encCBOR p
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockBody/Internal.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockBody/Internal.hs
@@ -198,7 +198,6 @@ instance Era era => EncCBORGroup (ShelleyBlockBody era) where
       BSL.toStrict $
         bodyBytes <> witsBytes <> metadataBytes
   listLen _ = 3
-  listLenBound _ = 3
 
 hashShelleySegWits ::
   BSL.ByteString ->
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs
@@ -114,6 +114,7 @@ import Data.Map.Strict (Map)
 import Data.Maybe (isJust)
 import Data.Monoid (Sum (..))
 import qualified Data.Set as Set
+import Data.Typeable (Proxy (Proxy))
 import GHC.Generics (Generic)
 import Lens.Micro
 import NoThunks.Class (NoThunks (..))
@@ -435,7 +436,7 @@ encodeShelleyDelegCert = \case
 encodePoolCert :: PoolCert -> Encoding
 encodePoolCert = \case
   RegPool poolParams ->
-    encodeListLen (1 + listLen poolParams)
+    encodeListLen (1 + listLen (Proxy @StakePoolParams))
       <> encodeWord8 3
       <> encCBORGroup poolParams
   RetirePool vk epoch ->
diff --git a/libs/cardano-ledger-binary/CHANGELOG.md b/libs/cardano-ledger-binary/CHANGELOG.md
@@ -2,6 +2,8 @@
 
 ## 1.8.0.0
 
+* Remove `listLenBound` from `EncCBORGroup`
+* Change type of `listLen` in `EncCBORGroup` to accept a `Proxy` instead of a concrete value
 * Make `decodeAnnSet` fail when there are duplicates, starting with protocol version `12`.
 * Provide ability for `Annotator` to fail, by changing its type signature to return `Either` and adding `MonadFail` instance.
 * Remove `encodedSizeExpr` and `encodedListSizeExpr` from `EncCBOR`
diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/Coders.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/Coders.hs
@@ -76,7 +76,7 @@ import Data.Maybe.Strict (StrictMaybe (..))
 import Data.Set (Set, insert, member)
 import qualified Data.Set as Set
 import qualified Data.Text as Text
-import Data.Typeable (Proxy (..), Typeable, typeOf)
+import Data.Typeable (Proxy (Proxy), Typeable, typeOf)
 import Data.Void (Void)
 
 -- ====================================================================
@@ -410,7 +410,9 @@ x <! y = ApplyD x y
 -- | Infix form of @ApplyAnn@ with the same infixity and precedence as @($)@.
 (<*!) ::
   (Typeable a, Typeable t) =>
-  Decode w1 (Annotator (a -> t)) -> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
+  Decode w1 (Annotator (a -> t)) ->
+  Decode ('Closed d) (Annotator a) ->
+  Decode w1 (Annotator t)
 x <*! y = ApplyAnn x y
 {-# INLINE (<*!) #-}
 
@@ -425,7 +427,7 @@ hsize (SumD _) = 0
 hsize (RecD _) = 0
 hsize (KeyedD _) = 0
 hsize From = 1
-hsize FromGroup = fromIntegral $ listLenBound $ Proxy @t
+hsize FromGroup = fromIntegral $ listLen $ Proxy @t
 hsize (D _) = 1
 hsize (ApplyD f x) = hsize f + hsize x
 hsize (Invalid _) = 0
diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/Coders.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/Coders.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -69,6 +70,7 @@ import Cardano.Ledger.Binary.Encoding.Encoder (
  )
 import Cardano.Ledger.Binary.Group (EncCBORGroup (..))
 import Data.Maybe.Strict (StrictMaybe (SJust, SNothing))
+import Data.Typeable (Proxy (Proxy))
 
 -- ====================================================================
 
@@ -172,11 +174,11 @@ runE (Tag _ x) = runE x
 runE (Key _ x) = runE x
 runE (Keyed cn) = cn
 
-gsize :: Encode w t -> Word
+gsize :: forall w t. Encode w t -> Word
 gsize (Sum _ _) = 0
 gsize (Rec _) = 0
 gsize (To _) = 1
-gsize (ToGroup x) = listLen x
+gsize (ToGroup _) = listLen $ Proxy @t
 gsize (E _ _) = 1
 gsize (MapE _ x) = gsize x
 gsize (ApplyE f x) = gsize f + gsize x
diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Group.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Group.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Cardano.Ledger.Binary.Group (
   CBORGroup (..),
@@ -12,8 +14,7 @@ module Cardano.Ledger.Binary.Group (
 
 import Cardano.Ledger.Binary.Decoding
 import Cardano.Ledger.Binary.Encoding
-import Data.Proxy
-import Data.Typeable
+import Data.Typeable (Proxy (..), Typeable)
 
 --------------------------------------------------------------------------------
 -- CBORGroup
@@ -26,10 +27,11 @@ instance (DecCBORGroup a, EncCBORGroup a) => DecCBOR (CBORGroup a) where
   decCBOR = CBORGroup <$> groupRecord
 
 instance EncCBORGroup a => EncCBOR (CBORGroup a) where
-  encCBOR (CBORGroup x) = encodeListLen (listLen x) <> encCBORGroup x
+  encCBOR (CBORGroup x) = encodeListLen (listLen $ Proxy @a) <> encCBORGroup x
 
 groupRecord :: forall a s. (EncCBORGroup a, DecCBORGroup a) => Decoder s a
-groupRecord = decodeRecordNamed "CBORGroup" (fromIntegral . toInteger . listLen) decCBORGroup
+groupRecord =
+  decodeRecordNamed "CBORGroup" (fromIntegral . toInteger . const (listLen $ Proxy @a)) decCBORGroup
 
 --------------------------------------------------------------------------------
 -- EncCBORGroup
@@ -38,13 +40,10 @@ groupRecord = decodeRecordNamed "CBORGroup" (fromIntegral . toInteger . listLen)
 class EncCBORGroup a where
   encCBORGroup :: a -> Encoding
 
-  listLen :: a -> Word
+  listLen :: Proxy a -> Word
 
-  -- | an upper bound for 'listLen', used in 'Size' expressions.
-  listLenBound :: Proxy a -> Word
-
-listLenInt :: EncCBORGroup a => a -> Int
-listLenInt x = fromIntegral (listLen x)
+listLenInt :: forall a. EncCBORGroup a => a -> Int
+listLenInt _ = fromIntegral $ listLen $ Proxy @a
 
 --------------------------------------------------------------------------------
 -- DecCBORGroup
@@ -57,7 +56,6 @@ instance EncCBOR a => EncCBORGroup (a, a) where
   encCBORGroup (x, y) =
     encCBOR x <> encCBOR y
   listLen _ = 2
-  listLenBound _ = 2
 
 instance DecCBOR a => DecCBORGroup (a, a) where
   decCBORGroup = do
diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs
@@ -223,7 +223,6 @@ instance EncCBORGroup ProtVer where
   encCBORGroup (ProtVer x y) = encCBOR x <> encCBOR y
 
   listLen _ = 2
-  listLenBound _ = 2
 
 instance DecCBORGroup ProtVer where
   decCBORGroup = ProtVer <$> decCBOR <*> decCBOR
@@ -774,7 +773,6 @@ instance (DecCBOR a, Typeable r) => DecCBOR (Mismatch r a) where
 instance EncCBOR a => EncCBORGroup (Mismatch r a) where
   encCBORGroup Mismatch {..} = encCBOR mismatchSupplied <> encCBOR mismatchExpected
   listLen _ = 2
-  listLenBound _ = 2
 
 instance (Typeable r, DecCBOR a) => DecCBORGroup (Mismatch r a) where
   decCBORGroup = do
diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Block.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Block.hs
@@ -34,7 +34,7 @@ import Cardano.Ledger.TxIn (TxIn (..))
 import Data.Foldable (toList)
 import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.Typeable (Typeable)
+import Data.Typeable (Proxy (Proxy), Typeable)
 import GHC.Generics (Generic)
 import Lens.Micro ((^.))
 import NoThunks.Class (NoThunks (..))
@@ -69,7 +69,7 @@ instance
   EncCBOR (Block h era)
   where
   encCBOR (Block h txns) =
-    encodeListLen (1 + listLen txns) <> encCBOR h <> encCBORGroup txns
+    encodeListLen (1 + listLen (Proxy @(BlockBody era))) <> encCBOR h <> encCBORGroup txns
 
 instance
   forall era h.
diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Credential.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Credential.hs
@@ -307,7 +307,6 @@ instance EncCBORGroup Ptr where
       <> encCBOR txIx
       <> encCBOR certIx
   listLen _ = 3
-  listLenBound _ = 3
 
 instance DecCBORGroup Ptr where
   decCBORGroup = do
diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/State/StakePool.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/State/StakePool.hs
@@ -536,7 +536,6 @@ instance EncCBORGroup StakePoolParams where
       <> encCBOR (sppRelays poolParams)
       <> encodeNullStrictMaybe encCBOR (sppMetadata poolParams)
   listLen _ = 9
-  listLenBound _ = 9
 
 instance DecCBORGroup StakePoolParams where
   decCBORGroup = do
diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs
@@ -108,6 +108,7 @@ import Cardano.Slotting.Slot (WithOrigin (..))
 import Control.DeepSeq (NFData)
 import qualified Data.ByteString.Builder as BS
 import qualified Data.ByteString.Builder.Extra as BS
+import Data.Proxy (Proxy (Proxy))
 import Data.Word (Word32)
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks (..))
@@ -168,7 +169,7 @@ instance Crypto c => NoThunks (BHBody c)
 
 instance Crypto c => EncCBOR (BHBody c) where
   encCBOR bhBody =
-    encodeListLen (9 + listLen oc + listLen pv)
+    encodeListLen (9 + listLen (Proxy @(OCert c)) + listLen (Proxy @ProtVer))
       <> encCBOR (bheaderBlockNo bhBody)
       <> encCBOR (bheaderSlotNo bhBody)
       <> encCBOR (bheaderPrev bhBody)
diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/OCert.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/OCert.hs
@@ -106,17 +106,19 @@ instance Crypto c => NoThunks (OCert c)
 instance Crypto c => EncCBORGroup (OCert c) where
   encCBORGroup = fromPlainEncoding . encodeOCertFields
   listLen _ = 4
-  listLenBound _ = 4
 
 instance Crypto c => DecCBORGroup (OCert c) where
   decCBORGroup = fromPlainDecoder decodeOCertFields
 
 instance Crypto c => ToCBOR (OCert c) where
-  toCBOR ocert = Plain.encodeListLen (listLen ocert) <> encodeOCertFields ocert
+  toCBOR ocert = Plain.encodeListLen (listLen (Proxy @(OCert c))) <> encodeOCertFields ocert
 
 instance Crypto c => FromCBOR (OCert c) where
   fromCBOR =
-    Plain.decodeRecordNamed "OCert" (fromIntegral . listLen) decodeOCertFields
+    Plain.decodeRecordNamed
+      "OCert"
+      (fromIntegral . const (listLen (Proxy @(OCert c))))
+      decodeOCertFields
 
 encodeOCertFields :: Crypto c => OCert c -> Plain.Encoding
 encodeOCertFields ocert =
