Remove listLenBound from EncCBORGroup class

f-f · f-f · commit 193bf3886452 · 2025-11-06T16:19:15.000+01: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
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingVia #-}
@@ -7,7 +8,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
@@ -85,6 +85,7 @@ import Cardano.Ledger.Binary (
   encodeTag,
   ifDecoderVersionAtLeast,
   ifEncodingVersionAtLeast,
+  listLenInt,
   natVersion,
   peekTokenType,
   setTag,
@@ -152,8 +153,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 (toProxy ptr) + 2)
           <> encCBORGroup ptr
           <> encCBOR dats
           <> encCBOR exs
@@ -556,7 +558,8 @@ 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
+        let redeemerLen (redeemerPtr, _, _) = listLenInt redeemerPtr + 2
+        decodeRecordNamed "Redeemer" redeemerLen do
           !redeemerPtr <- decCBORGroup
           !redeemerData <- decCBOR
           !redeemerExUnits <- 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
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -235,7 +236,8 @@ 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
+        let redeemerLen (redeemerPtr, _) = listLenInt redeemerPtr + 2
+        decodeRecordNamed "Redeemer" redeemerLen do
           !redeemerPtr <- decCBORGroup
           !redeemerData <- decCBOR
           !redeemerExUnits <- 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
@@ -435,7 +435,7 @@ encodeShelleyDelegCert = \case
 encodePoolCert :: PoolCert -> Encoding
 encodePoolCert = \case
   RegPool poolParams ->
-    encodeListLen (1 + listLen poolParams)
+    encodeListLen (1 + listLen (toProxy poolParams))
       <> 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
@@ -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 (toProxy txns)) <> encCBOR h <> encCBORGroup txns
 
 instance
   forall era h.
diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs
@@ -57,6 +57,7 @@ module Cardano.Ledger.Core (
   binaryUpgradeTxAuxData,
   fromStrictMaybeL,
   toStrictMaybeL,
+  toProxy,
 
   -- * Era
   module Cardano.Ledger.Core.Era,
@@ -679,3 +680,6 @@ toStrictMaybeL = lens maybeToStrictMaybe (const strictMaybeToMaybe)
 
 fromStrictMaybeL :: Lens' (StrictMaybe a) (Maybe a)
 fromStrictMaybeL = lens strictMaybeToMaybe (const maybeToStrictMaybe)
+
+toProxy :: forall a. a -> Proxy a
+toProxy _ = Proxy
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
@@ -76,6 +76,7 @@ import Cardano.Ledger.Binary (
  )
 import Cardano.Ledger.Binary.Crypto
 import qualified Cardano.Ledger.Binary.Plain as Plain
+import Cardano.Ledger.Core (toProxy)
 import Cardano.Ledger.Hashes (
   EraIndependentBlockBody,
   EraIndependentBlockHeader,
@@ -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 (toProxy oc) + listLen (toProxy pv))
       <> 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
@@ -33,9 +33,11 @@ import Cardano.Ledger.Binary (
   ToCBOR (..),
   fromPlainDecoder,
   fromPlainEncoding,
+  listLenInt,
   runByteBuilder,
  )
 import qualified Cardano.Ledger.Binary.Plain as Plain
+import Cardano.Ledger.Core (toProxy)
 import Cardano.Ledger.Keys (
   DSIGN,
   KeyHash,
@@ -106,17 +108,16 @@ 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 (toProxy ocert)) <> encodeOCertFields ocert
 
 instance Crypto c => FromCBOR (OCert c) where
   fromCBOR =
-    Plain.decodeRecordNamed "OCert" (fromIntegral . listLen) decodeOCertFields
+    Plain.decodeRecordNamed "OCert" listLenInt decodeOCertFields
 
 encodeOCertFields :: Crypto c => OCert c -> Plain.Encoding
 encodeOCertFields ocert =
