-- | Test the Praos chain selection rule but with explicit leader schedule
module Ouroboros.Consensus.Mock.Node.PraosRule (
    MockPraosRuleBlock
  , blockForgingPraosRule
  , protocolInfoPraosRule
  ) where

import           Cardano.Crypto.KES
import           Cardano.Crypto.VRF
import           Data.Map.Strict (Map)
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
import           Ouroboros.Consensus.Mock.Ledger
import           Ouroboros.Consensus.Mock.Node
import           Ouroboros.Consensus.Mock.Protocol.LeaderSchedule
import           Ouroboros.Consensus.Mock.Protocol.Praos
import           Ouroboros.Consensus.Node.ProtocolInfo
import           Ouroboros.Consensus.NodeId (CoreNodeId (..))

type MockPraosRuleBlock = SimplePraosRuleBlock SimpleMockCrypto

protocolInfoPraosRule :: NumCoreNodes
                      -> CoreNodeId
                      -> PraosParams
                      -> HardFork.EraParams
                      -> LeaderSchedule
                      -> PraosEvolvingStake
                      -> ProtocolInfo MockPraosRuleBlock
protocolInfoPraosRule :: NumCoreNodes
-> CoreNodeId
-> PraosParams
-> EraParams
-> LeaderSchedule
-> PraosEvolvingStake
-> ProtocolInfo MockPraosRuleBlock
protocolInfoPraosRule NumCoreNodes
numCoreNodes
                      CoreNodeId
nid
                      PraosParams
params
                      EraParams
eraParams
                      LeaderSchedule
schedule
                      PraosEvolvingStake
evolvingStake =
    ProtocolInfo {
      pInfoConfig :: TopLevelConfig MockPraosRuleBlock
pInfoConfig = TopLevelConfig {
          topLevelConfigProtocol :: ConsensusConfig (BlockProtocol MockPraosRuleBlock)
topLevelConfigProtocol = WLSConfig {
              wlsConfigSchedule :: LeaderSchedule
wlsConfigSchedule = LeaderSchedule
schedule
            , wlsConfigP :: ConsensusConfig (Praos PraosCryptoUnused)
wlsConfigP        = PraosConfig
                { praosParams :: PraosParams
praosParams        = PraosParams
params
                , praosSignKeyVRF :: SignKeyVRF (PraosVRF PraosCryptoUnused)
praosSignKeyVRF    = SignKeyVRF NeverVRF
SignKeyVRF (PraosVRF PraosCryptoUnused)
NeverUsedSignKeyVRF
                , praosInitialEta :: Natural
praosInitialEta    = Natural
0
                , praosInitialStake :: StakeDist
praosInitialStake  = AddrDist -> StakeDist
genesisStakeDist AddrDist
addrDist
                , praosEvolvingStake :: PraosEvolvingStake
praosEvolvingStake = PraosEvolvingStake
evolvingStake
                , praosVerKeys :: Map
  CoreNodeId
  (VerKeyKES (PraosKES PraosCryptoUnused),
   VerKeyVRF (PraosVRF PraosCryptoUnused))
praosVerKeys       = Map CoreNodeId (VerKeyKES NeverKES, VerKeyVRF NeverVRF)
Map
  CoreNodeId
  (VerKeyKES (PraosKES PraosCryptoUnused),
   VerKeyVRF (PraosVRF PraosCryptoUnused))
verKeys
                }
            , wlsConfigNodeId :: CoreNodeId
wlsConfigNodeId   = CoreNodeId
nid
            }
        , topLevelConfigLedger :: LedgerConfig MockPraosRuleBlock
topLevelConfigLedger      = MockLedgerConfig SimpleMockCrypto SimplePraosRuleExt
-> EraParams
-> MockConfig
-> SimpleLedgerConfig SimpleMockCrypto SimplePraosRuleExt
forall c ext.
MockLedgerConfig c ext
-> EraParams -> MockConfig -> SimpleLedgerConfig c ext
SimpleLedgerConfig () EraParams
eraParams MockConfig
defaultMockConfig
        , topLevelConfigBlock :: BlockConfig MockPraosRuleBlock
topLevelConfigBlock       = BlockConfig MockPraosRuleBlock
forall c ext. BlockConfig (SimpleBlock c ext)
SimpleBlockConfig
        , topLevelConfigCodec :: CodecConfig MockPraosRuleBlock
topLevelConfigCodec       = CodecConfig MockPraosRuleBlock
forall c ext. CodecConfig (SimpleBlock c ext)
SimpleCodecConfig
        , topLevelConfigStorage :: StorageConfig MockPraosRuleBlock
topLevelConfigStorage     = SecurityParam -> StorageConfig MockPraosRuleBlock
forall c ext. SecurityParam -> StorageConfig (SimpleBlock c ext)
SimpleStorageConfig (PraosParams -> SecurityParam
praosSecurityParam PraosParams
params)
        , topLevelConfigCheckpoints :: CheckpointsMap MockPraosRuleBlock
topLevelConfigCheckpoints = CheckpointsMap MockPraosRuleBlock
forall blk. CheckpointsMap blk
emptyCheckpointsMap
        }
    , pInfoInitLedger :: ExtLedgerState MockPraosRuleBlock
pInfoInitLedger = ExtLedgerState
        { ledgerState :: LedgerState MockPraosRuleBlock
ledgerState = AddrDist -> LedgerState MockPraosRuleBlock
forall c ext. AddrDist -> LedgerState (SimpleBlock c ext)
genesisSimpleLedgerState AddrDist
addrDist
        , headerState :: HeaderState MockPraosRuleBlock
headerState = ChainDepState (BlockProtocol MockPraosRuleBlock)
-> HeaderState MockPraosRuleBlock
forall blk. ChainDepState (BlockProtocol blk) -> HeaderState blk
genesisHeaderState ()
        }
    }
  where
    addrDist :: AddrDist
    addrDist :: AddrDist
addrDist = NumCoreNodes -> AddrDist
mkAddrDist NumCoreNodes
numCoreNodes

    verKeys :: Map CoreNodeId (VerKeyKES NeverKES, VerKeyVRF NeverVRF)
    verKeys :: Map CoreNodeId (VerKeyKES NeverKES, VerKeyVRF NeverVRF)
verKeys = [(CoreNodeId, (VerKeyKES NeverKES, VerKeyVRF NeverVRF))]
-> Map CoreNodeId (VerKeyKES NeverKES, VerKeyVRF NeverVRF)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (CoreNodeId
nid', (VerKeyKES NeverKES
NeverUsedVerKeyKES, VerKeyVRF NeverVRF
NeverUsedVerKeyVRF))
                           | CoreNodeId
nid' <- NumCoreNodes -> [CoreNodeId]
enumCoreNodes NumCoreNodes
numCoreNodes
                           ]

blockForgingPraosRule :: Monad m => [BlockForging m MockPraosRuleBlock]
blockForgingPraosRule :: forall (m :: * -> *).
Monad m =>
[BlockForging m MockPraosRuleBlock]
blockForgingPraosRule = [CanBeLeader (BlockProtocol MockPraosRuleBlock)
-> ForgeExt SimpleMockCrypto SimplePraosRuleExt
-> BlockForging m MockPraosRuleBlock
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 () ForgeExt SimpleMockCrypto SimplePraosRuleExt
forall c. SimpleCrypto c => ForgeExt c SimplePraosRuleExt
forgePraosRuleExt]