Skip to content

Commit 754a631

Browse files
qnikstqnikst
committed
Address review comments
1 parent 27feb2f commit 754a631

File tree

6 files changed

+262
-436
lines changed

6 files changed

+262
-436
lines changed

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

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@ library
5252
cardano-crypto-class,
5353
cardano-ledger-binary,
5454
cardano-ledger-core,
55-
cardano-slotting,
55+
-- cardano-slotting,
5656
cborg,
5757
containers,
5858
mempack-scls,
@@ -69,11 +69,13 @@ library conway
6969
hs-source-dirs: conway
7070
build-depends:
7171
base,
72-
cardano-ledger-alonzo,
7372
cardano-ledger-canonical-state,
7473
cardano-ledger-conway,
7574
cardano-ledger-core,
75+
cborg,
7676
scls-core,
77+
scls-cbor,
78+
microlens,
7779

7880
library testlib
7981
import: warnings
@@ -113,5 +115,6 @@ test-suite tests
113115
cardano-ledger-conway,
114116
cardano-ledger-core,
115117
cardano-ledger-core:testlib,
118+
microlens,
116119
scls-cardano:testlib,
117120
scls-cbor,

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

Lines changed: 183 additions & 90 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,20 @@
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
12
{-# LANGUAGE DataKinds #-}
23
{-# LANGUAGE FlexibleInstances #-}
34
{-# LANGUAGE MultiParamTypeClasses #-}
5+
{-# LANGUAGE OverloadedStrings #-}
6+
{-# LANGUAGE RankNTypes #-}
47
{-# LANGUAGE RecordWildCards #-}
8+
{-# LANGUAGE ScopedTypeVariables #-}
9+
{-# LANGUAGE TypeApplications #-}
510
{-# LANGUAGE TypeFamilies #-}
611
{-# OPTIONS_GHC -Wno-orphans #-}
712

813
module Cardano.Ledger.CanonicalState.Conway (
914
mkCanonicalConstitution,
1015
) where
1116

12-
import Cardano.Ledger.Alonzo.PParams (OrdExUnits (..))
13-
import Cardano.Ledger.BaseTypes (ProtVer)
17+
import Cardano.Ledger.BaseTypes (ProtVer (..))
1418
import Cardano.Ledger.CanonicalState.BasicTypes (
1519
CanonicalCoin (..),
1620
fromCanonicalExUnits,
@@ -21,18 +25,26 @@ import Cardano.Ledger.CanonicalState.Namespace.GovCommittee.V0 ()
2125
import Cardano.Ledger.CanonicalState.Namespace.GovConstitution.V0
2226
import Cardano.Ledger.CanonicalState.Namespace.GovPParams.V0
2327
import Cardano.Ledger.CanonicalState.Namespace.UTxO.V0
24-
import Cardano.Ledger.Coin (CoinPerByte (..))
2528
import Cardano.Ledger.Conway (ConwayEra)
29+
import Cardano.Ledger.Conway.Core
2630
import Cardano.Ledger.Conway.Governance (Constitution (..))
27-
import Cardano.Ledger.Conway.PParams (
28-
ConwayPParams (..),
29-
DRepVotingThresholds (..),
30-
PoolVotingThresholds (..),
31-
THKD (..),
31+
import Cardano.Ledger.Conway.PParams
32+
import Cardano.SCLS.CBOR.Canonical (
33+
CanonicalDecoder,
34+
assumeCanonicalDecoder,
35+
assumeCanonicalEncoding,
3236
)
33-
import Cardano.Ledger.Core (PParams (..))
37+
import Cardano.SCLS.CBOR.Canonical.Decoder (
38+
FromCanonicalCBOR (..),
39+
decodeMapLenCanonicalOf,
40+
decodeWordCanonicalOf,
41+
)
42+
import Cardano.SCLS.CBOR.Canonical.Encoder (ToCanonicalCBOR (..), encodeAsMap, mkEncodablePair)
3443
import Cardano.SCLS.NamespaceCodec
35-
import Data.Function ((&))
44+
import Cardano.SCLS.Versioned (Versioned (..))
45+
import qualified Codec.CBOR.Decoding as D
46+
import qualified Codec.CBOR.Encoding as E
47+
import Lens.Micro
3648

3749
type instance NamespaceEra "blocks/v0" = ConwayEra
3850

@@ -53,83 +65,164 @@ instance KnownNamespace "utxo/v0" where
5365
mkCanonicalConstitution :: Constitution era -> CanonicalConstitution
5466
mkCanonicalConstitution Constitution {..} = CanonicalConstitution {..}
5567

56-
instance MkCanonicalPParams (PParams ConwayEra) where
57-
mkCanonicalPParams (PParams ConwayPParams {..}) =
58-
CanonicalPParams
59-
{ ccppA0 = unTHKD cppA0
60-
, ccppTxFeePerByte = CanonicalCoin $ unCoinPerByte $ unTHKD cppTxFeePerByte
61-
, ccppTxFeeFixed = CanonicalCoin $ unTHKD cppTxFeeFixed
62-
, ccppMaxBBSize = unTHKD cppMaxBBSize
63-
, ccppMaxTxSize = unTHKD cppMaxTxSize
64-
, ccppMaxBHSize = unTHKD cppMaxBHSize
65-
, ccppKeyDeposit = CanonicalCoin $ unTHKD cppKeyDeposit
66-
, ccppPoolDeposit = CanonicalCoin $ unTHKD cppPoolDeposit
67-
, ccppEMax = unTHKD cppEMax
68-
, ccppNOpt = unTHKD cppNOpt
69-
, ccppRho = unTHKD cppRho
70-
, ccppTau = unTHKD cppTau
71-
, ccppMinPoolCost = CanonicalCoin $ unTHKD cppMinPoolCost
72-
, ccppCoinsPerUTxOByte = CanonicalCoin $ unCoinPerByte $ unTHKD cppCoinsPerUTxOByte
73-
, ccppCostModels = mkCanonicalCostModels $ unTHKD cppCostModels
74-
, ccppPrices = mkCanonicalPrices $ unTHKD cppPrices
75-
, ccppMaxTxExUnits = unTHKD cppMaxTxExUnits & unOrdExUnits & mkCanonicalExUnits
76-
, ccppMaxBlockExUnits = unTHKD cppMaxBlockExUnits & unOrdExUnits & mkCanonicalExUnits
77-
, ccppMaxValSize = unTHKD cppMaxValSize
78-
, ccppCollateralPercentage = unTHKD cppCollateralPercentage
79-
, ccppMaxCollateralInputs = unTHKD cppMaxCollateralInputs
80-
, ccppPoolVotingThresholds = mkCanonicalPoolVotingThresholds $ unTHKD cppPoolVotingThresholds
81-
, ccppDRepVotingThresholds = mkCanonicalDRepVotingThresholds $ unTHKD cppDRepVotingThresholds
82-
, ccppCommitteeMinSize = unTHKD cppCommitteeMinSize
83-
, ccppCommitteeMaxTermLength = unTHKD cppCommitteeMaxTermLength
84-
, ccppGovActionLifetime = unTHKD cppGovActionLifetime
85-
, ccppGovActionDeposit = CanonicalCoin $ unTHKD cppGovActionDeposit
86-
, ccppDRepDeposit = CanonicalCoin $ unTHKD cppDRepDeposit
87-
, ccppDRepActivity = unTHKD cppDRepActivity
88-
, ccppMinFeeRefScriptCostPerByte = unTHKD cppMinFeeRefScriptCostPerByte
89-
}
90-
91-
instance FromCanonicalPParams (PParams ConwayEra) where
92-
type FromCanonicalPParamsExtra (PParams ConwayEra) = ProtVer
93-
fromCanonicalPParams protocolVersion CanonicalPParams {..} =
94-
PParams
95-
ConwayPParams
96-
{ cppA0 = THKD ccppA0
97-
, cppTxFeePerByte = THKD (CoinPerByte $ unCoin ccppTxFeePerByte)
98-
, cppTxFeeFixed = THKD (unCoin ccppTxFeeFixed)
99-
, cppMaxBBSize = THKD ccppMaxBBSize
100-
, cppMaxTxSize = THKD ccppMaxTxSize
101-
, cppMaxBHSize = THKD ccppMaxBHSize
102-
, cppKeyDeposit = THKD (unCoin ccppKeyDeposit)
103-
, cppPoolDeposit = THKD (unCoin ccppPoolDeposit)
104-
, cppEMax = THKD ccppEMax
105-
, cppNOpt = THKD ccppNOpt
106-
, cppRho = THKD ccppRho
107-
, cppTau = THKD ccppTau
108-
, cppProtocolVersion = protocolVersion
109-
, cppMinPoolCost = THKD (unCoin ccppMinPoolCost)
110-
, cppCoinsPerUTxOByte = THKD (CoinPerByte $ unCoin ccppCoinsPerUTxOByte)
111-
, cppCostModels = THKD (fromCanonicalCostModels ccppCostModels)
112-
, cppPrices = THKD (fromCanonicalPrices ccppPrices)
113-
, cppMaxTxExUnits = THKD (ccppMaxTxExUnits & fromCanonicalExUnits & OrdExUnits)
114-
, cppMaxBlockExUnits = THKD (ccppMaxBlockExUnits & fromCanonicalExUnits & OrdExUnits)
115-
, cppMaxValSize = THKD ccppMaxValSize
116-
, cppCollateralPercentage = THKD ccppCollateralPercentage
117-
, cppMaxCollateralInputs = THKD ccppMaxCollateralInputs
118-
, cppPoolVotingThresholds = THKD (fromCanonicalPoolVotingThresholds ccppPoolVotingThresholds)
119-
, cppDRepVotingThresholds = THKD (fromCanonicalDRepVotingThresholds ccppDRepVotingThresholds)
120-
, cppCommitteeMinSize = THKD ccppCommitteeMinSize
121-
, cppCommitteeMaxTermLength = THKD ccppCommitteeMaxTermLength
122-
, cppGovActionLifetime = THKD ccppGovActionLifetime
123-
, cppGovActionDeposit = THKD (unCoin ccppGovActionDeposit)
124-
, cppDRepDeposit = THKD (unCoin ccppDRepDeposit)
125-
, cppDRepActivity = THKD ccppDRepActivity
126-
, cppMinFeeRefScriptCostPerByte = THKD ccppMinFeeRefScriptCostPerByte
127-
}
128-
129-
instance IsCanonicalDRepVotingThresholds DRepVotingThresholds where
130-
mkCanonicalDRepVotingThresholds DRepVotingThresholds {..} = CanonicalDRepVotingThresholds {..}
131-
fromCanonicalDRepVotingThresholds CanonicalDRepVotingThresholds {..} = DRepVotingThresholds {..}
132-
133-
instance IsCanonicalPoolVotingThresholds PoolVotingThresholds where
134-
fromCanonicalPoolVotingThresholds CanonicalPoolVotingThresholds {..} = PoolVotingThresholds {..}
135-
mkCanonicalPoolVotingThresholds PoolVotingThresholds {..} = CanonicalPoolVotingThresholds {..}
68+
instance ToCanonicalCBOR "gov/pparams/v0" (PParams ConwayEra) where
69+
toCanonicalCBOR v pp =
70+
encodeAsMap
71+
[ mkEncodablePair v (0 :: Int) (pp ^. ppTxFeePerByteL . to (CanonicalCoin . unCoinPerByte))
72+
, mkEncodablePair v (1 :: Int) (pp ^. ppTxFeeFixedCompactL . to (CanonicalCoin))
73+
, mkEncodablePair v (2 :: Int) (pp ^. ppMaxBBSizeL)
74+
, mkEncodablePair v (3 :: Int) (pp ^. ppMaxTxSizeL)
75+
, mkEncodablePair v (4 :: Int) (pp ^. ppMaxBHSizeL)
76+
, mkEncodablePair v (5 :: Int) (pp ^. ppKeyDepositCompactL . to (CanonicalCoin))
77+
, mkEncodablePair v (6 :: Int) (pp ^. ppPoolDepositCompactL . to (CanonicalCoin))
78+
, mkEncodablePair v (7 :: Int) (pp ^. ppEMaxL)
79+
, mkEncodablePair v (8 :: Int) (pp ^. ppNOptL)
80+
, mkEncodablePair v (9 :: Int) (pp ^. ppA0L)
81+
, mkEncodablePair v (10 :: Int) (pp ^. ppRhoL)
82+
, mkEncodablePair v (11 :: Int) (pp ^. ppTauL)
83+
, mkEncodablePair v (16 :: Int) (pp ^. ppMinPoolCostCompactL . to (CanonicalCoin))
84+
, mkEncodablePair v (17 :: Int) (pp ^. ppCoinsPerUTxOByteL . to (CanonicalCoin . unCoinPerByte))
85+
, mkEncodablePair v (18 :: Int) (pp ^. ppCostModelsL)
86+
, mkEncodablePair v (19 :: Int) (pp ^. ppPricesL . to (mkCanonicalPrices))
87+
, mkEncodablePair v (20 :: Int) (pp ^. ppMaxTxExUnitsL . to (mkCanonicalExUnits))
88+
, mkEncodablePair v (21 :: Int) (pp ^. ppMaxBlockExUnitsL . to (mkCanonicalExUnits))
89+
, mkEncodablePair v (22 :: Int) (pp ^. ppMaxValSizeL)
90+
, mkEncodablePair v (23 :: Int) (pp ^. ppCollateralPercentageL)
91+
, mkEncodablePair v (24 :: Int) (pp ^. ppMaxCollateralInputsL)
92+
, mkEncodablePair v (25 :: Int) (pp ^. ppPoolVotingThresholdsL)
93+
, mkEncodablePair v (26 :: Int) (pp ^. ppDRepVotingThresholdsL)
94+
, mkEncodablePair v (27 :: Int) (pp ^. ppCommitteeMinSizeL)
95+
, mkEncodablePair v (28 :: Int) (pp ^. ppCommitteeMaxTermLengthL)
96+
, mkEncodablePair v (29 :: Int) (pp ^. ppGovActionLifetimeL)
97+
, mkEncodablePair v (30 :: Int) (pp ^. ppGovActionDepositCompactL . to (CanonicalCoin))
98+
, mkEncodablePair v (31 :: Int) (pp ^. ppDRepDepositCompactL . to (CanonicalCoin))
99+
, mkEncodablePair v (32 :: Int) (pp ^. ppDRepActivityL)
100+
, mkEncodablePair v (33 :: Int) (pp ^. ppMinFeeRefScriptCostPerByteL)
101+
]
102+
103+
instance FromCanonicalCBOR "gov/pparams/v0" (PParams ConwayEra) where
104+
fromCanonicalCBOR = do
105+
decodeMapLenCanonicalOf 30
106+
txFeePerByte <- decodeField @"gov/pparams/v0" @CanonicalCoin 0
107+
txFeeFixedCompact <- decodeField @"gov/pparams/v0" @CanonicalCoin 1
108+
maxBBSize <- decodeField @"gov/pparams/v0" 2
109+
maxTxSize <- decodeField @"gov/pparams/v0" 3
110+
maxBHSize <- decodeField @"gov/pparams/v0" 4
111+
keyDepositCompact <- decodeField @"gov/pparams/v0" @CanonicalCoin 5
112+
poolDepositCompact <- decodeField @"gov/pparams/v0" @CanonicalCoin 6
113+
eMax <- decodeField @"gov/pparams/v0" 7
114+
nOpt <- decodeField @"gov/pparams/v0" 8
115+
a0 <- decodeField @"gov/pparams/v0" 9
116+
rho <- decodeField @"gov/pparams/v0" 10
117+
tau <- decodeField @"gov/pparams/v0" 11
118+
minPoolCostCompact <- decodeField @"gov/pparams/v0" @CanonicalCoin 16
119+
coinsPerUTxOByte <- decodeField @"gov/pparams/v0" @CanonicalCoin 17
120+
costModels <- decodeField @"gov/pparams/v0" 18
121+
prices <- decodeField @"gov/pparams/v0" 19
122+
maxTxExUnits <- decodeField @"gov/pparams/v0" 20
123+
maxBlockExUnits <- decodeField @"gov/pparams/v0" 21
124+
maxValSize <- decodeField @"gov/pparams/v0" 22
125+
collateralPercentage <- decodeField @"gov/pparams/v0" 23
126+
maxCollateralInputs <- decodeField @"gov/pparams/v0" 24
127+
poolVotingThresholds <- decodeField @"gov/pparams/v0" 25
128+
dRepVotingThresholds <- decodeField @"gov/pparams/v0" 26
129+
committeeMinSize <- decodeField @"gov/pparams/v0" 27
130+
committeeMaxTermLength <- decodeField @"gov/pparams/v0" 28
131+
govActionLifetime <- decodeField @"gov/pparams/v0" 29
132+
govActionDepositCompact <- decodeField @"gov/pparams/v0" @CanonicalCoin 30
133+
dRepDepositCompact <- decodeField @"gov/pparams/v0" @CanonicalCoin 31
134+
dRepActivity <- decodeField @"gov/pparams/v0" 32
135+
minFeeRefScriptCostPerByte <- decodeField @"gov/pparams/v0" 33
136+
137+
return $
138+
Versioned $
139+
emptyPParams @ConwayEra
140+
& ppTxFeePerByteL .~ CoinPerByte (unCoin txFeePerByte)
141+
& ppTxFeeFixedCompactL .~ unCoin txFeeFixedCompact
142+
& ppMaxBBSizeL .~ maxBBSize
143+
& ppMaxTxSizeL .~ maxTxSize
144+
& ppMaxBHSizeL .~ maxBHSize
145+
& ppKeyDepositCompactL .~ unCoin keyDepositCompact
146+
& ppPoolDepositCompactL .~ unCoin poolDepositCompact
147+
& ppEMaxL .~ eMax
148+
& ppNOptL .~ nOpt
149+
& ppA0L .~ a0
150+
& ppRhoL .~ rho
151+
& ppTauL .~ tau
152+
& ppMinPoolCostCompactL .~ unCoin minPoolCostCompact
153+
& ppCoinsPerUTxOByteL .~ CoinPerByte (unCoin coinsPerUTxOByte)
154+
& ppCostModelsL .~ costModels
155+
& ppPricesL .~ fromCanonicalPrices prices
156+
& ppMaxTxExUnitsL .~ fromCanonicalExUnits maxTxExUnits
157+
& ppMaxBlockExUnitsL .~ fromCanonicalExUnits maxBlockExUnits
158+
& ppMaxValSizeL .~ maxValSize
159+
& ppCollateralPercentageL .~ collateralPercentage
160+
& ppMaxCollateralInputsL .~ maxCollateralInputs
161+
& ppPoolVotingThresholdsL .~ poolVotingThresholds
162+
& ppDRepVotingThresholdsL .~ dRepVotingThresholds
163+
& ppCommitteeMinSizeL .~ committeeMinSize
164+
& ppCommitteeMaxTermLengthL .~ committeeMaxTermLength
165+
& ppGovActionLifetimeL .~ govActionLifetime
166+
& ppGovActionDepositCompactL .~ unCoin govActionDepositCompact
167+
& ppDRepDepositCompactL .~ unCoin dRepDepositCompact
168+
& ppDRepActivityL .~ dRepActivity
169+
& ppMinFeeRefScriptCostPerByteL .~ minFeeRefScriptCostPerByte
170+
& ppProtocolVersionL .~ ProtVer (eraProtVerLow @ConwayEra) 0
171+
172+
decodeField :: forall v a s. FromCanonicalCBOR v a => Word -> CanonicalDecoder s a
173+
decodeField expectedTag = do
174+
decodeWordCanonicalOf expectedTag
175+
Versioned value <- fromCanonicalCBOR @v
176+
return value
177+
178+
instance ToCanonicalCBOR "gov/pparams/v0" DRepVotingThresholds where
179+
toCanonicalCBOR v dvt =
180+
assumeCanonicalEncoding (E.encodeListLen 10)
181+
<> toCanonicalCBOR v (dvt ^. dvtMotionNoConfidenceL)
182+
<> toCanonicalCBOR v (dvt ^. dvtCommitteeNormalL)
183+
<> toCanonicalCBOR v (dvt ^. dvtCommitteeNoConfidenceL)
184+
<> toCanonicalCBOR v (dvt ^. dvtUpdateToConstitutionL)
185+
<> toCanonicalCBOR v (dvt ^. dvtHardForkInitiationL)
186+
<> toCanonicalCBOR v (dvt ^. dvtPPNetworkGroupL)
187+
<> toCanonicalCBOR v (dvt ^. dvtPPEconomicGroupL)
188+
<> toCanonicalCBOR v (dvt ^. dvtPPTechnicalGroupL)
189+
<> toCanonicalCBOR v (dvt ^. dvtPPGovGroupL)
190+
<> toCanonicalCBOR v (dvt ^. dvtTreasuryWithdrawalL)
191+
192+
instance FromCanonicalCBOR "gov/pparams/v0" DRepVotingThresholds where
193+
fromCanonicalCBOR = do
194+
assumeCanonicalDecoder $ D.decodeListLenCanonicalOf 10
195+
Versioned dvtMotionNoConfidence <- fromCanonicalCBOR @"gov/pparams/v0"
196+
Versioned dvtCommitteeNormal <- fromCanonicalCBOR @"gov/pparams/v0"
197+
Versioned dvtCommitteeNoConfidence <- fromCanonicalCBOR @"gov/pparams/v0"
198+
Versioned dvtUpdateToConstitution <- fromCanonicalCBOR @"gov/pparams/v0"
199+
Versioned dvtHardForkInitiation <- fromCanonicalCBOR @"gov/pparams/v0"
200+
Versioned dvtPPNetworkGroup <- fromCanonicalCBOR @"gov/pparams/v0"
201+
Versioned dvtPPEconomicGroup <- fromCanonicalCBOR @"gov/pparams/v0"
202+
Versioned dvtPPTechnicalGroup <- fromCanonicalCBOR @"gov/pparams/v0"
203+
Versioned dvtPPGovGroup <- fromCanonicalCBOR @"gov/pparams/v0"
204+
Versioned dvtTreasuryWithdrawal <- fromCanonicalCBOR @"gov/pparams/v0"
205+
return $ Versioned DRepVotingThresholds {..}
206+
207+
instance ToCanonicalCBOR "gov/pparams/v0" PoolVotingThresholds where
208+
toCanonicalCBOR v pvt =
209+
toCanonicalCBOR
210+
v
211+
( pvt ^. pvtMotionNoConfidenceL
212+
, pvt ^. pvtCommitteeNormalL
213+
, pvt ^. pvtCommitteeNoConfidenceL
214+
, pvt ^. pvtHardForkInitiationL
215+
, pvt ^. pvtPPSecurityGroupL
216+
)
217+
218+
instance FromCanonicalCBOR "gov/pparams/v0" PoolVotingThresholds where
219+
fromCanonicalCBOR = do
220+
Versioned
221+
( pvtMotionNoConfidence
222+
, pvtCommitteeNormal
223+
, pvtCommitteeNoConfidence
224+
, pvtHardForkInitiation
225+
, pvtPPSecurityGroup
226+
) <-
227+
fromCanonicalCBOR @"gov/pparams/v0"
228+
return $ Versioned PoolVotingThresholds {..}

0 commit comments

Comments
 (0)