{-# 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