{-# LANGUAGE TypeFamilies #-}
module Test.Consensus.PeerSimulator.Config (defaultCfg) where
import Cardano.Crypto.DSIGN (SignKeyDSIGN (..), VerKeyDSIGN (..))
import Cardano.Slotting.Time (SlotLength, slotLengthFromSec)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import Ouroboros.Consensus.Config
( SecurityParam
, TopLevelConfig (..)
, emptyCheckpointsMap
)
import Ouroboros.Consensus.HardFork.History
( EraParams (eraGenesisWin)
)
import qualified Ouroboros.Consensus.HardFork.History.EraParams as HardFork
import Ouroboros.Consensus.Ledger.SupportsProtocol (GenesisWindow)
import Ouroboros.Consensus.Node.ProtocolInfo
( NumCoreNodes (NumCoreNodes)
)
import Ouroboros.Consensus.NodeId
( CoreNodeId (CoreNodeId)
, NodeId (CoreId)
)
import Ouroboros.Consensus.Protocol.BFT
( BftParams (BftParams, bftNumNodes, bftSecurityParam)
, ConsensusConfig (BftConfig, bftParams, bftSignKey, bftVerKeys)
)
import Test.Consensus.PointSchedule (ForecastRange (ForecastRange))
import Test.Util.Orphans.IOLike ()
import Test.Util.TestBlock
( BlockConfig (TestBlockConfig)
, CodecConfig (TestBlockCodecConfig)
, StorageConfig (TestBlockStorageConfig)
, TestBlock
, TestBlockLedgerConfig (..)
)
defaultCfg :: SecurityParam -> ForecastRange -> GenesisWindow -> TopLevelConfig TestBlock
defaultCfg :: SecurityParam
-> ForecastRange -> GenesisWindow -> TopLevelConfig TestBlock
defaultCfg SecurityParam
secParam (ForecastRange Word64
sfor) GenesisWindow
sgen =
TopLevelConfig
{ topLevelConfigProtocol :: ConsensusConfig (BlockProtocol TestBlock)
topLevelConfigProtocol =
BftConfig
{ bftParams :: BftParams
bftParams =
BftParams
{ bftSecurityParam :: SecurityParam
bftSecurityParam = SecurityParam
secParam
, bftNumNodes :: NumCoreNodes
bftNumNodes = Word64 -> NumCoreNodes
NumCoreNodes Word64
2
}
, bftSignKey :: SignKeyDSIGN (BftDSIGN BftMockCrypto)
bftSignKey = Word64 -> SignKeyDSIGN MockDSIGN
SignKeyMockDSIGN Word64
0
, bftVerKeys :: Map NodeId (VerKeyDSIGN (BftDSIGN BftMockCrypto))
bftVerKeys =
[(NodeId, VerKeyDSIGN MockDSIGN)]
-> Map NodeId (VerKeyDSIGN MockDSIGN)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (CoreNodeId -> NodeId
CoreId (Word64 -> CoreNodeId
CoreNodeId Word64
0), Word64 -> VerKeyDSIGN MockDSIGN
VerKeyMockDSIGN Word64
0)
, (CoreNodeId -> NodeId
CoreId (Word64 -> CoreNodeId
CoreNodeId Word64
1), Word64 -> VerKeyDSIGN MockDSIGN
VerKeyMockDSIGN Word64
1)
]
}
, topLevelConfigLedger :: LedgerConfig TestBlock
topLevelConfigLedger = EraParams -> StrictMaybe SlotNo -> TestBlockLedgerConfig
TestBlockLedgerConfig EraParams
eraParams (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sfor))
, topLevelConfigBlock :: BlockConfig TestBlock
topLevelConfigBlock = NumCoreNodes -> BlockConfig TestBlock
forall ptype. NumCoreNodes -> BlockConfig (TestBlockWith ptype)
TestBlockConfig NumCoreNodes
numCoreNodes
, topLevelConfigCodec :: CodecConfig TestBlock
topLevelConfigCodec = CodecConfig TestBlock
TestBlockCodecConfig
, topLevelConfigStorage :: StorageConfig TestBlock
topLevelConfigStorage = StorageConfig TestBlock
TestBlockStorageConfig
, topLevelConfigCheckpoints :: CheckpointsMap TestBlock
topLevelConfigCheckpoints = CheckpointsMap TestBlock
forall blk. CheckpointsMap blk
emptyCheckpointsMap
}
where
slotLength :: SlotLength
slotLength :: SlotLength
slotLength = Integer -> SlotLength
slotLengthFromSec Integer
20
eraParams :: HardFork.EraParams
eraParams :: EraParams
eraParams = (SecurityParam -> SlotLength -> EraParams
HardFork.defaultEraParams SecurityParam
secParam SlotLength
slotLength){eraGenesisWin = sgen}
numCoreNodes :: NumCoreNodes
numCoreNodes = Word64 -> NumCoreNodes
NumCoreNodes Word64
2