{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Test.Consensus.Cardano.ProtocolInfo (
ByronSlotLengthInSeconds (..)
, NumCoreNodes (..)
, ShelleySlotLengthInSeconds (..)
, Era (..)
, hardForkInto
, hardForkOnDefaultProtocolVersions
, mkSimpleTestProtocolInfo
, mkTestProtocolInfo
, protocolVersionZero
) where
import qualified Cardano.Chain.Genesis as CC.Genesis
import qualified Cardano.Chain.Update as CC.Update
import Cardano.Ledger.Api.Era (StandardCrypto)
import qualified Cardano.Ledger.Api.Transition as L
import qualified Cardano.Ledger.BaseTypes as SL
import qualified Cardano.Protocol.TPraos.OCert as SL
import qualified Cardano.Slotting.Time as Time
import Data.Proxy (Proxy (..))
import Data.SOP.Strict
import Data.Word (Word64)
import Ouroboros.Consensus.Block.Forging (BlockForging)
import Ouroboros.Consensus.BlockchainTime (SlotLength)
import Ouroboros.Consensus.Byron.Node (ByronLeaderCredentials,
ProtocolParamsByron (..), byronGenesis,
byronPbftSignatureThreshold, byronSoftwareVersion)
import Ouroboros.Consensus.Cardano.Block (CardanoBlock)
import Ouroboros.Consensus.Cardano.Node (CardanoHardForkConstraints,
CardanoHardForkTrigger (..), CardanoHardForkTriggers (..),
CardanoProtocolParams (..), protocolInfoCardano)
import Ouroboros.Consensus.Config (emptyCheckpointsMap)
import Ouroboros.Consensus.Config.SecurityParam (SecurityParam (..))
import Ouroboros.Consensus.Node.ProtocolInfo (NumCoreNodes (..),
ProtocolInfo)
import Ouroboros.Consensus.NodeId (CoreNodeId (..))
import Ouroboros.Consensus.Protocol.PBFT (PBftParams,
PBftSignatureThreshold (..))
import Ouroboros.Consensus.Shelley.Node
(ProtocolParamsShelleyBased (..), ShelleyGenesis,
ShelleyLeaderCredentials)
import Ouroboros.Consensus.Util.IOLike (IOLike)
import qualified Test.Cardano.Ledger.Alonzo.Examples.Consensus as SL
import qualified Test.Cardano.Ledger.Conway.Examples.Consensus as SL
import qualified Test.ThreadNet.Infra.Byron as Byron
import qualified Test.ThreadNet.Infra.Shelley as Shelley
import Test.ThreadNet.Util.Seed (Seed (Seed), runGen)
import Test.Util.Slots (NumSlots (..))
newtype ByronSlotLengthInSeconds = ByronSlotLengthInSeconds Word64
newtype ShelleySlotLengthInSeconds = ShelleySlotLengthInSeconds Word64
class ToSlotLength a where
toSlotLength :: a -> SlotLength
instance ToSlotLength ByronSlotLengthInSeconds where
toSlotLength :: ByronSlotLengthInSeconds -> SlotLength
toSlotLength (ByronSlotLengthInSeconds Word64
n) = Integer -> SlotLength
Time.slotLengthFromSec (Integer -> SlotLength) -> Integer -> SlotLength
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n
instance ToSlotLength ShelleySlotLengthInSeconds where
toSlotLength :: ShelleySlotLengthInSeconds -> SlotLength
toSlotLength (ShelleySlotLengthInSeconds Word64
n) = Integer -> SlotLength
Time.slotLengthFromSec (Integer -> SlotLength) -> Integer -> SlotLength
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n
data Era = Byron
| Shelley
| Allegra
| Mary
| Alonzo
| Babbage
| Conway
deriving (Int -> Era -> ShowS
[Era] -> ShowS
Era -> String
(Int -> Era -> ShowS)
-> (Era -> String) -> ([Era] -> ShowS) -> Show Era
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Era -> ShowS
showsPrec :: Int -> Era -> ShowS
$cshow :: Era -> String
show :: Era -> String
$cshowList :: [Era] -> ShowS
showList :: [Era] -> ShowS
Show, Era -> Era -> Bool
(Era -> Era -> Bool) -> (Era -> Era -> Bool) -> Eq Era
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Era -> Era -> Bool
== :: Era -> Era -> Bool
$c/= :: Era -> Era -> Bool
/= :: Era -> Era -> Bool
Eq, Eq Era
Eq Era =>
(Era -> Era -> Ordering)
-> (Era -> Era -> Bool)
-> (Era -> Era -> Bool)
-> (Era -> Era -> Bool)
-> (Era -> Era -> Bool)
-> (Era -> Era -> Era)
-> (Era -> Era -> Era)
-> Ord Era
Era -> Era -> Bool
Era -> Era -> Ordering
Era -> Era -> Era
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Era -> Era -> Ordering
compare :: Era -> Era -> Ordering
$c< :: Era -> Era -> Bool
< :: Era -> Era -> Bool
$c<= :: Era -> Era -> Bool
<= :: Era -> Era -> Bool
$c> :: Era -> Era -> Bool
> :: Era -> Era -> Bool
$c>= :: Era -> Era -> Bool
>= :: Era -> Era -> Bool
$cmax :: Era -> Era -> Era
max :: Era -> Era -> Era
$cmin :: Era -> Era -> Era
min :: Era -> Era -> Era
Ord, Int -> Era
Era -> Int
Era -> [Era]
Era -> Era
Era -> Era -> [Era]
Era -> Era -> Era -> [Era]
(Era -> Era)
-> (Era -> Era)
-> (Int -> Era)
-> (Era -> Int)
-> (Era -> [Era])
-> (Era -> Era -> [Era])
-> (Era -> Era -> [Era])
-> (Era -> Era -> Era -> [Era])
-> Enum Era
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Era -> Era
succ :: Era -> Era
$cpred :: Era -> Era
pred :: Era -> Era
$ctoEnum :: Int -> Era
toEnum :: Int -> Era
$cfromEnum :: Era -> Int
fromEnum :: Era -> Int
$cenumFrom :: Era -> [Era]
enumFrom :: Era -> [Era]
$cenumFromThen :: Era -> Era -> [Era]
enumFromThen :: Era -> Era -> [Era]
$cenumFromTo :: Era -> Era -> [Era]
enumFromTo :: Era -> Era -> [Era]
$cenumFromThenTo :: Era -> Era -> Era -> [Era]
enumFromThenTo :: Era -> Era -> Era -> [Era]
Enum)
protocolVersionZero :: SL.ProtVer
protocolVersionZero :: ProtVer
protocolVersionZero = Version -> Natural -> ProtVer
SL.ProtVer Version
versionZero Natural
0
where
versionZero :: SL.Version
versionZero :: Version
versionZero = forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
SL.natVersion @0
hardForkOnDefaultProtocolVersions :: CardanoHardForkTriggers
hardForkOnDefaultProtocolVersions :: CardanoHardForkTriggers
hardForkOnDefaultProtocolVersions =
NP CardanoHardForkTrigger (CardanoShelleyEras StandardCrypto)
-> CardanoHardForkTriggers
CardanoHardForkTriggers
(NP CardanoHardForkTrigger (CardanoShelleyEras StandardCrypto)
-> CardanoHardForkTriggers)
-> NP CardanoHardForkTrigger (CardanoShelleyEras StandardCrypto)
-> CardanoHardForkTriggers
forall a b. (a -> b) -> a -> b
$ (forall a. CardanoHardForkTrigger a)
-> NP CardanoHardForkTrigger (CardanoShelleyEras StandardCrypto)
forall (xs :: [*]) (f :: * -> *).
SListIN NP xs =>
(forall a. f a) -> NP f xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure CardanoHardForkTrigger a
forall a. CardanoHardForkTrigger a
CardanoTriggerHardForkAtDefaultVersion
hardForkInto :: Era -> CardanoHardForkTriggers
hardForkInto :: Era -> CardanoHardForkTriggers
hardForkInto Era
Byron = CardanoHardForkTriggers
hardForkOnDefaultProtocolVersions
hardForkInto Era
Shelley =
CardanoHardForkTriggers
hardForkOnDefaultProtocolVersions
{ triggerHardForkShelley = CardanoTriggerHardForkAtEpoch 0 }
hardForkInto Era
Allegra =
(Era -> CardanoHardForkTriggers
hardForkInto Era
Shelley)
{ triggerHardForkAllegra = CardanoTriggerHardForkAtEpoch 0 }
hardForkInto Era
Mary =
(Era -> CardanoHardForkTriggers
hardForkInto Era
Allegra)
{ triggerHardForkMary = CardanoTriggerHardForkAtEpoch 0 }
hardForkInto Era
Alonzo =
(Era -> CardanoHardForkTriggers
hardForkInto Era
Mary)
{ triggerHardForkAlonzo = CardanoTriggerHardForkAtEpoch 0 }
hardForkInto Era
Babbage =
(Era -> CardanoHardForkTriggers
hardForkInto Era
Alonzo)
{ triggerHardForkBabbage = CardanoTriggerHardForkAtEpoch 0 }
hardForkInto Era
Conway =
(Era -> CardanoHardForkTriggers
hardForkInto Era
Babbage)
{ triggerHardForkConway = CardanoTriggerHardForkAtEpoch 0 }
mkSimpleTestProtocolInfo ::
forall c
. (CardanoHardForkConstraints c, c ~ StandardCrypto)
=> Shelley.DecentralizationParam
-> SecurityParam
-> ByronSlotLengthInSeconds
-> ShelleySlotLengthInSeconds
-> SL.ProtVer
-> CardanoHardForkTriggers
-> ProtocolInfo (CardanoBlock c)
mkSimpleTestProtocolInfo :: forall c.
(CardanoHardForkConstraints c, c ~ StandardCrypto) =>
DecentralizationParam
-> SecurityParam
-> ByronSlotLengthInSeconds
-> ShelleySlotLengthInSeconds
-> ProtVer
-> CardanoHardForkTriggers
-> ProtocolInfo (CardanoBlock c)
mkSimpleTestProtocolInfo
DecentralizationParam
decentralizationParam
SecurityParam
securityParam
ByronSlotLengthInSeconds
byronSlotLenghtInSeconds
ShelleySlotLengthInSeconds
shelleySlotLengthInSeconds
ProtVer
protocolVersion
CardanoHardForkTriggers
hardForkTriggers
= (ProtocolInfo (CardanoBlock c),
IO [BlockForging IO (CardanoBlock c)])
-> ProtocolInfo (CardanoBlock c)
forall a b. (a, b) -> a
fst
((ProtocolInfo (CardanoBlock c),
IO [BlockForging IO (CardanoBlock c)])
-> ProtocolInfo (CardanoBlock c))
-> (ProtocolInfo (CardanoBlock c),
IO [BlockForging IO (CardanoBlock c)])
-> ProtocolInfo (CardanoBlock c)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) c.
(CardanoHardForkConstraints c, IOLike m, c ~ StandardCrypto) =>
(CoreNodeId, CoreNode c)
-> ShelleyGenesis c
-> ProtocolVersion
-> Nonce
-> Config
-> GeneratedSecrets
-> Maybe PBftSignatureThreshold
-> ProtVer
-> CardanoHardForkTriggers
-> (ProtocolInfo (CardanoBlock c),
m [BlockForging m (CardanoBlock c)])
mkTestProtocolInfo @IO
(Word64 -> CoreNodeId
CoreNodeId Word64
0, CoreNode c
coreNodeShelley)
ShelleyGenesis c
shelleyGenesis
ProtocolVersion
aByronProtocolVersion
Nonce
SL.NeutralNonce
Config
genesisByron
GeneratedSecrets
generatedSecretsByron
(PBftSignatureThreshold -> Maybe PBftSignatureThreshold
forall a. a -> Maybe a
Just (PBftSignatureThreshold -> Maybe PBftSignatureThreshold)
-> PBftSignatureThreshold -> Maybe PBftSignatureThreshold
forall a b. (a -> b) -> a -> b
$ Double -> PBftSignatureThreshold
PBftSignatureThreshold Double
1)
ProtVer
protocolVersion
CardanoHardForkTriggers
hardForkTriggers
where
aByronProtocolVersion :: ProtocolVersion
aByronProtocolVersion =
Word16 -> Word16 -> Word8 -> ProtocolVersion
CC.Update.ProtocolVersion Word16
0 Word16
0 Word8
0
coreNodeShelley :: CoreNode c
coreNodeShelley = Seed -> Gen (CoreNode c) -> CoreNode c
forall a. Seed -> Gen a -> a
runGen Seed
initSeed (Gen (CoreNode c) -> CoreNode c) -> Gen (CoreNode c) -> CoreNode c
forall a b. (a -> b) -> a -> b
$ KESPeriod -> Gen (CoreNode c)
forall c. PraosCrypto c => KESPeriod -> Gen (CoreNode c)
Shelley.genCoreNode KESPeriod
initialKESPeriod
where
initSeed :: Seed
initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
initialKESPeriod :: SL.KESPeriod
initialKESPeriod :: KESPeriod
initialKESPeriod = Word -> KESPeriod
SL.KESPeriod Word
0
pbftParams :: PBftParams
pbftParams :: PBftParams
pbftParams = SecurityParam -> NumCoreNodes -> PBftParams
Byron.byronPBftParams SecurityParam
securityParam (Word64 -> NumCoreNodes
NumCoreNodes Word64
1)
generatedSecretsByron :: CC.Genesis.GeneratedSecrets
(Config
genesisByron, GeneratedSecrets
generatedSecretsByron) =
SlotLength -> PBftParams -> (Config, GeneratedSecrets)
Byron.generateGenesisConfig (ByronSlotLengthInSeconds -> SlotLength
forall a. ToSlotLength a => a -> SlotLength
toSlotLength ByronSlotLengthInSeconds
byronSlotLenghtInSeconds) PBftParams
pbftParams
shelleyGenesis :: ShelleyGenesis c
shelleyGenesis :: ShelleyGenesis c
shelleyGenesis =
ProtVer
-> SecurityParam
-> Rational
-> DecentralizationParam
-> Word64
-> SlotLength
-> KesConfig
-> [CoreNode c]
-> ShelleyGenesis c
forall c.
PraosCrypto c =>
ProtVer
-> SecurityParam
-> Rational
-> DecentralizationParam
-> Word64
-> SlotLength
-> KesConfig
-> [CoreNode c]
-> ShelleyGenesis c
Shelley.mkGenesisConfig
ProtVer
protocolVersion
SecurityParam
securityParam
Rational
activeSlotCoeff
DecentralizationParam
decentralizationParam
Word64
maxLovelaceSupply
(ShelleySlotLengthInSeconds -> SlotLength
forall a. ToSlotLength a => a -> SlotLength
toSlotLength ShelleySlotLengthInSeconds
shelleySlotLengthInSeconds)
(Proxy c -> NumSlots -> KesConfig
forall (proxy :: * -> *) c.
Crypto c =>
proxy c -> NumSlots -> KesConfig
Shelley.mkKesConfig (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) NumSlots
numSlots)
[CoreNode c
coreNodeShelley]
where
maxLovelaceSupply :: Word64
maxLovelaceSupply :: Word64
maxLovelaceSupply = Word64
45000000000000000
activeSlotCoeff :: Rational
activeSlotCoeff :: Rational
activeSlotCoeff = Rational
0.2
numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
100
mkTestProtocolInfo ::
forall m c
. (CardanoHardForkConstraints c, IOLike m, c ~ StandardCrypto)
=> (CoreNodeId, Shelley.CoreNode c)
-> ShelleyGenesis c
-> CC.Update.ProtocolVersion
-> SL.Nonce
-> CC.Genesis.Config
-> CC.Genesis.GeneratedSecrets
-> Maybe PBftSignatureThreshold
-> SL.ProtVer
-> CardanoHardForkTriggers
-> (ProtocolInfo (CardanoBlock c), m [BlockForging m (CardanoBlock c)])
mkTestProtocolInfo :: forall (m :: * -> *) c.
(CardanoHardForkConstraints c, IOLike m, c ~ StandardCrypto) =>
(CoreNodeId, CoreNode c)
-> ShelleyGenesis c
-> ProtocolVersion
-> Nonce
-> Config
-> GeneratedSecrets
-> Maybe PBftSignatureThreshold
-> ProtVer
-> CardanoHardForkTriggers
-> (ProtocolInfo (CardanoBlock c),
m [BlockForging m (CardanoBlock c)])
mkTestProtocolInfo
(CoreNodeId
coreNodeId, CoreNode c
coreNode)
ShelleyGenesis c
shelleyGenesis
ProtocolVersion
aByronProtocolVersion
Nonce
initialNonce
Config
genesisByron
GeneratedSecrets
generatedSecretsByron
Maybe PBftSignatureThreshold
aByronPbftSignatureThreshold
ProtVer
protocolVersion
CardanoHardForkTriggers
hardForkTriggers
=
CardanoProtocolParams c
-> (ProtocolInfo (CardanoBlock c),
m [BlockForging m (CardanoBlock c)])
forall c (m :: * -> *).
(IOLike m, CardanoHardForkConstraints c) =>
CardanoProtocolParams c
-> (ProtocolInfo (CardanoBlock c),
m [BlockForging m (CardanoBlock c)])
protocolInfoCardano
(ProtocolParamsByron
-> ProtocolParamsShelleyBased c
-> CardanoHardForkTriggers
-> TransitionConfig (LatestKnownEra c)
-> CheckpointsMap (CardanoBlock c)
-> ProtVer
-> CardanoProtocolParams c
forall c.
ProtocolParamsByron
-> ProtocolParamsShelleyBased c
-> CardanoHardForkTriggers
-> TransitionConfig (LatestKnownEra c)
-> CheckpointsMap (CardanoBlock c)
-> ProtVer
-> CardanoProtocolParams c
CardanoProtocolParams
ProtocolParamsByron {
$sel:byronGenesis:ProtocolParamsByron :: Config
byronGenesis = Config
genesisByron
, $sel:byronPbftSignatureThreshold:ProtocolParamsByron :: Maybe PBftSignatureThreshold
byronPbftSignatureThreshold = Maybe PBftSignatureThreshold
aByronPbftSignatureThreshold
, $sel:byronProtocolVersion:ProtocolParamsByron :: ProtocolVersion
byronProtocolVersion = ProtocolVersion
aByronProtocolVersion
, $sel:byronSoftwareVersion:ProtocolParamsByron :: SoftwareVersion
byronSoftwareVersion = SoftwareVersion
softVerByron
, $sel:byronLeaderCredentials:ProtocolParamsByron :: Maybe ByronLeaderCredentials
byronLeaderCredentials = ByronLeaderCredentials -> Maybe ByronLeaderCredentials
forall a. a -> Maybe a
Just ByronLeaderCredentials
leaderCredentialsByron
}
ProtocolParamsShelleyBased {
shelleyBasedInitialNonce :: Nonce
shelleyBasedInitialNonce = Nonce
initialNonce
, shelleyBasedLeaderCredentials :: [ShelleyLeaderCredentials c]
shelleyBasedLeaderCredentials = [ShelleyLeaderCredentials c
leaderCredentialsShelley]
}
CardanoHardForkTriggers
hardForkTriggers
( ShelleyGenesis c
-> AlonzoGenesis
-> ConwayGenesis c
-> TransitionConfig (LatestKnownEra c)
forall c.
Crypto c =>
ShelleyGenesis c
-> AlonzoGenesis
-> ConwayGenesis c
-> TransitionConfig (LatestKnownEra c)
L.mkLatestTransitionConfig
ShelleyGenesis c
shelleyGenesis
AlonzoGenesis
SL.exampleAlonzoGenesis
ConwayGenesis c
ConwayGenesis StandardCrypto
SL.exampleConwayGenesis
)
CheckpointsMap (CardanoBlock c)
forall blk. CheckpointsMap blk
emptyCheckpointsMap
ProtVer
protocolVersion
)
where
leaderCredentialsByron :: ByronLeaderCredentials
leaderCredentialsByron :: ByronLeaderCredentials
leaderCredentialsByron =
HasCallStack =>
Config -> GeneratedSecrets -> CoreNodeId -> ByronLeaderCredentials
Config -> GeneratedSecrets -> CoreNodeId -> ByronLeaderCredentials
Byron.mkLeaderCredentials
Config
genesisByron
GeneratedSecrets
generatedSecretsByron
CoreNodeId
coreNodeId
softVerByron :: CC.Update.SoftwareVersion
softVerByron :: SoftwareVersion
softVerByron = SoftwareVersion
Byron.theProposedSoftwareVersion
leaderCredentialsShelley :: ShelleyLeaderCredentials c
leaderCredentialsShelley :: ShelleyLeaderCredentials c
leaderCredentialsShelley = CoreNode c -> ShelleyLeaderCredentials c
forall c. PraosCrypto c => CoreNode c -> ShelleyLeaderCredentials c
Shelley.mkLeaderCredentials CoreNode c
coreNode