Skip to content

Commit d267190

Browse files
joaosreisjoaosreis
committed
Add entities/accounts/v0 namespace
1 parent fcedee9 commit d267190

5 files changed

Lines changed: 177 additions & 0 deletions

File tree

‎libs/cardano-ledger-canonical-state/cardano-ledger-canonical-state.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,7 @@ library
4444
Cardano.Ledger.CanonicalState.LedgerCBOR
4545
Cardano.Ledger.CanonicalState.Namespace
4646
Cardano.Ledger.CanonicalState.Namespace.Blocks.V0
47+
Cardano.Ledger.CanonicalState.Namespace.EntitiesAccounts.V0
4748
Cardano.Ledger.CanonicalState.Namespace.EntitiesCommittee.V0
4849
Cardano.Ledger.CanonicalState.Namespace.GovCommittee.V0
4950
Cardano.Ledger.CanonicalState.Namespace.GovConstitution.V0

‎libs/cardano-ledger-canonical-state/conway/Cardano/Ledger/CanonicalState/Conway.hs‎

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,18 @@
11
{-# LANGUAGE AllowAmbiguousTypes #-}
22
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE DerivingVia #-}
34
{-# LANGUAGE FlexibleInstances #-}
45
{-# LANGUAGE MultiParamTypeClasses #-}
56
{-# LANGUAGE NamedFieldPuns #-}
67
{-# LANGUAGE OverloadedStrings #-}
78
{-# LANGUAGE RankNTypes #-}
89
{-# LANGUAGE RecordWildCards #-}
910
{-# LANGUAGE ScopedTypeVariables #-}
11+
{-# LANGUAGE StandaloneDeriving #-}
1012
{-# LANGUAGE TypeApplications #-}
1113
{-# LANGUAGE TypeFamilies #-}
14+
{-# LANGUAGE TypeOperators #-}
15+
{-# LANGUAGE UndecidableInstances #-}
1216
{-# OPTIONS_GHC -Wno-orphans #-}
1317

1418
module Cardano.Ledger.CanonicalState.Conway (
@@ -18,6 +22,8 @@ module Cardano.Ledger.CanonicalState.Conway (
1822
fromGovActionState,
1923
mkGovProposalIn,
2024
fromGovProposalIn,
25+
fromCanonicalAccountState,
26+
mkCanonicalAccountState,
2127
) where
2228

2329
import Cardano.Ledger.BaseTypes (EpochNo (..))
@@ -33,6 +39,7 @@ import Cardano.Ledger.CanonicalState.BasicTypes (
3339
mkOnChain,
3440
)
3541
import Cardano.Ledger.CanonicalState.Namespace
42+
import Cardano.Ledger.CanonicalState.Namespace.EntitiesAccounts.V0 (CanonicalAccountState (..))
3643
import Cardano.Ledger.CanonicalState.Namespace.GovConstitution.V0
3744
import Cardano.Ledger.CanonicalState.Namespace.GovPParams.V0
3845
import Cardano.Ledger.CanonicalState.Namespace.GovProposals.V0
@@ -41,6 +48,7 @@ import Cardano.Ledger.Conway (ConwayEra)
4148
import Cardano.Ledger.Conway.Core
4249
import Cardano.Ledger.Conway.Governance
4350
import Cardano.Ledger.Conway.PParams
51+
import Cardano.Ledger.Conway.State (ConwayAccountState (..))
4452
import Cardano.Ledger.Credential (Credential (..))
4553
import Cardano.SCLS.CBOR.Canonical (
4654
assumeCanonicalDecoder,
@@ -64,6 +72,8 @@ type instance NamespaceEra "blocks/v0" = ConwayEra
6472

6573
type instance NamespaceEra "entities/committee/v0" = ConwayEra
6674

75+
type instance NamespaceEra "entities/accounts/v0" = ConwayEra
76+
6777
type instance NamespaceEra "gov/committee/v0" = ConwayEra
6878

6979
type instance NamespaceEra "gov/constitution/v0" = ConwayEra
@@ -331,3 +341,25 @@ instance FromCanonicalCBOR v Vote where
331341
1 -> return (Versioned VoteYes)
332342
2 -> return (Versioned Abstain)
333343
_ -> fail "Invalid CanonicalVote"
344+
345+
mkCanonicalAccountState ::
346+
ConwayAccountState era ->
347+
CanonicalAccountState
348+
mkCanonicalAccountState ConwayAccountState {..} =
349+
CanonicalAccountState
350+
{ casBalance = CanonicalCoin casBalance
351+
, casDeposit = CanonicalCoin casDeposit
352+
, casDRepDelegation = casDRepDelegation
353+
, casStakePoolDelegation = casStakePoolDelegation
354+
}
355+
356+
fromCanonicalAccountState ::
357+
CanonicalAccountState ->
358+
ConwayAccountState era
359+
fromCanonicalAccountState CanonicalAccountState {..} =
360+
ConwayAccountState
361+
{ casBalance = unCoin casBalance
362+
, casDeposit = unCoin casDeposit
363+
, casDRepDelegation = casDRepDelegation
364+
, casStakePoolDelegation = casStakePoolDelegation
365+
}

‎libs/cardano-ledger-canonical-state/src/Cardano/Ledger/CanonicalState/Namespace/EntitiesAccounts/V0.hs‎

Lines changed: 125 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,125 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE DerivingVia #-}
4+
{-# LANGUAGE FlexibleContexts #-}
5+
{-# LANGUAGE FlexibleInstances #-}
6+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7+
{-# LANGUAGE MultiParamTypeClasses #-}
8+
{-# LANGUAGE OverloadedStrings #-}
9+
{-# LANGUAGE RecordWildCards #-}
10+
{-# LANGUAGE StandaloneDeriving #-}
11+
{-# LANGUAGE TypeApplications #-}
12+
{-# LANGUAGE TypeFamilies #-}
13+
{-# LANGUAGE TypeOperators #-}
14+
{-# LANGUAGE UndecidableInstances #-}
15+
{-# OPTIONS_GHC -Wno-orphans #-}
16+
17+
module Cardano.Ledger.CanonicalState.Namespace.EntitiesAccounts.V0 (
18+
EntitiesAccountsIn (..),
19+
EntitiesAccountsOut (..),
20+
CanonicalAccountState (..),
21+
) where
22+
23+
import Cardano.Ledger.CanonicalState.BasicTypes (CanonicalCoin, decodeNamespacedField)
24+
import Cardano.Ledger.CanonicalState.LedgerCBOR (LedgerCBOR (LedgerCBOR))
25+
import Cardano.Ledger.CanonicalState.Namespace (Era, NamespaceEra)
26+
import Cardano.Ledger.Core (KeyHash, KeyRole (StakePool), Staking)
27+
import Cardano.Ledger.Credential (Credential)
28+
import Cardano.Ledger.State (DRep)
29+
import Cardano.SCLS.CBOR.Canonical.Decoder (FromCanonicalCBOR (..), decodeMapLenCanonicalOf)
30+
import Cardano.SCLS.CBOR.Canonical.Encoder (ToCanonicalCBOR (..), encodeAsMap, mkEncodablePair)
31+
import Cardano.SCLS.Entry.IsKey (IsKey (..))
32+
import Cardano.SCLS.NamespaceCodec (
33+
CanonicalCBOREntryDecoder (..),
34+
CanonicalCBOREntryEncoder (..),
35+
KnownNamespace (..),
36+
NamespaceKeySize,
37+
namespaceKeySize,
38+
)
39+
import Cardano.SCLS.Versioned (Versioned (..))
40+
import Data.MemPack (MemPack (packM, unpackM))
41+
import Data.Proxy (Proxy (..))
42+
import Data.Text (Text)
43+
import GHC.Generics (Generic)
44+
45+
instance (Era era, NamespaceEra "entities/accounts/v0" ~ era) => KnownNamespace "entities/accounts/v0" where
46+
type NamespaceKey "entities/accounts/v0" = EntitiesAccountsIn
47+
type NamespaceEntry "entities/accounts/v0" = EntitiesAccountsOut
48+
49+
instance
50+
(Era era, NamespaceEra "entities/accounts/v0" ~ era) =>
51+
CanonicalCBOREntryEncoder "entities/accounts/v0" EntitiesAccountsOut
52+
where
53+
encodeEntry (EntitiesAccountsOut n) = toCanonicalCBOR (Proxy @"entities/accounts/v0") n
54+
55+
instance
56+
(Era era, NamespaceEra "entities/accounts/v0" ~ era) =>
57+
CanonicalCBOREntryDecoder "entities/accounts/v0" EntitiesAccountsOut
58+
where
59+
decodeEntry = fmap EntitiesAccountsOut <$> fromCanonicalCBOR
60+
61+
newtype EntitiesAccountsIn = EntitiesAccountsIn (Credential Staking)
62+
deriving (Eq, Ord, Show)
63+
64+
type instance NamespaceKeySize "entities/accounts/v0" = 29
65+
66+
instance IsKey EntitiesAccountsIn where
67+
keySize = namespaceKeySize @"entities/accounts/v0"
68+
packKeyM (EntitiesAccountsIn accountCredential) =
69+
packM accountCredential
70+
unpackKeyM =
71+
EntitiesAccountsIn <$> unpackM
72+
73+
newtype EntitiesAccountsOut
74+
= EntitiesAccountsOut CanonicalAccountState
75+
deriving (Eq, Show, Generic)
76+
77+
deriving newtype instance
78+
ToCanonicalCBOR "entities/accounts/v0" CanonicalAccountState =>
79+
ToCanonicalCBOR "entities/accounts/v0" EntitiesAccountsOut
80+
81+
deriving instance
82+
FromCanonicalCBOR "entities/accounts/v0" CanonicalAccountState =>
83+
FromCanonicalCBOR "entities/accounts/v0" EntitiesAccountsOut
84+
85+
data CanonicalAccountState = CanonicalAccountState
86+
{ casBalance :: CanonicalCoin
87+
, casDeposit :: CanonicalCoin
88+
, casDRepDelegation :: Maybe DRep
89+
, casStakePoolDelegation :: Maybe (KeyHash StakePool)
90+
}
91+
deriving (Eq, Show, Generic)
92+
93+
instance
94+
(Era era, NamespaceEra "entities/accounts/v0" ~ era) =>
95+
ToCanonicalCBOR "entities/accounts/v0" CanonicalAccountState
96+
where
97+
toCanonicalCBOR v CanonicalAccountState {..} =
98+
encodeAsMap
99+
[ mkEncodablePair v ("balance" :: Text) casBalance
100+
, mkEncodablePair v ("deposit" :: Text) casDeposit
101+
, mkEncodablePair v ("drep_delegation" :: Text) casDRepDelegation
102+
, mkEncodablePair v ("stake_pool_delegation" :: Text) casStakePoolDelegation
103+
]
104+
105+
instance (Era era, NamespaceEra "entities/accounts/v0" ~ era) => FromCanonicalCBOR v CanonicalAccountState where
106+
fromCanonicalCBOR = do
107+
decodeMapLenCanonicalOf 4
108+
Versioned casBalance <- decodeNamespacedField @"entities/accounts/v0" ("balance" :: Text)
109+
Versioned casDeposit <- decodeNamespacedField @"entities/accounts/v0" ("deposit" :: Text)
110+
Versioned casDRepDelegation <-
111+
decodeNamespacedField @"entities/accounts/v0" ("drep_delegation" :: Text)
112+
Versioned casStakePoolDelegation <-
113+
decodeNamespacedField @"entities/accounts/v0" ("stake_pool_delegation" :: Text)
114+
115+
pure $ Versioned $ CanonicalAccountState {..}
116+
117+
deriving via
118+
LedgerCBOR v DRep
119+
instance
120+
(Era era, NamespaceEra v ~ era) => FromCanonicalCBOR v DRep
121+
122+
deriving via
123+
LedgerCBOR v DRep
124+
instance
125+
(Era era, NamespaceEra v ~ era) => ToCanonicalCBOR v DRep

‎libs/cardano-ledger-canonical-state/test/Test/Cardano/Ledger/CanonicalState/Spec.hs‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,13 +17,15 @@ import Cardano.Ledger.BaseTypes (EpochInterval, NonNegativeInterval, UnitInterva
1717
import Cardano.Ledger.CanonicalState.BasicTypes (CanonicalExUnits (..))
1818
import Cardano.Ledger.CanonicalState.Conway ()
1919
import qualified Cardano.Ledger.CanonicalState.Namespace.Blocks.V0 as Blocks.V0
20+
import qualified Cardano.Ledger.CanonicalState.Namespace.EntitiesAccounts.V0 as EntitiesAccounts.V0
2021
import qualified Cardano.Ledger.CanonicalState.Namespace.EntitiesCommittee.V0 as Committee.V0
2122
import qualified Cardano.Ledger.CanonicalState.Namespace.GovCommittee.V0 as GovCommittee.V0
2223
import qualified Cardano.Ledger.CanonicalState.Namespace.GovConstitution.V0 as GovConstitution.V0
2324
import qualified Cardano.Ledger.CanonicalState.Namespace.GovPParams.V0 as GovPParams.V0
2425
import qualified Cardano.Ledger.CanonicalState.Namespace.UTxO.V0 as UTxO.V0
2526
import Cardano.Ledger.Conway (ConwayEra)
2627
import Cardano.Ledger.Core (PParams)
28+
import Cardano.Ledger.DRep (DRep)
2729
import Cardano.SCLS.CBOR.Canonical.Encoder (ToCanonicalCBOR (..))
2830
import Cardano.SCLS.Testlib
2931
import Data.Typeable
@@ -47,6 +49,15 @@ spec = do
4749
isCanonical @"entities/committee/v0" @Committee.V0.CanonicalCommitteeAuthorization
4850
validateType @"entities/committee/v0" @Committee.V0.CanonicalCommitteeAuthorization
4951
"committee_authorization"
52+
describe "entities/accounts/v0" $ do
53+
isCanonical @"entities/accounts/v0" @DRep
54+
validateType @"entities/accounts/v0" @DRep "drep"
55+
isCanonical @"entities/accounts/v0" @EntitiesAccounts.V0.CanonicalAccountState
56+
validateType @"entities/accounts/v0" @EntitiesAccounts.V0.CanonicalAccountState
57+
"account_state"
58+
isCanonical @"entities/accounts/v0" @EntitiesAccounts.V0.EntitiesAccountsOut
59+
validateType @"entities/accounts/v0" @EntitiesAccounts.V0.EntitiesAccountsOut
60+
"record_entry"
5061
describe "gov/committee/v0" $ do
5162
isCanonical @"gov/committee/v0" @GovCommittee.V0.CanonicalCommittee
5263
validateType @"gov/committee/v0" @GovCommittee.V0.CanonicalCommittee "committee"
@@ -70,6 +81,7 @@ spec = do
7081
testNS @"blocks/v0"
7182
testNS @"utxo/v0"
7283
testNS @"entities/committee/v0"
84+
testNS @"entities/accounts/v0"
7385
testNS @"gov/constitution/v0"
7486
testNS @"gov/committee/v0"
7587
testNS @"gov/pparams/v0"

‎libs/cardano-ledger-canonical-state/testlib/Test/Cardano/Ledger/CanonicalState/Arbitrary.hs‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ import Cardano.Ledger.CanonicalState.BasicTypes (
1414
)
1515
import Cardano.Ledger.CanonicalState.Conway ()
1616
import qualified Cardano.Ledger.CanonicalState.Namespace.Blocks.V0 as Blocks.V0
17+
import qualified Cardano.Ledger.CanonicalState.Namespace.EntitiesAccounts.V0 as EntitiesAccounts.V0
1718
import qualified Cardano.Ledger.CanonicalState.Namespace.EntitiesCommittee.V0 as EntitiesCommittee.V0
1819
import qualified Cardano.Ledger.CanonicalState.Namespace.GovCommittee.V0 as GovCommittee.V0
1920
import qualified Cardano.Ledger.CanonicalState.Namespace.GovPParams.V0 as GovPParams.V0 ()
@@ -52,3 +53,9 @@ instance Arbitrary GovCommittee.V0.CanonicalCommittee where
5253

5354
instance Arbitrary CanonicalExUnits where
5455
arbitrary = mkCanonicalExUnits <$> arbitrary
56+
57+
instance Arbitrary EntitiesAccounts.V0.CanonicalAccountState where
58+
arbitrary = genericArbitraryU
59+
60+
instance Arbitrary EntitiesAccounts.V0.EntitiesAccountsOut where
61+
arbitrary = genericArbitraryU

0 commit comments

Comments
 (0)