{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}

module Ouroboros.Consensus.Protocol.ModChainSel (
    ModChainSel
    -- * Type family instances
  , ConsensusConfig (..)
  ) where

import           Data.Proxy (Proxy (..))
import           Data.Typeable (Typeable)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)

import           Ouroboros.Consensus.Protocol.Abstract

data ModChainSel p s

data instance ConsensusConfig (ModChainSel p s) = McsConsensusConfig {
      ConsensusConfig (ModChainSel p s) -> ChainSelConfig s
mcsConfigS :: ChainSelConfig  s
    , ConsensusConfig (ModChainSel p s) -> ConsensusConfig p
mcsConfigP :: ConsensusConfig p
    }
  deriving ((forall x.
 ConsensusConfig (ModChainSel p s)
 -> Rep (ConsensusConfig (ModChainSel p s)) x)
-> (forall x.
    Rep (ConsensusConfig (ModChainSel p s)) x
    -> ConsensusConfig (ModChainSel p s))
-> Generic (ConsensusConfig (ModChainSel p s))
forall x.
Rep (ConsensusConfig (ModChainSel p s)) x
-> ConsensusConfig (ModChainSel p s)
forall x.
ConsensusConfig (ModChainSel p s)
-> Rep (ConsensusConfig (ModChainSel p s)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p s x.
Rep (ConsensusConfig (ModChainSel p s)) x
-> ConsensusConfig (ModChainSel p s)
forall p s x.
ConsensusConfig (ModChainSel p s)
-> Rep (ConsensusConfig (ModChainSel p s)) x
$cto :: forall p s x.
Rep (ConsensusConfig (ModChainSel p s)) x
-> ConsensusConfig (ModChainSel p s)
$cfrom :: forall p s x.
ConsensusConfig (ModChainSel p s)
-> Rep (ConsensusConfig (ModChainSel p s)) x
Generic)

instance ChainSelection s => ChainSelection (ModChainSel p s) where
  type ChainSelConfig (ModChainSel p s) = ChainSelConfig s
  type SelectView     (ModChainSel p s) = SelectView     s

  preferCandidate :: proxy (ModChainSel p s)
-> ChainSelConfig (ModChainSel p s)
-> SelectView (ModChainSel p s)
-> SelectView (ModChainSel p s)
-> Bool
preferCandidate   proxy (ModChainSel p s)
_ = Proxy s -> ChainSelConfig s -> SelectView s -> SelectView s -> Bool
forall p (proxy :: * -> *).
ChainSelection p =>
proxy p -> ChainSelConfig p -> SelectView p -> SelectView p -> Bool
preferCandidate   (Proxy s
forall k (t :: k). Proxy t
Proxy @s)
  compareCandidates :: proxy (ModChainSel p s)
-> ChainSelConfig (ModChainSel p s)
-> SelectView (ModChainSel p s)
-> SelectView (ModChainSel p s)
-> Ordering
compareCandidates proxy (ModChainSel p s)
_ = Proxy s
-> ChainSelConfig s -> SelectView s -> SelectView s -> Ordering
forall p (proxy :: * -> *).
ChainSelection p =>
proxy p
-> ChainSelConfig p -> SelectView p -> SelectView p -> Ordering
compareCandidates (Proxy s
forall k (t :: k). Proxy t
Proxy @s)

instance (Typeable p, Typeable s, ConsensusProtocol p, ChainSelection s)
      => ConsensusProtocol (ModChainSel p s) where
    type ChainDepState (ModChainSel p s) = ChainDepState p
    type IsLeader      (ModChainSel p s) = IsLeader      p
    type CanBeLeader   (ModChainSel p s) = CanBeLeader   p
    type LedgerView    (ModChainSel p s) = LedgerView    p
    type ValidationErr (ModChainSel p s) = ValidationErr p
    type ValidateView  (ModChainSel p s) = ValidateView  p

    checkIsLeader :: ConsensusConfig (ModChainSel p s)
-> CanBeLeader (ModChainSel p s)
-> SlotNo
-> Ticked (ChainDepState (ModChainSel p s))
-> Maybe (IsLeader (ModChainSel p s))
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 s) -> ConsensusConfig p)
-> ConsensusConfig (ModChainSel p s)
-> CanBeLeader p
-> SlotNo
-> Ticked (ChainDepState p)
-> Maybe (IsLeader p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (ModChainSel p s) -> ConsensusConfig p
forall p s. ConsensusConfig (ModChainSel p s) -> ConsensusConfig p
mcsConfigP
    tickChainDepState :: ConsensusConfig (ModChainSel p s)
-> Ticked (LedgerView (ModChainSel p s))
-> SlotNo
-> ChainDepState (ModChainSel p s)
-> Ticked (ChainDepState (ModChainSel p s))
tickChainDepState     = ConsensusConfig p
-> Ticked (LedgerView p)
-> SlotNo
-> ChainDepState p
-> Ticked (ChainDepState p)
forall p.
ConsensusProtocol p =>
ConsensusConfig p
-> Ticked (LedgerView p)
-> SlotNo
-> ChainDepState p
-> Ticked (ChainDepState p)
tickChainDepState     (ConsensusConfig p
 -> Ticked (LedgerView p)
 -> SlotNo
 -> ChainDepState p
 -> Ticked (ChainDepState p))
-> (ConsensusConfig (ModChainSel p s) -> ConsensusConfig p)
-> ConsensusConfig (ModChainSel p s)
-> Ticked (LedgerView p)
-> SlotNo
-> ChainDepState p
-> Ticked (ChainDepState p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (ModChainSel p s) -> ConsensusConfig p
forall p s. ConsensusConfig (ModChainSel p s) -> ConsensusConfig p
mcsConfigP
    updateChainDepState :: ConsensusConfig (ModChainSel p s)
-> ValidateView (ModChainSel p s)
-> SlotNo
-> Ticked (ChainDepState (ModChainSel p s))
-> Except
     (ValidationErr (ModChainSel p s)) (ChainDepState (ModChainSel p s))
updateChainDepState   = ConsensusConfig p
-> ValidateView p
-> SlotNo
-> Ticked (ChainDepState p)
-> ExceptT (ValidationErr p) Identity (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)
 -> ExceptT (ValidationErr p) Identity (ChainDepState p))
-> (ConsensusConfig (ModChainSel p s) -> ConsensusConfig p)
-> ConsensusConfig (ModChainSel p s)
-> ValidateView p
-> SlotNo
-> Ticked (ChainDepState p)
-> ExceptT (ValidationErr p) Identity (ChainDepState p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (ModChainSel p s) -> ConsensusConfig p
forall p s. ConsensusConfig (ModChainSel p s) -> ConsensusConfig p
mcsConfigP
    reupdateChainDepState :: ConsensusConfig (ModChainSel p s)
-> ValidateView (ModChainSel p s)
-> SlotNo
-> Ticked (ChainDepState (ModChainSel p s))
-> ChainDepState (ModChainSel p s)
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 s) -> ConsensusConfig p)
-> ConsensusConfig (ModChainSel p s)
-> ValidateView p
-> SlotNo
-> Ticked (ChainDepState p)
-> ChainDepState p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (ModChainSel p s) -> ConsensusConfig p
forall p s. ConsensusConfig (ModChainSel p s) -> ConsensusConfig p
mcsConfigP
    protocolSecurityParam :: ConsensusConfig (ModChainSel p s) -> SecurityParam
protocolSecurityParam = ConsensusConfig p -> SecurityParam
forall p. ConsensusProtocol p => ConsensusConfig p -> SecurityParam
protocolSecurityParam (ConsensusConfig p -> SecurityParam)
-> (ConsensusConfig (ModChainSel p s) -> ConsensusConfig p)
-> ConsensusConfig (ModChainSel p s)
-> SecurityParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (ModChainSel p s) -> ConsensusConfig p
forall p s. ConsensusConfig (ModChainSel p s) -> ConsensusConfig p
mcsConfigP

    chainSelConfig :: ConsensusConfig (ModChainSel p s)
-> ChainSelConfig (ModChainSel p s)
chainSelConfig = ConsensusConfig (ModChainSel p s)
-> ChainSelConfig (ModChainSel p s)
forall p s. ConsensusConfig (ModChainSel p s) -> ChainSelConfig s
mcsConfigS

instance (ConsensusProtocol p, ChainSelection s)
      => NoThunks (ConsensusConfig (ModChainSel p s))