{-# 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 (..))

-- REVIEW: this has not been deliberately chosen
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
    -- REVIEW: Make it 1s or a parameter?
    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