Skip to content

Commit 0f53af2

Browse files
geo2ageo2a
committed
WIP add compatibility layer for EraPerams serialisation
1 parent 246fb40 commit 0f53af2

File tree

33 files changed

+565
-456
lines changed

33 files changed

+565
-456
lines changed

‎ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -167,6 +167,7 @@ library
167167
ouroboros-consensus ^>=0.27,
168168
ouroboros-consensus-protocol ^>=0.12,
169169
ouroboros-network-api ^>=0.14,
170+
reflection,
170171
serialise ^>=0.2,
171172
singletons ^>=3.0,
172173
small-steps,
@@ -492,6 +493,7 @@ test-suite cardano-test
492493
ouroboros-network-protocols:{ouroboros-network-protocols, testlib},
493494
pretty-simple,
494495
process-extras,
496+
reflection,
495497
sop-core,
496498
sop-extras,
497499
strict-sop-core,

‎ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/ByronHFC.hs

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@ import Control.Monad
2626
import qualified Data.Map.Strict as Map
2727
import Data.Maybe (listToMaybe, mapMaybe)
2828
import Data.MemPack
29+
import qualified Data.Reflection as Reflection
2930
import Data.SOP.Index (Index (..))
3031
import Data.Void (Void, absurd)
3132
import Data.Word
@@ -39,6 +40,7 @@ import Ouroboros.Consensus.Config
3940
import Ouroboros.Consensus.HardFork.Combinator
4041
import Ouroboros.Consensus.HardFork.Combinator.Degenerate
4142
import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
43+
import Ouroboros.Consensus.HardFork.History (EraParamsFormat (EraParamsWithoutPerasRoundLength))
4244
import Ouroboros.Consensus.HardFork.Simple
4345
import Ouroboros.Consensus.Ledger.Abstract
4446
import Ouroboros.Consensus.Ledger.Query
@@ -99,7 +101,7 @@ instance SerialiseConstraintsHFC ByronBlock
99101
-- existing Byron blocks.
100102
instance SerialiseHFC '[ByronBlock] where
101103
encodeDiskHfcBlock (DegenCodecConfig ccfg) (DegenBlock b) =
102-
encodeDisk ccfg b
104+
Reflection.give EraParamsWithoutPerasRoundLength $ encodeDisk ccfg b
103105
decodeDiskHfcBlock (DegenCodecConfig ccfg) =
104106
fmap DegenBlock <$> decodeDisk ccfg
105107
reconstructHfcPrefixLen _ =

‎ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -333,7 +333,7 @@ byronEraParams genesis =
333333
, eraSlotLength = fromByronSlotLength $ genesisSlotLength genesis
334334
, eraSafeZone = HardFork.StandardSafeZone (2 * k)
335335
, eraGenesisWin = GenesisWindow (2 * k)
336-
, eraPerasRoundLength = Nothing
336+
, eraPerasRoundLength = Nothing
337337
}
338338
where
339339
k = unNonZero $ maxRollbacks $ genesisSecurityParam genesis

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -343,11 +343,11 @@ instance
343343
internsFromMap $
344344
shelleyLedgerState st
345345
^. SL.nesEsL
346-
. SL.esLStateL
347-
. SL.lsCertStateL
348-
. SL.certDStateL
349-
. SL.dsUnifiedL
350-
. SL.umElemsL
346+
. SL.esLStateL
347+
. SL.lsCertStateL
348+
. SL.certDStateL
349+
. SL.dsUnifiedL
350+
. SL.umElemsL
351351
in LedgerTables . ValuesMK <$> (eraDecoder @era $ decodeMap decodeMemPack (decShareCBOR certInterns))
352352

353353
instance
@@ -462,10 +462,10 @@ slUtxoL :: SL.NewEpochState era -> SL.UTxO era -> (SL.UTxO era, SL.NewEpochState
462462
slUtxoL st vals =
463463
st
464464
& SL.nesEsL
465-
. SL.esLStateL
466-
. SL.lsUTxOStateL
467-
. SL.utxoL
468-
<<.~ vals
465+
. SL.esLStateL
466+
. SL.lsUTxOStateL
467+
. SL.utxoL
468+
<<.~ vals
469469

470470
{-------------------------------------------------------------------------------
471471
GetTip

‎ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Golden.hs

Lines changed: 14 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -7,9 +7,11 @@
77

88
module Test.Consensus.Cardano.Golden (tests) where
99

10+
import qualified Data.Reflection as Reflection
1011
import Ouroboros.Consensus.Cardano.Block
1112
import Ouroboros.Consensus.Cardano.Node
1213
import Ouroboros.Consensus.HardFork.Combinator.Serialisation
14+
import qualified Ouroboros.Consensus.HardFork.History as HardFork
1315
import Ouroboros.Consensus.Ledger.Query (QueryVersion)
1416
import Ouroboros.Consensus.Shelley.HFEras ()
1517
import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
@@ -22,17 +24,18 @@ import Test.Util.Serialisation.Golden
2224

2325
tests :: TestTree
2426
tests =
25-
goldenTest_all
26-
codecConfig
27-
($(getGoldenDir) </> "cardano")
28-
( Just $
29-
CDDLsForNodeToNode
30-
("ntnblock.cddl", "serialisedCardanoBlock")
31-
("ntnheader.cddl", "header")
32-
("ntntx.cddl", "tx")
33-
("ntntxid.cddl", "txId")
34-
)
35-
examples
27+
Reflection.give HardFork.EraParamsWithoutPerasRoundLength $
28+
goldenTest_all
29+
codecConfig
30+
($(getGoldenDir) </> "cardano")
31+
( Just $
32+
CDDLsForNodeToNode
33+
("ntnblock.cddl", "serialisedCardanoBlock")
34+
("ntnheader.cddl", "header")
35+
("ntntx.cddl", "tx")
36+
("ntntxid.cddl", "txId")
37+
)
38+
examples
3639

3740
instance
3841
CardanoHardForkConstraints c =>

‎ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Serialisation.hs

Lines changed: 20 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -9,12 +9,14 @@ module Test.Consensus.Cardano.Serialisation (tests) where
99
import qualified Codec.CBOR.Write as CBOR
1010
import qualified Data.ByteString.Lazy as Lazy
1111
import Data.Constraint
12+
import qualified Data.Reflection as Reflection
1213
import Ouroboros.Consensus.Block
1314
import Ouroboros.Consensus.Byron.Ledger
1415
import Ouroboros.Consensus.Byron.Node ()
1516
import Ouroboros.Consensus.Cardano.Block
1617
import Ouroboros.Consensus.Cardano.Node ()
1718
import Ouroboros.Consensus.HardFork.Combinator.Block
19+
import qualified Ouroboros.Consensus.HardFork.History as HardFork
1820
import Ouroboros.Consensus.Shelley.Ledger
1921
import Ouroboros.Consensus.Shelley.Node ()
2022
import Ouroboros.Consensus.Storage.Serialisation
@@ -32,22 +34,24 @@ tests =
3234
testGroup
3335
"Cardano"
3436
[ testGroup "Examples roundtrip" $
35-
examplesRoundtrip Cardano.Examples.codecConfig Cardano.Examples.examples
36-
, roundtrip_all_skipping
37-
result
38-
testCodecCfg
39-
dictNestedHdr
40-
-- We would want to use this instead, but the generated blocks
41-
-- do not quite validate yet or sometimes they are not
42-
-- entirely coherent, so for now this is commented out.
43-
--
44-
-- It is also the case that some (conway in particular) blocks take a
45-
-- very long time to validate or consume too much memory.
46-
--
47-
-- ( Just $
48-
-- CDDLsForNodeToNode ("ntnblock.cddl", "serialisedCardanoBlock") ("ntnheader.cddl", "header")
49-
-- )
50-
Nothing
37+
Reflection.give HardFork.EraParamsWithoutPerasRoundLength $
38+
examplesRoundtrip Cardano.Examples.codecConfig Cardano.Examples.examples
39+
, Reflection.give HardFork.EraParamsWithoutPerasRoundLength $
40+
roundtrip_all_skipping
41+
result
42+
testCodecCfg
43+
dictNestedHdr
44+
-- We would want to use this instead, but the generated blocks
45+
-- do not quite validate yet or sometimes they are not
46+
-- entirely coherent, so for now this is commented out.
47+
--
48+
-- It is also the case that some (conway in particular) blocks take a
49+
-- very long time to validate or consume too much memory.
50+
--
51+
-- ( Just $
52+
-- CDDLsForNodeToNode ("ntnblock.cddl", "serialisedCardanoBlock") ("ntnheader.cddl", "header")
53+
-- )
54+
Nothing
5155
, testProperty "BinaryBlockInfo sanity check" prop_CardanoBinaryBlockInfo
5256
]
5357
where

‎ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs

Lines changed: 66 additions & 62 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ import Control.Monad (replicateM)
2323
import qualified Data.Map.Strict as Map
2424
import Data.Maybe (maybeToList)
2525
import Data.Proxy (Proxy (..))
26+
import qualified Data.Reflection as Reflection
2627
import Data.SOP.Strict (NP (..))
2728
import Data.Set (Set)
2829
import qualified Data.Set as Set
@@ -35,6 +36,7 @@ import Ouroboros.Consensus.Config.SecurityParam
3536
import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
3637
( isHardForkNodeToNodeEnabled
3738
)
39+
import qualified Ouroboros.Consensus.HardFork.History as HardFork
3840
import Ouroboros.Consensus.Ledger.SupportsMempool (extractTxs)
3941
import Ouroboros.Consensus.Node.NetworkProtocolVersion
4042
import Ouroboros.Consensus.Node.ProtocolInfo
@@ -169,28 +171,29 @@ prop_simple_allegraMary_convergence
169171
, setupTestConfig
170172
, setupVersion
171173
} =
172-
prop_general_semisync pga testOutput
173-
.&&. prop_inSync testOutput
174-
.&&. prop_ReachesEra2 reachesEra2
175-
.&&. prop_noCPViolation
176-
.&&. ( tabulate "ReachesEra2 label" [label_ReachesEra2 reachesEra2]
177-
$ tabulate
178-
"Observed forge during a non-overlay slot in the second era"
179-
[ label_hadActiveNonOverlaySlots
180-
testOutput
181-
overlaySlots
182-
]
183-
$ tabulatePartitionDuration setupK setupPartition
184-
$ tabulateFinalIntersectionDepth
185-
setupK
186-
(NumBlocks finalIntersectionDepth)
187-
finalBlockEra
188-
$ tabulatePartitionPosition
189-
(NumSlots numFirstEraSlots)
190-
setupPartition
191-
(ledgerReachesEra2 reachesEra2)
192-
$ property True
193-
)
174+
Reflection.give HardFork.EraParamsWithoutPerasRoundLength $
175+
prop_general_semisync pga testOutput
176+
.&&. prop_inSync testOutput
177+
.&&. prop_ReachesEra2 reachesEra2
178+
.&&. prop_noCPViolation
179+
.&&. ( tabulate "ReachesEra2 label" [label_ReachesEra2 reachesEra2]
180+
$ tabulate
181+
"Observed forge during a non-overlay slot in the second era"
182+
[ label_hadActiveNonOverlaySlots
183+
testOutput
184+
overlaySlots
185+
]
186+
$ tabulatePartitionDuration setupK setupPartition
187+
$ tabulateFinalIntersectionDepth
188+
setupK
189+
(NumBlocks finalIntersectionDepth)
190+
finalBlockEra
191+
$ tabulatePartitionPosition
192+
(NumSlots numFirstEraSlots)
193+
setupPartition
194+
(ledgerReachesEra2 reachesEra2)
195+
$ property True
196+
)
194197
where
195198
TestConfig
196199
{ initSeed
@@ -236,47 +239,48 @@ prop_simple_allegraMary_convergence
236239

237240
testOutput :: TestOutput AllegraMaryBlock
238241
testOutput =
239-
runTestNetwork
240-
setupTestConfig
241-
testConfigB
242-
TestConfigMB
243-
{ nodeInfo = \(CoreNodeId nid) ->
244-
let protocolParamsShelleyBased =
245-
ProtocolParamsShelleyBased
246-
{ shelleyBasedInitialNonce = setupInitialNonce
247-
, shelleyBasedLeaderCredentials =
248-
[ Shelley.mkLeaderCredentials
249-
(coreNodes !! fromIntegral nid)
250-
]
242+
Reflection.give HardFork.EraParamsWithoutPerasRoundLength $
243+
runTestNetwork
244+
setupTestConfig
245+
testConfigB
246+
TestConfigMB
247+
{ nodeInfo = \(CoreNodeId nid) ->
248+
let protocolParamsShelleyBased =
249+
ProtocolParamsShelleyBased
250+
{ shelleyBasedInitialNonce = setupInitialNonce
251+
, shelleyBasedLeaderCredentials =
252+
[ Shelley.mkLeaderCredentials
253+
(coreNodes !! fromIntegral nid)
254+
]
255+
}
256+
hardForkTrigger =
257+
TriggerHardForkAtVersion $ SL.getVersion majorVersion2
258+
(protocolInfo, blockForging) =
259+
protocolInfoShelleyBasedHardFork
260+
protocolParamsShelleyBased
261+
(SL.ProtVer majorVersion1 0)
262+
(SL.ProtVer majorVersion2 0)
263+
( L.mkTransitionConfig L.NoGenesis $
264+
L.mkTransitionConfig L.NoGenesis $
265+
L.mkShelleyTransitionConfig genesisShelley
266+
)
267+
hardForkTrigger
268+
in TestNodeInitialization
269+
{ tniCrucialTxs =
270+
if not setupHardFork
271+
then []
272+
else
273+
fmap GenTxShelley1 $
274+
Shelley.mkMASetDecentralizationParamTxs
275+
coreNodes
276+
(SL.ProtVer majorVersion2 0)
277+
(SlotNo $ unNumSlots numSlots) -- never expire
278+
setupD -- unchanged
279+
, tniProtocolInfo = protocolInfo
280+
, tniBlockForging = blockForging
251281
}
252-
hardForkTrigger =
253-
TriggerHardForkAtVersion $ SL.getVersion majorVersion2
254-
(protocolInfo, blockForging) =
255-
protocolInfoShelleyBasedHardFork
256-
protocolParamsShelleyBased
257-
(SL.ProtVer majorVersion1 0)
258-
(SL.ProtVer majorVersion2 0)
259-
( L.mkTransitionConfig L.NoGenesis $
260-
L.mkTransitionConfig L.NoGenesis $
261-
L.mkShelleyTransitionConfig genesisShelley
262-
)
263-
hardForkTrigger
264-
in TestNodeInitialization
265-
{ tniCrucialTxs =
266-
if not setupHardFork
267-
then []
268-
else
269-
fmap GenTxShelley1 $
270-
Shelley.mkMASetDecentralizationParamTxs
271-
coreNodes
272-
(SL.ProtVer majorVersion2 0)
273-
(SlotNo $ unNumSlots numSlots) -- never expire
274-
setupD -- unchanged
275-
, tniProtocolInfo = protocolInfo
276-
, tniBlockForging = blockForging
277-
}
278-
, mkRekeyM = Nothing
279-
}
282+
, mkRekeyM = Nothing
283+
}
280284

281285
maxForkLength :: NumBlocks
282286
maxForkLength = NumBlocks $ unNonZero $ maxRollbacks setupK

0 commit comments

Comments
 (0)