{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}

module Ouroboros.Consensus.Protocol.ModChainSel
  ( ModChainSel

    -- * Type family instances
  , ConsensusConfig (..)
  ) where

import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Protocol.Abstract

data ModChainSel p t

newtype instance ConsensusConfig (ModChainSel p t) = McsConsensusConfig
  { forall p t. ConsensusConfig (ModChainSel p t) -> ConsensusConfig p
mcsConfigP :: ConsensusConfig p
  }
  deriving (forall x.
 ConsensusConfig (ModChainSel p t)
 -> Rep (ConsensusConfig (ModChainSel p t)) x)
-> (forall x.
    Rep (ConsensusConfig (ModChainSel p t)) x
    -> ConsensusConfig (ModChainSel p t))
-> Generic (ConsensusConfig (ModChainSel p t))
forall x.
Rep (ConsensusConfig (ModChainSel p t)) x
-> ConsensusConfig (ModChainSel p t)
forall x.
ConsensusConfig (ModChainSel p t)
-> Rep (ConsensusConfig (ModChainSel p t)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p t x.
Rep (ConsensusConfig (ModChainSel p t)) x
-> ConsensusConfig (ModChainSel p t)
forall p t x.
ConsensusConfig (ModChainSel p t)
-> Rep (ConsensusConfig (ModChainSel p t)) x
$cfrom :: forall p t x.
ConsensusConfig (ModChainSel p t)
-> Rep (ConsensusConfig (ModChainSel p t)) x
from :: forall x.
ConsensusConfig (ModChainSel p t)
-> Rep (ConsensusConfig (ModChainSel p t)) x
$cto :: forall p t x.
Rep (ConsensusConfig (ModChainSel p t)) x
-> ConsensusConfig (ModChainSel p t)
to :: forall x.
Rep (ConsensusConfig (ModChainSel p t)) x
-> ConsensusConfig (ModChainSel p t)
Generic

instance
  ( ConsensusProtocol p
  , ChainOrder t
  , Show t
  , Typeable t
  , NoThunks t
  ) =>
  ConsensusProtocol (ModChainSel p t)
  where
  type TiebreakerView (ModChainSel p t) = t

  type ChainDepState (ModChainSel p t) = ChainDepState p
  type IsLeader (ModChainSel p t) = IsLeader p
  type CanBeLeader (ModChainSel p t) = CanBeLeader p
  type LedgerView (ModChainSel p t) = LedgerView p
  type ValidationErr (ModChainSel p t) = ValidationErr p
  type ValidateView (ModChainSel p t) = ValidateView p

  checkIsLeader :: HasCallStack =>
ConsensusConfig (ModChainSel p t)
-> CanBeLeader (ModChainSel p t)
-> SlotNo
-> Ticked (ChainDepState (ModChainSel p t))
-> Maybe (IsLeader (ModChainSel p t))
checkIsLeader = ConsensusConfig p
-> CanBeLeader p
-> SlotNo
-> Ticked (ChainDepState p)
-> Maybe (IsLeader p)
forall p.
(ConsensusProtocol p, HasCallStack) =>
ConsensusConfig p
-> CanBeLeader p
-> SlotNo
-> Ticked (ChainDepState p)
-> Maybe (IsLeader p)
checkIsLeader (ConsensusConfig p
 -> CanBeLeader p
 -> SlotNo
 -> Ticked (ChainDepState p)
 -> Maybe (IsLeader p))
-> (ConsensusConfig (ModChainSel p t) -> ConsensusConfig p)
-> ConsensusConfig (ModChainSel p t)
-> CanBeLeader p
-> SlotNo
-> Ticked (ChainDepState p)
-> Maybe (IsLeader p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (ModChainSel p t) -> ConsensusConfig p
forall p t. ConsensusConfig (ModChainSel p t) -> ConsensusConfig p
mcsConfigP
  tickChainDepState :: ConsensusConfig (ModChainSel p t)
-> LedgerView (ModChainSel p t)
-> SlotNo
-> ChainDepState (ModChainSel p t)
-> Ticked (ChainDepState (ModChainSel p t))
tickChainDepState = ConsensusConfig p
-> LedgerView p
-> SlotNo
-> ChainDepState p
-> Ticked (ChainDepState p)
forall p.
ConsensusProtocol p =>
ConsensusConfig p
-> LedgerView p
-> SlotNo
-> ChainDepState p
-> Ticked (ChainDepState p)
tickChainDepState (ConsensusConfig p
 -> LedgerView p
 -> SlotNo
 -> ChainDepState p
 -> Ticked (ChainDepState p))
-> (ConsensusConfig (ModChainSel p t) -> ConsensusConfig p)
-> ConsensusConfig (ModChainSel p t)
-> LedgerView p
-> SlotNo
-> ChainDepState p
-> Ticked (ChainDepState p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (ModChainSel p t) -> ConsensusConfig p
forall p t. ConsensusConfig (ModChainSel p t) -> ConsensusConfig p
mcsConfigP
  updateChainDepState :: HasCallStack =>
ConsensusConfig (ModChainSel p t)
-> ValidateView (ModChainSel p t)
-> SlotNo
-> Ticked (ChainDepState (ModChainSel p t))
-> Except
     (ValidationErr (ModChainSel p t)) (ChainDepState (ModChainSel p t))
updateChainDepState = ConsensusConfig p
-> ValidateView p
-> SlotNo
-> Ticked (ChainDepState p)
-> Except (ValidationErr p) (ChainDepState p)
forall p.
(ConsensusProtocol p, HasCallStack) =>
ConsensusConfig p
-> ValidateView p
-> SlotNo
-> Ticked (ChainDepState p)
-> Except (ValidationErr p) (ChainDepState p)
updateChainDepState (ConsensusConfig p
 -> ValidateView p
 -> SlotNo
 -> Ticked (ChainDepState p)
 -> Except (ValidationErr p) (ChainDepState p))
-> (ConsensusConfig (ModChainSel p t) -> ConsensusConfig p)
-> ConsensusConfig (ModChainSel p t)
-> ValidateView p
-> SlotNo
-> Ticked (ChainDepState p)
-> Except (ValidationErr p) (ChainDepState p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (ModChainSel p t) -> ConsensusConfig p
forall p t. ConsensusConfig (ModChainSel p t) -> ConsensusConfig p
mcsConfigP
  reupdateChainDepState :: HasCallStack =>
ConsensusConfig (ModChainSel p t)
-> ValidateView (ModChainSel p t)
-> SlotNo
-> Ticked (ChainDepState (ModChainSel p t))
-> ChainDepState (ModChainSel p t)
reupdateChainDepState = ConsensusConfig p
-> ValidateView p
-> SlotNo
-> Ticked (ChainDepState p)
-> ChainDepState p
forall p.
(ConsensusProtocol p, HasCallStack) =>
ConsensusConfig p
-> ValidateView p
-> SlotNo
-> Ticked (ChainDepState p)
-> ChainDepState p
reupdateChainDepState (ConsensusConfig p
 -> ValidateView p
 -> SlotNo
 -> Ticked (ChainDepState p)
 -> ChainDepState p)
-> (ConsensusConfig (ModChainSel p t) -> ConsensusConfig p)
-> ConsensusConfig (ModChainSel p t)
-> ValidateView p
-> SlotNo
-> Ticked (ChainDepState p)
-> ChainDepState p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (ModChainSel p t) -> ConsensusConfig p
forall p t. ConsensusConfig (ModChainSel p t) -> ConsensusConfig p
mcsConfigP
  protocolSecurityParam :: ConsensusConfig (ModChainSel p t) -> SecurityParam
protocolSecurityParam = ConsensusConfig p -> SecurityParam
forall p. ConsensusProtocol p => ConsensusConfig p -> SecurityParam
protocolSecurityParam (ConsensusConfig p -> SecurityParam)
-> (ConsensusConfig (ModChainSel p t) -> ConsensusConfig p)
-> ConsensusConfig (ModChainSel p t)
-> SecurityParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (ModChainSel p t) -> ConsensusConfig p
forall p t. ConsensusConfig (ModChainSel p t) -> ConsensusConfig p
mcsConfigP

instance ConsensusProtocol p => NoThunks (ConsensusConfig (ModChainSel p t))