{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.HardFork.Combinator.Protocol (
    -- * Re-exports to keep 'Protocol.State' an internal module
    HardForkCanBeLeader
  , HardForkChainDepState
  , HardForkIsLeader
  , HardForkValidationErr (..)
    -- * Re-exports to keep 'Protocol.LedgerView' an internal module
  , HardForkLedgerView
  , HardForkLedgerView_ (..)
    -- * Type family instances
  , Ticked (..)
  ) where

import           Control.Monad.Except
import           Data.Functor.Product
import           Data.SOP.Strict
import           GHC.Generics (Generic)
import           GHC.Stack
import           NoThunks.Class (NoThunks)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Protocol.Abstract
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Consensus.Util ((.:))
import qualified Ouroboros.Consensus.Util.OptNP as OptNP
import           Ouroboros.Consensus.Util.SOP

import           Ouroboros.Consensus.HardFork.Combinator.Abstract
import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import           Ouroboros.Consensus.HardFork.Combinator.Basics
import           Ouroboros.Consensus.HardFork.Combinator.Block
import           Ouroboros.Consensus.HardFork.Combinator.Info
import           Ouroboros.Consensus.HardFork.Combinator.PartialConfig
import           Ouroboros.Consensus.HardFork.Combinator.Protocol.ChainSel
import           Ouroboros.Consensus.HardFork.Combinator.Protocol.LedgerView
                     (HardForkLedgerView, HardForkLedgerView_ (..), Ticked (..))
import           Ouroboros.Consensus.HardFork.Combinator.State (HardForkState,
                     Translate (..))
import qualified Ouroboros.Consensus.HardFork.Combinator.State as State
import           Ouroboros.Consensus.HardFork.Combinator.Translation
import           Ouroboros.Consensus.HardFork.Combinator.Util.InPairs
                     (InPairs (..))
import qualified Ouroboros.Consensus.HardFork.Combinator.Util.InPairs as InPairs
import qualified Ouroboros.Consensus.HardFork.Combinator.Util.Match as Match

{-------------------------------------------------------------------------------
  ChainSelection
-------------------------------------------------------------------------------}

newtype HardForkSelectView xs = HardForkSelectView {
      HardForkSelectView xs -> WithBlockNo OneEraSelectView xs
getHardForkSelectView :: WithBlockNo OneEraSelectView xs
    }
  deriving (Int -> HardForkSelectView xs -> ShowS
[HardForkSelectView xs] -> ShowS
HardForkSelectView xs -> String
(Int -> HardForkSelectView xs -> ShowS)
-> (HardForkSelectView xs -> String)
-> ([HardForkSelectView xs] -> ShowS)
-> Show (HardForkSelectView xs)
forall (xs :: [*]).
CanHardFork xs =>
Int -> HardForkSelectView xs -> ShowS
forall (xs :: [*]).
CanHardFork xs =>
[HardForkSelectView xs] -> ShowS
forall (xs :: [*]).
CanHardFork xs =>
HardForkSelectView xs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HardForkSelectView xs] -> ShowS
$cshowList :: forall (xs :: [*]).
CanHardFork xs =>
[HardForkSelectView xs] -> ShowS
show :: HardForkSelectView xs -> String
$cshow :: forall (xs :: [*]).
CanHardFork xs =>
HardForkSelectView xs -> String
showsPrec :: Int -> HardForkSelectView xs -> ShowS
$cshowsPrec :: forall (xs :: [*]).
CanHardFork xs =>
Int -> HardForkSelectView xs -> ShowS
Show, HardForkSelectView xs -> HardForkSelectView xs -> Bool
(HardForkSelectView xs -> HardForkSelectView xs -> Bool)
-> (HardForkSelectView xs -> HardForkSelectView xs -> Bool)
-> Eq (HardForkSelectView xs)
forall (xs :: [*]).
CanHardFork xs =>
HardForkSelectView xs -> HardForkSelectView xs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HardForkSelectView xs -> HardForkSelectView xs -> Bool
$c/= :: forall (xs :: [*]).
CanHardFork xs =>
HardForkSelectView xs -> HardForkSelectView xs -> Bool
== :: HardForkSelectView xs -> HardForkSelectView xs -> Bool
$c== :: forall (xs :: [*]).
CanHardFork xs =>
HardForkSelectView xs -> HardForkSelectView xs -> Bool
Eq)
  deriving newtype (Context -> HardForkSelectView xs -> IO (Maybe ThunkInfo)
Proxy (HardForkSelectView xs) -> String
(Context -> HardForkSelectView xs -> IO (Maybe ThunkInfo))
-> (Context -> HardForkSelectView xs -> IO (Maybe ThunkInfo))
-> (Proxy (HardForkSelectView xs) -> String)
-> NoThunks (HardForkSelectView xs)
forall (xs :: [*]).
CanHardFork xs =>
Context -> HardForkSelectView xs -> IO (Maybe ThunkInfo)
forall (xs :: [*]).
CanHardFork xs =>
Proxy (HardForkSelectView xs) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (HardForkSelectView xs) -> String
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (HardForkSelectView xs) -> String
wNoThunks :: Context -> HardForkSelectView xs -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> HardForkSelectView xs -> IO (Maybe ThunkInfo)
noThunks :: Context -> HardForkSelectView xs -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> HardForkSelectView xs -> IO (Maybe ThunkInfo)
NoThunks)

instance CanHardFork xs => Ord (HardForkSelectView xs) where
  compare :: HardForkSelectView xs -> HardForkSelectView xs -> Ordering
compare (HardForkSelectView WithBlockNo OneEraSelectView xs
l) (HardForkSelectView WithBlockNo OneEraSelectView xs
r) =
     Tails AcrossEraSelection xs
-> WithBlockNo (NS WrapSelectView) xs
-> WithBlockNo (NS WrapSelectView) xs
-> Ordering
forall (xs :: [*]).
All SingleEraBlock xs =>
Tails AcrossEraSelection xs
-> WithBlockNo (NS WrapSelectView) xs
-> WithBlockNo (NS WrapSelectView) xs
-> Ordering
acrossEraSelection
       Tails AcrossEraSelection xs
forall (xs :: [*]). CanHardFork xs => Tails AcrossEraSelection xs
hardForkChainSel
       ((OneEraSelectView xs -> NS WrapSelectView xs)
-> WithBlockNo OneEraSelectView xs
-> WithBlockNo (NS WrapSelectView) xs
forall k1 k2 (f :: k1 -> *) (x :: k1) (g :: k2 -> *) (y :: k2).
(f x -> g y) -> WithBlockNo f x -> WithBlockNo g y
mapWithBlockNo OneEraSelectView xs -> NS WrapSelectView xs
forall (xs :: [*]). OneEraSelectView xs -> NS WrapSelectView xs
getOneEraSelectView WithBlockNo OneEraSelectView xs
l)
       ((OneEraSelectView xs -> NS WrapSelectView xs)
-> WithBlockNo OneEraSelectView xs
-> WithBlockNo (NS WrapSelectView) xs
forall k1 k2 (f :: k1 -> *) (x :: k1) (g :: k2 -> *) (y :: k2).
(f x -> g y) -> WithBlockNo f x -> WithBlockNo g y
mapWithBlockNo OneEraSelectView xs -> NS WrapSelectView xs
forall (xs :: [*]). OneEraSelectView xs -> NS WrapSelectView xs
getOneEraSelectView WithBlockNo OneEraSelectView xs
r)

mkHardForkSelectView ::
     BlockNo
  -> NS WrapSelectView xs
  -> HardForkSelectView xs
mkHardForkSelectView :: BlockNo -> NS WrapSelectView xs -> HardForkSelectView xs
mkHardForkSelectView BlockNo
bno NS WrapSelectView xs
view =
    WithBlockNo OneEraSelectView xs -> HardForkSelectView xs
forall (xs :: [*]).
WithBlockNo OneEraSelectView xs -> HardForkSelectView xs
HardForkSelectView (WithBlockNo OneEraSelectView xs -> HardForkSelectView xs)
-> WithBlockNo OneEraSelectView xs -> HardForkSelectView xs
forall a b. (a -> b) -> a -> b
$ BlockNo -> OneEraSelectView xs -> WithBlockNo OneEraSelectView xs
forall k (f :: k -> *) (a :: k). BlockNo -> f a -> WithBlockNo f a
WithBlockNo BlockNo
bno (NS WrapSelectView xs -> OneEraSelectView xs
forall (xs :: [*]). NS WrapSelectView xs -> OneEraSelectView xs
OneEraSelectView NS WrapSelectView xs
view)

{-------------------------------------------------------------------------------
  ConsensusProtocol
-------------------------------------------------------------------------------}

type HardForkChainDepState xs = HardForkState WrapChainDepState xs

instance CanHardFork xs => ConsensusProtocol (HardForkProtocol xs) where
  type ChainDepState (HardForkProtocol xs) = HardForkChainDepState xs
  type ValidationErr (HardForkProtocol xs) = HardForkValidationErr xs
  type SelectView    (HardForkProtocol xs) = HardForkSelectView    xs
  type LedgerView    (HardForkProtocol xs) = HardForkLedgerView    xs
  type CanBeLeader   (HardForkProtocol xs) = HardForkCanBeLeader   xs
  type IsLeader      (HardForkProtocol xs) = HardForkIsLeader      xs
  type ValidateView  (HardForkProtocol xs) = OneEraValidateView    xs

  -- Operations on the state

  tickChainDepState :: ConsensusConfig (HardForkProtocol xs)
-> Ticked (LedgerView (HardForkProtocol xs))
-> SlotNo
-> ChainDepState (HardForkProtocol xs)
-> Ticked (ChainDepState (HardForkProtocol xs))
tickChainDepState     = ConsensusConfig (HardForkProtocol xs)
-> Ticked (LedgerView (HardForkProtocol xs))
-> SlotNo
-> ChainDepState (HardForkProtocol xs)
-> Ticked (ChainDepState (HardForkProtocol xs))
forall (xs :: [*]).
CanHardFork xs =>
ConsensusConfig (HardForkProtocol xs)
-> Ticked (HardForkLedgerView xs)
-> SlotNo
-> HardForkChainDepState xs
-> Ticked (HardForkChainDepState xs)
tick
  checkIsLeader :: ConsensusConfig (HardForkProtocol xs)
-> CanBeLeader (HardForkProtocol xs)
-> SlotNo
-> Ticked (ChainDepState (HardForkProtocol xs))
-> Maybe (IsLeader (HardForkProtocol xs))
checkIsLeader         = ConsensusConfig (HardForkProtocol xs)
-> CanBeLeader (HardForkProtocol xs)
-> SlotNo
-> Ticked (ChainDepState (HardForkProtocol xs))
-> Maybe (IsLeader (HardForkProtocol xs))
forall (xs :: [*]).
(CanHardFork xs, HasCallStack) =>
ConsensusConfig (HardForkProtocol xs)
-> HardForkCanBeLeader xs
-> SlotNo
-> Ticked (ChainDepState (HardForkProtocol xs))
-> Maybe (HardForkIsLeader xs)
check
  updateChainDepState :: ConsensusConfig (HardForkProtocol xs)
-> ValidateView (HardForkProtocol xs)
-> SlotNo
-> Ticked (ChainDepState (HardForkProtocol xs))
-> Except
     (ValidationErr (HardForkProtocol xs))
     (ChainDepState (HardForkProtocol xs))
updateChainDepState   = ConsensusConfig (HardForkProtocol xs)
-> ValidateView (HardForkProtocol xs)
-> SlotNo
-> Ticked (ChainDepState (HardForkProtocol xs))
-> Except
     (ValidationErr (HardForkProtocol xs))
     (ChainDepState (HardForkProtocol xs))
forall (xs :: [*]).
CanHardFork xs =>
ConsensusConfig (HardForkProtocol xs)
-> OneEraValidateView xs
-> SlotNo
-> Ticked (HardForkChainDepState xs)
-> Except (HardForkValidationErr xs) (HardForkChainDepState xs)
update
  reupdateChainDepState :: ConsensusConfig (HardForkProtocol xs)
-> ValidateView (HardForkProtocol xs)
-> SlotNo
-> Ticked (ChainDepState (HardForkProtocol xs))
-> ChainDepState (HardForkProtocol xs)
reupdateChainDepState = ConsensusConfig (HardForkProtocol xs)
-> ValidateView (HardForkProtocol xs)
-> SlotNo
-> Ticked (ChainDepState (HardForkProtocol xs))
-> ChainDepState (HardForkProtocol xs)
forall (xs :: [*]).
CanHardFork xs =>
ConsensusConfig (HardForkProtocol xs)
-> OneEraValidateView xs
-> SlotNo
-> Ticked (HardForkChainDepState xs)
-> HardForkChainDepState xs
reupdate

  --
  -- Straight-forward extensions
  --

  -- Security parameter must be equal across /all/ eras
  protocolSecurityParam :: ConsensusConfig (HardForkProtocol xs) -> SecurityParam
protocolSecurityParam = ConsensusConfig (HardForkProtocol xs) -> SecurityParam
forall (xs :: [*]).
ConsensusConfig (HardForkProtocol xs) -> SecurityParam
hardForkConsensusConfigK

{-------------------------------------------------------------------------------
  BlockSupportsProtocol
-------------------------------------------------------------------------------}

instance CanHardFork xs => BlockSupportsProtocol (HardForkBlock xs) where
  validateView :: BlockConfig (HardForkBlock xs)
-> Header (HardForkBlock xs)
-> ValidateView (BlockProtocol (HardForkBlock xs))
validateView HardForkBlockConfig{..} =
        NS WrapValidateView xs -> OneEraValidateView xs
forall (xs :: [*]). NS WrapValidateView xs -> OneEraValidateView xs
OneEraValidateView
      (NS WrapValidateView xs -> OneEraValidateView xs)
-> (Header (HardForkBlock xs) -> NS WrapValidateView xs)
-> Header (HardForkBlock xs)
-> OneEraValidateView xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    BlockConfig a -> Header a -> WrapValidateView a)
-> Prod NS BlockConfig xs
-> NS Header xs
-> NS WrapValidateView xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hczipWith Proxy SingleEraBlock
proxySingle (ValidateView (BlockProtocol a) -> WrapValidateView a
forall blk.
ValidateView (BlockProtocol blk) -> WrapValidateView blk
WrapValidateView (ValidateView (BlockProtocol a) -> WrapValidateView a)
-> (BlockConfig a -> Header a -> ValidateView (BlockProtocol a))
-> BlockConfig a
-> Header a
-> WrapValidateView a
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: BlockConfig a -> Header a -> ValidateView (BlockProtocol a)
forall blk.
BlockSupportsProtocol blk =>
BlockConfig blk -> Header blk -> ValidateView (BlockProtocol blk)
validateView) Prod NS BlockConfig xs
NP BlockConfig xs
cfgs
      (NS Header xs -> NS WrapValidateView xs)
-> (Header (HardForkBlock xs) -> NS Header xs)
-> Header (HardForkBlock xs)
-> NS WrapValidateView xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraHeader xs -> NS Header xs
forall (xs :: [*]). OneEraHeader xs -> NS Header xs
getOneEraHeader
      (OneEraHeader xs -> NS Header xs)
-> (Header (HardForkBlock xs) -> OneEraHeader xs)
-> Header (HardForkBlock xs)
-> NS Header xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (HardForkBlock xs) -> OneEraHeader xs
forall (xs :: [*]). Header (HardForkBlock xs) -> OneEraHeader xs
getHardForkHeader
    where
      cfgs :: NP BlockConfig xs
cfgs = PerEraBlockConfig xs -> NP BlockConfig xs
forall (xs :: [*]). PerEraBlockConfig xs -> NP BlockConfig xs
getPerEraBlockConfig PerEraBlockConfig xs
hardForkBlockConfigPerEra

  selectView :: BlockConfig (HardForkBlock xs)
-> Header (HardForkBlock xs)
-> SelectView (BlockProtocol (HardForkBlock xs))
selectView HardForkBlockConfig{..} Header (HardForkBlock xs)
hdr =
        BlockNo -> NS WrapSelectView xs -> HardForkSelectView xs
forall (xs :: [*]).
BlockNo -> NS WrapSelectView xs -> HardForkSelectView xs
mkHardForkSelectView (Header (HardForkBlock xs) -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo Header (HardForkBlock xs)
hdr)
      (NS WrapSelectView xs -> HardForkSelectView xs)
-> (OneEraHeader xs -> NS WrapSelectView xs)
-> OneEraHeader xs
-> HardForkSelectView xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    BlockConfig a -> Header a -> WrapSelectView a)
-> Prod NS BlockConfig xs
-> NS Header xs
-> NS WrapSelectView xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hczipWith Proxy SingleEraBlock
proxySingle (SelectView (BlockProtocol a) -> WrapSelectView a
forall blk. SelectView (BlockProtocol blk) -> WrapSelectView blk
WrapSelectView (SelectView (BlockProtocol a) -> WrapSelectView a)
-> (BlockConfig a -> Header a -> SelectView (BlockProtocol a))
-> BlockConfig a
-> Header a
-> WrapSelectView a
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: BlockConfig a -> Header a -> SelectView (BlockProtocol a)
forall blk.
BlockSupportsProtocol blk =>
BlockConfig blk -> Header blk -> SelectView (BlockProtocol blk)
selectView) Prod NS BlockConfig xs
NP BlockConfig xs
cfgs
      (NS Header xs -> NS WrapSelectView xs)
-> (OneEraHeader xs -> NS Header xs)
-> OneEraHeader xs
-> NS WrapSelectView xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraHeader xs -> NS Header xs
forall (xs :: [*]). OneEraHeader xs -> NS Header xs
getOneEraHeader
      (OneEraHeader xs -> HardForkSelectView xs)
-> OneEraHeader xs -> HardForkSelectView xs
forall a b. (a -> b) -> a -> b
$ Header (HardForkBlock xs) -> OneEraHeader xs
forall (xs :: [*]). Header (HardForkBlock xs) -> OneEraHeader xs
getHardForkHeader Header (HardForkBlock xs)
hdr
    where
      cfgs :: NP BlockConfig xs
cfgs = PerEraBlockConfig xs -> NP BlockConfig xs
forall (xs :: [*]). PerEraBlockConfig xs -> NP BlockConfig xs
getPerEraBlockConfig PerEraBlockConfig xs
hardForkBlockConfigPerEra

{-------------------------------------------------------------------------------
  Ticking the chain dependent state
-------------------------------------------------------------------------------}

data instance Ticked (HardForkChainDepState xs) =
    TickedHardForkChainDepState {
        Ticked (HardForkChainDepState xs)
-> HardForkState (Ticked :.: WrapChainDepState) xs
tickedHardForkChainDepStatePerEra ::
             HardForkState (Ticked :.: WrapChainDepState) xs

        -- | 'EpochInfo' constructed from the ticked 'LedgerView'
      , Ticked (HardForkChainDepState xs)
-> EpochInfo (Except PastHorizonException)
tickedHardForkChainDepStateEpochInfo ::
             EpochInfo (Except PastHorizonException)
      }

tick :: CanHardFork xs
     => ConsensusConfig (HardForkProtocol xs)
     -> Ticked (HardForkLedgerView xs)
     -> SlotNo
     -> HardForkChainDepState xs
     -> Ticked (HardForkChainDepState xs)
tick :: ConsensusConfig (HardForkProtocol xs)
-> Ticked (HardForkLedgerView xs)
-> SlotNo
-> HardForkChainDepState xs
-> Ticked (HardForkChainDepState xs)
tick cfg :: ConsensusConfig (HardForkProtocol xs)
cfg@HardForkConsensusConfig{..}
     (TickedHardForkLedgerView transition ledgerView)
     SlotNo
slot
     HardForkChainDepState xs
chainDepState = TickedHardForkChainDepState :: forall (xs :: [*]).
HardForkState (Ticked :.: WrapChainDepState) xs
-> EpochInfo (Except PastHorizonException)
-> Ticked (HardForkChainDepState xs)
TickedHardForkChainDepState {
      tickedHardForkChainDepStateEpochInfo :: EpochInfo (Except PastHorizonException)
tickedHardForkChainDepStateEpochInfo = EpochInfo (Except PastHorizonException)
ei
    , tickedHardForkChainDepStatePerEra :: HardForkState (Ticked :.: WrapChainDepState) xs
tickedHardForkChainDepStatePerEra =
         InPairs (Translate WrapChainDepState) xs
-> NP
     ((Ticked :.: WrapLedgerView)
      -.-> (WrapChainDepState -.-> (Ticked :.: WrapChainDepState)))
     xs
-> HardForkState (Ticked :.: WrapLedgerView) xs
-> HardForkChainDepState xs
-> HardForkState (Ticked :.: WrapChainDepState) xs
forall (xs :: [*]) (f :: * -> *) (f' :: * -> *) (f'' :: * -> *).
All SingleEraBlock xs =>
InPairs (Translate f) xs
-> NP (f' -.-> (f -.-> f'')) xs
-> HardForkState f' xs
-> HardForkState f xs
-> HardForkState f'' xs
State.align
           (EpochInfo (Except PastHorizonException)
-> ConsensusConfig (HardForkProtocol xs)
-> InPairs (Translate WrapChainDepState) xs
forall (xs :: [*]).
CanHardFork xs =>
EpochInfo (Except PastHorizonException)
-> ConsensusConfig (HardForkProtocol xs)
-> InPairs (Translate WrapChainDepState) xs
translateConsensus EpochInfo (Except PastHorizonException)
ei ConsensusConfig (HardForkProtocol xs)
cfg)
           (Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPartialConsensusConfig a
    -> (-.->)
         (Ticked :.: WrapLedgerView)
         (WrapChainDepState -.-> (Ticked :.: WrapChainDepState))
         a)
-> NP WrapPartialConsensusConfig xs
-> NP
     ((Ticked :.: WrapLedgerView)
      -.-> (WrapChainDepState -.-> (Ticked :.: WrapChainDepState)))
     xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle (((:.:) Ticked WrapLedgerView a
 -> WrapChainDepState a -> (:.:) Ticked WrapChainDepState a)
-> (-.->)
     (Ticked :.: WrapLedgerView)
     (WrapChainDepState -.-> (Ticked :.: WrapChainDepState))
     a
forall k (f :: k -> *) (a :: k) (f' :: k -> *) (f'' :: k -> *).
(f a -> f' a -> f'' a) -> (-.->) f (f' -.-> f'') a
fn_2 (((:.:) Ticked WrapLedgerView a
  -> WrapChainDepState a -> (:.:) Ticked WrapChainDepState a)
 -> (-.->)
      (Ticked :.: WrapLedgerView)
      (WrapChainDepState -.-> (Ticked :.: WrapChainDepState))
      a)
-> (WrapPartialConsensusConfig a
    -> (:.:) Ticked WrapLedgerView a
    -> WrapChainDepState a
    -> (:.:) Ticked WrapChainDepState a)
-> WrapPartialConsensusConfig a
-> (-.->)
     (Ticked :.: WrapLedgerView)
     (WrapChainDepState -.-> (Ticked :.: WrapChainDepState))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPartialConsensusConfig a
-> (:.:) Ticked WrapLedgerView a
-> WrapChainDepState a
-> (:.:) Ticked WrapChainDepState a
forall blk.
SingleEraBlock blk =>
WrapPartialConsensusConfig blk
-> (:.:) Ticked WrapLedgerView blk
-> WrapChainDepState blk
-> (:.:) Ticked WrapChainDepState blk
tickOne) NP WrapPartialConsensusConfig xs
cfgs)
           HardForkState (Ticked :.: WrapLedgerView) xs
ledgerView
           HardForkChainDepState xs
chainDepState
    }
  where
    cfgs :: NP WrapPartialConsensusConfig xs
cfgs = PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
forall (xs :: [*]).
PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
getPerEraConsensusConfig PerEraConsensusConfig xs
hardForkConsensusConfigPerEra
    ei :: EpochInfo (Except PastHorizonException)
ei   = Shape xs
-> TransitionInfo
-> HardForkState (Ticked :.: WrapLedgerView) xs
-> EpochInfo (Except PastHorizonException)
forall (xs :: [*]) (f :: * -> *).
Shape xs
-> TransitionInfo
-> HardForkState f xs
-> EpochInfo (Except PastHorizonException)
State.epochInfoPrecomputedTransitionInfo
             Shape xs
hardForkConsensusConfigShape
             TransitionInfo
transition
             HardForkState (Ticked :.: WrapLedgerView) xs
ledgerView

    tickOne :: SingleEraBlock                 blk
            => WrapPartialConsensusConfig     blk
            -> (Ticked :.: WrapLedgerView)    blk
            -> WrapChainDepState              blk
            -> (Ticked :.: WrapChainDepState) blk
    tickOne :: WrapPartialConsensusConfig blk
-> (:.:) Ticked WrapLedgerView blk
-> WrapChainDepState blk
-> (:.:) Ticked WrapChainDepState blk
tickOne WrapPartialConsensusConfig blk
cfg' (Comp Ticked (WrapLedgerView blk)
ledgerView') WrapChainDepState blk
chainDepState' = Ticked (WrapChainDepState blk)
-> (:.:) Ticked WrapChainDepState blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Ticked (WrapChainDepState blk)
 -> (:.:) Ticked WrapChainDepState blk)
-> Ticked (WrapChainDepState blk)
-> (:.:) Ticked WrapChainDepState blk
forall a b. (a -> b) -> a -> b
$
        Ticked (ChainDepState (BlockProtocol blk))
-> Ticked (WrapChainDepState blk)
forall blk.
Ticked (ChainDepState (BlockProtocol blk))
-> Ticked (WrapChainDepState blk)
WrapTickedChainDepState (Ticked (ChainDepState (BlockProtocol blk))
 -> Ticked (WrapChainDepState blk))
-> Ticked (ChainDepState (BlockProtocol blk))
-> Ticked (WrapChainDepState blk)
forall a b. (a -> b) -> a -> b
$
          ConsensusConfig (BlockProtocol blk)
-> Ticked (LedgerView (BlockProtocol blk))
-> SlotNo
-> ChainDepState (BlockProtocol blk)
-> Ticked (ChainDepState (BlockProtocol blk))
forall p.
ConsensusProtocol p =>
ConsensusConfig p
-> Ticked (LedgerView p)
-> SlotNo
-> ChainDepState p
-> Ticked (ChainDepState p)
tickChainDepState
            (EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
forall blk.
HasPartialConsensusConfig (BlockProtocol blk) =>
EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
completeConsensusConfig' EpochInfo (Except PastHorizonException)
ei WrapPartialConsensusConfig blk
cfg')
            (Ticked (WrapLedgerView blk)
-> Ticked (LedgerView (BlockProtocol blk))
forall blk.
Ticked (WrapLedgerView blk)
-> Ticked (LedgerView (BlockProtocol blk))
unwrapTickedLedgerView Ticked (WrapLedgerView blk)
ledgerView')
            SlotNo
slot
            (WrapChainDepState blk -> ChainDepState (BlockProtocol blk)
forall blk.
WrapChainDepState blk -> ChainDepState (BlockProtocol blk)
unwrapChainDepState WrapChainDepState blk
chainDepState')

{-------------------------------------------------------------------------------
  Leader check

  NOTE: The precondition to 'align' is satisfied: the consensus state will never
  be ahead (but possibly behind) the ledger state, which we tick first.
-------------------------------------------------------------------------------}

-- | We are a leader if we have a proof from one of the eras
type HardForkIsLeader xs = OneEraIsLeader xs

-- | We have one or more 'BlockForging's, and thus 'CanBeLeader' proofs, for
-- each era in which we can forge blocks.
type HardForkCanBeLeader xs = SomeErasCanBeLeader xs

-- | POSTCONDITION: if the result is @Just isLeader@, then 'HardForkCanBeLeader'
-- and the ticked 'ChainDepState' must be in the same era. The returned
-- @isLeader@ will be from the same era.
check :: forall xs. (CanHardFork xs, HasCallStack)
      => ConsensusConfig (HardForkProtocol xs)
      -> HardForkCanBeLeader xs
      -> SlotNo
      -> Ticked (ChainDepState (HardForkProtocol xs))
      -> Maybe (HardForkIsLeader xs)
check :: ConsensusConfig (HardForkProtocol xs)
-> HardForkCanBeLeader xs
-> SlotNo
-> Ticked (ChainDepState (HardForkProtocol xs))
-> Maybe (HardForkIsLeader xs)
check HardForkConsensusConfig{..}
      (SomeErasCanBeLeader NonEmptyOptNP WrapCanBeLeader xs
canBeLeader)
      SlotNo
slot
      (TickedHardForkChainDepState chainDepState ei) =
    NS (Maybe :.: WrapIsLeader) xs -> Maybe (HardForkIsLeader xs)
undistrib (NS (Maybe :.: WrapIsLeader) xs -> Maybe (HardForkIsLeader xs))
-> NS (Maybe :.: WrapIsLeader) xs -> Maybe (HardForkIsLeader xs)
forall a b. (a -> b) -> a -> b
$
      Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPartialConsensusConfig a
    -> (:.:) Maybe WrapCanBeLeader a
    -> (:.:) Ticked WrapChainDepState a
    -> (:.:) Maybe WrapIsLeader a)
-> Prod NS WrapPartialConsensusConfig xs
-> Prod NS (Maybe :.: WrapCanBeLeader) xs
-> NS (Ticked :.: WrapChainDepState) xs
-> NS (Maybe :.: WrapIsLeader) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *) (f''' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a -> f''' a)
-> Prod h f xs
-> Prod h f' xs
-> h f'' xs
-> h f''' xs
hczipWith3
        Proxy SingleEraBlock
proxySingle
        forall a.
SingleEraBlock a =>
WrapPartialConsensusConfig a
-> (:.:) Maybe WrapCanBeLeader a
-> (:.:) Ticked WrapChainDepState a
-> (:.:) Maybe WrapIsLeader a
checkOne
        Prod NS WrapPartialConsensusConfig xs
NP WrapPartialConsensusConfig xs
cfgs
        (NonEmptyOptNP WrapCanBeLeader xs
-> NP (Maybe :.: WrapCanBeLeader) xs
forall k (empty :: Bool) (f :: k -> *) (xs :: [k]).
OptNP empty f xs -> NP (Maybe :.: f) xs
OptNP.toNP NonEmptyOptNP WrapCanBeLeader xs
canBeLeader)
        (HardForkState (Ticked :.: WrapChainDepState) xs
-> NS (Ticked :.: WrapChainDepState) xs
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
HardForkState f xs -> NS f xs
State.tip HardForkState (Ticked :.: WrapChainDepState) xs
chainDepState)
  where
    cfgs :: NP WrapPartialConsensusConfig xs
cfgs = PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
forall (xs :: [*]).
PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
getPerEraConsensusConfig PerEraConsensusConfig xs
hardForkConsensusConfigPerEra

    checkOne ::
         SingleEraBlock                 blk
      => WrapPartialConsensusConfig     blk
      -> (Maybe :.: WrapCanBeLeader)    blk
      -> (Ticked :.: WrapChainDepState) blk
      -> (Maybe :.: WrapIsLeader)       blk
    checkOne :: WrapPartialConsensusConfig blk
-> (:.:) Maybe WrapCanBeLeader blk
-> (:.:) Ticked WrapChainDepState blk
-> (:.:) Maybe WrapIsLeader blk
checkOne WrapPartialConsensusConfig blk
cfg' (Comp Maybe (WrapCanBeLeader blk)
mCanBeLeader) (Comp Ticked (WrapChainDepState blk)
chainDepState') = Maybe (WrapIsLeader blk) -> (:.:) Maybe WrapIsLeader blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Maybe (WrapIsLeader blk) -> (:.:) Maybe WrapIsLeader blk)
-> Maybe (WrapIsLeader blk) -> (:.:) Maybe WrapIsLeader blk
forall a b. (a -> b) -> a -> b
$ do
        WrapCanBeLeader blk
canBeLeader' <- Maybe (WrapCanBeLeader blk)
mCanBeLeader
        IsLeader (BlockProtocol blk) -> WrapIsLeader blk
forall blk. IsLeader (BlockProtocol blk) -> WrapIsLeader blk
WrapIsLeader (IsLeader (BlockProtocol blk) -> WrapIsLeader blk)
-> Maybe (IsLeader (BlockProtocol blk)) -> Maybe (WrapIsLeader blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          ConsensusConfig (BlockProtocol blk)
-> CanBeLeader (BlockProtocol blk)
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> Maybe (IsLeader (BlockProtocol blk))
forall p.
(ConsensusProtocol p, HasCallStack) =>
ConsensusConfig p
-> CanBeLeader p
-> SlotNo
-> Ticked (ChainDepState p)
-> Maybe (IsLeader p)
checkIsLeader
            (EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
forall blk.
HasPartialConsensusConfig (BlockProtocol blk) =>
EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
completeConsensusConfig' EpochInfo (Except PastHorizonException)
ei WrapPartialConsensusConfig blk
cfg')
            (WrapCanBeLeader blk -> CanBeLeader (BlockProtocol blk)
forall blk. WrapCanBeLeader blk -> CanBeLeader (BlockProtocol blk)
unwrapCanBeLeader WrapCanBeLeader blk
canBeLeader')
            SlotNo
slot
            (Ticked (WrapChainDepState blk)
-> Ticked (ChainDepState (BlockProtocol blk))
forall blk.
Ticked (WrapChainDepState blk)
-> Ticked (ChainDepState (BlockProtocol blk))
unwrapTickedChainDepState Ticked (WrapChainDepState blk)
chainDepState')

    undistrib :: NS (Maybe :.: WrapIsLeader) xs -> Maybe (HardForkIsLeader xs)
    undistrib :: NS (Maybe :.: WrapIsLeader) xs -> Maybe (HardForkIsLeader xs)
undistrib = NS (K (Maybe (HardForkIsLeader xs))) xs
-> Maybe (HardForkIsLeader xs)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K (Maybe (HardForkIsLeader xs))) xs
 -> Maybe (HardForkIsLeader xs))
-> (NS (Maybe :.: WrapIsLeader) xs
    -> NS (K (Maybe (HardForkIsLeader xs))) xs)
-> NS (Maybe :.: WrapIsLeader) xs
-> Maybe (HardForkIsLeader xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 Index xs a
 -> (:.:) Maybe WrapIsLeader a -> K (Maybe (HardForkIsLeader xs)) a)
-> NS (Maybe :.: WrapIsLeader) xs
-> NS (K (Maybe (HardForkIsLeader xs))) xs
forall k (h :: (k -> *) -> [k] -> *) (xs :: [k]) (f1 :: k -> *)
       (f2 :: k -> *).
(HAp h, SListI xs, Prod h ~ NP) =>
(forall (a :: k). Index xs a -> f1 a -> f2 a) -> h f1 xs -> h f2 xs
himap forall a.
Index xs a
-> (:.:) Maybe WrapIsLeader a -> K (Maybe (HardForkIsLeader xs)) a
inj
      where
        inj :: Index xs blk
            -> (Maybe :.: WrapIsLeader) blk
            -> K (Maybe (HardForkIsLeader xs)) blk
        inj :: Index xs blk
-> (:.:) Maybe WrapIsLeader blk
-> K (Maybe (HardForkIsLeader xs)) blk
inj Index xs blk
index (Comp Maybe (WrapIsLeader blk)
mIsLeader) = Maybe (HardForkIsLeader xs) -> K (Maybe (HardForkIsLeader xs)) blk
forall k a (b :: k). a -> K a b
K (Maybe (HardForkIsLeader xs)
 -> K (Maybe (HardForkIsLeader xs)) blk)
-> Maybe (HardForkIsLeader xs)
-> K (Maybe (HardForkIsLeader xs)) blk
forall a b. (a -> b) -> a -> b
$
            NS WrapIsLeader xs -> HardForkIsLeader xs
forall (xs :: [*]). NS WrapIsLeader xs -> OneEraIsLeader xs
OneEraIsLeader (NS WrapIsLeader xs -> HardForkIsLeader xs)
-> (WrapIsLeader blk -> NS WrapIsLeader xs)
-> WrapIsLeader blk
-> HardForkIsLeader xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk -> WrapIsLeader blk -> NS WrapIsLeader xs
forall k (f :: k -> *) (x :: k) (xs :: [k]).
Index xs x -> f x -> NS f xs
injectNS Index xs blk
index (WrapIsLeader blk -> HardForkIsLeader xs)
-> Maybe (WrapIsLeader blk) -> Maybe (HardForkIsLeader xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (WrapIsLeader blk)
mIsLeader

{-------------------------------------------------------------------------------
  Rolling forward and backward
-------------------------------------------------------------------------------}

data HardForkValidationErr xs =
    -- | Validation error from one of the eras
    HardForkValidationErrFromEra (OneEraValidationErr xs)

    -- | We tried to apply a block from the wrong era
  | HardForkValidationErrWrongEra (MismatchEraInfo xs)
  deriving ((forall x.
 HardForkValidationErr xs -> Rep (HardForkValidationErr xs) x)
-> (forall x.
    Rep (HardForkValidationErr xs) x -> HardForkValidationErr xs)
-> Generic (HardForkValidationErr xs)
forall (xs :: [*]) x.
Rep (HardForkValidationErr xs) x -> HardForkValidationErr xs
forall (xs :: [*]) x.
HardForkValidationErr xs -> Rep (HardForkValidationErr xs) x
forall x.
Rep (HardForkValidationErr xs) x -> HardForkValidationErr xs
forall x.
HardForkValidationErr xs -> Rep (HardForkValidationErr xs) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (xs :: [*]) x.
Rep (HardForkValidationErr xs) x -> HardForkValidationErr xs
$cfrom :: forall (xs :: [*]) x.
HardForkValidationErr xs -> Rep (HardForkValidationErr xs) x
Generic)

update :: forall xs. CanHardFork xs
       => ConsensusConfig (HardForkProtocol xs)
       -> OneEraValidateView xs
       -> SlotNo
       -> Ticked (HardForkChainDepState xs)
       -> Except (HardForkValidationErr xs) (HardForkChainDepState xs)
update :: ConsensusConfig (HardForkProtocol xs)
-> OneEraValidateView xs
-> SlotNo
-> Ticked (HardForkChainDepState xs)
-> Except (HardForkValidationErr xs) (HardForkChainDepState xs)
update HardForkConsensusConfig{..}
       (OneEraValidateView NS WrapValidateView xs
view)
       SlotNo
slot
       (TickedHardForkChainDepState chainDepState ei) =
    case NS WrapValidateView xs
-> HardForkState (Ticked :.: WrapChainDepState) xs
-> Either
     (Mismatch
        WrapValidateView (Current (Ticked :.: WrapChainDepState)) xs)
     (HardForkState
        (Product WrapValidateView (Ticked :.: WrapChainDepState)) xs)
forall (xs :: [*]) (h :: * -> *) (f :: * -> *).
SListI xs =>
NS h xs
-> HardForkState f xs
-> Either
     (Mismatch h (Current f) xs) (HardForkState (Product h f) xs)
State.match NS WrapValidateView xs
view HardForkState (Ticked :.: WrapChainDepState) xs
chainDepState of
      Left Mismatch
  WrapValidateView (Current (Ticked :.: WrapChainDepState)) xs
mismatch ->
        HardForkValidationErr xs
-> Except (HardForkValidationErr xs) (HardForkChainDepState xs)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (HardForkValidationErr xs
 -> Except (HardForkValidationErr xs) (HardForkChainDepState xs))
-> HardForkValidationErr xs
-> Except (HardForkValidationErr xs) (HardForkChainDepState xs)
forall a b. (a -> b) -> a -> b
$ MismatchEraInfo xs -> HardForkValidationErr xs
forall (xs :: [*]). MismatchEraInfo xs -> HardForkValidationErr xs
HardForkValidationErrWrongEra (MismatchEraInfo xs -> HardForkValidationErr xs)
-> (Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs)
-> Mismatch SingleEraInfo LedgerEraInfo xs
-> HardForkValidationErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
forall (xs :: [*]).
Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
MismatchEraInfo (Mismatch SingleEraInfo LedgerEraInfo xs
 -> HardForkValidationErr xs)
-> Mismatch SingleEraInfo LedgerEraInfo xs
-> HardForkValidationErr xs
forall a b. (a -> b) -> a -> b
$
          Proxy SingleEraBlock
-> (forall x.
    SingleEraBlock x =>
    WrapValidateView x -> SingleEraInfo x)
-> (forall x.
    SingleEraBlock x =>
    Current (Ticked :.: WrapChainDepState) x -> LedgerEraInfo x)
-> Mismatch
     WrapValidateView (Current (Ticked :.: WrapChainDepState)) xs
-> Mismatch SingleEraInfo LedgerEraInfo xs
forall k (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> *) (f :: k -> *) (f' :: k -> *)
       (g :: k -> *) (g' :: k -> *).
All c xs =>
proxy c
-> (forall (x :: k). c x => f x -> f' x)
-> (forall (x :: k). c x => g x -> g' x)
-> Mismatch f g xs
-> Mismatch f' g' xs
Match.bihcmap
            Proxy SingleEraBlock
proxySingle
            forall x. SingleEraBlock x => WrapValidateView x -> SingleEraInfo x
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
singleEraInfo
            (SingleEraInfo x -> LedgerEraInfo x
forall blk. SingleEraInfo blk -> LedgerEraInfo blk
LedgerEraInfo (SingleEraInfo x -> LedgerEraInfo x)
-> (Current (Ticked :.: WrapChainDepState) x -> SingleEraInfo x)
-> Current (Ticked :.: WrapChainDepState) x
-> LedgerEraInfo x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:.:) Ticked WrapChainDepState x -> SingleEraInfo x
forall blk.
SingleEraBlock blk =>
(:.:) Ticked WrapChainDepState blk -> SingleEraInfo blk
chainDepStateInfo ((:.:) Ticked WrapChainDepState x -> SingleEraInfo x)
-> (Current (Ticked :.: WrapChainDepState) x
    -> (:.:) Ticked WrapChainDepState x)
-> Current (Ticked :.: WrapChainDepState) x
-> SingleEraInfo x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current (Ticked :.: WrapChainDepState) x
-> (:.:) Ticked WrapChainDepState x
forall (f :: * -> *) blk. Current f blk -> f blk
State.currentState)
            Mismatch
  WrapValidateView (Current (Ticked :.: WrapChainDepState)) xs
mismatch
      Right HardForkState
  (Product WrapValidateView (Ticked :.: WrapChainDepState)) xs
matched ->
           HardForkState
  (ExceptT (HardForkValidationErr xs) Identity :.: WrapChainDepState)
  xs
-> Except (HardForkValidationErr xs) (HardForkChainDepState xs)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: * -> *)
       (g :: k -> *).
(HSequence h, SListIN h xs, Applicative f) =>
h (f :.: g) xs -> f (h g xs)
hsequence'
         (HardForkState
   (ExceptT (HardForkValidationErr xs) Identity :.: WrapChainDepState)
   xs
 -> Except (HardForkValidationErr xs) (HardForkChainDepState xs))
-> (HardForkState
      (Product WrapValidateView (Ticked :.: WrapChainDepState)) xs
    -> HardForkState
         (ExceptT (HardForkValidationErr xs) Identity :.: WrapChainDepState)
         xs)
-> HardForkState
     (Product WrapValidateView (Ticked :.: WrapChainDepState)) xs
-> Except (HardForkValidationErr xs) (HardForkChainDepState xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Index xs a
    -> WrapPartialConsensusConfig a
    -> Product WrapValidateView (Ticked :.: WrapChainDepState) a
    -> (:.:)
         (ExceptT (HardForkValidationErr xs) Identity) WrapChainDepState a)
-> NP WrapPartialConsensusConfig xs
-> HardForkState
     (Product WrapValidateView (Ticked :.: WrapChainDepState)) xs
-> HardForkState
     (ExceptT (HardForkValidationErr xs) Identity :.: WrapChainDepState)
     xs
forall k (h :: (k -> *) -> [k] -> *) (c :: k -> Constraint)
       (xs :: [k]) (proxy :: (k -> Constraint) -> *) (f1 :: k -> *)
       (f2 :: k -> *) (f3 :: k -> *).
(HAp h, All c xs, Prod h ~ NP) =>
proxy c
-> (forall (a :: k). c a => Index xs a -> f1 a -> f2 a -> f3 a)
-> NP f1 xs
-> h f2 xs
-> h f3 xs
hcizipWith Proxy SingleEraBlock
proxySingle (EpochInfo (Except PastHorizonException)
-> SlotNo
-> Index xs a
-> WrapPartialConsensusConfig a
-> Product WrapValidateView (Ticked :.: WrapChainDepState) a
-> (:.:)
     (ExceptT (HardForkValidationErr xs) Identity) WrapChainDepState a
forall (xs :: [*]) blk.
SingleEraBlock blk =>
EpochInfo (Except PastHorizonException)
-> SlotNo
-> Index xs blk
-> WrapPartialConsensusConfig blk
-> Product WrapValidateView (Ticked :.: WrapChainDepState) blk
-> (:.:) (Except (HardForkValidationErr xs)) WrapChainDepState blk
updateEra EpochInfo (Except PastHorizonException)
ei SlotNo
slot) NP WrapPartialConsensusConfig xs
cfgs
         (HardForkState
   (Product WrapValidateView (Ticked :.: WrapChainDepState)) xs
 -> Except (HardForkValidationErr xs) (HardForkChainDepState xs))
-> HardForkState
     (Product WrapValidateView (Ticked :.: WrapChainDepState)) xs
-> Except (HardForkValidationErr xs) (HardForkChainDepState xs)
forall a b. (a -> b) -> a -> b
$ HardForkState
  (Product WrapValidateView (Ticked :.: WrapChainDepState)) xs
matched
  where
    cfgs :: NP WrapPartialConsensusConfig xs
cfgs = PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
forall (xs :: [*]).
PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
getPerEraConsensusConfig PerEraConsensusConfig xs
hardForkConsensusConfigPerEra

updateEra :: forall xs blk. SingleEraBlock blk
          => EpochInfo (Except PastHorizonException)
          -> SlotNo
          -> Index xs blk
          -> WrapPartialConsensusConfig blk
          -> Product WrapValidateView (Ticked :.: WrapChainDepState) blk
          -> (Except (HardForkValidationErr xs) :.: WrapChainDepState) blk
updateEra :: EpochInfo (Except PastHorizonException)
-> SlotNo
-> Index xs blk
-> WrapPartialConsensusConfig blk
-> Product WrapValidateView (Ticked :.: WrapChainDepState) blk
-> (:.:) (Except (HardForkValidationErr xs)) WrapChainDepState blk
updateEra EpochInfo (Except PastHorizonException)
ei SlotNo
slot Index xs blk
index WrapPartialConsensusConfig blk
cfg
          (Pair WrapValidateView blk
view (Comp Ticked (WrapChainDepState blk)
chainDepState)) = ExceptT (HardForkValidationErr xs) Identity (WrapChainDepState blk)
-> (:.:) (Except (HardForkValidationErr xs)) WrapChainDepState blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (ExceptT
   (HardForkValidationErr xs) Identity (WrapChainDepState blk)
 -> (:.:) (Except (HardForkValidationErr xs)) WrapChainDepState blk)
-> ExceptT
     (HardForkValidationErr xs) Identity (WrapChainDepState blk)
-> (:.:) (Except (HardForkValidationErr xs)) WrapChainDepState blk
forall a b. (a -> b) -> a -> b
$
    (ValidationErr (BlockProtocol blk) -> HardForkValidationErr xs)
-> Except
     (ValidationErr (BlockProtocol blk)) (WrapChainDepState blk)
-> ExceptT
     (HardForkValidationErr xs) Identity (WrapChainDepState blk)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept (Index xs blk
-> ValidationErr (BlockProtocol blk) -> HardForkValidationErr xs
forall (xs :: [*]) blk.
Index xs blk
-> ValidationErr (BlockProtocol blk) -> HardForkValidationErr xs
injectValidationErr Index xs blk
index) (Except (ValidationErr (BlockProtocol blk)) (WrapChainDepState blk)
 -> ExceptT
      (HardForkValidationErr xs) Identity (WrapChainDepState blk))
-> Except
     (ValidationErr (BlockProtocol blk)) (WrapChainDepState blk)
-> ExceptT
     (HardForkValidationErr xs) Identity (WrapChainDepState blk)
forall a b. (a -> b) -> a -> b
$
      (ChainDepState (BlockProtocol blk) -> WrapChainDepState blk)
-> ExceptT
     (ValidationErr (BlockProtocol blk))
     Identity
     (ChainDepState (BlockProtocol blk))
-> Except
     (ValidationErr (BlockProtocol blk)) (WrapChainDepState blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
forall blk.
ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
WrapChainDepState (ExceptT
   (ValidationErr (BlockProtocol blk))
   Identity
   (ChainDepState (BlockProtocol blk))
 -> Except
      (ValidationErr (BlockProtocol blk)) (WrapChainDepState blk))
-> ExceptT
     (ValidationErr (BlockProtocol blk))
     Identity
     (ChainDepState (BlockProtocol blk))
-> Except
     (ValidationErr (BlockProtocol blk)) (WrapChainDepState blk)
forall a b. (a -> b) -> a -> b
$
        ConsensusConfig (BlockProtocol blk)
-> ValidateView (BlockProtocol blk)
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> ExceptT
     (ValidationErr (BlockProtocol blk))
     Identity
     (ChainDepState (BlockProtocol blk))
forall p.
(ConsensusProtocol p, HasCallStack) =>
ConsensusConfig p
-> ValidateView p
-> SlotNo
-> Ticked (ChainDepState p)
-> Except (ValidationErr p) (ChainDepState p)
updateChainDepState
          (EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
forall blk.
HasPartialConsensusConfig (BlockProtocol blk) =>
EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
completeConsensusConfig' EpochInfo (Except PastHorizonException)
ei WrapPartialConsensusConfig blk
cfg)
          (WrapValidateView blk -> ValidateView (BlockProtocol blk)
forall blk.
WrapValidateView blk -> ValidateView (BlockProtocol blk)
unwrapValidateView WrapValidateView blk
view)
          SlotNo
slot
          (Ticked (WrapChainDepState blk)
-> Ticked (ChainDepState (BlockProtocol blk))
forall blk.
Ticked (WrapChainDepState blk)
-> Ticked (ChainDepState (BlockProtocol blk))
unwrapTickedChainDepState Ticked (WrapChainDepState blk)
chainDepState)

reupdate :: forall xs. CanHardFork xs
         => ConsensusConfig (HardForkProtocol xs)
         -> OneEraValidateView xs
         -> SlotNo
         -> Ticked (HardForkChainDepState xs)
         -> HardForkChainDepState xs
reupdate :: ConsensusConfig (HardForkProtocol xs)
-> OneEraValidateView xs
-> SlotNo
-> Ticked (HardForkChainDepState xs)
-> HardForkChainDepState xs
reupdate HardForkConsensusConfig{..}
         (OneEraValidateView NS WrapValidateView xs
view)
         SlotNo
slot
         (TickedHardForkChainDepState chainDepState ei) =
    case NS WrapValidateView xs
-> HardForkState (Ticked :.: WrapChainDepState) xs
-> Either
     (Mismatch
        WrapValidateView (Current (Ticked :.: WrapChainDepState)) xs)
     (HardForkState
        (Product WrapValidateView (Ticked :.: WrapChainDepState)) xs)
forall (xs :: [*]) (h :: * -> *) (f :: * -> *).
SListI xs =>
NS h xs
-> HardForkState f xs
-> Either
     (Mismatch h (Current f) xs) (HardForkState (Product h f) xs)
State.match NS WrapValidateView xs
view HardForkState (Ticked :.: WrapChainDepState) xs
chainDepState of
      Left Mismatch
  WrapValidateView (Current (Ticked :.: WrapChainDepState)) xs
mismatch ->
        String -> HardForkChainDepState xs
forall a. HasCallStack => String -> a
error (String -> HardForkChainDepState xs)
-> String -> HardForkChainDepState xs
forall a b. (a -> b) -> a -> b
$ HardForkValidationErr xs -> String
forall a. Show a => a -> String
show (HardForkValidationErr xs -> String)
-> (Mismatch SingleEraInfo LedgerEraInfo xs
    -> HardForkValidationErr xs)
-> Mismatch SingleEraInfo LedgerEraInfo xs
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MismatchEraInfo xs -> HardForkValidationErr xs
forall (xs :: [*]). MismatchEraInfo xs -> HardForkValidationErr xs
HardForkValidationErrWrongEra (MismatchEraInfo xs -> HardForkValidationErr xs)
-> (Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs)
-> Mismatch SingleEraInfo LedgerEraInfo xs
-> HardForkValidationErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
forall (xs :: [*]).
Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
MismatchEraInfo (Mismatch SingleEraInfo LedgerEraInfo xs -> String)
-> Mismatch SingleEraInfo LedgerEraInfo xs -> String
forall a b. (a -> b) -> a -> b
$
          Proxy SingleEraBlock
-> (forall x.
    SingleEraBlock x =>
    WrapValidateView x -> SingleEraInfo x)
-> (forall x.
    SingleEraBlock x =>
    Current (Ticked :.: WrapChainDepState) x -> LedgerEraInfo x)
-> Mismatch
     WrapValidateView (Current (Ticked :.: WrapChainDepState)) xs
-> Mismatch SingleEraInfo LedgerEraInfo xs
forall k (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> *) (f :: k -> *) (f' :: k -> *)
       (g :: k -> *) (g' :: k -> *).
All c xs =>
proxy c
-> (forall (x :: k). c x => f x -> f' x)
-> (forall (x :: k). c x => g x -> g' x)
-> Mismatch f g xs
-> Mismatch f' g' xs
Match.bihcmap
            Proxy SingleEraBlock
proxySingle
            forall x. SingleEraBlock x => WrapValidateView x -> SingleEraInfo x
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
singleEraInfo
            (SingleEraInfo x -> LedgerEraInfo x
forall blk. SingleEraInfo blk -> LedgerEraInfo blk
LedgerEraInfo (SingleEraInfo x -> LedgerEraInfo x)
-> (Current (Ticked :.: WrapChainDepState) x -> SingleEraInfo x)
-> Current (Ticked :.: WrapChainDepState) x
-> LedgerEraInfo x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:.:) Ticked WrapChainDepState x -> SingleEraInfo x
forall blk.
SingleEraBlock blk =>
(:.:) Ticked WrapChainDepState blk -> SingleEraInfo blk
chainDepStateInfo ((:.:) Ticked WrapChainDepState x -> SingleEraInfo x)
-> (Current (Ticked :.: WrapChainDepState) x
    -> (:.:) Ticked WrapChainDepState x)
-> Current (Ticked :.: WrapChainDepState) x
-> SingleEraInfo x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current (Ticked :.: WrapChainDepState) x
-> (:.:) Ticked WrapChainDepState x
forall (f :: * -> *) blk. Current f blk -> f blk
State.currentState)
            Mismatch
  WrapValidateView (Current (Ticked :.: WrapChainDepState)) xs
mismatch
      Right HardForkState
  (Product WrapValidateView (Ticked :.: WrapChainDepState)) xs
matched ->
           Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPartialConsensusConfig a
    -> Product WrapValidateView (Ticked :.: WrapChainDepState) a
    -> WrapChainDepState a)
-> Prod HardForkState WrapPartialConsensusConfig xs
-> HardForkState
     (Product WrapValidateView (Ticked :.: WrapChainDepState)) xs
-> HardForkChainDepState xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hczipWith Proxy SingleEraBlock
proxySingle (EpochInfo (Except PastHorizonException)
-> SlotNo
-> WrapPartialConsensusConfig a
-> Product WrapValidateView (Ticked :.: WrapChainDepState) a
-> WrapChainDepState a
forall blk.
SingleEraBlock blk =>
EpochInfo (Except PastHorizonException)
-> SlotNo
-> WrapPartialConsensusConfig blk
-> Product WrapValidateView (Ticked :.: WrapChainDepState) blk
-> WrapChainDepState blk
reupdateEra EpochInfo (Except PastHorizonException)
ei SlotNo
slot) Prod HardForkState WrapPartialConsensusConfig xs
NP WrapPartialConsensusConfig xs
cfgs
         (HardForkState
   (Product WrapValidateView (Ticked :.: WrapChainDepState)) xs
 -> HardForkChainDepState xs)
-> HardForkState
     (Product WrapValidateView (Ticked :.: WrapChainDepState)) xs
-> HardForkChainDepState xs
forall a b. (a -> b) -> a -> b
$ HardForkState
  (Product WrapValidateView (Ticked :.: WrapChainDepState)) xs
matched
  where
    cfgs :: NP WrapPartialConsensusConfig xs
cfgs = PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
forall (xs :: [*]).
PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
getPerEraConsensusConfig PerEraConsensusConfig xs
hardForkConsensusConfigPerEra

reupdateEra :: SingleEraBlock blk
            => EpochInfo (Except PastHorizonException)
            -> SlotNo
            -> WrapPartialConsensusConfig blk
            -> Product WrapValidateView (Ticked :.: WrapChainDepState) blk
            -> WrapChainDepState blk
reupdateEra :: EpochInfo (Except PastHorizonException)
-> SlotNo
-> WrapPartialConsensusConfig blk
-> Product WrapValidateView (Ticked :.: WrapChainDepState) blk
-> WrapChainDepState blk
reupdateEra EpochInfo (Except PastHorizonException)
ei SlotNo
slot WrapPartialConsensusConfig blk
cfg (Pair WrapValidateView blk
view (Comp Ticked (WrapChainDepState blk)
chainDepState)) =
    ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
forall blk.
ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
WrapChainDepState (ChainDepState (BlockProtocol blk) -> WrapChainDepState blk)
-> ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
forall a b. (a -> b) -> a -> b
$
      ConsensusConfig (BlockProtocol blk)
-> ValidateView (BlockProtocol blk)
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> ChainDepState (BlockProtocol blk)
forall p.
(ConsensusProtocol p, HasCallStack) =>
ConsensusConfig p
-> ValidateView p
-> SlotNo
-> Ticked (ChainDepState p)
-> ChainDepState p
reupdateChainDepState
        (EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
forall blk.
HasPartialConsensusConfig (BlockProtocol blk) =>
EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
completeConsensusConfig' EpochInfo (Except PastHorizonException)
ei WrapPartialConsensusConfig blk
cfg)
        (WrapValidateView blk -> ValidateView (BlockProtocol blk)
forall blk.
WrapValidateView blk -> ValidateView (BlockProtocol blk)
unwrapValidateView WrapValidateView blk
view)
        SlotNo
slot
        (Ticked (WrapChainDepState blk)
-> Ticked (ChainDepState (BlockProtocol blk))
forall blk.
Ticked (WrapChainDepState blk)
-> Ticked (ChainDepState (BlockProtocol blk))
unwrapTickedChainDepState Ticked (WrapChainDepState blk)
chainDepState)

{-------------------------------------------------------------------------------
  Auxiliary
-------------------------------------------------------------------------------}

chainDepStateInfo :: forall blk. SingleEraBlock blk
                  => (Ticked :.: WrapChainDepState) blk -> SingleEraInfo blk
chainDepStateInfo :: (:.:) Ticked WrapChainDepState blk -> SingleEraInfo blk
chainDepStateInfo (:.:) Ticked WrapChainDepState blk
_ = Proxy blk -> SingleEraInfo blk
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
singleEraInfo (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk)

translateConsensus :: forall xs. CanHardFork xs
                   => EpochInfo (Except PastHorizonException)
                   -> ConsensusConfig (HardForkProtocol xs)
                   -> InPairs (Translate WrapChainDepState) xs
translateConsensus :: EpochInfo (Except PastHorizonException)
-> ConsensusConfig (HardForkProtocol xs)
-> InPairs (Translate WrapChainDepState) xs
translateConsensus EpochInfo (Except PastHorizonException)
ei HardForkConsensusConfig{..} =
    NP WrapConsensusConfig xs
-> InPairs
     (RequiringBoth WrapConsensusConfig (Translate WrapChainDepState))
     xs
-> InPairs (Translate WrapChainDepState) xs
forall k (h :: k -> *) (xs :: [k]) (f :: k -> k -> *).
NP h xs -> InPairs (RequiringBoth h f) xs -> InPairs f xs
InPairs.requiringBoth NP WrapConsensusConfig xs
cfgs (InPairs
   (RequiringBoth WrapConsensusConfig (Translate WrapChainDepState))
   xs
 -> InPairs (Translate WrapChainDepState) xs)
-> InPairs
     (RequiringBoth WrapConsensusConfig (Translate WrapChainDepState))
     xs
-> InPairs (Translate WrapChainDepState) xs
forall a b. (a -> b) -> a -> b
$
       EraTranslation xs
-> InPairs
     (RequiringBoth WrapConsensusConfig (Translate WrapChainDepState))
     xs
forall (xs :: [*]).
EraTranslation xs
-> InPairs
     (RequiringBoth WrapConsensusConfig (Translate WrapChainDepState))
     xs
translateChainDepState EraTranslation xs
forall (xs :: [*]). CanHardFork xs => EraTranslation xs
hardForkEraTranslation
  where
    pcfgs :: NP WrapPartialConsensusConfig xs
pcfgs = PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
forall (xs :: [*]).
PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
getPerEraConsensusConfig PerEraConsensusConfig xs
hardForkConsensusConfigPerEra
    cfgs :: NP WrapConsensusConfig xs
cfgs  = Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPartialConsensusConfig a -> WrapConsensusConfig a)
-> NP WrapPartialConsensusConfig xs
-> NP WrapConsensusConfig xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle (EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig a -> WrapConsensusConfig a
forall blk.
HasPartialConsensusConfig (BlockProtocol blk) =>
EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk -> WrapConsensusConfig blk
completeConsensusConfig'' EpochInfo (Except PastHorizonException)
ei) NP WrapPartialConsensusConfig xs
pcfgs

injectValidationErr :: Index xs blk
                    -> ValidationErr (BlockProtocol blk)
                    -> HardForkValidationErr xs
injectValidationErr :: Index xs blk
-> ValidationErr (BlockProtocol blk) -> HardForkValidationErr xs
injectValidationErr Index xs blk
index =
      OneEraValidationErr xs -> HardForkValidationErr xs
forall (xs :: [*]).
OneEraValidationErr xs -> HardForkValidationErr xs
HardForkValidationErrFromEra
    (OneEraValidationErr xs -> HardForkValidationErr xs)
-> (ValidationErr (BlockProtocol blk) -> OneEraValidationErr xs)
-> ValidationErr (BlockProtocol blk)
-> HardForkValidationErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapValidationErr xs -> OneEraValidationErr xs
forall (xs :: [*]).
NS WrapValidationErr xs -> OneEraValidationErr xs
OneEraValidationErr
    (NS WrapValidationErr xs -> OneEraValidationErr xs)
-> (ValidationErr (BlockProtocol blk) -> NS WrapValidationErr xs)
-> ValidationErr (BlockProtocol blk)
-> OneEraValidationErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk -> WrapValidationErr blk -> NS WrapValidationErr xs
forall k (f :: k -> *) (x :: k) (xs :: [k]).
Index xs x -> f x -> NS f xs
injectNS Index xs blk
index
    (WrapValidationErr blk -> NS WrapValidationErr xs)
-> (ValidationErr (BlockProtocol blk) -> WrapValidationErr blk)
-> ValidationErr (BlockProtocol blk)
-> NS WrapValidationErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidationErr (BlockProtocol blk) -> WrapValidationErr blk
forall blk.
ValidationErr (BlockProtocol blk) -> WrapValidationErr blk
WrapValidationErr

{-------------------------------------------------------------------------------
  Instances
-------------------------------------------------------------------------------}

deriving instance CanHardFork xs => Eq       (HardForkValidationErr xs)
deriving instance CanHardFork xs => Show     (HardForkValidationErr xs)
deriving instance CanHardFork xs => NoThunks (HardForkValidationErr xs)