{-# LANGUAGE NamedFieldPuns #-}

module Ouroboros.Consensus.Mock.Node.BFT
  ( MockBftBlock
  , blockForgingBft
  , protocolInfoBft
  ) where

import Cardano.Crypto.DSIGN
import qualified Data.Map.Strict as Map
import Ouroboros.Consensus.Block.Forging (BlockForging)
import Ouroboros.Consensus.Config
import qualified Ouroboros.Consensus.HardFork.History as HardFork
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState (..))
import Ouroboros.Consensus.Ledger.Peras (initPerasState)
import Ouroboros.Consensus.Mock.Ledger
import Ouroboros.Consensus.Mock.Node
import Ouroboros.Consensus.Node.ProtocolInfo
import Ouroboros.Consensus.NodeId (CoreNodeId (..), NodeId (..))
import Ouroboros.Consensus.Protocol.BFT

type MockBftBlock = SimpleBftBlock SimpleMockCrypto BftMockCrypto

protocolInfoBft ::
  NumCoreNodes ->
  CoreNodeId ->
  SecurityParam ->
  HardFork.EraParams ->
  ProtocolInfo MockBftBlock
protocolInfoBft :: NumCoreNodes
-> CoreNodeId
-> SecurityParam
-> EraParams
-> ProtocolInfo MockBftBlock
protocolInfoBft NumCoreNodes
numCoreNodes CoreNodeId
nid SecurityParam
securityParam EraParams
eraParams =
  let ledgerConfig :: SimpleLedgerConfig
  SimpleMockCrypto (SimpleBftExt SimpleMockCrypto BftMockCrypto)
ledgerConfig = MockLedgerConfig
  SimpleMockCrypto (SimpleBftExt SimpleMockCrypto BftMockCrypto)
-> EraParams
-> MockConfig
-> SimpleLedgerConfig
     SimpleMockCrypto (SimpleBftExt SimpleMockCrypto BftMockCrypto)
forall c ext.
MockLedgerConfig c ext
-> EraParams -> MockConfig -> SimpleLedgerConfig c ext
SimpleLedgerConfig () EraParams
eraParams MockConfig
defaultMockConfig
   in ProtocolInfo
        { pInfoConfig :: TopLevelConfig MockBftBlock
pInfoConfig =
            TopLevelConfig
              { topLevelConfigProtocol :: ConsensusConfig (BlockProtocol MockBftBlock)
topLevelConfigProtocol =
                  BftConfig
                    { bftParams :: BftParams
bftParams =
                        BftParams
                          { bftNumNodes :: NumCoreNodes
bftNumNodes = NumCoreNodes
numCoreNodes
                          , bftSecurityParam :: SecurityParam
bftSecurityParam = SecurityParam
securityParam
                          }
                    , bftSignKey :: SignKeyDSIGN (BftDSIGN BftMockCrypto)
bftSignKey = CoreNodeId -> SignKeyDSIGN MockDSIGN
signKey CoreNodeId
nid
                    , 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 CoreNodeId
n, CoreNodeId -> VerKeyDSIGN MockDSIGN
verKey CoreNodeId
n)
                          | CoreNodeId
n <- NumCoreNodes -> [CoreNodeId]
enumCoreNodes NumCoreNodes
numCoreNodes
                          ]
                    }
              , topLevelConfigLedger :: LedgerConfig MockBftBlock
topLevelConfigLedger = LedgerConfig MockBftBlock
SimpleLedgerConfig
  SimpleMockCrypto (SimpleBftExt SimpleMockCrypto BftMockCrypto)
ledgerConfig
              , topLevelConfigBlock :: BlockConfig MockBftBlock
topLevelConfigBlock = BlockConfig MockBftBlock
forall c ext. BlockConfig (SimpleBlock c ext)
SimpleBlockConfig
              , topLevelConfigCodec :: CodecConfig MockBftBlock
topLevelConfigCodec = CodecConfig MockBftBlock
forall c ext. CodecConfig (SimpleBlock c ext)
SimpleCodecConfig
              , topLevelConfigStorage :: StorageConfig MockBftBlock
topLevelConfigStorage = SecurityParam -> StorageConfig MockBftBlock
forall c ext. SecurityParam -> StorageConfig (SimpleBlock c ext)
SimpleStorageConfig SecurityParam
securityParam
              , topLevelConfigCheckpoints :: CheckpointsMap MockBftBlock
topLevelConfigCheckpoints = CheckpointsMap MockBftBlock
forall blk. CheckpointsMap blk
emptyCheckpointsMap
              }
        , pInfoInitLedger :: ExtLedgerState MockBftBlock ValuesMK
pInfoInitLedger =
            let ledgerState :: LedgerState (SimpleBlock c ext) ValuesMK
ledgerState = AddrDist -> LedgerState (SimpleBlock c ext) ValuesMK
forall c ext. AddrDist -> LedgerState (SimpleBlock c ext) ValuesMK
genesisSimpleLedgerState AddrDist
addrDist
                headerState :: HeaderState MockBftBlock
headerState = ChainDepState (BlockProtocol MockBftBlock)
-> HeaderState MockBftBlock
forall blk. ChainDepState (BlockProtocol blk) -> HeaderState blk
genesisHeaderState ()
                perasState :: PerasState MockBftBlock
perasState = LedgerConfig MockBftBlock
-> LedgerState MockBftBlock ValuesMK
-> HeaderState MockBftBlock
-> PerasState MockBftBlock
forall blk (mk :: * -> * -> *).
(All Top (HardForkIndices blk), StateSupportsPerasEpochContext blk,
 HasLedgerTables LedgerState blk) =>
LedgerCfg LedgerState blk
-> LedgerState blk mk -> HeaderState blk -> PerasState blk
initPerasState LedgerConfig MockBftBlock
SimpleLedgerConfig
  SimpleMockCrypto (SimpleBftExt SimpleMockCrypto BftMockCrypto)
ledgerConfig LedgerState MockBftBlock ValuesMK
forall {c} {ext}. LedgerState (SimpleBlock c ext) ValuesMK
ledgerState HeaderState MockBftBlock
headerState
             in ExtLedgerState
                  { LedgerState MockBftBlock ValuesMK
forall {c} {ext}. LedgerState (SimpleBlock c ext) ValuesMK
ledgerState :: forall {c} {ext}. LedgerState (SimpleBlock c ext) ValuesMK
ledgerState :: LedgerState MockBftBlock ValuesMK
ledgerState
                  , HeaderState MockBftBlock
headerState :: HeaderState MockBftBlock
headerState :: HeaderState MockBftBlock
headerState
                  , PerasState MockBftBlock
perasState :: PerasState MockBftBlock
perasState :: PerasState MockBftBlock
perasState
                  }
        }
 where
  signKey :: CoreNodeId -> SignKeyDSIGN MockDSIGN
  signKey :: CoreNodeId -> SignKeyDSIGN MockDSIGN
signKey (CoreNodeId Word64
n) = Word64 -> SignKeyDSIGN MockDSIGN
SignKeyMockDSIGN Word64
n

  verKey :: CoreNodeId -> VerKeyDSIGN MockDSIGN
  verKey :: CoreNodeId -> VerKeyDSIGN MockDSIGN
verKey (CoreNodeId Word64
n) = Word64 -> VerKeyDSIGN MockDSIGN
VerKeyMockDSIGN Word64
n

  addrDist :: AddrDist
  addrDist :: AddrDist
addrDist = NumCoreNodes -> AddrDist
mkAddrDist NumCoreNodes
numCoreNodes

blockForgingBft :: Monad m => CoreNodeId -> [BlockForging m MockBftBlock]
blockForgingBft :: forall (m :: * -> *).
Monad m =>
CoreNodeId -> [BlockForging m MockBftBlock]
blockForgingBft CoreNodeId
nid = [CanBeLeader (BlockProtocol MockBftBlock)
-> ForgeExt
     SimpleMockCrypto (SimpleBftExt SimpleMockCrypto BftMockCrypto)
-> BlockForging m MockBftBlock
forall c ext (m :: * -> *).
(RunMockBlock c ext, CannotForge (SimpleBlock c ext) ~ Void,
 ForgeStateInfo (SimpleBlock c ext) ~ (),
 ForgeStateUpdateError (SimpleBlock c ext) ~ Void, Monad m) =>
CanBeLeader (BlockProtocol (SimpleBlock c ext))
-> ForgeExt c ext -> BlockForging m (SimpleBlock c ext)
simpleBlockForging CoreNodeId
CanBeLeader (BlockProtocol MockBftBlock)
nid ForgeExt
  SimpleMockCrypto (SimpleBftExt SimpleMockCrypto BftMockCrypto)
forall c c'.
(SimpleCrypto c, BftCrypto c',
 Signable (BftDSIGN c') (SignedSimpleBft c c')) =>
ForgeExt c (SimpleBftExt c c')
forgeBftExt]