{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

-- | Witness isomorphism between @b@ and @HardForkBlock '[b]@
module Ouroboros.Consensus.HardFork.Combinator.Embed.Unary (
    Isomorphic (..)
  , inject'
  , project'
    -- * Dependent types
  , ProjHardForkQuery (..)
  , injNestedCtxt
  , injQuery
  , injQueryResult
  , projNestedCtxt
  , projQuery
  , projQuery'
  , projQueryResult
    -- * Convenience exports
  , I (..)
  , Proxy (..)
  ) where

import           Cardano.Slotting.EpochInfo
import           Data.Bifunctor (first)
import           Data.Coerce
import           Data.Kind (Type)
import           Data.Proxy
import           Data.SOP.BasicFunctors
import qualified Data.SOP.OptNP as OptNP
import           Data.SOP.Strict
import qualified Data.SOP.Telescope as Telescope
import           Data.Type.Equality
import           Data.Void
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.HardFork.Combinator.Abstract
import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import           Ouroboros.Consensus.HardFork.Combinator.Basics
import           Ouroboros.Consensus.HardFork.Combinator.Block
import           Ouroboros.Consensus.HardFork.Combinator.Forging
import           Ouroboros.Consensus.HardFork.Combinator.Ledger
import           Ouroboros.Consensus.HardFork.Combinator.Ledger.Query
import           Ouroboros.Consensus.HardFork.Combinator.Mempool
import           Ouroboros.Consensus.HardFork.Combinator.PartialConfig
import           Ouroboros.Consensus.HardFork.Combinator.Protocol
import qualified Ouroboros.Consensus.HardFork.Combinator.State as State
import           Ouroboros.Consensus.HardFork.Combinator.State.Types
import qualified Ouroboros.Consensus.HardFork.History as History
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Node.ProtocolInfo
import           Ouroboros.Consensus.Protocol.Abstract
import           Ouroboros.Consensus.Storage.ChainDB.Init (InitChainDB)
import qualified Ouroboros.Consensus.Storage.ChainDB.Init as InitChainDB
import           Ouroboros.Consensus.Storage.Serialisation
import           Ouroboros.Consensus.TypeFamilyWrappers

{-------------------------------------------------------------------------------
  Projection/injection for a single block into degenerate HardForkBlock
-------------------------------------------------------------------------------}

class Isomorphic f where
  project :: NoHardForks blk => f (HardForkBlock '[blk]) -> f blk
  inject  :: NoHardForks blk => f blk -> f (HardForkBlock '[blk])

project' :: forall proxy f x y blk. (
              Isomorphic f
            , NoHardForks blk
            , Coercible x (f (HardForkBlock '[blk]))
            , Coercible y (f blk)
            )
         => proxy (f blk) -> x -> y
project' :: forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk,
 Coercible x (f (HardForkBlock '[blk])), Coercible y (f blk)) =>
proxy (f blk) -> x -> y
project' proxy (f blk)
_ =
      (f blk -> y
forall a b. Coercible a b => a -> b
coerce :: f blk -> y)
    (f blk -> y) -> (x -> f blk) -> x -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (HardForkBlock '[blk]) -> f blk
forall blk. NoHardForks blk => f (HardForkBlock '[blk]) -> f blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project
    (f (HardForkBlock '[blk]) -> f blk)
-> (x -> f (HardForkBlock '[blk])) -> x -> f blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> f (HardForkBlock '[blk])
forall a b. Coercible a b => a -> b
coerce :: x -> f (HardForkBlock '[blk]))

inject' :: forall proxy f x y blk. (
              Isomorphic f
            , NoHardForks blk
            , Coercible x (f blk)
            , Coercible y (f (HardForkBlock '[blk]))
            )
         => proxy (f blk) -> x -> y
inject' :: forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' proxy (f blk)
_ =
      (f (HardForkBlock '[blk]) -> y
forall a b. Coercible a b => a -> b
coerce :: f (HardForkBlock '[blk]) -> y)
    (f (HardForkBlock '[blk]) -> y)
-> (x -> f (HardForkBlock '[blk])) -> x -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f blk -> f (HardForkBlock '[blk])
forall blk. NoHardForks blk => f blk -> f (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject
    (f blk -> f (HardForkBlock '[blk]))
-> (x -> f blk) -> x -> f (HardForkBlock '[blk])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> f blk
forall a b. Coercible a b => a -> b
coerce :: x -> f blk)

{-------------------------------------------------------------------------------
  Defaults (to ease implementation)

  It'd be nicer to use deriving-via here, but we cannot due to a GHC bug
  (resulting in @No family instance for ‘GenTx’@ errors).
  See <https://gitlab.haskell.org/ghc/ghc/issues/13154#note_224287> .
-------------------------------------------------------------------------------}

defaultProjectNS :: forall f blk.
                    Coercible (f (HardForkBlock '[blk])) (NS f '[blk])
                 => f (HardForkBlock '[blk]) -> f blk
defaultProjectNS :: forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectNS = NS f '[blk] -> f blk
forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
unZ (NS f '[blk] -> f blk)
-> (f (HardForkBlock '[blk]) -> NS f '[blk])
-> f (HardForkBlock '[blk])
-> f blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (HardForkBlock '[blk]) -> NS f '[blk]
forall a b. Coercible a b => a -> b
coerce :: f (HardForkBlock '[blk]) -> NS f '[blk])

defaultInjectNS :: forall f blk.
                   Coercible (f (HardForkBlock '[blk])) (NS f '[blk])
                => f blk -> f (HardForkBlock '[blk])
defaultInjectNS :: forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectNS = (NS f '[blk] -> f (HardForkBlock '[blk])
forall a b. Coercible a b => a -> b
coerce :: NS f '[blk] -> f (HardForkBlock '[blk])) (NS f '[blk] -> f (HardForkBlock '[blk]))
-> (f blk -> NS f '[blk]) -> f blk -> f (HardForkBlock '[blk])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f blk -> NS f '[blk]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z

defaultProjectNP :: forall f blk.
                    Coercible (f (HardForkBlock '[blk])) (NP f '[blk])
                 => f (HardForkBlock '[blk]) -> f blk
defaultProjectNP :: forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NP f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectNP = NP f '[blk] -> f blk
forall {k} (f :: k -> *) (x :: k) (xs :: [k]). NP f (x : xs) -> f x
hd (NP f '[blk] -> f blk)
-> (f (HardForkBlock '[blk]) -> NP f '[blk])
-> f (HardForkBlock '[blk])
-> f blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (HardForkBlock '[blk]) -> NP f '[blk]
forall a b. Coercible a b => a -> b
coerce :: f (HardForkBlock '[blk]) -> NP f '[blk])

defaultInjectNP :: forall f blk.
                   Coercible (f (HardForkBlock '[blk])) (NP f '[blk])
                => f blk -> f (HardForkBlock '[blk])
defaultInjectNP :: forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NP f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectNP = (NP f '[blk] -> f (HardForkBlock '[blk])
forall a b. Coercible a b => a -> b
coerce :: NP f '[blk] -> f (HardForkBlock '[blk])) (NP f '[blk] -> f (HardForkBlock '[blk]))
-> (f blk -> NP f '[blk]) -> f blk -> f (HardForkBlock '[blk])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f blk -> NP f '[] -> NP f '[blk]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP f '[]
forall {k} (f :: k -> *). NP f '[]
Nil)

defaultProjectSt :: forall f blk.
                    Coercible (f (HardForkBlock '[blk])) (HardForkState f '[blk])
                 => f (HardForkBlock '[blk]) -> f blk
defaultProjectSt :: forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (HardForkState f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectSt =
      Current f blk -> f blk
forall (f :: * -> *) blk. Current f blk -> f blk
State.currentState
    (Current f blk -> f blk)
-> (f (HardForkBlock '[blk]) -> Current f blk)
-> f (HardForkBlock '[blk])
-> f blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Telescope (K Past) (Current f) '[blk] -> Current f blk
forall {k} (g :: k -> *) (f :: k -> *) (x :: k).
Telescope g f '[x] -> f x
Telescope.fromTZ
    (Telescope (K Past) (Current f) '[blk] -> Current f blk)
-> (f (HardForkBlock '[blk])
    -> Telescope (K Past) (Current f) '[blk])
-> f (HardForkBlock '[blk])
-> Current f blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkState f '[blk] -> Telescope (K Past) (Current f) '[blk]
forall (f :: * -> *) (xs :: [*]).
HardForkState f xs -> Telescope (K Past) (Current f) xs
getHardForkState
    (HardForkState f '[blk] -> Telescope (K Past) (Current f) '[blk])
-> (f (HardForkBlock '[blk]) -> HardForkState f '[blk])
-> f (HardForkBlock '[blk])
-> Telescope (K Past) (Current f) '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (HardForkBlock '[blk]) -> HardForkState f '[blk]
forall a b. Coercible a b => a -> b
coerce :: f (HardForkBlock '[blk]) -> HardForkState f '[blk])

defaultInjectSt :: forall f blk.
                   Coercible (f (HardForkBlock '[blk])) (HardForkState f '[blk])
                => f blk -> f (HardForkBlock '[blk])
defaultInjectSt :: forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (HardForkState f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectSt =
      (HardForkState f '[blk] -> f (HardForkBlock '[blk])
forall a b. Coercible a b => a -> b
coerce :: HardForkState f '[blk] -> f (HardForkBlock '[blk]))
    (HardForkState f '[blk] -> f (HardForkBlock '[blk]))
-> (f blk -> HardForkState f '[blk])
-> f blk
-> f (HardForkBlock '[blk])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Telescope (K Past) (Current f) '[blk] -> HardForkState f '[blk]
forall (f :: * -> *) (xs :: [*]).
Telescope (K Past) (Current f) xs -> HardForkState f xs
HardForkState
    (Telescope (K Past) (Current f) '[blk] -> HardForkState f '[blk])
-> (f blk -> Telescope (K Past) (Current f) '[blk])
-> f blk
-> HardForkState f '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current f blk -> Telescope (K Past) (Current f) '[blk]
forall {k} (f :: k -> *) (x :: k) (g :: k -> *) (xs1 :: [k]).
f x -> Telescope g f (x : xs1)
Telescope.TZ
    (Current f blk -> Telescope (K Past) (Current f) '[blk])
-> (f blk -> Current f blk)
-> f blk
-> Telescope (K Past) (Current f) '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound -> f blk -> Current f blk
forall (f :: * -> *) blk. Bound -> f blk -> Current f blk
State.Current Bound
History.initBound

{-------------------------------------------------------------------------------
  Forwarding instances
-------------------------------------------------------------------------------}

instance Isomorphic ((->) a) where
  project :: forall blk.
NoHardForks blk =>
(a -> HardForkBlock '[blk]) -> a -> blk
project a -> HardForkBlock '[blk]
f = (I (HardForkBlock '[blk]) -> I blk) -> HardForkBlock '[blk] -> blk
forall a b. Coercible a b => a -> b
coerce (forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project @I) (HardForkBlock '[blk] -> blk)
-> (a -> HardForkBlock '[blk]) -> a -> blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> HardForkBlock '[blk]
f
  inject :: forall blk.
NoHardForks blk =>
(a -> blk) -> a -> HardForkBlock '[blk]
inject  a -> blk
f = (I blk -> I (HardForkBlock '[blk])) -> blk -> HardForkBlock '[blk]
forall a b. Coercible a b => a -> b
coerce (forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject  @I) (blk -> HardForkBlock '[blk])
-> (a -> blk) -> a -> HardForkBlock '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> blk
f

{-------------------------------------------------------------------------------
  Simple instances
-------------------------------------------------------------------------------}

instance Isomorphic WrapIsLeader where
  project :: forall blk.
NoHardForks blk =>
WrapIsLeader (HardForkBlock '[blk]) -> WrapIsLeader blk
project = WrapIsLeader (HardForkBlock '[blk]) -> WrapIsLeader blk
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectNS
  inject :: forall blk.
NoHardForks blk =>
WrapIsLeader blk -> WrapIsLeader (HardForkBlock '[blk])
inject  = WrapIsLeader blk -> WrapIsLeader (HardForkBlock '[blk])
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectNS

instance Isomorphic WrapGenTxId where
  project :: forall blk.
NoHardForks blk =>
WrapGenTxId (HardForkBlock '[blk]) -> WrapGenTxId blk
project = WrapGenTxId (HardForkBlock '[blk]) -> WrapGenTxId blk
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectNS
  inject :: forall blk.
NoHardForks blk =>
WrapGenTxId blk -> WrapGenTxId (HardForkBlock '[blk])
inject  = WrapGenTxId blk -> WrapGenTxId (HardForkBlock '[blk])
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectNS

instance Isomorphic WrapValidatedGenTx where
  project :: forall blk.
NoHardForks blk =>
WrapValidatedGenTx (HardForkBlock '[blk]) -> WrapValidatedGenTx blk
project = WrapValidatedGenTx (HardForkBlock '[blk]) -> WrapValidatedGenTx blk
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectNS
  inject :: forall blk.
NoHardForks blk =>
WrapValidatedGenTx blk -> WrapValidatedGenTx (HardForkBlock '[blk])
inject  = WrapValidatedGenTx blk -> WrapValidatedGenTx (HardForkBlock '[blk])
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectNS

instance Isomorphic I where
  project :: forall blk. NoHardForks blk => I (HardForkBlock '[blk]) -> I blk
project = I (HardForkBlock '[blk]) -> I blk
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectNS
  inject :: forall blk. NoHardForks blk => I blk -> I (HardForkBlock '[blk])
inject  = I blk -> I (HardForkBlock '[blk])
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectNS

instance Isomorphic GenTx where
  project :: forall blk.
NoHardForks blk =>
GenTx (HardForkBlock '[blk]) -> GenTx blk
project = GenTx (HardForkBlock '[blk]) -> GenTx blk
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectNS
  inject :: forall blk.
NoHardForks blk =>
GenTx blk -> GenTx (HardForkBlock '[blk])
inject  = GenTx blk -> GenTx (HardForkBlock '[blk])
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectNS

instance Isomorphic Header where
  project :: forall blk.
NoHardForks blk =>
Header (HardForkBlock '[blk]) -> Header blk
project = Header (HardForkBlock '[blk]) -> Header blk
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectNS
  inject :: forall blk.
NoHardForks blk =>
Header blk -> Header (HardForkBlock '[blk])
inject  = Header blk -> Header (HardForkBlock '[blk])
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectNS

instance Isomorphic BlockConfig where
  project :: forall blk.
NoHardForks blk =>
BlockConfig (HardForkBlock '[blk]) -> BlockConfig blk
project = BlockConfig (HardForkBlock '[blk]) -> BlockConfig blk
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NP f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectNP
  inject :: forall blk.
NoHardForks blk =>
BlockConfig blk -> BlockConfig (HardForkBlock '[blk])
inject  = BlockConfig blk -> BlockConfig (HardForkBlock '[blk])
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NP f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectNP

instance Isomorphic CodecConfig where
  project :: forall blk.
NoHardForks blk =>
CodecConfig (HardForkBlock '[blk]) -> CodecConfig blk
project = CodecConfig (HardForkBlock '[blk]) -> CodecConfig blk
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NP f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectNP
  inject :: forall blk.
NoHardForks blk =>
CodecConfig blk -> CodecConfig (HardForkBlock '[blk])
inject  = CodecConfig blk -> CodecConfig (HardForkBlock '[blk])
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NP f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectNP

instance Isomorphic StorageConfig where
  project :: forall blk.
NoHardForks blk =>
StorageConfig (HardForkBlock '[blk]) -> StorageConfig blk
project = StorageConfig (HardForkBlock '[blk]) -> StorageConfig blk
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NP f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectNP
  inject :: forall blk.
NoHardForks blk =>
StorageConfig blk -> StorageConfig (HardForkBlock '[blk])
inject  = StorageConfig blk -> StorageConfig (HardForkBlock '[blk])
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NP f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectNP

instance Isomorphic LedgerState where
  project :: forall blk.
NoHardForks blk =>
LedgerState (HardForkBlock '[blk]) -> LedgerState blk
project = LedgerState (HardForkBlock '[blk]) -> LedgerState blk
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (HardForkState f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectSt
  inject :: forall blk.
NoHardForks blk =>
LedgerState blk -> LedgerState (HardForkBlock '[blk])
inject  = LedgerState blk -> LedgerState (HardForkBlock '[blk])
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (HardForkState f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectSt

instance Isomorphic WrapCannotForge where
  project :: forall blk.
NoHardForks blk =>
WrapCannotForge (HardForkBlock '[blk]) -> WrapCannotForge blk
project = WrapCannotForge (HardForkBlock '[blk]) -> WrapCannotForge blk
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectNS
  inject :: forall blk.
NoHardForks blk =>
WrapCannotForge blk -> WrapCannotForge (HardForkBlock '[blk])
inject  = WrapCannotForge blk -> WrapCannotForge (HardForkBlock '[blk])
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectNS

instance Isomorphic WrapChainDepState where
  project :: forall blk.
NoHardForks blk =>
WrapChainDepState (HardForkBlock '[blk]) -> WrapChainDepState blk
project = WrapChainDepState (HardForkBlock '[blk]) -> WrapChainDepState blk
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (HardForkState f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectSt
  inject :: forall blk.
NoHardForks blk =>
WrapChainDepState blk -> WrapChainDepState (HardForkBlock '[blk])
inject  = WrapChainDepState blk -> WrapChainDepState (HardForkBlock '[blk])
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (HardForkState f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectSt

instance Isomorphic WrapForgeStateUpdateError where
  project :: forall blk.
NoHardForks blk =>
WrapForgeStateUpdateError (HardForkBlock '[blk])
-> WrapForgeStateUpdateError blk
project = WrapForgeStateUpdateError (HardForkBlock '[blk])
-> WrapForgeStateUpdateError blk
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectNS
  inject :: forall blk.
NoHardForks blk =>
WrapForgeStateUpdateError blk
-> WrapForgeStateUpdateError (HardForkBlock '[blk])
inject  = WrapForgeStateUpdateError blk
-> WrapForgeStateUpdateError (HardForkBlock '[blk])
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectNS

instance Isomorphic WrapTipInfo where
  project :: forall blk.
NoHardForks blk =>
WrapTipInfo (HardForkBlock '[blk]) -> WrapTipInfo blk
project = WrapTipInfo (HardForkBlock '[blk]) -> WrapTipInfo blk
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f (HardForkBlock '[blk]) -> f blk
defaultProjectNS
  inject :: forall blk.
NoHardForks blk =>
WrapTipInfo blk -> WrapTipInfo (HardForkBlock '[blk])
inject  = WrapTipInfo blk -> WrapTipInfo (HardForkBlock '[blk])
forall (f :: * -> *) blk.
Coercible (f (HardForkBlock '[blk])) (NS f '[blk]) =>
f blk -> f (HardForkBlock '[blk])
defaultInjectNS

{-------------------------------------------------------------------------------
  Hash
-------------------------------------------------------------------------------}

instance Isomorphic WrapHeaderHash where
  project :: forall blk. ConvertRawHash blk
          => WrapHeaderHash (HardForkBlock '[blk]) -> WrapHeaderHash blk
  project :: forall blk.
ConvertRawHash blk =>
WrapHeaderHash (HardForkBlock '[blk]) -> WrapHeaderHash blk
project =
        HeaderHash blk -> WrapHeaderHash blk
forall blk. HeaderHash blk -> WrapHeaderHash blk
WrapHeaderHash
      (HeaderHash blk -> WrapHeaderHash blk)
-> (WrapHeaderHash (HardForkBlock '[blk]) -> HeaderHash blk)
-> WrapHeaderHash (HardForkBlock '[blk])
-> WrapHeaderHash blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy blk -> ShortByteString -> HeaderHash blk
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> ShortByteString -> HeaderHash blk
forall (proxy :: * -> *).
proxy blk -> ShortByteString -> HeaderHash blk
fromShortRawHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) (ShortByteString -> HeaderHash blk)
-> (WrapHeaderHash (HardForkBlock '[blk]) -> ShortByteString)
-> WrapHeaderHash (HardForkBlock '[blk])
-> HeaderHash blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraHash '[blk] -> ShortByteString
forall k (xs :: [k]). OneEraHash xs -> ShortByteString
getOneEraHash
      (OneEraHash '[blk] -> ShortByteString)
-> (WrapHeaderHash (HardForkBlock '[blk]) -> OneEraHash '[blk])
-> WrapHeaderHash (HardForkBlock '[blk])
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapHeaderHash (HardForkBlock '[blk])
-> HeaderHash (HardForkBlock '[blk])
WrapHeaderHash (HardForkBlock '[blk]) -> OneEraHash '[blk]
forall blk. WrapHeaderHash blk -> HeaderHash blk
unwrapHeaderHash

  inject :: forall blk. ConvertRawHash blk
      => WrapHeaderHash blk -> WrapHeaderHash (HardForkBlock '[blk])
  inject :: forall blk.
ConvertRawHash blk =>
WrapHeaderHash blk -> WrapHeaderHash (HardForkBlock '[blk])
inject =
        HeaderHash (HardForkBlock '[blk])
-> WrapHeaderHash (HardForkBlock '[blk])
OneEraHash '[blk] -> WrapHeaderHash (HardForkBlock '[blk])
forall blk. HeaderHash blk -> WrapHeaderHash blk
WrapHeaderHash
      (OneEraHash '[blk] -> WrapHeaderHash (HardForkBlock '[blk]))
-> (WrapHeaderHash blk -> OneEraHash '[blk])
-> WrapHeaderHash blk
-> WrapHeaderHash (HardForkBlock '[blk])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> OneEraHash '[blk]
forall k (xs :: [k]). ShortByteString -> OneEraHash xs
OneEraHash (ShortByteString -> OneEraHash '[blk])
-> (WrapHeaderHash blk -> ShortByteString)
-> WrapHeaderHash blk
-> OneEraHash '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> ShortByteString)
-> (WrapHeaderHash blk -> HeaderHash blk)
-> WrapHeaderHash blk
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapHeaderHash blk -> HeaderHash blk
forall blk. WrapHeaderHash blk -> HeaderHash blk
unwrapHeaderHash

instance Isomorphic ChainHash where
  project :: forall blk. NoHardForks blk
          => ChainHash (HardForkBlock '[blk]) -> ChainHash blk
  project :: forall blk.
NoHardForks blk =>
ChainHash (HardForkBlock '[blk]) -> ChainHash blk
project ChainHash (HardForkBlock '[blk])
GenesisHash   = ChainHash blk
forall {k} (b :: k). ChainHash b
GenesisHash
  project (BlockHash HeaderHash (HardForkBlock '[blk])
h) = HeaderHash blk -> ChainHash blk
forall {k} (b :: k). HeaderHash b -> ChainHash b
BlockHash (Proxy (WrapHeaderHash blk) -> OneEraHash '[blk] -> HeaderHash blk
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk,
 Coercible x (f (HardForkBlock '[blk])), Coercible y (f blk)) =>
proxy (f blk) -> x -> y
project' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapHeaderHash blk)) HeaderHash (HardForkBlock '[blk])
OneEraHash '[blk]
h)

  inject :: forall blk. NoHardForks blk
         => ChainHash blk -> ChainHash (HardForkBlock '[blk])
  inject :: forall blk.
NoHardForks blk =>
ChainHash blk -> ChainHash (HardForkBlock '[blk])
inject ChainHash blk
GenesisHash   = ChainHash (HardForkBlock '[blk])
forall {k} (b :: k). ChainHash b
GenesisHash
  inject (BlockHash HeaderHash blk
h) = HeaderHash (HardForkBlock '[blk])
-> ChainHash (HardForkBlock '[blk])
forall {k} (b :: k). HeaderHash b -> ChainHash b
BlockHash (Proxy (WrapHeaderHash blk) -> HeaderHash blk -> OneEraHash '[blk]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapHeaderHash blk)) HeaderHash blk
h)

{-------------------------------------------------------------------------------
  Config
-------------------------------------------------------------------------------}

-- | Projection/injection for 'TopLevelConfig'
--
-- NOTE: We do not define one for 'LedgerConfig' or 'ConsensusConfig', since
-- we need the 'EraParams' for their injections, which we can only derive if
-- we have the top-level config.
instance Isomorphic TopLevelConfig where
  project :: forall blk. NoHardForks blk
          => TopLevelConfig (HardForkBlock '[blk]) -> TopLevelConfig blk
  project :: forall blk.
NoHardForks blk =>
TopLevelConfig (HardForkBlock '[blk]) -> TopLevelConfig blk
project TopLevelConfig (HardForkBlock '[blk])
tlc =
      ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> CheckpointsMap blk
-> TopLevelConfig blk
forall blk.
ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> CheckpointsMap blk
-> TopLevelConfig blk
mkTopLevelConfig
        (ConsensusConfig (BlockProtocol (HardForkBlock '[blk]))
-> ConsensusConfig (BlockProtocol blk)
auxConsensus (ConsensusConfig (BlockProtocol (HardForkBlock '[blk]))
 -> ConsensusConfig (BlockProtocol blk))
-> ConsensusConfig (BlockProtocol (HardForkBlock '[blk]))
-> ConsensusConfig (BlockProtocol blk)
forall a b. (a -> b) -> a -> b
$ TopLevelConfig (HardForkBlock '[blk])
-> ConsensusConfig (BlockProtocol (HardForkBlock '[blk]))
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus TopLevelConfig (HardForkBlock '[blk])
tlc)
        (LedgerConfig (HardForkBlock '[blk]) -> LedgerConfig blk
auxLedger    (LedgerConfig (HardForkBlock '[blk]) -> LedgerConfig blk)
-> LedgerConfig (HardForkBlock '[blk]) -> LedgerConfig blk
forall a b. (a -> b) -> a -> b
$ TopLevelConfig (HardForkBlock '[blk])
-> LedgerConfig (HardForkBlock '[blk])
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger    TopLevelConfig (HardForkBlock '[blk])
tlc)
        (BlockConfig (HardForkBlock '[blk]) -> BlockConfig blk
forall blk.
NoHardForks blk =>
BlockConfig (HardForkBlock '[blk]) -> BlockConfig blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project      (BlockConfig (HardForkBlock '[blk]) -> BlockConfig blk)
-> BlockConfig (HardForkBlock '[blk]) -> BlockConfig blk
forall a b. (a -> b) -> a -> b
$ TopLevelConfig (HardForkBlock '[blk])
-> BlockConfig (HardForkBlock '[blk])
forall blk. TopLevelConfig blk -> BlockConfig blk
configBlock     TopLevelConfig (HardForkBlock '[blk])
tlc)
        (CodecConfig (HardForkBlock '[blk]) -> CodecConfig blk
forall blk.
NoHardForks blk =>
CodecConfig (HardForkBlock '[blk]) -> CodecConfig blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project      (CodecConfig (HardForkBlock '[blk]) -> CodecConfig blk)
-> CodecConfig (HardForkBlock '[blk]) -> CodecConfig blk
forall a b. (a -> b) -> a -> b
$ TopLevelConfig (HardForkBlock '[blk])
-> CodecConfig (HardForkBlock '[blk])
forall blk. TopLevelConfig blk -> CodecConfig blk
configCodec     TopLevelConfig (HardForkBlock '[blk])
tlc)
        (StorageConfig (HardForkBlock '[blk]) -> StorageConfig blk
forall blk.
NoHardForks blk =>
StorageConfig (HardForkBlock '[blk]) -> StorageConfig blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project      (StorageConfig (HardForkBlock '[blk]) -> StorageConfig blk)
-> StorageConfig (HardForkBlock '[blk]) -> StorageConfig blk
forall a b. (a -> b) -> a -> b
$ TopLevelConfig (HardForkBlock '[blk])
-> StorageConfig (HardForkBlock '[blk])
forall blk. TopLevelConfig blk -> StorageConfig blk
configStorage   TopLevelConfig (HardForkBlock '[blk])
tlc)
        CheckpointsMap blk
forall blk. CheckpointsMap blk
emptyCheckpointsMap
    where
      ei :: EpochInfo (Except PastHorizonException)
      ei :: EpochInfo (Except PastHorizonException)
ei = TopLevelConfig blk -> EpochInfo (Except PastHorizonException)
forall (m :: * -> *) blk.
(Monad m, NoHardForks blk) =>
TopLevelConfig blk -> EpochInfo m
noHardForksEpochInfo (TopLevelConfig blk -> EpochInfo (Except PastHorizonException))
-> TopLevelConfig blk -> EpochInfo (Except PastHorizonException)
forall a b. (a -> b) -> a -> b
$ TopLevelConfig (HardForkBlock '[blk]) -> TopLevelConfig blk
forall blk.
NoHardForks blk =>
TopLevelConfig (HardForkBlock '[blk]) -> TopLevelConfig blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project TopLevelConfig (HardForkBlock '[blk])
tlc

      auxLedger :: LedgerConfig (HardForkBlock '[blk]) -> LedgerConfig blk
      auxLedger :: LedgerConfig (HardForkBlock '[blk]) -> LedgerConfig blk
auxLedger =
            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)
-> (HardForkLedgerConfig '[blk] -> PartialLedgerConfig blk)
-> HardForkLedgerConfig '[blk]
-> LedgerConfig blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPartialLedgerConfig blk -> PartialLedgerConfig blk
forall blk. WrapPartialLedgerConfig blk -> PartialLedgerConfig blk
unwrapPartialLedgerConfig
          (WrapPartialLedgerConfig blk -> PartialLedgerConfig blk)
-> (HardForkLedgerConfig '[blk] -> WrapPartialLedgerConfig blk)
-> HardForkLedgerConfig '[blk]
-> PartialLedgerConfig blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP WrapPartialLedgerConfig '[blk] -> WrapPartialLedgerConfig blk
forall {k} (f :: k -> *) (x :: k) (xs :: [k]). NP f (x : xs) -> f x
hd
          (NP WrapPartialLedgerConfig '[blk] -> WrapPartialLedgerConfig blk)
-> (HardForkLedgerConfig '[blk]
    -> NP WrapPartialLedgerConfig '[blk])
-> HardForkLedgerConfig '[blk]
-> WrapPartialLedgerConfig blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerEraLedgerConfig '[blk] -> NP WrapPartialLedgerConfig '[blk]
forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
getPerEraLedgerConfig
          (PerEraLedgerConfig '[blk] -> NP WrapPartialLedgerConfig '[blk])
-> (HardForkLedgerConfig '[blk] -> PerEraLedgerConfig '[blk])
-> HardForkLedgerConfig '[blk]
-> NP WrapPartialLedgerConfig '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkLedgerConfig '[blk] -> PerEraLedgerConfig '[blk]
forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigPerEra

      auxConsensus :: ConsensusConfig (BlockProtocol (HardForkBlock '[blk]))
                   -> ConsensusConfig (BlockProtocol blk)
      auxConsensus :: ConsensusConfig (BlockProtocol (HardForkBlock '[blk]))
-> ConsensusConfig (BlockProtocol blk)
auxConsensus =
            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))
-> (ConsensusConfig (HardForkProtocol '[blk])
    -> PartialConsensusConfig (BlockProtocol blk))
-> ConsensusConfig (HardForkProtocol '[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
          (WrapPartialConsensusConfig blk
 -> PartialConsensusConfig (BlockProtocol blk))
-> (ConsensusConfig (HardForkProtocol '[blk])
    -> WrapPartialConsensusConfig blk)
-> ConsensusConfig (HardForkProtocol '[blk])
-> PartialConsensusConfig (BlockProtocol blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP WrapPartialConsensusConfig '[blk]
-> WrapPartialConsensusConfig blk
forall {k} (f :: k -> *) (x :: k) (xs :: [k]). NP f (x : xs) -> f x
hd
          (NP WrapPartialConsensusConfig '[blk]
 -> WrapPartialConsensusConfig blk)
-> (ConsensusConfig (HardForkProtocol '[blk])
    -> NP WrapPartialConsensusConfig '[blk])
-> ConsensusConfig (HardForkProtocol '[blk])
-> WrapPartialConsensusConfig blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerEraConsensusConfig '[blk]
-> NP WrapPartialConsensusConfig '[blk]
forall (xs :: [*]).
PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
getPerEraConsensusConfig
          (PerEraConsensusConfig '[blk]
 -> NP WrapPartialConsensusConfig '[blk])
-> (ConsensusConfig (HardForkProtocol '[blk])
    -> PerEraConsensusConfig '[blk])
-> ConsensusConfig (HardForkProtocol '[blk])
-> NP WrapPartialConsensusConfig '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (HardForkProtocol '[blk])
-> PerEraConsensusConfig '[blk]
forall (xs :: [*]).
ConsensusConfig (HardForkProtocol xs) -> PerEraConsensusConfig xs
hardForkConsensusConfigPerEra

  inject :: forall blk. NoHardForks blk
         => TopLevelConfig blk -> TopLevelConfig (HardForkBlock '[blk])
  inject :: forall blk.
NoHardForks blk =>
TopLevelConfig blk -> TopLevelConfig (HardForkBlock '[blk])
inject TopLevelConfig blk
tlc =
      ConsensusConfig (BlockProtocol (HardForkBlock '[blk]))
-> LedgerConfig (HardForkBlock '[blk])
-> BlockConfig (HardForkBlock '[blk])
-> CodecConfig (HardForkBlock '[blk])
-> StorageConfig (HardForkBlock '[blk])
-> CheckpointsMap (HardForkBlock '[blk])
-> TopLevelConfig (HardForkBlock '[blk])
forall blk.
ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> CheckpointsMap blk
-> TopLevelConfig blk
mkTopLevelConfig
        (ConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol (HardForkBlock '[blk]))
auxConsensus (ConsensusConfig (BlockProtocol blk)
 -> ConsensusConfig (BlockProtocol (HardForkBlock '[blk])))
-> ConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol (HardForkBlock '[blk]))
forall a b. (a -> b) -> a -> b
$ TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus TopLevelConfig blk
tlc)
        (LedgerConfig blk -> LedgerConfig (HardForkBlock '[blk])
auxLedger    (LedgerConfig blk -> LedgerConfig (HardForkBlock '[blk]))
-> LedgerConfig blk -> LedgerConfig (HardForkBlock '[blk])
forall a b. (a -> b) -> a -> b
$ TopLevelConfig blk -> LedgerConfig blk
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger    TopLevelConfig blk
tlc)
        (BlockConfig blk -> BlockConfig (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
BlockConfig blk -> BlockConfig (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject       (BlockConfig blk -> BlockConfig (HardForkBlock '[blk]))
-> BlockConfig blk -> BlockConfig (HardForkBlock '[blk])
forall a b. (a -> b) -> a -> b
$ TopLevelConfig blk -> BlockConfig blk
forall blk. TopLevelConfig blk -> BlockConfig blk
configBlock     TopLevelConfig blk
tlc)
        (CodecConfig blk -> CodecConfig (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
CodecConfig blk -> CodecConfig (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject       (CodecConfig blk -> CodecConfig (HardForkBlock '[blk]))
-> CodecConfig blk -> CodecConfig (HardForkBlock '[blk])
forall a b. (a -> b) -> a -> b
$ TopLevelConfig blk -> CodecConfig blk
forall blk. TopLevelConfig blk -> CodecConfig blk
configCodec     TopLevelConfig blk
tlc)
        (StorageConfig blk -> StorageConfig (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
StorageConfig blk -> StorageConfig (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject       (StorageConfig blk -> StorageConfig (HardForkBlock '[blk]))
-> StorageConfig blk -> StorageConfig (HardForkBlock '[blk])
forall a b. (a -> b) -> a -> b
$ TopLevelConfig blk -> StorageConfig blk
forall blk. TopLevelConfig blk -> StorageConfig blk
configStorage   TopLevelConfig blk
tlc)
        CheckpointsMap (HardForkBlock '[blk])
forall blk. CheckpointsMap blk
emptyCheckpointsMap
    where
      eraParams :: EraParams
eraParams = TopLevelConfig blk -> EraParams
forall blk. NoHardForks blk => TopLevelConfig blk -> EraParams
getEraParams TopLevelConfig blk
tlc

      auxLedger :: LedgerConfig blk -> LedgerConfig (HardForkBlock '[blk])
      auxLedger :: LedgerConfig blk -> LedgerConfig (HardForkBlock '[blk])
auxLedger LedgerConfig blk
cfg = HardForkLedgerConfig {
            hardForkLedgerConfigShape :: Shape '[blk]
hardForkLedgerConfigShape  = EraParams -> Shape '[blk]
forall x. EraParams -> Shape '[x]
History.singletonShape EraParams
eraParams
          , hardForkLedgerConfigPerEra :: PerEraLedgerConfig '[blk]
hardForkLedgerConfigPerEra = NP WrapPartialLedgerConfig '[blk] -> PerEraLedgerConfig '[blk]
forall (xs :: [*]).
NP WrapPartialLedgerConfig xs -> PerEraLedgerConfig xs
PerEraLedgerConfig (NP WrapPartialLedgerConfig '[blk] -> PerEraLedgerConfig '[blk])
-> NP WrapPartialLedgerConfig '[blk] -> PerEraLedgerConfig '[blk]
forall a b. (a -> b) -> a -> b
$
                 PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
forall blk. PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
WrapPartialLedgerConfig (Proxy blk -> LedgerConfig blk -> PartialLedgerConfig blk
forall blk (proxy :: * -> *).
NoHardForks blk =>
proxy blk -> LedgerConfig blk -> PartialLedgerConfig blk
forall (proxy :: * -> *).
proxy blk -> LedgerConfig blk -> PartialLedgerConfig blk
toPartialLedgerConfig (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) LedgerConfig blk
cfg )
              WrapPartialLedgerConfig blk
-> NP WrapPartialLedgerConfig '[]
-> NP WrapPartialLedgerConfig '[blk]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP WrapPartialLedgerConfig '[]
forall {k} (f :: k -> *). NP f '[]
Nil
          }

      auxConsensus :: ConsensusConfig (BlockProtocol blk)
                   -> ConsensusConfig (BlockProtocol (HardForkBlock '[blk]))
      auxConsensus :: ConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol (HardForkBlock '[blk]))
auxConsensus ConsensusConfig (BlockProtocol blk)
cfg = HardForkConsensusConfig {
            hardForkConsensusConfigK :: SecurityParam
hardForkConsensusConfigK      = ConsensusConfig (BlockProtocol blk) -> SecurityParam
forall p. ConsensusProtocol p => ConsensusConfig p -> SecurityParam
protocolSecurityParam ConsensusConfig (BlockProtocol blk)
cfg
          , hardForkConsensusConfigShape :: Shape '[blk]
hardForkConsensusConfigShape  = EraParams -> Shape '[blk]
forall x. EraParams -> Shape '[x]
History.singletonShape EraParams
eraParams
          , hardForkConsensusConfigPerEra :: PerEraConsensusConfig '[blk]
hardForkConsensusConfigPerEra = NP WrapPartialConsensusConfig '[blk]
-> PerEraConsensusConfig '[blk]
forall (xs :: [*]).
NP WrapPartialConsensusConfig xs -> PerEraConsensusConfig xs
PerEraConsensusConfig (NP WrapPartialConsensusConfig '[blk]
 -> PerEraConsensusConfig '[blk])
-> NP WrapPartialConsensusConfig '[blk]
-> PerEraConsensusConfig '[blk]
forall a b. (a -> b) -> a -> b
$
                 PartialConsensusConfig (BlockProtocol blk)
-> WrapPartialConsensusConfig blk
forall blk.
PartialConsensusConfig (BlockProtocol blk)
-> WrapPartialConsensusConfig blk
WrapPartialConsensusConfig (Proxy (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol blk)
-> PartialConsensusConfig (BlockProtocol blk)
forall p (proxy :: * -> *).
HasPartialConsensusConfig p =>
proxy p -> ConsensusConfig p -> PartialConsensusConfig p
forall (proxy :: * -> *).
proxy (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol blk)
-> PartialConsensusConfig (BlockProtocol blk)
toPartialConsensusConfig (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(BlockProtocol blk)) ConsensusConfig (BlockProtocol blk)
cfg)
              WrapPartialConsensusConfig blk
-> NP WrapPartialConsensusConfig '[]
-> NP WrapPartialConsensusConfig '[blk]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP WrapPartialConsensusConfig '[]
forall {k} (f :: k -> *). NP f '[]
Nil
          }

{-------------------------------------------------------------------------------
  Various kinds of records
-------------------------------------------------------------------------------}

instance Isomorphic HeaderState where
  project :: forall blk. NoHardForks blk
          => HeaderState (HardForkBlock '[blk]) -> HeaderState blk
  project :: forall blk.
NoHardForks blk =>
HeaderState (HardForkBlock '[blk]) -> HeaderState blk
project HeaderState{WithOrigin (AnnTip (HardForkBlock '[blk]))
ChainDepState (BlockProtocol (HardForkBlock '[blk]))
headerStateTip :: WithOrigin (AnnTip (HardForkBlock '[blk]))
headerStateChainDep :: ChainDepState (BlockProtocol (HardForkBlock '[blk]))
headerStateTip :: forall blk. HeaderState blk -> WithOrigin (AnnTip blk)
headerStateChainDep :: forall blk. HeaderState blk -> ChainDepState (BlockProtocol blk)
..} = HeaderState {
        headerStateTip :: WithOrigin (AnnTip blk)
headerStateTip      = AnnTip (HardForkBlock '[blk]) -> AnnTip blk
forall blk.
NoHardForks blk =>
AnnTip (HardForkBlock '[blk]) -> AnnTip blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project (AnnTip (HardForkBlock '[blk]) -> AnnTip blk)
-> WithOrigin (AnnTip (HardForkBlock '[blk]))
-> WithOrigin (AnnTip blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithOrigin (AnnTip (HardForkBlock '[blk]))
headerStateTip
      , headerStateChainDep :: ChainDepState (BlockProtocol blk)
headerStateChainDep = Proxy (WrapChainDepState blk)
-> HardForkChainDepState '[blk]
-> ChainDepState (BlockProtocol blk)
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk,
 Coercible x (f (HardForkBlock '[blk])), Coercible y (f blk)) =>
proxy (f blk) -> x -> y
project' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapChainDepState blk)) ChainDepState (BlockProtocol (HardForkBlock '[blk]))
HardForkChainDepState '[blk]
headerStateChainDep
      }

  inject :: forall blk. NoHardForks blk
         => HeaderState blk -> HeaderState (HardForkBlock '[blk])
  inject :: forall blk.
NoHardForks blk =>
HeaderState blk -> HeaderState (HardForkBlock '[blk])
inject HeaderState{WithOrigin (AnnTip blk)
ChainDepState (BlockProtocol blk)
headerStateTip :: forall blk. HeaderState blk -> WithOrigin (AnnTip blk)
headerStateChainDep :: forall blk. HeaderState blk -> ChainDepState (BlockProtocol blk)
headerStateTip :: WithOrigin (AnnTip blk)
headerStateChainDep :: ChainDepState (BlockProtocol blk)
..} = HeaderState {
        headerStateTip :: WithOrigin (AnnTip (HardForkBlock '[blk]))
headerStateTip      = AnnTip blk -> AnnTip (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
AnnTip blk -> AnnTip (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject (AnnTip blk -> AnnTip (HardForkBlock '[blk]))
-> WithOrigin (AnnTip blk)
-> WithOrigin (AnnTip (HardForkBlock '[blk]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithOrigin (AnnTip blk)
headerStateTip
      , headerStateChainDep :: ChainDepState (BlockProtocol (HardForkBlock '[blk]))
headerStateChainDep = Proxy (WrapChainDepState blk)
-> ChainDepState (BlockProtocol blk)
-> HardForkChainDepState '[blk]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapChainDepState blk)) ChainDepState (BlockProtocol blk)
headerStateChainDep
      }

instance Isomorphic (Ticked :.: LedgerState) where
  project :: forall blk.
NoHardForks blk =>
(:.:) Ticked LedgerState (HardForkBlock '[blk])
-> (:.:) Ticked LedgerState blk
project =
        Current (Ticked :.: LedgerState) blk
-> (:.:) Ticked LedgerState blk
forall (f :: * -> *) blk. Current f blk -> f blk
State.currentState
      (Current (Ticked :.: LedgerState) blk
 -> (:.:) Ticked LedgerState blk)
-> ((:.:) Ticked LedgerState (HardForkBlock '[blk])
    -> Current (Ticked :.: LedgerState) blk)
-> (:.:) Ticked LedgerState (HardForkBlock '[blk])
-> (:.:) Ticked LedgerState blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Telescope (K Past) (Current (Ticked :.: LedgerState)) '[blk]
-> Current (Ticked :.: LedgerState) blk
forall {k} (g :: k -> *) (f :: k -> *) (x :: k).
Telescope g f '[x] -> f x
Telescope.fromTZ
      (Telescope (K Past) (Current (Ticked :.: LedgerState)) '[blk]
 -> Current (Ticked :.: LedgerState) blk)
-> ((:.:) Ticked LedgerState (HardForkBlock '[blk])
    -> Telescope (K Past) (Current (Ticked :.: LedgerState)) '[blk])
-> (:.:) Ticked LedgerState (HardForkBlock '[blk])
-> Current (Ticked :.: LedgerState) blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkState (Ticked :.: LedgerState) '[blk]
-> Telescope (K Past) (Current (Ticked :.: LedgerState)) '[blk]
forall (f :: * -> *) (xs :: [*]).
HardForkState f xs -> Telescope (K Past) (Current f) xs
getHardForkState
      (HardForkState (Ticked :.: LedgerState) '[blk]
 -> Telescope (K Past) (Current (Ticked :.: LedgerState)) '[blk])
-> ((:.:) Ticked LedgerState (HardForkBlock '[blk])
    -> HardForkState (Ticked :.: LedgerState) '[blk])
-> (:.:) Ticked LedgerState (HardForkBlock '[blk])
-> Telescope (K Past) (Current (Ticked :.: LedgerState)) '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState (HardForkBlock '[blk]))
-> HardForkState (Ticked :.: LedgerState) '[blk]
forall (xs :: [*]).
Ticked (LedgerState (HardForkBlock xs))
-> HardForkState (Ticked :.: LedgerState) xs
tickedHardForkLedgerStatePerEra
      (Ticked (LedgerState (HardForkBlock '[blk]))
 -> HardForkState (Ticked :.: LedgerState) '[blk])
-> ((:.:) Ticked LedgerState (HardForkBlock '[blk])
    -> Ticked (LedgerState (HardForkBlock '[blk])))
-> (:.:) Ticked LedgerState (HardForkBlock '[blk])
-> HardForkState (Ticked :.: LedgerState) '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:.:) Ticked LedgerState (HardForkBlock '[blk])
-> Ticked (LedgerState (HardForkBlock '[blk]))
forall {l} {k} (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp

  inject :: forall blk.
NoHardForks blk =>
(:.:) Ticked LedgerState blk
-> (:.:) Ticked LedgerState (HardForkBlock '[blk])
inject =
        Ticked (LedgerState (HardForkBlock '[blk]))
-> (:.:) Ticked LedgerState (HardForkBlock '[blk])
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp
      (Ticked (LedgerState (HardForkBlock '[blk]))
 -> (:.:) Ticked LedgerState (HardForkBlock '[blk]))
-> ((:.:) Ticked LedgerState blk
    -> Ticked (LedgerState (HardForkBlock '[blk])))
-> (:.:) Ticked LedgerState blk
-> (:.:) Ticked LedgerState (HardForkBlock '[blk])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransitionInfo
-> HardForkState (Ticked :.: LedgerState) '[blk]
-> Ticked (LedgerState (HardForkBlock '[blk]))
forall (xs :: [*]).
TransitionInfo
-> HardForkState (Ticked :.: LedgerState) xs
-> Ticked (LedgerState (HardForkBlock xs))
TickedHardForkLedgerState TransitionInfo
TransitionImpossible
      (HardForkState (Ticked :.: LedgerState) '[blk]
 -> Ticked (LedgerState (HardForkBlock '[blk])))
-> ((:.:) Ticked LedgerState blk
    -> HardForkState (Ticked :.: LedgerState) '[blk])
-> (:.:) Ticked LedgerState blk
-> Ticked (LedgerState (HardForkBlock '[blk]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Telescope (K Past) (Current (Ticked :.: LedgerState)) '[blk]
-> HardForkState (Ticked :.: LedgerState) '[blk]
forall (f :: * -> *) (xs :: [*]).
Telescope (K Past) (Current f) xs -> HardForkState f xs
HardForkState
      (Telescope (K Past) (Current (Ticked :.: LedgerState)) '[blk]
 -> HardForkState (Ticked :.: LedgerState) '[blk])
-> ((:.:) Ticked LedgerState blk
    -> Telescope (K Past) (Current (Ticked :.: LedgerState)) '[blk])
-> (:.:) Ticked LedgerState blk
-> HardForkState (Ticked :.: LedgerState) '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current (Ticked :.: LedgerState) blk
-> Telescope (K Past) (Current (Ticked :.: LedgerState)) '[blk]
forall {k} (f :: k -> *) (x :: k) (g :: k -> *) (xs1 :: [k]).
f x -> Telescope g f (x : xs1)
Telescope.TZ
      (Current (Ticked :.: LedgerState) blk
 -> Telescope (K Past) (Current (Ticked :.: LedgerState)) '[blk])
-> ((:.:) Ticked LedgerState blk
    -> Current (Ticked :.: LedgerState) blk)
-> (:.:) Ticked LedgerState blk
-> Telescope (K Past) (Current (Ticked :.: LedgerState)) '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound
-> (:.:) Ticked LedgerState blk
-> Current (Ticked :.: LedgerState) blk
forall (f :: * -> *) blk. Bound -> f blk -> Current f blk
State.Current Bound
History.initBound

instance Isomorphic ExtLedgerState where
  project :: forall blk.
NoHardForks blk =>
ExtLedgerState (HardForkBlock '[blk]) -> ExtLedgerState blk
project ExtLedgerState{LedgerState (HardForkBlock '[blk])
HeaderState (HardForkBlock '[blk])
ledgerState :: LedgerState (HardForkBlock '[blk])
headerState :: HeaderState (HardForkBlock '[blk])
ledgerState :: forall blk. ExtLedgerState blk -> LedgerState blk
headerState :: forall blk. ExtLedgerState blk -> HeaderState blk
..} = ExtLedgerState {
        ledgerState :: LedgerState blk
ledgerState = LedgerState (HardForkBlock '[blk]) -> LedgerState blk
forall blk.
NoHardForks blk =>
LedgerState (HardForkBlock '[blk]) -> LedgerState blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project LedgerState (HardForkBlock '[blk])
ledgerState
      , headerState :: HeaderState blk
headerState = HeaderState (HardForkBlock '[blk]) -> HeaderState blk
forall blk.
NoHardForks blk =>
HeaderState (HardForkBlock '[blk]) -> HeaderState blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project HeaderState (HardForkBlock '[blk])
headerState
      }

  inject :: forall blk.
NoHardForks blk =>
ExtLedgerState blk -> ExtLedgerState (HardForkBlock '[blk])
inject ExtLedgerState{LedgerState blk
HeaderState blk
ledgerState :: forall blk. ExtLedgerState blk -> LedgerState blk
headerState :: forall blk. ExtLedgerState blk -> HeaderState blk
ledgerState :: LedgerState blk
headerState :: HeaderState blk
..} = ExtLedgerState {
        ledgerState :: LedgerState (HardForkBlock '[blk])
ledgerState = LedgerState blk -> LedgerState (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
LedgerState blk -> LedgerState (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject LedgerState blk
ledgerState
      , headerState :: HeaderState (HardForkBlock '[blk])
headerState = HeaderState blk -> HeaderState (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
HeaderState blk -> HeaderState (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject HeaderState blk
headerState
      }

instance Isomorphic AnnTip where
  project :: forall blk. NoHardForks blk => AnnTip (HardForkBlock '[blk]) -> AnnTip blk
  project :: forall blk.
NoHardForks blk =>
AnnTip (HardForkBlock '[blk]) -> AnnTip blk
project (AnnTip SlotNo
s BlockNo
b TipInfo (HardForkBlock '[blk])
nfo) = SlotNo -> BlockNo -> TipInfo blk -> AnnTip blk
forall blk. SlotNo -> BlockNo -> TipInfo blk -> AnnTip blk
AnnTip SlotNo
s BlockNo
b (Proxy (WrapTipInfo blk) -> OneEraTipInfo '[blk] -> TipInfo blk
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk,
 Coercible x (f (HardForkBlock '[blk])), Coercible y (f blk)) =>
proxy (f blk) -> x -> y
project' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapTipInfo blk)) TipInfo (HardForkBlock '[blk])
OneEraTipInfo '[blk]
nfo)

  inject :: forall blk.
NoHardForks blk =>
AnnTip blk -> AnnTip (HardForkBlock '[blk])
inject (AnnTip SlotNo
s BlockNo
b TipInfo blk
nfo) = SlotNo
-> BlockNo
-> TipInfo (HardForkBlock '[blk])
-> AnnTip (HardForkBlock '[blk])
forall blk. SlotNo -> BlockNo -> TipInfo blk -> AnnTip blk
AnnTip SlotNo
s BlockNo
b (NS WrapTipInfo '[blk] -> OneEraTipInfo '[blk]
forall (xs :: [*]). NS WrapTipInfo xs -> OneEraTipInfo xs
OneEraTipInfo (WrapTipInfo blk -> NS WrapTipInfo '[blk]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (TipInfo blk -> WrapTipInfo blk
forall blk. TipInfo blk -> WrapTipInfo blk
WrapTipInfo TipInfo blk
nfo)))

instance Functor m => Isomorphic (InitChainDB m) where
  project :: forall blk. NoHardForks blk
          => InitChainDB m (HardForkBlock '[blk]) -> InitChainDB m blk
  project :: forall blk.
NoHardForks blk =>
InitChainDB m (HardForkBlock '[blk]) -> InitChainDB m blk
project = (blk -> HardForkBlock '[blk])
-> (LedgerState (HardForkBlock '[blk]) -> LedgerState blk)
-> InitChainDB m (HardForkBlock '[blk])
-> InitChainDB m blk
forall (m :: * -> *) blk' blk.
Functor m =>
(blk' -> blk)
-> (LedgerState blk -> LedgerState blk')
-> InitChainDB m blk
-> InitChainDB m blk'
InitChainDB.map (Proxy (I blk) -> blk -> HardForkBlock '[blk]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(I blk))) LedgerState (HardForkBlock '[blk]) -> LedgerState blk
forall blk.
NoHardForks blk =>
LedgerState (HardForkBlock '[blk]) -> LedgerState blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project

  inject :: forall blk. NoHardForks blk
         => InitChainDB m blk -> InitChainDB m (HardForkBlock '[blk])
  inject :: forall blk.
NoHardForks blk =>
InitChainDB m blk -> InitChainDB m (HardForkBlock '[blk])
inject = (HardForkBlock '[blk] -> blk)
-> (LedgerState blk -> LedgerState (HardForkBlock '[blk]))
-> InitChainDB m blk
-> InitChainDB m (HardForkBlock '[blk])
forall (m :: * -> *) blk' blk.
Functor m =>
(blk' -> blk)
-> (LedgerState blk -> LedgerState blk')
-> InitChainDB m blk
-> InitChainDB m blk'
InitChainDB.map (Proxy (I blk) -> HardForkBlock '[blk] -> blk
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk,
 Coercible x (f (HardForkBlock '[blk])), Coercible y (f blk)) =>
proxy (f blk) -> x -> y
project' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(I blk))) LedgerState blk -> LedgerState (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
LedgerState blk -> LedgerState (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject

instance Isomorphic ProtocolClientInfo where
  project :: forall blk.
NoHardForks blk =>
ProtocolClientInfo (HardForkBlock '[blk]) -> ProtocolClientInfo blk
project ProtocolClientInfo{CodecConfig (HardForkBlock '[blk])
pClientInfoCodecConfig :: CodecConfig (HardForkBlock '[blk])
pClientInfoCodecConfig :: forall b. ProtocolClientInfo b -> CodecConfig b
..} = ProtocolClientInfo {
        pClientInfoCodecConfig :: CodecConfig blk
pClientInfoCodecConfig = CodecConfig (HardForkBlock '[blk]) -> CodecConfig blk
forall blk.
NoHardForks blk =>
CodecConfig (HardForkBlock '[blk]) -> CodecConfig blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project CodecConfig (HardForkBlock '[blk])
pClientInfoCodecConfig
      }

  inject :: forall blk.
NoHardForks blk =>
ProtocolClientInfo blk -> ProtocolClientInfo (HardForkBlock '[blk])
inject ProtocolClientInfo{CodecConfig blk
pClientInfoCodecConfig :: forall b. ProtocolClientInfo b -> CodecConfig b
pClientInfoCodecConfig :: CodecConfig blk
..} = ProtocolClientInfo {
        pClientInfoCodecConfig :: CodecConfig (HardForkBlock '[blk])
pClientInfoCodecConfig = CodecConfig blk -> CodecConfig (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
CodecConfig blk -> CodecConfig (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject CodecConfig blk
pClientInfoCodecConfig
      }

instance Isomorphic ForgeStateUpdateInfo where
  project :: forall blk. NoHardForks blk
          => ForgeStateUpdateInfo (HardForkBlock '[blk]) -> ForgeStateUpdateInfo blk
  project :: forall blk.
NoHardForks blk =>
ForgeStateUpdateInfo (HardForkBlock '[blk])
-> ForgeStateUpdateInfo blk
project ForgeStateUpdateInfo (HardForkBlock '[blk])
forgeStateUpdateInfo =
      case ForgeStateUpdateInfo (HardForkBlock '[blk])
forgeStateUpdateInfo of
        ForgeStateUpdated ForgeStateInfo (HardForkBlock '[blk])
forgeStateInfo ->
          ForgeStateInfo blk -> ForgeStateUpdateInfo blk
forall blk. ForgeStateInfo blk -> ForgeStateUpdateInfo blk
ForgeStateUpdated
            (Proxy (WrapForgeStateInfo blk)
-> HardForkForgeStateInfo '[blk] -> ForgeStateInfo blk
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk,
 Coercible x (f (HardForkBlock '[blk])), Coercible y (f blk)) =>
proxy (f blk) -> x -> y
project' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapForgeStateInfo blk)) ForgeStateInfo (HardForkBlock '[blk])
HardForkForgeStateInfo '[blk]
forgeStateInfo)
        ForgeStateUpdateFailed ForgeStateUpdateError (HardForkBlock '[blk])
forgeStateUpdateError ->
          ForgeStateUpdateError blk -> ForgeStateUpdateInfo blk
forall blk. ForgeStateUpdateError blk -> ForgeStateUpdateInfo blk
ForgeStateUpdateFailed
            (Proxy (WrapForgeStateUpdateError blk)
-> HardForkForgeStateUpdateError '[blk]
-> ForgeStateUpdateError blk
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk,
 Coercible x (f (HardForkBlock '[blk])), Coercible y (f blk)) =>
proxy (f blk) -> x -> y
project' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapForgeStateUpdateError blk)) ForgeStateUpdateError (HardForkBlock '[blk])
HardForkForgeStateUpdateError '[blk]
forgeStateUpdateError)
        ForgeStateUpdateInfo (HardForkBlock '[blk])
ForgeStateUpdateSuppressed -> ForgeStateUpdateInfo blk
forall blk. ForgeStateUpdateInfo blk
ForgeStateUpdateSuppressed

  inject :: forall blk. NoHardForks blk
         => ForgeStateUpdateInfo blk -> ForgeStateUpdateInfo (HardForkBlock '[blk])
  inject :: forall blk.
NoHardForks blk =>
ForgeStateUpdateInfo blk
-> ForgeStateUpdateInfo (HardForkBlock '[blk])
inject ForgeStateUpdateInfo blk
forgeStateUpdateInfo =
      case ForgeStateUpdateInfo blk
forgeStateUpdateInfo of
        ForgeStateUpdated ForgeStateInfo blk
forgeStateInfo ->
          ForgeStateInfo (HardForkBlock '[blk])
-> ForgeStateUpdateInfo (HardForkBlock '[blk])
forall blk. ForgeStateInfo blk -> ForgeStateUpdateInfo blk
ForgeStateUpdated
            (Proxy (WrapForgeStateInfo blk)
-> ForgeStateInfo blk -> HardForkForgeStateInfo '[blk]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapForgeStateInfo blk)) ForgeStateInfo blk
forgeStateInfo)
        ForgeStateUpdateFailed ForgeStateUpdateError blk
forgeStateUpdateError ->
          ForgeStateUpdateError (HardForkBlock '[blk])
-> ForgeStateUpdateInfo (HardForkBlock '[blk])
forall blk. ForgeStateUpdateError blk -> ForgeStateUpdateInfo blk
ForgeStateUpdateFailed
            (Proxy (WrapForgeStateUpdateError blk)
-> ForgeStateUpdateError blk
-> HardForkForgeStateUpdateError '[blk]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapForgeStateUpdateError blk)) ForgeStateUpdateError blk
forgeStateUpdateError)
        ForgeStateUpdateInfo blk
ForgeStateUpdateSuppressed -> ForgeStateUpdateInfo (HardForkBlock '[blk])
forall blk. ForgeStateUpdateInfo blk
ForgeStateUpdateSuppressed

instance Functor m => Isomorphic (BlockForging m) where
  project :: forall blk. NoHardForks blk
          => BlockForging m (HardForkBlock '[blk]) -> BlockForging m blk
  project :: forall blk.
NoHardForks blk =>
BlockForging m (HardForkBlock '[blk]) -> BlockForging m blk
project BlockForging {Text
CanBeLeader (BlockProtocol (HardForkBlock '[blk]))
TopLevelConfig (HardForkBlock '[blk])
-> BlockNo
-> SlotNo
-> TickedLedgerState (HardForkBlock '[blk])
-> [Validated (GenTx (HardForkBlock '[blk]))]
-> IsLeader (BlockProtocol (HardForkBlock '[blk]))
-> m (HardForkBlock '[blk])
TopLevelConfig (HardForkBlock '[blk])
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol (HardForkBlock '[blk])))
-> m (ForgeStateUpdateInfo (HardForkBlock '[blk]))
TopLevelConfig (HardForkBlock '[blk])
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol (HardForkBlock '[blk])))
-> IsLeader (BlockProtocol (HardForkBlock '[blk]))
-> ForgeStateInfo (HardForkBlock '[blk])
-> Either (CannotForge (HardForkBlock '[blk])) ()
forgeLabel :: Text
canBeLeader :: CanBeLeader (BlockProtocol (HardForkBlock '[blk]))
updateForgeState :: TopLevelConfig (HardForkBlock '[blk])
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol (HardForkBlock '[blk])))
-> m (ForgeStateUpdateInfo (HardForkBlock '[blk]))
checkCanForge :: TopLevelConfig (HardForkBlock '[blk])
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol (HardForkBlock '[blk])))
-> IsLeader (BlockProtocol (HardForkBlock '[blk]))
-> ForgeStateInfo (HardForkBlock '[blk])
-> Either (CannotForge (HardForkBlock '[blk])) ()
forgeBlock :: TopLevelConfig (HardForkBlock '[blk])
-> BlockNo
-> SlotNo
-> TickedLedgerState (HardForkBlock '[blk])
-> [Validated (GenTx (HardForkBlock '[blk]))]
-> IsLeader (BlockProtocol (HardForkBlock '[blk]))
-> m (HardForkBlock '[blk])
forgeLabel :: forall (m :: * -> *) blk. BlockForging m blk -> Text
canBeLeader :: forall (m :: * -> *) blk.
BlockForging m blk -> CanBeLeader (BlockProtocol blk)
updateForgeState :: forall (m :: * -> *) blk.
BlockForging m blk
-> TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> m (ForgeStateUpdateInfo blk)
checkCanForge :: forall (m :: * -> *) blk.
BlockForging m blk
-> TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> IsLeader (BlockProtocol blk)
-> ForgeStateInfo blk
-> Either (CannotForge blk) ()
forgeBlock :: forall (m :: * -> *) blk.
BlockForging m blk
-> TopLevelConfig blk
-> BlockNo
-> SlotNo
-> TickedLedgerState blk
-> [Validated (GenTx blk)]
-> IsLeader (BlockProtocol blk)
-> m blk
..} = BlockForging {
        forgeLabel :: Text
forgeLabel       = Text
forgeLabel
      , canBeLeader :: CanBeLeader (BlockProtocol blk)
canBeLeader      = Proxy (WrapCanBeLeader blk)
-> HardForkCanBeLeader '[blk] -> CanBeLeader (BlockProtocol blk)
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk,
 Coercible x (f (HardForkBlock '[blk])), Coercible y (f blk)) =>
proxy (f blk) -> x -> y
project' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapCanBeLeader blk)) CanBeLeader (BlockProtocol (HardForkBlock '[blk]))
HardForkCanBeLeader '[blk]
canBeLeader
      , updateForgeState :: TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> m (ForgeStateUpdateInfo blk)
updateForgeState = \TopLevelConfig blk
cfg SlotNo
sno Ticked (ChainDepState (BlockProtocol blk))
tickedChainDepSt ->
                               ForgeStateUpdateInfo (HardForkBlock '[blk])
-> ForgeStateUpdateInfo blk
forall blk.
NoHardForks blk =>
ForgeStateUpdateInfo (HardForkBlock '[blk])
-> ForgeStateUpdateInfo blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project (ForgeStateUpdateInfo (HardForkBlock '[blk])
 -> ForgeStateUpdateInfo blk)
-> m (ForgeStateUpdateInfo (HardForkBlock '[blk]))
-> m (ForgeStateUpdateInfo blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                 TopLevelConfig (HardForkBlock '[blk])
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol (HardForkBlock '[blk])))
-> m (ForgeStateUpdateInfo (HardForkBlock '[blk]))
updateForgeState
                                   (TopLevelConfig blk -> TopLevelConfig (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
TopLevelConfig blk -> TopLevelConfig (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject TopLevelConfig blk
cfg)
                                   SlotNo
sno
                                   (EpochInfo (Except PastHorizonException)
-> Ticked (ChainDepState (BlockProtocol blk))
-> Ticked (ChainDepState (HardForkProtocol '[blk]))
injTickedChainDepSt
                                     (TopLevelConfig blk -> EpochInfo (Except PastHorizonException)
forall (m :: * -> *) blk.
(Monad m, NoHardForks blk) =>
TopLevelConfig blk -> EpochInfo m
noHardForksEpochInfo TopLevelConfig blk
cfg)
                                     Ticked (ChainDepState (BlockProtocol blk))
tickedChainDepSt)
      , checkCanForge :: TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> IsLeader (BlockProtocol blk)
-> ForgeStateInfo blk
-> Either (CannotForge blk) ()
checkCanForge    = \TopLevelConfig blk
cfg SlotNo
sno Ticked (ChainDepState (BlockProtocol blk))
tickedChainDepSt IsLeader (BlockProtocol blk)
isLeader ForgeStateInfo blk
forgeStateInfo ->
                               (CannotForge (HardForkBlock '[blk]) -> CannotForge blk)
-> Either (CannotForge (HardForkBlock '[blk])) ()
-> Either (CannotForge blk) ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Proxy (WrapCannotForge blk)
-> HardForkCannotForge '[blk] -> CannotForge blk
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk,
 Coercible x (f (HardForkBlock '[blk])), Coercible y (f blk)) =>
proxy (f blk) -> x -> y
project' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapCannotForge blk))) (Either (CannotForge (HardForkBlock '[blk])) ()
 -> Either (CannotForge blk) ())
-> Either (CannotForge (HardForkBlock '[blk])) ()
-> Either (CannotForge blk) ()
forall a b. (a -> b) -> a -> b
$
                                 TopLevelConfig (HardForkBlock '[blk])
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol (HardForkBlock '[blk])))
-> IsLeader (BlockProtocol (HardForkBlock '[blk]))
-> ForgeStateInfo (HardForkBlock '[blk])
-> Either (CannotForge (HardForkBlock '[blk])) ()
checkCanForge
                                   (TopLevelConfig blk -> TopLevelConfig (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
TopLevelConfig blk -> TopLevelConfig (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject TopLevelConfig blk
cfg)
                                   SlotNo
sno
                                   (EpochInfo (Except PastHorizonException)
-> Ticked (ChainDepState (BlockProtocol blk))
-> Ticked (ChainDepState (HardForkProtocol '[blk]))
injTickedChainDepSt
                                     (TopLevelConfig blk -> EpochInfo (Except PastHorizonException)
forall (m :: * -> *) blk.
(Monad m, NoHardForks blk) =>
TopLevelConfig blk -> EpochInfo m
noHardForksEpochInfo TopLevelConfig blk
cfg)
                                     Ticked (ChainDepState (BlockProtocol blk))
tickedChainDepSt)
                                   (Proxy (WrapIsLeader blk)
-> IsLeader (BlockProtocol blk) -> HardForkIsLeader '[blk]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapIsLeader blk)) IsLeader (BlockProtocol blk)
isLeader)
                                   (Proxy (WrapForgeStateInfo blk)
-> ForgeStateInfo blk -> HardForkForgeStateInfo '[blk]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapForgeStateInfo blk)) ForgeStateInfo blk
forgeStateInfo)

      , forgeBlock :: TopLevelConfig blk
-> BlockNo
-> SlotNo
-> TickedLedgerState blk
-> [Validated (GenTx blk)]
-> IsLeader (BlockProtocol blk)
-> m blk
forgeBlock       = \TopLevelConfig blk
cfg BlockNo
bno SlotNo
sno TickedLedgerState blk
tickedLgrSt [Validated (GenTx blk)]
txs IsLeader (BlockProtocol blk)
isLeader ->
                               Proxy (I blk) -> HardForkBlock '[blk] -> blk
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk,
 Coercible x (f (HardForkBlock '[blk])), Coercible y (f blk)) =>
proxy (f blk) -> x -> y
project' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(I blk)) (HardForkBlock '[blk] -> blk) -> m (HardForkBlock '[blk]) -> m blk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                 TopLevelConfig (HardForkBlock '[blk])
-> BlockNo
-> SlotNo
-> TickedLedgerState (HardForkBlock '[blk])
-> [Validated (GenTx (HardForkBlock '[blk]))]
-> IsLeader (BlockProtocol (HardForkBlock '[blk]))
-> m (HardForkBlock '[blk])
forgeBlock
                                   (TopLevelConfig blk -> TopLevelConfig (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
TopLevelConfig blk -> TopLevelConfig (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject TopLevelConfig blk
cfg)
                                   BlockNo
bno
                                   SlotNo
sno
                                   ((:.:) Ticked LedgerState (HardForkBlock '[blk])
-> TickedLedgerState (HardForkBlock '[blk])
forall {l} {k} (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp ((:.:) Ticked LedgerState blk
-> (:.:) Ticked LedgerState (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
(:.:) Ticked LedgerState blk
-> (:.:) Ticked LedgerState (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject (TickedLedgerState blk -> (:.:) Ticked LedgerState blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp TickedLedgerState blk
tickedLgrSt)))
                                   (Proxy (WrapValidatedGenTx blk)
-> Validated (GenTx blk)
-> Validated (GenTx (HardForkBlock '[blk]))
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapValidatedGenTx blk)) (Validated (GenTx blk) -> Validated (GenTx (HardForkBlock '[blk])))
-> [Validated (GenTx blk)]
-> [Validated (GenTx (HardForkBlock '[blk]))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Validated (GenTx blk)]
txs)
                                   (Proxy (WrapIsLeader blk)
-> IsLeader (BlockProtocol blk) -> HardForkIsLeader '[blk]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapIsLeader blk)) IsLeader (BlockProtocol blk)
isLeader)
      }
    where
      injTickedChainDepSt ::
           EpochInfo (Except PastHorizonException)
        -> Ticked (ChainDepState (BlockProtocol blk))
        -> Ticked (ChainDepState (HardForkProtocol '[blk]))
      injTickedChainDepSt :: EpochInfo (Except PastHorizonException)
-> Ticked (ChainDepState (BlockProtocol blk))
-> Ticked (ChainDepState (HardForkProtocol '[blk]))
injTickedChainDepSt EpochInfo (Except PastHorizonException)
ei =
            (HardForkState (Ticked :.: WrapChainDepState) '[blk]
-> EpochInfo (Except PastHorizonException)
-> Ticked (HardForkChainDepState '[blk])
forall (xs :: [*]).
HardForkState (Ticked :.: WrapChainDepState) xs
-> EpochInfo (Except PastHorizonException)
-> Ticked (HardForkChainDepState xs)
`TickedHardForkChainDepState` EpochInfo (Except PastHorizonException)
ei)
          (HardForkState (Ticked :.: WrapChainDepState) '[blk]
 -> Ticked (HardForkChainDepState '[blk]))
-> (Ticked (ChainDepState (BlockProtocol blk))
    -> HardForkState (Ticked :.: WrapChainDepState) '[blk])
-> Ticked (ChainDepState (BlockProtocol blk))
-> Ticked (HardForkChainDepState '[blk])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Telescope (K Past) (Current (Ticked :.: WrapChainDepState)) '[blk]
-> HardForkState (Ticked :.: WrapChainDepState) '[blk]
forall (f :: * -> *) (xs :: [*]).
Telescope (K Past) (Current f) xs -> HardForkState f xs
HardForkState
          (Telescope (K Past) (Current (Ticked :.: WrapChainDepState)) '[blk]
 -> HardForkState (Ticked :.: WrapChainDepState) '[blk])
-> (Ticked (ChainDepState (BlockProtocol blk))
    -> Telescope
         (K Past) (Current (Ticked :.: WrapChainDepState)) '[blk])
-> Ticked (ChainDepState (BlockProtocol blk))
-> HardForkState (Ticked :.: WrapChainDepState) '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current (Ticked :.: WrapChainDepState) blk
-> Telescope
     (K Past) (Current (Ticked :.: WrapChainDepState)) '[blk]
forall {k} (f :: k -> *) (x :: k) (g :: k -> *) (xs1 :: [k]).
f x -> Telescope g f (x : xs1)
Telescope.TZ
          (Current (Ticked :.: WrapChainDepState) blk
 -> Telescope
      (K Past) (Current (Ticked :.: WrapChainDepState)) '[blk])
-> (Ticked (ChainDepState (BlockProtocol blk))
    -> Current (Ticked :.: WrapChainDepState) blk)
-> Ticked (ChainDepState (BlockProtocol blk))
-> Telescope
     (K Past) (Current (Ticked :.: WrapChainDepState)) '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound
-> (:.:) Ticked WrapChainDepState blk
-> Current (Ticked :.: WrapChainDepState) blk
forall (f :: * -> *) blk. Bound -> f blk -> Current f blk
State.Current Bound
History.initBound
          ((:.:) Ticked WrapChainDepState blk
 -> Current (Ticked :.: WrapChainDepState) blk)
-> (Ticked (ChainDepState (BlockProtocol blk))
    -> (:.:) Ticked WrapChainDepState blk)
-> Ticked (ChainDepState (BlockProtocol blk))
-> Current (Ticked :.: WrapChainDepState) blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (WrapChainDepState blk)
-> (:.:) Ticked WrapChainDepState blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp
          (Ticked (WrapChainDepState blk)
 -> (:.:) Ticked WrapChainDepState blk)
-> (Ticked (ChainDepState (BlockProtocol blk))
    -> Ticked (WrapChainDepState blk))
-> Ticked (ChainDepState (BlockProtocol blk))
-> (:.:) Ticked WrapChainDepState blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (ChainDepState (BlockProtocol blk))
-> Ticked (WrapChainDepState blk)
forall blk.
Ticked (ChainDepState (BlockProtocol blk))
-> Ticked (WrapChainDepState blk)
WrapTickedChainDepState

  inject :: forall blk. NoHardForks blk
         => BlockForging m blk -> BlockForging m (HardForkBlock '[blk])
  inject :: forall blk.
NoHardForks blk =>
BlockForging m blk -> BlockForging m (HardForkBlock '[blk])
inject BlockForging {Text
CanBeLeader (BlockProtocol blk)
TopLevelConfig blk
-> BlockNo
-> SlotNo
-> TickedLedgerState blk
-> [Validated (GenTx blk)]
-> IsLeader (BlockProtocol blk)
-> m blk
TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> m (ForgeStateUpdateInfo blk)
TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> IsLeader (BlockProtocol blk)
-> ForgeStateInfo blk
-> Either (CannotForge blk) ()
forgeLabel :: forall (m :: * -> *) blk. BlockForging m blk -> Text
canBeLeader :: forall (m :: * -> *) blk.
BlockForging m blk -> CanBeLeader (BlockProtocol blk)
updateForgeState :: forall (m :: * -> *) blk.
BlockForging m blk
-> TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> m (ForgeStateUpdateInfo blk)
checkCanForge :: forall (m :: * -> *) blk.
BlockForging m blk
-> TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> IsLeader (BlockProtocol blk)
-> ForgeStateInfo blk
-> Either (CannotForge blk) ()
forgeBlock :: forall (m :: * -> *) blk.
BlockForging m blk
-> TopLevelConfig blk
-> BlockNo
-> SlotNo
-> TickedLedgerState blk
-> [Validated (GenTx blk)]
-> IsLeader (BlockProtocol blk)
-> m blk
forgeLabel :: Text
canBeLeader :: CanBeLeader (BlockProtocol blk)
updateForgeState :: TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> m (ForgeStateUpdateInfo blk)
checkCanForge :: TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> IsLeader (BlockProtocol blk)
-> ForgeStateInfo blk
-> Either (CannotForge blk) ()
forgeBlock :: TopLevelConfig blk
-> BlockNo
-> SlotNo
-> TickedLedgerState blk
-> [Validated (GenTx blk)]
-> IsLeader (BlockProtocol blk)
-> m blk
..} = BlockForging {
        forgeLabel :: Text
forgeLabel       = Text
forgeLabel
      , canBeLeader :: CanBeLeader (BlockProtocol (HardForkBlock '[blk]))
canBeLeader      = Proxy (WrapCanBeLeader blk)
-> CanBeLeader (BlockProtocol blk) -> HardForkCanBeLeader '[blk]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapCanBeLeader blk)) CanBeLeader (BlockProtocol blk)
canBeLeader
      , updateForgeState :: TopLevelConfig (HardForkBlock '[blk])
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol (HardForkBlock '[blk])))
-> m (ForgeStateUpdateInfo (HardForkBlock '[blk]))
updateForgeState = \TopLevelConfig (HardForkBlock '[blk])
cfg SlotNo
sno Ticked (ChainDepState (BlockProtocol (HardForkBlock '[blk])))
tickedChainDepSt ->
                               ForgeStateUpdateInfo blk
-> ForgeStateUpdateInfo (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
ForgeStateUpdateInfo blk
-> ForgeStateUpdateInfo (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject (ForgeStateUpdateInfo blk
 -> ForgeStateUpdateInfo (HardForkBlock '[blk]))
-> m (ForgeStateUpdateInfo blk)
-> m (ForgeStateUpdateInfo (HardForkBlock '[blk]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                 TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> m (ForgeStateUpdateInfo blk)
updateForgeState
                                   (TopLevelConfig (HardForkBlock '[blk]) -> TopLevelConfig blk
forall blk.
NoHardForks blk =>
TopLevelConfig (HardForkBlock '[blk]) -> TopLevelConfig blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project TopLevelConfig (HardForkBlock '[blk])
cfg)
                                   SlotNo
sno
                                   (Ticked (ChainDepState (HardForkProtocol '[blk]))
-> Ticked (ChainDepState (BlockProtocol blk))
projTickedChainDepSt Ticked (ChainDepState (BlockProtocol (HardForkBlock '[blk])))
Ticked (ChainDepState (HardForkProtocol '[blk]))
tickedChainDepSt)
      , checkCanForge :: TopLevelConfig (HardForkBlock '[blk])
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol (HardForkBlock '[blk])))
-> IsLeader (BlockProtocol (HardForkBlock '[blk]))
-> ForgeStateInfo (HardForkBlock '[blk])
-> Either (CannotForge (HardForkBlock '[blk])) ()
checkCanForge    = \TopLevelConfig (HardForkBlock '[blk])
cfg SlotNo
sno Ticked (ChainDepState (BlockProtocol (HardForkBlock '[blk])))
tickedChainDepSt IsLeader (BlockProtocol (HardForkBlock '[blk]))
isLeader ForgeStateInfo (HardForkBlock '[blk])
forgeStateInfo ->
                               (CannotForge blk -> CannotForge (HardForkBlock '[blk]))
-> Either (CannotForge blk) ()
-> Either (CannotForge (HardForkBlock '[blk])) ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Proxy (WrapCannotForge blk)
-> CannotForge blk -> HardForkCannotForge '[blk]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapCannotForge blk))) (Either (CannotForge blk) ()
 -> Either (CannotForge (HardForkBlock '[blk])) ())
-> Either (CannotForge blk) ()
-> Either (CannotForge (HardForkBlock '[blk])) ()
forall a b. (a -> b) -> a -> b
$
                                 TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> IsLeader (BlockProtocol blk)
-> ForgeStateInfo blk
-> Either (CannotForge blk) ()
checkCanForge
                                   (TopLevelConfig (HardForkBlock '[blk]) -> TopLevelConfig blk
forall blk.
NoHardForks blk =>
TopLevelConfig (HardForkBlock '[blk]) -> TopLevelConfig blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project TopLevelConfig (HardForkBlock '[blk])
cfg)
                                   SlotNo
sno
                                   (Ticked (ChainDepState (HardForkProtocol '[blk]))
-> Ticked (ChainDepState (BlockProtocol blk))
projTickedChainDepSt Ticked (ChainDepState (BlockProtocol (HardForkBlock '[blk])))
Ticked (ChainDepState (HardForkProtocol '[blk]))
tickedChainDepSt)
                                   (Proxy (WrapIsLeader blk)
-> HardForkIsLeader '[blk] -> IsLeader (BlockProtocol blk)
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk,
 Coercible x (f (HardForkBlock '[blk])), Coercible y (f blk)) =>
proxy (f blk) -> x -> y
project' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapIsLeader blk)) IsLeader (BlockProtocol (HardForkBlock '[blk]))
HardForkIsLeader '[blk]
isLeader)
                                   (Proxy (WrapForgeStateInfo blk)
-> HardForkForgeStateInfo '[blk] -> ForgeStateInfo blk
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk,
 Coercible x (f (HardForkBlock '[blk])), Coercible y (f blk)) =>
proxy (f blk) -> x -> y
project' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapForgeStateInfo blk)) ForgeStateInfo (HardForkBlock '[blk])
HardForkForgeStateInfo '[blk]
forgeStateInfo)

      , forgeBlock :: TopLevelConfig (HardForkBlock '[blk])
-> BlockNo
-> SlotNo
-> TickedLedgerState (HardForkBlock '[blk])
-> [Validated (GenTx (HardForkBlock '[blk]))]
-> IsLeader (BlockProtocol (HardForkBlock '[blk]))
-> m (HardForkBlock '[blk])
forgeBlock       = \TopLevelConfig (HardForkBlock '[blk])
cfg BlockNo
bno SlotNo
sno TickedLedgerState (HardForkBlock '[blk])
tickedLgrSt [Validated (GenTx (HardForkBlock '[blk]))]
txs IsLeader (BlockProtocol (HardForkBlock '[blk]))
isLeader ->
                               Proxy (I blk) -> blk -> HardForkBlock '[blk]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(I blk)) (blk -> HardForkBlock '[blk]) -> m blk -> m (HardForkBlock '[blk])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                 TopLevelConfig blk
-> BlockNo
-> SlotNo
-> TickedLedgerState blk
-> [Validated (GenTx blk)]
-> IsLeader (BlockProtocol blk)
-> m blk
forgeBlock
                                   (TopLevelConfig (HardForkBlock '[blk]) -> TopLevelConfig blk
forall blk.
NoHardForks blk =>
TopLevelConfig (HardForkBlock '[blk]) -> TopLevelConfig blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project TopLevelConfig (HardForkBlock '[blk])
cfg)
                                   BlockNo
bno
                                   SlotNo
sno
                                   ((:.:) Ticked LedgerState blk -> TickedLedgerState blk
forall {l} {k} (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp ((:.:) Ticked LedgerState (HardForkBlock '[blk])
-> (:.:) Ticked LedgerState blk
forall blk.
NoHardForks blk =>
(:.:) Ticked LedgerState (HardForkBlock '[blk])
-> (:.:) Ticked LedgerState blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project (TickedLedgerState (HardForkBlock '[blk])
-> (:.:) Ticked LedgerState (HardForkBlock '[blk])
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp TickedLedgerState (HardForkBlock '[blk])
tickedLgrSt)))
                                   (Proxy (WrapValidatedGenTx blk)
-> Validated (GenTx (HardForkBlock '[blk]))
-> Validated (GenTx blk)
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk,
 Coercible x (f (HardForkBlock '[blk])), Coercible y (f blk)) =>
proxy (f blk) -> x -> y
project' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapValidatedGenTx blk)) (Validated (GenTx (HardForkBlock '[blk])) -> Validated (GenTx blk))
-> [Validated (GenTx (HardForkBlock '[blk]))]
-> [Validated (GenTx blk)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Validated (GenTx (HardForkBlock '[blk]))]
txs)
                                   (Proxy (WrapIsLeader blk)
-> HardForkIsLeader '[blk] -> IsLeader (BlockProtocol blk)
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk,
 Coercible x (f (HardForkBlock '[blk])), Coercible y (f blk)) =>
proxy (f blk) -> x -> y
project' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapIsLeader blk)) IsLeader (BlockProtocol (HardForkBlock '[blk]))
HardForkIsLeader '[blk]
isLeader)
      }
    where
      projTickedChainDepSt ::
           Ticked (ChainDepState (HardForkProtocol '[blk]))
        -> Ticked (ChainDepState (BlockProtocol blk))
      projTickedChainDepSt :: Ticked (ChainDepState (HardForkProtocol '[blk]))
-> Ticked (ChainDepState (BlockProtocol blk))
projTickedChainDepSt =
            Ticked (WrapChainDepState blk)
-> Ticked (ChainDepState (BlockProtocol blk))
forall blk.
Ticked (WrapChainDepState blk)
-> Ticked (ChainDepState (BlockProtocol blk))
unwrapTickedChainDepState
          (Ticked (WrapChainDepState blk)
 -> Ticked (ChainDepState (BlockProtocol blk)))
-> (Ticked (HardForkChainDepState '[blk])
    -> Ticked (WrapChainDepState blk))
-> Ticked (HardForkChainDepState '[blk])
-> Ticked (ChainDepState (BlockProtocol blk))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:.:) Ticked WrapChainDepState blk
-> Ticked (WrapChainDepState blk)
forall {l} {k} (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp
          ((:.:) Ticked WrapChainDepState blk
 -> Ticked (WrapChainDepState blk))
-> (Ticked (HardForkChainDepState '[blk])
    -> (:.:) Ticked WrapChainDepState blk)
-> Ticked (HardForkChainDepState '[blk])
-> Ticked (WrapChainDepState blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkState (Ticked :.: WrapChainDepState) '[blk]
-> (:.:) Ticked WrapChainDepState blk
forall (f :: * -> *) blk. HardForkState f '[blk] -> f blk
State.fromTZ
          (HardForkState (Ticked :.: WrapChainDepState) '[blk]
 -> (:.:) Ticked WrapChainDepState blk)
-> (Ticked (HardForkChainDepState '[blk])
    -> HardForkState (Ticked :.: WrapChainDepState) '[blk])
-> Ticked (HardForkChainDepState '[blk])
-> (:.:) Ticked WrapChainDepState blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (HardForkChainDepState '[blk])
-> HardForkState (Ticked :.: WrapChainDepState) '[blk]
forall (xs :: [*]).
Ticked (HardForkChainDepState xs)
-> HardForkState (Ticked :.: WrapChainDepState) xs
tickedHardForkChainDepStatePerEra

instance Isomorphic ProtocolInfo where
  project :: forall blk. NoHardForks blk
          => ProtocolInfo (HardForkBlock '[blk]) -> ProtocolInfo blk
  project :: forall blk.
NoHardForks blk =>
ProtocolInfo (HardForkBlock '[blk]) -> ProtocolInfo blk
project ProtocolInfo {TopLevelConfig (HardForkBlock '[blk])
ExtLedgerState (HardForkBlock '[blk])
pInfoConfig :: TopLevelConfig (HardForkBlock '[blk])
pInfoInitLedger :: ExtLedgerState (HardForkBlock '[blk])
pInfoConfig :: forall b. ProtocolInfo b -> TopLevelConfig b
pInfoInitLedger :: forall b. ProtocolInfo b -> ExtLedgerState b
..} = ProtocolInfo {
        pInfoConfig :: TopLevelConfig blk
pInfoConfig       = TopLevelConfig (HardForkBlock '[blk]) -> TopLevelConfig blk
forall blk.
NoHardForks blk =>
TopLevelConfig (HardForkBlock '[blk]) -> TopLevelConfig blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project TopLevelConfig (HardForkBlock '[blk])
pInfoConfig
      , pInfoInitLedger :: ExtLedgerState blk
pInfoInitLedger   = ExtLedgerState (HardForkBlock '[blk]) -> ExtLedgerState blk
forall blk.
NoHardForks blk =>
ExtLedgerState (HardForkBlock '[blk]) -> ExtLedgerState blk
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project ExtLedgerState (HardForkBlock '[blk])
pInfoInitLedger
      }

  inject :: forall blk. NoHardForks blk
         => ProtocolInfo blk -> ProtocolInfo (HardForkBlock '[blk])
  inject :: forall blk.
NoHardForks blk =>
ProtocolInfo blk -> ProtocolInfo (HardForkBlock '[blk])
inject ProtocolInfo {TopLevelConfig blk
ExtLedgerState blk
pInfoConfig :: forall b. ProtocolInfo b -> TopLevelConfig b
pInfoInitLedger :: forall b. ProtocolInfo b -> ExtLedgerState b
pInfoConfig :: TopLevelConfig blk
pInfoInitLedger :: ExtLedgerState blk
..} = ProtocolInfo {
        pInfoConfig :: TopLevelConfig (HardForkBlock '[blk])
pInfoConfig       = TopLevelConfig blk -> TopLevelConfig (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
TopLevelConfig blk -> TopLevelConfig (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject TopLevelConfig blk
pInfoConfig
      , pInfoInitLedger :: ExtLedgerState (HardForkBlock '[blk])
pInfoInitLedger   = ExtLedgerState blk -> ExtLedgerState (HardForkBlock '[blk])
forall blk.
NoHardForks blk =>
ExtLedgerState blk -> ExtLedgerState (HardForkBlock '[blk])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject ExtLedgerState blk
pInfoInitLedger
      }

{-------------------------------------------------------------------------------
  Types that require take advantage of the fact that we have a single era
-------------------------------------------------------------------------------}

instance Isomorphic WrapApplyTxErr where
  project :: forall blk.
NoHardForks blk =>
WrapApplyTxErr (HardForkBlock '[blk]) -> WrapApplyTxErr blk
project = ApplyTxErr (HardForkBlock '[blk]) -> WrapApplyTxErr blk
HardForkApplyTxErr '[blk] -> WrapApplyTxErr blk
forall blk. ApplyTxErr (HardForkBlock '[blk]) -> WrapApplyTxErr blk
aux (HardForkApplyTxErr '[blk] -> WrapApplyTxErr blk)
-> (WrapApplyTxErr (HardForkBlock '[blk])
    -> HardForkApplyTxErr '[blk])
-> WrapApplyTxErr (HardForkBlock '[blk])
-> WrapApplyTxErr blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapApplyTxErr (HardForkBlock '[blk])
-> ApplyTxErr (HardForkBlock '[blk])
WrapApplyTxErr (HardForkBlock '[blk]) -> HardForkApplyTxErr '[blk]
forall blk. WrapApplyTxErr blk -> ApplyTxErr blk
unwrapApplyTxErr
    where
      aux :: ApplyTxErr (HardForkBlock '[blk]) -> WrapApplyTxErr blk
      aux :: forall blk. ApplyTxErr (HardForkBlock '[blk]) -> WrapApplyTxErr blk
aux (HardForkApplyTxErrFromEra  OneEraApplyTxErr '[blk]
err) = NS WrapApplyTxErr '[blk] -> WrapApplyTxErr blk
forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
unZ (NS WrapApplyTxErr '[blk] -> WrapApplyTxErr blk)
-> NS WrapApplyTxErr '[blk] -> WrapApplyTxErr blk
forall a b. (a -> b) -> a -> b
$ OneEraApplyTxErr '[blk] -> NS WrapApplyTxErr '[blk]
forall (xs :: [*]). OneEraApplyTxErr xs -> NS WrapApplyTxErr xs
getOneEraApplyTxErr OneEraApplyTxErr '[blk]
err
      aux (HardForkApplyTxErrWrongEra MismatchEraInfo '[blk]
err) = Void -> WrapApplyTxErr blk
forall a. Void -> a
absurd (Void -> WrapApplyTxErr blk) -> Void -> WrapApplyTxErr blk
forall a b. (a -> b) -> a -> b
$ MismatchEraInfo '[blk] -> Void
forall b. MismatchEraInfo '[b] -> Void
mismatchOneEra MismatchEraInfo '[blk]
err

  inject :: forall blk.
NoHardForks blk =>
WrapApplyTxErr blk -> WrapApplyTxErr (HardForkBlock '[blk])
inject = ApplyTxErr (HardForkBlock '[blk])
-> WrapApplyTxErr (HardForkBlock '[blk])
HardForkApplyTxErr '[blk] -> WrapApplyTxErr (HardForkBlock '[blk])
forall blk. ApplyTxErr blk -> WrapApplyTxErr blk
WrapApplyTxErr (HardForkApplyTxErr '[blk]
 -> WrapApplyTxErr (HardForkBlock '[blk]))
-> (WrapApplyTxErr blk -> HardForkApplyTxErr '[blk])
-> WrapApplyTxErr blk
-> WrapApplyTxErr (HardForkBlock '[blk])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapApplyTxErr blk -> ApplyTxErr (HardForkBlock '[blk])
WrapApplyTxErr blk -> HardForkApplyTxErr '[blk]
forall blk. WrapApplyTxErr blk -> ApplyTxErr (HardForkBlock '[blk])
aux
    where
      aux :: WrapApplyTxErr blk -> ApplyTxErr (HardForkBlock '[blk])
      aux :: forall blk. WrapApplyTxErr blk -> ApplyTxErr (HardForkBlock '[blk])
aux = OneEraApplyTxErr '[blk] -> HardForkApplyTxErr '[blk]
forall (xs :: [*]). OneEraApplyTxErr xs -> HardForkApplyTxErr xs
HardForkApplyTxErrFromEra (OneEraApplyTxErr '[blk] -> HardForkApplyTxErr '[blk])
-> (WrapApplyTxErr blk -> OneEraApplyTxErr '[blk])
-> WrapApplyTxErr blk
-> HardForkApplyTxErr '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapApplyTxErr '[blk] -> OneEraApplyTxErr '[blk]
forall (xs :: [*]). NS WrapApplyTxErr xs -> OneEraApplyTxErr xs
OneEraApplyTxErr (NS WrapApplyTxErr '[blk] -> OneEraApplyTxErr '[blk])
-> (WrapApplyTxErr blk -> NS WrapApplyTxErr '[blk])
-> WrapApplyTxErr blk
-> OneEraApplyTxErr '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapApplyTxErr blk -> NS WrapApplyTxErr '[blk]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z

instance Isomorphic WrapEnvelopeErr where
  project :: forall blk.
NoHardForks blk =>
WrapEnvelopeErr (HardForkBlock '[blk]) -> WrapEnvelopeErr blk
project = OtherHeaderEnvelopeError (HardForkBlock '[blk])
-> WrapEnvelopeErr blk
HardForkEnvelopeErr '[blk] -> WrapEnvelopeErr blk
forall blk.
OtherHeaderEnvelopeError (HardForkBlock '[blk])
-> WrapEnvelopeErr blk
aux (HardForkEnvelopeErr '[blk] -> WrapEnvelopeErr blk)
-> (WrapEnvelopeErr (HardForkBlock '[blk])
    -> HardForkEnvelopeErr '[blk])
-> WrapEnvelopeErr (HardForkBlock '[blk])
-> WrapEnvelopeErr blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapEnvelopeErr (HardForkBlock '[blk])
-> OtherHeaderEnvelopeError (HardForkBlock '[blk])
WrapEnvelopeErr (HardForkBlock '[blk])
-> HardForkEnvelopeErr '[blk]
forall blk. WrapEnvelopeErr blk -> OtherHeaderEnvelopeError blk
unwrapEnvelopeErr
    where
      aux :: OtherHeaderEnvelopeError (HardForkBlock '[blk])
          -> WrapEnvelopeErr blk
      aux :: forall blk.
OtherHeaderEnvelopeError (HardForkBlock '[blk])
-> WrapEnvelopeErr blk
aux (HardForkEnvelopeErrFromEra  OneEraEnvelopeErr '[blk]
err) = NS WrapEnvelopeErr '[blk] -> WrapEnvelopeErr blk
forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
unZ (NS WrapEnvelopeErr '[blk] -> WrapEnvelopeErr blk)
-> NS WrapEnvelopeErr '[blk] -> WrapEnvelopeErr blk
forall a b. (a -> b) -> a -> b
$ OneEraEnvelopeErr '[blk] -> NS WrapEnvelopeErr '[blk]
forall (xs :: [*]). OneEraEnvelopeErr xs -> NS WrapEnvelopeErr xs
getOneEraEnvelopeErr OneEraEnvelopeErr '[blk]
err
      aux (HardForkEnvelopeErrWrongEra MismatchEraInfo '[blk]
err) = Void -> WrapEnvelopeErr blk
forall a. Void -> a
absurd (Void -> WrapEnvelopeErr blk) -> Void -> WrapEnvelopeErr blk
forall a b. (a -> b) -> a -> b
$ MismatchEraInfo '[blk] -> Void
forall b. MismatchEraInfo '[b] -> Void
mismatchOneEra MismatchEraInfo '[blk]
err

  inject :: forall blk.
NoHardForks blk =>
WrapEnvelopeErr blk -> WrapEnvelopeErr (HardForkBlock '[blk])
inject = OtherHeaderEnvelopeError (HardForkBlock '[blk])
-> WrapEnvelopeErr (HardForkBlock '[blk])
HardForkEnvelopeErr '[blk]
-> WrapEnvelopeErr (HardForkBlock '[blk])
forall blk. OtherHeaderEnvelopeError blk -> WrapEnvelopeErr blk
WrapEnvelopeErr (HardForkEnvelopeErr '[blk]
 -> WrapEnvelopeErr (HardForkBlock '[blk]))
-> (WrapEnvelopeErr blk -> HardForkEnvelopeErr '[blk])
-> WrapEnvelopeErr blk
-> WrapEnvelopeErr (HardForkBlock '[blk])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapEnvelopeErr blk
-> OtherHeaderEnvelopeError (HardForkBlock '[blk])
WrapEnvelopeErr blk -> HardForkEnvelopeErr '[blk]
forall b.
WrapEnvelopeErr b -> OtherHeaderEnvelopeError (HardForkBlock '[b])
aux
    where
      aux :: WrapEnvelopeErr b
          -> OtherHeaderEnvelopeError (HardForkBlock '[b])
      aux :: forall b.
WrapEnvelopeErr b -> OtherHeaderEnvelopeError (HardForkBlock '[b])
aux = OneEraEnvelopeErr '[b] -> HardForkEnvelopeErr '[b]
forall (xs :: [*]). OneEraEnvelopeErr xs -> HardForkEnvelopeErr xs
HardForkEnvelopeErrFromEra (OneEraEnvelopeErr '[b] -> HardForkEnvelopeErr '[b])
-> (WrapEnvelopeErr b -> OneEraEnvelopeErr '[b])
-> WrapEnvelopeErr b
-> HardForkEnvelopeErr '[b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapEnvelopeErr '[b] -> OneEraEnvelopeErr '[b]
forall (xs :: [*]). NS WrapEnvelopeErr xs -> OneEraEnvelopeErr xs
OneEraEnvelopeErr (NS WrapEnvelopeErr '[b] -> OneEraEnvelopeErr '[b])
-> (WrapEnvelopeErr b -> NS WrapEnvelopeErr '[b])
-> WrapEnvelopeErr b
-> OneEraEnvelopeErr '[b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapEnvelopeErr b -> NS WrapEnvelopeErr '[b]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z

instance Isomorphic WrapCanBeLeader where
  project :: forall blk.
NoHardForks blk =>
WrapCanBeLeader (HardForkBlock '[blk]) -> WrapCanBeLeader blk
project = NonEmptyOptNP WrapCanBeLeader '[blk] -> WrapCanBeLeader blk
forall {k} (f :: k -> *) (x :: k). NonEmptyOptNP f '[x] -> f x
OptNP.fromSingleton (NonEmptyOptNP WrapCanBeLeader '[blk] -> WrapCanBeLeader blk)
-> (WrapCanBeLeader (HardForkBlock '[blk])
    -> NonEmptyOptNP WrapCanBeLeader '[blk])
-> WrapCanBeLeader (HardForkBlock '[blk])
-> WrapCanBeLeader blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeErasCanBeLeader '[blk] -> NonEmptyOptNP WrapCanBeLeader '[blk]
forall (xs :: [*]).
SomeErasCanBeLeader xs -> NonEmptyOptNP WrapCanBeLeader xs
getSomeErasCanBeLeader (SomeErasCanBeLeader '[blk]
 -> NonEmptyOptNP WrapCanBeLeader '[blk])
-> (WrapCanBeLeader (HardForkBlock '[blk])
    -> SomeErasCanBeLeader '[blk])
-> WrapCanBeLeader (HardForkBlock '[blk])
-> NonEmptyOptNP WrapCanBeLeader '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapCanBeLeader (HardForkBlock '[blk])
-> CanBeLeader (BlockProtocol (HardForkBlock '[blk]))
WrapCanBeLeader (HardForkBlock '[blk])
-> SomeErasCanBeLeader '[blk]
forall blk. WrapCanBeLeader blk -> CanBeLeader (BlockProtocol blk)
unwrapCanBeLeader
  inject :: forall blk.
NoHardForks blk =>
WrapCanBeLeader blk -> WrapCanBeLeader (HardForkBlock '[blk])
inject  = CanBeLeader (BlockProtocol (HardForkBlock '[blk]))
-> WrapCanBeLeader (HardForkBlock '[blk])
HardForkCanBeLeader '[blk]
-> WrapCanBeLeader (HardForkBlock '[blk])
forall blk. CanBeLeader (BlockProtocol blk) -> WrapCanBeLeader blk
WrapCanBeLeader (HardForkCanBeLeader '[blk]
 -> WrapCanBeLeader (HardForkBlock '[blk]))
-> (WrapCanBeLeader blk -> HardForkCanBeLeader '[blk])
-> WrapCanBeLeader blk
-> WrapCanBeLeader (HardForkBlock '[blk])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyOptNP WrapCanBeLeader '[blk] -> HardForkCanBeLeader '[blk]
forall (xs :: [*]).
NonEmptyOptNP WrapCanBeLeader xs -> SomeErasCanBeLeader xs
SomeErasCanBeLeader (NonEmptyOptNP WrapCanBeLeader '[blk]
 -> HardForkCanBeLeader '[blk])
-> (WrapCanBeLeader blk -> NonEmptyOptNP WrapCanBeLeader '[blk])
-> WrapCanBeLeader blk
-> HardForkCanBeLeader '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapCanBeLeader blk -> NonEmptyOptNP WrapCanBeLeader '[blk]
forall {k} (f :: k -> *) (x :: k). f x -> NonEmptyOptNP f '[x]
OptNP.singleton

instance Isomorphic WrapForgeStateInfo where
  project :: forall blk.
NoHardForks blk =>
WrapForgeStateInfo (HardForkBlock '[blk]) -> WrapForgeStateInfo blk
project (WrapForgeStateInfo ForgeStateInfo (HardForkBlock '[blk])
forgeStateInfo) =
      case ForgeStateInfo (HardForkBlock '[blk])
forgeStateInfo of
        CurrentEraForgeStateUpdated OneEraForgeStateInfo '[blk]
info -> NS WrapForgeStateInfo '[blk] -> WrapForgeStateInfo blk
forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
unZ (NS WrapForgeStateInfo '[blk] -> WrapForgeStateInfo blk)
-> NS WrapForgeStateInfo '[blk] -> WrapForgeStateInfo blk
forall a b. (a -> b) -> a -> b
$ OneEraForgeStateInfo '[blk] -> NS WrapForgeStateInfo '[blk]
forall (xs :: [*]).
OneEraForgeStateInfo xs -> NS WrapForgeStateInfo xs
getOneEraForgeStateInfo OneEraForgeStateInfo '[blk]
info
  inject :: forall blk.
NoHardForks blk =>
WrapForgeStateInfo blk -> WrapForgeStateInfo (HardForkBlock '[blk])
inject  =
        ForgeStateInfo (HardForkBlock '[blk])
-> WrapForgeStateInfo (HardForkBlock '[blk])
HardForkForgeStateInfo '[blk]
-> WrapForgeStateInfo (HardForkBlock '[blk])
forall blk. ForgeStateInfo blk -> WrapForgeStateInfo blk
WrapForgeStateInfo
      (HardForkForgeStateInfo '[blk]
 -> WrapForgeStateInfo (HardForkBlock '[blk]))
-> (WrapForgeStateInfo blk -> HardForkForgeStateInfo '[blk])
-> WrapForgeStateInfo blk
-> WrapForgeStateInfo (HardForkBlock '[blk])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraForgeStateInfo '[blk] -> HardForkForgeStateInfo '[blk]
forall (xs :: [*]).
OneEraForgeStateInfo xs -> HardForkForgeStateInfo xs
CurrentEraForgeStateUpdated
      (OneEraForgeStateInfo '[blk] -> HardForkForgeStateInfo '[blk])
-> (WrapForgeStateInfo blk -> OneEraForgeStateInfo '[blk])
-> WrapForgeStateInfo blk
-> HardForkForgeStateInfo '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapForgeStateInfo '[blk] -> OneEraForgeStateInfo '[blk]
forall (xs :: [*]).
NS WrapForgeStateInfo xs -> OneEraForgeStateInfo xs
OneEraForgeStateInfo
      (NS WrapForgeStateInfo '[blk] -> OneEraForgeStateInfo '[blk])
-> (WrapForgeStateInfo blk -> NS WrapForgeStateInfo '[blk])
-> WrapForgeStateInfo blk
-> OneEraForgeStateInfo '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapForgeStateInfo blk -> NS WrapForgeStateInfo '[blk]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z

instance Isomorphic WrapLedgerView where
  project :: forall blk.
NoHardForks blk =>
WrapLedgerView (HardForkBlock '[blk]) -> WrapLedgerView blk
project = HardForkState WrapLedgerView '[blk] -> WrapLedgerView blk
forall (f :: * -> *) blk. HardForkState f '[blk] -> f blk
State.fromTZ (HardForkState WrapLedgerView '[blk] -> WrapLedgerView blk)
-> (WrapLedgerView (HardForkBlock '[blk])
    -> HardForkState WrapLedgerView '[blk])
-> WrapLedgerView (HardForkBlock '[blk])
-> WrapLedgerView blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkLedgerView_ WrapLedgerView '[blk]
-> HardForkState WrapLedgerView '[blk]
forall (f :: * -> *) (xs :: [*]).
HardForkLedgerView_ f xs -> HardForkState f xs
hardForkLedgerViewPerEra (HardForkLedgerView_ WrapLedgerView '[blk]
 -> HardForkState WrapLedgerView '[blk])
-> (WrapLedgerView (HardForkBlock '[blk])
    -> HardForkLedgerView_ WrapLedgerView '[blk])
-> WrapLedgerView (HardForkBlock '[blk])
-> HardForkState WrapLedgerView '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapLedgerView (HardForkBlock '[blk])
-> LedgerView (BlockProtocol (HardForkBlock '[blk]))
WrapLedgerView (HardForkBlock '[blk])
-> HardForkLedgerView_ WrapLedgerView '[blk]
forall blk. WrapLedgerView blk -> LedgerView (BlockProtocol blk)
unwrapLedgerView
  inject :: forall blk.
NoHardForks blk =>
WrapLedgerView blk -> WrapLedgerView (HardForkBlock '[blk])
inject  = LedgerView (BlockProtocol (HardForkBlock '[blk]))
-> WrapLedgerView (HardForkBlock '[blk])
HardForkLedgerView '[blk] -> WrapLedgerView (HardForkBlock '[blk])
forall blk. LedgerView (BlockProtocol blk) -> WrapLedgerView blk
WrapLedgerView
          (HardForkLedgerView '[blk]
 -> WrapLedgerView (HardForkBlock '[blk]))
-> (WrapLedgerView blk -> HardForkLedgerView '[blk])
-> WrapLedgerView blk
-> WrapLedgerView (HardForkBlock '[blk])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransitionInfo
-> HardForkState WrapLedgerView '[blk] -> HardForkLedgerView '[blk]
forall (f :: * -> *) (xs :: [*]).
TransitionInfo -> HardForkState f xs -> HardForkLedgerView_ f xs
HardForkLedgerView TransitionInfo
TransitionImpossible
          (HardForkState WrapLedgerView '[blk] -> HardForkLedgerView '[blk])
-> (WrapLedgerView blk -> HardForkState WrapLedgerView '[blk])
-> WrapLedgerView blk
-> HardForkLedgerView '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Telescope (K Past) (Current WrapLedgerView) '[blk]
-> HardForkState WrapLedgerView '[blk]
forall (f :: * -> *) (xs :: [*]).
Telescope (K Past) (Current f) xs -> HardForkState f xs
HardForkState
          (Telescope (K Past) (Current WrapLedgerView) '[blk]
 -> HardForkState WrapLedgerView '[blk])
-> (WrapLedgerView blk
    -> Telescope (K Past) (Current WrapLedgerView) '[blk])
-> WrapLedgerView blk
-> HardForkState WrapLedgerView '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current WrapLedgerView blk
-> Telescope (K Past) (Current WrapLedgerView) '[blk]
forall {k} (f :: k -> *) (x :: k) (g :: k -> *) (xs1 :: [k]).
f x -> Telescope g f (x : xs1)
Telescope.TZ
          (Current WrapLedgerView blk
 -> Telescope (K Past) (Current WrapLedgerView) '[blk])
-> (WrapLedgerView blk -> Current WrapLedgerView blk)
-> WrapLedgerView blk
-> Telescope (K Past) (Current WrapLedgerView) '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound -> WrapLedgerView blk -> Current WrapLedgerView blk
forall (f :: * -> *) blk. Bound -> f blk -> Current f blk
Current Bound
History.initBound

instance Isomorphic (SomeSecond (NestedCtxt f)) where
  project :: forall blk.
NoHardForks blk =>
SomeSecond (NestedCtxt f) (HardForkBlock '[blk])
-> SomeSecond (NestedCtxt f) blk
project (SomeSecond NestedCtxt f (HardForkBlock '[blk]) b
ctxt) = NestedCtxt f blk b -> SomeSecond (NestedCtxt f) blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (NestedCtxt f blk b -> SomeSecond (NestedCtxt f) blk)
-> NestedCtxt f blk b -> SomeSecond (NestedCtxt f) blk
forall a b. (a -> b) -> a -> b
$ NestedCtxt f (HardForkBlock '[blk]) b -> NestedCtxt f blk b
forall (f :: * -> *) blk a.
NestedCtxt f (HardForkBlock '[blk]) a -> NestedCtxt f blk a
projNestedCtxt NestedCtxt f (HardForkBlock '[blk]) b
ctxt
  inject :: forall blk.
NoHardForks blk =>
SomeSecond (NestedCtxt f) blk
-> SomeSecond (NestedCtxt f) (HardForkBlock '[blk])
inject  (SomeSecond NestedCtxt f blk b
ctxt) = NestedCtxt f (HardForkBlock '[blk]) b
-> SomeSecond (NestedCtxt f) (HardForkBlock '[blk])
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (NestedCtxt f (HardForkBlock '[blk]) b
 -> SomeSecond (NestedCtxt f) (HardForkBlock '[blk]))
-> NestedCtxt f (HardForkBlock '[blk]) b
-> SomeSecond (NestedCtxt f) (HardForkBlock '[blk])
forall a b. (a -> b) -> a -> b
$ NestedCtxt f blk b -> NestedCtxt f (HardForkBlock '[blk]) b
forall (f :: * -> *) blk a.
NestedCtxt f blk a -> NestedCtxt f (HardForkBlock '[blk]) a
injNestedCtxt  NestedCtxt f blk b
ctxt

instance Isomorphic WrapLedgerErr where
  project :: forall blk.
NoHardForks blk =>
WrapLedgerErr (HardForkBlock '[blk]) -> WrapLedgerErr blk
project = LedgerError blk -> WrapLedgerErr blk
forall blk. LedgerError blk -> WrapLedgerErr blk
WrapLedgerErr (LedgerError blk -> WrapLedgerErr blk)
-> (WrapLedgerErr (HardForkBlock '[blk]) -> LedgerError blk)
-> WrapLedgerErr (HardForkBlock '[blk])
-> WrapLedgerErr blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkLedgerError '[blk] -> LedgerError blk
forall blk.
HardForkLedgerError '[blk] -> LedgerErr (LedgerState blk)
aux (HardForkLedgerError '[blk] -> LedgerError blk)
-> (WrapLedgerErr (HardForkBlock '[blk])
    -> HardForkLedgerError '[blk])
-> WrapLedgerErr (HardForkBlock '[blk])
-> LedgerError blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapLedgerErr (HardForkBlock '[blk])
-> LedgerError (HardForkBlock '[blk])
WrapLedgerErr (HardForkBlock '[blk]) -> HardForkLedgerError '[blk]
forall blk. WrapLedgerErr blk -> LedgerError blk
unwrapLedgerErr
    where
      aux :: HardForkLedgerError '[blk] -> LedgerErr (LedgerState blk)
      aux :: forall blk.
HardForkLedgerError '[blk] -> LedgerErr (LedgerState blk)
aux (HardForkLedgerErrorFromEra OneEraLedgerError '[blk]
err) =
            WrapLedgerErr blk -> LedgerError blk
forall blk. WrapLedgerErr blk -> LedgerError blk
unwrapLedgerErr
          (WrapLedgerErr blk -> LedgerError blk)
-> (OneEraLedgerError '[blk] -> WrapLedgerErr blk)
-> OneEraLedgerError '[blk]
-> LedgerError blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapLedgerErr '[blk] -> WrapLedgerErr blk
forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
unZ
          (NS WrapLedgerErr '[blk] -> WrapLedgerErr blk)
-> (OneEraLedgerError '[blk] -> NS WrapLedgerErr '[blk])
-> OneEraLedgerError '[blk]
-> WrapLedgerErr blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraLedgerError '[blk] -> NS WrapLedgerErr '[blk]
forall (xs :: [*]). OneEraLedgerError xs -> NS WrapLedgerErr xs
getOneEraLedgerError
          (OneEraLedgerError '[blk] -> LedgerError blk)
-> OneEraLedgerError '[blk] -> LedgerError blk
forall a b. (a -> b) -> a -> b
$ OneEraLedgerError '[blk]
err
      aux (HardForkLedgerErrorWrongEra MismatchEraInfo '[blk]
err) =
          Void -> LedgerError blk
forall a. Void -> a
absurd (Void -> LedgerError blk) -> Void -> LedgerError blk
forall a b. (a -> b) -> a -> b
$ MismatchEraInfo '[blk] -> Void
forall b. MismatchEraInfo '[b] -> Void
mismatchOneEra MismatchEraInfo '[blk]
err

  inject :: forall blk.
NoHardForks blk =>
WrapLedgerErr blk -> WrapLedgerErr (HardForkBlock '[blk])
inject = LedgerError (HardForkBlock '[blk])
-> WrapLedgerErr (HardForkBlock '[blk])
HardForkLedgerError '[blk] -> WrapLedgerErr (HardForkBlock '[blk])
forall blk. LedgerError blk -> WrapLedgerErr blk
WrapLedgerErr (HardForkLedgerError '[blk]
 -> WrapLedgerErr (HardForkBlock '[blk]))
-> (WrapLedgerErr blk -> HardForkLedgerError '[blk])
-> WrapLedgerErr blk
-> WrapLedgerErr (HardForkBlock '[blk])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerErr (LedgerState blk) -> HardForkLedgerError '[blk]
forall blk.
LedgerErr (LedgerState blk) -> HardForkLedgerError '[blk]
aux (LedgerErr (LedgerState blk) -> HardForkLedgerError '[blk])
-> (WrapLedgerErr blk -> LedgerErr (LedgerState blk))
-> WrapLedgerErr blk
-> HardForkLedgerError '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapLedgerErr blk -> LedgerErr (LedgerState blk)
forall blk. WrapLedgerErr blk -> LedgerError blk
unwrapLedgerErr
    where
      aux :: LedgerErr (LedgerState blk) -> HardForkLedgerError '[blk]
      aux :: forall blk.
LedgerErr (LedgerState blk) -> HardForkLedgerError '[blk]
aux = OneEraLedgerError '[blk] -> HardForkLedgerError '[blk]
forall (xs :: [*]). OneEraLedgerError xs -> HardForkLedgerError xs
HardForkLedgerErrorFromEra (OneEraLedgerError '[blk] -> HardForkLedgerError '[blk])
-> (LedgerErr (LedgerState blk) -> OneEraLedgerError '[blk])
-> LedgerErr (LedgerState blk)
-> HardForkLedgerError '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapLedgerErr '[blk] -> OneEraLedgerError '[blk]
forall (xs :: [*]). NS WrapLedgerErr xs -> OneEraLedgerError xs
OneEraLedgerError (NS WrapLedgerErr '[blk] -> OneEraLedgerError '[blk])
-> (LedgerErr (LedgerState blk) -> NS WrapLedgerErr '[blk])
-> LedgerErr (LedgerState blk)
-> OneEraLedgerError '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapLedgerErr blk -> NS WrapLedgerErr '[blk]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (WrapLedgerErr blk -> NS WrapLedgerErr '[blk])
-> (LedgerErr (LedgerState blk) -> WrapLedgerErr blk)
-> LedgerErr (LedgerState blk)
-> NS WrapLedgerErr '[blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerErr (LedgerState blk) -> WrapLedgerErr blk
forall blk. LedgerError blk -> WrapLedgerErr blk
WrapLedgerErr

{-------------------------------------------------------------------------------
  Serialised
-------------------------------------------------------------------------------}

instance Isomorphic SerialisedHeader where
  project :: forall blk.
NoHardForks blk =>
SerialisedHeader (HardForkBlock '[blk]) -> SerialisedHeader blk
project =
        GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
forall blk.
GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
SerialisedHeaderFromDepPair
      (GenDepPair Serialised (NestedCtxt Header blk)
 -> SerialisedHeader blk)
-> (SerialisedHeader (HardForkBlock '[blk])
    -> GenDepPair Serialised (NestedCtxt Header blk))
-> SerialisedHeader (HardForkBlock '[blk])
-> SerialisedHeader blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 NestedCtxt Header (HardForkBlock '[blk]) a
 -> NestedCtxt Header blk a)
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock '[blk]))
-> GenDepPair Serialised (NestedCtxt Header blk)
forall (f :: * -> *) (f' :: * -> *) (g :: * -> *).
(forall a. f a -> f' a) -> GenDepPair g f -> GenDepPair g f'
depPairFirst NestedCtxt Header (HardForkBlock '[blk]) a
-> NestedCtxt Header blk a
forall a.
NestedCtxt Header (HardForkBlock '[blk]) a
-> NestedCtxt Header blk a
forall (f :: * -> *) blk a.
NestedCtxt f (HardForkBlock '[blk]) a -> NestedCtxt f blk a
projNestedCtxt
      (GenDepPair Serialised (NestedCtxt Header (HardForkBlock '[blk]))
 -> GenDepPair Serialised (NestedCtxt Header blk))
-> (SerialisedHeader (HardForkBlock '[blk])
    -> GenDepPair
         Serialised (NestedCtxt Header (HardForkBlock '[blk])))
-> SerialisedHeader (HardForkBlock '[blk])
-> GenDepPair Serialised (NestedCtxt Header blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialisedHeader (HardForkBlock '[blk])
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock '[blk]))
forall blk.
SerialisedHeader blk
-> GenDepPair Serialised (NestedCtxt Header blk)
serialisedHeaderToDepPair

  inject :: forall blk.
NoHardForks blk =>
SerialisedHeader blk -> SerialisedHeader (HardForkBlock '[blk])
inject =
        GenDepPair Serialised (NestedCtxt Header (HardForkBlock '[blk]))
-> SerialisedHeader (HardForkBlock '[blk])
forall blk.
GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
SerialisedHeaderFromDepPair
      (GenDepPair Serialised (NestedCtxt Header (HardForkBlock '[blk]))
 -> SerialisedHeader (HardForkBlock '[blk]))
-> (SerialisedHeader blk
    -> GenDepPair
         Serialised (NestedCtxt Header (HardForkBlock '[blk])))
-> SerialisedHeader blk
-> SerialisedHeader (HardForkBlock '[blk])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 NestedCtxt Header blk a
 -> NestedCtxt Header (HardForkBlock '[blk]) a)
-> GenDepPair Serialised (NestedCtxt Header blk)
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock '[blk]))
forall (f :: * -> *) (f' :: * -> *) (g :: * -> *).
(forall a. f a -> f' a) -> GenDepPair g f -> GenDepPair g f'
depPairFirst NestedCtxt Header blk a
-> NestedCtxt Header (HardForkBlock '[blk]) a
forall a.
NestedCtxt Header blk a
-> NestedCtxt Header (HardForkBlock '[blk]) a
forall (f :: * -> *) blk a.
NestedCtxt f blk a -> NestedCtxt f (HardForkBlock '[blk]) a
injNestedCtxt
      (GenDepPair Serialised (NestedCtxt Header blk)
 -> GenDepPair
      Serialised (NestedCtxt Header (HardForkBlock '[blk])))
-> (SerialisedHeader blk
    -> GenDepPair Serialised (NestedCtxt Header blk))
-> SerialisedHeader blk
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock '[blk]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialisedHeader blk
-> GenDepPair Serialised (NestedCtxt Header blk)
forall blk.
SerialisedHeader blk
-> GenDepPair Serialised (NestedCtxt Header blk)
serialisedHeaderToDepPair

{-------------------------------------------------------------------------------
  Dependent types

  TODO: Class?
-------------------------------------------------------------------------------}

-- | Project 'BlockQuery'
--
-- Not an instance of 'Isomorphic' because the types change.
projQuery :: BlockQuery (HardForkBlock '[b]) result
          -> (forall result'.
                  (result :~: HardForkQueryResult '[b] result')
               -> BlockQuery b result'
               -> a)
          -> a
projQuery :: forall b result a.
BlockQuery (HardForkBlock '[b]) result
-> (forall result'.
    (result :~: HardForkQueryResult '[b] result')
    -> BlockQuery b result' -> a)
-> a
projQuery BlockQuery (HardForkBlock '[b]) result
qry forall result'.
(result :~: HardForkQueryResult '[b] result')
-> BlockQuery b result' -> a
k =
    BlockQuery (HardForkBlock '[b]) result
-> (forall result'.
    (result :~: HardForkQueryResult '[b] result')
    -> QueryIfCurrent '[b] result' -> a)
-> (forall x' (xs' :: [*]).
    ('[b] :~: (x' : xs'))
    -> ProofNonEmpty xs' -> QueryAnytime result -> EraIndex '[b] -> a)
-> (forall x' (xs' :: [*]).
    ('[b] :~: (x' : xs'))
    -> ProofNonEmpty xs' -> QueryHardFork '[b] result -> a)
-> a
forall (xs :: [*]) result r.
BlockQuery (HardForkBlock xs) result
-> (forall result'.
    (result :~: HardForkQueryResult xs result')
    -> QueryIfCurrent xs result' -> r)
-> (forall x' (xs' :: [*]).
    (xs :~: (x' : xs'))
    -> ProofNonEmpty xs' -> QueryAnytime result -> EraIndex xs -> r)
-> (forall x' (xs' :: [*]).
    (xs :~: (x' : xs'))
    -> ProofNonEmpty xs' -> QueryHardFork xs result -> r)
-> r
getHardForkQuery
      BlockQuery (HardForkBlock '[b]) result
qry
      (\result :~: HardForkQueryResult '[b] result'
Refl -> (result :~: HardForkQueryResult '[b] result')
-> BlockQuery b result' -> a
forall result'.
(result :~: HardForkQueryResult '[b] result')
-> BlockQuery b result' -> a
k result :~: result
result :~: HardForkQueryResult '[b] result'
forall {k} (a :: k). a :~: a
Refl (BlockQuery b result' -> a)
-> (QueryIfCurrent '[b] result' -> BlockQuery b result')
-> QueryIfCurrent '[b] result'
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryIfCurrent '[b] result' -> BlockQuery b result'
forall b result. QueryIfCurrent '[b] result -> BlockQuery b result
aux)
      (\'[b] :~: (x' : xs')
Refl ProofNonEmpty xs'
prfNonEmpty QueryAnytime result
_ EraIndex '[b]
_ -> case ProofNonEmpty xs'
prfNonEmpty of {})
      (\'[b] :~: (x' : xs')
Refl ProofNonEmpty xs'
prfNonEmpty QueryHardFork '[b] result
_   -> case ProofNonEmpty xs'
prfNonEmpty of {})
  where
    aux :: QueryIfCurrent '[b] result -> BlockQuery b result
    aux :: forall b result. QueryIfCurrent '[b] result -> BlockQuery b result
aux (QZ BlockQuery x result
q) = BlockQuery b result
BlockQuery x result
q
    aux (QS QueryIfCurrent xs result
q) = case QueryIfCurrent xs result
q of {}

projQuery' :: BlockQuery (HardForkBlock '[b]) result
           -> ProjHardForkQuery b result
projQuery' :: forall b result.
BlockQuery (HardForkBlock '[b]) result
-> ProjHardForkQuery b result
projQuery' BlockQuery (HardForkBlock '[b]) result
qry = BlockQuery (HardForkBlock '[b]) result
-> (forall {result'}.
    (result :~: HardForkQueryResult '[b] result')
    -> BlockQuery b result' -> ProjHardForkQuery b result)
-> ProjHardForkQuery b result
forall b result a.
BlockQuery (HardForkBlock '[b]) result
-> (forall result'.
    (result :~: HardForkQueryResult '[b] result')
    -> BlockQuery b result' -> a)
-> a
projQuery BlockQuery (HardForkBlock '[b]) result
qry ((forall {result'}.
  (result :~: HardForkQueryResult '[b] result')
  -> BlockQuery b result' -> ProjHardForkQuery b result)
 -> ProjHardForkQuery b result)
-> (forall {result'}.
    (result :~: HardForkQueryResult '[b] result')
    -> BlockQuery b result' -> ProjHardForkQuery b result)
-> ProjHardForkQuery b result
forall a b. (a -> b) -> a -> b
$ \result :~: HardForkQueryResult '[b] result'
Refl -> BlockQuery b result' -> ProjHardForkQuery b result
BlockQuery b result'
-> ProjHardForkQuery b (HardForkQueryResult '[b] result')
forall b result'.
BlockQuery b result'
-> ProjHardForkQuery b (HardForkQueryResult '[b] result')
ProjHardForkQuery

data ProjHardForkQuery b :: Type -> Type where
  ProjHardForkQuery ::
       BlockQuery b result'
    -> ProjHardForkQuery b (HardForkQueryResult '[b] result')

-- | Inject 'BlockQuery'
--
-- Not an instance of 'Isomorphic' because the types change.
injQuery :: BlockQuery b result
         -> BlockQuery (HardForkBlock '[b]) (HardForkQueryResult '[b] result)
injQuery :: forall b result.
BlockQuery b result
-> BlockQuery
     (HardForkBlock '[b]) (HardForkQueryResult '[b] result)
injQuery = QueryIfCurrent '[b] result
-> BlockQuery
     (HardForkBlock '[b]) (Either (MismatchEraInfo '[b]) result)
forall (xs :: [*]) result.
QueryIfCurrent xs result
-> BlockQuery
     (HardForkBlock xs) (Either (MismatchEraInfo xs) result)
QueryIfCurrent (QueryIfCurrent '[b] result
 -> BlockQuery
      (HardForkBlock '[b]) (Either (MismatchEraInfo '[b]) result))
-> (BlockQuery b result -> QueryIfCurrent '[b] result)
-> BlockQuery b result
-> BlockQuery
     (HardForkBlock '[b]) (Either (MismatchEraInfo '[b]) result)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockQuery b result -> QueryIfCurrent '[b] result
forall x b (xs :: [*]). BlockQuery x b -> QueryIfCurrent (x : xs) b
QZ

projQueryResult :: HardForkQueryResult '[b] result -> result
projQueryResult :: forall b result. HardForkQueryResult '[b] result -> result
projQueryResult (Left  MismatchEraInfo '[b]
err)    = Void -> result
forall a. Void -> a
absurd (Void -> result) -> Void -> result
forall a b. (a -> b) -> a -> b
$ MismatchEraInfo '[b] -> Void
forall b. MismatchEraInfo '[b] -> Void
mismatchOneEra MismatchEraInfo '[b]
err
projQueryResult (Right result
result) = result
result

injQueryResult :: result -> HardForkQueryResult '[b] result
injQueryResult :: forall result b. result -> HardForkQueryResult '[b] result
injQueryResult = result -> Either (MismatchEraInfo '[b]) result
forall a b. b -> Either a b
Right

projNestedCtxt :: NestedCtxt f (HardForkBlock '[blk]) a -> NestedCtxt f blk a
projNestedCtxt :: forall (f :: * -> *) blk a.
NestedCtxt f (HardForkBlock '[blk]) a -> NestedCtxt f blk a
projNestedCtxt = NestedCtxt_ blk f a -> NestedCtxt f blk a
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_ blk f a -> NestedCtxt f blk a)
-> (NestedCtxt f (HardForkBlock '[blk]) a -> NestedCtxt_ blk f a)
-> NestedCtxt f (HardForkBlock '[blk]) a
-> NestedCtxt f blk a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedCtxt_ (HardForkBlock '[blk]) f a -> NestedCtxt_ blk f a
forall blk (f :: * -> *) a.
NestedCtxt_ (HardForkBlock '[blk]) f a -> NestedCtxt_ blk f a
aux (NestedCtxt_ (HardForkBlock '[blk]) f a -> NestedCtxt_ blk f a)
-> (NestedCtxt f (HardForkBlock '[blk]) a
    -> NestedCtxt_ (HardForkBlock '[blk]) f a)
-> NestedCtxt f (HardForkBlock '[blk]) a
-> NestedCtxt_ blk f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedCtxt f (HardForkBlock '[blk]) a
-> NestedCtxt_ (HardForkBlock '[blk]) f a
forall (f :: * -> *) blk a.
NestedCtxt f blk a -> NestedCtxt_ blk f a
flipNestedCtxt
  where
    aux :: NestedCtxt_ (HardForkBlock '[blk]) f a -> NestedCtxt_ blk f a
    aux :: forall blk (f :: * -> *) a.
NestedCtxt_ (HardForkBlock '[blk]) f a -> NestedCtxt_ blk f a
aux (NCZ NestedCtxt_ x f a
ctxt) = NestedCtxt_ blk f a
NestedCtxt_ x f a
ctxt

injNestedCtxt :: NestedCtxt f blk a -> NestedCtxt f (HardForkBlock '[blk]) a
injNestedCtxt :: forall (f :: * -> *) blk a.
NestedCtxt f blk a -> NestedCtxt f (HardForkBlock '[blk]) a
injNestedCtxt = NestedCtxt_ (HardForkBlock '[blk]) f a
-> NestedCtxt f (HardForkBlock '[blk]) a
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_ (HardForkBlock '[blk]) f a
 -> NestedCtxt f (HardForkBlock '[blk]) a)
-> (NestedCtxt f blk a -> NestedCtxt_ (HardForkBlock '[blk]) f a)
-> NestedCtxt f blk a
-> NestedCtxt f (HardForkBlock '[blk]) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedCtxt_ blk f a -> NestedCtxt_ (HardForkBlock '[blk]) f a
forall x (a :: * -> *) b (xs1 :: [*]).
NestedCtxt_ x a b -> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCZ (NestedCtxt_ blk f a -> NestedCtxt_ (HardForkBlock '[blk]) f a)
-> (NestedCtxt f blk a -> NestedCtxt_ blk f a)
-> NestedCtxt f blk a
-> NestedCtxt_ (HardForkBlock '[blk]) f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedCtxt f blk a -> NestedCtxt_ blk f a
forall (f :: * -> *) blk a.
NestedCtxt f blk a -> NestedCtxt_ blk f a
flipNestedCtxt