{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Mock.Node (
    CodecConfig (..)
  , simpleBlockForging
  ) where

import           Codec.Serialise (Serialise)
import qualified Data.Map.Strict as Map
import           Data.Void (Void)
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.Ledger.SupportsMempool (txForgetValidated)
import           Ouroboros.Consensus.Ledger.SupportsProtocol
import           Ouroboros.Consensus.Mock.Ledger
import           Ouroboros.Consensus.Mock.Node.Abstract
import           Ouroboros.Consensus.Mock.Node.Serialisation ()
import           Ouroboros.Consensus.Node.InitStorage
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Node.Run
import           Ouroboros.Consensus.Protocol.Abstract
import           Ouroboros.Consensus.Storage.ImmutableDB (simpleChunkInfo)
import           Ouroboros.Consensus.Util.RedundantConstraints

{-------------------------------------------------------------------------------
  RunNode instance for the mock ledger
-------------------------------------------------------------------------------}

instance HasNetworkProtocolVersion (SimpleBlock SimpleMockCrypto ext) where
  -- Use defaults

instance SupportedNetworkProtocolVersion (SimpleBlock SimpleMockCrypto ext) where
  supportedNodeToNodeVersions :: Proxy (SimpleBlock SimpleMockCrypto ext)
-> Map
     NodeToNodeVersion
     (BlockNodeToNodeVersion (SimpleBlock SimpleMockCrypto ext))
supportedNodeToNodeVersions   Proxy (SimpleBlock SimpleMockCrypto ext)
_ = NodeToNodeVersion -> () -> Map NodeToNodeVersion ()
forall k a. k -> a -> Map k a
Map.singleton NodeToNodeVersion
forall a. Bounded a => a
maxBound ()
  supportedNodeToClientVersions :: Proxy (SimpleBlock SimpleMockCrypto ext)
-> Map
     NodeToClientVersion
     (BlockNodeToClientVersion (SimpleBlock SimpleMockCrypto ext))
supportedNodeToClientVersions Proxy (SimpleBlock SimpleMockCrypto ext)
_ = NodeToClientVersion -> () -> Map NodeToClientVersion ()
forall k a. k -> a -> Map k a
Map.singleton NodeToClientVersion
forall a. Bounded a => a
maxBound ()

  latestReleasedNodeVersion :: Proxy (SimpleBlock SimpleMockCrypto ext)
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersion = Proxy (SimpleBlock SimpleMockCrypto ext)
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersionDefault

instance NodeInitStorage (SimpleBlock SimpleMockCrypto ext) where
  nodeImmutableDbChunkInfo :: StorageConfig (SimpleBlock SimpleMockCrypto ext) -> ChunkInfo
nodeImmutableDbChunkInfo (SimpleStorageConfig SecurityParam
secParam) = EpochSize -> ChunkInfo
simpleChunkInfo (EpochSize -> ChunkInfo) -> EpochSize -> ChunkInfo
forall a b. (a -> b) -> a -> b
$
      Word64 -> EpochSize
EpochSize (Word64 -> EpochSize) -> Word64 -> EpochSize
forall a b. (a -> b) -> a -> b
$ Word64
10 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* SecurityParam -> Word64
maxRollbacks SecurityParam
secParam

  nodeCheckIntegrity :: StorageConfig (SimpleBlock SimpleMockCrypto ext)
-> SimpleBlock SimpleMockCrypto ext -> Bool
nodeCheckIntegrity StorageConfig (SimpleBlock SimpleMockCrypto ext)
_ SimpleBlock SimpleMockCrypto ext
_ = Bool
True

instance BlockSupportsMetrics (SimpleBlock c ext) where
  isSelfIssued :: BlockConfig (SimpleBlock c ext)
-> Header (SimpleBlock c ext) -> WhetherSelfIssued
isSelfIssued = BlockConfig (SimpleBlock c ext)
-> Header (SimpleBlock c ext) -> WhetherSelfIssued
forall blk. BlockConfig blk -> Header blk -> WhetherSelfIssued
isSelfIssuedConstUnknown

deriving via SelectViewDiffusionPipelining (SimpleBlock c ext) instance
  ( BlockSupportsProtocol (SimpleBlock c ext)
  , Show (SelectView (BlockProtocol (SimpleBlock c ext)))
  ) => BlockSupportsDiffusionPipelining (SimpleBlock c ext)

instance ConsensusProtocol (BlockProtocol (SimpleBlock c ext)) => BlockSupportsSanityCheck (SimpleBlock c ext) where
  configAllSecurityParams :: TopLevelConfig (SimpleBlock c ext) -> NonEmpty SecurityParam
configAllSecurityParams = SecurityParam -> NonEmpty SecurityParam
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SecurityParam -> NonEmpty SecurityParam)
-> (TopLevelConfig (SimpleBlock c ext) -> SecurityParam)
-> TopLevelConfig (SimpleBlock c ext)
-> NonEmpty SecurityParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopLevelConfig (SimpleBlock c ext) -> SecurityParam
forall blk.
ConsensusProtocol (BlockProtocol blk) =>
TopLevelConfig blk -> SecurityParam
configSecurityParam

instance ( LedgerSupportsProtocol      (SimpleBlock SimpleMockCrypto ext)
         , Show (CannotForge           (SimpleBlock SimpleMockCrypto ext))
         , Show (ForgeStateInfo        (SimpleBlock SimpleMockCrypto ext))
         , Show (ForgeStateUpdateError (SimpleBlock SimpleMockCrypto ext))
         , Serialise ext
         , RunMockBlock SimpleMockCrypto ext
         ) => RunNode (SimpleBlock SimpleMockCrypto ext)

{-------------------------------------------------------------------------------
  BlockForging
-------------------------------------------------------------------------------}

-- | Can be used when 'CanBeLeader' is static
simpleBlockForging ::
     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 :: 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 CanBeLeader (BlockProtocol (SimpleBlock c ext))
aCanBeLeader ForgeExt c ext
aForgeExt = BlockForging {
      forgeLabel :: Text
forgeLabel       = Text
"simpleBlockForging"
    , canBeLeader :: CanBeLeader (BlockProtocol (SimpleBlock c ext))
canBeLeader      = CanBeLeader (BlockProtocol (SimpleBlock c ext))
aCanBeLeader
    , updateForgeState :: TopLevelConfig (SimpleBlock c ext)
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol (SimpleBlock c ext)))
-> m (ForgeStateUpdateInfo (SimpleBlock c ext))
updateForgeState = \TopLevelConfig (SimpleBlock c ext)
_ SlotNo
_ Ticked (ChainDepState (BlockProtocol (SimpleBlock c ext)))
_ -> ForgeStateUpdateInfo (SimpleBlock c ext)
-> m (ForgeStateUpdateInfo (SimpleBlock c ext))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForgeStateUpdateInfo (SimpleBlock c ext)
 -> m (ForgeStateUpdateInfo (SimpleBlock c ext)))
-> ForgeStateUpdateInfo (SimpleBlock c ext)
-> m (ForgeStateUpdateInfo (SimpleBlock c ext))
forall a b. (a -> b) -> a -> b
$ ForgeStateInfo (SimpleBlock c ext)
-> ForgeStateUpdateInfo (SimpleBlock c ext)
forall blk. ForgeStateInfo blk -> ForgeStateUpdateInfo blk
ForgeStateUpdated ()
    , checkCanForge :: TopLevelConfig (SimpleBlock c ext)
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol (SimpleBlock c ext)))
-> IsLeader (BlockProtocol (SimpleBlock c ext))
-> ForgeStateInfo (SimpleBlock c ext)
-> Either (CannotForge (SimpleBlock c ext)) ()
checkCanForge    = \TopLevelConfig (SimpleBlock c ext)
_ SlotNo
_ Ticked (ChainDepState (BlockProtocol (SimpleBlock c ext)))
_ IsLeader (BlockProtocol (SimpleBlock c ext))
_ ForgeStateInfo (SimpleBlock c ext)
_ -> () -> Either Void ()
forall a. a -> Either Void a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , forgeBlock :: TopLevelConfig (SimpleBlock c ext)
-> BlockNo
-> SlotNo
-> TickedLedgerState (SimpleBlock c ext)
-> [Validated (GenTx (SimpleBlock c ext))]
-> IsLeader (BlockProtocol (SimpleBlock c ext))
-> m (SimpleBlock c ext)
forgeBlock       = \TopLevelConfig (SimpleBlock c ext)
cfg BlockNo
bno SlotNo
slot TickedLedgerState (SimpleBlock c ext)
lst [Validated (GenTx (SimpleBlock c ext))]
txs IsLeader (BlockProtocol (SimpleBlock c ext))
proof ->
        SimpleBlock c ext -> m (SimpleBlock c ext)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
          (SimpleBlock c ext -> m (SimpleBlock c ext))
-> SimpleBlock c ext -> m (SimpleBlock c ext)
forall a b. (a -> b) -> a -> b
$ ForgeExt c ext
-> TopLevelConfig (SimpleBlock c ext)
-> BlockNo
-> SlotNo
-> TickedLedgerState (SimpleBlock c ext)
-> [GenTx (SimpleBlock c ext)]
-> IsLeader (BlockProtocol (SimpleBlock c ext))
-> SimpleBlock c ext
forall c ext.
SimpleCrypto c =>
ForgeExt c ext
-> TopLevelConfig (SimpleBlock c ext)
-> BlockNo
-> SlotNo
-> TickedLedgerState (SimpleBlock c ext)
-> [GenTx (SimpleBlock c ext)]
-> IsLeader (BlockProtocol (SimpleBlock c ext))
-> SimpleBlock c ext
forgeSimple
              ForgeExt c ext
aForgeExt
              TopLevelConfig (SimpleBlock c ext)
cfg
              BlockNo
bno
              SlotNo
slot
              TickedLedgerState (SimpleBlock c ext)
lst
              ((Validated (GenTx (SimpleBlock c ext))
 -> GenTx (SimpleBlock c ext))
-> [Validated (GenTx (SimpleBlock c ext))]
-> [GenTx (SimpleBlock c ext)]
forall a b. (a -> b) -> [a] -> [b]
map Validated (GenTx (SimpleBlock c ext)) -> GenTx (SimpleBlock c ext)
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated [Validated (GenTx (SimpleBlock c ext))]
txs)
              IsLeader (BlockProtocol (SimpleBlock c ext))
proof
    }
  where
    ()
_ = Proxy (ForgeStateUpdateError (SimpleBlock c ext) ~ Void) -> ()
forall (c :: Constraint) (proxy :: Constraint -> *).
c =>
proxy c -> ()
keepRedundantConstraint (forall {k} (t :: k). Proxy t
forall (t :: Constraint). Proxy t
Proxy @(ForgeStateUpdateError (SimpleBlock c ext) ~ Void))