Skip to content
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.

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

Reduce memory usage with sharing #4826

Merged
merged 9 commits into from
Jan 30, 2025
Prev Previous commit
Next Next commit
Implement sharing for Conway related deserializers
lehins committed Jan 30, 2025
commit 84af9f6b09187368f84ba605cf78f909e89af0bf
13 changes: 10 additions & 3 deletions eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs
Original file line number Diff line number Diff line change
@@ -191,6 +191,7 @@ import Cardano.Ledger.Binary (
DecShareCBOR (..),
EncCBOR (..),
FromCBOR (..),
Interns,
ToCBOR (..),
decNoShareCBOR,
)
@@ -351,12 +352,18 @@ mkEnactState gs =
, ensPrevGovActionIds = govStatePrevGovActionIds gs
}

-- TODO: Implement Sharing: https://github.com/intersectmbo/cardano-ledger/issues/3486
instance EraPParams era => DecShareCBOR (ConwayGovState era) where
decShareCBOR _ =
type
Share (ConwayGovState era) =
( Interns (Credential 'Staking)
, Interns (KeyHash 'StakePool)
, Interns (Credential 'DRepRole)
, Interns (Credential 'HotCommitteeRole)
)
decShareCBOR is =
decode $
RecD ConwayGovState
<! From
<! D (decShareCBOR is)
<! From
<! From
<! From
Original file line number Diff line number Diff line change
@@ -19,7 +19,9 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.Conway.Governance.Procedures (
@@ -92,6 +94,7 @@ import Cardano.Ledger.Binary (
DecShareCBOR (..),
EncCBOR (..),
FromCBOR (fromCBOR),
Interns,
ToCBOR (toCBOR),
decNoShareCBOR,
decodeEnumBounded,
@@ -280,8 +283,14 @@ instance EraPParams era => NoThunks (GovActionState era)

instance EraPParams era => NFData (GovActionState era)

-- TODO: Implement Sharing: https://github.com/intersectmbo/cardano-ledger/issues/3486
instance EraPParams era => DecShareCBOR (GovActionState era) where
type
Share (GovActionState era) =
( Interns (Credential 'Staking)
, Interns (KeyHash 'StakePool)
, Interns (Credential 'DRepRole)
, Interns (Credential 'HotCommitteeRole)
)
decShareCBOR _ =
decode $
RecD GovActionState
Original file line number Diff line number Diff line change
@@ -15,6 +15,7 @@
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This module isolates all the types and functionality around
@@ -125,6 +126,8 @@ import Cardano.Ledger.Binary (
DecCBOR (..),
DecShareCBOR (..),
EncCBOR (..),
Interns,
decodeListLenOf,
)
import Cardano.Ledger.Coin (Coin, CompactForm (CompactCoin))
import Cardano.Ledger.Conway.Governance.Procedures
@@ -359,9 +362,19 @@ instance EraPParams era => EncCBOR (Proposals era) where
instance EraPParams era => DecCBOR (Proposals era) where
decCBOR = decCBOR >>= uncurry mkProposals

-- TODO: Implement Sharing: https://github.com/intersectmbo/cardano-ledger/issues/3486
instance EraPParams era => DecShareCBOR (Proposals era) where
decShareCBOR _ = decCBOR
type
Share (Proposals era) =
( Interns (Credential 'Staking)
, Interns (KeyHash 'StakePool)
, Interns (Credential 'DRepRole)
, Interns (Credential 'HotCommitteeRole)
)
decShareCBOR is = do
decodeListLenOf 2
gaid <- decCBOR
omap <- OMap.decodeOMap (decShareCBOR is)
mkProposals gaid omap

-- | Add a vote to an existing `GovActionState`. This is a no-op if the
-- provided `GovActionId` does not already exist
16 changes: 16 additions & 0 deletions eras/shelley/impl/src/Cardano/Ledger/Shelley/Governance.hs
Original file line number Diff line number Diff line change
@@ -10,6 +10,7 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

@@ -36,12 +37,14 @@ import Cardano.Ledger.Binary (
DecShareCBOR (..),
EncCBOR (encCBOR),
FromCBOR (..),
Interns,
ToCBOR (..),
decNoShareCBOR,
)
import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
import Cardano.Ledger.CertState (Obligations)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates, emptyPPPUpdates)
import Control.DeepSeq (NFData (..))
@@ -68,6 +71,12 @@ class
, EncCBOR (GovState era)
, DecCBOR (GovState era)
, DecShareCBOR (GovState era)
, Share (GovState era)
~ ( Interns (Credential 'Staking)
, Interns (KeyHash 'StakePool)
, Interns (Credential 'DRepRole)
, Interns (Credential 'HotCommitteeRole)
)
, ToCBOR (GovState era)
, FromCBOR (GovState era)
, Default (GovState era)
@@ -265,6 +274,13 @@ instance
) =>
DecShareCBOR (ShelleyGovState era)
where
type
Share (ShelleyGovState era) =
( Interns (Credential 'Staking)
, Interns (KeyHash 'StakePool)
, Interns (Credential 'DRepRole)
, Interns (Credential 'HotCommitteeRole)
)
decShareCBOR _ =
decode $
RecD ShelleyGovState
38 changes: 22 additions & 16 deletions eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/Types.hs
Original file line number Diff line number Diff line change
@@ -33,8 +33,8 @@ import Cardano.Ledger.Binary (
FromCBOR (..),
Interns,
ToCBOR (..),
decNoShareCBOR,
decShareLensCBOR,
decSharePlusLensCBOR,
decodeRecordNamed,
decodeRecordNamedT,
encodeListLen,
@@ -179,7 +179,9 @@ instance
flip evalStateT mempty $ do
esAccountState <- lift decCBOR
esLState <- decSharePlusCBOR
esSnapshots <- decSharePlusCBOR
esSnapshots <-
decSharePlusLensCBOR $
lens (\(cs, ks, _, _) -> (cs, ks)) (\(_, _, cd, ch) (cs, ks) -> (cs, ks, cd, ch))
esNonMyopic <- decShareLensCBOR _2
pure EpochState {esAccountState, esSnapshots, esLState, esNonMyopic}

@@ -330,21 +332,21 @@ instance
!> To sd
!> To don

instance
( EraTxOut era
, EraGov era
) =>
DecShareCBOR (UTxOState era)
where
type Share (UTxOState era) = Interns (Credential 'Staking)
decShareCBOR credInterns =
instance (EraTxOut era, EraGov era) => DecShareCBOR (UTxOState era) where
type
Share (UTxOState era) =
( Interns (Credential 'Staking)
, Interns (KeyHash 'StakePool)
, Interns (Credential 'DRepRole)
, Interns (Credential 'HotCommitteeRole)
)
decShareCBOR is@(cs, _, _, _) =
decodeRecordNamed "UTxOState" (const 6) $ do
utxosUtxo <- decShareCBOR credInterns
utxosUtxo <- decShareCBOR cs
utxosDeposited <- decCBOR
utxosFees <- decCBOR
-- TODO: implement proper sharing: https://github.com/intersectmbo/cardano-ledger/issues/3486
utxosGovState <- decNoShareCBOR
utxosStakeDistr <- decShareCBOR credInterns
utxosGovState <- decShareCBOR is
utxosStakeDistr <- decShareCBOR cs
utxosDonation <- decCBOR
pure UTxOState {..}

@@ -531,11 +533,15 @@ instance
where
type
Share (LedgerState era) =
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool))
( Interns (Credential 'Staking)
, Interns (KeyHash 'StakePool)
, Interns (Credential 'DRepRole)
, Interns (Credential 'HotCommitteeRole)
)
decSharePlusCBOR =
decodeRecordNamedT "LedgerState" (const 2) $ do
lsCertState <- decSharePlusCBOR
lsUTxOState <- decShareLensCBOR _1
lsUTxOState <- decSharePlusCBOR
pure LedgerState {lsUTxOState, lsCertState}

instance (EraTxOut era, EraGov era) => ToCBOR (LedgerState era) where
4 changes: 2 additions & 2 deletions libs/cardano-data/CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
# Version history for `cardano-data`

## 1.2.3.2
## 1.2.4.0

*
* Add `decodeOMap`

## 1.2.3.1

2 changes: 1 addition & 1 deletion libs/cardano-data/cardano-data.cabal
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
cabal-version: 3.0
name: cardano-data
version: 1.2.3.1
version: 1.2.4.0
license: Apache-2.0
maintainer: operations@iohk.io
author: IOHK
17 changes: 11 additions & 6 deletions libs/cardano-data/src/Data/OMap/Strict.hs
Original file line number Diff line number Diff line change
@@ -44,11 +44,13 @@ module Data.OMap.Strict (
extractKeys,
adjust,
filter,
decodeOMap,
)
where

import Cardano.Ledger.Binary (
DecCBOR,
Decoder,
EncCBOR (encCBOR),
decodeListLenOrIndef,
decodeListLikeEnforceNoDuplicates,
@@ -419,12 +421,15 @@ instance (Typeable k, EncCBOR v, Ord k) => EncCBOR (OMap k v) where
encCBOR omap = encodeStrictSeq encCBOR (toStrictSeq omap)

instance (Typeable k, HasOKey k v, DecCBOR v, Eq v) => DecCBOR (OMap k v) where
decCBOR =
decodeListLikeEnforceNoDuplicates
decodeListLenOrIndef
(flip snoc)
(\omap -> (size omap, omap))
decCBOR
decCBOR = decodeOMap decCBOR

decodeOMap :: HasOKey k v => Decoder s v -> Decoder s (OMap k v)
decodeOMap decValue =
decodeListLikeEnforceNoDuplicates
decodeListLenOrIndef
(flip snoc)
(\omap -> (size omap, omap))
decValue

-- | \( O(n \log n) \)
filter :: Ord k => (v -> Bool) -> OMap k v -> OMap k v
Original file line number Diff line number Diff line change
@@ -17,6 +17,7 @@ module Cardano.Ledger.Binary.Decoding.Sharing (
decSharePlusLensCBOR,
decNoShareCBOR,
interns,
internsFromSet,
internsFromMap,
internsFromVMap,
internMap,
@@ -36,6 +37,7 @@ import Data.Kind
import qualified Data.Map.Strict as Map (size)
import Data.Map.Strict.Internal (Map (..))
import Data.Primitive.Types (Prim)
import qualified Data.Set as Set (size)
import qualified Data.Set.Internal as Set (Set (..))
import Data.VMap (VB, VMap, VP)
import qualified Data.VMap as VMap
@@ -95,6 +97,15 @@ internSet k = go
GT -> go r
EQ -> Just kx

internsFromSet :: Ord k => Set.Set k -> Interns k
internsFromSet m =
Interns
[ Intern
{ internMaybe = (`internSet` m)
, internWeight = Set.size m
}
]

internsFromMap :: Ord k => Map k a -> Interns k
internsFromMap m =
Interns
33 changes: 27 additions & 6 deletions libs/cardano-ledger-core/src/Cardano/Ledger/CertState.hs
Original file line number Diff line number Diff line change
@@ -75,6 +75,7 @@ import Cardano.Ledger.Binary (
decodeRecordNamed,
decodeRecordNamedT,
encodeListLen,
internsFromSet,
toMemptyLens,
)
import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
@@ -189,7 +190,9 @@ instance Era era => EncCBOR (DState era) where
<> encCBOR ir

instance DecShareCBOR (DState era) where
type Share (DState era) = (Interns (Credential 'Staking), Interns (KeyHash 'StakePool))
type
Share (DState era) =
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool), Interns (Credential 'DRepRole))
decSharePlusCBOR =
decodeRecordNamedT "DState" (const 4) $ do
unified <- decSharePlusCBOR
@@ -316,8 +319,9 @@ authorizedHotCommitteeCredentials CommitteeState {csCommitteeCreds} =
CommitteeMemberResigned {} -> acc
in F.foldl' toHotCredSet Set.empty csCommitteeCreds

-- TODO: Implement sharing: https://github.com/intersectmbo/cardano-ledger/issues/3486
instance Era era => DecShareCBOR (CommitteeState era) where
type Share (CommitteeState era) = Interns (Credential 'HotCommitteeRole)
getShare = internsFromSet . authorizedHotCommitteeCredentials
decShareCBOR _ = CommitteeState <$> decCBOR

instance Era era => DecCBOR (CommitteeState era) where
@@ -353,8 +357,15 @@ instance NoThunks (VState era)

instance NFData (VState era)

-- TODO: Implement sharing: https://github.com/intersectmbo/cardano-ledger/issues/3486
instance Era era => DecShareCBOR (VState era) where
type
Share (VState era) =
( Interns (Credential 'Staking)
, Interns (Credential 'DRepRole)
, Interns (Credential 'HotCommitteeRole)
)
getShare VState {vsDReps, vsCommitteeState} =
(internsFromSet (foldMap drepDelegs vsDReps), fst (getShare vsDReps), getShare vsCommitteeState)
decShareCBOR _ =
decode $
RecD VState
@@ -408,11 +419,21 @@ instance Era era => EncCBOR (CertState era) where
<> encCBOR certDState

instance Era era => DecShareCBOR (CertState era) where
type Share (CertState era) = (Interns (Credential 'Staking), Interns (KeyHash 'StakePool))
type
Share (CertState era) =
( Interns (Credential 'Staking)
, Interns (KeyHash 'StakePool)
, Interns (Credential 'DRepRole)
, Interns (Credential 'HotCommitteeRole)
)
decSharePlusCBOR = decodeRecordNamedT "CertState" (const 3) $ do
certVState <- lift decNoShareCBOR -- TODO: add sharing of DRep credentials
certVState <-
decSharePlusLensCBOR $
lens (\(cs, _, cd, ch) -> (cs, cd, ch)) (\(_, ks, _, _) (cs, cd, ch) -> (cs, ks, cd, ch))
certPState <- decSharePlusLensCBOR _2
certDState <- decSharePlusCBOR
certDState <-
decSharePlusLensCBOR $
lens (\(cs, ks, cd, _) -> (cs, ks, cd)) (\(_, _, _, ch) (cs, ks, cd) -> (cs, ks, cd, ch))
pure CertState {certPState, certDState, certVState}

instance Default (CertState era) where
Loading