Skip to content

Remove listLenBound from EncCBORGroup class #5383

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Remove listLenBound from EncCBORGroup class #5383

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion eras/alonzo/impl/src/Cardano/Ledger/Alonzo/BlockBody/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -177,7 +177,6 @@ instance Era era => EncCBORGroup (AlonzoBlockBody era) where
BSL.toStrict $
bodyBytes <> witsBytes <> metadataBytes <> invalidBytes
listLen _ = 4
listLenBound _ = 4

hashAlonzoSegWits ::
BSL.ByteString ->
Expand Down
1 change: 0 additions & 1 deletion eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
9 changes: 6 additions & 3 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
Expand All @@ -7,7 +8,6 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
Expand Down Expand Up @@ -85,6 +85,7 @@ import Cardano.Ledger.Binary (
encodeTag,
ifDecoderVersionAtLeast,
ifEncodingVersionAtLeast,
listLenInt,
natVersion,
peekTokenType,
setTag,
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
4 changes: 3 additions & 1 deletion eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Annotator.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
Expand Down Expand Up @@ -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
Expand Down
1 change: 0 additions & 1 deletion eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 0 additions & 1 deletion eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Scripts.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 0 additions & 1 deletion eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockBody/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -198,7 +198,6 @@ instance Era era => EncCBORGroup (ShelleyBlockBody era) where
BSL.toStrict $
bodyBytes <> witsBytes <> metadataBytes
listLen _ = 3
listLenBound _ = 3

hashShelleySegWits ::
BSL.ByteString ->
Expand Down
2 changes: 1 addition & 1 deletion eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand Down
2 changes: 2 additions & 0 deletions libs/cardano-ledger-binary/CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
* Change `Density` type to only be available at the type level
* Change `Wrapped` type to only be available at the type level
* Make `decodeAnnSet` fail when there are duplicates, starting with protocol version `12`.
Expand Down
4 changes: 2 additions & 2 deletions libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/Coders.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -77,7 +77,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)

-- ====================================================================
Expand Down Expand Up @@ -426,7 +426,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
Expand Down
6 changes: 4 additions & 2 deletions libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/Coders.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

Expand Down Expand Up @@ -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))

-- ====================================================================

Expand Down Expand Up @@ -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
Expand Down
20 changes: 9 additions & 11 deletions libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Group.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Ledger.Binary.Group (
CBORGroup (..),
Expand All @@ -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
Expand All @@ -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
Copy link
Collaborator

@lehins lehins Nov 6, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Looks like I missed one more suggestion. Using Proxy @a would have been fine, it is the fromIntegral . toInteger that is totally unnecessary here, which was there before this PR.

Suggested change
decodeRecordNamed "CBORGroup" (fromIntegral . toInteger . const (listLen $ Proxy @a)) decCBORGroup
decodeRecordNamed "CBORGroup" (listLenInt . (`asProxyTypeOf` Proxy)) decCBORGroup


--------------------------------------------------------------------------------
-- EncCBORGroup
Expand All @@ -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
Copy link
Contributor

@teodanciu teodanciu Nov 11, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why not a Proxy here too, instead of a value a? Isn't it misleading like this, as if the value is taken into consideration?

Copy link
Collaborator Author

@f-f f-f Nov 11, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Good point - though I find that not having to pass the proxy is half of the convenience of this function: it then becomes fromIntegral . listLen, and I think I'd rather just remove it at that point?

Copy link
Collaborator

@lehins lehins Nov 12, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I agree with both of you. That's why I think the best approach here will be to make it:

Suggested change
listLenInt :: forall a. EncCBORGroup a => a -> Int
listLenInt :: forall proxy a. EncCBORGroup a => proxy a -> Int

This will allow using it with concrete types instead of just Proxy, e.g.

  Plain.decodeRecordNamed "OCert" (listLenInt . Just) decodeOCertFields

or Identity a, if Maybe a feels too hacky:

  Plain.decodeRecordNamed "OCert" (listLenInt . Identity) decodeOCertFields

This will keep it consistent, while still allow for convenience to use the value for inferring the type.

listLenInt _ = fromIntegral $ listLen $ Proxy @a

--------------------------------------------------------------------------------
-- DecCBORGroup
Expand All @@ -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
Expand Down
2 changes: 0 additions & 2 deletions libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -225,7 +225,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
Expand Down Expand Up @@ -794,7 +793,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
Expand Down
2 changes: 1 addition & 1 deletion libs/cardano-ledger-core/src/Cardano/Ledger/Block.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
4 changes: 4 additions & 0 deletions libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -57,6 +57,7 @@ module Cardano.Ledger.Core (
binaryUpgradeTxAuxData,
fromStrictMaybeL,
toStrictMaybeL,
toProxy,

-- * Era
module Cardano.Ledger.Core.Era,
Expand Down Expand Up @@ -683,3 +684,6 @@ fromStrictMaybeL = lens strictMaybeToMaybe (const maybeToStrictMaybe)

instance EraTx era => HasOKey TxId (Tx l era) where
toOKey = txIdTx

toProxy :: forall a. a -> Proxy a
toProxy _ = Proxy
Copy link
Collaborator Author

@f-f f-f Nov 6, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@lehins asProxyTypeOf was not what we needed, so I have defined this toProxy here. I'm pretty sure this is not the right place, so let's figure out where it needs to move or if it should be defined in every module where we need it

Copy link
Collaborator

@lehins lehins Nov 6, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, I totally agree with the fact that this is a better function for us than asProxyTypeOf. I tend to avoid defining things that are already available in some form in base, even if they are slightly worse then what I need.
The reason why I avoid it is because I am too lazy. 😅
There are two very hard problems that needs to be solved when one creates a generally reusable function like this 🤣

  • Finding a good name
  • Finding where to put it

The irony about this function, is that I have defined a function just like that in the past toProxy, which doesn't really help us here, but still funny 🥲

In order to stay consistent with the name in base, I think it would be better to call this one asProxy instead. And, as of recent developments, there is a really good place where we can put it, we created a package cardano-base.

With all this in mind, I think it would be a prefect time for you to make this small contribution in a place other than ledger. So, please:

  • add a module Cardano.Base.Proxy in cardano-base package.
  • add this function there and re-export all of the stuff from Data.Proxy.
  • make a release of that package to CHaP and tag me on the RP for approval
  • Update index-state and nix flake in cardano-ledger, once release has been merged and start using this asProxy function in this PR.

FTR. We don't normally go through all these troubles just to get one function form some place. I am only suggesting you do this to get familiar with the process of making release to CHaP and pulling in newer dependencies in

1 change: 0 additions & 1 deletion libs/cardano-ledger-core/src/Cardano/Ledger/Credential.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -307,7 +307,6 @@ instance EncCBORGroup Ptr where
<> encCBOR txIx
<> encCBOR certIx
listLen _ = 3
listLenBound _ = 3

instance DecCBORGroup Ptr where
decCBORGroup = do
Expand Down
1 change: 0 additions & 1 deletion libs/cardano-ledger-core/src/Cardano/Ledger/State/StakePool.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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)
Expand Down
7 changes: 4 additions & 3 deletions libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/OCert.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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 =
Expand Down
Loading