{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# 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 (..)
  , 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           Cardano.Binary (enforceSize)
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.BasicFunctors
import           Data.SOP.Constraint
import           Data.SOP.Index
import qualified Data.SOP.Match as Match
import           Data.SOP.Strict
import           Data.SOP.Telescope (SimpleTelescope (..), Telescope (..))
import qualified Data.SOP.Telescope as Telescope
import           Data.Word
import           Ouroboros.Consensus.Block
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.NetworkVersion
import           Ouroboros.Consensus.HardFork.Combinator.State
import           Ouroboros.Consensus.HardFork.Combinator.State.Instances
import           Ouroboros.Consensus.Ledger.Query
import           Ouroboros.Consensus.Ledger.Tables
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Node.Run
import           Ouroboros.Consensus.Storage.Serialisation
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Network.Block (Serialised)

{-------------------------------------------------------------------------------
  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 :: forall (f :: * -> *) (xs :: [*]).
All SingleEraBlock xs =>
NS f xs
-> Either (NS SingleEraInfo (LaterEra xs)) (f (FirstEra xs))
isFirstEra (Z f x
x) = f x -> Either (NS SingleEraInfo xs1) (f x)
forall a b. b -> Either a b
Right f x
x
isFirstEra (S NS f xs1
x) = NS SingleEraInfo xs1 -> Either (NS SingleEraInfo xs1) (f x)
forall a b. a -> Either a b
Left (Proxy SingleEraBlock
-> (forall a. SingleEraBlock a => f a -> SingleEraInfo a)
-> NS f xs1
-> NS SingleEraInfo xs1
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 f a -> SingleEraInfo a
forall a. SingleEraBlock a => f a -> SingleEraInfo a
aux NS f xs1
x)
  where
    aux :: forall blk. SingleEraBlock blk => f blk -> SingleEraInfo blk
    aux :: forall a. SingleEraBlock a => f a -> SingleEraInfo a
aux f blk
_ = Proxy blk -> SingleEraInfo blk
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
forall (proxy :: * -> *). proxy blk -> SingleEraInfo blk
singleEraInfo (forall t. Proxy t
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 :: forall (xs :: [*]) (f :: * -> *).
All SingleEraBlock xs =>
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 f a -> SingleEraInfo a
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 :: forall (f :: * -> *) blk.
SingleEraBlock blk =>
f blk -> SingleEraInfo blk
aux f blk
_ = Proxy blk -> SingleEraInfo blk
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
forall (proxy :: * -> *). proxy blk -> SingleEraInfo blk
singleEraInfo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)

{-------------------------------------------------------------------------------
  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 EraNodeToClientVersion) xs
      , All (Compose Eq   EraNodeToClientVersion) xs
      , All (Compose Show WrapNodeToNodeVersion)  xs
      , All (Compose Eq   WrapNodeToNodeVersion)  xs
        -- Required for 'encodeNestedCtxt'/'decodeNestedCtxt'
      , All (EncodeDiskDepIx (NestedCtxt Header)) xs
      , All (DecodeDiskDepIx (NestedCtxt Header)) xs
        -- Required for 'getHfcBinaryBlockInfo'
      , All HasBinaryBlockInfo xs
      , All HasNetworkProtocolVersion xs
      , All BlockSupportsLedgerQuery xs
        -- LedgerTables on the HardForkBlock might not be compositionally
        -- defined, but we need to require this instances for any instantiation.
      , HasLedgerTables (LedgerState (HardForkBlock xs))
      , SerializeTablesWithHint (LedgerState (HardForkBlock 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
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)
      ((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
<$> 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 CodecConfig a -> AnnDecoder I a
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 :: forall blk.
SerialiseDiskConstraints blk =>
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
$ (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) -> 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 a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (NP (K PrefixLen) xs -> CollapseTo NP PrefixLen
forall (xs :: [*]) a.
SListIN NP xs =>
NP (K a) xs -> CollapseTo NP a
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
forall (c :: * -> Constraint) (xs :: [*])
       (proxy :: (* -> Constraint) -> *) (f :: * -> *).
AllN NP c xs =>
proxy c -> (forall a. c a => f a) -> NP f xs
hcpure Proxy SingleEraBlock
proxySingle K PrefixLen a
forall a. SingleEraBlock a => K PrefixLen a
reconstructOne

      reconstructOne :: forall blk. SingleEraBlock blk
                     => K PrefixLen blk
      reconstructOne :: forall a. SingleEraBlock a => K PrefixLen a
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 (proxy :: * -> *). proxy (Header blk) -> PrefixLen
forall (f :: * -> *) blk (proxy :: * -> *).
ReconstructNestedCtxt f blk =>
proxy (f blk) -> PrefixLen
reconstructPrefixLen (forall t. Proxy t
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 -> [Char] -> SomeSecond (NestedCtxt Header) (HardForkBlock xs)
forall a. HasCallStack => [Char] -> a
error ([Char] -> SomeSecond (NestedCtxt Header) (HardForkBlock xs))
-> [Char] -> SomeSecond (NestedCtxt Header) (HardForkBlock xs)
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid HardForkBlock with tag: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Word8 -> [Char]
forall a. Show a => a -> [Char]
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 K () a -> SomeSecond (NestedCtxt Header) a
forall a.
SingleEraBlock a =>
K () a -> SomeSecond (NestedCtxt Header) a
reconstructOne NS (K ()) xs
ns
    where
      tag :: Word8
      tag :: Word8
tag = HasCallStack => ShortByteString -> Int -> Word8
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 :: forall a.
SingleEraBlock a =>
K () a -> SomeSecond (NestedCtxt Header) a
reconstructOne K () blk
_ =
          Proxy (Header blk)
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) blk
forall (proxy :: * -> *).
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 (forall t. Proxy t
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 :: forall (xs' :: [*]).
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 xs') b
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs')
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (NestedCtxt_ (HardForkBlock xs') Header b
-> NestedCtxt Header (HardForkBlock xs') b
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_ x Header b
-> NestedCtxt_ (HardForkBlock (x : xs1)) Header b
forall x (a :: * -> *) b (xs1 :: [*]).
NestedCtxt_ x a b -> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCZ NestedCtxt_ x Header b
y))
      injSomeSecond (S NS (SomeSecond (NestedCtxt Header)) xs1
x) = case NS (SomeSecond (NestedCtxt Header)) xs1
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs1)
forall (xs' :: [*]).
NS (SomeSecond (NestedCtxt Header)) xs'
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs')
injSomeSecond NS (SomeSecond (NestedCtxt Header)) xs1
x of
          SomeSecond (NestedCtxt NestedCtxt_ (HardForkBlock xs1) Header b
y) -> NestedCtxt Header (HardForkBlock xs') b
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs')
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (NestedCtxt_ (HardForkBlock xs') Header b
-> NestedCtxt Header (HardForkBlock xs') b
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_ (HardForkBlock xs1) Header b
-> NestedCtxt_ (HardForkBlock (x : xs1)) Header b
forall (xs1 :: [*]) (a :: * -> *) b x.
NestedCtxt_ (HardForkBlock xs1) a b
-> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCS NestedCtxt_ (HardForkBlock xs1) 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 (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K 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 (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @HasBinaryBlockInfo) I a -> K BinaryBlockInfo a
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 :: forall a. HasBinaryBlockInfo a => I a -> K BinaryBlockInfo a
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 {
            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
NS (K SizeInBytes) xs -> CollapseTo NS SizeInBytes
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K 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 (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). 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
  --
  -- This is only thrown by the Node-to-Client codec. Two nodes' negotiated
  -- version does not constrain how the /distributed/ chain will evolve, so the
  -- Node-to-Node communication does not need this. The
  -- 'Ouroboros.Consensus.Protocol.Praos.Common.MaxMajorProtVer' check will
  -- enforce it appropriately and incur explanatory log messages on the node
  -- that needs to be updated in order to handle the latest hard fork.
  --
  -- See 'HardForkNodeToClientEnabled' for the use case.
  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 :: forall (xs :: [*]).
SListI xs =>
NS SingleEraInfo xs -> HardForkEncoderException
futureEraException = NS (K HardForkEncoderException) xs
-> CollapseTo NS HardForkEncoderException
NS (K HardForkEncoderException) xs -> HardForkEncoderException
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K 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 :: forall blk.
SingleEraBlock blk =>
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
forall (proxy :: * -> *). proxy blk -> SingleEraInfo blk
singleEraInfo

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

data AnnDecoder f blk = AnnDecoder {
      forall (f :: * -> *) blk.
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 :: forall (xs :: [*]) (f :: * -> *).
SListI xs =>
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 (xs :: [*]) a.
SListIN SimpleTelescope xs =>
SimpleTelescope (K a) xs -> CollapseTo SimpleTelescope a
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
        ((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) (-.->) f (K Encoding) x -> Current f x -> K Encoding x
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 :: forall blk. 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 :: forall (f :: * -> *) blk.
(-.->) 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 :: forall s (f :: * -> *) (xs :: [*]).
NP (Decoder s :.: f) xs -> Decoder s (HardForkState f xs)
decodeTelescope = \NP (Decoder s :.: f) xs
ds -> do
    ix <- Decoder s Int
forall s. Decoder s Int
Dec.decodeListLen
    if ix < 1
      then fail $ "decodeTelescope: invalid telescope length " ++ show ix
      else HardForkState <$> go (ix - 1) ds
  where
    go :: Int
       -> NP (Decoder s :.: f) xs
       -> Decoder s (Telescope (K Past) (Current f) xs)
    go :: forall s (f :: * -> *) (xs :: [*]).
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) xs1
_)  = Current f x -> Telescope (K Past) (Current f) xs
Current f x -> Telescope (K Past) (Current f) (x : xs1)
forall {k} (f :: k -> *) (x :: k) (g :: k -> *) (xs1 :: [k]).
f x -> Telescope g f (x : xs1)
TZ (Current f x -> Telescope (K Past) (Current f) xs)
-> Decoder s (Current f x)
-> Decoder s (Telescope (K Past) (Current f) 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) xs1
ds) = K Past x
-> Telescope (K Past) (Current f) xs1
-> Telescope (K Past) (Current f) xs
K Past x
-> Telescope (K Past) (Current f) xs1
-> Telescope (K Past) (Current f) (x : xs1)
forall {k} (g :: k -> *) (x :: k) (f :: k -> *) (xs1 :: [k]).
g x -> Telescope g f xs1 -> Telescope g f (x : xs1)
TS (K Past x
 -> Telescope (K Past) (Current f) xs1
 -> Telescope (K Past) (Current f) xs)
-> Decoder s (K Past x)
-> Decoder
     s
     (Telescope (K Past) (Current f) xs1
      -> Telescope (K Past) (Current f) 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) xs1
   -> Telescope (K Past) (Current f) xs)
-> Decoder s (Telescope (K Past) (Current f) xs1)
-> Decoder s (Telescope (K Past) (Current f) xs)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int
-> NP (Decoder s :.: f) xs1
-> Decoder s (Telescope (K Past) (Current f) xs1)
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) xs1
ds
    go Int
_ NP (Decoder s :.: f) xs
Nil            = [Char] -> Decoder s (Telescope (K Past) (Current f) xs)
forall a. HasCallStack => [Char] -> a
error [Char]
"decodeTelescope: invalid telescope length"

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

encodeNS :: SListI xs => NP (f -.-> K Encoding) xs -> NS f xs -> Encoding
encodeNS :: forall (xs :: [*]) (f :: * -> *).
SListI xs =>
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 (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K 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 (-.->) f (K Encoding) a -> f a -> K Encoding a
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 :: forall xs f s. SListI xs => NP (Decoder s :.: f) xs -> Decoder s (NS f xs)
decodeNS :: forall (xs :: [*]) (f :: * -> *) s.
SListI xs =>
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
    i <- Decoder s Word8
forall s. Decoder s Word8
Dec.decodeWord8
    case nsFromIndex i of
      Maybe (NS (K ()) xs)
Nothing -> [Char] -> Decoder s (NS f xs)
forall a. [Char] -> Decoder s a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Decoder s (NS f xs)) -> [Char] -> Decoder s (NS f xs)
forall a b. (a -> b) -> a -> b
$ [Char]
"decodeNS: invalid index " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
i
      Just NS (K ()) xs
ns -> NS (K (Decoder s (NS f xs))) xs
-> CollapseTo NS (Decoder s (NS f xs))
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K (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 Index xs a
-> (:.:) (Decoder s) f a -> K () a -> K (Decoder s (NS f xs)) a
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 :: forall a.
Index xs a
-> (:.:) (Decoder s) f a -> K () a -> K (Decoder s (NS f xs)) a
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]).
All Top xs =>
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 :: forall xs f. SListI xs
            => NP (AnnDecoder f) xs
            -> forall s. Decoder s (Lazy.ByteString -> NS f xs)
decodeAnnNS :: forall (xs :: [*]) (f :: * -> *).
SListI xs =>
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
    i <- Decoder s Word8
forall s. Decoder s Word8
Dec.decodeWord8
    case nsFromIndex i of
      Maybe (NS (K ()) xs)
Nothing -> [Char] -> Decoder s (ByteString -> NS f xs)
forall a. [Char] -> Decoder s a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Decoder s (ByteString -> NS f xs))
-> [Char] -> Decoder s (ByteString -> NS f xs)
forall a b. (a -> b) -> a -> b
$ [Char]
"decodeAnnNS: invalid index " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
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 (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K (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 Index xs a
-> AnnDecoder f a
-> K () a
-> K (Decoder s (ByteString -> NS f xs)) a
forall a.
Index xs a
-> AnnDecoder f a
-> K () a
-> K (Decoder s (ByteString -> NS f xs)) a
forall blk s.
Index xs blk
-> AnnDecoder f blk
-> K () blk
-> K (Decoder s (ByteString -> NS f xs)) blk
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 :: forall blk s.
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]).
All Top xs =>
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 :: forall (f :: * -> *) (xs :: [*]) a.
All (EncodeDiskDep (NestedCtxt f)) xs =>
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 :: forall (f :: * -> *) (xs' :: [*]) a.
All (EncodeDiskDep (NestedCtxt f)) xs' =>
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 xs1
_)  (NCZ NestedCtxt_ x f a
ctxt) = CodecConfig x -> NestedCtxt f x a -> a -> Encoding
forall a. 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
NestedCtxt_ x f a
ctxt)
    go (CodecConfig x
_ :* NP CodecConfig xs1
cs) (NCS NestedCtxt_ (HardForkBlock xs1) f a
ctxt) = NP CodecConfig xs1
-> NestedCtxt_ (HardForkBlock xs1) 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 xs1
cs NestedCtxt_ (HardForkBlock xs1) f a
NestedCtxt_ (HardForkBlock xs1) 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 :: forall (f :: * -> *) (xs :: [*]) a.
All (DecodeDiskDep (NestedCtxt f)) xs =>
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 :: 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'
Nil       NestedCtxt_ (HardForkBlock xs') f a
ctxt       = case NestedCtxt_ (HardForkBlock xs') f a
ctxt of {}
    go (CodecConfig x
c :* NP CodecConfig xs1
_)  (NCZ NestedCtxt_ x f a
ctxt) = CodecConfig x
-> NestedCtxt f x a -> forall s. Decoder s (ByteString -> a)
forall a.
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
NestedCtxt_ x f a
ctxt)
    go (CodecConfig x
_ :* NP CodecConfig xs1
cs) (NCS NestedCtxt_ (HardForkBlock xs1) f a
ctxt) = NP CodecConfig xs1
-> NestedCtxt_ (HardForkBlock xs1) 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 xs1
cs NestedCtxt_ (HardForkBlock xs1) f a
NestedCtxt_ (HardForkBlock xs1) f a
ctxt

encodeNestedCtxt :: All (EncodeDiskDepIx (NestedCtxt f)) xs
                 => CodecConfig (HardForkBlock xs)
                 -> SomeSecond (NestedCtxt f) (HardForkBlock xs)
                 -> Encoding
encodeNestedCtxt :: forall (f :: * -> *) (xs :: [*]).
All (EncodeDiskDepIx (NestedCtxt f)) xs =>
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 :: 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'
Nil       NP (K Word8) xs'
_           NestedCtxt_ (HardForkBlock xs') f a
ctxt       = case NestedCtxt_ (HardForkBlock xs') f a
ctxt of {}
    go (CodecConfig x
_ :* NP CodecConfig xs1
cs) (K Word8 x
_   :* NP (K Word8) xs1
is) (NCS NestedCtxt_ (HardForkBlock xs1) f a
ctxt) = NP CodecConfig xs1
-> NP (K Word8) xs1
-> NestedCtxt_ (HardForkBlock xs1) 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 xs1
cs NP (K Word8) xs1
NP (K Word8) xs1
is NestedCtxt_ (HardForkBlock xs1) f a
NestedCtxt_ (HardForkBlock xs1) f a
ctxt
    go (CodecConfig x
c :* NP CodecConfig xs1
_)  (K Word8
i :* NP (K Word8) xs1
_)  (NCZ NestedCtxt_ x f a
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 {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
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
NestedCtxt_ x f a
ctxt))
        ]

decodeNestedCtxt :: All (DecodeDiskDepIx (NestedCtxt f)) xs
                 => CodecConfig (HardForkBlock xs)
                 -> forall s. Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs))
decodeNestedCtxt :: forall (f :: * -> *) (xs :: [*]).
All (DecodeDiskDepIx (NestedCtxt f)) xs =>
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
    tag <- Decoder s Word8
forall s. Decoder s Word8
forall a s. Serialise a => Decoder s a
Serialise.decode
    case nsFromIndex tag of
      Maybe (NS (K ()) xs)
Nothing -> [Char] -> Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs))
forall a. [Char] -> Decoder s a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
 -> Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs)))
-> [Char]
-> Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs))
forall a b. (a -> b) -> a -> b
$ [Char]
"decodeNestedCtxt: invalid tag " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
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 :: 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'
Nil       NS (K ()) xs'
i     = case NS (K ()) xs'
i of {}
    go (CodecConfig x
c :* NP CodecConfig xs1
_)  (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 NestedCtxt_ x f a -> NestedCtxt_ (HardForkBlock xs') f a
NestedCtxt_ x f a -> NestedCtxt_ (HardForkBlock (x : xs1)) f a
forall a. NestedCtxt_ x f a -> NestedCtxt_ (HardForkBlock xs') f a
forall x (a :: * -> *) b (xs1 :: [*]).
NestedCtxt_ x a b -> NestedCtxt_ (HardForkBlock (x : xs1)) a b
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 s. 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 xs1
cs) (S NS (K ()) xs1
i) = (forall a.
 NestedCtxt_ (HardForkBlock xs1) f a
 -> NestedCtxt_ (HardForkBlock xs') f a)
-> SomeSecond (NestedCtxt f) (HardForkBlock xs1)
-> 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 NestedCtxt_ (HardForkBlock xs1) f a
-> NestedCtxt_ (HardForkBlock xs') f a
NestedCtxt_ (HardForkBlock xs1) f a
-> NestedCtxt_ (HardForkBlock (x : xs1)) f a
forall (xs1 :: [*]) (a :: * -> *) b x.
NestedCtxt_ (HardForkBlock xs1) a b
-> NestedCtxt_ (HardForkBlock (x : xs1)) a b
forall a.
NestedCtxt_ (HardForkBlock xs1) f a
-> NestedCtxt_ (HardForkBlock xs') f a
NCS (SomeSecond (NestedCtxt f) (HardForkBlock xs1)
 -> SomeSecond (NestedCtxt f) (HardForkBlock xs'))
-> Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs1))
-> Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NP CodecConfig xs1
-> NS (K ()) xs1
-> forall s.
   Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs1))
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 xs1
cs NS (K ()) xs1
NS (K ()) xs1
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 :: forall (xs :: [*]) a.
SListI xs =>
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. (HasCallStack, Exception e) => e -> a
throw (HardForkEncoderException -> Encoding)
-> HardForkEncoderException -> Encoding
forall a b. (a -> b) -> a -> b
$ NS SingleEraInfo xs1 -> HardForkEncoderException
forall (xs :: [*]).
SListI xs =>
NS SingleEraInfo xs -> HardForkEncoderException
futureEraException (MismatchEraInfo (x : xs1) -> NS SingleEraInfo xs1
forall (xs :: [*]) x.
SListI xs =>
MismatchEraInfo (x : xs) -> NS SingleEraInfo xs
mismatchFutureEra MismatchEraInfo xs
MismatchEraInfo (x : xs1)
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 (xs :: [*]) (f :: * -> *).
SListIN NP xs =>
(forall a. f a) -> NP f 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 (xs :: [*]) (f :: * -> *).
SListIN NP xs =>
(forall a. f a) -> NP f 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 :: forall blk. 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 :: forall (xs :: [*]) s a.
SListI xs =>
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
        tag <- Decoder s Int
forall s. Decoder s Int
Dec.decodeListLen
        case 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 era1 <- NP (Decoder s :.: SingleEraInfo) xs
-> Decoder s (NS SingleEraInfo xs)
forall (xs :: [*]) (f :: * -> *) s.
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 (xs :: [*]) (f :: * -> *).
SListIN NP xs =>
(forall a. f a) -> NP f 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))
                  era2 <- decodeNS (hpure (Comp (LedgerEraInfo <$> decodeName)))
                  case Match.matchNS era1 era2 of
                    Left Mismatch SingleEraInfo LedgerEraInfo xs
err -> Either (MismatchEraInfo xs) a
-> Decoder s (Either (MismatchEraInfo xs) a)
forall a. a -> Decoder s 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
_  -> [Char] -> Decoder s (Either (MismatchEraInfo xs) a)
forall a. [Char] -> Decoder s a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"dispatchDecoderErr: unexpected match"
          Int
_ -> [Char] -> Decoder s (Either (MismatchEraInfo xs) a)
forall a. [Char] -> Decoder s a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Decoder s (Either (MismatchEraInfo xs) a))
-> [Char] -> Decoder s (Either (MismatchEraInfo xs) a)
forall a b. (a -> b) -> a -> b
$ [Char]
"dispatchDecoderErr: invalid tag " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
tag
  where
    decodeName :: forall blk s. Decoder s (SingleEraInfo blk)
    decodeName :: forall blk s. 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 s. Decoder s Text
forall a s. Serialise a => Decoder s a
Serialise.decode

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

distribSerialisedHeader :: SerialisedHeader (HardForkBlock xs)
                        -> NS SerialisedHeader xs
distribSerialisedHeader :: forall (xs :: [*]).
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 :: forall (xs :: [*]) a.
NestedCtxt_ (HardForkBlock xs) Header a
-> Serialised a -> NS SerialisedHeader xs
go (NCZ NestedCtxt_ x Header a
c) = SerialisedHeader x -> NS SerialisedHeader xs
SerialisedHeader x -> NS SerialisedHeader (x : xs1)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (SerialisedHeader x -> NS SerialisedHeader xs)
-> (Serialised a -> SerialisedHeader x)
-> Serialised a
-> NS SerialisedHeader 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 {k} (f :: k -> *) (a :: k) (g :: k -> *).
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 NestedCtxt_ (HardForkBlock xs1) Header a
c) = NS SerialisedHeader xs1 -> NS SerialisedHeader xs
NS SerialisedHeader xs1 -> NS SerialisedHeader (x : xs1)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS SerialisedHeader xs1 -> NS SerialisedHeader xs)
-> (Serialised a -> NS SerialisedHeader xs1)
-> Serialised a
-> NS SerialisedHeader xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedCtxt_ (HardForkBlock xs1) Header a
-> Serialised a -> NS SerialisedHeader xs1
forall (xs :: [*]) a.
NestedCtxt_ (HardForkBlock xs) Header a
-> Serialised a -> NS SerialisedHeader xs
go NestedCtxt_ (HardForkBlock xs1) Header a
c

undistribSerialisedHeader :: NS SerialisedHeader xs
                          -> SerialisedHeader (HardForkBlock xs)
undistribSerialisedHeader :: forall (xs :: [*]).
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 :: forall (xs :: [*]).
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 xs) a
-> Serialised a
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
forall {k} (f :: k -> *) (a :: k) (g :: k -> *).
f a -> g a -> GenDepPair g f
GenDepPair (NestedCtxt_ (HardForkBlock xs) Header a
-> NestedCtxt Header (HardForkBlock xs) a
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_ x Header a
-> NestedCtxt_ (HardForkBlock (x : xs1)) Header a
forall x (a :: * -> *) b (xs1 :: [*]).
NestedCtxt_ x a b -> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCZ NestedCtxt_ x Header a
c)) Serialised a
bs
    go (S NS SerialisedHeader xs1
bs) =
        (forall a.
 NestedCtxt Header (HardForkBlock xs1) a
 -> NestedCtxt Header (HardForkBlock xs) a)
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs1))
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
forall {k} (f :: k -> *) (f' :: k -> *) (g :: k -> *).
(forall (a :: k). f a -> f' a) -> GenDepPair g f -> GenDepPair g f'
depPairFirst ((NestedCtxt_ (HardForkBlock xs1) Header a
 -> NestedCtxt_ (HardForkBlock xs) Header a)
-> NestedCtxt Header (HardForkBlock xs1) a
-> NestedCtxt Header (HardForkBlock 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 xs1) Header a
-> NestedCtxt_ (HardForkBlock xs) Header a
NestedCtxt_ (HardForkBlock xs1) Header a
-> NestedCtxt_ (HardForkBlock (x : xs1)) Header a
forall (xs1 :: [*]) (a :: * -> *) b x.
NestedCtxt_ (HardForkBlock xs1) a b
-> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCS) (GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs1))
 -> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs)))
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs1))
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
forall a b. (a -> b) -> a -> b
$ NS SerialisedHeader xs1
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs1))
forall (xs :: [*]).
NS SerialisedHeader xs
-> GenDepPair Serialised (NestedCtxt Header (HardForkBlock xs))
go NS SerialisedHeader xs1
bs

distribQueryIfCurrent ::
     SomeBlockQuery (QueryIfCurrent xs)
  -> NS (SomeBlockQuery :.: BlockQuery) xs
distribQueryIfCurrent :: forall (xs :: [*]).
SomeBlockQuery (QueryIfCurrent xs)
-> NS (SomeBlockQuery :.: BlockQuery) xs
distribQueryIfCurrent = SomeBlockQuery (QueryIfCurrent xs)
-> NS (SomeBlockQuery :.: BlockQuery) xs
forall (xs :: [*]).
SomeBlockQuery (QueryIfCurrent xs)
-> NS (SomeBlockQuery :.: BlockQuery) xs
go
  where
    go :: SomeBlockQuery (QueryIfCurrent xs) -> NS (SomeBlockQuery :.: BlockQuery) xs
    go :: forall (xs :: [*]).
SomeBlockQuery (QueryIfCurrent xs)
-> NS (SomeBlockQuery :.: BlockQuery) xs
go (SomeBlockQuery (QZ BlockQuery x footprint result
qry)) = (:.:) SomeBlockQuery BlockQuery x
-> NS (SomeBlockQuery :.: BlockQuery) (x : xs1)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (SomeBlockQuery (BlockQuery x) -> (:.:) SomeBlockQuery BlockQuery x
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (BlockQuery x footprint result -> SomeBlockQuery (BlockQuery x)
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery x footprint result
qry))
    go (SomeBlockQuery (QS QueryIfCurrent xs1 footprint result
qry)) = NS (SomeBlockQuery :.: BlockQuery) xs1
-> NS (SomeBlockQuery :.: BlockQuery) (x : xs1)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (SomeBlockQuery (QueryIfCurrent xs1)
-> NS (SomeBlockQuery :.: BlockQuery) xs1
forall (xs :: [*]).
SomeBlockQuery (QueryIfCurrent xs)
-> NS (SomeBlockQuery :.: BlockQuery) xs
go (QueryIfCurrent xs1 footprint result
-> SomeBlockQuery (QueryIfCurrent xs1)
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery QueryIfCurrent xs1 footprint result
qry))

undistribQueryIfCurrent ::
     NS (SomeBlockQuery :.: BlockQuery) xs
  -> SomeBlockQuery (QueryIfCurrent xs)
undistribQueryIfCurrent :: forall (xs :: [*]).
NS (SomeBlockQuery :.: BlockQuery) xs
-> SomeBlockQuery (QueryIfCurrent xs)
undistribQueryIfCurrent = NS (SomeBlockQuery :.: BlockQuery) xs
-> SomeBlockQuery (QueryIfCurrent xs)
forall (xs :: [*]).
NS (SomeBlockQuery :.: BlockQuery) xs
-> SomeBlockQuery (QueryIfCurrent xs)
go
  where
    go :: NS (SomeBlockQuery :.: BlockQuery) xs -> SomeBlockQuery (QueryIfCurrent xs)
    go :: forall (xs :: [*]).
NS (SomeBlockQuery :.: BlockQuery) xs
-> SomeBlockQuery (QueryIfCurrent xs)
go (Z (:.:) SomeBlockQuery BlockQuery x
qry) = case (:.:) SomeBlockQuery BlockQuery x
qry of
                   Comp (SomeBlockQuery BlockQuery x footprint result
qry') ->
                     QueryIfCurrent xs footprint result
-> SomeBlockQuery (QueryIfCurrent xs)
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery x footprint result
-> QueryIfCurrent (x : xs1) footprint result
forall x (footprint :: QueryFootprint) result (xs1 :: [*]).
BlockQuery x footprint result
-> QueryIfCurrent (x : xs1) footprint result
QZ BlockQuery x footprint result
qry')
    go (S NS (SomeBlockQuery :.: BlockQuery) xs1
qry) = case NS (SomeBlockQuery :.: BlockQuery) xs1
-> SomeBlockQuery (QueryIfCurrent xs1)
forall (xs :: [*]).
NS (SomeBlockQuery :.: BlockQuery) xs
-> SomeBlockQuery (QueryIfCurrent xs)
go NS (SomeBlockQuery :.: BlockQuery) xs1
qry of
                   SomeBlockQuery QueryIfCurrent xs1 footprint result
qry' ->
                     QueryIfCurrent xs footprint result
-> SomeBlockQuery (QueryIfCurrent xs)
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (QueryIfCurrent xs1 footprint result
-> QueryIfCurrent (x : xs1) footprint result
forall (xs1 :: [*]) (footprint :: QueryFootprint) result x.
QueryIfCurrent xs1 footprint result
-> QueryIfCurrent (x : xs1) footprint result
QS QueryIfCurrent xs1 footprint result
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 {
      forall (f :: * -> *) (xs :: [*]). 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
forall (c :: * -> Constraint) (xs :: [*])
       (proxy :: (* -> Constraint) -> *) (f :: * -> *).
AllN NP c xs =>
proxy c -> (forall a. c a => f a) -> NP f xs
hcpure (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). 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 :: forall s. Decoder s (SerialiseNS f xs)
decode = NS f xs -> SerialiseNS f xs
forall (f :: * -> *) (xs :: [*]). NS f xs -> SerialiseNS f xs
SerialiseNS
       (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
<$> NP (Decoder s :.: f) xs -> Decoder s (NS f xs)
forall (xs :: [*]) (f :: * -> *) s.
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
forall (c :: * -> Constraint) (xs :: [*])
       (proxy :: (* -> Constraint) -> *) (f :: * -> *).
AllN NP c xs =>
proxy c -> (forall a. c a => f a) -> NP f xs
hcpure (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). 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 s. Decoder s (f a)
forall a s. Serialise a => Decoder s a
Serialise.decode))