{-# LANGUAGE DataKinds               #-}
{-# LANGUAGE EmptyCase               #-}
{-# LANGUAGE FlexibleContexts        #-}
{-# LANGUAGE GADTs                   #-}
{-# LANGUAGE KindSignatures          #-}
{-# LANGUAGE LambdaCase              #-}
{-# LANGUAGE OverloadedStrings       #-}
{-# LANGUAGE RankNTypes              #-}
{-# LANGUAGE RecordWildCards         #-}
{-# LANGUAGE ScopedTypeVariables     #-}
{-# LANGUAGE StandaloneDeriving      #-}
{-# LANGUAGE TypeApplications        #-}
{-# LANGUAGE TypeFamilies            #-}
{-# LANGUAGE TypeOperators           #-}
{-# LANGUAGE UndecidableInstances    #-}
{-# LANGUAGE UndecidableSuperClasses #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common (
    -- * Conditions required by the HFC to support serialisation
    HardForkEncoderException (..)
  , SerialiseConstraintsHFC
  , SerialiseHFC (..)
  , disabledEraException
  , futureEraException
  , pSHFC
    -- * Distinguish first era from the rest
  , FirstEra
  , LaterEra
  , isFirstEra
  , notFirstEra
    -- * Versioning
  , EraNodeToClientVersion (..)
  , EraNodeToNodeVersion (..)
  , HardForkNodeToClientVersion (..)
  , HardForkNodeToNodeVersion (..)
  , HardForkSpecificNodeToClientVersion (..)
  , HardForkSpecificNodeToNodeVersion (..)
  , isHardForkNodeToClientEnabled
  , isHardForkNodeToNodeEnabled
    -- * Dealing with annotations
  , AnnDecoder (..)
    -- * Serialisation of telescopes
  , decodeTelescope
  , encodeTelescope
    -- * Serialisation of sums
  , decodeAnnNS
  , decodeNS
  , encodeNS
    -- * Dependent serialisation
  , decodeNested
  , decodeNestedCtxt
  , encodeNested
  , encodeNestedCtxt
    -- * MismatchEraInfo
  , decodeEitherMismatch
  , encodeEitherMismatch
    -- * Distributive properties
  , distribAnnTip
  , distribQueryIfCurrent
  , distribSerialisedHeader
  , undistribAnnTip
  , undistribQueryIfCurrent
  , undistribSerialisedHeader
    -- * Deriving-via support for tests
  , SerialiseNS (..)
  ) where

import           Codec.CBOR.Decoding (Decoder)
import qualified Codec.CBOR.Decoding as Dec
import           Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as Enc
import           Codec.Serialise (Serialise)
import qualified Codec.Serialise as Serialise
import           Control.Exception (Exception, throw)
import qualified Data.ByteString.Lazy as Lazy
import           Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as Short
import           Data.Kind (Type)
import           Data.SOP.Strict
import           Data.Word

import           Cardano.Binary (enforceSize)

import           Ouroboros.Network.Block (Serialised)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Node.Run
import           Ouroboros.Consensus.Node.Serialisation (Some (..))
import           Ouroboros.Consensus.Storage.Serialisation
import           Ouroboros.Consensus.Util.SOP

import           Ouroboros.Consensus.HardFork.Combinator.Abstract
import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import           Ouroboros.Consensus.HardFork.Combinator.Basics
import           Ouroboros.Consensus.HardFork.Combinator.Block
import           Ouroboros.Consensus.HardFork.Combinator.Info
import           Ouroboros.Consensus.HardFork.Combinator.Ledger.Query
import           Ouroboros.Consensus.HardFork.Combinator.State
import           Ouroboros.Consensus.HardFork.Combinator.State.Instances
import qualified Ouroboros.Consensus.HardFork.Combinator.Util.Match as Match
import           Ouroboros.Consensus.HardFork.Combinator.Util.Telescope
                     (SimpleTelescope (..), Telescope (..))
import qualified Ouroboros.Consensus.HardFork.Combinator.Util.Telescope as Telescope

{-------------------------------------------------------------------------------
  Distinguish between the first era and all others
-------------------------------------------------------------------------------}

type family FirstEra (xs :: [Type]) where
  FirstEra (x ': xs) = x

type family LaterEra (xs :: [Type]) where
  LaterEra (x ': xs) = xs

isFirstEra :: forall f xs. All SingleEraBlock xs
           => NS f xs
           -> Either (NS SingleEraInfo (LaterEra xs)) (f (FirstEra xs))
isFirstEra :: NS f xs
-> Either (NS SingleEraInfo (LaterEra xs)) (f (FirstEra xs))
isFirstEra (Z f x
x) = f x -> Either (NS SingleEraInfo xs) (f x)
forall a b. b -> Either a b
Right f x
x
isFirstEra (S NS f xs
x) = NS SingleEraInfo xs -> Either (NS SingleEraInfo xs) (f x)
forall a b. a -> Either a b
Left (Proxy SingleEraBlock
-> (forall a. SingleEraBlock a => f a -> SingleEraInfo a)
-> NS f xs
-> NS SingleEraInfo xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle forall a. SingleEraBlock a => f a -> SingleEraInfo a
aux NS f xs
x)
  where
    aux :: forall blk. SingleEraBlock blk => f blk -> SingleEraInfo blk
    aux :: f blk -> SingleEraInfo blk
aux f blk
_ = Proxy blk -> SingleEraInfo blk
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
singleEraInfo (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk)

-- | Used to construct 'FutureEraException'
notFirstEra :: All SingleEraBlock xs
            => NS f xs -- ^ 'NS' intended to be from a future era
            -> NS SingleEraInfo xs
notFirstEra :: NS f xs -> NS SingleEraInfo xs
notFirstEra = Proxy SingleEraBlock
-> (forall a. SingleEraBlock a => f a -> SingleEraInfo a)
-> NS f xs
-> NS SingleEraInfo xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle forall a. SingleEraBlock a => f a -> SingleEraInfo a
forall (f :: * -> *) blk.
SingleEraBlock blk =>
f blk -> SingleEraInfo blk
aux
  where
    aux :: forall f blk. SingleEraBlock blk => f blk -> SingleEraInfo blk
    aux :: f blk -> SingleEraInfo blk
aux f blk
_ = Proxy blk -> SingleEraInfo blk
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
singleEraInfo (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk)

{-------------------------------------------------------------------------------
  Versioning
-------------------------------------------------------------------------------}

-- | Versioning of the specific additions made by the HFC to the @NodeToNode@
-- protocols, e.g., the era tag.
data HardForkSpecificNodeToNodeVersion =
    HardForkSpecificNodeToNodeVersion1
  deriving (HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
(HardForkSpecificNodeToNodeVersion
 -> HardForkSpecificNodeToNodeVersion -> Bool)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion -> Bool)
-> Eq HardForkSpecificNodeToNodeVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
$c/= :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
== :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
$c== :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
Eq, Eq HardForkSpecificNodeToNodeVersion
Eq HardForkSpecificNodeToNodeVersion
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion -> Ordering)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion -> Bool)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion -> Bool)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion -> Bool)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion -> Bool)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion)
-> Ord HardForkSpecificNodeToNodeVersion
HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Ordering
HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
$cmin :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
max :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
$cmax :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
>= :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
$c>= :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
> :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
$c> :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
<= :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
$c<= :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
< :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
$c< :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
compare :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Ordering
$ccompare :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Ordering
$cp1Ord :: Eq HardForkSpecificNodeToNodeVersion
Ord, Int -> HardForkSpecificNodeToNodeVersion -> ShowS
[HardForkSpecificNodeToNodeVersion] -> ShowS
HardForkSpecificNodeToNodeVersion -> String
(Int -> HardForkSpecificNodeToNodeVersion -> ShowS)
-> (HardForkSpecificNodeToNodeVersion -> String)
-> ([HardForkSpecificNodeToNodeVersion] -> ShowS)
-> Show HardForkSpecificNodeToNodeVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HardForkSpecificNodeToNodeVersion] -> ShowS
$cshowList :: [HardForkSpecificNodeToNodeVersion] -> ShowS
show :: HardForkSpecificNodeToNodeVersion -> String
$cshow :: HardForkSpecificNodeToNodeVersion -> String
showsPrec :: Int -> HardForkSpecificNodeToNodeVersion -> ShowS
$cshowsPrec :: Int -> HardForkSpecificNodeToNodeVersion -> ShowS
Show, Int -> HardForkSpecificNodeToNodeVersion
HardForkSpecificNodeToNodeVersion -> Int
HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
(HardForkSpecificNodeToNodeVersion
 -> HardForkSpecificNodeToNodeVersion)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion)
-> (Int -> HardForkSpecificNodeToNodeVersion)
-> (HardForkSpecificNodeToNodeVersion -> Int)
-> (HardForkSpecificNodeToNodeVersion
    -> [HardForkSpecificNodeToNodeVersion])
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion
    -> [HardForkSpecificNodeToNodeVersion])
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion
    -> [HardForkSpecificNodeToNodeVersion])
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion
    -> [HardForkSpecificNodeToNodeVersion])
-> Enum HardForkSpecificNodeToNodeVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
$cenumFromThenTo :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
enumFromTo :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
$cenumFromTo :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
enumFromThen :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
$cenumFromThen :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
enumFrom :: HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
$cenumFrom :: HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
fromEnum :: HardForkSpecificNodeToNodeVersion -> Int
$cfromEnum :: HardForkSpecificNodeToNodeVersion -> Int
toEnum :: Int -> HardForkSpecificNodeToNodeVersion
$ctoEnum :: Int -> HardForkSpecificNodeToNodeVersion
pred :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
$cpred :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
succ :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
$csucc :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
Enum, HardForkSpecificNodeToNodeVersion
HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> Bounded HardForkSpecificNodeToNodeVersion
forall a. a -> a -> Bounded a
maxBound :: HardForkSpecificNodeToNodeVersion
$cmaxBound :: HardForkSpecificNodeToNodeVersion
minBound :: HardForkSpecificNodeToNodeVersion
$cminBound :: HardForkSpecificNodeToNodeVersion
Bounded)

-- | Versioning of the specific additions made by the HFC to the @NodeToClient@
-- protocols, e.g., the era tag or the hard-fork specific queries.
data HardForkSpecificNodeToClientVersion =
    HardForkSpecificNodeToClientVersion1

    -- | Enable the 'GetCurrentEra' query in 'QueryHardFork'.
  | HardForkSpecificNodeToClientVersion2
  deriving (HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
(HardForkSpecificNodeToClientVersion
 -> HardForkSpecificNodeToClientVersion -> Bool)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion -> Bool)
-> Eq HardForkSpecificNodeToClientVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
$c/= :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
== :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
$c== :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
Eq, Eq HardForkSpecificNodeToClientVersion
Eq HardForkSpecificNodeToClientVersion
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion -> Ordering)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion -> Bool)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion -> Bool)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion -> Bool)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion -> Bool)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion)
-> Ord HardForkSpecificNodeToClientVersion
HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Ordering
HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
$cmin :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
max :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
$cmax :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
>= :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
$c>= :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
> :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
$c> :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
<= :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
$c<= :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
< :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
$c< :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
compare :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Ordering
$ccompare :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Ordering
$cp1Ord :: Eq HardForkSpecificNodeToClientVersion
Ord, Int -> HardForkSpecificNodeToClientVersion -> ShowS
[HardForkSpecificNodeToClientVersion] -> ShowS
HardForkSpecificNodeToClientVersion -> String
(Int -> HardForkSpecificNodeToClientVersion -> ShowS)
-> (HardForkSpecificNodeToClientVersion -> String)
-> ([HardForkSpecificNodeToClientVersion] -> ShowS)
-> Show HardForkSpecificNodeToClientVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HardForkSpecificNodeToClientVersion] -> ShowS
$cshowList :: [HardForkSpecificNodeToClientVersion] -> ShowS
show :: HardForkSpecificNodeToClientVersion -> String
$cshow :: HardForkSpecificNodeToClientVersion -> String
showsPrec :: Int -> HardForkSpecificNodeToClientVersion -> ShowS
$cshowsPrec :: Int -> HardForkSpecificNodeToClientVersion -> ShowS
Show, Int -> HardForkSpecificNodeToClientVersion
HardForkSpecificNodeToClientVersion -> Int
HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
(HardForkSpecificNodeToClientVersion
 -> HardForkSpecificNodeToClientVersion)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion)
-> (Int -> HardForkSpecificNodeToClientVersion)
-> (HardForkSpecificNodeToClientVersion -> Int)
-> (HardForkSpecificNodeToClientVersion
    -> [HardForkSpecificNodeToClientVersion])
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion
    -> [HardForkSpecificNodeToClientVersion])
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion
    -> [HardForkSpecificNodeToClientVersion])
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion
    -> [HardForkSpecificNodeToClientVersion])
-> Enum HardForkSpecificNodeToClientVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
$cenumFromThenTo :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
enumFromTo :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
$cenumFromTo :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
enumFromThen :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
$cenumFromThen :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
enumFrom :: HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
$cenumFrom :: HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
fromEnum :: HardForkSpecificNodeToClientVersion -> Int
$cfromEnum :: HardForkSpecificNodeToClientVersion -> Int
toEnum :: Int -> HardForkSpecificNodeToClientVersion
$ctoEnum :: Int -> HardForkSpecificNodeToClientVersion
pred :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
$cpred :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
succ :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
$csucc :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
Enum, HardForkSpecificNodeToClientVersion
HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> Bounded HardForkSpecificNodeToClientVersion
forall a. a -> a -> Bounded a
maxBound :: HardForkSpecificNodeToClientVersion
$cmaxBound :: HardForkSpecificNodeToClientVersion
minBound :: HardForkSpecificNodeToClientVersion
$cminBound :: HardForkSpecificNodeToClientVersion
Bounded)

data HardForkNodeToNodeVersion xs where
  -- | Disable the HFC
  --
  -- This means that only the first era (@x@) is supported, and moreover, is
  -- compatible with serialisation used if the HFC would not be present at all.
  HardForkNodeToNodeDisabled ::
       BlockNodeToNodeVersion x
    -> HardForkNodeToNodeVersion (x ': xs)

  -- | Enable the HFC
  --
  -- Each era can be enabled or disabled individually by passing
  -- 'EraNodeToNodeDisabled' as its configuration, but serialised values will
  -- always include tags inserted by the HFC to distinguish one era from
  -- another. We also version the hard-fork specific parts with
  -- 'HardForkSpecificNodeToNodeVersion'.
  HardForkNodeToNodeEnabled ::
       HardForkSpecificNodeToNodeVersion
    -> NP EraNodeToNodeVersion xs
    -> HardForkNodeToNodeVersion xs

data HardForkNodeToClientVersion xs where
  -- | Disable the HFC
  --
  -- See 'HardForkNodeToNodeDisabled'
  HardForkNodeToClientDisabled ::
       BlockNodeToClientVersion x
    -> HardForkNodeToClientVersion (x ': xs)

  -- | Enable the HFC
  --
  -- See 'HardForkNodeToNodeEnabled'
  HardForkNodeToClientEnabled ::
       HardForkSpecificNodeToClientVersion
    -> NP EraNodeToClientVersion xs
    -> HardForkNodeToClientVersion xs

data EraNodeToNodeVersion blk =
    EraNodeToNodeEnabled !(BlockNodeToNodeVersion blk)
  | EraNodeToNodeDisabled

data EraNodeToClientVersion blk =
    EraNodeToClientEnabled !(BlockNodeToClientVersion blk)
  | EraNodeToClientDisabled

deriving instance Show (BlockNodeToNodeVersion   blk) => Show (EraNodeToNodeVersion   blk)
deriving instance Show (BlockNodeToClientVersion blk) => Show (EraNodeToClientVersion blk)

deriving instance Eq (BlockNodeToNodeVersion   blk) => Eq (EraNodeToNodeVersion   blk)
deriving instance Eq (BlockNodeToClientVersion blk) => Eq (EraNodeToClientVersion blk)

deriving instance SerialiseHFC xs => Show (HardForkNodeToNodeVersion xs)
deriving instance SerialiseHFC xs => Show (HardForkNodeToClientVersion xs)

deriving instance SerialiseHFC xs => Eq (HardForkNodeToNodeVersion xs)
deriving instance SerialiseHFC xs => Eq (HardForkNodeToClientVersion xs)

instance SerialiseHFC xs => HasNetworkProtocolVersion (HardForkBlock xs) where
  type BlockNodeToNodeVersion   (HardForkBlock xs) = HardForkNodeToNodeVersion   xs
  type BlockNodeToClientVersion (HardForkBlock xs) = HardForkNodeToClientVersion xs

isHardForkNodeToNodeEnabled :: HardForkNodeToNodeVersion xs -> Bool
isHardForkNodeToNodeEnabled :: HardForkNodeToNodeVersion xs -> Bool
isHardForkNodeToNodeEnabled HardForkNodeToNodeEnabled {} = Bool
True
isHardForkNodeToNodeEnabled HardForkNodeToNodeVersion xs
_                            = Bool
False

isHardForkNodeToClientEnabled :: HardForkNodeToClientVersion xs -> Bool
isHardForkNodeToClientEnabled :: HardForkNodeToClientVersion xs -> Bool
isHardForkNodeToClientEnabled HardForkNodeToClientEnabled {} = Bool
True
isHardForkNodeToClientEnabled HardForkNodeToClientVersion xs
_                              = Bool
False

{-------------------------------------------------------------------------------
  Conditions required by the HFC to support serialisation
-------------------------------------------------------------------------------}

class ( SingleEraBlock                   blk
      , SerialiseDiskConstraints         blk
      , SerialiseNodeToNodeConstraints   blk
      , SerialiseNodeToClientConstraints blk
      , HasNetworkProtocolVersion        blk
      ) => SerialiseConstraintsHFC       blk

pSHFC :: Proxy SerialiseConstraintsHFC
pSHFC :: Proxy SerialiseConstraintsHFC
pSHFC = Proxy SerialiseConstraintsHFC
forall k (t :: k). Proxy t
Proxy

-- | Conditions required by the HFC to provide serialisation
--
-- NOTE: Compatibility between HFC enabled and disabled:
--
-- 1. Node-to-node and node-to-client communication is versioned. When the HFC
--    is disabled, we default to the instances for the first era, and so
--    compatibility is preserved by construction.
--
-- 2. On-disk storage is /not/ versioned, and here we make no attempt to be
--    compatible between non-HFC and HFC deployments, /except/ for blocks: we
--    define two methods 'encodeDiskHfcBlock' and 'decodeDiskHfcBlock' which
--    are used for on-disk serialisation of blocks. These methods have
--    defaults which can and probably should be used for deployments that use
--    the HFC from the get-go, but for deployments that only later change to use
--    the HFC these functions can be overriden to provide an on-disk storage
--    format for HFC blocks that is compatible with the on-disk storage of
--    blocks from the first era.
--
-- 3. The converse is NOT supported. Deployments that use the HFC from the start
--    should not use 'HardForkNodeToNodeDisabled' and/or
--    'HardForkNodeToClientDisabled'. Doing so would result in opposite
--    compatibility problems: the on-disk block would include the HFC tag, but
--    sending blocks with the HFC disabled suggests that that tag is unexpected.
--    This would then lead to problems with binary streaming, and we do not
--    currently provide any provisions to resolve these.
class ( CanHardFork xs
      , All SerialiseConstraintsHFC xs
        -- Required for HasNetworkProtocolVersion
      , All (Compose Show EraNodeToNodeVersion)   xs
      , All (Compose Eq   EraNodeToNodeVersion)   xs
      , All (Compose Show EraNodeToClientVersion) xs
      , All (Compose Eq   EraNodeToClientVersion) xs
        -- Required for 'encodeNestedCtxt'/'decodeNestedCtxt'
      , All (EncodeDiskDepIx (NestedCtxt Header)) xs
      , All (DecodeDiskDepIx (NestedCtxt Header)) xs
        -- Required for 'getHfcBinaryBlockInfo'
      , All HasBinaryBlockInfo xs
      ) => SerialiseHFC xs where

  encodeDiskHfcBlock :: CodecConfig (HardForkBlock xs)
                     -> HardForkBlock xs -> Encoding
  encodeDiskHfcBlock CodecConfig (HardForkBlock xs)
cfg =
        NP (I -.-> K Encoding) xs -> NS I xs -> Encoding
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
NP (f -.-> K Encoding) xs -> NS f xs -> Encoding
encodeNS (Proxy SerialiseConstraintsHFC
-> (forall a.
    SerialiseConstraintsHFC a =>
    CodecConfig a -> (-.->) I (K Encoding) a)
-> NP CodecConfig xs
-> NP (I -.-> K Encoding) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SerialiseConstraintsHFC
pSHFC ((I a -> K Encoding a) -> (-.->) I (K Encoding) a
forall k (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn ((I a -> K Encoding a) -> (-.->) I (K Encoding) a)
-> (CodecConfig a -> I a -> K Encoding a)
-> CodecConfig a
-> (-.->) I (K Encoding) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Encoding) -> I a -> K Encoding a
forall k a b (c :: k). (a -> b) -> I a -> K b c
mapIK ((a -> Encoding) -> I a -> K Encoding a)
-> (CodecConfig a -> a -> Encoding)
-> CodecConfig a
-> I a
-> K Encoding a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodecConfig a -> a -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk) NP CodecConfig xs
cfgs)
      (NS I xs -> Encoding)
-> (HardForkBlock xs -> NS I xs) -> HardForkBlock xs -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OneEraBlock xs -> NS I xs
forall (xs :: [*]). OneEraBlock xs -> NS I xs
getOneEraBlock (OneEraBlock xs -> NS I xs)
-> (HardForkBlock xs -> OneEraBlock xs)
-> HardForkBlock xs
-> NS I xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkBlock xs -> OneEraBlock xs
forall (xs :: [*]). HardForkBlock xs -> OneEraBlock xs
getHardForkBlock)
    where
      cfgs :: NP CodecConfig xs
cfgs = PerEraCodecConfig xs -> NP CodecConfig xs
forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs
getPerEraCodecConfig (CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra CodecConfig (HardForkBlock xs)
cfg)

  decodeDiskHfcBlock :: CodecConfig (HardForkBlock xs)
                     -> forall s. Decoder s (Lazy.ByteString -> HardForkBlock xs)
  decodeDiskHfcBlock CodecConfig (HardForkBlock xs)
cfg =
        ((ByteString -> NS I xs) -> ByteString -> HardForkBlock xs)
-> Decoder s (ByteString -> NS I xs)
-> Decoder s (ByteString -> HardForkBlock xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ByteString -> NS I xs
f -> OneEraBlock xs -> HardForkBlock xs
forall (xs :: [*]). OneEraBlock xs -> HardForkBlock xs
HardForkBlock (OneEraBlock xs -> HardForkBlock xs)
-> (ByteString -> OneEraBlock xs) -> ByteString -> HardForkBlock xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS I xs -> OneEraBlock xs
forall (xs :: [*]). NS I xs -> OneEraBlock xs
OneEraBlock (NS I xs -> OneEraBlock xs)
-> (ByteString -> NS I xs) -> ByteString -> OneEraBlock xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> NS I xs
f)
      (Decoder s (ByteString -> NS I xs)
 -> Decoder s (ByteString -> HardForkBlock xs))
-> Decoder s (ByteString -> NS I xs)
-> Decoder s (ByteString -> HardForkBlock xs)
forall a b. (a -> b) -> a -> b
$ NP (AnnDecoder I) xs -> forall s. Decoder s (ByteString -> NS I xs)
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
NP (AnnDecoder f) xs -> forall s. Decoder s (ByteString -> NS f xs)
decodeAnnNS (Proxy SerialiseConstraintsHFC
-> (forall a.
    SerialiseConstraintsHFC a =>
    CodecConfig a -> AnnDecoder I a)
-> NP CodecConfig xs
-> NP (AnnDecoder I) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SerialiseConstraintsHFC
pSHFC forall blk.
SerialiseDiskConstraints blk =>
CodecConfig blk -> AnnDecoder I blk
forall a.
SerialiseConstraintsHFC a =>
CodecConfig a -> AnnDecoder I a
aux NP CodecConfig xs
cfgs)
    where
      cfgs :: NP CodecConfig xs
cfgs = PerEraCodecConfig xs -> NP CodecConfig xs
forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs
getPerEraCodecConfig (CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra CodecConfig (HardForkBlock xs)
cfg)

      aux :: SerialiseDiskConstraints blk
          => CodecConfig blk -> AnnDecoder I blk
      aux :: CodecConfig blk -> AnnDecoder I blk
aux CodecConfig blk
cfg' = (forall s. Decoder s (ByteString -> I blk)) -> AnnDecoder I blk
forall (f :: * -> *) blk.
(forall s. Decoder s (ByteString -> f blk)) -> AnnDecoder f blk
AnnDecoder ((forall s. Decoder s (ByteString -> I blk)) -> AnnDecoder I blk)
-> (forall s. Decoder s (ByteString -> I blk)) -> AnnDecoder I blk
forall a b. (a -> b) -> a -> b
$ (\ByteString -> blk
f -> blk -> I blk
forall a. a -> I a
I (blk -> I blk) -> (ByteString -> blk) -> ByteString -> I blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> blk
f) ((ByteString -> blk) -> ByteString -> I blk)
-> Decoder s (ByteString -> blk) -> Decoder s (ByteString -> I blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig blk -> forall s. Decoder s (ByteString -> blk)
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig blk
cfg'

  -- | Used as the implementation of 'reconstructPrefixLen' for
  -- 'HardForkBlock'.
  reconstructHfcPrefixLen :: proxy (Header (HardForkBlock xs)) -> PrefixLen
  reconstructHfcPrefixLen proxy (Header (HardForkBlock xs))
_ =
      -- We insert two bytes at the front
      Word8
2 Word8 -> PrefixLen -> PrefixLen
`addPrefixLen` [PrefixLen] -> PrefixLen
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (NP (K PrefixLen) xs -> CollapseTo NP PrefixLen
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse NP (K PrefixLen) xs
perEra)
    where
      perEra :: NP (K PrefixLen) xs
      perEra :: NP (K PrefixLen) xs
perEra = Proxy SingleEraBlock
-> (forall a. SingleEraBlock a => K PrefixLen a)
-> NP (K PrefixLen) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
hcpure Proxy SingleEraBlock
proxySingle forall a. SingleEraBlock a => K PrefixLen a
reconstructOne

      reconstructOne :: forall blk. SingleEraBlock blk
                     => K PrefixLen blk
      reconstructOne :: K PrefixLen blk
reconstructOne = PrefixLen -> K PrefixLen blk
forall k a (b :: k). a -> K a b
K (PrefixLen -> K PrefixLen blk) -> PrefixLen -> K PrefixLen blk
forall a b. (a -> b) -> a -> b
$ Proxy (Header blk) -> PrefixLen
forall (f :: * -> *) blk (proxy :: * -> *).
ReconstructNestedCtxt f blk =>
proxy (f blk) -> PrefixLen
reconstructPrefixLen (Proxy (Header blk)
forall k (t :: k). Proxy t
Proxy @(Header blk))

  -- | Used as the implementation of 'reconstructNestedCtxt' for
  -- 'HardForkBlock'.
  reconstructHfcNestedCtxt ::
       proxy (Header (HardForkBlock xs))
    -> ShortByteString  -- ^ First bytes ('reconstructPrefixLen') of the block
    -> SizeInBytes      -- ^ Block size
    -> SomeSecond (NestedCtxt Header) (HardForkBlock xs)
  reconstructHfcNestedCtxt proxy (Header (HardForkBlock xs))
_ ShortByteString
prefix SizeInBytes
blockSize =
     case Word8 -> Maybe (NS (K ()) xs)
forall k (xs :: [k]). SListI xs => Word8 -> Maybe (NS (K ()) xs)
nsFromIndex Word8
tag of
       Maybe (NS (K ()) xs)
Nothing -> String -> SomeSecond (NestedCtxt Header) (HardForkBlock xs)
forall a. HasCallStack => String -> a
error (String -> SomeSecond (NestedCtxt Header) (HardForkBlock xs))
-> String -> SomeSecond (NestedCtxt Header) (HardForkBlock xs)
forall a b. (a -> b) -> a -> b
$ String
"invalid HardForkBlock with tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
tag
       Just NS (K ()) xs
ns -> NS (SomeSecond (NestedCtxt Header)) xs
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs)
forall (xs' :: [*]).
NS (SomeSecond (NestedCtxt Header)) xs'
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs')
injSomeSecond (NS (SomeSecond (NestedCtxt Header)) xs
 -> SomeSecond (NestedCtxt Header) (HardForkBlock xs))
-> NS (SomeSecond (NestedCtxt Header)) xs
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs)
forall a b. (a -> b) -> a -> b
$ Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    K () a -> SomeSecond (NestedCtxt Header) a)
-> NS (K ()) xs
-> NS (SomeSecond (NestedCtxt Header)) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle forall a.
SingleEraBlock a =>
K () a -> SomeSecond (NestedCtxt Header) a
reconstructOne NS (K ()) xs
ns
    where
      tag :: Word8
      tag :: Word8
tag = ShortByteString -> Int -> Word8
Short.index ShortByteString
prefix Int
1

      prefixOne :: ShortByteString
      prefixOne :: ShortByteString
prefixOne = [Word8] -> ShortByteString
Short.pack ([Word8] -> ShortByteString)
-> (ShortByteString -> [Word8])
-> ShortByteString
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
drop Int
2 ([Word8] -> [Word8])
-> (ShortByteString -> [Word8]) -> ShortByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> [Word8]
Short.unpack (ShortByteString -> ShortByteString)
-> ShortByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ ShortByteString
prefix

      reconstructOne :: forall blk. SingleEraBlock blk
                     => K () blk -> SomeSecond (NestedCtxt Header) blk
      reconstructOne :: K () blk -> SomeSecond (NestedCtxt Header) blk
reconstructOne K () blk
_ =
          Proxy (Header blk)
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) blk
forall (f :: * -> *) blk (proxy :: * -> *).
ReconstructNestedCtxt f blk =>
proxy (f blk)
-> ShortByteString -> SizeInBytes -> SomeSecond (NestedCtxt f) blk
reconstructNestedCtxt (Proxy (Header blk)
forall k (t :: k). Proxy t
Proxy @(Header blk)) ShortByteString
prefixOne SizeInBytes
blockSize

      injSomeSecond :: NS (SomeSecond (NestedCtxt Header)) xs'
                   -> SomeSecond (NestedCtxt Header) (HardForkBlock xs')
      injSomeSecond :: NS (SomeSecond (NestedCtxt Header)) xs'
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs')
injSomeSecond (Z SomeSecond (NestedCtxt Header) x
x) = case SomeSecond (NestedCtxt Header) x
x of
          SomeSecond (NestedCtxt NestedCtxt_ x Header b
y) -> NestedCtxt Header (HardForkBlock (x : xs)) b
-> SomeSecond (NestedCtxt Header) (HardForkBlock (x : xs))
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (NestedCtxt_ (HardForkBlock (x : xs)) Header b
-> NestedCtxt Header (HardForkBlock (x : xs)) b
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_ x Header b
-> NestedCtxt_ (HardForkBlock (x : xs)) Header b
forall x (f :: * -> *) a (xs :: [*]).
NestedCtxt_ x f a -> NestedCtxt_ (HardForkBlock (x : xs)) f a
NCZ NestedCtxt_ x Header b
y))
      injSomeSecond (S NS (SomeSecond (NestedCtxt Header)) xs
x) = case NS (SomeSecond (NestedCtxt Header)) xs
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs)
forall (xs' :: [*]).
NS (SomeSecond (NestedCtxt Header)) xs'
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs')
injSomeSecond NS (SomeSecond (NestedCtxt Header)) xs
x of
          SomeSecond (NestedCtxt NestedCtxt_ (HardForkBlock xs) Header b
y) -> NestedCtxt Header (HardForkBlock (x : xs)) b
-> SomeSecond (NestedCtxt Header) (HardForkBlock (x : xs))
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (NestedCtxt_ (HardForkBlock (x : xs)) Header b
-> NestedCtxt Header (HardForkBlock (x : xs)) b
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_ (HardForkBlock xs) Header b
-> NestedCtxt_ (HardForkBlock (x : xs)) Header b
forall (xs :: [*]) (f :: * -> *) a x.
NestedCtxt_ (HardForkBlock xs) f a
-> NestedCtxt_ (HardForkBlock (x : xs)) f a
NCS NestedCtxt_ (HardForkBlock xs) Header b
y))

  -- | Used as the implementation of 'getBinaryBlockInfo' for
  -- 'HardForkBlock'.
  getHfcBinaryBlockInfo :: HardForkBlock xs -> BinaryBlockInfo
  getHfcBinaryBlockInfo (HardForkBlock (OneEraBlock NS I xs
bs)) =
      NS (K BinaryBlockInfo) xs -> CollapseTo NS BinaryBlockInfo
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K BinaryBlockInfo) xs -> CollapseTo NS BinaryBlockInfo)
-> NS (K BinaryBlockInfo) xs -> CollapseTo NS BinaryBlockInfo
forall a b. (a -> b) -> a -> b
$ Proxy HasBinaryBlockInfo
-> (forall a. HasBinaryBlockInfo a => I a -> K BinaryBlockInfo a)
-> NS I xs
-> NS (K BinaryBlockInfo) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (Proxy HasBinaryBlockInfo
forall k (t :: k). Proxy t
Proxy @HasBinaryBlockInfo) forall a. HasBinaryBlockInfo a => I a -> K BinaryBlockInfo a
aux NS I xs
bs
    where
      -- The header is unchanged, but the whole block is offset by 2 bytes
      -- (list length and tag)
      aux :: HasBinaryBlockInfo blk => I blk -> K BinaryBlockInfo blk
      aux :: I blk -> K BinaryBlockInfo blk
aux (I blk
blk) = BinaryBlockInfo -> K BinaryBlockInfo blk
forall k a (b :: k). a -> K a b
K (BinaryBlockInfo -> K BinaryBlockInfo blk)
-> BinaryBlockInfo -> K BinaryBlockInfo blk
forall a b. (a -> b) -> a -> b
$ BinaryBlockInfo :: Word16 -> Word16 -> BinaryBlockInfo
BinaryBlockInfo {
            headerOffset :: Word16
headerOffset = BinaryBlockInfo -> Word16
headerOffset BinaryBlockInfo
underlyingBlockInfo Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
2
          , headerSize :: Word16
headerSize   = BinaryBlockInfo -> Word16
headerSize   BinaryBlockInfo
underlyingBlockInfo
          }
        where
          underlyingBlockInfo :: BinaryBlockInfo
          underlyingBlockInfo :: BinaryBlockInfo
underlyingBlockInfo = blk -> BinaryBlockInfo
forall blk. HasBinaryBlockInfo blk => blk -> BinaryBlockInfo
getBinaryBlockInfo blk
blk

  -- | Used as the implementation of 'estimateBlockSize' for 'HardForkBlock'.
  estimateHfcBlockSize :: Header (HardForkBlock xs) -> SizeInBytes
  estimateHfcBlockSize =
        (SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
2) -- Account for the era wrapper
      (SizeInBytes -> SizeInBytes)
-> (Header (HardForkBlock xs) -> SizeInBytes)
-> Header (HardForkBlock xs)
-> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (K SizeInBytes) xs -> SizeInBytes
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K SizeInBytes) xs -> SizeInBytes)
-> (Header (HardForkBlock xs) -> NS (K SizeInBytes) xs)
-> Header (HardForkBlock xs)
-> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SerialiseConstraintsHFC
-> (forall a.
    SerialiseConstraintsHFC a =>
    Header a -> K SizeInBytes a)
-> NS Header xs
-> NS (K SizeInBytes) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (Proxy SerialiseConstraintsHFC
forall k (t :: k). Proxy t
Proxy @SerialiseConstraintsHFC) (SizeInBytes -> K SizeInBytes a
forall k a (b :: k). a -> K a b
K (SizeInBytes -> K SizeInBytes a)
-> (Header a -> SizeInBytes) -> Header a -> K SizeInBytes a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header a -> SizeInBytes
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> SizeInBytes
estimateBlockSize)
      (NS Header xs -> NS (K SizeInBytes) xs)
-> (Header (HardForkBlock xs) -> NS Header xs)
-> Header (HardForkBlock xs)
-> NS (K SizeInBytes) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraHeader xs -> NS Header xs
forall (xs :: [*]). OneEraHeader xs -> NS Header xs
getOneEraHeader
      (OneEraHeader xs -> NS Header xs)
-> (Header (HardForkBlock xs) -> OneEraHeader xs)
-> Header (HardForkBlock xs)
-> NS Header xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (HardForkBlock xs) -> OneEraHeader xs
forall (xs :: [*]). Header (HardForkBlock xs) -> OneEraHeader xs
getHardForkHeader

{-------------------------------------------------------------------------------
  Exceptions
-------------------------------------------------------------------------------}

-- | Exception thrown in the HFC encoders
data HardForkEncoderException where
  -- | HFC disabled, but we saw a value from an era other than the first
  HardForkEncoderFutureEra :: SingleEraInfo blk -> HardForkEncoderException

  -- | HFC enabled, but we saw a value from a disabled era
  HardForkEncoderDisabledEra :: SingleEraInfo blk -> HardForkEncoderException

  -- | HFC disabled, but we saw a query that is only supported by the HFC
  HardForkEncoderQueryHfcDisabled :: HardForkEncoderException

  -- | HFC enabled, but we saw a HFC query that is not supported by the
  -- HFC-specific version used
  HardForkEncoderQueryWrongVersion :: HardForkEncoderException

deriving instance Show HardForkEncoderException
instance Exception HardForkEncoderException

futureEraException ::
     SListI xs
  => NS SingleEraInfo xs
  -> HardForkEncoderException
futureEraException :: NS SingleEraInfo xs -> HardForkEncoderException
futureEraException = NS (K HardForkEncoderException) xs -> HardForkEncoderException
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K HardForkEncoderException) xs -> HardForkEncoderException)
-> (NS SingleEraInfo xs -> NS (K HardForkEncoderException) xs)
-> NS SingleEraInfo xs
-> HardForkEncoderException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. SingleEraInfo a -> K HardForkEncoderException a)
-> NS SingleEraInfo xs -> NS (K HardForkEncoderException) xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
hmap (HardForkEncoderException -> K HardForkEncoderException a
forall k a (b :: k). a -> K a b
K (HardForkEncoderException -> K HardForkEncoderException a)
-> (SingleEraInfo a -> HardForkEncoderException)
-> SingleEraInfo a
-> K HardForkEncoderException a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleEraInfo a -> HardForkEncoderException
forall blk. SingleEraInfo blk -> HardForkEncoderException
HardForkEncoderFutureEra)

disabledEraException ::
     forall blk. SingleEraBlock blk
  => Proxy blk
  -> HardForkEncoderException
disabledEraException :: Proxy blk -> HardForkEncoderException
disabledEraException = SingleEraInfo blk -> HardForkEncoderException
forall blk. SingleEraInfo blk -> HardForkEncoderException
HardForkEncoderDisabledEra (SingleEraInfo blk -> HardForkEncoderException)
-> (Proxy blk -> SingleEraInfo blk)
-> Proxy blk
-> HardForkEncoderException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy blk -> SingleEraInfo blk
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
singleEraInfo

{-------------------------------------------------------------------------------
  Dealing with annotations
-------------------------------------------------------------------------------}

data AnnDecoder f blk = AnnDecoder {
      AnnDecoder f blk -> forall s. Decoder s (ByteString -> f blk)
annDecoder :: forall s. Decoder s (Lazy.ByteString -> f blk)
    }

{-------------------------------------------------------------------------------
  Serialisation of telescopes
-------------------------------------------------------------------------------}

encodeTelescope :: SListI xs
                => NP (f -.-> K Encoding) xs -> HardForkState f xs -> Encoding
encodeTelescope :: NP (f -.-> K Encoding) xs -> HardForkState f xs -> Encoding
encodeTelescope NP (f -.-> K Encoding) xs
es (HardForkState Telescope (K Past) (Current f) xs
st) = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      Word -> Encoding
Enc.encodeListLen (Word
1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ix)
    , [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat ([Encoding] -> Encoding) -> [Encoding] -> Encoding
forall a b. (a -> b) -> a -> b
$ SimpleTelescope (K Encoding) xs
-> CollapseTo SimpleTelescope Encoding
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (SimpleTelescope (K Encoding) xs
 -> CollapseTo SimpleTelescope Encoding)
-> SimpleTelescope (K Encoding) xs
-> CollapseTo SimpleTelescope Encoding
forall a b. (a -> b) -> a -> b
$ Telescope (K Encoding) (K Encoding) xs
-> SimpleTelescope (K Encoding) xs
forall k (f :: k -> *) (xs :: [k]).
Telescope f f xs -> SimpleTelescope f xs
SimpleTelescope (Telescope (K Encoding) (K Encoding) xs
 -> SimpleTelescope (K Encoding) xs)
-> Telescope (K Encoding) (K Encoding) xs
-> SimpleTelescope (K Encoding) xs
forall a b. (a -> b) -> a -> b
$
        ((forall x. (-.->) f (K Encoding) x -> K Past x -> K Encoding x)
-> (forall x.
    (-.->) f (K Encoding) x -> Current f x -> K Encoding x)
-> NP (f -.-> K Encoding) xs
-> Telescope (K Past) (Current f) xs
-> Telescope (K Encoding) (K Encoding) xs
forall k (xs :: [k]) (h :: k -> *) (g :: k -> *) (g' :: k -> *)
       (f :: k -> *) (f' :: k -> *).
SListI xs =>
(forall (x :: k). h x -> g x -> g' x)
-> (forall (x :: k). h x -> f x -> f' x)
-> NP h xs
-> Telescope g f xs
-> Telescope g' f' xs
Telescope.bihzipWith ((K Past x -> K Encoding x)
-> (-.->) f (K Encoding) x -> K Past x -> K Encoding x
forall a b. a -> b -> a
const K Past x -> K Encoding x
forall blk. K Past blk -> K Encoding blk
encPast) forall x. (-.->) f (K Encoding) x -> Current f x -> K Encoding x
forall (f :: * -> *) blk.
(-.->) f (K Encoding) blk -> Current f blk -> K Encoding blk
encCurrent NP (f -.-> K Encoding) xs
es Telescope (K Past) (Current f) xs
st)
    ]
  where
    -- The tip of the telescope also tells us the length
    ix :: Word8
    ix :: Word8
ix = NS (Current f) xs -> Word8
forall k (xs :: [k]) (f :: k -> *). SListI xs => NS f xs -> Word8
nsToIndex (Telescope (K Past) (Current f) xs -> NS (Current f) xs
forall k (g :: k -> *) (f :: k -> *) (xs :: [k]).
Telescope g f xs -> NS f xs
Telescope.tip Telescope (K Past) (Current f) xs
st)

    encPast :: K Past blk -> K Encoding blk
    encPast :: K Past blk -> K Encoding blk
encPast = Encoding -> K Encoding blk
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding blk)
-> (K Past blk -> Encoding) -> K Past blk -> K Encoding blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Past -> Encoding
encodePast (Past -> Encoding)
-> (K Past blk -> Past) -> K Past blk -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K Past blk -> Past
forall k a (b :: k). K a b -> a
unK

    encCurrent :: (f -.-> K Encoding) blk -> Current f blk  -> K Encoding blk
    encCurrent :: (-.->) f (K Encoding) blk -> Current f blk -> K Encoding blk
encCurrent (-.->) f (K Encoding) blk
enc = Encoding -> K Encoding blk
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding blk)
-> (Current f blk -> Encoding) -> Current f blk -> K Encoding blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f blk -> Encoding) -> Current f blk -> Encoding
forall (f :: * -> *) blk.
(f blk -> Encoding) -> Current f blk -> Encoding
encodeCurrent (K Encoding blk -> Encoding
forall k a (b :: k). K a b -> a
unK (K Encoding blk -> Encoding)
-> (f blk -> K Encoding blk) -> f blk -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (-.->) f (K Encoding) blk -> f blk -> K Encoding blk
forall k (f :: k -> *) (g :: k -> *) (a :: k).
(-.->) f g a -> f a -> g a
apFn (-.->) f (K Encoding) blk
enc)

decodeTelescope :: NP (Decoder s :.: f) xs -> Decoder s (HardForkState f xs)
decodeTelescope :: NP (Decoder s :.: f) xs -> Decoder s (HardForkState f xs)
decodeTelescope = \NP (Decoder s :.: f) xs
ds -> do
    Int
ix <- Decoder s Int
forall s. Decoder s Int
Dec.decodeListLen
    if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
      then String -> Decoder s (HardForkState f xs)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (HardForkState f xs))
-> String -> Decoder s (HardForkState f xs)
forall a b. (a -> b) -> a -> b
$ String
"decodeTelescope: invalid telescope length " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ix
      else Telescope (K Past) (Current f) xs -> HardForkState f xs
forall (f :: * -> *) (xs :: [*]).
Telescope (K Past) (Current f) xs -> HardForkState f xs
HardForkState (Telescope (K Past) (Current f) xs -> HardForkState f xs)
-> Decoder s (Telescope (K Past) (Current f) xs)
-> Decoder s (HardForkState f xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> NP (Decoder s :.: f) xs
-> Decoder s (Telescope (K Past) (Current f) xs)
forall s (f :: * -> *) (xs :: [*]).
Int
-> NP (Decoder s :.: f) xs
-> Decoder s (Telescope (K Past) (Current f) xs)
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) NP (Decoder s :.: f) xs
ds
  where
    go :: Int
       -> NP (Decoder s :.: f) xs
       -> Decoder s (Telescope (K Past) (Current f) xs)
    go :: Int
-> NP (Decoder s :.: f) xs
-> Decoder s (Telescope (K Past) (Current f) xs)
go Int
0 (Comp Decoder s (f x)
d :* NP (Decoder s :.: f) xs
_)  = Current f x -> Telescope (K Past) (Current f) (x : xs)
forall a (f :: a -> *) (x :: a) (g :: a -> *) (xs :: [a]).
f x -> Telescope g f (x : xs)
TZ (Current f x -> Telescope (K Past) (Current f) (x : xs))
-> Decoder s (Current f x)
-> Decoder s (Telescope (K Past) (Current f) (x : xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (f x) -> Decoder s (Current f x)
forall s (f :: * -> *) blk.
Decoder s (f blk) -> Decoder s (Current f blk)
decodeCurrent Decoder s (f x)
d
    go Int
i (Comp Decoder s (f x)
_ :* NP (Decoder s :.: f) xs
ds) = K Past x
-> Telescope (K Past) (Current f) xs
-> Telescope (K Past) (Current f) (x : xs)
forall a (g :: a -> *) (x :: a) (f :: a -> *) (xs :: [a]).
g x -> Telescope g f xs -> Telescope g f (x : xs)
TS (K Past x
 -> Telescope (K Past) (Current f) xs
 -> Telescope (K Past) (Current f) (x : xs))
-> Decoder s (K Past x)
-> Decoder
     s
     (Telescope (K Past) (Current f) xs
      -> Telescope (K Past) (Current f) (x : xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Past -> K Past x
forall k a (b :: k). a -> K a b
K (Past -> K Past x) -> Decoder s Past -> Decoder s (K Past x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Past
forall s. Decoder s Past
decodePast) Decoder
  s
  (Telescope (K Past) (Current f) xs
   -> Telescope (K Past) (Current f) (x : xs))
-> Decoder s (Telescope (K Past) (Current f) xs)
-> Decoder s (Telescope (K Past) (Current f) (x : xs))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int
-> NP (Decoder s :.: f) xs
-> Decoder s (Telescope (K Past) (Current f) xs)
forall s (f :: * -> *) (xs :: [*]).
Int
-> NP (Decoder s :.: f) xs
-> Decoder s (Telescope (K Past) (Current f) xs)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) NP (Decoder s :.: f) xs
ds
    go Int
_ NP (Decoder s :.: f) xs
Nil            = String -> Decoder s (Telescope (K Past) (Current f) xs)
forall a. HasCallStack => String -> a
error String
"decodeTelescope: invalid telescope length"

{-------------------------------------------------------------------------------
  Serialisation of sums
-------------------------------------------------------------------------------}

encodeNS :: SListI xs => NP (f -.-> K Encoding) xs -> NS f xs -> Encoding
encodeNS :: NP (f -.-> K Encoding) xs -> NS f xs -> Encoding
encodeNS NP (f -.-> K Encoding) xs
es NS f xs
ns = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      Word -> Encoding
Enc.encodeListLen Word
2
    , Word8 -> Encoding
Enc.encodeWord8 (Word8 -> Encoding) -> Word8 -> Encoding
forall a b. (a -> b) -> a -> b
$ NS f xs -> Word8
forall k (xs :: [k]) (f :: k -> *). SListI xs => NS f xs -> Word8
nsToIndex NS f xs
ns
    , NS (K Encoding) xs -> CollapseTo NS Encoding
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K Encoding) xs -> CollapseTo NS Encoding)
-> NS (K Encoding) xs -> CollapseTo NS Encoding
forall a b. (a -> b) -> a -> b
$ (forall a. (-.->) f (K Encoding) a -> f a -> K Encoding a)
-> Prod NS (f -.-> K Encoding) xs -> NS f xs -> NS (K Encoding) xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(SListIN (Prod h) xs, HAp h, HAp (Prod h)) =>
(forall (a :: k). f a -> f' a -> f'' a)
-> Prod h f xs -> h f' xs -> h f'' xs
hzipWith forall a. (-.->) f (K Encoding) a -> f a -> K Encoding a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
(-.->) f g a -> f a -> g a
apFn Prod NS (f -.-> K Encoding) xs
NP (f -.-> K Encoding) xs
es NS f xs
ns
    ]

decodeNS :: SListI xs => NP (Decoder s :.: f) xs -> Decoder s (NS f xs)
decodeNS :: NP (Decoder s :.: f) xs -> Decoder s (NS f xs)
decodeNS NP (Decoder s :.: f) xs
ds = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"decodeNS" Int
2
    Word8
i <- Decoder s Word8
forall s. Decoder s Word8
Dec.decodeWord8
    case Word8 -> Maybe (NS (K ()) xs)
forall k (xs :: [k]). SListI xs => Word8 -> Maybe (NS (K ()) xs)
nsFromIndex Word8
i of
      Maybe (NS (K ()) xs)
Nothing -> String -> Decoder s (NS f xs)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (NS f xs)) -> String -> Decoder s (NS f xs)
forall a b. (a -> b) -> a -> b
$ String
"decodeNS: invalid index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
i
      Just NS (K ()) xs
ns -> NS (K (Decoder s (NS f xs))) xs
-> CollapseTo NS (Decoder s (NS f xs))
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K (Decoder s (NS f xs))) xs
 -> CollapseTo NS (Decoder s (NS f xs)))
-> NS (K (Decoder s (NS f xs))) xs
-> CollapseTo NS (Decoder s (NS f xs))
forall a b. (a -> b) -> a -> b
$ (forall a.
 Index xs a
 -> (:.:) (Decoder s) f a -> K () a -> K (Decoder s (NS f xs)) a)
-> NP (Decoder s :.: f) xs
-> NS (K ()) xs
-> NS (K (Decoder s (NS f xs))) xs
forall k (h :: (k -> *) -> [k] -> *) (xs :: [k]) (f1 :: k -> *)
       (f2 :: k -> *) (f3 :: k -> *).
(HAp h, SListI xs, Prod h ~ NP) =>
(forall (a :: k). Index xs a -> f1 a -> f2 a -> f3 a)
-> NP f1 xs -> h f2 xs -> h f3 xs
hizipWith forall (xs :: [*]) blk s (f :: * -> *).
Index xs blk
-> (:.:) (Decoder s) f blk
-> K () blk
-> K (Decoder s (NS f xs)) blk
forall a.
Index xs a
-> (:.:) (Decoder s) f a -> K () a -> K (Decoder s (NS f xs)) a
aux NP (Decoder s :.: f) xs
ds NS (K ()) xs
ns
  where
    aux :: Index xs blk
        -> (Decoder s :.: f) blk
        -> K () blk
        -> K (Decoder s (NS f xs)) blk
    aux :: Index xs blk
-> (:.:) (Decoder s) f blk
-> K () blk
-> K (Decoder s (NS f xs)) blk
aux Index xs blk
index (Comp Decoder s (f blk)
dec) (K ()) = Decoder s (NS f xs) -> K (Decoder s (NS f xs)) blk
forall k a (b :: k). a -> K a b
K (Decoder s (NS f xs) -> K (Decoder s (NS f xs)) blk)
-> Decoder s (NS f xs) -> K (Decoder s (NS f xs)) blk
forall a b. (a -> b) -> a -> b
$ Index xs blk -> f blk -> NS f xs
forall k (f :: k -> *) (x :: k) (xs :: [k]).
Index xs x -> f x -> NS f xs
injectNS Index xs blk
index (f blk -> NS f xs) -> Decoder s (f blk) -> Decoder s (NS f xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (f blk)
dec

decodeAnnNS :: SListI xs
            => NP (AnnDecoder f) xs
            -> forall s. Decoder s (Lazy.ByteString -> NS f xs)
decodeAnnNS :: NP (AnnDecoder f) xs -> forall s. Decoder s (ByteString -> NS f xs)
decodeAnnNS NP (AnnDecoder f) xs
ds = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"decodeDiskAnnNS" Int
2
    Word8
i <- Decoder s Word8
forall s. Decoder s Word8
Dec.decodeWord8
    case Word8 -> Maybe (NS (K ()) xs)
forall k (xs :: [k]). SListI xs => Word8 -> Maybe (NS (K ()) xs)
nsFromIndex Word8
i of
      Maybe (NS (K ()) xs)
Nothing -> String -> Decoder s (ByteString -> NS f xs)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (ByteString -> NS f xs))
-> String -> Decoder s (ByteString -> NS f xs)
forall a b. (a -> b) -> a -> b
$ String
"decodeAnnNS: invalid index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
i
      Just NS (K ()) xs
ns -> NS (K (Decoder s (ByteString -> NS f xs))) xs
-> CollapseTo NS (Decoder s (ByteString -> NS f xs))
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K (Decoder s (ByteString -> NS f xs))) xs
 -> CollapseTo NS (Decoder s (ByteString -> NS f xs)))
-> NS (K (Decoder s (ByteString -> NS f xs))) xs
-> CollapseTo NS (Decoder s (ByteString -> NS f xs))
forall a b. (a -> b) -> a -> b
$ (forall a.
 Index xs a
 -> AnnDecoder f a
 -> K () a
 -> K (Decoder s (ByteString -> NS f xs)) a)
-> NP (AnnDecoder f) xs
-> NS (K ()) xs
-> NS (K (Decoder s (ByteString -> NS f xs))) xs
forall k (h :: (k -> *) -> [k] -> *) (xs :: [k]) (f1 :: k -> *)
       (f2 :: k -> *) (f3 :: k -> *).
(HAp h, SListI xs, Prod h ~ NP) =>
(forall (a :: k). Index xs a -> f1 a -> f2 a -> f3 a)
-> NP f1 xs -> h f2 xs -> h f3 xs
hizipWith forall (xs :: [*]) blk (f :: * -> *) s.
Index xs blk
-> AnnDecoder f blk
-> K () blk
-> K (Decoder s (ByteString -> NS f xs)) blk
forall a.
Index xs a
-> AnnDecoder f a
-> K () a
-> K (Decoder s (ByteString -> NS f xs)) a
aux NP (AnnDecoder f) xs
ds NS (K ()) xs
ns
  where
    aux :: Index xs blk
        -> AnnDecoder f blk
        -> K () blk
        -> K (Decoder s (Lazy.ByteString -> NS f xs)) blk
    aux :: Index xs blk
-> AnnDecoder f blk
-> K () blk
-> K (Decoder s (ByteString -> NS f xs)) blk
aux Index xs blk
index (AnnDecoder forall s. Decoder s (ByteString -> f blk)
dec) (K ()) = Decoder s (ByteString -> NS f xs)
-> K (Decoder s (ByteString -> NS f xs)) blk
forall k a (b :: k). a -> K a b
K (Decoder s (ByteString -> NS f xs)
 -> K (Decoder s (ByteString -> NS f xs)) blk)
-> Decoder s (ByteString -> NS f xs)
-> K (Decoder s (ByteString -> NS f xs)) blk
forall a b. (a -> b) -> a -> b
$ (Index xs blk -> f blk -> NS f xs
forall k (f :: k -> *) (x :: k) (xs :: [k]).
Index xs x -> f x -> NS f xs
injectNS Index xs blk
index (f blk -> NS f xs)
-> (ByteString -> f blk) -> ByteString -> NS f xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((ByteString -> f blk) -> ByteString -> NS f xs)
-> Decoder s (ByteString -> f blk)
-> Decoder s (ByteString -> NS f xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (ByteString -> f blk)
forall s. Decoder s (ByteString -> f blk)
dec

{-------------------------------------------------------------------------------
  Dependent serialisation
-------------------------------------------------------------------------------}

encodeNested :: All (EncodeDiskDep (NestedCtxt f)) xs
             => CodecConfig (HardForkBlock xs)
             -> NestedCtxt f (HardForkBlock xs) a
             -> a
             -> Encoding
encodeNested :: CodecConfig (HardForkBlock xs)
-> NestedCtxt f (HardForkBlock xs) a -> a -> Encoding
encodeNested = \CodecConfig (HardForkBlock xs)
ccfg (NestedCtxt NestedCtxt_ (HardForkBlock xs) f a
ctxt) a
a ->
    NP CodecConfig xs
-> NestedCtxt_ (HardForkBlock xs) f a -> a -> Encoding
forall (f :: * -> *) (xs' :: [*]) a.
All (EncodeDiskDep (NestedCtxt f)) xs' =>
NP CodecConfig xs'
-> NestedCtxt_ (HardForkBlock xs') f a -> a -> Encoding
go (PerEraCodecConfig xs -> NP CodecConfig xs
forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs
getPerEraCodecConfig (CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra CodecConfig (HardForkBlock xs)
ccfg)) NestedCtxt_ (HardForkBlock xs) f a
ctxt a
a
  where
    go :: All (EncodeDiskDep (NestedCtxt f)) xs'
       => NP CodecConfig xs'
       -> NestedCtxt_ (HardForkBlock xs') f a
       -> a -> Encoding
    go :: NP CodecConfig xs'
-> NestedCtxt_ (HardForkBlock xs') f a -> a -> Encoding
go NP CodecConfig xs'
Nil       NestedCtxt_ (HardForkBlock xs') f a
ctxt       = case NestedCtxt_ (HardForkBlock xs') f a
ctxt of {}
    go (CodecConfig x
c :* NP CodecConfig xs
_)  (NCZ ctxt) = CodecConfig x -> NestedCtxt f x a -> a -> Encoding
forall (f :: * -> * -> *) blk a.
EncodeDiskDep f blk =>
CodecConfig blk -> f blk a -> a -> Encoding
encodeDiskDep CodecConfig x
c (NestedCtxt_ x f a -> NestedCtxt f x a
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt NestedCtxt_ x f a
ctxt)
    go (CodecConfig x
_ :* NP CodecConfig xs
cs) (NCS ctxt) = NP CodecConfig xs
-> NestedCtxt_ (HardForkBlock xs) f a -> a -> Encoding
forall (f :: * -> *) (xs' :: [*]) a.
All (EncodeDiskDep (NestedCtxt f)) xs' =>
NP CodecConfig xs'
-> NestedCtxt_ (HardForkBlock xs') f a -> a -> Encoding
go NP CodecConfig xs
cs NestedCtxt_ (HardForkBlock xs) f a
NestedCtxt_ (HardForkBlock xs) f a
ctxt

decodeNested :: All (DecodeDiskDep (NestedCtxt f)) xs
             => CodecConfig (HardForkBlock xs)
             -> NestedCtxt f (HardForkBlock xs) a
             -> forall s. Decoder s (Lazy.ByteString -> a)
decodeNested :: CodecConfig (HardForkBlock xs)
-> NestedCtxt f (HardForkBlock xs) a
-> forall s. Decoder s (ByteString -> a)
decodeNested = \CodecConfig (HardForkBlock xs)
ccfg (NestedCtxt NestedCtxt_ (HardForkBlock xs) f a
ctxt) ->
    NP CodecConfig xs
-> NestedCtxt_ (HardForkBlock xs) f a
-> Decoder s (ByteString -> a)
forall (f :: * -> *) (xs' :: [*]) a s.
All (DecodeDiskDep (NestedCtxt f)) xs' =>
NP CodecConfig xs'
-> NestedCtxt_ (HardForkBlock xs') f a
-> Decoder s (ByteString -> a)
go (PerEraCodecConfig xs -> NP CodecConfig xs
forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs
getPerEraCodecConfig (CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra CodecConfig (HardForkBlock xs)
ccfg)) NestedCtxt_ (HardForkBlock xs) f a
ctxt
  where
    go :: All (DecodeDiskDep (NestedCtxt f)) xs'
       => NP CodecConfig xs'
       -> NestedCtxt_ (HardForkBlock xs') f a
       -> Decoder s (Lazy.ByteString -> a)
    go :: NP CodecConfig xs'
-> NestedCtxt_ (HardForkBlock xs') f a
-> Decoder s (ByteString -> a)
go NP CodecConfig xs'
Nil       NestedCtxt_ (HardForkBlock xs') f a
ctxt       = case NestedCtxt_ (HardForkBlock xs') f a
ctxt of {}
    go (CodecConfig x
c :* NP CodecConfig xs
_)  (NCZ ctxt) = CodecConfig x
-> NestedCtxt f x a -> forall s. Decoder s (ByteString -> a)
forall (f :: * -> * -> *) blk a.
DecodeDiskDep f blk =>
CodecConfig blk -> f blk a -> forall s. Decoder s (ByteString -> a)
decodeDiskDep CodecConfig x
c (NestedCtxt_ x f a -> NestedCtxt f x a
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt NestedCtxt_ x f a
ctxt)
    go (CodecConfig x
_ :* NP CodecConfig xs
cs) (NCS ctxt) = NP CodecConfig xs
-> NestedCtxt_ (HardForkBlock xs) f a
-> Decoder s (ByteString -> a)
forall (f :: * -> *) (xs' :: [*]) a s.
All (DecodeDiskDep (NestedCtxt f)) xs' =>
NP CodecConfig xs'
-> NestedCtxt_ (HardForkBlock xs') f a
-> Decoder s (ByteString -> a)
go NP CodecConfig xs
cs NestedCtxt_ (HardForkBlock xs) f a
NestedCtxt_ (HardForkBlock xs) f a
ctxt

encodeNestedCtxt :: All (EncodeDiskDepIx (NestedCtxt f)) xs
                 => CodecConfig (HardForkBlock xs)
                 -> SomeSecond (NestedCtxt f) (HardForkBlock xs)
                 -> Encoding
encodeNestedCtxt :: CodecConfig (HardForkBlock xs)
-> SomeSecond (NestedCtxt f) (HardForkBlock xs) -> Encoding
encodeNestedCtxt = \CodecConfig (HardForkBlock xs)
ccfg (SomeSecond NestedCtxt f (HardForkBlock xs) b
ctxt) ->
    NP CodecConfig xs
-> NP (K Word8) xs
-> NestedCtxt_ (HardForkBlock xs) f b
-> Encoding
forall (f :: * -> *) (xs' :: [*]) a.
All (EncodeDiskDepIx (NestedCtxt f)) xs' =>
NP CodecConfig xs'
-> NP (K Word8) xs'
-> NestedCtxt_ (HardForkBlock xs') f a
-> Encoding
go (PerEraCodecConfig xs -> NP CodecConfig xs
forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs
getPerEraCodecConfig (CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra CodecConfig (HardForkBlock xs)
ccfg))
       NP (K Word8) xs
forall k (xs :: [k]). SListI xs => NP (K Word8) xs
npWithIndices
       (NestedCtxt f (HardForkBlock xs) b
-> NestedCtxt_ (HardForkBlock xs) f b
forall (f :: * -> *) blk a.
NestedCtxt f blk a -> NestedCtxt_ blk f a
flipNestedCtxt NestedCtxt f (HardForkBlock xs) b
ctxt)
  where
    go :: All (EncodeDiskDepIx (NestedCtxt f)) xs'
       => NP CodecConfig xs'
       -> NP (K Word8) xs'
       -> NestedCtxt_ (HardForkBlock xs') f a
       -> Encoding
    go :: NP CodecConfig xs'
-> NP (K Word8) xs'
-> NestedCtxt_ (HardForkBlock xs') f a
-> Encoding
go NP CodecConfig xs'
Nil       NP (K Word8) xs'
_           NestedCtxt_ (HardForkBlock xs') f a
ctxt       = case NestedCtxt_ (HardForkBlock xs') f a
ctxt of {}
    go (CodecConfig x
_ :* NP CodecConfig xs
cs) (K Word8 x
_   :* NP (K Word8) xs
is) (NCS ctxt) = NP CodecConfig xs
-> NP (K Word8) xs
-> NestedCtxt_ (HardForkBlock xs) f a
-> Encoding
forall (f :: * -> *) (xs' :: [*]) a.
All (EncodeDiskDepIx (NestedCtxt f)) xs' =>
NP CodecConfig xs'
-> NP (K Word8) xs'
-> NestedCtxt_ (HardForkBlock xs') f a
-> Encoding
go NP CodecConfig xs
cs NP (K Word8) xs
NP (K Word8) xs
is NestedCtxt_ (HardForkBlock xs) f a
NestedCtxt_ (HardForkBlock xs) f a
ctxt
    go (CodecConfig x
c :* NP CodecConfig xs
_)  (K Word8
i :* NP (K Word8) xs
_)  (NCZ ctxt) = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
          Word -> Encoding
Enc.encodeListLen Word
2
        , Word8 -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode Word8
i
        , CodecConfig x -> SomeSecond (NestedCtxt f) x -> Encoding
forall (f :: * -> * -> *) blk.
EncodeDiskDepIx f blk =>
CodecConfig blk -> SomeSecond f blk -> Encoding
encodeDiskDepIx CodecConfig x
c (NestedCtxt f x a -> SomeSecond (NestedCtxt f) x
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (NestedCtxt_ x f a -> NestedCtxt f x a
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt NestedCtxt_ x f a
ctxt))
        ]

decodeNestedCtxt :: All (DecodeDiskDepIx (NestedCtxt f)) xs
                 => CodecConfig (HardForkBlock xs)
                 -> forall s. Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs))
decodeNestedCtxt :: CodecConfig (HardForkBlock xs)
-> forall s.
   Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs))
decodeNestedCtxt = \CodecConfig (HardForkBlock xs)
ccfg -> do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"decodeNestedCtxt" Int
2
    Word8
tag <- Decoder s Word8
forall a s. Serialise a => Decoder s a
Serialise.decode
    case Word8 -> Maybe (NS (K ()) xs)
forall k (xs :: [k]). SListI xs => Word8 -> Maybe (NS (K ()) xs)
nsFromIndex Word8
tag of
      Maybe (NS (K ()) xs)
Nothing -> String -> Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs)))
-> String
-> Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs))
forall a b. (a -> b) -> a -> b
$ String
"decodeNestedCtxt: invalid tag " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag
      Just NS (K ()) xs
ns ->
        NP CodecConfig xs
-> NS (K ()) xs
-> forall s.
   Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs))
forall (f :: * -> *) (xs' :: [*]).
All (DecodeDiskDepIx (NestedCtxt f)) xs' =>
NP CodecConfig xs'
-> NS (K ()) xs'
-> forall s.
   Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs'))
go (PerEraCodecConfig xs -> NP CodecConfig xs
forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs
getPerEraCodecConfig (CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra CodecConfig (HardForkBlock xs)
ccfg)) NS (K ()) xs
ns
  where
    go :: All (DecodeDiskDepIx (NestedCtxt f)) xs'
       => NP CodecConfig xs'
       -> NS (K ()) xs'
       -> forall s. Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs'))
    go :: NP CodecConfig xs'
-> NS (K ()) xs'
-> forall s.
   Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs'))
go NP CodecConfig xs'
Nil       NS (K ()) xs'
i     = case NS (K ()) xs'
i of {}
    go (CodecConfig x
c :* NP CodecConfig xs
_)  (Z K () x
_) = (forall a.
 NestedCtxt_ x f a -> NestedCtxt_ (HardForkBlock xs') f a)
-> SomeSecond (NestedCtxt f) x
-> SomeSecond (NestedCtxt f) (HardForkBlock xs')
forall blk (f :: * -> *) blk' (f' :: * -> *).
(forall a. NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a)
-> SomeSecond (NestedCtxt f) blk -> SomeSecond (NestedCtxt f') blk'
mapSomeNestedCtxt forall a. NestedCtxt_ x f a -> NestedCtxt_ (HardForkBlock xs') f a
forall x (f :: * -> *) a (xs :: [*]).
NestedCtxt_ x f a -> NestedCtxt_ (HardForkBlock (x : xs)) f a
NCZ (SomeSecond (NestedCtxt f) x
 -> SomeSecond (NestedCtxt f) (HardForkBlock xs'))
-> Decoder s (SomeSecond (NestedCtxt f) x)
-> Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig x -> Decoder s (SomeSecond (NestedCtxt f) x)
forall (f :: * -> * -> *) blk s.
DecodeDiskDepIx f blk =>
CodecConfig blk -> Decoder s (SomeSecond f blk)
decodeDiskDepIx CodecConfig x
c
    go (CodecConfig x
_ :* NP CodecConfig xs
cs) (S NS (K ()) xs
i) = (forall a.
 NestedCtxt_ (HardForkBlock xs) f a
 -> NestedCtxt_ (HardForkBlock xs') f a)
-> SomeSecond (NestedCtxt f) (HardForkBlock xs)
-> SomeSecond (NestedCtxt f) (HardForkBlock xs')
forall blk (f :: * -> *) blk' (f' :: * -> *).
(forall a. NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a)
-> SomeSecond (NestedCtxt f) blk -> SomeSecond (NestedCtxt f') blk'
mapSomeNestedCtxt forall (xs :: [*]) (f :: * -> *) a x.
NestedCtxt_ (HardForkBlock xs) f a
-> NestedCtxt_ (HardForkBlock (x : xs)) f a
forall a.
NestedCtxt_ (HardForkBlock xs) f a
-> NestedCtxt_ (HardForkBlock xs') f a
NCS (SomeSecond (NestedCtxt f) (HardForkBlock xs)
 -> SomeSecond (NestedCtxt f) (HardForkBlock xs'))
-> Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs))
-> Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NP CodecConfig xs
-> NS (K ()) xs
-> forall s.
   Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs))
forall (f :: * -> *) (xs' :: [*]).
All (DecodeDiskDepIx (NestedCtxt f)) xs' =>
NP CodecConfig xs'
-> NS (K ()) xs'
-> forall s.
   Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs'))
go NP CodecConfig xs
cs NS (K ()) xs
NS (K ()) xs
i

{-------------------------------------------------------------------------------
  Serialisation of 'MismatchEraInfo'

  We have to be careful here not to introduce any additional wrapping when
  using 'HardForkNodeToClientDisabled'.
-------------------------------------------------------------------------------}

encodeEitherMismatch :: forall xs a. SListI xs
                     => BlockNodeToClientVersion (HardForkBlock xs)
                     -> (a -> Encoding)
                     -> (Either (MismatchEraInfo xs) a -> Encoding)
encodeEitherMismatch :: BlockNodeToClientVersion (HardForkBlock xs)
-> (a -> Encoding) -> Either (MismatchEraInfo xs) a -> Encoding
encodeEitherMismatch BlockNodeToClientVersion (HardForkBlock xs)
version a -> Encoding
enc Either (MismatchEraInfo xs) a
ma =
    case (BlockNodeToClientVersion (HardForkBlock xs)
HardForkNodeToClientVersion xs
version, Either (MismatchEraInfo xs) a
ma) of
      (HardForkNodeToClientDisabled {}, Right a
a) ->
          a -> Encoding
enc a
a
      (HardForkNodeToClientDisabled {}, Left MismatchEraInfo xs
err) ->
          HardForkEncoderException -> Encoding
forall a e. Exception e => e -> a
throw (HardForkEncoderException -> Encoding)
-> HardForkEncoderException -> Encoding
forall a b. (a -> b) -> a -> b
$ NS SingleEraInfo xs -> HardForkEncoderException
forall (xs :: [*]).
SListI xs =>
NS SingleEraInfo xs -> HardForkEncoderException
futureEraException (MismatchEraInfo (x : xs) -> NS SingleEraInfo xs
forall (xs :: [*]) x.
SListI xs =>
MismatchEraInfo (x : xs) -> NS SingleEraInfo xs
mismatchFutureEra MismatchEraInfo xs
MismatchEraInfo (x : xs)
err)
      (HardForkNodeToClientEnabled {}, Right a
a) -> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
            Word -> Encoding
Enc.encodeListLen Word
1
          , a -> Encoding
enc a
a
          ]
      (HardForkNodeToClientEnabled {}, Left (MismatchEraInfo Mismatch SingleEraInfo LedgerEraInfo xs
err)) -> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
            Word -> Encoding
Enc.encodeListLen Word
2
          , NP (SingleEraInfo -.-> K Encoding) xs
-> NS SingleEraInfo xs -> Encoding
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
NP (f -.-> K Encoding) xs -> NS f xs -> Encoding
encodeNS ((forall a. (-.->) SingleEraInfo (K Encoding) a)
-> NP (SingleEraInfo -.-> K Encoding) xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure ((SingleEraInfo a -> K Encoding a)
-> (-.->) SingleEraInfo (K Encoding) a
forall k (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn SingleEraInfo a -> K Encoding a
forall blk. SingleEraInfo blk -> K Encoding blk
encodeName)) NS SingleEraInfo xs
era1
          , NP (LedgerEraInfo -.-> K Encoding) xs
-> NS LedgerEraInfo xs -> Encoding
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
NP (f -.-> K Encoding) xs -> NS f xs -> Encoding
encodeNS ((forall a. (-.->) LedgerEraInfo (K Encoding) a)
-> NP (LedgerEraInfo -.-> K Encoding) xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure ((LedgerEraInfo a -> K Encoding a)
-> (-.->) LedgerEraInfo (K Encoding) a
forall k (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn (SingleEraInfo a -> K Encoding a
forall blk. SingleEraInfo blk -> K Encoding blk
encodeName (SingleEraInfo a -> K Encoding a)
-> (LedgerEraInfo a -> SingleEraInfo a)
-> LedgerEraInfo a
-> K Encoding a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerEraInfo a -> SingleEraInfo a
forall blk. LedgerEraInfo blk -> SingleEraInfo blk
getLedgerEraInfo))) NS LedgerEraInfo xs
era2
          ]
        where
          era1 :: NS SingleEraInfo xs
          era2 :: NS LedgerEraInfo xs
          (NS SingleEraInfo xs
era1, NS LedgerEraInfo xs
era2) = Mismatch SingleEraInfo LedgerEraInfo xs
-> (NS SingleEraInfo xs, NS LedgerEraInfo xs)
forall k (f :: k -> *) (g :: k -> *) (xs :: [k]).
Mismatch f g xs -> (NS f xs, NS g xs)
Match.mismatchToNS Mismatch SingleEraInfo LedgerEraInfo xs
err
  where
    encodeName :: SingleEraInfo blk -> K Encoding blk
    encodeName :: SingleEraInfo blk -> K Encoding blk
encodeName = Encoding -> K Encoding blk
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding blk)
-> (SingleEraInfo blk -> Encoding)
-> SingleEraInfo blk
-> K Encoding blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode (Text -> Encoding)
-> (SingleEraInfo blk -> Text) -> SingleEraInfo blk -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleEraInfo blk -> Text
forall blk. SingleEraInfo blk -> Text
singleEraName

decodeEitherMismatch :: SListI xs
                     => BlockNodeToClientVersion (HardForkBlock xs)
                     -> Decoder s a
                     -> Decoder s (Either (MismatchEraInfo xs) a)
decodeEitherMismatch :: BlockNodeToClientVersion (HardForkBlock xs)
-> Decoder s a -> Decoder s (Either (MismatchEraInfo xs) a)
decodeEitherMismatch BlockNodeToClientVersion (HardForkBlock xs)
version Decoder s a
dec =
    case BlockNodeToClientVersion (HardForkBlock xs)
version of
      HardForkNodeToClientDisabled {} ->
        a -> Either (MismatchEraInfo xs) a
forall a b. b -> Either a b
Right (a -> Either (MismatchEraInfo xs) a)
-> Decoder s a -> Decoder s (Either (MismatchEraInfo xs) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
dec
      HardForkNodeToClientEnabled {} -> do
        Int
tag <- Decoder s Int
forall s. Decoder s Int
Dec.decodeListLen
        case Int
tag of
          Int
1 -> a -> Either (MismatchEraInfo xs) a
forall a b. b -> Either a b
Right (a -> Either (MismatchEraInfo xs) a)
-> Decoder s a -> Decoder s (Either (MismatchEraInfo xs) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
dec
          Int
2 -> do NS SingleEraInfo xs
era1 <- NP (Decoder s :.: SingleEraInfo) xs
-> Decoder s (NS SingleEraInfo xs)
forall (xs :: [*]) s (f :: * -> *).
SListI xs =>
NP (Decoder s :.: f) xs -> Decoder s (NS f xs)
decodeNS ((forall a. (:.:) (Decoder s) SingleEraInfo a)
-> NP (Decoder s :.: SingleEraInfo) xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure (Decoder s (SingleEraInfo a) -> (:.:) (Decoder s) SingleEraInfo a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp Decoder s (SingleEraInfo a)
forall blk s. Decoder s (SingleEraInfo blk)
decodeName))
                  NS LedgerEraInfo xs
era2 <- NP (Decoder s :.: LedgerEraInfo) xs
-> Decoder s (NS LedgerEraInfo xs)
forall (xs :: [*]) s (f :: * -> *).
SListI xs =>
NP (Decoder s :.: f) xs -> Decoder s (NS f xs)
decodeNS ((forall a. (:.:) (Decoder s) LedgerEraInfo a)
-> NP (Decoder s :.: LedgerEraInfo) xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure (Decoder s (LedgerEraInfo a) -> (:.:) (Decoder s) LedgerEraInfo a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (SingleEraInfo a -> LedgerEraInfo a
forall blk. SingleEraInfo blk -> LedgerEraInfo blk
LedgerEraInfo (SingleEraInfo a -> LedgerEraInfo a)
-> Decoder s (SingleEraInfo a) -> Decoder s (LedgerEraInfo a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (SingleEraInfo a)
forall blk s. Decoder s (SingleEraInfo blk)
decodeName)))
                  case NS SingleEraInfo xs
-> NS LedgerEraInfo xs
-> Either
     (Mismatch SingleEraInfo LedgerEraInfo xs)
     (NS (Product SingleEraInfo LedgerEraInfo) xs)
forall k (f :: k -> *) (xs :: [k]) (g :: k -> *).
NS f xs
-> NS g xs -> Either (Mismatch f g xs) (NS (Product f g) xs)
Match.matchNS NS SingleEraInfo xs
era1 NS LedgerEraInfo xs
era2 of
                    Left Mismatch SingleEraInfo LedgerEraInfo xs
err -> Either (MismatchEraInfo xs) a
-> Decoder s (Either (MismatchEraInfo xs) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (MismatchEraInfo xs) a
 -> Decoder s (Either (MismatchEraInfo xs) a))
-> Either (MismatchEraInfo xs) a
-> Decoder s (Either (MismatchEraInfo xs) a)
forall a b. (a -> b) -> a -> b
$ MismatchEraInfo xs -> Either (MismatchEraInfo xs) a
forall a b. a -> Either a b
Left (Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
forall (xs :: [*]).
Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
MismatchEraInfo Mismatch SingleEraInfo LedgerEraInfo xs
err)
                    Right NS (Product SingleEraInfo LedgerEraInfo) xs
_  -> String -> Decoder s (Either (MismatchEraInfo xs) a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"dispatchDecoderErr: unexpected match"
          Int
_ -> String -> Decoder s (Either (MismatchEraInfo xs) a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (Either (MismatchEraInfo xs) a))
-> String -> Decoder s (Either (MismatchEraInfo xs) a)
forall a b. (a -> b) -> a -> b
$ String
"dispatchDecoderErr: invalid tag " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
tag
  where
    decodeName :: forall blk s. Decoder s (SingleEraInfo blk)
    decodeName :: Decoder s (SingleEraInfo blk)
decodeName = Text -> SingleEraInfo blk
forall blk. Text -> SingleEraInfo blk
SingleEraInfo (Text -> SingleEraInfo blk)
-> Decoder s Text -> Decoder s (SingleEraInfo blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall a s. Serialise a => Decoder s a
Serialise.decode

{-------------------------------------------------------------------------------
  Distributive properties
-------------------------------------------------------------------------------}

distribSerialisedHeader :: SerialisedHeader (HardForkBlock xs)
                        -> NS SerialisedHeader xs
distribSerialisedHeader :: SerialisedHeader (HardForkBlock xs) -> NS SerialisedHeader xs
distribSerialisedHeader = \SerialisedHeader (HardForkBlock xs)
hdr ->
    case SerialisedHeader (HardForkBlock xs)
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
forall blk.
SerialisedHeader blk
-> GenDepPair Serialised (NestedCtxt Header blk)
serialisedHeaderToDepPair SerialisedHeader (HardForkBlock xs)
hdr of
      GenDepPair (NestedCtxt NestedCtxt_ (HardForkBlock xs) Header a
ctxt) Serialised a
bs ->
        NestedCtxt_ (HardForkBlock xs) Header a
-> Serialised a -> NS SerialisedHeader xs
forall (xs :: [*]) a.
NestedCtxt_ (HardForkBlock xs) Header a
-> Serialised a -> NS SerialisedHeader xs
go NestedCtxt_ (HardForkBlock xs) Header a
ctxt Serialised a
bs
  where
    go :: NestedCtxt_ (HardForkBlock xs) Header a
       -> Serialised a
       -> NS SerialisedHeader xs
    go :: NestedCtxt_ (HardForkBlock xs) Header a
-> Serialised a -> NS SerialisedHeader xs
go (NCZ c) = SerialisedHeader x -> NS SerialisedHeader (x : xs)
forall a (f :: a -> *) (x :: a) (xs :: [a]). f x -> NS f (x : xs)
Z (SerialisedHeader x -> NS SerialisedHeader (x : xs))
-> (Serialised a -> SerialisedHeader x)
-> Serialised a
-> NS SerialisedHeader (x : xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenDepPair Serialised (NestedCtxt Header x) -> SerialisedHeader x
forall blk.
GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
SerialisedHeaderFromDepPair (GenDepPair Serialised (NestedCtxt Header x) -> SerialisedHeader x)
-> (Serialised a -> GenDepPair Serialised (NestedCtxt Header x))
-> Serialised a
-> SerialisedHeader x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedCtxt Header x a
-> Serialised a -> GenDepPair Serialised (NestedCtxt Header x)
forall (f :: * -> *) a (g :: * -> *). f a -> g a -> GenDepPair g f
GenDepPair (NestedCtxt_ x Header a -> NestedCtxt Header x a
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt NestedCtxt_ x Header a
c)
    go (NCS c) = NS SerialisedHeader xs -> NS SerialisedHeader (x : xs)
forall a (f :: a -> *) (xs :: [a]) (x :: a).
NS f xs -> NS f (x : xs)
S (NS SerialisedHeader xs -> NS SerialisedHeader (x : xs))
-> (Serialised a -> NS SerialisedHeader xs)
-> Serialised a
-> NS SerialisedHeader (x : xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedCtxt_ (HardForkBlock xs) Header a
-> Serialised a -> NS SerialisedHeader xs
forall (xs :: [*]) a.
NestedCtxt_ (HardForkBlock xs) Header a
-> Serialised a -> NS SerialisedHeader xs
go NestedCtxt_ (HardForkBlock xs) Header a
c

undistribSerialisedHeader :: NS SerialisedHeader xs
                          -> SerialisedHeader (HardForkBlock xs)
undistribSerialisedHeader :: NS SerialisedHeader xs -> SerialisedHeader (HardForkBlock xs)
undistribSerialisedHeader =
    GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
-> SerialisedHeader (HardForkBlock xs)
forall blk.
GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
SerialisedHeaderFromDepPair (GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
 -> SerialisedHeader (HardForkBlock xs))
-> (NS SerialisedHeader xs
    -> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs)))
-> NS SerialisedHeader xs
-> SerialisedHeader (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS SerialisedHeader xs
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
forall (xs :: [*]).
NS SerialisedHeader xs
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
go
  where
    go :: NS SerialisedHeader xs
       -> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
    go :: NS SerialisedHeader xs
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
go (Z (SerialisedHeaderFromDepPair (GenDepPair (NestedCtxt NestedCtxt_ x Header a
c) Serialised a
bs))) =
        NestedCtxt Header (HardForkBlock (x : xs)) a
-> Serialised a
-> GenDepPair
     Serialised (NestedCtxt Header (HardForkBlock (x : xs)))
forall (f :: * -> *) a (g :: * -> *). f a -> g a -> GenDepPair g f
GenDepPair (NestedCtxt_ (HardForkBlock (x : xs)) Header a
-> NestedCtxt Header (HardForkBlock (x : xs)) a
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_ x Header a
-> NestedCtxt_ (HardForkBlock (x : xs)) Header a
forall x (f :: * -> *) a (xs :: [*]).
NestedCtxt_ x f a -> NestedCtxt_ (HardForkBlock (x : xs)) f a
NCZ NestedCtxt_ x Header a
c)) Serialised a
bs
    go (S NS SerialisedHeader xs
bs) =
        (forall a.
 NestedCtxt Header (HardForkBlock xs) a
 -> NestedCtxt Header (HardForkBlock xs) a)
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
forall (f :: * -> *) (f' :: * -> *) (g :: * -> *).
(forall a. f a -> f' a) -> GenDepPair g f -> GenDepPair g f'
depPairFirst ((NestedCtxt_ (HardForkBlock xs) Header a
 -> NestedCtxt_ (HardForkBlock (x : xs)) Header a)
-> NestedCtxt Header (HardForkBlock xs) a
-> NestedCtxt Header (HardForkBlock (x : xs)) a
forall blk (f :: * -> *) a blk' (f' :: * -> *) a'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a')
-> NestedCtxt f blk a -> NestedCtxt f' blk' a'
mapNestedCtxt NestedCtxt_ (HardForkBlock xs) Header a
-> NestedCtxt_ (HardForkBlock (x : xs)) Header a
forall (xs :: [*]) (f :: * -> *) a x.
NestedCtxt_ (HardForkBlock xs) f a
-> NestedCtxt_ (HardForkBlock (x : xs)) f a
NCS) (GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
 -> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs)))
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
forall a b. (a -> b) -> a -> b
$ NS SerialisedHeader xs
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
forall (xs :: [*]).
NS SerialisedHeader xs
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
go NS SerialisedHeader xs
bs

distribQueryIfCurrent ::
     Some (QueryIfCurrent xs)
  -> NS (SomeSecond BlockQuery) xs
distribQueryIfCurrent :: Some (QueryIfCurrent xs) -> NS (SomeSecond BlockQuery) xs
distribQueryIfCurrent = \(Some QueryIfCurrent xs a
qry) -> QueryIfCurrent xs a -> NS (SomeSecond BlockQuery) xs
forall (xs :: [*]) result.
QueryIfCurrent xs result -> NS (SomeSecond BlockQuery) xs
go QueryIfCurrent xs a
qry
  where
    go :: QueryIfCurrent xs result -> NS (SomeSecond BlockQuery) xs
    go :: QueryIfCurrent xs result -> NS (SomeSecond BlockQuery) xs
go (QZ BlockQuery x result
qry) = SomeSecond BlockQuery x -> NS (SomeSecond BlockQuery) (x : xs)
forall a (f :: a -> *) (x :: a) (xs :: [a]). f x -> NS f (x : xs)
Z (BlockQuery x result -> SomeSecond BlockQuery x
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond BlockQuery x result
qry)
    go (QS QueryIfCurrent xs result
qry) = NS (SomeSecond BlockQuery) xs
-> NS (SomeSecond BlockQuery) (x : xs)
forall a (f :: a -> *) (xs :: [a]) (x :: a).
NS f xs -> NS f (x : xs)
S (QueryIfCurrent xs result -> NS (SomeSecond BlockQuery) xs
forall (xs :: [*]) result.
QueryIfCurrent xs result -> NS (SomeSecond BlockQuery) xs
go QueryIfCurrent xs result
qry)

undistribQueryIfCurrent ::
     NS (SomeSecond BlockQuery) xs
  -> Some (QueryIfCurrent xs)
undistribQueryIfCurrent :: NS (SomeSecond BlockQuery) xs -> Some (QueryIfCurrent xs)
undistribQueryIfCurrent = NS (SomeSecond BlockQuery) xs -> Some (QueryIfCurrent xs)
forall (xs :: [*]).
NS (SomeSecond BlockQuery) xs -> Some (QueryIfCurrent xs)
go
  where
    go :: NS (SomeSecond BlockQuery) xs -> Some (QueryIfCurrent xs)
    go :: NS (SomeSecond BlockQuery) xs -> Some (QueryIfCurrent xs)
go (Z SomeSecond BlockQuery x
qry) = case SomeSecond BlockQuery x
qry of
                   SomeSecond BlockQuery x b
qry' ->
                     QueryIfCurrent (x : xs) b -> Some (QueryIfCurrent (x : xs))
forall k (f :: k -> *) (a :: k). f a -> Some f
Some (BlockQuery x b -> QueryIfCurrent (x : xs) b
forall x result (xs :: [*]).
BlockQuery x result -> QueryIfCurrent (x : xs) result
QZ BlockQuery x b
qry')
    go (S NS (SomeSecond BlockQuery) xs
qry) = case NS (SomeSecond BlockQuery) xs -> Some (QueryIfCurrent xs)
forall (xs :: [*]).
NS (SomeSecond BlockQuery) xs -> Some (QueryIfCurrent xs)
go NS (SomeSecond BlockQuery) xs
qry of
                   Some QueryIfCurrent xs a
qry' ->
                     QueryIfCurrent (x : xs) a -> Some (QueryIfCurrent (x : xs))
forall k (f :: k -> *) (a :: k). f a -> Some f
Some (QueryIfCurrent xs a -> QueryIfCurrent (x : xs) a
forall (xs :: [*]) result x.
QueryIfCurrent xs result -> QueryIfCurrent (x : xs) result
QS QueryIfCurrent xs a
qry')

{-------------------------------------------------------------------------------
  Deriving-via support

  This is primarily for the benefit of tests, and depends only on 'Serialise'
  (rather than 'SerialiseDisk'/'SerialiseNodeToNode'/'SerialiseNodeToClient').
-------------------------------------------------------------------------------}

-- | Used for deriving via
--
-- Example
--
-- > deriving via SerialiseNS Header SomeEras
-- >          instance Serialise (Header SomeSecond)
newtype SerialiseNS f xs = SerialiseNS {
      SerialiseNS f xs -> NS f xs
getSerialiseNS :: NS f xs
    }

instance All (Compose Serialise f) xs => Serialise (SerialiseNS f xs) where
  encode :: SerialiseNS f xs -> Encoding
encode = NP (f -.-> K Encoding) xs -> NS f xs -> Encoding
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
NP (f -.-> K Encoding) xs -> NS f xs -> Encoding
encodeNS (Proxy (Compose Serialise f)
-> (forall a. Compose Serialise f a => (-.->) f (K Encoding) a)
-> NP (f -.-> K Encoding) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
hcpure (Proxy (Compose Serialise f)
forall k (t :: k). Proxy t
Proxy @(Compose Serialise f))
                            ((f a -> K Encoding a) -> (-.->) f (K Encoding) a
forall k (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn (Encoding -> K Encoding a
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding a)
-> (f a -> Encoding) -> f a -> K Encoding a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode)))
         (NS f xs -> Encoding)
-> (SerialiseNS f xs -> NS f xs) -> SerialiseNS f xs -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialiseNS f xs -> NS f xs
forall (f :: * -> *) (xs :: [*]). SerialiseNS f xs -> NS f xs
getSerialiseNS

  decode :: Decoder s (SerialiseNS f xs)
decode = (NS f xs -> SerialiseNS f xs)
-> Decoder s (NS f xs) -> Decoder s (SerialiseNS f xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NS f xs -> SerialiseNS f xs
forall (f :: * -> *) (xs :: [*]). NS f xs -> SerialiseNS f xs
SerialiseNS
         (Decoder s (NS f xs) -> Decoder s (SerialiseNS f xs))
-> Decoder s (NS f xs) -> Decoder s (SerialiseNS f xs)
forall a b. (a -> b) -> a -> b
$ NP (Decoder s :.: f) xs -> Decoder s (NS f xs)
forall (xs :: [*]) s (f :: * -> *).
SListI xs =>
NP (Decoder s :.: f) xs -> Decoder s (NS f xs)
decodeNS (Proxy (Compose Serialise f)
-> (forall a. Compose Serialise f a => (:.:) (Decoder s) f a)
-> NP (Decoder s :.: f) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
hcpure (Proxy (Compose Serialise f)
forall k (t :: k). Proxy t
Proxy @(Compose Serialise f))
                            (Decoder s (f a) -> (:.:) (Decoder s) f a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp Decoder s (f a)
forall a s. Serialise a => Decoder s a
Serialise.decode))