{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Ouroboros.Consensus.Config
  ( -- * The top-level node configuration
    TopLevelConfig (..)
  , castTopLevelConfig
  , mkTopLevelConfig

    -- ** Checkpoints map
  , CheckpointsMap (..)
  , DiffusionPipeliningSupport (..)
  , castCheckpointsMap
  , emptyCheckpointsMap

    -- ** Derived extraction functions
  , configBlock
  , configCodec
  , configConsensus
  , configLedger
  , configStorage

    -- ** Additional convenience functions
  , configSecurityParam

    -- * Re-exports
  , module Ouroboros.Consensus.Config.SecurityParam
  ) where

import Data.Coerce
import Data.Map.Strict (Map)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block.Abstract
import Ouroboros.Consensus.Config.SecurityParam
import Ouroboros.Consensus.Ledger.Basics
import Ouroboros.Consensus.Protocol.Abstract

{-------------------------------------------------------------------------------
  Top-level config
-------------------------------------------------------------------------------}

-- | The top-level node configuration
data TopLevelConfig blk = TopLevelConfig
  { forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
topLevelConfigProtocol :: !(ConsensusConfig (BlockProtocol blk))
  , forall blk. TopLevelConfig blk -> LedgerConfig blk
topLevelConfigLedger :: !(LedgerConfig blk)
  , forall blk. TopLevelConfig blk -> BlockConfig blk
topLevelConfigBlock :: !(BlockConfig blk)
  , forall blk. TopLevelConfig blk -> CodecConfig blk
topLevelConfigCodec :: !(CodecConfig blk)
  , forall blk. TopLevelConfig blk -> StorageConfig blk
topLevelConfigStorage :: !(StorageConfig blk)
  , forall blk. TopLevelConfig blk -> CheckpointsMap blk
topLevelConfigCheckpoints :: !(CheckpointsMap blk)
  }
  deriving (forall x. TopLevelConfig blk -> Rep (TopLevelConfig blk) x)
-> (forall x. Rep (TopLevelConfig blk) x -> TopLevelConfig blk)
-> Generic (TopLevelConfig blk)
forall x. Rep (TopLevelConfig blk) x -> TopLevelConfig blk
forall x. TopLevelConfig blk -> Rep (TopLevelConfig blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (TopLevelConfig blk) x -> TopLevelConfig blk
forall blk x. TopLevelConfig blk -> Rep (TopLevelConfig blk) x
$cfrom :: forall blk x. TopLevelConfig blk -> Rep (TopLevelConfig blk) x
from :: forall x. TopLevelConfig blk -> Rep (TopLevelConfig blk) x
$cto :: forall blk x. Rep (TopLevelConfig blk) x -> TopLevelConfig blk
to :: forall x. Rep (TopLevelConfig blk) x -> TopLevelConfig blk
Generic

instance
  ( ConsensusProtocol (BlockProtocol blk)
  , NoThunks (LedgerConfig blk)
  , NoThunks (BlockConfig blk)
  , NoThunks (CodecConfig blk)
  , NoThunks (StorageConfig blk)
  , NoThunks (HeaderHash blk)
  ) =>
  NoThunks (TopLevelConfig blk)

-- | Checkpoints are block hashes that are expected to be present in the honest
-- historical chain.
--
-- Each checkpoint is associated with a 'BlockNo', and any block with a
-- 'BlockNo' in the checkpoints map is expected to have the corresponding hash.
newtype CheckpointsMap blk = CheckpointsMap
  { forall blk. CheckpointsMap blk -> Map BlockNo (HeaderHash blk)
unCheckpointsMap :: Map BlockNo (HeaderHash blk)
  }
  deriving ((forall x. CheckpointsMap blk -> Rep (CheckpointsMap blk) x)
-> (forall x. Rep (CheckpointsMap blk) x -> CheckpointsMap blk)
-> Generic (CheckpointsMap blk)
forall x. Rep (CheckpointsMap blk) x -> CheckpointsMap blk
forall x. CheckpointsMap blk -> Rep (CheckpointsMap blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (CheckpointsMap blk) x -> CheckpointsMap blk
forall blk x. CheckpointsMap blk -> Rep (CheckpointsMap blk) x
$cfrom :: forall blk x. CheckpointsMap blk -> Rep (CheckpointsMap blk) x
from :: forall x. CheckpointsMap blk -> Rep (CheckpointsMap blk) x
$cto :: forall blk x. Rep (CheckpointsMap blk) x -> CheckpointsMap blk
to :: forall x. Rep (CheckpointsMap blk) x -> CheckpointsMap blk
Generic, Semigroup (CheckpointsMap blk)
CheckpointsMap blk
Semigroup (CheckpointsMap blk) =>
CheckpointsMap blk
-> (CheckpointsMap blk -> CheckpointsMap blk -> CheckpointsMap blk)
-> ([CheckpointsMap blk] -> CheckpointsMap blk)
-> Monoid (CheckpointsMap blk)
[CheckpointsMap blk] -> CheckpointsMap blk
CheckpointsMap blk -> CheckpointsMap blk -> CheckpointsMap blk
forall blk. Semigroup (CheckpointsMap blk)
forall blk. CheckpointsMap blk
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall blk. [CheckpointsMap blk] -> CheckpointsMap blk
forall blk.
CheckpointsMap blk -> CheckpointsMap blk -> CheckpointsMap blk
$cmempty :: forall blk. CheckpointsMap blk
mempty :: CheckpointsMap blk
$cmappend :: forall blk.
CheckpointsMap blk -> CheckpointsMap blk -> CheckpointsMap blk
mappend :: CheckpointsMap blk -> CheckpointsMap blk -> CheckpointsMap blk
$cmconcat :: forall blk. [CheckpointsMap blk] -> CheckpointsMap blk
mconcat :: [CheckpointsMap blk] -> CheckpointsMap blk
Monoid, NonEmpty (CheckpointsMap blk) -> CheckpointsMap blk
CheckpointsMap blk -> CheckpointsMap blk -> CheckpointsMap blk
(CheckpointsMap blk -> CheckpointsMap blk -> CheckpointsMap blk)
-> (NonEmpty (CheckpointsMap blk) -> CheckpointsMap blk)
-> (forall b.
    Integral b =>
    b -> CheckpointsMap blk -> CheckpointsMap blk)
-> Semigroup (CheckpointsMap blk)
forall b.
Integral b =>
b -> CheckpointsMap blk -> CheckpointsMap blk
forall blk. NonEmpty (CheckpointsMap blk) -> CheckpointsMap blk
forall blk.
CheckpointsMap blk -> CheckpointsMap blk -> CheckpointsMap blk
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall blk b.
Integral b =>
b -> CheckpointsMap blk -> CheckpointsMap blk
$c<> :: forall blk.
CheckpointsMap blk -> CheckpointsMap blk -> CheckpointsMap blk
<> :: CheckpointsMap blk -> CheckpointsMap blk -> CheckpointsMap blk
$csconcat :: forall blk. NonEmpty (CheckpointsMap blk) -> CheckpointsMap blk
sconcat :: NonEmpty (CheckpointsMap blk) -> CheckpointsMap blk
$cstimes :: forall blk b.
Integral b =>
b -> CheckpointsMap blk -> CheckpointsMap blk
stimes :: forall b.
Integral b =>
b -> CheckpointsMap blk -> CheckpointsMap blk
Semigroup)

-- | Configure consensus layer how to handle some cases of invalid data
-- when processing mini protocol communication in the presence of diffusion
-- pipelining. See also 'Ouroboros.Consensus.Block.BlockSupportsDiffusionPipelining'
data DiffusionPipeliningSupport = DiffusionPipeliningOn | DiffusionPipeliningOff
  deriving Int -> DiffusionPipeliningSupport -> ShowS
[DiffusionPipeliningSupport] -> ShowS
DiffusionPipeliningSupport -> String
(Int -> DiffusionPipeliningSupport -> ShowS)
-> (DiffusionPipeliningSupport -> String)
-> ([DiffusionPipeliningSupport] -> ShowS)
-> Show DiffusionPipeliningSupport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiffusionPipeliningSupport -> ShowS
showsPrec :: Int -> DiffusionPipeliningSupport -> ShowS
$cshow :: DiffusionPipeliningSupport -> String
show :: DiffusionPipeliningSupport -> String
$cshowList :: [DiffusionPipeliningSupport] -> ShowS
showList :: [DiffusionPipeliningSupport] -> ShowS
Show

instance
  NoThunks (HeaderHash blk) =>
  NoThunks (CheckpointsMap blk)

emptyCheckpointsMap :: CheckpointsMap blk
emptyCheckpointsMap :: forall blk. CheckpointsMap blk
emptyCheckpointsMap = CheckpointsMap blk
forall a. Monoid a => a
mempty

mkTopLevelConfig ::
  ConsensusConfig (BlockProtocol blk) ->
  LedgerConfig blk ->
  BlockConfig blk ->
  CodecConfig blk ->
  StorageConfig blk ->
  CheckpointsMap blk ->
  TopLevelConfig blk
mkTopLevelConfig :: forall blk.
ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> CheckpointsMap blk
-> TopLevelConfig blk
mkTopLevelConfig ConsensusConfig (BlockProtocol blk)
prtclCfg LedgerConfig blk
ledgerCfg BlockConfig blk
blockCfg CodecConfig blk
codecCfg StorageConfig blk
storageCfg CheckpointsMap blk
checkpointsMap =
  ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> CheckpointsMap blk
-> TopLevelConfig blk
forall blk.
ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> CheckpointsMap blk
-> TopLevelConfig blk
TopLevelConfig ConsensusConfig (BlockProtocol blk)
prtclCfg LedgerConfig blk
ledgerCfg BlockConfig blk
blockCfg CodecConfig blk
codecCfg StorageConfig blk
storageCfg CheckpointsMap blk
checkpointsMap

configConsensus :: TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus :: forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus = TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
topLevelConfigProtocol

configLedger :: TopLevelConfig blk -> LedgerConfig blk
configLedger :: forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger = TopLevelConfig blk -> LedgerConfig blk
forall blk. TopLevelConfig blk -> LedgerConfig blk
topLevelConfigLedger

configBlock :: TopLevelConfig blk -> BlockConfig blk
configBlock :: forall blk. TopLevelConfig blk -> BlockConfig blk
configBlock = TopLevelConfig blk -> BlockConfig blk
forall blk. TopLevelConfig blk -> BlockConfig blk
topLevelConfigBlock

configCodec :: TopLevelConfig blk -> CodecConfig blk
configCodec :: forall blk. TopLevelConfig blk -> CodecConfig blk
configCodec = TopLevelConfig blk -> CodecConfig blk
forall blk. TopLevelConfig blk -> CodecConfig blk
topLevelConfigCodec

configStorage :: TopLevelConfig blk -> StorageConfig blk
configStorage :: forall blk. TopLevelConfig blk -> StorageConfig blk
configStorage = TopLevelConfig blk -> StorageConfig blk
forall blk. TopLevelConfig blk -> StorageConfig blk
topLevelConfigStorage

configSecurityParam ::
  ConsensusProtocol (BlockProtocol blk) =>
  TopLevelConfig blk -> SecurityParam
configSecurityParam :: forall blk.
ConsensusProtocol (BlockProtocol blk) =>
TopLevelConfig blk -> SecurityParam
configSecurityParam = ConsensusConfig (BlockProtocol blk) -> SecurityParam
forall p. ConsensusProtocol p => ConsensusConfig p -> SecurityParam
protocolSecurityParam (ConsensusConfig (BlockProtocol blk) -> SecurityParam)
-> (TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk))
-> TopLevelConfig blk
-> SecurityParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus

castTopLevelConfig ::
  ( Coercible
      (ConsensusConfig (BlockProtocol blk))
      (ConsensusConfig (BlockProtocol blk'))
  , LedgerConfig blk ~ LedgerConfig blk'
  , Coercible (BlockConfig blk) (BlockConfig blk')
  , Coercible (CodecConfig blk) (CodecConfig blk')
  , Coercible (StorageConfig blk) (StorageConfig blk')
  , Coercible (HeaderHash blk) (HeaderHash blk')
  ) =>
  TopLevelConfig blk -> TopLevelConfig blk'
castTopLevelConfig :: forall blk blk'.
(Coercible
   (ConsensusConfig (BlockProtocol blk))
   (ConsensusConfig (BlockProtocol blk')),
 LedgerConfig blk ~ LedgerConfig blk',
 Coercible (BlockConfig blk) (BlockConfig blk'),
 Coercible (CodecConfig blk) (CodecConfig blk'),
 Coercible (StorageConfig blk) (StorageConfig blk'),
 Coercible (HeaderHash blk) (HeaderHash blk')) =>
TopLevelConfig blk -> TopLevelConfig blk'
castTopLevelConfig TopLevelConfig{StorageConfig blk
CodecConfig blk
BlockConfig blk
ConsensusConfig (BlockProtocol blk)
LedgerConfig blk
CheckpointsMap blk
topLevelConfigProtocol :: forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
topLevelConfigLedger :: forall blk. TopLevelConfig blk -> LedgerConfig blk
topLevelConfigBlock :: forall blk. TopLevelConfig blk -> BlockConfig blk
topLevelConfigCodec :: forall blk. TopLevelConfig blk -> CodecConfig blk
topLevelConfigStorage :: forall blk. TopLevelConfig blk -> StorageConfig blk
topLevelConfigCheckpoints :: forall blk. TopLevelConfig blk -> CheckpointsMap blk
topLevelConfigProtocol :: ConsensusConfig (BlockProtocol blk)
topLevelConfigLedger :: LedgerConfig blk
topLevelConfigBlock :: BlockConfig blk
topLevelConfigCodec :: CodecConfig blk
topLevelConfigStorage :: StorageConfig blk
topLevelConfigCheckpoints :: CheckpointsMap blk
..} =
  TopLevelConfig
    { topLevelConfigProtocol :: ConsensusConfig (BlockProtocol blk')
topLevelConfigProtocol = ConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol blk')
forall a b. Coercible a b => a -> b
coerce ConsensusConfig (BlockProtocol blk)
topLevelConfigProtocol
    , topLevelConfigLedger :: LedgerConfig blk'
topLevelConfigLedger = LedgerConfig blk
LedgerConfig blk'
topLevelConfigLedger
    , topLevelConfigBlock :: BlockConfig blk'
topLevelConfigBlock = BlockConfig blk -> BlockConfig blk'
forall a b. Coercible a b => a -> b
coerce BlockConfig blk
topLevelConfigBlock
    , topLevelConfigCodec :: CodecConfig blk'
topLevelConfigCodec = CodecConfig blk -> CodecConfig blk'
forall a b. Coercible a b => a -> b
coerce CodecConfig blk
topLevelConfigCodec
    , topLevelConfigStorage :: StorageConfig blk'
topLevelConfigStorage = StorageConfig blk -> StorageConfig blk'
forall a b. Coercible a b => a -> b
coerce StorageConfig blk
topLevelConfigStorage
    , topLevelConfigCheckpoints :: CheckpointsMap blk'
topLevelConfigCheckpoints = CheckpointsMap blk -> CheckpointsMap blk'
forall a b. Coercible a b => a -> b
coerce CheckpointsMap blk
topLevelConfigCheckpoints
    }

castCheckpointsMap ::
  Coercible (HeaderHash blk) (HeaderHash blk') =>
  CheckpointsMap blk -> CheckpointsMap blk'
castCheckpointsMap :: forall blk blk'.
Coercible (HeaderHash blk) (HeaderHash blk') =>
CheckpointsMap blk -> CheckpointsMap blk'
castCheckpointsMap = CheckpointsMap blk -> CheckpointsMap blk'
forall a b. Coercible a b => a -> b
coerce