{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- TODO: figure out how to move the 'IsPerasVote'/'IsPerasCert' next to the
-- definition of 'OneEraPerasVote' and 'OneEraPerasCert'.
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.HardFork.Combinator.Basics
  ( -- * Hard fork protocol, block, and ledger state
    HardForkBlock (..)
  , HardForkProtocol
  , LedgerState (..)

    -- * Config
  , BlockConfig (..)
  , CodecConfig (..)
  , ConsensusConfig (..)
  , HardForkLedgerConfig (..)
  , StorageConfig (..)

    -- ** Functions on config
  , completeConsensusConfig'
  , completeConsensusConfig''
  , completeLedgerConfig'
  , completeLedgerConfig''
  , distribLedgerConfig
  , distribTopLevelConfig

    -- ** Functions on Peras context
  , injectHFCBoundedPerasEpochContext
  , projectHFCBoundedPerasEpochContext
  , injectHFCPerasEpochContextResolver

    -- * HFC injection/projection helpers for Peras
  , distribHardForkPoint
  , injectHardForkPoint

    -- ** Convenience re-exports
  , EpochInfo
  , Except
  ) where

import Cardano.Slotting.EpochInfo
import Data.Bifunctor (bimap)
import Data.Functor.Product (Product (..))
import Data.Kind (Type)
import Data.SOP (I (..), K (..), type (:.:) (..))
import Data.SOP.Constraint
import Data.SOP.Dict (Dict (..))
import qualified Data.SOP.Dict as Dict
import Data.SOP.Either (hdistribute, mkEitherF)
import Data.SOP.Functors
import Data.SOP.Index (himap, injectNS)
import qualified Data.SOP.Match as Match
import Data.SOP.Strict
import Data.Typeable
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block.Abstract
import Ouroboros.Consensus.Block.SupportsPeras
  ( BlockSupportsPeras (..)
  , BoostedBlock
  , IsPerasCert (..)
  , IsPerasError (..)
  , IsPerasVote (..)
  , PerasEpochContext (..)
  , PerasRoundNo
  , PerasVoteCollection (..)
  , PerasVoteCollectionWithQuorum (..)
  , ValidatedPerasCert (..)
  , ValidatedPerasVote (..)
  , castPerasParams
  , unsafeAssumeQuorum
  , unsafePerasVoteCollection
  )
import Ouroboros.Consensus.BlockchainTime (WithArrivalTime (..))
import Ouroboros.Consensus.Committee.Crypto
  ( ElectionId
  , VoteCandidate
  )
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.HardFork.Combinator.Abstract.CanHardFork
  ( CanHardFork
  , EqualHashSizeOfHead
  , HashSizeOfHead
  )
import Ouroboros.Consensus.HardFork.Combinator.Abstract.SingleEraBlock
  ( SingleEraBlock
  , proxySingle
  )
import Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import Ouroboros.Consensus.HardFork.Combinator.PartialConfig
import qualified Ouroboros.Consensus.HardFork.Combinator.State.Infra as State
import Ouroboros.Consensus.HardFork.Combinator.State.Instances ()
import Ouroboros.Consensus.HardFork.Combinator.State.Types
import qualified Ouroboros.Consensus.HardFork.History as History
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.SupportsPeras (LedgerStateSupportsPeras (..))
import Ouroboros.Consensus.Peras.Context
  ( BoundedPerasEpochContext (..)
  , PerasEpochContextResolver (..)
  )
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.TypeFamilyWrappers
import Ouroboros.Consensus.Util (ShowProxy)
import Ouroboros.Consensus.Util.RedundantConstraints (keepRedundantConstraint)

{-------------------------------------------------------------------------------
  Hard fork protocol, block, and ledger state
-------------------------------------------------------------------------------}

data HardForkProtocol (xs :: [Type])

newtype HardForkBlock xs = HardForkBlock
  { forall (xs :: [*]). HardForkBlock xs -> OneEraBlock xs
getHardForkBlock :: OneEraBlock xs
  }
  deriving Int -> HardForkBlock xs -> ShowS
[HardForkBlock xs] -> ShowS
HardForkBlock xs -> String
(Int -> HardForkBlock xs -> ShowS)
-> (HardForkBlock xs -> String)
-> ([HardForkBlock xs] -> ShowS)
-> Show (HardForkBlock xs)
forall (xs :: [*]).
CanHardFork xs =>
Int -> HardForkBlock xs -> ShowS
forall (xs :: [*]). CanHardFork xs => [HardForkBlock xs] -> ShowS
forall (xs :: [*]). CanHardFork xs => HardForkBlock xs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (xs :: [*]).
CanHardFork xs =>
Int -> HardForkBlock xs -> ShowS
showsPrec :: Int -> HardForkBlock xs -> ShowS
$cshow :: forall (xs :: [*]). CanHardFork xs => HardForkBlock xs -> String
show :: HardForkBlock xs -> String
$cshowList :: forall (xs :: [*]). CanHardFork xs => [HardForkBlock xs] -> ShowS
showList :: [HardForkBlock xs] -> ShowS
Show

instance Typeable xs => ShowProxy (HardForkBlock xs)

type instance BlockProtocol (HardForkBlock xs) = HardForkProtocol xs
type instance HeaderHash (HardForkBlock xs) = OneEraHash xs

newtype instance LedgerState (HardForkBlock xs) mk = HardForkLedgerState
  { forall (xs :: [*]) (mk :: MapKind).
LedgerState (HardForkBlock xs) mk
-> HardForkState (Flip LedgerState mk) xs
hardForkLedgerStatePerEra :: HardForkState (Flip LedgerState mk) xs
  }

deriving stock instance
  (ShowMK mk, CanHardFork xs) =>
  Show (LedgerState (HardForkBlock xs) mk)
deriving stock instance
  (EqMK mk, CanHardFork xs) =>
  Eq (LedgerState (HardForkBlock xs) mk)
deriving newtype instance
  (NoThunksMK mk, CanHardFork xs) =>
  NoThunks (LedgerState (HardForkBlock xs) mk)

{-------------------------------------------------------------------------------
  Protocol config
-------------------------------------------------------------------------------}

data instance ConsensusConfig (HardForkProtocol xs) = HardForkConsensusConfig
  { forall (xs :: [*]).
ConsensusConfig (HardForkProtocol xs) -> SecurityParam
hardForkConsensusConfigK :: !(SecurityParam)
  -- ^ The value of @k@ cannot change at hard fork boundaries
  , forall (xs :: [*]).
ConsensusConfig (HardForkProtocol xs) -> Shape xs
hardForkConsensusConfigShape :: !(History.Shape xs)
  -- ^ The shape of the hard fork
  --
  -- We require this in the consensus config because consensus might need
  -- access to 'EpochInfo', and in order to compute that, we need the
  -- 'EraParams' of all eras.
  , forall (xs :: [*]).
ConsensusConfig (HardForkProtocol xs) -> PerEraConsensusConfig xs
hardForkConsensusConfigPerEra :: !(PerEraConsensusConfig xs)
  -- ^ Config for each era
  }
  deriving stock (forall x.
 ConsensusConfig (HardForkProtocol xs)
 -> Rep (ConsensusConfig (HardForkProtocol xs)) x)
-> (forall x.
    Rep (ConsensusConfig (HardForkProtocol xs)) x
    -> ConsensusConfig (HardForkProtocol xs))
-> Generic (ConsensusConfig (HardForkProtocol xs))
forall (xs :: [*]) x.
Rep (ConsensusConfig (HardForkProtocol xs)) x
-> ConsensusConfig (HardForkProtocol xs)
forall (xs :: [*]) x.
ConsensusConfig (HardForkProtocol xs)
-> Rep (ConsensusConfig (HardForkProtocol xs)) x
forall x.
Rep (ConsensusConfig (HardForkProtocol xs)) x
-> ConsensusConfig (HardForkProtocol xs)
forall x.
ConsensusConfig (HardForkProtocol xs)
-> Rep (ConsensusConfig (HardForkProtocol xs)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (xs :: [*]) x.
ConsensusConfig (HardForkProtocol xs)
-> Rep (ConsensusConfig (HardForkProtocol xs)) x
from :: forall x.
ConsensusConfig (HardForkProtocol xs)
-> Rep (ConsensusConfig (HardForkProtocol xs)) x
$cto :: forall (xs :: [*]) x.
Rep (ConsensusConfig (HardForkProtocol xs)) x
-> ConsensusConfig (HardForkProtocol xs)
to :: forall x.
Rep (ConsensusConfig (HardForkProtocol xs)) x
-> ConsensusConfig (HardForkProtocol xs)
Generic
  deriving anyclass Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
Proxy (ConsensusConfig (HardForkProtocol xs)) -> String
(Context
 -> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo))
-> (Context
    -> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo))
-> (Proxy (ConsensusConfig (HardForkProtocol xs)) -> String)
-> NoThunks (ConsensusConfig (HardForkProtocol xs))
forall (xs :: [*]).
CanHardFork xs =>
Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
forall (xs :: [*]).
CanHardFork xs =>
Proxy (ConsensusConfig (HardForkProtocol xs)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (ConsensusConfig (HardForkProtocol xs)) -> String
showTypeOf :: Proxy (ConsensusConfig (HardForkProtocol xs)) -> String
NoThunks

{-------------------------------------------------------------------------------
  Block config
-------------------------------------------------------------------------------}

newtype instance BlockConfig (HardForkBlock xs) = HardForkBlockConfig
  { forall (xs :: [*]).
BlockConfig (HardForkBlock xs) -> PerEraBlockConfig xs
hardForkBlockConfigPerEra :: PerEraBlockConfig xs
  }
  deriving newtype Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
Proxy (BlockConfig (HardForkBlock xs)) -> String
(Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo))
-> (Context
    -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo))
-> (Proxy (BlockConfig (HardForkBlock xs)) -> String)
-> NoThunks (BlockConfig (HardForkBlock xs))
forall (xs :: [*]).
CanHardFork xs =>
Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
forall (xs :: [*]).
CanHardFork xs =>
Proxy (BlockConfig (HardForkBlock xs)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (BlockConfig (HardForkBlock xs)) -> String
showTypeOf :: Proxy (BlockConfig (HardForkBlock xs)) -> String
NoThunks

{-------------------------------------------------------------------------------
  Codec config
-------------------------------------------------------------------------------}

newtype instance CodecConfig (HardForkBlock xs) = HardForkCodecConfig
  { forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra :: PerEraCodecConfig xs
  }
  deriving newtype Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
Proxy (CodecConfig (HardForkBlock xs)) -> String
(Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo))
-> (Context
    -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo))
-> (Proxy (CodecConfig (HardForkBlock xs)) -> String)
-> NoThunks (CodecConfig (HardForkBlock xs))
forall (xs :: [*]).
CanHardFork xs =>
Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
forall (xs :: [*]).
CanHardFork xs =>
Proxy (CodecConfig (HardForkBlock xs)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
noThunks :: Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (CodecConfig (HardForkBlock xs)) -> String
showTypeOf :: Proxy (CodecConfig (HardForkBlock xs)) -> String
NoThunks

{-------------------------------------------------------------------------------
  Storage config
-------------------------------------------------------------------------------}

newtype instance StorageConfig (HardForkBlock xs) = HardForkStorageConfig
  { forall (xs :: [*]).
StorageConfig (HardForkBlock xs) -> PerEraStorageConfig xs
hardForkStorageConfigPerEra :: PerEraStorageConfig xs
  }
  deriving newtype Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
Proxy (StorageConfig (HardForkBlock xs)) -> String
(Context
 -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo))
-> (Context
    -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo))
-> (Proxy (StorageConfig (HardForkBlock xs)) -> String)
-> NoThunks (StorageConfig (HardForkBlock xs))
forall (xs :: [*]).
CanHardFork xs =>
Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
forall (xs :: [*]).
CanHardFork xs =>
Proxy (StorageConfig (HardForkBlock xs)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
noThunks :: Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (StorageConfig (HardForkBlock xs)) -> String
showTypeOf :: Proxy (StorageConfig (HardForkBlock xs)) -> String
NoThunks

{-------------------------------------------------------------------------------
  Ledger config
-------------------------------------------------------------------------------}

data HardForkLedgerConfig xs = HardForkLedgerConfig
  { forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs
hardForkLedgerConfigShape :: !(History.Shape xs)
  , forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigPerEra :: !(PerEraLedgerConfig xs)
  }
  deriving (forall x.
 HardForkLedgerConfig xs -> Rep (HardForkLedgerConfig xs) x)
-> (forall x.
    Rep (HardForkLedgerConfig xs) x -> HardForkLedgerConfig xs)
-> Generic (HardForkLedgerConfig xs)
forall (xs :: [*]) x.
Rep (HardForkLedgerConfig xs) x -> HardForkLedgerConfig xs
forall (xs :: [*]) x.
HardForkLedgerConfig xs -> Rep (HardForkLedgerConfig xs) x
forall x.
Rep (HardForkLedgerConfig xs) x -> HardForkLedgerConfig xs
forall x.
HardForkLedgerConfig xs -> Rep (HardForkLedgerConfig xs) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (xs :: [*]) x.
HardForkLedgerConfig xs -> Rep (HardForkLedgerConfig xs) x
from :: forall x.
HardForkLedgerConfig xs -> Rep (HardForkLedgerConfig xs) x
$cto :: forall (xs :: [*]) x.
Rep (HardForkLedgerConfig xs) x -> HardForkLedgerConfig xs
to :: forall x.
Rep (HardForkLedgerConfig xs) x -> HardForkLedgerConfig xs
Generic

deriving instance Show (PerEraLedgerConfig xs) => Show (HardForkLedgerConfig xs)
instance CanHardFork xs => NoThunks (HardForkLedgerConfig xs)

type instance LedgerCfg LedgerState (HardForkBlock xs) = HardForkLedgerConfig xs

{-------------------------------------------------------------------------------
  Operations on config
-------------------------------------------------------------------------------}

completeLedgerConfig' ::
  forall blk.
  HasPartialLedgerConfig blk =>
  EpochInfo (Except PastHorizonException) ->
  WrapPartialLedgerConfig blk ->
  LedgerConfig blk
completeLedgerConfig' :: forall blk.
HasPartialLedgerConfig blk =>
EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> LedgerConfig blk
completeLedgerConfig' EpochInfo (Except PastHorizonException)
ei =
  Proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerCfg LedgerState blk
forall blk (proxy :: * -> *).
HasPartialLedgerConfig blk =>
proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerConfig blk
forall (proxy :: * -> *).
proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerCfg LedgerState blk
completeLedgerConfig (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) EpochInfo (Except PastHorizonException)
ei
    (PartialLedgerConfig blk -> LedgerCfg LedgerState blk)
-> (WrapPartialLedgerConfig blk -> PartialLedgerConfig blk)
-> WrapPartialLedgerConfig blk
-> LedgerCfg LedgerState blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPartialLedgerConfig blk -> PartialLedgerConfig blk
forall blk. WrapPartialLedgerConfig blk -> PartialLedgerConfig blk
unwrapPartialLedgerConfig

completeLedgerConfig'' ::
  forall blk.
  HasPartialLedgerConfig blk =>
  EpochInfo (Except PastHorizonException) ->
  WrapPartialLedgerConfig blk ->
  WrapLedgerConfig blk
completeLedgerConfig'' :: forall blk.
HasPartialLedgerConfig blk =>
EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> WrapLedgerConfig blk
completeLedgerConfig'' EpochInfo (Except PastHorizonException)
ei =
  LedgerConfig blk -> WrapLedgerConfig blk
forall blk. LedgerConfig blk -> WrapLedgerConfig blk
WrapLedgerConfig
    (LedgerConfig blk -> WrapLedgerConfig blk)
-> (WrapPartialLedgerConfig blk -> LedgerConfig blk)
-> WrapPartialLedgerConfig blk
-> WrapLedgerConfig blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerConfig blk
forall blk (proxy :: * -> *).
HasPartialLedgerConfig blk =>
proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerConfig blk
forall (proxy :: * -> *).
proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerConfig blk
completeLedgerConfig (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) EpochInfo (Except PastHorizonException)
ei
    (PartialLedgerConfig blk -> LedgerConfig blk)
-> (WrapPartialLedgerConfig blk -> PartialLedgerConfig blk)
-> WrapPartialLedgerConfig blk
-> LedgerConfig blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPartialLedgerConfig blk -> PartialLedgerConfig blk
forall blk. WrapPartialLedgerConfig blk -> PartialLedgerConfig blk
unwrapPartialLedgerConfig

completeConsensusConfig' ::
  forall blk.
  HasPartialConsensusConfig (BlockProtocol blk) =>
  EpochInfo (Except PastHorizonException) ->
  WrapPartialConsensusConfig blk ->
  ConsensusConfig (BlockProtocol blk)
completeConsensusConfig' :: forall blk.
HasPartialConsensusConfig (BlockProtocol blk) =>
EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
completeConsensusConfig' EpochInfo (Except PastHorizonException)
ei =
  Proxy (BlockProtocol blk)
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol blk)
forall p (proxy :: * -> *).
HasPartialConsensusConfig p =>
proxy p
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig p
-> ConsensusConfig p
forall (proxy :: * -> *).
proxy (BlockProtocol blk)
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol blk)
completeConsensusConfig (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(BlockProtocol blk)) EpochInfo (Except PastHorizonException)
ei
    (PartialConsensusConfig (BlockProtocol blk)
 -> ConsensusConfig (BlockProtocol blk))
-> (WrapPartialConsensusConfig blk
    -> PartialConsensusConfig (BlockProtocol blk))
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPartialConsensusConfig blk
-> PartialConsensusConfig (BlockProtocol blk)
forall blk.
WrapPartialConsensusConfig blk
-> PartialConsensusConfig (BlockProtocol blk)
unwrapPartialConsensusConfig

completeConsensusConfig'' ::
  forall blk.
  HasPartialConsensusConfig (BlockProtocol blk) =>
  EpochInfo (Except PastHorizonException) ->
  WrapPartialConsensusConfig blk ->
  WrapConsensusConfig blk
completeConsensusConfig'' :: forall blk.
HasPartialConsensusConfig (BlockProtocol blk) =>
EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk -> WrapConsensusConfig blk
completeConsensusConfig'' EpochInfo (Except PastHorizonException)
ei =
  ConsensusConfig (BlockProtocol blk) -> WrapConsensusConfig blk
forall blk.
ConsensusConfig (BlockProtocol blk) -> WrapConsensusConfig blk
WrapConsensusConfig
    (ConsensusConfig (BlockProtocol blk) -> WrapConsensusConfig blk)
-> (WrapPartialConsensusConfig blk
    -> ConsensusConfig (BlockProtocol blk))
-> WrapPartialConsensusConfig blk
-> WrapConsensusConfig blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (BlockProtocol blk)
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol blk)
forall p (proxy :: * -> *).
HasPartialConsensusConfig p =>
proxy p
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig p
-> ConsensusConfig p
forall (proxy :: * -> *).
proxy (BlockProtocol blk)
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol blk)
completeConsensusConfig (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(BlockProtocol blk)) EpochInfo (Except PastHorizonException)
ei
    (PartialConsensusConfig (BlockProtocol blk)
 -> ConsensusConfig (BlockProtocol blk))
-> (WrapPartialConsensusConfig blk
    -> PartialConsensusConfig (BlockProtocol blk))
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPartialConsensusConfig blk
-> PartialConsensusConfig (BlockProtocol blk)
forall blk.
WrapPartialConsensusConfig blk
-> PartialConsensusConfig (BlockProtocol blk)
unwrapPartialConsensusConfig

distribLedgerConfig ::
  CanHardFork xs =>
  EpochInfo (Except PastHorizonException) ->
  LedgerConfig (HardForkBlock xs) ->
  NP WrapLedgerConfig xs
distribLedgerConfig :: forall (xs :: [*]).
CanHardFork xs =>
EpochInfo (Except PastHorizonException)
-> LedgerConfig (HardForkBlock xs) -> NP WrapLedgerConfig xs
distribLedgerConfig EpochInfo (Except PastHorizonException)
ei LedgerConfig (HardForkBlock xs)
cfg =
  Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPartialLedgerConfig a -> WrapLedgerConfig a)
-> NP WrapPartialLedgerConfig xs
-> NP WrapLedgerConfig 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)
-> WrapPartialLedgerConfig a -> WrapLedgerConfig a
forall blk.
HasPartialLedgerConfig blk =>
EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> WrapLedgerConfig blk
completeLedgerConfig'' EpochInfo (Except PastHorizonException)
ei)
    (PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
getPerEraLedgerConfig (PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs)
-> PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall a b. (a -> b) -> a -> b
$ HardForkLedgerConfig xs -> PerEraLedgerConfig xs
forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigPerEra LedgerConfig (HardForkBlock xs)
HardForkLedgerConfig xs
cfg)

distribTopLevelConfig ::
  All SingleEraBlock xs =>
  EpochInfo (Except PastHorizonException) ->
  TopLevelConfig (HardForkBlock xs) ->
  NP TopLevelConfig xs
distribTopLevelConfig :: forall (xs :: [*]).
All SingleEraBlock xs =>
EpochInfo (Except PastHorizonException)
-> TopLevelConfig (HardForkBlock xs) -> NP TopLevelConfig xs
distribTopLevelConfig EpochInfo (Except PastHorizonException)
ei TopLevelConfig (HardForkBlock xs)
tlc =
  Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    (-.->)
      WrapPartialConsensusConfig
      (WrapPartialLedgerConfig
       -.-> (BlockConfig
             -.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig))))
      a)
-> NP
     (WrapPartialConsensusConfig
      -.-> (WrapPartialLedgerConfig
            -.-> (BlockConfig
                  -.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig)))))
     xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
forall (c :: * -> Constraint) (xs :: [*])
       (proxy :: (* -> Constraint) -> *) (f :: * -> *).
AllN NP c xs =>
proxy c -> (forall a. c a => f a) -> NP f xs
hcpure
    Proxy SingleEraBlock
proxySingle
    ( (WrapPartialConsensusConfig a
 -> WrapPartialLedgerConfig a
 -> BlockConfig a
 -> CodecConfig a
 -> StorageConfig a
 -> TopLevelConfig a)
-> (-.->)
     WrapPartialConsensusConfig
     (WrapPartialLedgerConfig
      -.-> (BlockConfig
            -.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig))))
     a
forall {k} (f0 :: k -> *) (a :: k) (f1 :: k -> *) (f2 :: k -> *)
       (f3 :: k -> *) (f4 :: k -> *) (f5 :: k -> *).
(f0 a -> f1 a -> f2 a -> f3 a -> f4 a -> f5 a)
-> (-.->) f0 (f1 -.-> (f2 -.-> (f3 -.-> (f4 -.-> f5)))) a
fn_5
        ( \WrapPartialConsensusConfig a
cfgConsensus WrapPartialLedgerConfig a
cfgLedger BlockConfig a
cfgBlock CodecConfig a
cfgCodec StorageConfig a
cfgStorage ->
            ConsensusConfig (BlockProtocol a)
-> LedgerConfig a
-> BlockConfig a
-> CodecConfig a
-> StorageConfig a
-> CheckpointsMap a
-> TopLevelConfig a
forall blk.
ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> CheckpointsMap blk
-> TopLevelConfig blk
mkTopLevelConfig
              (EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig a
-> ConsensusConfig (BlockProtocol a)
forall blk.
HasPartialConsensusConfig (BlockProtocol blk) =>
EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
completeConsensusConfig' EpochInfo (Except PastHorizonException)
ei WrapPartialConsensusConfig a
cfgConsensus)
              (EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig a -> LedgerConfig a
forall blk.
HasPartialLedgerConfig blk =>
EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> LedgerConfig blk
completeLedgerConfig' EpochInfo (Except PastHorizonException)
ei WrapPartialLedgerConfig a
cfgLedger)
              BlockConfig a
cfgBlock
              CodecConfig a
cfgCodec
              StorageConfig a
cfgStorage
              -- topLevelConfigCheckpoints is only used in validateEnvelope,
              -- where it comes from the TopLevelConfig of the HardForkBlock.
              --
              -- The checkpoints of the underlying blocks are not used.
              CheckpointsMap a
forall blk. CheckpointsMap blk
emptyCheckpointsMap
        )
    )
    Prod
  NP
  (WrapPartialConsensusConfig
   -.-> (WrapPartialLedgerConfig
         -.-> (BlockConfig
               -.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig)))))
  xs
-> NP WrapPartialConsensusConfig xs
-> NP
     (WrapPartialLedgerConfig
      -.-> (BlockConfig
            -.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig))))
     xs
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NP (f -.-> g) xs -> NP f xs -> NP g xs
`hap` ( PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
forall (xs :: [*]).
PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
getPerEraConsensusConfig (PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs)
-> PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
forall a b. (a -> b) -> a -> b
$
              ConsensusConfig (HardForkProtocol xs) -> PerEraConsensusConfig xs
forall (xs :: [*]).
ConsensusConfig (HardForkProtocol xs) -> PerEraConsensusConfig xs
hardForkConsensusConfigPerEra (TopLevelConfig (HardForkBlock xs)
-> ConsensusConfig (BlockProtocol (HardForkBlock xs))
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus TopLevelConfig (HardForkBlock xs)
tlc)
          )
    Prod
  NP
  (WrapPartialLedgerConfig
   -.-> (BlockConfig
         -.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig))))
  xs
-> NP WrapPartialLedgerConfig xs
-> NP
     (BlockConfig
      -.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig)))
     xs
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NP (f -.-> g) xs -> NP f xs -> NP g xs
`hap` ( PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
getPerEraLedgerConfig (PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs)
-> PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall a b. (a -> b) -> a -> b
$
              HardForkLedgerConfig xs -> PerEraLedgerConfig xs
forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigPerEra (TopLevelConfig (HardForkBlock xs)
-> LedgerConfig (HardForkBlock xs)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger TopLevelConfig (HardForkBlock xs)
tlc)
          )
    Prod
  NP
  (BlockConfig
   -.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig)))
  xs
-> NP BlockConfig xs
-> NP (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig)) xs
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NP (f -.-> g) xs -> NP f xs -> NP g xs
`hap` ( PerEraBlockConfig xs -> NP BlockConfig xs
forall (xs :: [*]). PerEraBlockConfig xs -> NP BlockConfig xs
getPerEraBlockConfig (PerEraBlockConfig xs -> NP BlockConfig xs)
-> PerEraBlockConfig xs -> NP BlockConfig xs
forall a b. (a -> b) -> a -> b
$
              BlockConfig (HardForkBlock xs) -> PerEraBlockConfig xs
forall (xs :: [*]).
BlockConfig (HardForkBlock xs) -> PerEraBlockConfig xs
hardForkBlockConfigPerEra (TopLevelConfig (HardForkBlock xs) -> BlockConfig (HardForkBlock xs)
forall blk. TopLevelConfig blk -> BlockConfig blk
configBlock TopLevelConfig (HardForkBlock xs)
tlc)
          )
    Prod NP (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig)) xs
-> NP CodecConfig xs -> NP (StorageConfig -.-> TopLevelConfig) xs
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NP (f -.-> g) xs -> NP f xs -> NP g xs
`hap` ( PerEraCodecConfig xs -> NP CodecConfig xs
forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs
getPerEraCodecConfig (PerEraCodecConfig xs -> NP CodecConfig xs)
-> PerEraCodecConfig xs -> NP CodecConfig xs
forall a b. (a -> b) -> a -> b
$
              CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra (TopLevelConfig (HardForkBlock xs) -> CodecConfig (HardForkBlock xs)
forall blk. TopLevelConfig blk -> CodecConfig blk
configCodec TopLevelConfig (HardForkBlock xs)
tlc)
          )
    Prod NP (StorageConfig -.-> TopLevelConfig) xs
-> NP StorageConfig xs -> NP TopLevelConfig xs
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NP (f -.-> g) xs -> NP f xs -> NP g xs
`hap` ( PerEraStorageConfig xs -> NP StorageConfig xs
forall (xs :: [*]). PerEraStorageConfig xs -> NP StorageConfig xs
getPerEraStorageConfig (PerEraStorageConfig xs -> NP StorageConfig xs)
-> PerEraStorageConfig xs -> NP StorageConfig xs
forall a b. (a -> b) -> a -> b
$
              StorageConfig (HardForkBlock xs) -> PerEraStorageConfig xs
forall (xs :: [*]).
StorageConfig (HardForkBlock xs) -> PerEraStorageConfig xs
hardForkStorageConfigPerEra (TopLevelConfig (HardForkBlock xs)
-> StorageConfig (HardForkBlock xs)
forall blk. TopLevelConfig blk -> StorageConfig blk
configStorage TopLevelConfig (HardForkBlock xs)
tlc)
          )

{-------------------------------------------------------------------------------
  HFC injection/projection helpers for Peras
-------------------------------------------------------------------------------}

-- | Extract a 'Point' of the hard fork block to a 'Point' of a single era by
-- decoding the raw hash via 'fromShortRawHash'. Used when delegating operations
-- that take a 'Point' argument to a single-era implementation.
distribHardForkPoint ::
  forall blk xs.
  ( ConvertRawHash blk
  , HashSize (HardForkBlock xs) ~ HashSize blk
  ) =>
  Point (HardForkBlock xs) ->
  Point blk
distribHardForkPoint :: forall blk (xs :: [*]).
(ConvertRawHash blk, HashSize (HardForkBlock xs) ~ HashSize blk) =>
Point (HardForkBlock xs) -> Point blk
distribHardForkPoint = \case
  Point (HardForkBlock xs)
GenesisPoint ->
    Point blk
forall {k} (block :: k). Point block
GenesisPoint
  BlockPoint SlotNo
s (OneEraHash ShortByteString
h) ->
    -- The constraints ensure that the hash sizes match, so we can safely use
    -- the unsafe variant of 'fromShortRawHash' here.
    SlotNo -> HeaderHash blk -> Point blk
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint SlotNo
s (Proxy blk -> ShortByteString -> HeaderHash blk
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> ShortByteString -> HeaderHash blk
forall (proxy :: * -> *).
proxy blk -> ShortByteString -> HeaderHash blk
unsafeFromShortRawHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) ShortByteString
h)
 where
  ()
_ = Proxy (HashSize blk ~ HashSize blk) -> ()
forall (c :: Constraint) (proxy :: Constraint -> *).
c =>
proxy c -> ()
keepRedundantConstraint (forall {k} (t :: k). Proxy t
forall (t :: Constraint). Proxy t
Proxy @(HashSize (HardForkBlock xs) ~ HashSize blk))

-- | Inject a 'Point' from a single era into a 'Point' of the hard fork block by
-- encoding the raw hash via 'toShortRawHash'. Used by accessor instances to
-- return 'Point (HardForkBlock xs)' from single-era point values.
injectHardForkPoint ::
  forall blk xs.
  ConvertRawHash blk =>
  Point blk ->
  Point (HardForkBlock xs)
injectHardForkPoint :: forall blk (xs :: [*]).
ConvertRawHash blk =>
Point blk -> Point (HardForkBlock xs)
injectHardForkPoint = \case
  Point blk
GenesisPoint ->
    Point (HardForkBlock xs)
forall {k} (block :: k). Point block
GenesisPoint
  BlockPoint SlotNo
s HeaderHash blk
h ->
    SlotNo -> HeaderHash (HardForkBlock xs) -> Point (HardForkBlock xs)
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint SlotNo
s (ShortByteString -> OneEraHash xs
forall k (xs :: [k]). ShortByteString -> OneEraHash xs
OneEraHash (Proxy blk -> HeaderHash blk -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
forall (proxy :: * -> *).
proxy blk -> HeaderHash blk -> ShortByteString
toShortRawHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) HeaderHash blk
h))

-- | Project a 'PerasVoteCollectionWithQuorum' of the hard fork block into a
-- 'NS' of 'PerasVoteCollectionWithQuorum' of the single era blocks.
projectHFCPerasVoteCollectionWithQuorum ::
  All SingleEraBlock xs =>
  PerasVoteCollectionWithQuorum (HardForkBlock xs) ->
  Maybe (NS PerasVoteCollectionWithQuorum xs)
projectHFCPerasVoteCollectionWithQuorum :: forall (xs :: [*]).
All SingleEraBlock xs =>
PerasVoteCollectionWithQuorum (HardForkBlock xs)
-> Maybe (NS PerasVoteCollectionWithQuorum xs)
projectHFCPerasVoteCollectionWithQuorum PerasVoteCollectionWithQuorum (HardForkBlock xs)
hfcCollection =
  let votes :: NE
  (Map
     PerasVoteId
     (WithArrivalTime (ValidatedPerasVote (HardForkBlock xs))))
votes = PerasVoteCollection (HardForkBlock xs)
-> NE
     (Map
        PerasVoteId
        (WithArrivalTime (ValidatedPerasVote (HardForkBlock xs))))
forall blk.
PerasVoteCollection blk
-> NE (Map PerasVoteId (WithArrivalTime (ValidatedPerasVote blk)))
pvcVotes (PerasVoteCollection (HardForkBlock xs)
 -> NE
      (Map
         PerasVoteId
         (WithArrivalTime (ValidatedPerasVote (HardForkBlock xs)))))
-> PerasVoteCollection (HardForkBlock xs)
-> NE
     (Map
        PerasVoteId
        (WithArrivalTime (ValidatedPerasVote (HardForkBlock xs))))
forall a b. (a -> b) -> a -> b
$ PerasVoteCollectionWithQuorum (HardForkBlock xs)
-> PerasVoteCollection (HardForkBlock xs)
forall blk.
PerasVoteCollectionWithQuorum blk -> PerasVoteCollection blk
forgetQuorum PerasVoteCollectionWithQuorum (HardForkBlock xs)
hfcCollection
      neMapNs :: NEMap PerasVoteId (NS (WithArrivalTime :.: ValidatedPerasVote) xs)
neMapNs = WithArrivalTime (ValidatedPerasVote (HardForkBlock xs))
-> NS (WithArrivalTime :.: ValidatedPerasVote) xs
forall (xs :: [*]).
All Top xs =>
WithArrivalTime (ValidatedPerasVote (HardForkBlock xs))
-> NS (WithArrivalTime :.: ValidatedPerasVote) xs
projectHFCWithArrivalTimeValidatedPerasVote (WithArrivalTime (ValidatedPerasVote (HardForkBlock xs))
 -> NS (WithArrivalTime :.: ValidatedPerasVote) xs)
-> NEMap
     PerasVoteId
     (WithArrivalTime (ValidatedPerasVote (HardForkBlock xs)))
-> NEMap
     PerasVoteId (NS (WithArrivalTime :.: ValidatedPerasVote) xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NEMap
  PerasVoteId
  (WithArrivalTime (ValidatedPerasVote (HardForkBlock xs)))
NE
  (Map
     PerasVoteId
     (WithArrivalTime (ValidatedPerasVote (HardForkBlock xs))))
votes
   in case NEMap PerasVoteId (NS (WithArrivalTime :.: ValidatedPerasVote) xs)
-> Either
     (Mismatch
        (NEMap PerasVoteId :.: (WithArrivalTime :.: ValidatedPerasVote))
        (WithArrivalTime :.: ValidatedPerasVote)
        xs)
     (NS
        (NEMap PerasVoteId :.: (WithArrivalTime :.: ValidatedPerasVote))
        xs)
forall {k1} (xs :: [k1]) k2 (f :: k1 -> *).
(SListI xs, Eq k2) =>
NEMap k2 (NS f xs)
-> Either (Mismatch (NEMap k2 :.: f) f xs) (NS (NEMap k2 :.: f) xs)
Match.matchNEMap NEMap PerasVoteId (NS (WithArrivalTime :.: ValidatedPerasVote) xs)
neMapNs of
        Left Mismatch
  (NEMap PerasVoteId :.: (WithArrivalTime :.: ValidatedPerasVote))
  (WithArrivalTime :.: ValidatedPerasVote)
  xs
_mismatch ->
          Maybe (NS PerasVoteCollectionWithQuorum xs)
forall a. Maybe a
Nothing
        Right NS
  (NEMap PerasVoteId :.: (WithArrivalTime :.: ValidatedPerasVote)) xs
nsNeMap ->
          NS PerasVoteCollectionWithQuorum xs
-> Maybe (NS PerasVoteCollectionWithQuorum xs)
forall a. a -> Maybe a
Just (NS PerasVoteCollectionWithQuorum xs
 -> Maybe (NS PerasVoteCollectionWithQuorum xs))
-> NS PerasVoteCollectionWithQuorum xs
-> Maybe (NS PerasVoteCollectionWithQuorum xs)
forall a b. (a -> b) -> a -> b
$
            Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    (:.:)
      (NEMap PerasVoteId) (WithArrivalTime :.: ValidatedPerasVote) a
    -> PerasVoteCollectionWithQuorum a)
-> NS
     (NEMap PerasVoteId :.: (WithArrivalTime :.: ValidatedPerasVote)) xs
-> NS PerasVoteCollectionWithQuorum 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
              ( \(Comp NEMap PerasVoteId ((:.:) WithArrivalTime ValidatedPerasVote a)
compedValMap) ->
                  PerasVoteCollection a -> PerasVoteCollectionWithQuorum a
forall blk.
PerasVoteCollection blk -> PerasVoteCollectionWithQuorum blk
unsafeAssumeQuorum (PerasVoteCollection a -> PerasVoteCollectionWithQuorum a)
-> PerasVoteCollection a -> PerasVoteCollectionWithQuorum a
forall a b. (a -> b) -> a -> b
$
                    NE (Map PerasVoteId (WithArrivalTime (ValidatedPerasVote a)))
-> PerasVoteCollection a
forall blk.
(IsPerasVote (PerasVote blk) blk, StandardHash blk) =>
NE (Map PerasVoteId (WithArrivalTime (ValidatedPerasVote blk)))
-> PerasVoteCollection blk
unsafePerasVoteCollection
                      ((\(Comp WithArrivalTime (ValidatedPerasVote a)
v) -> WithArrivalTime (ValidatedPerasVote a)
v) ((:.:) WithArrivalTime ValidatedPerasVote a
 -> WithArrivalTime (ValidatedPerasVote a))
-> NEMap PerasVoteId ((:.:) WithArrivalTime ValidatedPerasVote a)
-> NEMap PerasVoteId (WithArrivalTime (ValidatedPerasVote a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NEMap PerasVoteId ((:.:) WithArrivalTime ValidatedPerasVote a)
compedValMap)
              )
              NS
  (NEMap PerasVoteId :.: (WithArrivalTime :.: ValidatedPerasVote)) xs
nsNeMap

-- NOTE: this assumes PerasParams are the same for all eras.
--
-- In the future, @pecParams@ will be an @NP@ of @PerasParams@.
projectHFCPerasEpochContext ::
  All Top xs =>
  PerasEpochContext (HardForkBlock xs) ->
  NS PerasEpochContext xs
projectHFCPerasEpochContext :: forall (xs :: [*]).
All Top xs =>
PerasEpochContext (HardForkBlock xs) -> NS PerasEpochContext xs
projectHFCPerasEpochContext PerasEpochContext{PerasVotingCommittee (HardForkBlock xs)
pecCommittee :: PerasVotingCommittee (HardForkBlock xs)
pecCommittee :: forall blk. PerasEpochContext blk -> PerasVotingCommittee blk
pecCommittee, PerasParams (HardForkBlock xs)
pecParams :: PerasParams (HardForkBlock xs)
pecParams :: forall blk. PerasEpochContext blk -> PerasParams blk
pecParams} =
  (forall a. WrapPerasVotingCommittee a -> PerasEpochContext a)
-> NS WrapPerasVotingCommittee xs -> NS PerasEpochContext xs
forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
hmap
    ( \(WrapPerasVotingCommittee VotingCommittee (PerasCrypto a) (PerasVotingCommitteeScheme a)
committee) ->
        PerasEpochContext
          { pecCommittee :: VotingCommittee (PerasCrypto a) (PerasVotingCommitteeScheme a)
pecCommittee = VotingCommittee (PerasCrypto a) (PerasVotingCommitteeScheme a)
committee
          , pecParams :: PerasParams a
pecParams = PerasParams (HardForkBlock xs) -> PerasParams a
forall blk' blk. PerasParams blk -> PerasParams blk'
castPerasParams PerasParams (HardForkBlock xs)
pecParams
          }
    )
    (NS WrapPerasVotingCommittee xs -> NS PerasEpochContext xs)
-> (PerasVotingCommittee (HardForkBlock xs)
    -> NS WrapPerasVotingCommittee xs)
-> PerasVotingCommittee (HardForkBlock xs)
-> NS PerasEpochContext xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasVotingCommittee (HardForkBlock xs)
-> NS WrapPerasVotingCommittee xs
VotingCommittee
  (OneEraPerasCrypto xs) (OneEraPerasVotingCommitteeScheme xs)
-> NS WrapPerasVotingCommittee xs
forall (xs :: [*]).
VotingCommittee
  (OneEraPerasCrypto xs) (OneEraPerasVotingCommitteeScheme xs)
-> NS WrapPerasVotingCommittee xs
getOneEraPerasVotingCommittee
    (PerasVotingCommittee (HardForkBlock xs)
 -> NS PerasEpochContext xs)
-> PerasVotingCommittee (HardForkBlock xs)
-> NS PerasEpochContext xs
forall a b. (a -> b) -> a -> b
$ PerasVotingCommittee (HardForkBlock xs)
pecCommittee

injectHFCPerasEpochContext ::
  All Top xs =>
  NS PerasEpochContext xs ->
  PerasEpochContext (HardForkBlock xs)
injectHFCPerasEpochContext :: forall (xs :: [*]).
All Top xs =>
NS PerasEpochContext xs -> PerasEpochContext (HardForkBlock xs)
injectHFCPerasEpochContext =
  NS (K (PerasEpochContext (HardForkBlock xs))) xs
-> CollapseTo NS (PerasEpochContext (HardForkBlock xs))
NS (K (PerasEpochContext (HardForkBlock xs))) xs
-> PerasEpochContext (HardForkBlock xs)
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
    (NS (K (PerasEpochContext (HardForkBlock xs))) xs
 -> PerasEpochContext (HardForkBlock xs))
-> (NS PerasEpochContext xs
    -> NS (K (PerasEpochContext (HardForkBlock xs))) xs)
-> NS PerasEpochContext xs
-> PerasEpochContext (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 Index xs a
 -> PerasEpochContext a
 -> K (PerasEpochContext (HardForkBlock xs)) a)
-> NS PerasEpochContext xs
-> NS (K (PerasEpochContext (HardForkBlock 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
      ( \Index xs a
idx PerasEpochContext a
context ->
          PerasEpochContext (HardForkBlock xs)
-> K (PerasEpochContext (HardForkBlock xs)) a
forall k a (b :: k). a -> K a b
K (PerasEpochContext (HardForkBlock xs)
 -> K (PerasEpochContext (HardForkBlock xs)) a)
-> PerasEpochContext (HardForkBlock xs)
-> K (PerasEpochContext (HardForkBlock xs)) a
forall a b. (a -> b) -> a -> b
$
            PerasEpochContext
              { pecCommittee :: PerasVotingCommittee (HardForkBlock xs)
pecCommittee =
                  NS WrapPerasVotingCommittee xs
-> PerasVotingCommittee (HardForkBlock xs)
NS WrapPerasVotingCommittee xs
-> VotingCommittee
     (OneEraPerasCrypto xs) (OneEraPerasVotingCommitteeScheme xs)
forall (xs :: [*]).
NS WrapPerasVotingCommittee xs
-> VotingCommittee
     (OneEraPerasCrypto xs) (OneEraPerasVotingCommitteeScheme xs)
OneEraPerasVotingCommittee
                    (NS WrapPerasVotingCommittee xs
 -> PerasVotingCommittee (HardForkBlock xs))
-> (PerasEpochContext a -> NS WrapPerasVotingCommittee xs)
-> PerasEpochContext a
-> PerasVotingCommittee (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs a
-> WrapPerasVotingCommittee a -> NS WrapPerasVotingCommittee xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs a
idx
                    (WrapPerasVotingCommittee a -> NS WrapPerasVotingCommittee xs)
-> (PerasEpochContext a -> WrapPerasVotingCommittee a)
-> PerasEpochContext a
-> NS WrapPerasVotingCommittee xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotingCommittee (PerasCrypto a) (PerasVotingCommitteeScheme a)
-> WrapPerasVotingCommittee a
forall blk.
VotingCommittee (PerasCrypto blk) (PerasVotingCommitteeScheme blk)
-> WrapPerasVotingCommittee blk
WrapPerasVotingCommittee
                    (VotingCommittee (PerasCrypto a) (PerasVotingCommitteeScheme a)
 -> WrapPerasVotingCommittee a)
-> (PerasEpochContext a
    -> VotingCommittee (PerasCrypto a) (PerasVotingCommitteeScheme a))
-> PerasEpochContext a
-> WrapPerasVotingCommittee a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasEpochContext a
-> VotingCommittee (PerasCrypto a) (PerasVotingCommitteeScheme a)
forall blk. PerasEpochContext blk -> PerasVotingCommittee blk
pecCommittee
                    (PerasEpochContext a -> PerasVotingCommittee (HardForkBlock xs))
-> PerasEpochContext a -> PerasVotingCommittee (HardForkBlock xs)
forall a b. (a -> b) -> a -> b
$ PerasEpochContext a
context
              , pecParams :: PerasParams (HardForkBlock xs)
pecParams =
                  PerasParams a -> PerasParams (HardForkBlock xs)
forall blk' blk. PerasParams blk -> PerasParams blk'
castPerasParams
                    (PerasParams a -> PerasParams (HardForkBlock xs))
-> (PerasEpochContext a -> PerasParams a)
-> PerasEpochContext a
-> PerasParams (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasEpochContext a -> PerasParams a
forall blk. PerasEpochContext blk -> PerasParams blk
pecParams
                    (PerasEpochContext a -> PerasParams (HardForkBlock xs))
-> PerasEpochContext a -> PerasParams (HardForkBlock xs)
forall a b. (a -> b) -> a -> b
$ PerasEpochContext a
context
              }
      )

-- | Inject a 'NS' of 'BoundedPerasEpochContext' of the single era blocks into a
-- 'BoundedPerasEpochContext' of the hard fork block.
injectHFCBoundedPerasEpochContext ::
  All Top xs =>
  NS BoundedPerasEpochContext xs ->
  BoundedPerasEpochContext (HardForkBlock xs)
injectHFCBoundedPerasEpochContext :: forall (xs :: [*]).
All Top xs =>
NS BoundedPerasEpochContext xs
-> BoundedPerasEpochContext (HardForkBlock xs)
injectHFCBoundedPerasEpochContext =
  NS (K (BoundedPerasEpochContext (HardForkBlock xs))) xs
-> CollapseTo NS (BoundedPerasEpochContext (HardForkBlock xs))
NS (K (BoundedPerasEpochContext (HardForkBlock xs))) xs
-> BoundedPerasEpochContext (HardForkBlock xs)
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
    (NS (K (BoundedPerasEpochContext (HardForkBlock xs))) xs
 -> BoundedPerasEpochContext (HardForkBlock xs))
-> (NS BoundedPerasEpochContext xs
    -> NS (K (BoundedPerasEpochContext (HardForkBlock xs))) xs)
-> NS BoundedPerasEpochContext xs
-> BoundedPerasEpochContext (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 Index xs a
 -> BoundedPerasEpochContext a
 -> K (BoundedPerasEpochContext (HardForkBlock xs)) a)
-> NS BoundedPerasEpochContext xs
-> NS (K (BoundedPerasEpochContext (HardForkBlock 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
      ( \Index xs a
idx BoundedPerasEpochContext a
context ->
          BoundedPerasEpochContext (HardForkBlock xs)
-> K (BoundedPerasEpochContext (HardForkBlock xs)) a
forall k a (b :: k). a -> K a b
K (BoundedPerasEpochContext (HardForkBlock xs)
 -> K (BoundedPerasEpochContext (HardForkBlock xs)) a)
-> BoundedPerasEpochContext (HardForkBlock xs)
-> K (BoundedPerasEpochContext (HardForkBlock xs)) a
forall a b. (a -> b) -> a -> b
$
            BoundedPerasEpochContext
              { startPerasRoundNo :: PerasRoundNo
startPerasRoundNo =
                  BoundedPerasEpochContext a -> PerasRoundNo
forall blk. BoundedPerasEpochContext blk -> PerasRoundNo
startPerasRoundNo BoundedPerasEpochContext a
context
              , endPerasRoundNo :: PerasRoundNo
endPerasRoundNo =
                  BoundedPerasEpochContext a -> PerasRoundNo
forall blk. BoundedPerasEpochContext blk -> PerasRoundNo
endPerasRoundNo BoundedPerasEpochContext a
context
              , epochContext :: PerasEpochContext (HardForkBlock xs)
epochContext =
                  NS PerasEpochContext xs -> PerasEpochContext (HardForkBlock xs)
forall (xs :: [*]).
All Top xs =>
NS PerasEpochContext xs -> PerasEpochContext (HardForkBlock xs)
injectHFCPerasEpochContext
                    (NS PerasEpochContext xs -> PerasEpochContext (HardForkBlock xs))
-> (BoundedPerasEpochContext a -> NS PerasEpochContext xs)
-> BoundedPerasEpochContext a
-> PerasEpochContext (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs a -> PerasEpochContext a -> NS PerasEpochContext xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs a
idx
                    (PerasEpochContext a -> NS PerasEpochContext xs)
-> (BoundedPerasEpochContext a -> PerasEpochContext a)
-> BoundedPerasEpochContext a
-> NS PerasEpochContext xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPerasEpochContext a -> PerasEpochContext a
forall blk. BoundedPerasEpochContext blk -> PerasEpochContext blk
epochContext
                    (BoundedPerasEpochContext a
 -> PerasEpochContext (HardForkBlock xs))
-> BoundedPerasEpochContext a
-> PerasEpochContext (HardForkBlock xs)
forall a b. (a -> b) -> a -> b
$ BoundedPerasEpochContext a
context
              }
      )

-- | Project a 'BoundedPerasEpochContext' of the hard fork block into a 'NS' of
-- 'BoundedPerasEpochContext' of the single era blocks.
projectHFCBoundedPerasEpochContext ::
  All Top xs =>
  BoundedPerasEpochContext (HardForkBlock xs) ->
  NS BoundedPerasEpochContext xs
projectHFCBoundedPerasEpochContext :: forall (xs :: [*]).
All Top xs =>
BoundedPerasEpochContext (HardForkBlock xs)
-> NS BoundedPerasEpochContext xs
projectHFCBoundedPerasEpochContext
  BoundedPerasEpochContext
    { PerasRoundNo
startPerasRoundNo :: forall blk. BoundedPerasEpochContext blk -> PerasRoundNo
startPerasRoundNo :: PerasRoundNo
startPerasRoundNo
    , PerasRoundNo
endPerasRoundNo :: forall blk. BoundedPerasEpochContext blk -> PerasRoundNo
endPerasRoundNo :: PerasRoundNo
endPerasRoundNo
    , PerasEpochContext (HardForkBlock xs)
epochContext :: forall blk. BoundedPerasEpochContext blk -> PerasEpochContext blk
epochContext :: PerasEpochContext (HardForkBlock xs)
epochContext
    } =
    (forall a.
 WrapPerasVotingCommittee a -> BoundedPerasEpochContext a)
-> NS WrapPerasVotingCommittee xs -> NS BoundedPerasEpochContext xs
forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
hmap
      ( \(WrapPerasVotingCommittee VotingCommittee (PerasCrypto a) (PerasVotingCommitteeScheme a)
committee) ->
          BoundedPerasEpochContext
            { startPerasRoundNo :: PerasRoundNo
startPerasRoundNo =
                PerasRoundNo
startPerasRoundNo
            , endPerasRoundNo :: PerasRoundNo
endPerasRoundNo =
                PerasRoundNo
endPerasRoundNo
            , epochContext :: PerasEpochContext a
epochContext =
                PerasEpochContext
                  { pecCommittee :: VotingCommittee (PerasCrypto a) (PerasVotingCommitteeScheme a)
pecCommittee = VotingCommittee (PerasCrypto a) (PerasVotingCommitteeScheme a)
committee
                  , pecParams :: PerasParams a
pecParams = PerasParams (HardForkBlock xs) -> PerasParams a
forall blk' blk. PerasParams blk -> PerasParams blk'
castPerasParams (PerasEpochContext (HardForkBlock xs)
-> PerasParams (HardForkBlock xs)
forall blk. PerasEpochContext blk -> PerasParams blk
pecParams PerasEpochContext (HardForkBlock xs)
epochContext)
                  }
            }
      )
      (NS WrapPerasVotingCommittee xs -> NS BoundedPerasEpochContext xs)
-> (VotingCommittee
      (OneEraPerasCrypto xs) (OneEraPerasVotingCommitteeScheme xs)
    -> NS WrapPerasVotingCommittee xs)
-> VotingCommittee
     (OneEraPerasCrypto xs) (OneEraPerasVotingCommitteeScheme xs)
-> NS BoundedPerasEpochContext xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotingCommittee
  (OneEraPerasCrypto xs) (OneEraPerasVotingCommitteeScheme xs)
-> NS WrapPerasVotingCommittee xs
forall (xs :: [*]).
VotingCommittee
  (OneEraPerasCrypto xs) (OneEraPerasVotingCommitteeScheme xs)
-> NS WrapPerasVotingCommittee xs
getOneEraPerasVotingCommittee
      (VotingCommittee
   (OneEraPerasCrypto xs) (OneEraPerasVotingCommitteeScheme xs)
 -> NS BoundedPerasEpochContext xs)
-> VotingCommittee
     (OneEraPerasCrypto xs) (OneEraPerasVotingCommitteeScheme xs)
-> NS BoundedPerasEpochContext xs
forall a b. (a -> b) -> a -> b
$ PerasEpochContext (HardForkBlock xs)
-> PerasVotingCommittee (HardForkBlock xs)
forall blk. PerasEpochContext blk -> PerasVotingCommittee blk
pecCommittee PerasEpochContext (HardForkBlock xs)
epochContext

-- | Inject a 'NS' of 'PerasEpochContextResolver' of the single era blocks into
-- a 'PerasEpochContextResolver' of the hard fork block.
injectHFCPerasEpochContextResolver ::
  All Top xs =>
  NS PerasEpochContextResolver xs ->
  PerasEpochContextResolver (HardForkBlock xs)
injectHFCPerasEpochContextResolver :: forall (xs :: [*]).
All Top xs =>
NS PerasEpochContextResolver xs
-> PerasEpochContextResolver (HardForkBlock xs)
injectHFCPerasEpochContextResolver =
  NS (K (PerasEpochContextResolver (HardForkBlock xs))) xs
-> CollapseTo NS (PerasEpochContextResolver (HardForkBlock xs))
NS (K (PerasEpochContextResolver (HardForkBlock xs))) xs
-> PerasEpochContextResolver (HardForkBlock xs)
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
    (NS (K (PerasEpochContextResolver (HardForkBlock xs))) xs
 -> PerasEpochContextResolver (HardForkBlock xs))
-> (NS PerasEpochContextResolver xs
    -> NS (K (PerasEpochContextResolver (HardForkBlock xs))) xs)
-> NS PerasEpochContextResolver xs
-> PerasEpochContextResolver (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 Index xs a
 -> PerasEpochContextResolver a
 -> K (PerasEpochContextResolver (HardForkBlock xs)) a)
-> NS PerasEpochContextResolver xs
-> NS (K (PerasEpochContextResolver (HardForkBlock 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
      ( \Index xs a
idx PerasEpochContextResolver a
resolver ->
          case PerasEpochContextResolver a
resolver of
            PerasEpochContextResolverError String
err ->
              PerasEpochContextResolver (HardForkBlock xs)
-> K (PerasEpochContextResolver (HardForkBlock xs)) a
forall k a (b :: k). a -> K a b
K (PerasEpochContextResolver (HardForkBlock xs)
 -> K (PerasEpochContextResolver (HardForkBlock xs)) a)
-> PerasEpochContextResolver (HardForkBlock xs)
-> K (PerasEpochContextResolver (HardForkBlock xs)) a
forall a b. (a -> b) -> a -> b
$ String -> PerasEpochContextResolver (HardForkBlock xs)
forall blk. String -> PerasEpochContextResolver blk
PerasEpochContextResolverError String
err
            PerasEpochContextResolver PerasEnabled (BoundedPerasEpochContext a)
currBoundedContext PerasEnabled (BoundedPerasEpochContext a)
prevBoundedContext ->
              PerasEpochContextResolver (HardForkBlock xs)
-> K (PerasEpochContextResolver (HardForkBlock xs)) a
forall k a (b :: k). a -> K a b
K (PerasEpochContextResolver (HardForkBlock xs)
 -> K (PerasEpochContextResolver (HardForkBlock xs)) a)
-> PerasEpochContextResolver (HardForkBlock xs)
-> K (PerasEpochContextResolver (HardForkBlock xs)) a
forall a b. (a -> b) -> a -> b
$
                PerasEnabled (BoundedPerasEpochContext (HardForkBlock xs))
-> PerasEnabled (BoundedPerasEpochContext (HardForkBlock xs))
-> PerasEpochContextResolver (HardForkBlock xs)
forall blk.
PerasEnabled (BoundedPerasEpochContext blk)
-> PerasEnabled (BoundedPerasEpochContext blk)
-> PerasEpochContextResolver blk
PerasEpochContextResolver
                  (NS BoundedPerasEpochContext xs
-> BoundedPerasEpochContext (HardForkBlock xs)
forall (xs :: [*]).
All Top xs =>
NS BoundedPerasEpochContext xs
-> BoundedPerasEpochContext (HardForkBlock xs)
injectHFCBoundedPerasEpochContext (NS BoundedPerasEpochContext xs
 -> BoundedPerasEpochContext (HardForkBlock xs))
-> (BoundedPerasEpochContext a -> NS BoundedPerasEpochContext xs)
-> BoundedPerasEpochContext a
-> BoundedPerasEpochContext (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs a
-> BoundedPerasEpochContext a -> NS BoundedPerasEpochContext xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs a
idx (BoundedPerasEpochContext a
 -> BoundedPerasEpochContext (HardForkBlock xs))
-> PerasEnabled (BoundedPerasEpochContext a)
-> PerasEnabled (BoundedPerasEpochContext (HardForkBlock xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PerasEnabled (BoundedPerasEpochContext a)
currBoundedContext)
                  (NS BoundedPerasEpochContext xs
-> BoundedPerasEpochContext (HardForkBlock xs)
forall (xs :: [*]).
All Top xs =>
NS BoundedPerasEpochContext xs
-> BoundedPerasEpochContext (HardForkBlock xs)
injectHFCBoundedPerasEpochContext (NS BoundedPerasEpochContext xs
 -> BoundedPerasEpochContext (HardForkBlock xs))
-> (BoundedPerasEpochContext a -> NS BoundedPerasEpochContext xs)
-> BoundedPerasEpochContext a
-> BoundedPerasEpochContext (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs a
-> BoundedPerasEpochContext a -> NS BoundedPerasEpochContext xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs a
idx (BoundedPerasEpochContext a
 -> BoundedPerasEpochContext (HardForkBlock xs))
-> PerasEnabled (BoundedPerasEpochContext a)
-> PerasEnabled (BoundedPerasEpochContext (HardForkBlock xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PerasEnabled (BoundedPerasEpochContext a)
prevBoundedContext)
      )

injectHFCValidatedPerasVote ::
  All Top xs =>
  NS ValidatedPerasVote xs ->
  ValidatedPerasVote (HardForkBlock xs)
injectHFCValidatedPerasVote :: forall (xs :: [*]).
All Top xs =>
NS ValidatedPerasVote xs -> ValidatedPerasVote (HardForkBlock xs)
injectHFCValidatedPerasVote =
  NS (K (ValidatedPerasVote (HardForkBlock xs))) xs
-> CollapseTo NS (ValidatedPerasVote (HardForkBlock xs))
NS (K (ValidatedPerasVote (HardForkBlock xs))) xs
-> ValidatedPerasVote (HardForkBlock xs)
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
    (NS (K (ValidatedPerasVote (HardForkBlock xs))) xs
 -> ValidatedPerasVote (HardForkBlock xs))
-> (NS ValidatedPerasVote xs
    -> NS (K (ValidatedPerasVote (HardForkBlock xs))) xs)
-> NS ValidatedPerasVote xs
-> ValidatedPerasVote (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 Index xs a
 -> ValidatedPerasVote a
 -> K (ValidatedPerasVote (HardForkBlock xs)) a)
-> NS ValidatedPerasVote xs
-> NS (K (ValidatedPerasVote (HardForkBlock 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
      ( \Index xs a
idx ValidatedPerasVote a
vote ->
          ValidatedPerasVote (HardForkBlock xs)
-> K (ValidatedPerasVote (HardForkBlock xs)) a
forall k a (b :: k). a -> K a b
K (ValidatedPerasVote (HardForkBlock xs)
 -> K (ValidatedPerasVote (HardForkBlock xs)) a)
-> ValidatedPerasVote (HardForkBlock xs)
-> K (ValidatedPerasVote (HardForkBlock xs)) a
forall a b. (a -> b) -> a -> b
$
            ValidatedPerasVote
              { vpvVote :: PerasVote (HardForkBlock xs)
vpvVote =
                  NS WrapPerasVote xs -> PerasVote (HardForkBlock xs)
NS WrapPerasVote xs -> OneEraPerasVote xs
forall (xs :: [*]). NS WrapPerasVote xs -> OneEraPerasVote xs
OneEraPerasVote
                    (NS WrapPerasVote xs -> PerasVote (HardForkBlock xs))
-> (ValidatedPerasVote a -> NS WrapPerasVote xs)
-> ValidatedPerasVote a
-> PerasVote (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs a -> WrapPerasVote a -> NS WrapPerasVote xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs a
idx
                    (WrapPerasVote a -> NS WrapPerasVote xs)
-> (ValidatedPerasVote a -> WrapPerasVote a)
-> ValidatedPerasVote a
-> NS WrapPerasVote xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasVote a -> WrapPerasVote a
forall blk. PerasVote blk -> WrapPerasVote blk
WrapPerasVote
                    (PerasVote a -> WrapPerasVote a)
-> (ValidatedPerasVote a -> PerasVote a)
-> ValidatedPerasVote a
-> WrapPerasVote a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidatedPerasVote a -> PerasVote a
forall blk. ValidatedPerasVote blk -> PerasVote blk
vpvVote
                    (ValidatedPerasVote a -> PerasVote (HardForkBlock xs))
-> ValidatedPerasVote a -> PerasVote (HardForkBlock xs)
forall a b. (a -> b) -> a -> b
$ ValidatedPerasVote a
vote
              , vpvVoteWeight :: VoteWeight
vpvVoteWeight =
                  ValidatedPerasVote a -> VoteWeight
forall blk. ValidatedPerasVote blk -> VoteWeight
vpvVoteWeight ValidatedPerasVote a
vote
              }
      )

injectHFCValidatedPerasCert ::
  All Top xs =>
  NS ValidatedPerasCert xs ->
  ValidatedPerasCert (HardForkBlock xs)
injectHFCValidatedPerasCert :: forall (xs :: [*]).
All Top xs =>
NS ValidatedPerasCert xs -> ValidatedPerasCert (HardForkBlock xs)
injectHFCValidatedPerasCert =
  NS (K (ValidatedPerasCert (HardForkBlock xs))) xs
-> CollapseTo NS (ValidatedPerasCert (HardForkBlock xs))
NS (K (ValidatedPerasCert (HardForkBlock xs))) xs
-> ValidatedPerasCert (HardForkBlock xs)
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
    (NS (K (ValidatedPerasCert (HardForkBlock xs))) xs
 -> ValidatedPerasCert (HardForkBlock xs))
-> (NS ValidatedPerasCert xs
    -> NS (K (ValidatedPerasCert (HardForkBlock xs))) xs)
-> NS ValidatedPerasCert xs
-> ValidatedPerasCert (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 Index xs a
 -> ValidatedPerasCert a
 -> K (ValidatedPerasCert (HardForkBlock xs)) a)
-> NS ValidatedPerasCert xs
-> NS (K (ValidatedPerasCert (HardForkBlock 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
      ( \Index xs a
idx ValidatedPerasCert a
cert ->
          ValidatedPerasCert (HardForkBlock xs)
-> K (ValidatedPerasCert (HardForkBlock xs)) a
forall k a (b :: k). a -> K a b
K (ValidatedPerasCert (HardForkBlock xs)
 -> K (ValidatedPerasCert (HardForkBlock xs)) a)
-> ValidatedPerasCert (HardForkBlock xs)
-> K (ValidatedPerasCert (HardForkBlock xs)) a
forall a b. (a -> b) -> a -> b
$
            ValidatedPerasCert
              { vpcCert :: PerasCert (HardForkBlock xs)
vpcCert =
                  NS WrapPerasCert xs -> PerasCert (HardForkBlock xs)
NS WrapPerasCert xs -> OneEraPerasCert xs
forall (xs :: [*]). NS WrapPerasCert xs -> OneEraPerasCert xs
OneEraPerasCert
                    (NS WrapPerasCert xs -> PerasCert (HardForkBlock xs))
-> (ValidatedPerasCert a -> NS WrapPerasCert xs)
-> ValidatedPerasCert a
-> PerasCert (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs a -> WrapPerasCert a -> NS WrapPerasCert xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs a
idx
                    (WrapPerasCert a -> NS WrapPerasCert xs)
-> (ValidatedPerasCert a -> WrapPerasCert a)
-> ValidatedPerasCert a
-> NS WrapPerasCert xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasCert a -> WrapPerasCert a
forall blk. PerasCert blk -> WrapPerasCert blk
WrapPerasCert
                    (PerasCert a -> WrapPerasCert a)
-> (ValidatedPerasCert a -> PerasCert a)
-> ValidatedPerasCert a
-> WrapPerasCert a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidatedPerasCert a -> PerasCert a
forall blk. ValidatedPerasCert blk -> PerasCert blk
vpcCert
                    (ValidatedPerasCert a -> PerasCert (HardForkBlock xs))
-> ValidatedPerasCert a -> PerasCert (HardForkBlock xs)
forall a b. (a -> b) -> a -> b
$ ValidatedPerasCert a
cert
              , vpcCertBoost :: PerasWeight
vpcCertBoost =
                  ValidatedPerasCert a -> PerasWeight
forall blk. ValidatedPerasCert blk -> PerasWeight
vpcCertBoost ValidatedPerasCert a
cert
              }
      )

projectHFCValidatedPerasVote ::
  All Top xs =>
  ValidatedPerasVote (HardForkBlock xs) ->
  NS ValidatedPerasVote xs
projectHFCValidatedPerasVote :: forall (xs :: [*]).
All Top xs =>
ValidatedPerasVote (HardForkBlock xs) -> NS ValidatedPerasVote xs
projectHFCValidatedPerasVote
  ValidatedPerasVote
    { PerasVote (HardForkBlock xs)
vpvVote :: forall blk. ValidatedPerasVote blk -> PerasVote blk
vpvVote :: PerasVote (HardForkBlock xs)
vpvVote
    , VoteWeight
vpvVoteWeight :: forall blk. ValidatedPerasVote blk -> VoteWeight
vpvVoteWeight :: VoteWeight
vpvVoteWeight
    } =
    (forall a. WrapPerasVote a -> ValidatedPerasVote a)
-> NS WrapPerasVote xs -> NS ValidatedPerasVote xs
forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
hmap
      ( \(WrapPerasVote PerasVote a
v) ->
          ValidatedPerasVote
            { vpvVote :: PerasVote a
vpvVote = PerasVote a
v
            , VoteWeight
vpvVoteWeight :: VoteWeight
vpvVoteWeight :: VoteWeight
vpvVoteWeight
            }
      )
      (NS WrapPerasVote xs -> NS ValidatedPerasVote xs)
-> (PerasVote (HardForkBlock xs) -> NS WrapPerasVote xs)
-> PerasVote (HardForkBlock xs)
-> NS ValidatedPerasVote xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasVote (HardForkBlock xs) -> NS WrapPerasVote xs
OneEraPerasVote xs -> NS WrapPerasVote xs
forall (xs :: [*]). OneEraPerasVote xs -> NS WrapPerasVote xs
getOneEraPerasVote
      (PerasVote (HardForkBlock xs) -> NS ValidatedPerasVote xs)
-> PerasVote (HardForkBlock xs) -> NS ValidatedPerasVote xs
forall a b. (a -> b) -> a -> b
$ PerasVote (HardForkBlock xs)
vpvVote

projectHFCWithArrivalTimeValidatedPerasVote ::
  All Top xs =>
  WithArrivalTime (ValidatedPerasVote (HardForkBlock xs)) ->
  NS (WithArrivalTime :.: ValidatedPerasVote) xs
projectHFCWithArrivalTimeValidatedPerasVote :: forall (xs :: [*]).
All Top xs =>
WithArrivalTime (ValidatedPerasVote (HardForkBlock xs))
-> NS (WithArrivalTime :.: ValidatedPerasVote) xs
projectHFCWithArrivalTimeValidatedPerasVote (WithArrivalTime RelativeTime
arrivalTime ValidatedPerasVote (HardForkBlock xs)
validatedVote) =
  (forall a.
 ValidatedPerasVote a -> (:.:) WithArrivalTime ValidatedPerasVote a)
-> NS ValidatedPerasVote xs
-> NS (WithArrivalTime :.: ValidatedPerasVote) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
hmap (WithArrivalTime (ValidatedPerasVote a)
-> (:.:) WithArrivalTime ValidatedPerasVote a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (WithArrivalTime (ValidatedPerasVote a)
 -> (:.:) WithArrivalTime ValidatedPerasVote a)
-> (ValidatedPerasVote a -> WithArrivalTime (ValidatedPerasVote a))
-> ValidatedPerasVote a
-> (:.:) WithArrivalTime ValidatedPerasVote a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelativeTime
-> ValidatedPerasVote a -> WithArrivalTime (ValidatedPerasVote a)
forall a. RelativeTime -> a -> WithArrivalTime a
WithArrivalTime RelativeTime
arrivalTime)
    (NS ValidatedPerasVote xs
 -> NS (WithArrivalTime :.: ValidatedPerasVote) xs)
-> (ValidatedPerasVote (HardForkBlock xs)
    -> NS ValidatedPerasVote xs)
-> ValidatedPerasVote (HardForkBlock xs)
-> NS (WithArrivalTime :.: ValidatedPerasVote) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidatedPerasVote (HardForkBlock xs) -> NS ValidatedPerasVote xs
forall (xs :: [*]).
All Top xs =>
ValidatedPerasVote (HardForkBlock xs) -> NS ValidatedPerasVote xs
projectHFCValidatedPerasVote
    (ValidatedPerasVote (HardForkBlock xs)
 -> NS (WithArrivalTime :.: ValidatedPerasVote) xs)
-> ValidatedPerasVote (HardForkBlock xs)
-> NS (WithArrivalTime :.: ValidatedPerasVote) xs
forall a b. (a -> b) -> a -> b
$ ValidatedPerasVote (HardForkBlock xs)
validatedVote

{-------------------------------------------------------------------------------
  BlockSupportsPeras
-------------------------------------------------------------------------------}

-- ** Type and class instances that are required for the 'BlockSupportsPeras'

-- instance of 'HardForkBlock'

type instance ElectionId (OneEraPerasCrypto xs) = PerasRoundNo
type instance BoostedBlock (OneEraPerasVote xs) = Point (HardForkBlock xs)
type instance BoostedBlock (OneEraPerasCert xs) = Point (HardForkBlock xs)
type instance VoteCandidate (OneEraPerasCrypto xs) = Point (HardForkBlock xs)

instance
  ( CanHardFork xs
  , All SingleEraBlock xs
  ) =>
  IsPerasVote (OneEraPerasVote xs) (HardForkBlock xs)
  where
  getPerasVoteRound :: OneEraPerasVote xs -> PerasRoundNo
getPerasVoteRound =
    NS (K PerasRoundNo) xs -> CollapseTo NS PerasRoundNo
NS (K PerasRoundNo) xs -> PerasRoundNo
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K PerasRoundNo) xs -> PerasRoundNo)
-> (OneEraPerasVote xs -> NS (K PerasRoundNo) xs)
-> OneEraPerasVote xs
-> PerasRoundNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPerasVote a -> K PerasRoundNo a)
-> NS WrapPerasVote xs
-> NS (K PerasRoundNo) 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 (PerasRoundNo -> K PerasRoundNo a
forall k a (b :: k). a -> K a b
K (PerasRoundNo -> K PerasRoundNo a)
-> (WrapPerasVote a -> PerasRoundNo)
-> WrapPerasVote a
-> K PerasRoundNo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasVote a -> PerasRoundNo
forall vote blk. IsPerasVote vote blk => vote -> PerasRoundNo
getPerasVoteRound (PerasVote a -> PerasRoundNo)
-> (WrapPerasVote a -> PerasVote a)
-> WrapPerasVote a
-> PerasRoundNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPerasVote a -> PerasVote a
forall blk. WrapPerasVote blk -> PerasVote blk
unwrapPerasVote)
      (NS WrapPerasVote xs -> NS (K PerasRoundNo) xs)
-> (OneEraPerasVote xs -> NS WrapPerasVote xs)
-> OneEraPerasVote xs
-> NS (K PerasRoundNo) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraPerasVote xs -> NS WrapPerasVote xs
forall (xs :: [*]). OneEraPerasVote xs -> NS WrapPerasVote xs
getOneEraPerasVote
  getPerasVoteSeatIndex :: OneEraPerasVote xs -> PerasSeatIndex
getPerasVoteSeatIndex =
    NS (K PerasSeatIndex) xs -> CollapseTo NS PerasSeatIndex
NS (K PerasSeatIndex) xs -> PerasSeatIndex
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K PerasSeatIndex) xs -> PerasSeatIndex)
-> (OneEraPerasVote xs -> NS (K PerasSeatIndex) xs)
-> OneEraPerasVote xs
-> PerasSeatIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPerasVote a -> K PerasSeatIndex a)
-> NS WrapPerasVote xs
-> NS (K PerasSeatIndex) 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 (PerasSeatIndex -> K PerasSeatIndex a
forall k a (b :: k). a -> K a b
K (PerasSeatIndex -> K PerasSeatIndex a)
-> (WrapPerasVote a -> PerasSeatIndex)
-> WrapPerasVote a
-> K PerasSeatIndex a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasVote a -> PerasSeatIndex
forall vote blk. IsPerasVote vote blk => vote -> PerasSeatIndex
getPerasVoteSeatIndex (PerasVote a -> PerasSeatIndex)
-> (WrapPerasVote a -> PerasVote a)
-> WrapPerasVote a
-> PerasSeatIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPerasVote a -> PerasVote a
forall blk. WrapPerasVote blk -> PerasVote blk
unwrapPerasVote)
      (NS WrapPerasVote xs -> NS (K PerasSeatIndex) xs)
-> (OneEraPerasVote xs -> NS WrapPerasVote xs)
-> OneEraPerasVote xs
-> NS (K PerasSeatIndex) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraPerasVote xs -> NS WrapPerasVote xs
forall (xs :: [*]). OneEraPerasVote xs -> NS WrapPerasVote xs
getOneEraPerasVote
  getPerasVoteBlock :: OneEraPerasVote xs -> BoostedBlock (OneEraPerasVote xs)
getPerasVoteBlock =
    NS (K (Point (HardForkBlock xs))) xs
-> CollapseTo NS (Point (HardForkBlock xs))
NS (K (Point (HardForkBlock xs))) xs -> Point (HardForkBlock xs)
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K (Point (HardForkBlock xs))) xs -> Point (HardForkBlock xs))
-> (OneEraPerasVote xs -> NS (K (Point (HardForkBlock xs))) xs)
-> OneEraPerasVote xs
-> Point (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPerasVote a -> K (Point (HardForkBlock xs)) a)
-> NS WrapPerasVote xs
-> NS (K (Point (HardForkBlock xs))) 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 (Point (HardForkBlock xs) -> K (Point (HardForkBlock xs)) a
forall k a (b :: k). a -> K a b
K (Point (HardForkBlock xs) -> K (Point (HardForkBlock xs)) a)
-> (WrapPerasVote a -> Point (HardForkBlock xs))
-> WrapPerasVote a
-> K (Point (HardForkBlock xs)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point a -> Point (HardForkBlock xs)
forall blk (xs :: [*]).
ConvertRawHash blk =>
Point blk -> Point (HardForkBlock xs)
injectHardForkPoint (Point a -> Point (HardForkBlock xs))
-> (WrapPerasVote a -> Point a)
-> WrapPerasVote a
-> Point (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasVote a -> Point a
forall vote blk. IsPerasVote vote blk => vote -> Point blk
getPerasVotePoint (PerasVote a -> Point a)
-> (WrapPerasVote a -> PerasVote a) -> WrapPerasVote a -> Point a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPerasVote a -> PerasVote a
forall blk. WrapPerasVote blk -> PerasVote blk
unwrapPerasVote)
      (NS WrapPerasVote xs -> NS (K (Point (HardForkBlock xs))) xs)
-> (OneEraPerasVote xs -> NS WrapPerasVote xs)
-> OneEraPerasVote xs
-> NS (K (Point (HardForkBlock xs))) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraPerasVote xs -> NS WrapPerasVote xs
forall (xs :: [*]). OneEraPerasVote xs -> NS WrapPerasVote xs
getOneEraPerasVote

instance
  CanHardFork xs =>
  IsPerasCert (OneEraPerasCert xs) (HardForkBlock xs)
  where
  getPerasCertRound :: OneEraPerasCert xs -> PerasRoundNo
getPerasCertRound =
    NS (K PerasRoundNo) xs -> CollapseTo NS PerasRoundNo
NS (K PerasRoundNo) xs -> PerasRoundNo
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K PerasRoundNo) xs -> PerasRoundNo)
-> (OneEraPerasCert xs -> NS (K PerasRoundNo) xs)
-> OneEraPerasCert xs
-> PerasRoundNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPerasCert a -> K PerasRoundNo a)
-> NS WrapPerasCert xs
-> NS (K PerasRoundNo) 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 (PerasRoundNo -> K PerasRoundNo a
forall k a (b :: k). a -> K a b
K (PerasRoundNo -> K PerasRoundNo a)
-> (WrapPerasCert a -> PerasRoundNo)
-> WrapPerasCert a
-> K PerasRoundNo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasCert a -> PerasRoundNo
forall cert blk. IsPerasCert cert blk => cert -> PerasRoundNo
getPerasCertRound (PerasCert a -> PerasRoundNo)
-> (WrapPerasCert a -> PerasCert a)
-> WrapPerasCert a
-> PerasRoundNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPerasCert a -> PerasCert a
forall blk. WrapPerasCert blk -> PerasCert blk
unwrapPerasCert)
      (NS WrapPerasCert xs -> NS (K PerasRoundNo) xs)
-> (OneEraPerasCert xs -> NS WrapPerasCert xs)
-> OneEraPerasCert xs
-> NS (K PerasRoundNo) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraPerasCert xs -> NS WrapPerasCert xs
forall (xs :: [*]). OneEraPerasCert xs -> NS WrapPerasCert xs
getOneEraPerasCert
  getPerasCertBlock :: OneEraPerasCert xs -> BoostedBlock (OneEraPerasCert xs)
getPerasCertBlock =
    NS (K (Point (HardForkBlock xs))) xs
-> CollapseTo NS (Point (HardForkBlock xs))
NS (K (Point (HardForkBlock xs))) xs -> Point (HardForkBlock xs)
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K (Point (HardForkBlock xs))) xs -> Point (HardForkBlock xs))
-> (OneEraPerasCert xs -> NS (K (Point (HardForkBlock xs))) xs)
-> OneEraPerasCert xs
-> Point (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPerasCert a -> K (Point (HardForkBlock xs)) a)
-> NS WrapPerasCert xs
-> NS (K (Point (HardForkBlock xs))) 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 (Point (HardForkBlock xs) -> K (Point (HardForkBlock xs)) a
forall k a (b :: k). a -> K a b
K (Point (HardForkBlock xs) -> K (Point (HardForkBlock xs)) a)
-> (WrapPerasCert a -> Point (HardForkBlock xs))
-> WrapPerasCert a
-> K (Point (HardForkBlock xs)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point a -> Point (HardForkBlock xs)
forall blk (xs :: [*]).
ConvertRawHash blk =>
Point blk -> Point (HardForkBlock xs)
injectHardForkPoint (Point a -> Point (HardForkBlock xs))
-> (WrapPerasCert a -> Point a)
-> WrapPerasCert a
-> Point (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasCert a -> Point a
forall cert blk. IsPerasCert cert blk => cert -> Point blk
getPerasCertPoint (PerasCert a -> Point a)
-> (WrapPerasCert a -> PerasCert a) -> WrapPerasCert a -> Point a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPerasCert a -> PerasCert a
forall blk. WrapPerasCert blk -> PerasCert blk
unwrapPerasCert)
      (NS WrapPerasCert xs -> NS (K (Point (HardForkBlock xs))) xs)
-> (OneEraPerasCert xs -> NS WrapPerasCert xs)
-> OneEraPerasCert xs
-> NS (K (Point (HardForkBlock xs))) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraPerasCert xs -> NS WrapPerasCert xs
forall (xs :: [*]). OneEraPerasCert xs -> NS WrapPerasCert xs
getOneEraPerasCert

instance
  CanHardFork xs =>
  IsPerasError (HardForkPerasError xs) (HardForkBlock xs)
  where
  -- NOTE: in practice this is never produced at the HFC level
  injectVotingCommitteeError :: PerasVotingCommitteeError (HardForkBlock xs)
-> HardForkPerasError xs
injectVotingCommitteeError PerasVotingCommitteeError (HardForkBlock xs)
_ = HardForkPerasError xs
forall (xs :: [*]). HardForkPerasError xs
HardForkPerasErrorCommitteeError

  -- NOTE: in practice this is never produced at the HFC level
  injectConversionError :: PerasConversionError -> HardForkPerasError xs
injectConversionError PerasConversionError
_ = HardForkPerasError xs
forall (xs :: [*]). HardForkPerasError xs
HardForkPerasErrorConversionError

  -- NOTE: in practice this is never produced at the HFC level
  injectQuorumNotReachedError :: VoteWeight -> HardForkPerasError xs
injectQuorumNotReachedError VoteWeight
_ = HardForkPerasError xs
forall (xs :: [*]). HardForkPerasError xs
HardForkPerasErrorQuorumNotReachedError

-- ** 'BlockSupportsPeras' instance for 'HardForkBlock'

class
  ( SingleEraBlock blk
  , EqualHashSizeOfHead xs blk
  ) =>
  SingleEraBlockWithHashSizeOfHead xs blk

instance
  ( SingleEraBlock blk
  , EqualHashSizeOfHead xs blk
  ) =>
  SingleEraBlockWithHashSizeOfHead xs blk

proofSingleEraBlockWithHashSizeOfHead ::
  forall xs.
  ( All SingleEraBlock xs
  , All (EqualHashSizeOfHead xs) xs
  ) =>
  Dict (All (SingleEraBlockWithHashSizeOfHead xs)) xs
proofSingleEraBlockWithHashSizeOfHead :: forall (xs :: [*]).
(All SingleEraBlock xs, All (EqualHashSizeOfHead xs) xs) =>
Dict (All (SingleEraBlockWithHashSizeOfHead xs)) xs
proofSingleEraBlockWithHashSizeOfHead =
  (forall a.
 Dict (And SingleEraBlock (EqualHashSizeOfHead xs)) a
 -> Dict (SingleEraBlockWithHashSizeOfHead xs) a)
-> Dict (All (And SingleEraBlock (EqualHashSizeOfHead xs))) xs
-> Dict (All (SingleEraBlockWithHashSizeOfHead xs)) xs
forall {k} (c :: k -> Constraint) (d :: k -> Constraint)
       (xs :: [k]).
(forall (a :: k). Dict c a -> Dict d a)
-> Dict (All c) xs -> Dict (All d) xs
Dict.mapAll
    (\Dict (And SingleEraBlock (EqualHashSizeOfHead xs)) a
Dict -> Dict (SingleEraBlockWithHashSizeOfHead xs) a
forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict)
    ( Dict (All SingleEraBlock) xs
-> Dict (All (EqualHashSizeOfHead xs)) xs
-> Dict (All (And SingleEraBlock (EqualHashSizeOfHead xs))) xs
forall {k} (c :: k -> Constraint) (xs :: [k])
       (d :: k -> Constraint).
Dict (All c) xs -> Dict (All d) xs -> Dict (All (And c d)) xs
Dict.zipAll
        (Dict (All SingleEraBlock) xs
forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict :: Dict (All SingleEraBlock) xs)
        (Dict (All (EqualHashSizeOfHead xs)) xs
forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict :: Dict (All (EqualHashSizeOfHead xs)) xs)
    )

instance
  ( StandardHash (HardForkBlock xs)
  , HashSize (HardForkBlock xs) ~ HashSizeOfHead xs
  , CanHardFork xs
  ) =>
  BlockSupportsPeras (HardForkBlock xs)
  where
  type PerasVote (HardForkBlock xs) = OneEraPerasVote xs
  type PerasCert (HardForkBlock xs) = OneEraPerasCert xs
  type PerasError (HardForkBlock xs) = HardForkPerasError xs
  type PerasCrypto (HardForkBlock xs) = OneEraPerasCrypto xs
  type PerasVotingCommitteeScheme (HardForkBlock xs) = OneEraPerasVotingCommitteeScheme xs

  forgePerasVoteIfEligible :: PerasEpochContext (HardForkBlock xs)
-> PoolId
-> PrivateKey (PerasCrypto (HardForkBlock xs))
-> PerasRoundNo
-> Point (HardForkBlock xs)
-> Either
     (PerasError (HardForkBlock xs))
     (Maybe (ValidatedPerasVote (HardForkBlock xs)))
forgePerasVoteIfEligible PerasEpochContext (HardForkBlock xs)
context PoolId
poolId PrivateKey (PerasCrypto (HardForkBlock xs))
privKey PerasRoundNo
roundNo Point (HardForkBlock xs)
point =
    let
      nsPrivKeyContext :: NS (Product WrapPerasPrivateKey PerasEpochContext) xs
nsPrivKeyContext =
        (forall a.
 WrapPerasPrivateKey a
 -> PerasEpochContext a
 -> Product WrapPerasPrivateKey PerasEpochContext a)
-> Prod NS WrapPerasPrivateKey xs
-> NS PerasEpochContext xs
-> NS (Product WrapPerasPrivateKey PerasEpochContext) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(SListIN (Prod h) xs, HAp h, HAp (Prod h)) =>
(forall (a :: k). f a -> f' a -> f'' a)
-> Prod h f xs -> h f' xs -> h f'' xs
hzipWith
          WrapPerasPrivateKey a
-> PerasEpochContext a
-> Product WrapPerasPrivateKey PerasEpochContext a
forall a.
WrapPerasPrivateKey a
-> PerasEpochContext a
-> Product WrapPerasPrivateKey PerasEpochContext a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair
          (PerEraPerasPrivateKey xs -> NP WrapPerasPrivateKey xs
forall (xs :: [*]).
PerEraPerasPrivateKey xs -> NP WrapPerasPrivateKey xs
getPerEraPerasPrivateKey PrivateKey (PerasCrypto (HardForkBlock xs))
PerEraPerasPrivateKey xs
privKey)
          (PerasEpochContext (HardForkBlock xs) -> NS PerasEpochContext xs
forall (xs :: [*]).
All Top xs =>
PerasEpochContext (HardForkBlock xs) -> NS PerasEpochContext xs
projectHFCPerasEpochContext PerasEpochContext (HardForkBlock xs)
context)
     in
      case forall (xs :: [*]).
(All SingleEraBlock xs, All (EqualHashSizeOfHead xs) xs) =>
Dict (All (SingleEraBlockWithHashSizeOfHead xs)) xs
proofSingleEraBlockWithHashSizeOfHead @xs of
        Dict (All (SingleEraBlockWithHashSizeOfHead xs)) xs
Dict ->
          (NS WrapPerasError xs -> HardForkPerasError xs)
-> (NS (Maybe :.: ValidatedPerasVote) xs
    -> Maybe (ValidatedPerasVote (HardForkBlock xs)))
-> Either
     (NS WrapPerasError xs) (NS (Maybe :.: ValidatedPerasVote) xs)
-> Either
     (HardForkPerasError xs)
     (Maybe (ValidatedPerasVote (HardForkBlock xs)))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: MapKind) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
            (OneEraPerasError xs -> HardForkPerasError xs
forall (xs :: [*]). OneEraPerasError xs -> HardForkPerasError xs
HardForkPerasErrorOneEraPerasError (OneEraPerasError xs -> HardForkPerasError xs)
-> (NS WrapPerasError xs -> OneEraPerasError xs)
-> NS WrapPerasError xs
-> HardForkPerasError xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapPerasError xs -> OneEraPerasError xs
forall (xs :: [*]). NS WrapPerasError xs -> OneEraPerasError xs
OneEraPerasError)
            ((NS ValidatedPerasVote xs -> ValidatedPerasVote (HardForkBlock xs))
-> Maybe (NS ValidatedPerasVote xs)
-> Maybe (ValidatedPerasVote (HardForkBlock xs))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NS ValidatedPerasVote xs -> ValidatedPerasVote (HardForkBlock xs)
forall (xs :: [*]).
All Top xs =>
NS ValidatedPerasVote xs -> ValidatedPerasVote (HardForkBlock xs)
injectHFCValidatedPerasVote (Maybe (NS ValidatedPerasVote xs)
 -> Maybe (ValidatedPerasVote (HardForkBlock xs)))
-> (NS (Maybe :.: ValidatedPerasVote) xs
    -> Maybe (NS ValidatedPerasVote xs))
-> NS (Maybe :.: ValidatedPerasVote) xs
-> Maybe (ValidatedPerasVote (HardForkBlock xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (Maybe :.: ValidatedPerasVote) xs
-> Maybe (NS ValidatedPerasVote xs)
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
(SListIN NS xs, Applicative f) =>
NS (f :.: g) xs -> f (NS g 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')
            (Either
   (NS WrapPerasError xs) (NS (Maybe :.: ValidatedPerasVote) xs)
 -> Either
      (PerasError (HardForkBlock xs))
      (Maybe (ValidatedPerasVote (HardForkBlock xs))))
-> (NS (Product WrapPerasPrivateKey PerasEpochContext) xs
    -> Either
         (NS WrapPerasError xs) (NS (Maybe :.: ValidatedPerasVote) xs))
-> NS (Product WrapPerasPrivateKey PerasEpochContext) xs
-> Either
     (PerasError (HardForkBlock xs))
     (Maybe (ValidatedPerasVote (HardForkBlock xs)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (EitherF WrapPerasError (Maybe :.: ValidatedPerasVote)) xs
-> Either
     (NS WrapPerasError xs) (NS (Maybe :.: ValidatedPerasVote) xs)
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
SListI xs =>
NS (EitherF f g) xs -> Either (NS f xs) (NS g xs)
hdistribute
            (NS (EitherF WrapPerasError (Maybe :.: ValidatedPerasVote)) xs
 -> Either
      (NS WrapPerasError xs) (NS (Maybe :.: ValidatedPerasVote) xs))
-> (NS (Product WrapPerasPrivateKey PerasEpochContext) xs
    -> NS (EitherF WrapPerasError (Maybe :.: ValidatedPerasVote)) xs)
-> NS (Product WrapPerasPrivateKey PerasEpochContext) xs
-> Either
     (NS WrapPerasError xs) (NS (Maybe :.: ValidatedPerasVote) xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (SingleEraBlockWithHashSizeOfHead xs)
-> (forall a.
    SingleEraBlockWithHashSizeOfHead xs a =>
    Product WrapPerasPrivateKey PerasEpochContext a
    -> EitherF WrapPerasError (Maybe :.: ValidatedPerasVote) a)
-> NS (Product WrapPerasPrivateKey PerasEpochContext) xs
-> NS (EitherF WrapPerasError (Maybe :.: ValidatedPerasVote)) 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
              (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @(SingleEraBlockWithHashSizeOfHead xs))
              ( \(Pair (WrapPerasPrivateKey PrivateKey (PerasCrypto a)
privKey') PerasEpochContext a
context') ->
                  (PerasError a -> WrapPerasError a)
-> (Maybe (ValidatedPerasVote a)
    -> (:.:) Maybe ValidatedPerasVote a)
-> Either (PerasError a) (Maybe (ValidatedPerasVote a))
-> EitherF WrapPerasError (Maybe :.: ValidatedPerasVote) a
forall a (f :: * -> *) x b (g :: * -> *).
(a -> f x) -> (b -> g x) -> Either a b -> EitherF f g x
mkEitherF PerasError a -> WrapPerasError a
forall blk. PerasError blk -> WrapPerasError blk
WrapPerasError Maybe (ValidatedPerasVote a) -> (:.:) Maybe ValidatedPerasVote a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Either (PerasError a) (Maybe (ValidatedPerasVote a))
 -> EitherF WrapPerasError (Maybe :.: ValidatedPerasVote) a)
-> Either (PerasError a) (Maybe (ValidatedPerasVote a))
-> EitherF WrapPerasError (Maybe :.: ValidatedPerasVote) a
forall a b. (a -> b) -> a -> b
$
                    PerasEpochContext a
-> PoolId
-> PrivateKey (PerasCrypto a)
-> PerasRoundNo
-> Point a
-> Either (PerasError a) (Maybe (ValidatedPerasVote a))
forall blk.
BlockSupportsPeras blk =>
PerasEpochContext blk
-> PoolId
-> PrivateKey (PerasCrypto blk)
-> PerasRoundNo
-> Point blk
-> Either (PerasError blk) (Maybe (ValidatedPerasVote blk))
forgePerasVoteIfEligible
                      PerasEpochContext a
context'
                      PoolId
poolId
                      PrivateKey (PerasCrypto a)
privKey'
                      PerasRoundNo
roundNo
                      (Point (HardForkBlock xs) -> Point a
forall blk (xs :: [*]).
(ConvertRawHash blk, HashSize (HardForkBlock xs) ~ HashSize blk) =>
Point (HardForkBlock xs) -> Point blk
distribHardForkPoint Point (HardForkBlock xs)
point)
              )
            (NS (Product WrapPerasPrivateKey PerasEpochContext) xs
 -> Either
      (PerasError (HardForkBlock xs))
      (Maybe (ValidatedPerasVote (HardForkBlock xs))))
-> NS (Product WrapPerasPrivateKey PerasEpochContext) xs
-> Either
     (PerasError (HardForkBlock xs))
     (Maybe (ValidatedPerasVote (HardForkBlock xs)))
forall a b. (a -> b) -> a -> b
$ NS (Product WrapPerasPrivateKey PerasEpochContext) xs
nsPrivKeyContext

  verifyPerasVote :: PerasEpochContext (HardForkBlock xs)
-> PerasVote (HardForkBlock xs)
-> Either
     (PerasError (HardForkBlock xs))
     (ValidatedPerasVote (HardForkBlock xs))
verifyPerasVote PerasEpochContext (HardForkBlock xs)
context PerasVote (HardForkBlock xs)
vote =
    case NS PerasEpochContext xs
-> NS WrapPerasVote xs
-> Either
     (Mismatch PerasEpochContext WrapPerasVote xs)
     (NS (Product PerasEpochContext WrapPerasVote) xs)
forall {k} (f :: k -> *) (xs :: [k]) (g :: k -> *).
NS f xs
-> NS g xs -> Either (Mismatch f g xs) (NS (Product f g) xs)
Match.matchNS (PerasEpochContext (HardForkBlock xs) -> NS PerasEpochContext xs
forall (xs :: [*]).
All Top xs =>
PerasEpochContext (HardForkBlock xs) -> NS PerasEpochContext xs
projectHFCPerasEpochContext PerasEpochContext (HardForkBlock xs)
context) (OneEraPerasVote xs -> NS WrapPerasVote xs
forall (xs :: [*]). OneEraPerasVote xs -> NS WrapPerasVote xs
getOneEraPerasVote PerasVote (HardForkBlock xs)
OneEraPerasVote xs
vote) of
      Left Mismatch PerasEpochContext WrapPerasVote xs
_mismatch ->
        HardForkPerasError xs
-> Either
     (HardForkPerasError xs) (ValidatedPerasVote (HardForkBlock xs))
forall a b. a -> Either a b
Left HardForkPerasError xs
forall (xs :: [*]). HardForkPerasError xs
HardForkPerasErrorEraMismatch
      Right NS (Product PerasEpochContext WrapPerasVote) xs
nsContextVote ->
        (NS WrapPerasError xs -> HardForkPerasError xs)
-> (NS ValidatedPerasVote xs
    -> ValidatedPerasVote (HardForkBlock xs))
-> Either (NS WrapPerasError xs) (NS ValidatedPerasVote xs)
-> Either
     (HardForkPerasError xs) (ValidatedPerasVote (HardForkBlock xs))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: MapKind) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
          (OneEraPerasError xs -> HardForkPerasError xs
forall (xs :: [*]). OneEraPerasError xs -> HardForkPerasError xs
HardForkPerasErrorOneEraPerasError (OneEraPerasError xs -> HardForkPerasError xs)
-> (NS WrapPerasError xs -> OneEraPerasError xs)
-> NS WrapPerasError xs
-> HardForkPerasError xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapPerasError xs -> OneEraPerasError xs
forall (xs :: [*]). NS WrapPerasError xs -> OneEraPerasError xs
OneEraPerasError)
          NS ValidatedPerasVote xs -> ValidatedPerasVote (HardForkBlock xs)
forall (xs :: [*]).
All Top xs =>
NS ValidatedPerasVote xs -> ValidatedPerasVote (HardForkBlock xs)
injectHFCValidatedPerasVote
          (Either (NS WrapPerasError xs) (NS ValidatedPerasVote xs)
 -> Either
      (PerasError (HardForkBlock xs))
      (ValidatedPerasVote (HardForkBlock xs)))
-> (NS (Product PerasEpochContext WrapPerasVote) xs
    -> Either (NS WrapPerasError xs) (NS ValidatedPerasVote xs))
-> NS (Product PerasEpochContext WrapPerasVote) xs
-> Either
     (PerasError (HardForkBlock xs))
     (ValidatedPerasVote (HardForkBlock xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (EitherF WrapPerasError ValidatedPerasVote) xs
-> Either (NS WrapPerasError xs) (NS ValidatedPerasVote xs)
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
SListI xs =>
NS (EitherF f g) xs -> Either (NS f xs) (NS g xs)
hdistribute
          (NS (EitherF WrapPerasError ValidatedPerasVote) xs
 -> Either (NS WrapPerasError xs) (NS ValidatedPerasVote xs))
-> (NS (Product PerasEpochContext WrapPerasVote) xs
    -> NS (EitherF WrapPerasError ValidatedPerasVote) xs)
-> NS (Product PerasEpochContext WrapPerasVote) xs
-> Either (NS WrapPerasError xs) (NS ValidatedPerasVote xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Product PerasEpochContext WrapPerasVote a
    -> EitherF WrapPerasError ValidatedPerasVote a)
-> NS (Product PerasEpochContext WrapPerasVote) xs
-> NS (EitherF WrapPerasError ValidatedPerasVote) 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
            ( \(Pair PerasEpochContext a
context' (WrapPerasVote PerasVote a
vote')) ->
                (PerasError a -> WrapPerasError a)
-> (ValidatedPerasVote a -> ValidatedPerasVote a)
-> Either (PerasError a) (ValidatedPerasVote a)
-> EitherF WrapPerasError ValidatedPerasVote a
forall a (f :: * -> *) x b (g :: * -> *).
(a -> f x) -> (b -> g x) -> Either a b -> EitherF f g x
mkEitherF PerasError a -> WrapPerasError a
forall blk. PerasError blk -> WrapPerasError blk
WrapPerasError ValidatedPerasVote a -> ValidatedPerasVote a
forall a. a -> a
id (Either (PerasError a) (ValidatedPerasVote a)
 -> EitherF WrapPerasError ValidatedPerasVote a)
-> Either (PerasError a) (ValidatedPerasVote a)
-> EitherF WrapPerasError ValidatedPerasVote a
forall a b. (a -> b) -> a -> b
$
                  PerasEpochContext a
-> PerasVote a -> Either (PerasError a) (ValidatedPerasVote a)
forall blk.
BlockSupportsPeras blk =>
PerasEpochContext blk
-> PerasVote blk
-> Either (PerasError blk) (ValidatedPerasVote blk)
verifyPerasVote PerasEpochContext a
context' PerasVote a
vote'
            )
          (NS (Product PerasEpochContext WrapPerasVote) xs
 -> Either
      (PerasError (HardForkBlock xs))
      (ValidatedPerasVote (HardForkBlock xs)))
-> NS (Product PerasEpochContext WrapPerasVote) xs
-> Either
     (PerasError (HardForkBlock xs))
     (ValidatedPerasVote (HardForkBlock xs))
forall a b. (a -> b) -> a -> b
$ NS (Product PerasEpochContext WrapPerasVote) xs
nsContextVote

  forgePerasCert :: PerasEpochContext (HardForkBlock xs)
-> PerasVoteCollectionWithQuorum (HardForkBlock xs)
-> Either
     (PerasError (HardForkBlock xs))
     (ValidatedPerasCert (HardForkBlock xs))
forgePerasCert PerasEpochContext (HardForkBlock xs)
context PerasVoteCollectionWithQuorum (HardForkBlock xs)
collection =
    case PerasVoteCollectionWithQuorum (HardForkBlock xs)
-> Maybe (NS PerasVoteCollectionWithQuorum xs)
forall (xs :: [*]).
All SingleEraBlock xs =>
PerasVoteCollectionWithQuorum (HardForkBlock xs)
-> Maybe (NS PerasVoteCollectionWithQuorum xs)
projectHFCPerasVoteCollectionWithQuorum PerasVoteCollectionWithQuorum (HardForkBlock xs)
collection of
      Maybe (NS PerasVoteCollectionWithQuorum xs)
Nothing ->
        HardForkPerasError xs
-> Either
     (HardForkPerasError xs) (ValidatedPerasCert (HardForkBlock xs))
forall a b. a -> Either a b
Left HardForkPerasError xs
forall (xs :: [*]). HardForkPerasError xs
HardForkPerasErrorEraMismatch
      Just NS PerasVoteCollectionWithQuorum xs
nsCollection ->
        case NS PerasEpochContext xs
-> NS PerasVoteCollectionWithQuorum xs
-> Either
     (Mismatch PerasEpochContext PerasVoteCollectionWithQuorum xs)
     (NS (Product PerasEpochContext PerasVoteCollectionWithQuorum) xs)
forall {k} (f :: k -> *) (xs :: [k]) (g :: k -> *).
NS f xs
-> NS g xs -> Either (Mismatch f g xs) (NS (Product f g) xs)
Match.matchNS (PerasEpochContext (HardForkBlock xs) -> NS PerasEpochContext xs
forall (xs :: [*]).
All Top xs =>
PerasEpochContext (HardForkBlock xs) -> NS PerasEpochContext xs
projectHFCPerasEpochContext PerasEpochContext (HardForkBlock xs)
context) NS PerasVoteCollectionWithQuorum xs
nsCollection of
          Left Mismatch PerasEpochContext PerasVoteCollectionWithQuorum xs
_mismatch ->
            HardForkPerasError xs
-> Either
     (HardForkPerasError xs) (ValidatedPerasCert (HardForkBlock xs))
forall a b. a -> Either a b
Left HardForkPerasError xs
forall (xs :: [*]). HardForkPerasError xs
HardForkPerasErrorEraMismatch
          Right NS (Product PerasEpochContext PerasVoteCollectionWithQuorum) xs
nsContextCollection ->
            (NS WrapPerasError xs -> HardForkPerasError xs)
-> (NS ValidatedPerasCert xs
    -> ValidatedPerasCert (HardForkBlock xs))
-> Either (NS WrapPerasError xs) (NS ValidatedPerasCert xs)
-> Either
     (HardForkPerasError xs) (ValidatedPerasCert (HardForkBlock xs))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: MapKind) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
              (OneEraPerasError xs -> HardForkPerasError xs
forall (xs :: [*]). OneEraPerasError xs -> HardForkPerasError xs
HardForkPerasErrorOneEraPerasError (OneEraPerasError xs -> HardForkPerasError xs)
-> (NS WrapPerasError xs -> OneEraPerasError xs)
-> NS WrapPerasError xs
-> HardForkPerasError xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapPerasError xs -> OneEraPerasError xs
forall (xs :: [*]). NS WrapPerasError xs -> OneEraPerasError xs
OneEraPerasError)
              NS ValidatedPerasCert xs -> ValidatedPerasCert (HardForkBlock xs)
forall (xs :: [*]).
All Top xs =>
NS ValidatedPerasCert xs -> ValidatedPerasCert (HardForkBlock xs)
injectHFCValidatedPerasCert
              (Either (NS WrapPerasError xs) (NS ValidatedPerasCert xs)
 -> Either
      (PerasError (HardForkBlock xs))
      (ValidatedPerasCert (HardForkBlock xs)))
-> (NS (Product PerasEpochContext PerasVoteCollectionWithQuorum) xs
    -> Either (NS WrapPerasError xs) (NS ValidatedPerasCert xs))
-> NS (Product PerasEpochContext PerasVoteCollectionWithQuorum) xs
-> Either
     (PerasError (HardForkBlock xs))
     (ValidatedPerasCert (HardForkBlock xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (EitherF WrapPerasError ValidatedPerasCert) xs
-> Either (NS WrapPerasError xs) (NS ValidatedPerasCert xs)
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
SListI xs =>
NS (EitherF f g) xs -> Either (NS f xs) (NS g xs)
hdistribute
              (NS (EitherF WrapPerasError ValidatedPerasCert) xs
 -> Either (NS WrapPerasError xs) (NS ValidatedPerasCert xs))
-> (NS (Product PerasEpochContext PerasVoteCollectionWithQuorum) xs
    -> NS (EitherF WrapPerasError ValidatedPerasCert) xs)
-> NS (Product PerasEpochContext PerasVoteCollectionWithQuorum) xs
-> Either (NS WrapPerasError xs) (NS ValidatedPerasCert xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Product PerasEpochContext PerasVoteCollectionWithQuorum a
    -> EitherF WrapPerasError ValidatedPerasCert a)
-> NS (Product PerasEpochContext PerasVoteCollectionWithQuorum) xs
-> NS (EitherF WrapPerasError ValidatedPerasCert) 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
                ( \(Pair PerasEpochContext a
context' PerasVoteCollectionWithQuorum a
collection') ->
                    (PerasError a -> WrapPerasError a)
-> (ValidatedPerasCert a -> ValidatedPerasCert a)
-> Either (PerasError a) (ValidatedPerasCert a)
-> EitherF WrapPerasError ValidatedPerasCert a
forall a (f :: * -> *) x b (g :: * -> *).
(a -> f x) -> (b -> g x) -> Either a b -> EitherF f g x
mkEitherF PerasError a -> WrapPerasError a
forall blk. PerasError blk -> WrapPerasError blk
WrapPerasError ValidatedPerasCert a -> ValidatedPerasCert a
forall a. a -> a
id (Either (PerasError a) (ValidatedPerasCert a)
 -> EitherF WrapPerasError ValidatedPerasCert a)
-> Either (PerasError a) (ValidatedPerasCert a)
-> EitherF WrapPerasError ValidatedPerasCert a
forall a b. (a -> b) -> a -> b
$
                      PerasEpochContext a
-> PerasVoteCollectionWithQuorum a
-> Either (PerasError a) (ValidatedPerasCert a)
forall blk.
BlockSupportsPeras blk =>
PerasEpochContext blk
-> PerasVoteCollectionWithQuorum blk
-> Either (PerasError blk) (ValidatedPerasCert blk)
forgePerasCert PerasEpochContext a
context' PerasVoteCollectionWithQuorum a
collection'
                )
              (NS (Product PerasEpochContext PerasVoteCollectionWithQuorum) xs
 -> Either
      (PerasError (HardForkBlock xs))
      (ValidatedPerasCert (HardForkBlock xs)))
-> NS (Product PerasEpochContext PerasVoteCollectionWithQuorum) xs
-> Either
     (PerasError (HardForkBlock xs))
     (ValidatedPerasCert (HardForkBlock xs))
forall a b. (a -> b) -> a -> b
$ NS (Product PerasEpochContext PerasVoteCollectionWithQuorum) xs
nsContextCollection

  verifyPerasCert :: PerasEpochContext (HardForkBlock xs)
-> PerasCert (HardForkBlock xs)
-> Either
     (PerasError (HardForkBlock xs))
     (ValidatedPerasCert (HardForkBlock xs))
verifyPerasCert PerasEpochContext (HardForkBlock xs)
context PerasCert (HardForkBlock xs)
cert =
    case NS PerasEpochContext xs
-> NS WrapPerasCert xs
-> Either
     (Mismatch PerasEpochContext WrapPerasCert xs)
     (NS (Product PerasEpochContext WrapPerasCert) xs)
forall {k} (f :: k -> *) (xs :: [k]) (g :: k -> *).
NS f xs
-> NS g xs -> Either (Mismatch f g xs) (NS (Product f g) xs)
Match.matchNS (PerasEpochContext (HardForkBlock xs) -> NS PerasEpochContext xs
forall (xs :: [*]).
All Top xs =>
PerasEpochContext (HardForkBlock xs) -> NS PerasEpochContext xs
projectHFCPerasEpochContext PerasEpochContext (HardForkBlock xs)
context) (OneEraPerasCert xs -> NS WrapPerasCert xs
forall (xs :: [*]). OneEraPerasCert xs -> NS WrapPerasCert xs
getOneEraPerasCert PerasCert (HardForkBlock xs)
OneEraPerasCert xs
cert) of
      Left Mismatch PerasEpochContext WrapPerasCert xs
_mismatch ->
        HardForkPerasError xs
-> Either
     (HardForkPerasError xs) (ValidatedPerasCert (HardForkBlock xs))
forall a b. a -> Either a b
Left HardForkPerasError xs
forall (xs :: [*]). HardForkPerasError xs
HardForkPerasErrorEraMismatch
      Right NS (Product PerasEpochContext WrapPerasCert) xs
nsContextCert ->
        (NS WrapPerasError xs -> HardForkPerasError xs)
-> (NS ValidatedPerasCert xs
    -> ValidatedPerasCert (HardForkBlock xs))
-> Either (NS WrapPerasError xs) (NS ValidatedPerasCert xs)
-> Either
     (HardForkPerasError xs) (ValidatedPerasCert (HardForkBlock xs))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: MapKind) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
          (OneEraPerasError xs -> HardForkPerasError xs
forall (xs :: [*]). OneEraPerasError xs -> HardForkPerasError xs
HardForkPerasErrorOneEraPerasError (OneEraPerasError xs -> HardForkPerasError xs)
-> (NS WrapPerasError xs -> OneEraPerasError xs)
-> NS WrapPerasError xs
-> HardForkPerasError xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapPerasError xs -> OneEraPerasError xs
forall (xs :: [*]). NS WrapPerasError xs -> OneEraPerasError xs
OneEraPerasError)
          NS ValidatedPerasCert xs -> ValidatedPerasCert (HardForkBlock xs)
forall (xs :: [*]).
All Top xs =>
NS ValidatedPerasCert xs -> ValidatedPerasCert (HardForkBlock xs)
injectHFCValidatedPerasCert
          (Either (NS WrapPerasError xs) (NS ValidatedPerasCert xs)
 -> Either
      (PerasError (HardForkBlock xs))
      (ValidatedPerasCert (HardForkBlock xs)))
-> (NS (Product PerasEpochContext WrapPerasCert) xs
    -> Either (NS WrapPerasError xs) (NS ValidatedPerasCert xs))
-> NS (Product PerasEpochContext WrapPerasCert) xs
-> Either
     (PerasError (HardForkBlock xs))
     (ValidatedPerasCert (HardForkBlock xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (EitherF WrapPerasError ValidatedPerasCert) xs
-> Either (NS WrapPerasError xs) (NS ValidatedPerasCert xs)
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
SListI xs =>
NS (EitherF f g) xs -> Either (NS f xs) (NS g xs)
hdistribute
          (NS (EitherF WrapPerasError ValidatedPerasCert) xs
 -> Either (NS WrapPerasError xs) (NS ValidatedPerasCert xs))
-> (NS (Product PerasEpochContext WrapPerasCert) xs
    -> NS (EitherF WrapPerasError ValidatedPerasCert) xs)
-> NS (Product PerasEpochContext WrapPerasCert) xs
-> Either (NS WrapPerasError xs) (NS ValidatedPerasCert xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Product PerasEpochContext WrapPerasCert a
    -> EitherF WrapPerasError ValidatedPerasCert a)
-> NS (Product PerasEpochContext WrapPerasCert) xs
-> NS (EitherF WrapPerasError ValidatedPerasCert) 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
            ( \(Pair PerasEpochContext a
context' (WrapPerasCert PerasCert a
cert')) ->
                (PerasError a -> WrapPerasError a)
-> (ValidatedPerasCert a -> ValidatedPerasCert a)
-> Either (PerasError a) (ValidatedPerasCert a)
-> EitherF WrapPerasError ValidatedPerasCert a
forall a (f :: * -> *) x b (g :: * -> *).
(a -> f x) -> (b -> g x) -> Either a b -> EitherF f g x
mkEitherF PerasError a -> WrapPerasError a
forall blk. PerasError blk -> WrapPerasError blk
WrapPerasError ValidatedPerasCert a -> ValidatedPerasCert a
forall a. a -> a
id (Either (PerasError a) (ValidatedPerasCert a)
 -> EitherF WrapPerasError ValidatedPerasCert a)
-> Either (PerasError a) (ValidatedPerasCert a)
-> EitherF WrapPerasError ValidatedPerasCert a
forall a b. (a -> b) -> a -> b
$
                  PerasEpochContext a
-> PerasCert a -> Either (PerasError a) (ValidatedPerasCert a)
forall blk.
BlockSupportsPeras blk =>
PerasEpochContext blk
-> PerasCert blk
-> Either (PerasError blk) (ValidatedPerasCert blk)
verifyPerasCert PerasEpochContext a
context' PerasCert a
cert'
            )
          (NS (Product PerasEpochContext WrapPerasCert) xs
 -> Either
      (PerasError (HardForkBlock xs))
      (ValidatedPerasCert (HardForkBlock xs)))
-> NS (Product PerasEpochContext WrapPerasCert) xs
-> Either
     (PerasError (HardForkBlock xs))
     (ValidatedPerasCert (HardForkBlock xs))
forall a b. (a -> b) -> a -> b
$ NS (Product PerasEpochContext WrapPerasCert) xs
nsContextCert

  getPerasCertInBlock :: HardForkBlock xs
-> Either
     (PerasError (HardForkBlock xs))
     (Maybe (PerasCert (HardForkBlock xs)))
getPerasCertInBlock (HardForkBlock (OneEraBlock NS I xs
nsBlock)) =
    (NS WrapPerasError xs -> HardForkPerasError xs)
-> (NS (Maybe :.: WrapPerasCert) xs -> Maybe (OneEraPerasCert xs))
-> Either (NS WrapPerasError xs) (NS (Maybe :.: WrapPerasCert) xs)
-> Either (HardForkPerasError xs) (Maybe (OneEraPerasCert xs))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: MapKind) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
      (OneEraPerasError xs -> HardForkPerasError xs
forall (xs :: [*]). OneEraPerasError xs -> HardForkPerasError xs
HardForkPerasErrorOneEraPerasError (OneEraPerasError xs -> HardForkPerasError xs)
-> (NS WrapPerasError xs -> OneEraPerasError xs)
-> NS WrapPerasError xs
-> HardForkPerasError xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapPerasError xs -> OneEraPerasError xs
forall (xs :: [*]). NS WrapPerasError xs -> OneEraPerasError xs
OneEraPerasError)
      ((NS WrapPerasCert xs -> OneEraPerasCert xs)
-> Maybe (NS WrapPerasCert xs) -> Maybe (OneEraPerasCert xs)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NS WrapPerasCert xs -> OneEraPerasCert xs
forall (xs :: [*]). NS WrapPerasCert xs -> OneEraPerasCert xs
OneEraPerasCert (Maybe (NS WrapPerasCert xs) -> Maybe (OneEraPerasCert xs))
-> (NS (Maybe :.: WrapPerasCert) xs -> Maybe (NS WrapPerasCert xs))
-> NS (Maybe :.: WrapPerasCert) xs
-> Maybe (OneEraPerasCert xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (Maybe :.: WrapPerasCert) xs -> Maybe (NS WrapPerasCert xs)
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
(SListIN NS xs, Applicative f) =>
NS (f :.: g) xs -> f (NS g 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')
      (Either (NS WrapPerasError xs) (NS (Maybe :.: WrapPerasCert) xs)
 -> Either
      (PerasError (HardForkBlock xs))
      (Maybe (PerasCert (HardForkBlock xs))))
-> (NS I xs
    -> Either (NS WrapPerasError xs) (NS (Maybe :.: WrapPerasCert) xs))
-> NS I xs
-> Either
     (PerasError (HardForkBlock xs))
     (Maybe (PerasCert (HardForkBlock xs)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (EitherF WrapPerasError (Maybe :.: WrapPerasCert)) xs
-> Either (NS WrapPerasError xs) (NS (Maybe :.: WrapPerasCert) xs)
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
SListI xs =>
NS (EitherF f g) xs -> Either (NS f xs) (NS g xs)
hdistribute
      (NS (EitherF WrapPerasError (Maybe :.: WrapPerasCert)) xs
 -> Either (NS WrapPerasError xs) (NS (Maybe :.: WrapPerasCert) xs))
-> (NS I xs
    -> NS (EitherF WrapPerasError (Maybe :.: WrapPerasCert)) xs)
-> NS I xs
-> Either (NS WrapPerasError xs) (NS (Maybe :.: WrapPerasCert) xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    I a -> EitherF WrapPerasError (Maybe :.: WrapPerasCert) a)
-> NS I xs
-> NS (EitherF WrapPerasError (Maybe :.: WrapPerasCert)) 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
        ( \(I a
block) ->
            (PerasError a -> WrapPerasError a)
-> (Maybe (PerasCert a) -> (:.:) Maybe WrapPerasCert a)
-> Either (PerasError a) (Maybe (PerasCert a))
-> EitherF WrapPerasError (Maybe :.: WrapPerasCert) a
forall a (f :: * -> *) x b (g :: * -> *).
(a -> f x) -> (b -> g x) -> Either a b -> EitherF f g x
mkEitherF PerasError a -> WrapPerasError a
forall blk. PerasError blk -> WrapPerasError blk
WrapPerasError (Maybe (WrapPerasCert a) -> (:.:) Maybe WrapPerasCert a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Maybe (WrapPerasCert a) -> (:.:) Maybe WrapPerasCert a)
-> (Maybe (PerasCert a) -> Maybe (WrapPerasCert a))
-> Maybe (PerasCert a)
-> (:.:) Maybe WrapPerasCert a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PerasCert a -> WrapPerasCert a)
-> Maybe (PerasCert a) -> Maybe (WrapPerasCert a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PerasCert a -> WrapPerasCert a
forall blk. PerasCert blk -> WrapPerasCert blk
WrapPerasCert) (Either (PerasError a) (Maybe (PerasCert a))
 -> EitherF WrapPerasError (Maybe :.: WrapPerasCert) a)
-> Either (PerasError a) (Maybe (PerasCert a))
-> EitherF WrapPerasError (Maybe :.: WrapPerasCert) a
forall a b. (a -> b) -> a -> b
$
              a -> Either (PerasError a) (Maybe (PerasCert a))
forall blk.
BlockSupportsPeras blk =>
blk -> Either (PerasError blk) (Maybe (PerasCert blk))
getPerasCertInBlock a
block
        )
      (NS I xs
 -> Either
      (PerasError (HardForkBlock xs))
      (Maybe (PerasCert (HardForkBlock xs))))
-> NS I xs
-> Either
     (PerasError (HardForkBlock xs))
     (Maybe (PerasCert (HardForkBlock xs)))
forall a b. (a -> b) -> a -> b
$ NS I xs
nsBlock

{-------------------------------------------------------------------------------
  LedgerSupportsPeras
-------------------------------------------------------------------------------}

instance CanHardFork xs => LedgerStateSupportsPeras (LedgerState (HardForkBlock xs)) where
  getPoolDistr :: LedgerState (HardForkBlock xs) EmptyMK -> PoolDistr
getPoolDistr =
    NS (K PoolDistr) xs -> PoolDistr
NS (K PoolDistr) xs -> CollapseTo NS PoolDistr
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K PoolDistr) xs -> PoolDistr)
-> (LedgerState (HardForkBlock xs) EmptyMK -> NS (K PoolDistr) xs)
-> LedgerState (HardForkBlock xs) EmptyMK
-> PoolDistr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Flip LedgerState EmptyMK a -> K PoolDistr a)
-> NS (Flip LedgerState EmptyMK) xs
-> NS (K PoolDistr) 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 (PoolDistr -> K PoolDistr a
forall k a (b :: k). a -> K a b
K (PoolDistr -> K PoolDistr a)
-> (Flip LedgerState EmptyMK a -> PoolDistr)
-> Flip LedgerState EmptyMK a
-> K PoolDistr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState a EmptyMK -> PoolDistr
forall (ledgerState :: MapKind -> *).
LedgerStateSupportsPeras ledgerState =>
ledgerState EmptyMK -> PoolDistr
getPoolDistr (LedgerState a EmptyMK -> PoolDistr)
-> (Flip LedgerState EmptyMK a -> LedgerState a EmptyMK)
-> Flip LedgerState EmptyMK a
-> PoolDistr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState EmptyMK a -> LedgerState a EmptyMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip)
      (NS (Flip LedgerState EmptyMK) xs -> NS (K PoolDistr) xs)
-> (LedgerState (HardForkBlock xs) EmptyMK
    -> NS (Flip LedgerState EmptyMK) xs)
-> LedgerState (HardForkBlock xs) EmptyMK
-> NS (K PoolDistr) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkState (Flip LedgerState EmptyMK) xs
-> NS (Flip LedgerState EmptyMK) xs
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
HardForkState f xs -> NS f xs
State.tip
      (HardForkState (Flip LedgerState EmptyMK) xs
 -> NS (Flip LedgerState EmptyMK) xs)
-> (LedgerState (HardForkBlock xs) EmptyMK
    -> HardForkState (Flip LedgerState EmptyMK) xs)
-> LedgerState (HardForkBlock xs) EmptyMK
-> NS (Flip LedgerState EmptyMK) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (HardForkBlock xs) EmptyMK
-> HardForkState (Flip LedgerState EmptyMK) xs
forall (xs :: [*]) (mk :: MapKind).
LedgerState (HardForkBlock xs) mk
-> HardForkState (Flip LedgerState mk) xs
hardForkLedgerStatePerEra