{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Ouroboros.Consensus.HardFork.Combinator.PartialConfig
( HasPartialConsensusConfig (..)
, HasPartialLedgerConfig (..)
, WrapPartialConsensusConfig (..)
, WrapPartialLedgerConfig (..)
, EpochInfo (..)
, Except
, PastHorizonException
) where
import Cardano.Slotting.EpochInfo
import Control.Monad.Except (Except)
import Data.Kind (Type)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.HardFork.History.Qry (PastHorizonException)
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Node.Serialisation
import Ouroboros.Consensus.Protocol.Abstract
class
( ConsensusProtocol p
, NoThunks (PartialConsensusConfig p)
) =>
HasPartialConsensusConfig p
where
type PartialConsensusConfig p :: Type
type PartialConsensusConfig p = ConsensusConfig p
completeConsensusConfig ::
proxy p ->
EpochInfo (Except PastHorizonException) ->
PartialConsensusConfig p ->
ConsensusConfig p
default completeConsensusConfig ::
PartialConsensusConfig p ~ ConsensusConfig p =>
proxy p ->
EpochInfo (Except PastHorizonException) ->
PartialConsensusConfig p ->
ConsensusConfig p
completeConsensusConfig proxy p
_ EpochInfo (Except PastHorizonException)
_ = ConsensusConfig p -> ConsensusConfig p
PartialConsensusConfig p -> ConsensusConfig p
forall a. a -> a
id
toPartialConsensusConfig ::
proxy p ->
ConsensusConfig p ->
PartialConsensusConfig p
default toPartialConsensusConfig ::
PartialConsensusConfig p ~ ConsensusConfig p =>
proxy p ->
ConsensusConfig p ->
PartialConsensusConfig p
toPartialConsensusConfig proxy p
_ = ConsensusConfig p -> ConsensusConfig p
ConsensusConfig p -> PartialConsensusConfig p
forall a. a -> a
id
class
( UpdateLedger blk
, Show (PartialLedgerConfig blk)
, NoThunks (PartialLedgerConfig blk)
) =>
HasPartialLedgerConfig blk
where
type PartialLedgerConfig blk :: Type
type PartialLedgerConfig blk = LedgerConfig blk
completeLedgerConfig ::
proxy blk ->
EpochInfo (Except PastHorizonException) ->
PartialLedgerConfig blk ->
LedgerConfig blk
default completeLedgerConfig ::
PartialLedgerConfig blk ~ LedgerConfig blk =>
proxy blk ->
EpochInfo (Except PastHorizonException) ->
PartialLedgerConfig blk ->
LedgerConfig blk
completeLedgerConfig proxy blk
_ EpochInfo (Except PastHorizonException)
_ = PartialLedgerConfig blk -> LedgerConfig blk
PartialLedgerConfig blk -> PartialLedgerConfig blk
forall a. a -> a
id
newtype WrapPartialLedgerConfig blk = WrapPartialLedgerConfig
{forall blk. WrapPartialLedgerConfig blk -> PartialLedgerConfig blk
unwrapPartialLedgerConfig :: PartialLedgerConfig blk}
newtype WrapPartialConsensusConfig blk = WrapPartialConsensusConfig
{forall blk.
WrapPartialConsensusConfig blk
-> PartialConsensusConfig (BlockProtocol blk)
unwrapPartialConsensusConfig :: PartialConsensusConfig (BlockProtocol blk)}
deriving instance
NoThunks (PartialLedgerConfig blk) => NoThunks (WrapPartialLedgerConfig blk)
deriving instance
NoThunks (PartialConsensusConfig (BlockProtocol blk)) => NoThunks (WrapPartialConsensusConfig blk)
deriving newtype instance
SerialiseNodeToClient blk (PartialLedgerConfig blk) =>
SerialiseNodeToClient blk (WrapPartialLedgerConfig blk)