{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}

module Ouroboros.Consensus.Config (
    -- * The top-level node configuration
    TopLevelConfig (..)
  , castTopLevelConfig
  , mkTopLevelConfig
    -- ** Derived extraction functions
  , configBlock
  , configCodec
  , configConsensus
  , configLedger
  , configStorage
    -- ** Additional convenience functions
  , configSecurityParam
    -- * Re-exports
  , module Ouroboros.Consensus.Config.SecurityParam
  ) where

import           Data.Coerce
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 {
      TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
topLevelConfigProtocol :: !(ConsensusConfig (BlockProtocol blk))
    , TopLevelConfig blk -> LedgerConfig blk
topLevelConfigLedger   :: !(LedgerConfig blk)
    , TopLevelConfig blk -> BlockConfig blk
topLevelConfigBlock    :: !(BlockConfig blk)
    , TopLevelConfig blk -> CodecConfig blk
topLevelConfigCodec    :: !(CodecConfig blk)
    , TopLevelConfig blk -> StorageConfig blk
topLevelConfigStorage  :: !(StorageConfig 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
$cto :: forall blk x. Rep (TopLevelConfig blk) x -> TopLevelConfig blk
$cfrom :: forall blk x. TopLevelConfig blk -> Rep (TopLevelConfig blk) x
Generic)

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

mkTopLevelConfig ::
     ConsensusConfig (BlockProtocol blk)
  -> LedgerConfig   blk
  -> BlockConfig    blk
  -> CodecConfig    blk
  -> StorageConfig  blk
  -> TopLevelConfig blk
mkTopLevelConfig :: ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> TopLevelConfig blk
mkTopLevelConfig = ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> TopLevelConfig blk
forall blk.
ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> TopLevelConfig blk
TopLevelConfig

configConsensus :: TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus :: 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 :: TopLevelConfig blk -> LedgerConfig blk
configLedger = TopLevelConfig blk -> LedgerConfig blk
forall blk. TopLevelConfig blk -> LedgerConfig blk
topLevelConfigLedger

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

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

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

configSecurityParam :: ConsensusProtocol (BlockProtocol blk)
                    => TopLevelConfig blk -> SecurityParam
configSecurityParam :: 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')
     )
  => TopLevelConfig blk -> TopLevelConfig blk'
castTopLevelConfig :: TopLevelConfig blk -> TopLevelConfig blk'
castTopLevelConfig TopLevelConfig{StorageConfig blk
CodecConfig blk
BlockConfig blk
ConsensusConfig (BlockProtocol blk)
LedgerConfig blk
topLevelConfigStorage :: StorageConfig blk
topLevelConfigCodec :: CodecConfig blk
topLevelConfigBlock :: BlockConfig blk
topLevelConfigLedger :: LedgerConfig blk
topLevelConfigProtocol :: ConsensusConfig (BlockProtocol blk)
topLevelConfigStorage :: forall blk. TopLevelConfig blk -> StorageConfig blk
topLevelConfigCodec :: forall blk. TopLevelConfig blk -> CodecConfig blk
topLevelConfigBlock :: forall blk. TopLevelConfig blk -> BlockConfig blk
topLevelConfigLedger :: forall blk. TopLevelConfig blk -> LedgerConfig blk
topLevelConfigProtocol :: forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
..} = TopLevelConfig :: forall blk.
ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> TopLevelConfig blk
TopLevelConfig{
      topLevelConfigProtocol :: ConsensusConfig (BlockProtocol blk')
topLevelConfigProtocol = ConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol blk')
coerce ConsensusConfig (BlockProtocol blk)
topLevelConfigProtocol
    , topLevelConfigLedger :: LedgerConfig blk'
topLevelConfigLedger   = LedgerConfig blk
LedgerConfig blk'
topLevelConfigLedger
    , topLevelConfigBlock :: BlockConfig blk'
topLevelConfigBlock    = BlockConfig blk -> BlockConfig blk'
coerce BlockConfig blk
topLevelConfigBlock
    , topLevelConfigCodec :: CodecConfig blk'
topLevelConfigCodec    = CodecConfig blk -> CodecConfig blk'
coerce CodecConfig blk
topLevelConfigCodec
    , topLevelConfigStorage :: StorageConfig blk'
topLevelConfigStorage  = StorageConfig blk -> StorageConfig blk'
coerce StorageConfig blk
topLevelConfigStorage
    }