{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.HardFork.Combinator.Serialisation.SerialiseNodeToClient () where

import Cardano.Binary (enforceSize)
import Codec.CBOR.Decoding (Decoder)
import qualified Codec.CBOR.Decoding as Dec
import Codec.CBOR.Encoding (Encoding, encodeListLen)
import qualified Codec.CBOR.Encoding as Enc
import qualified Codec.Serialise as Serialise
import Control.Exception (throw)
import Data.Maybe (catMaybes)
import Data.Proxy
import Data.SOP.BasicFunctors
import Data.SOP.Constraint
import Data.SOP.Counting
import Data.SOP.NonEmpty
  ( ProofNonEmpty (..)
  , checkIsNonEmpty
  , isNonEmpty
  )
import Data.SOP.Sing (lengthSList)
import Data.SOP.Strict
import qualified Data.Text as T
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.HardFork.Combinator.Abstract.SingleEraBlock
import Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import Ouroboros.Consensus.HardFork.Combinator.Basics
import Ouroboros.Consensus.HardFork.Combinator.Ledger.Query
import Ouroboros.Consensus.HardFork.Combinator.Mempool
import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
import Ouroboros.Consensus.HardFork.Combinator.Serialisation.SerialiseDisk ()
import qualified Ouroboros.Consensus.HardFork.History as History
import Ouroboros.Consensus.Ledger.Query
import Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId)
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.Node.Run
import Ouroboros.Consensus.Node.Serialisation
import Ouroboros.Consensus.Util ((.:))
import Ouroboros.Network.Block
  ( Serialised
  , unwrapCBORinCBOR
  , wrapCBORinCBOR
  )

{-------------------------------------------------------------------------------
  Serialisation of products
-------------------------------------------------------------------------------}

-- | Encoding of @NP f xs@ while filtering out the components for disabled eras
-- as indicated by the 'HardForkNodeToClientVersion xs'. Disabled eras imply
-- that the protocol version does not support those eras. Hence, omitting the
-- corresponding elements is the correct behavior.
encodeNodeToClientNP ::
  forall f xs.
  SerialiseHFC xs =>
  -- | The encoding of the individual elements (assuming era `x` is enabled).
  ( forall x.
    SerialiseConstraintsHFC x =>
    CodecConfig x ->
    BlockNodeToClientVersion x ->
    f x ->
    Encoding
  ) ->
  CodecConfig (HardForkBlock xs) ->
  HardForkNodeToClientVersion xs ->
  NP f xs ->
  Encoding
encodeNodeToClientNP :: forall (f :: * -> *) (xs :: [*]).
SerialiseHFC xs =>
(forall x.
 SerialiseConstraintsHFC x =>
 CodecConfig x -> BlockNodeToClientVersion x -> f x -> Encoding)
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> NP f xs
-> Encoding
encodeNodeToClientNP
  forall x.
SerialiseConstraintsHFC x =>
CodecConfig x -> BlockNodeToClientVersion x -> f x -> Encoding
encodeElement
  (HardForkCodecConfig (PerEraCodecConfig NP CodecConfig xs
ccfgs))
  HardForkNodeToClientVersion xs
version
  NP f xs
xs
    | Just String
err <- HardForkNodeToClientVersion xs -> Maybe String
forall (xs :: [*]).
SerialiseHFC xs =>
HardForkNodeToClientVersion xs -> Maybe String
validateHardForkNodeToClientVersion HardForkNodeToClientVersion xs
version =
        String -> Encoding
forall a. HasCallStack => String -> a
error String
err
    | Bool
otherwise =
        case HardForkNodeToClientVersion xs
version of
          HardForkNodeToClientDisabled BlockNodeToClientVersion x
versionX -> case NP CodecConfig xs
ccfgs of
            CodecConfig x
ccfg :* NP CodecConfig xs1
_ -> case NP f xs
xs of
              f x
x :* NP f xs1
_ -> CodecConfig x -> BlockNodeToClientVersion x -> f x -> Encoding
forall x.
SerialiseConstraintsHFC x =>
CodecConfig x -> BlockNodeToClientVersion x -> f x -> Encoding
encodeElement CodecConfig x
ccfg BlockNodeToClientVersion x
BlockNodeToClientVersion x
versionX f x
f x
x
          HardForkNodeToClientEnabled HardForkSpecificNodeToClientVersion
_ NP EraNodeToClientVersion xs
subVersions ->
            let components :: [Encoding]
                components :: [Encoding]
components =
                  [Maybe Encoding] -> [Encoding]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Encoding] -> [Encoding]) -> [Maybe Encoding] -> [Encoding]
forall a b. (a -> b) -> a -> b
$
                    NP (K (Maybe Encoding)) xs -> CollapseTo NP (Maybe Encoding)
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 (Maybe Encoding)) xs -> CollapseTo NP (Maybe Encoding))
-> NP (K (Maybe Encoding)) xs -> CollapseTo NP (Maybe Encoding)
forall a b. (a -> b) -> a -> b
$
                      Proxy SerialiseConstraintsHFC
-> (forall a.
    SerialiseConstraintsHFC a =>
    CodecConfig a
    -> EraNodeToClientVersion a -> f a -> K (Maybe Encoding) a)
-> Prod NP CodecConfig xs
-> Prod NP EraNodeToClientVersion xs
-> NP f xs
-> NP (K (Maybe Encoding)) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *) (f''' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a -> f''' a)
-> Prod h f xs
-> Prod h f' xs
-> h f'' xs
-> h f''' xs
hczipWith3
                        (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @SerialiseConstraintsHFC)
                        ( \CodecConfig a
ccfg EraNodeToClientVersion a
subVersionMay f a
x -> Maybe Encoding -> K (Maybe Encoding) a
forall k a (b :: k). a -> K a b
K (Maybe Encoding -> K (Maybe Encoding) a)
-> Maybe Encoding -> K (Maybe Encoding) a
forall a b. (a -> b) -> a -> b
$ case EraNodeToClientVersion a
subVersionMay of
                            EraNodeToClientEnabled BlockNodeToClientVersion a
subVersion -> Encoding -> Maybe Encoding
forall a. a -> Maybe a
Just (CodecConfig a -> BlockNodeToClientVersion a -> f a -> Encoding
forall x.
SerialiseConstraintsHFC x =>
CodecConfig x -> BlockNodeToClientVersion x -> f x -> Encoding
encodeElement CodecConfig a
ccfg BlockNodeToClientVersion a
subVersion f a
x)
                            -- Omit disabled eras
                            EraNodeToClientVersion a
EraNodeToClientDisabled -> Maybe Encoding
forall a. Maybe a
Nothing
                        )
                        Prod NP CodecConfig xs
NP CodecConfig xs
ccfgs
                        Prod NP EraNodeToClientVersion xs
NP EraNodeToClientVersion xs
subVersions
                        NP f xs
xs
                listLen :: Word
listLen = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Encoding] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Encoding]
components)
             in Word -> Encoding
Enc.encodeListLen Word
listLen Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [Encoding]
components

-- | Decoding of `NP f xs`. If any eras are disabled in the version and hence
-- missing in the serialisation, then this throws an exception. In effect,
-- deserialisation of product types is only supported when the sender uses an
-- equal or superset of eras.
decodeNodeToClientNP ::
  forall f xs.
  SerialiseHFC xs =>
  -- | The decoding of the individual elements (assuming era `x` is enabled).
  ( forall x.
    SerialiseConstraintsHFC x =>
    CodecConfig x ->
    BlockNodeToClientVersion x ->
    (forall s. Decoder s (f x))
  ) ->
  CodecConfig (HardForkBlock xs) ->
  HardForkNodeToClientVersion xs ->
  (forall s. Decoder s (NP f xs))
decodeNodeToClientNP :: forall (f :: * -> *) (xs :: [*]).
SerialiseHFC xs =>
(forall x.
 SerialiseConstraintsHFC x =>
 CodecConfig x
 -> BlockNodeToClientVersion x -> forall s. Decoder s (f x))
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> forall s. Decoder s (NP f xs)
decodeNodeToClientNP
  forall x.
SerialiseConstraintsHFC x =>
CodecConfig x
-> BlockNodeToClientVersion x -> forall s. Decoder s (f x)
decodeElement
  (HardForkCodecConfig (PerEraCodecConfig NP CodecConfig xs
ccfgs))
  HardForkNodeToClientVersion xs
version
    | Just String
err <- HardForkNodeToClientVersion xs -> Maybe String
forall (xs :: [*]).
SerialiseHFC xs =>
HardForkNodeToClientVersion xs -> Maybe String
validateHardForkNodeToClientVersion HardForkNodeToClientVersion xs
version =
        String -> Decoder s (NP f xs)
forall a. HasCallStack => String -> a
error String
err
    | Bool
otherwise =
        case HardForkNodeToClientVersion xs
version of
          HardForkNodeToClientDisabled BlockNodeToClientVersion x
versionX -> case NP CodecConfig xs
ccfgs of
            (CodecConfig x
ccfg :* NP CodecConfig xs1
Nil) -> do
              singleElement <- CodecConfig x
-> BlockNodeToClientVersion x -> forall s. Decoder s (f x)
forall x.
SerialiseConstraintsHFC x =>
CodecConfig x
-> BlockNodeToClientVersion x -> forall s. Decoder s (f x)
decodeElement CodecConfig x
ccfg BlockNodeToClientVersion x
BlockNodeToClientVersion x
versionX
              return (singleElement :* Nil)
            NP CodecConfig xs
_ -> Decoder s (NP f xs)
forall s a. Decoder s a
failVersion
          HardForkNodeToClientEnabled HardForkSpecificNodeToClientVersion
_ NP EraNodeToClientVersion xs
subVersions -> do
            Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
failVersionTxt Int
expectedN
            NP (Decoder s :.: f) xs -> Decoder s (NP f xs)
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
(SListIN NP xs, Applicative f) =>
NP (f :.: g) xs -> f (NP g xs)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: * -> *)
       (g :: k -> *).
(HSequence h, SListIN h xs, Applicative f) =>
h (f :.: g) xs -> f (h g xs)
hsequence' (NP (Decoder s :.: f) xs -> Decoder s (NP f xs))
-> NP (Decoder s :.: f) xs -> Decoder s (NP f xs)
forall a b. (a -> b) -> a -> b
$
              Proxy SerialiseConstraintsHFC
-> (forall a.
    SerialiseConstraintsHFC a =>
    CodecConfig a -> EraNodeToClientVersion a -> (:.:) (Decoder s) f a)
-> Prod NP CodecConfig xs
-> NP EraNodeToClientVersion xs
-> NP (Decoder s :.: f) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hczipWith
                (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @SerialiseConstraintsHFC)
                ( \CodecConfig a
ccfg EraNodeToClientVersion a
subVersionMay -> 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) -> (:.:) (Decoder s) f a)
-> Decoder s (f a) -> (:.:) (Decoder s) f a
forall a b. (a -> b) -> a -> b
$ case EraNodeToClientVersion a
subVersionMay of
                    EraNodeToClientEnabled BlockNodeToClientVersion a
subVersion -> CodecConfig a
-> BlockNodeToClientVersion a -> forall s. Decoder s (f a)
forall x.
SerialiseConstraintsHFC x =>
CodecConfig x
-> BlockNodeToClientVersion x -> forall s. Decoder s (f x)
decodeElement CodecConfig a
ccfg BlockNodeToClientVersion a
subVersion
                    -- Fail if any era is disabled
                    EraNodeToClientVersion a
EraNodeToClientDisabled -> Decoder s (f a)
forall s a. Decoder s a
failVersion
                )
                Prod NP CodecConfig xs
NP CodecConfig xs
ccfgs
                NP EraNodeToClientVersion xs
subVersions
   where
    expectedN :: Int
expectedN = Proxy xs -> Int
forall k (xs :: [k]) (proxy :: [k] -> *).
SListI xs =>
proxy xs -> Int
lengthSList (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs)

    failVersion :: Decoder s a
    failVersion :: forall s a. Decoder s a
failVersion = String -> Decoder s a
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
failVersionStr
    failVersionStr :: String
failVersionStr = String
"decodeNodeToClient: (NP f xs): incompatible node-to-client version"
    failVersionTxt :: Text
failVersionTxt = String -> Text
T.pack String
failVersionStr

-- | Check that @version@ consists of a run of 0 or more enabled eras followed
-- by a run of 0 or more disabled eras. Returns an error message if not.
validateHardForkNodeToClientVersion ::
  SerialiseHFC xs =>
  HardForkNodeToClientVersion xs ->
  Maybe String
validateHardForkNodeToClientVersion :: forall (xs :: [*]).
SerialiseHFC xs =>
HardForkNodeToClientVersion xs -> Maybe String
validateHardForkNodeToClientVersion HardForkNodeToClientVersion xs
version = case HardForkNodeToClientVersion xs
version of
  HardForkNodeToClientDisabled BlockNodeToClientVersion x
_ -> Maybe String
forall a. Maybe a
Nothing
  HardForkNodeToClientEnabled HardForkSpecificNodeToClientVersion
_ NP EraNodeToClientVersion xs
subVersions -> NP EraNodeToClientVersion xs -> Maybe String
forall (xs' :: [*]). NP EraNodeToClientVersion xs' -> Maybe String
goEnabled NP EraNodeToClientVersion xs
subVersions
 where
  goEnabled :: NP EraNodeToClientVersion xs' -> Maybe String
  goEnabled :: forall (xs' :: [*]). NP EraNodeToClientVersion xs' -> Maybe String
goEnabled NP EraNodeToClientVersion xs'
v = case NP EraNodeToClientVersion xs'
v of
    NP EraNodeToClientVersion xs'
Nil -> Maybe String
forall a. Maybe a
Nothing
    EraNodeToClientEnabled BlockNodeToClientVersion x
_ :* NP EraNodeToClientVersion xs1
v' -> NP EraNodeToClientVersion xs1 -> Maybe String
forall (xs' :: [*]). NP EraNodeToClientVersion xs' -> Maybe String
goEnabled NP EraNodeToClientVersion xs1
v'
    EraNodeToClientVersion x
EraNodeToClientDisabled :* NP EraNodeToClientVersion xs1
v' -> NP EraNodeToClientVersion xs1 -> Maybe String
forall (xs' :: [*]). NP EraNodeToClientVersion xs' -> Maybe String
goDisabled NP EraNodeToClientVersion xs1
v'

  goDisabled :: NP EraNodeToClientVersion xs' -> Maybe String
  goDisabled :: forall (xs' :: [*]). NP EraNodeToClientVersion xs' -> Maybe String
goDisabled NP EraNodeToClientVersion xs'
v = case NP EraNodeToClientVersion xs'
v of
    NP EraNodeToClientVersion xs'
Nil -> Maybe String
forall a. Maybe a
Nothing
    EraNodeToClientEnabled BlockNodeToClientVersion x
_ :* NP EraNodeToClientVersion xs1
_ ->
      String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$
        String
"Expected HardForkNodeToClientVersion to consists of a run of 0 or more"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" enabled eras followed by a run of 0 or more disabled eras, but got: "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HardForkNodeToClientVersion xs -> String
forall a. Show a => a -> String
show HardForkNodeToClientVersion xs
version
    EraNodeToClientVersion x
EraNodeToClientDisabled :* NP EraNodeToClientVersion xs1
v' -> NP EraNodeToClientVersion xs1 -> Maybe String
forall (xs' :: [*]). NP EraNodeToClientVersion xs' -> Maybe String
goDisabled NP EraNodeToClientVersion xs1
v'

instance SerialiseHFC xs => SerialiseNodeToClientConstraints (HardForkBlock xs)

instance SerialiseHFC xs => SerialiseNodeToClient (HardForkBlock xs) (HardForkLedgerConfig xs) where
  encodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> HardForkLedgerConfig xs
-> Encoding
encodeNodeToClient CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version (HardForkLedgerConfig Shape xs
hflcShape PerEraLedgerConfig xs
perEraLedgerConfig) =
    [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
      [ Word -> Encoding
encodeListLen Word
2
      , forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient @_ @(History.Shape xs) CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version Shape xs
hflcShape
      , forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient @_ @(PerEraLedgerConfig xs) CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version PerEraLedgerConfig xs
perEraLedgerConfig
      ]
  decodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (HardForkLedgerConfig xs)
decodeNodeToClient CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"HardForkLedgerConfig" Int
2
    Shape xs -> PerEraLedgerConfig xs -> HardForkLedgerConfig xs
forall (xs :: [*]).
Shape xs -> PerEraLedgerConfig xs -> HardForkLedgerConfig xs
HardForkLedgerConfig
      (Shape xs -> PerEraLedgerConfig xs -> HardForkLedgerConfig xs)
-> Decoder s (Shape xs)
-> Decoder s (PerEraLedgerConfig xs -> HardForkLedgerConfig xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient @_ @(History.Shape xs) CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version
      Decoder s (PerEraLedgerConfig xs -> HardForkLedgerConfig xs)
-> Decoder s (PerEraLedgerConfig xs)
-> Decoder s (HardForkLedgerConfig 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
<*> forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient @_ @(PerEraLedgerConfig xs) CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version

instance SerialiseHFC xs => SerialiseNodeToClient (HardForkBlock xs) (History.Shape xs) where
  encodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> Shape xs
-> Encoding
encodeNodeToClient CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version (History.Shape (Exactly NP (K EraParams) xs
xs)) =
    (forall x.
 SerialiseConstraintsHFC x =>
 CodecConfig x
 -> BlockNodeToClientVersion x -> K EraParams x -> Encoding)
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> NP (K EraParams) xs
-> Encoding
forall (f :: * -> *) (xs :: [*]).
SerialiseHFC xs =>
(forall x.
 SerialiseConstraintsHFC x =>
 CodecConfig x -> BlockNodeToClientVersion x -> f x -> Encoding)
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> NP f xs
-> Encoding
encodeNodeToClientNP
      (\CodecConfig x
_ BlockNodeToClientVersion x
_ (K EraParams
a) -> EraParams -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode EraParams
a)
      CodecConfig (HardForkBlock xs)
ccfg
      BlockNodeToClientVersion (HardForkBlock xs)
HardForkNodeToClientVersion xs
version
      NP (K EraParams) xs
xs
  decodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (Shape xs)
decodeNodeToClient CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version =
    Exactly xs EraParams -> Shape xs
forall (xs :: [*]). Exactly xs EraParams -> Shape xs
History.Shape (Exactly xs EraParams -> Shape xs)
-> (NP (K EraParams) xs -> Exactly xs EraParams)
-> NP (K EraParams) xs
-> Shape xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP (K EraParams) xs -> Exactly xs EraParams
forall (xs :: [*]) a. NP (K a) xs -> Exactly xs a
Exactly
      (NP (K EraParams) xs -> Shape xs)
-> Decoder s (NP (K EraParams) xs) -> Decoder s (Shape xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall x.
 SerialiseConstraintsHFC x =>
 CodecConfig x
 -> BlockNodeToClientVersion x
 -> forall s. Decoder s (K EraParams x))
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> forall s. Decoder s (NP (K EraParams) xs)
forall (f :: * -> *) (xs :: [*]).
SerialiseHFC xs =>
(forall x.
 SerialiseConstraintsHFC x =>
 CodecConfig x
 -> BlockNodeToClientVersion x -> forall s. Decoder s (f x))
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> forall s. Decoder s (NP f xs)
decodeNodeToClientNP
        (\CodecConfig x
_ BlockNodeToClientVersion x
_ -> EraParams -> K EraParams x
forall k a (b :: k). a -> K a b
K (EraParams -> K EraParams x)
-> Decoder s EraParams -> Decoder s (K EraParams x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s EraParams
forall s. Decoder s EraParams
forall a s. Serialise a => Decoder s a
Serialise.decode)
        CodecConfig (HardForkBlock xs)
ccfg
        BlockNodeToClientVersion (HardForkBlock xs)
HardForkNodeToClientVersion xs
version

{-------------------------------------------------------------------------------
  Dispatch to first era or HFC
-------------------------------------------------------------------------------}

dispatchEncoder ::
  forall f xs.
  ( SerialiseHFC xs
  , forall blk.
    SerialiseNodeToClientConstraints blk =>
    SerialiseNodeToClient blk (f blk)
  ) =>
  CodecConfig (HardForkBlock xs) ->
  BlockNodeToClientVersion (HardForkBlock xs) ->
  NS f xs ->
  Encoding
dispatchEncoder :: forall (f :: * -> *) (xs :: [*]).
(SerialiseHFC xs,
 forall blk.
 SerialiseNodeToClientConstraints blk =>
 SerialiseNodeToClient blk (f blk)) =>
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> NS f xs
-> Encoding
dispatchEncoder CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version NS f xs
ns =
  case Proxy xs -> ProofNonEmpty xs
forall {a} (xs :: [a]) (proxy :: [a] -> *).
IsNonEmpty xs =>
proxy xs -> ProofNonEmpty xs
forall (proxy :: [*] -> *). proxy xs -> ProofNonEmpty xs
isNonEmpty (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs) of
    ProofNonEmpty{} ->
      case (NP CodecConfig xs
ccfgs, BlockNodeToClientVersion (HardForkBlock xs)
HardForkNodeToClientVersion xs
version, NS f xs
ns) of
        (CodecConfig x
c0 :* NP CodecConfig xs1
_, HardForkNodeToClientDisabled BlockNodeToClientVersion x
v0, Z f x
x0) ->
          CodecConfig x -> BlockNodeToClientVersion x -> f x -> Encoding
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient CodecConfig x
c0 BlockNodeToClientVersion x
BlockNodeToClientVersion x
v0 f x
x0
        (NP CodecConfig xs
_, HardForkNodeToClientDisabled BlockNodeToClientVersion x
_, S NS f xs1
later) ->
          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 (NS f xs1 -> NS SingleEraInfo xs1
forall (xs :: [*]) (f :: * -> *).
All SingleEraBlock xs =>
NS f xs -> NS SingleEraInfo xs
notFirstEra NS f xs1
later)
        (NP CodecConfig xs
_, HardForkNodeToClientEnabled HardForkSpecificNodeToClientVersion
_ NP EraNodeToClientVersion xs
versions, NS f xs
_) ->
          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 SerialiseConstraintsHFC
-> (forall a.
    SerialiseConstraintsHFC a =>
    CodecConfig a
    -> EraNodeToClientVersion a -> (-.->) f (K Encoding) a)
-> Prod NP CodecConfig xs
-> NP EraNodeToClientVersion xs
-> NP (f -.-> K Encoding) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hczipWith Proxy SerialiseConstraintsHFC
pSHFC CodecConfig a
-> EraNodeToClientVersion a -> (-.->) f (K Encoding) a
forall blk.
(SingleEraBlock blk, SerialiseNodeToClientConstraints blk) =>
CodecConfig blk
-> EraNodeToClientVersion blk -> (-.->) f (K Encoding) blk
forall a.
SerialiseConstraintsHFC a =>
CodecConfig a
-> EraNodeToClientVersion a -> (-.->) f (K Encoding) a
aux Prod NP CodecConfig xs
NP CodecConfig xs
ccfgs NP EraNodeToClientVersion xs
versions) NS f xs
ns
 where
  ccfgs :: NP CodecConfig xs
ccfgs = PerEraCodecConfig xs -> NP CodecConfig xs
forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs
getPerEraCodecConfig (PerEraCodecConfig xs -> NP CodecConfig xs)
-> PerEraCodecConfig xs -> NP CodecConfig xs
forall a b. (a -> b) -> a -> b
$ CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra CodecConfig (HardForkBlock xs)
ccfg

  aux ::
    forall blk.
    (SingleEraBlock blk, SerialiseNodeToClientConstraints blk) =>
    CodecConfig blk ->
    EraNodeToClientVersion blk ->
    (f -.-> K Encoding) blk
  aux :: forall blk.
(SingleEraBlock blk, SerialiseNodeToClientConstraints blk) =>
CodecConfig blk
-> EraNodeToClientVersion blk -> (-.->) f (K Encoding) blk
aux CodecConfig blk
ccfg' (EraNodeToClientEnabled BlockNodeToClientVersion blk
v) = (f blk -> K Encoding blk) -> (-.->) f (K Encoding) blk
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f blk -> K Encoding blk) -> (-.->) f (K Encoding) blk)
-> (f blk -> K Encoding blk) -> (-.->) f (K Encoding) blk
forall a b. (a -> b) -> a -> b
$ Encoding -> K Encoding blk
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding blk)
-> (f blk -> Encoding) -> f blk -> K Encoding blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodecConfig blk
-> BlockNodeToClientVersion blk -> f blk -> Encoding
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient CodecConfig blk
ccfg' BlockNodeToClientVersion blk
v
  aux CodecConfig blk
_ EraNodeToClientVersion blk
EraNodeToClientDisabled = (f blk -> K Encoding blk) -> (-.->) f (K Encoding) blk
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f blk -> K Encoding blk) -> (-.->) f (K Encoding) blk)
-> (f blk -> K Encoding blk) -> (-.->) f (K Encoding) blk
forall a b. (a -> b) -> a -> b
$ \f blk
_ ->
    HardForkEncoderException -> K Encoding blk
forall a e. (HasCallStack, Exception e) => e -> a
throw (HardForkEncoderException -> K Encoding blk)
-> HardForkEncoderException -> K Encoding blk
forall a b. (a -> b) -> a -> b
$ Proxy blk -> HardForkEncoderException
forall blk.
SingleEraBlock blk =>
Proxy blk -> HardForkEncoderException
disabledEraException (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)

dispatchDecoder ::
  forall f xs.
  ( SerialiseHFC xs
  , forall blk.
    SerialiseNodeToClientConstraints blk =>
    SerialiseNodeToClient blk (f blk)
  ) =>
  CodecConfig (HardForkBlock xs) ->
  BlockNodeToClientVersion (HardForkBlock xs) ->
  forall s.
  Decoder s (NS f xs)
dispatchDecoder :: forall (f :: * -> *) (xs :: [*]).
(SerialiseHFC xs,
 forall blk.
 SerialiseNodeToClientConstraints blk =>
 SerialiseNodeToClient blk (f blk)) =>
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (NS f xs)
dispatchDecoder CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version =
  case Proxy xs -> ProofNonEmpty xs
forall {a} (xs :: [a]) (proxy :: [a] -> *).
IsNonEmpty xs =>
proxy xs -> ProofNonEmpty xs
forall (proxy :: [*] -> *). proxy xs -> ProofNonEmpty xs
isNonEmpty (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs) of
    ProofNonEmpty{} ->
      case (NP CodecConfig xs
ccfgs, BlockNodeToClientVersion (HardForkBlock xs)
HardForkNodeToClientVersion xs
version) of
        (CodecConfig x
c0 :* NP CodecConfig xs1
_, HardForkNodeToClientDisabled BlockNodeToClientVersion x
v0) ->
          f x -> NS f xs
f x -> NS f (x : xs1)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (f x -> NS f xs) -> Decoder s (f x) -> Decoder s (NS f xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig x
-> BlockNodeToClientVersion x -> forall s. Decoder s (f x)
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient CodecConfig x
c0 BlockNodeToClientVersion x
BlockNodeToClientVersion x
v0
        (NP CodecConfig xs
_, HardForkNodeToClientEnabled HardForkSpecificNodeToClientVersion
_ NP EraNodeToClientVersion xs
versions) ->
          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 SerialiseConstraintsHFC
-> (forall a.
    SerialiseConstraintsHFC a =>
    CodecConfig a -> EraNodeToClientVersion a -> (:.:) (Decoder s) f a)
-> Prod NP CodecConfig xs
-> NP EraNodeToClientVersion xs
-> NP (Decoder s :.: f) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hczipWith Proxy SerialiseConstraintsHFC
pSHFC CodecConfig a -> EraNodeToClientVersion a -> (:.:) (Decoder s) f a
CodecConfig a
-> EraNodeToClientVersion a -> forall s. (:.:) (Decoder s) f a
forall blk.
(SingleEraBlock blk, SerialiseNodeToClientConstraints blk) =>
CodecConfig blk
-> EraNodeToClientVersion blk -> forall s. (:.:) (Decoder s) f blk
forall a.
SerialiseConstraintsHFC a =>
CodecConfig a -> EraNodeToClientVersion a -> (:.:) (Decoder s) f a
aux Prod NP CodecConfig xs
NP CodecConfig xs
ccfgs NP EraNodeToClientVersion xs
versions)
 where
  ccfgs :: NP CodecConfig xs
ccfgs = PerEraCodecConfig xs -> NP CodecConfig xs
forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs
getPerEraCodecConfig (PerEraCodecConfig xs -> NP CodecConfig xs)
-> PerEraCodecConfig xs -> NP CodecConfig xs
forall a b. (a -> b) -> a -> b
$ CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra CodecConfig (HardForkBlock xs)
ccfg

  aux ::
    forall blk.
    (SingleEraBlock blk, SerialiseNodeToClientConstraints blk) =>
    CodecConfig blk ->
    EraNodeToClientVersion blk ->
    forall s.
    (Decoder s :.: f) blk
  aux :: forall blk.
(SingleEraBlock blk, SerialiseNodeToClientConstraints blk) =>
CodecConfig blk
-> EraNodeToClientVersion blk -> forall s. (:.:) (Decoder s) f blk
aux CodecConfig blk
ccfg' (EraNodeToClientEnabled BlockNodeToClientVersion blk
v) = Decoder s (f blk) -> (:.:) (Decoder s) f blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Decoder s (f blk) -> (:.:) (Decoder s) f blk)
-> Decoder s (f blk) -> (:.:) (Decoder s) f blk
forall a b. (a -> b) -> a -> b
$ CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s (f blk)
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient CodecConfig blk
ccfg' BlockNodeToClientVersion blk
v
  aux CodecConfig blk
_ EraNodeToClientVersion blk
EraNodeToClientDisabled =
    Decoder s (f blk) -> (:.:) (Decoder s) f blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Decoder s (f blk) -> (:.:) (Decoder s) f blk)
-> Decoder s (f blk) -> (:.:) (Decoder s) f blk
forall a b. (a -> b) -> a -> b
$
      String -> Decoder s (f blk)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (f blk))
-> (HardForkEncoderException -> String)
-> HardForkEncoderException
-> Decoder s (f blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkEncoderException -> String
forall a. Show a => a -> String
show (HardForkEncoderException -> Decoder s (f blk))
-> HardForkEncoderException -> Decoder s (f blk)
forall a b. (a -> b) -> a -> b
$
        Proxy blk -> HardForkEncoderException
forall blk.
SingleEraBlock blk =>
Proxy blk -> HardForkEncoderException
disabledEraException (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)

dispatchEncoderErr ::
  forall f xs.
  ( SerialiseHFC xs
  , forall blk.
    SerialiseNodeToClientConstraints blk =>
    SerialiseNodeToClient blk (f blk)
  ) =>
  CodecConfig (HardForkBlock xs) ->
  BlockNodeToClientVersion (HardForkBlock xs) ->
  Either (MismatchEraInfo xs) (NS f xs) ->
  Encoding
dispatchEncoderErr :: forall (f :: * -> *) (xs :: [*]).
(SerialiseHFC xs,
 forall blk.
 SerialiseNodeToClientConstraints blk =>
 SerialiseNodeToClient blk (f blk)) =>
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> Either (MismatchEraInfo xs) (NS f xs)
-> Encoding
dispatchEncoderErr CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version =
  BlockNodeToClientVersion (HardForkBlock xs)
-> (NS f xs -> Encoding)
-> Either (MismatchEraInfo xs) (NS f xs)
-> Encoding
forall (xs :: [*]) a.
SListI xs =>
BlockNodeToClientVersion (HardForkBlock xs)
-> (a -> Encoding) -> Either (MismatchEraInfo xs) a -> Encoding
encodeEitherMismatch BlockNodeToClientVersion (HardForkBlock xs)
version ((NS f xs -> Encoding)
 -> Either (MismatchEraInfo xs) (NS f xs) -> Encoding)
-> (NS f xs -> Encoding)
-> Either (MismatchEraInfo xs) (NS f xs)
-> Encoding
forall a b. (a -> b) -> a -> b
$
    CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> NS f xs
-> Encoding
forall (f :: * -> *) (xs :: [*]).
(SerialiseHFC xs,
 forall blk.
 SerialiseNodeToClientConstraints blk =>
 SerialiseNodeToClient blk (f blk)) =>
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> NS f xs
-> Encoding
dispatchEncoder CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version

dispatchDecoderErr ::
  forall f xs.
  ( SerialiseHFC xs
  , forall blk.
    SerialiseNodeToClientConstraints blk =>
    SerialiseNodeToClient blk (f blk)
  ) =>
  CodecConfig (HardForkBlock xs) ->
  BlockNodeToClientVersion (HardForkBlock xs) ->
  forall s.
  Decoder s (Either (MismatchEraInfo xs) (NS f xs))
dispatchDecoderErr :: forall (f :: * -> *) (xs :: [*]).
(SerialiseHFC xs,
 forall blk.
 SerialiseNodeToClientConstraints blk =>
 SerialiseNodeToClient blk (f blk)) =>
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (Either (MismatchEraInfo xs) (NS f xs))
dispatchDecoderErr CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version =
  BlockNodeToClientVersion (HardForkBlock xs)
-> Decoder s (NS f xs)
-> Decoder s (Either (MismatchEraInfo xs) (NS f xs))
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 (NS f xs)
 -> Decoder s (Either (MismatchEraInfo xs) (NS f xs)))
-> Decoder s (NS f xs)
-> Decoder s (Either (MismatchEraInfo xs) (NS f xs))
forall a b. (a -> b) -> a -> b
$
    CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (NS f xs)
forall (f :: * -> *) (xs :: [*]).
(SerialiseHFC xs,
 forall blk.
 SerialiseNodeToClientConstraints blk =>
 SerialiseNodeToClient blk (f blk)) =>
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (NS f xs)
dispatchDecoder CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version

after :: (a -> b -> d -> e) -> (c -> d) -> a -> b -> c -> e
after :: forall a b d e c.
(a -> b -> d -> e) -> (c -> d) -> a -> b -> c -> e
after a -> b -> d -> e
f c -> d
g a
x b
y c
z = a -> b -> d -> e
f a
x b
y (c -> d
g c
z)

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

instance SerialiseHFC xs => SerialiseNodeToClient (HardForkBlock xs) (PerEraLedgerConfig xs) where
  encodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> PerEraLedgerConfig xs
-> Encoding
encodeNodeToClient CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version (PerEraLedgerConfig NP WrapPartialLedgerConfig xs
xs) =
    (forall x.
 SerialiseConstraintsHFC x =>
 CodecConfig x
 -> BlockNodeToClientVersion x
 -> WrapPartialLedgerConfig x
 -> Encoding)
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> NP WrapPartialLedgerConfig xs
-> Encoding
forall (f :: * -> *) (xs :: [*]).
SerialiseHFC xs =>
(forall x.
 SerialiseConstraintsHFC x =>
 CodecConfig x -> BlockNodeToClientVersion x -> f x -> Encoding)
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> NP f xs
-> Encoding
encodeNodeToClientNP CodecConfig x
-> BlockNodeToClientVersion x
-> WrapPartialLedgerConfig x
-> Encoding
forall x.
SerialiseConstraintsHFC x =>
CodecConfig x
-> BlockNodeToClientVersion x
-> WrapPartialLedgerConfig x
-> Encoding
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
HardForkNodeToClientVersion xs
version NP WrapPartialLedgerConfig xs
xs
  decodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (PerEraLedgerConfig xs)
decodeNodeToClient CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version =
    NP WrapPartialLedgerConfig xs -> PerEraLedgerConfig xs
forall (xs :: [*]).
NP WrapPartialLedgerConfig xs -> PerEraLedgerConfig xs
PerEraLedgerConfig (NP WrapPartialLedgerConfig xs -> PerEraLedgerConfig xs)
-> Decoder s (NP WrapPartialLedgerConfig xs)
-> Decoder s (PerEraLedgerConfig xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall x.
 SerialiseConstraintsHFC x =>
 CodecConfig x
 -> BlockNodeToClientVersion x
 -> forall s. Decoder s (WrapPartialLedgerConfig x))
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> forall s. Decoder s (NP WrapPartialLedgerConfig xs)
forall (f :: * -> *) (xs :: [*]).
SerialiseHFC xs =>
(forall x.
 SerialiseConstraintsHFC x =>
 CodecConfig x
 -> BlockNodeToClientVersion x -> forall s. Decoder s (f x))
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> forall s. Decoder s (NP f xs)
decodeNodeToClientNP CodecConfig x
-> BlockNodeToClientVersion x
-> Decoder s (WrapPartialLedgerConfig x)
CodecConfig x
-> BlockNodeToClientVersion x
-> forall s. Decoder s (WrapPartialLedgerConfig x)
forall x.
SerialiseConstraintsHFC x =>
CodecConfig x
-> BlockNodeToClientVersion x
-> forall s. Decoder s (WrapPartialLedgerConfig x)
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
HardForkNodeToClientVersion xs
version

{-------------------------------------------------------------------------------
  Blocks
-------------------------------------------------------------------------------}

instance
  SerialiseHFC xs =>
  SerialiseNodeToClient (HardForkBlock xs) (HardForkBlock xs)
  where
  encodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> HardForkBlock xs
-> Encoding
encodeNodeToClient CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
_ = (HardForkBlock xs -> Encoding) -> HardForkBlock xs -> Encoding
forall a. (a -> Encoding) -> a -> Encoding
wrapCBORinCBOR (CodecConfig (HardForkBlock xs) -> HardForkBlock xs -> Encoding
forall (xs :: [*]).
SerialiseHFC xs =>
CodecConfig (HardForkBlock xs) -> HardForkBlock xs -> Encoding
encodeDiskHfcBlock CodecConfig (HardForkBlock xs)
ccfg)
  decodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (HardForkBlock xs)
decodeNodeToClient CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
_ = (forall s. Decoder s (ByteString -> HardForkBlock xs))
-> forall s. Decoder s (HardForkBlock xs)
forall a.
(forall s. Decoder s (ByteString -> a)) -> forall s. Decoder s a
unwrapCBORinCBOR (CodecConfig (HardForkBlock xs)
-> forall s. Decoder s (ByteString -> HardForkBlock xs)
forall (xs :: [*]).
SerialiseHFC xs =>
CodecConfig (HardForkBlock xs)
-> forall s. Decoder s (ByteString -> HardForkBlock xs)
decodeDiskHfcBlock CodecConfig (HardForkBlock xs)
ccfg)

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

instance
  SerialiseHFC xs =>
  SerialiseNodeToClient (HardForkBlock xs) (Serialised (HardForkBlock xs))
  where
  encodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> Serialised (HardForkBlock xs)
-> Encoding
encodeNodeToClient CodecConfig (HardForkBlock xs)
_ BlockNodeToClientVersion (HardForkBlock xs)
_ = Serialised (HardForkBlock xs) -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode
  decodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (Serialised (HardForkBlock xs))
decodeNodeToClient CodecConfig (HardForkBlock xs)
_ BlockNodeToClientVersion (HardForkBlock xs)
_ = Decoder s (Serialised (HardForkBlock xs))
forall s. Decoder s (Serialised (HardForkBlock xs))
forall a s. Serialise a => Decoder s a
Serialise.decode

{-------------------------------------------------------------------------------
  Transactions
-------------------------------------------------------------------------------}

instance
  SerialiseHFC xs =>
  SerialiseNodeToClient (HardForkBlock xs) (GenTx (HardForkBlock xs))
  where
  encodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> GenTx (HardForkBlock xs)
-> Encoding
encodeNodeToClient = CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> NS GenTx xs
-> Encoding
CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs -> NS GenTx xs -> Encoding
forall (f :: * -> *) (xs :: [*]).
(SerialiseHFC xs,
 forall blk.
 SerialiseNodeToClientConstraints blk =>
 SerialiseNodeToClient blk (f blk)) =>
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> NS f xs
-> Encoding
dispatchEncoder (CodecConfig (HardForkBlock xs)
 -> HardForkNodeToClientVersion xs -> NS GenTx xs -> Encoding)
-> (GenTx (HardForkBlock xs) -> NS GenTx xs)
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> GenTx (HardForkBlock xs)
-> Encoding
forall a b d e c.
(a -> b -> d -> e) -> (c -> d) -> a -> b -> c -> e
`after` (OneEraGenTx xs -> NS GenTx xs
forall (xs :: [*]). OneEraGenTx xs -> NS GenTx xs
getOneEraGenTx (OneEraGenTx xs -> NS GenTx xs)
-> (GenTx (HardForkBlock xs) -> OneEraGenTx xs)
-> GenTx (HardForkBlock xs)
-> NS GenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (HardForkBlock xs) -> OneEraGenTx xs
forall (xs :: [*]). GenTx (HardForkBlock xs) -> OneEraGenTx xs
getHardForkGenTx)
  decodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (GenTx (HardForkBlock xs))
decodeNodeToClient = (NS GenTx xs -> GenTx (HardForkBlock xs))
-> Decoder s (NS GenTx xs) -> Decoder s (GenTx (HardForkBlock xs))
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OneEraGenTx xs -> GenTx (HardForkBlock xs)
forall (xs :: [*]). OneEraGenTx xs -> GenTx (HardForkBlock xs)
HardForkGenTx (OneEraGenTx xs -> GenTx (HardForkBlock xs))
-> (NS GenTx xs -> OneEraGenTx xs)
-> NS GenTx xs
-> GenTx (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS GenTx xs -> OneEraGenTx xs
forall (xs :: [*]). NS GenTx xs -> OneEraGenTx xs
OneEraGenTx) (Decoder s (NS GenTx xs) -> Decoder s (GenTx (HardForkBlock xs)))
-> (CodecConfig (HardForkBlock xs)
    -> HardForkNodeToClientVersion xs -> Decoder s (NS GenTx xs))
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> Decoder s (GenTx (HardForkBlock xs))
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (NS GenTx xs)
CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs -> Decoder s (NS GenTx xs)
forall (f :: * -> *) (xs :: [*]).
(SerialiseHFC xs,
 forall blk.
 SerialiseNodeToClientConstraints blk =>
 SerialiseNodeToClient blk (f blk)) =>
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (NS f xs)
dispatchDecoder

instance
  SerialiseHFC xs =>
  SerialiseNodeToClient (HardForkBlock xs) (GenTxId (HardForkBlock xs))
  where
  encodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> GenTxId (HardForkBlock xs)
-> Encoding
encodeNodeToClient = CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> NS WrapGenTxId xs
-> Encoding
CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs -> NS WrapGenTxId xs -> Encoding
forall (f :: * -> *) (xs :: [*]).
(SerialiseHFC xs,
 forall blk.
 SerialiseNodeToClientConstraints blk =>
 SerialiseNodeToClient blk (f blk)) =>
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> NS f xs
-> Encoding
dispatchEncoder (CodecConfig (HardForkBlock xs)
 -> HardForkNodeToClientVersion xs -> NS WrapGenTxId xs -> Encoding)
-> (GenTxId (HardForkBlock xs) -> NS WrapGenTxId xs)
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> GenTxId (HardForkBlock xs)
-> Encoding
forall a b d e c.
(a -> b -> d -> e) -> (c -> d) -> a -> b -> c -> e
`after` (OneEraGenTxId xs -> NS WrapGenTxId xs
forall (xs :: [*]). OneEraGenTxId xs -> NS WrapGenTxId xs
getOneEraGenTxId (OneEraGenTxId xs -> NS WrapGenTxId xs)
-> (GenTxId (HardForkBlock xs) -> OneEraGenTxId xs)
-> GenTxId (HardForkBlock xs)
-> NS WrapGenTxId xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTxId (HardForkBlock xs) -> OneEraGenTxId xs
forall (xs :: [*]).
TxId (GenTx (HardForkBlock xs)) -> OneEraGenTxId xs
getHardForkGenTxId)
  decodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (GenTxId (HardForkBlock xs))
decodeNodeToClient = (NS WrapGenTxId xs -> GenTxId (HardForkBlock xs))
-> Decoder s (NS WrapGenTxId xs)
-> Decoder s (GenTxId (HardForkBlock xs))
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OneEraGenTxId xs -> GenTxId (HardForkBlock xs)
forall (xs :: [*]).
OneEraGenTxId xs -> TxId (GenTx (HardForkBlock xs))
HardForkGenTxId (OneEraGenTxId xs -> GenTxId (HardForkBlock xs))
-> (NS WrapGenTxId xs -> OneEraGenTxId xs)
-> NS WrapGenTxId xs
-> GenTxId (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapGenTxId xs -> OneEraGenTxId xs
forall (xs :: [*]). NS WrapGenTxId xs -> OneEraGenTxId xs
OneEraGenTxId) (Decoder s (NS WrapGenTxId xs)
 -> Decoder s (GenTxId (HardForkBlock xs)))
-> (CodecConfig (HardForkBlock xs)
    -> HardForkNodeToClientVersion xs -> Decoder s (NS WrapGenTxId xs))
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> Decoder s (GenTxId (HardForkBlock xs))
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (NS WrapGenTxId xs)
CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs -> Decoder s (NS WrapGenTxId xs)
forall (f :: * -> *) (xs :: [*]).
(SerialiseHFC xs,
 forall blk.
 SerialiseNodeToClientConstraints blk =>
 SerialiseNodeToClient blk (f blk)) =>
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (NS f xs)
dispatchDecoder

instance
  SerialiseHFC xs =>
  SerialiseNodeToClient (HardForkBlock xs) SlotNo
  where
  encodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> SlotNo
-> Encoding
encodeNodeToClient CodecConfig (HardForkBlock xs)
_ BlockNodeToClientVersion (HardForkBlock xs)
_ = SlotNo -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode
  decodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s SlotNo
decodeNodeToClient CodecConfig (HardForkBlock xs)
_ BlockNodeToClientVersion (HardForkBlock xs)
_ = Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. Serialise a => Decoder s a
Serialise.decode

instance
  SerialiseHFC xs =>
  SerialiseNodeToClient (HardForkBlock xs) (HardForkApplyTxErr xs)
  where
  encodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> HardForkApplyTxErr xs
-> Encoding
encodeNodeToClient = CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs)
-> Encoding
CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs)
-> Encoding
forall (f :: * -> *) (xs :: [*]).
(SerialiseHFC xs,
 forall blk.
 SerialiseNodeToClientConstraints blk =>
 SerialiseNodeToClient blk (f blk)) =>
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> Either (MismatchEraInfo xs) (NS f xs)
-> Encoding
dispatchEncoderErr (CodecConfig (HardForkBlock xs)
 -> HardForkNodeToClientVersion xs
 -> Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs)
 -> Encoding)
-> (HardForkApplyTxErr xs
    -> Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs))
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> HardForkApplyTxErr xs
-> Encoding
forall a b d e c.
(a -> b -> d -> e) -> (c -> d) -> a -> b -> c -> e
`after` ((OneEraApplyTxErr xs -> NS WrapApplyTxErr xs)
-> Either (MismatchEraInfo xs) (OneEraApplyTxErr xs)
-> Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs)
forall a b.
(a -> b)
-> Either (MismatchEraInfo xs) a -> Either (MismatchEraInfo xs) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OneEraApplyTxErr xs -> NS WrapApplyTxErr xs
forall (xs :: [*]). OneEraApplyTxErr xs -> NS WrapApplyTxErr xs
getOneEraApplyTxErr (Either (MismatchEraInfo xs) (OneEraApplyTxErr xs)
 -> Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs))
-> (HardForkApplyTxErr xs
    -> Either (MismatchEraInfo xs) (OneEraApplyTxErr xs))
-> HardForkApplyTxErr xs
-> Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkApplyTxErr xs
-> Either (MismatchEraInfo xs) (OneEraApplyTxErr xs)
forall (xs :: [*]).
HardForkApplyTxErr xs
-> Either (MismatchEraInfo xs) (OneEraApplyTxErr xs)
hardForkApplyTxErrToEither)
  decodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (HardForkApplyTxErr xs)
decodeNodeToClient = (Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs)
 -> HardForkApplyTxErr xs)
-> Decoder s (Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs))
-> Decoder s (HardForkApplyTxErr xs)
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either (MismatchEraInfo xs) (OneEraApplyTxErr xs)
-> HardForkApplyTxErr xs
forall (xs :: [*]).
Either (MismatchEraInfo xs) (OneEraApplyTxErr xs)
-> HardForkApplyTxErr xs
hardForkApplyTxErrFromEither (Either (MismatchEraInfo xs) (OneEraApplyTxErr xs)
 -> HardForkApplyTxErr xs)
-> (Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs)
    -> Either (MismatchEraInfo xs) (OneEraApplyTxErr xs))
-> Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs)
-> HardForkApplyTxErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NS WrapApplyTxErr xs -> OneEraApplyTxErr xs)
-> Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs)
-> Either (MismatchEraInfo xs) (OneEraApplyTxErr xs)
forall a b.
(a -> b)
-> Either (MismatchEraInfo xs) a -> Either (MismatchEraInfo xs) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NS WrapApplyTxErr xs -> OneEraApplyTxErr xs
forall (xs :: [*]). NS WrapApplyTxErr xs -> OneEraApplyTxErr xs
OneEraApplyTxErr) (Decoder s (Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs))
 -> Decoder s (HardForkApplyTxErr xs))
-> (CodecConfig (HardForkBlock xs)
    -> HardForkNodeToClientVersion xs
    -> Decoder s (Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs)))
-> CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> Decoder s (HardForkApplyTxErr xs)
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s.
   Decoder s (Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs))
CodecConfig (HardForkBlock xs)
-> HardForkNodeToClientVersion xs
-> Decoder s (Either (MismatchEraInfo xs) (NS WrapApplyTxErr xs))
forall (f :: * -> *) (xs :: [*]).
(SerialiseHFC xs,
 forall blk.
 SerialiseNodeToClientConstraints blk =>
 SerialiseNodeToClient blk (f blk)) =>
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (Either (MismatchEraInfo xs) (NS f xs))
dispatchDecoderErr

{-------------------------------------------------------------------------------
  Queries
-------------------------------------------------------------------------------}

encodeQueryHardFork ::
  HardForkSpecificNodeToClientVersion ->
  Some (QueryHardFork xs) ->
  Encoding
encodeQueryHardFork :: forall (xs :: [*]).
HardForkSpecificNodeToClientVersion
-> Some (QueryHardFork xs) -> Encoding
encodeQueryHardFork HardForkSpecificNodeToClientVersion
_vHfc = \case
  Some QueryHardFork xs a
GetInterpreter ->
    [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
      [ Word -> Encoding
Enc.encodeListLen Word
1
      , Word8 -> Encoding
Enc.encodeWord8 Word8
0
      ]
  Some QueryHardFork xs a
GetCurrentEra ->
    [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
      [ Word -> Encoding
Enc.encodeListLen Word
1
      , Word8 -> Encoding
Enc.encodeWord8 Word8
1
      ]

decodeQueryHardFork :: Decoder s (Some (QueryHardFork xs))
decodeQueryHardFork :: forall s (xs :: [*]). Decoder s (Some (QueryHardFork xs))
decodeQueryHardFork = do
  Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"QueryHardFork" Int
1
  tag <- Decoder s Word8
forall s. Decoder s Word8
Dec.decodeWord8
  case tag of
    Word8
0 -> Some (QueryHardFork xs) -> Decoder s (Some (QueryHardFork xs))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Some (QueryHardFork xs) -> Decoder s (Some (QueryHardFork xs)))
-> Some (QueryHardFork xs) -> Decoder s (Some (QueryHardFork xs))
forall a b. (a -> b) -> a -> b
$ QueryHardFork xs (Interpreter xs) -> Some (QueryHardFork xs)
forall {k} (f :: k -> *) (a :: k). f a -> Some f
Some QueryHardFork xs (Interpreter xs)
forall (xs :: [*]). QueryHardFork xs (Interpreter xs)
GetInterpreter
    Word8
1 -> Some (QueryHardFork xs) -> Decoder s (Some (QueryHardFork xs))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Some (QueryHardFork xs) -> Decoder s (Some (QueryHardFork xs)))
-> Some (QueryHardFork xs) -> Decoder s (Some (QueryHardFork xs))
forall a b. (a -> b) -> a -> b
$ QueryHardFork xs (EraIndex xs) -> Some (QueryHardFork xs)
forall {k} (f :: k -> *) (a :: k). f a -> Some f
Some QueryHardFork xs (EraIndex xs)
forall (xs :: [*]). QueryHardFork xs (EraIndex xs)
GetCurrentEra
    Word8
_ -> String -> Decoder s (Some (QueryHardFork xs))
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (Some (QueryHardFork xs)))
-> String -> Decoder s (Some (QueryHardFork xs))
forall a b. (a -> b) -> a -> b
$ String
"QueryHardFork: invalid tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag

instance
  SerialiseHFC xs =>
  SerialiseNodeToClient (HardForkBlock xs) (SomeBlockQuery (BlockQuery (HardForkBlock xs)))
  where
  encodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> SomeBlockQuery (BlockQuery (HardForkBlock xs))
-> Encoding
encodeNodeToClient CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version (SomeBlockQuery BlockQuery (HardForkBlock xs) footprint result
q) = case BlockNodeToClientVersion (HardForkBlock xs)
version of
    HardForkNodeToClientDisabled BlockNodeToClientVersion x
v0 -> case BlockQuery (HardForkBlock xs) footprint result
q of
      QueryIfCurrent QueryIfCurrent xs footprint result1
qry ->
        case SomeBlockQuery (QueryIfCurrent xs)
-> NS (SomeBlockQuery :.: BlockQuery) xs
forall (xs :: [*]).
SomeBlockQuery (QueryIfCurrent xs)
-> NS (SomeBlockQuery :.: BlockQuery) xs
distribQueryIfCurrent (QueryIfCurrent xs footprint result1
-> SomeBlockQuery (QueryIfCurrent xs)
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery QueryIfCurrent xs footprint result1
qry) of
          Z (Comp SomeBlockQuery (BlockQuery x)
qry0) -> CodecConfig x
-> BlockNodeToClientVersion x
-> SomeBlockQuery (BlockQuery x)
-> Encoding
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient (NP CodecConfig (x : xs1) -> CodecConfig x
forall {k} (f :: k -> *) (x :: k) (xs :: [k]). NP f (x : xs) -> f x
hd NP CodecConfig xs
NP CodecConfig (x : xs1)
ccfgs) BlockNodeToClientVersion x
v0 SomeBlockQuery (BlockQuery x)
qry0
          S NS (SomeBlockQuery :.: BlockQuery) xs1
later -> 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 (NS (SomeBlockQuery :.: BlockQuery) xs1 -> NS SingleEraInfo xs1
forall (xs :: [*]) (f :: * -> *).
All SingleEraBlock xs =>
NS f xs -> NS SingleEraInfo xs
notFirstEra NS (SomeBlockQuery :.: BlockQuery) xs1
later)
      QueryAnytime{} ->
        HardForkEncoderException -> Encoding
forall a e. (HasCallStack, Exception e) => e -> a
throw HardForkEncoderException
HardForkEncoderQueryHfcDisabled
      QueryHardFork{} ->
        HardForkEncoderException -> Encoding
forall a e. (HasCallStack, Exception e) => e -> a
throw HardForkEncoderException
HardForkEncoderQueryHfcDisabled
    HardForkNodeToClientEnabled HardForkSpecificNodeToClientVersion
vHfc NP EraNodeToClientVersion xs
_ -> case BlockQuery (HardForkBlock xs) footprint result
q of
      QueryIfCurrent QueryIfCurrent xs footprint result1
qry ->
        [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
          [ Word -> Encoding
Enc.encodeListLen Word
2
          , Word8 -> Encoding
Enc.encodeWord8 Word8
0
          , CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> NS (SomeBlockQuery :.: BlockQuery) xs
-> Encoding
forall (f :: * -> *) (xs :: [*]).
(SerialiseHFC xs,
 forall blk.
 SerialiseNodeToClientConstraints blk =>
 SerialiseNodeToClient blk (f blk)) =>
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> NS f xs
-> Encoding
dispatchEncoder CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version (SomeBlockQuery (QueryIfCurrent xs)
-> NS (SomeBlockQuery :.: BlockQuery) xs
forall (xs :: [*]).
SomeBlockQuery (QueryIfCurrent xs)
-> NS (SomeBlockQuery :.: BlockQuery) xs
distribQueryIfCurrent (QueryIfCurrent xs footprint result1
-> SomeBlockQuery (QueryIfCurrent xs)
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery QueryIfCurrent xs footprint result1
qry))
          ]
      QueryAnytime QueryAnytime result
qry EraIndex (x : xs1)
eraIndex ->
        [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
          [ Word -> Encoding
Enc.encodeListLen Word
3
          , Word8 -> Encoding
Enc.encodeWord8 Word8
1
          , Some QueryAnytime -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode (QueryAnytime result -> Some QueryAnytime
forall {k} (f :: k -> *) (a :: k). f a -> Some f
Some QueryAnytime result
qry)
          , EraIndex (x : xs1) -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode EraIndex (x : xs1)
eraIndex
          ]
      QueryHardFork QueryHardFork (x : xs1) result
qry ->
        [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
          [ Word -> Encoding
Enc.encodeListLen Word
2
          , Word8 -> Encoding
Enc.encodeWord8 Word8
2
          , HardForkSpecificNodeToClientVersion
-> Some (QueryHardFork (x : xs1)) -> Encoding
forall (xs :: [*]).
HardForkSpecificNodeToClientVersion
-> Some (QueryHardFork xs) -> Encoding
encodeQueryHardFork HardForkSpecificNodeToClientVersion
vHfc (QueryHardFork (x : xs1) result -> Some (QueryHardFork (x : xs1))
forall {k} (f :: k -> *) (a :: k). f a -> Some f
Some QueryHardFork (x : xs1) result
qry)
          ]
   where
    ccfgs :: NP CodecConfig xs
ccfgs = PerEraCodecConfig xs -> NP CodecConfig xs
forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs
getPerEraCodecConfig (PerEraCodecConfig xs -> NP CodecConfig xs)
-> PerEraCodecConfig xs -> NP CodecConfig xs
forall a b. (a -> b) -> a -> b
$ CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra CodecConfig (HardForkBlock xs)
ccfg

  decodeNodeToClient :: CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s.
   Decoder s (SomeBlockQuery (BlockQuery (HardForkBlock xs)))
decodeNodeToClient CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version = case BlockNodeToClientVersion (HardForkBlock xs)
version of
    HardForkNodeToClientDisabled BlockNodeToClientVersion x
v0 ->
      NS (SomeBlockQuery :.: BlockQuery) xs
-> SomeBlockQuery (BlockQuery (HardForkBlock xs))
injQueryIfCurrent (NS (SomeBlockQuery :.: BlockQuery) xs
 -> SomeBlockQuery (BlockQuery (HardForkBlock xs)))
-> (SomeBlockQuery (BlockQuery x)
    -> NS (SomeBlockQuery :.: BlockQuery) xs)
-> SomeBlockQuery (BlockQuery x)
-> SomeBlockQuery (BlockQuery (HardForkBlock xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:.:) SomeBlockQuery BlockQuery x
-> NS (SomeBlockQuery :.: BlockQuery) xs
(:.:) 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
 -> NS (SomeBlockQuery :.: BlockQuery) xs)
-> (SomeBlockQuery (BlockQuery x)
    -> (:.:) SomeBlockQuery BlockQuery x)
-> SomeBlockQuery (BlockQuery x)
-> NS (SomeBlockQuery :.: BlockQuery) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeBlockQuery (BlockQuery x) -> (:.:) SomeBlockQuery BlockQuery x
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp
        (SomeBlockQuery (BlockQuery x)
 -> SomeBlockQuery (BlockQuery (HardForkBlock xs)))
-> Decoder s (SomeBlockQuery (BlockQuery x))
-> Decoder s (SomeBlockQuery (BlockQuery (HardForkBlock xs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig x
-> BlockNodeToClientVersion x
-> forall s. Decoder s (SomeBlockQuery (BlockQuery x))
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient (NP CodecConfig (x : xs1) -> CodecConfig x
forall {k} (f :: k -> *) (x :: k) (xs :: [k]). NP f (x : xs) -> f x
hd NP CodecConfig xs
NP CodecConfig (x : xs1)
ccfgs) BlockNodeToClientVersion x
v0
    HardForkNodeToClientEnabled{} -> case Proxy xs -> ProofNonEmpty xs
forall {a} (xs :: [a]) (proxy :: [a] -> *).
IsNonEmpty xs =>
proxy xs -> ProofNonEmpty xs
forall (proxy :: [*] -> *). proxy xs -> ProofNonEmpty xs
isNonEmpty (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs) of
      ProofNonEmpty (Proxy x
_ :: Proxy x') (Proxy xs1
p :: Proxy xs') -> do
        size <- Decoder s Int
forall s. Decoder s Int
Dec.decodeListLen
        tag <- Dec.decodeWord8
        case (size, tag) of
          (Int
2, Word8
0) -> NS (SomeBlockQuery :.: BlockQuery) xs
-> SomeBlockQuery (BlockQuery (HardForkBlock xs))
injQueryIfCurrent (NS (SomeBlockQuery :.: BlockQuery) xs
 -> SomeBlockQuery (BlockQuery (HardForkBlock xs)))
-> Decoder s (NS (SomeBlockQuery :.: BlockQuery) xs)
-> Decoder s (SomeBlockQuery (BlockQuery (HardForkBlock xs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (NS (SomeBlockQuery :.: BlockQuery) xs)
forall (f :: * -> *) (xs :: [*]).
(SerialiseHFC xs,
 forall blk.
 SerialiseNodeToClientConstraints blk =>
 SerialiseNodeToClient blk (f blk)) =>
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> forall s. Decoder s (NS f xs)
dispatchDecoder CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version
          (Int
3, Word8
1) -> do
            Some (qry :: QueryAnytime result) <- Decoder s (Some QueryAnytime)
forall s. Decoder s (Some QueryAnytime)
forall a s. Serialise a => Decoder s a
Serialise.decode
            eraIndex :: EraIndex (x' ': xs') <- Serialise.decode
            case checkIsNonEmpty p of
              Maybe (ProofNonEmpty xs1)
Nothing -> String
-> Decoder s (SomeBlockQuery (BlockQuery (HardForkBlock xs)))
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"QueryAnytime requires multiple era"
              Just (ProofNonEmpty{}) ->
                SomeBlockQuery (BlockQuery (HardForkBlock xs))
-> Decoder s (SomeBlockQuery (BlockQuery (HardForkBlock xs)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (HardForkBlock xs))
 -> Decoder s (SomeBlockQuery (BlockQuery (HardForkBlock xs))))
-> SomeBlockQuery (BlockQuery (HardForkBlock xs))
-> Decoder s (SomeBlockQuery (BlockQuery (HardForkBlock xs)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (HardForkBlock xs) 'QFNoTables a
-> SomeBlockQuery (BlockQuery (HardForkBlock xs))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (QueryAnytime a
-> EraIndex (x : xs1)
-> BlockQuery (HardForkBlock (x : xs1)) 'QFNoTables a
forall (xs1 :: [*]) result x.
IsNonEmpty xs1 =>
QueryAnytime result
-> EraIndex (x : xs1)
-> BlockQuery (HardForkBlock (x : xs1)) 'QFNoTables result
QueryAnytime QueryAnytime a
qry EraIndex (x : xs1)
eraIndex)
          (Int
2, Word8
2) -> do
            Some (qry :: QueryHardFork xs result) <- Decoder s (Some (QueryHardFork (x : xs1)))
forall s (xs :: [*]). Decoder s (Some (QueryHardFork xs))
decodeQueryHardFork
            case checkIsNonEmpty p of
              Maybe (ProofNonEmpty xs1)
Nothing -> String
-> Decoder s (SomeBlockQuery (BlockQuery (HardForkBlock xs)))
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"QueryHardFork requires multiple era"
              Just (ProofNonEmpty{}) ->
                SomeBlockQuery (BlockQuery (HardForkBlock xs))
-> Decoder s (SomeBlockQuery (BlockQuery (HardForkBlock xs)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (HardForkBlock xs))
 -> Decoder s (SomeBlockQuery (BlockQuery (HardForkBlock xs))))
-> SomeBlockQuery (BlockQuery (HardForkBlock xs))
-> Decoder s (SomeBlockQuery (BlockQuery (HardForkBlock xs)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (HardForkBlock xs) 'QFNoTables a
-> SomeBlockQuery (BlockQuery (HardForkBlock xs))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (QueryHardFork (x : x : xs1) a
-> BlockQuery (HardForkBlock (x : x : xs1)) 'QFNoTables a
forall (xs1 :: [*]) x result.
IsNonEmpty xs1 =>
QueryHardFork (x : xs1) result
-> BlockQuery (HardForkBlock (x : xs1)) 'QFNoTables result
QueryHardFork QueryHardFork xs a
QueryHardFork (x : x : xs1) a
qry)
          (Int, Word8)
_ -> String
-> Decoder s (SomeBlockQuery (BlockQuery (HardForkBlock xs)))
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> Decoder s (SomeBlockQuery (BlockQuery (HardForkBlock xs))))
-> String
-> Decoder s (SomeBlockQuery (BlockQuery (HardForkBlock xs)))
forall a b. (a -> b) -> a -> b
$ String
"HardForkQuery: invalid size and tag" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Int, Word8) -> String
forall a. Show a => a -> String
show (Int
size, Word8
tag)
   where
    ccfgs :: NP CodecConfig xs
ccfgs = PerEraCodecConfig xs -> NP CodecConfig xs
forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs
getPerEraCodecConfig (PerEraCodecConfig xs -> NP CodecConfig xs)
-> PerEraCodecConfig xs -> NP CodecConfig xs
forall a b. (a -> b) -> a -> b
$ CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra CodecConfig (HardForkBlock xs)
ccfg

    injQueryIfCurrent ::
      NS (SomeBlockQuery :.: BlockQuery) xs ->
      SomeBlockQuery (BlockQuery (HardForkBlock xs))
    injQueryIfCurrent :: NS (SomeBlockQuery :.: BlockQuery) xs
-> SomeBlockQuery (BlockQuery (HardForkBlock xs))
injQueryIfCurrent NS (SomeBlockQuery :.: BlockQuery) xs
ns =
      case NS (SomeBlockQuery :.: BlockQuery) xs
-> SomeBlockQuery (QueryIfCurrent xs)
forall (xs :: [*]).
NS (SomeBlockQuery :.: BlockQuery) xs
-> SomeBlockQuery (QueryIfCurrent xs)
undistribQueryIfCurrent NS (SomeBlockQuery :.: BlockQuery) xs
ns of
        SomeBlockQuery QueryIfCurrent xs footprint result
q -> BlockQuery
  (HardForkBlock xs) footprint (Either (MismatchEraInfo xs) result)
-> SomeBlockQuery (BlockQuery (HardForkBlock xs))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (QueryIfCurrent xs footprint result
-> BlockQuery
     (HardForkBlock xs) footprint (Either (MismatchEraInfo xs) result)
forall (xs :: [*]) (footprint :: QueryFootprint) result1.
QueryIfCurrent xs footprint result1
-> BlockQuery
     (HardForkBlock xs) footprint (Either (MismatchEraInfo xs) result1)
QueryIfCurrent QueryIfCurrent xs footprint result
q)

{-------------------------------------------------------------------------------
  Results
-------------------------------------------------------------------------------}

instance
  SerialiseHFC xs =>
  SerialiseBlockQueryResult (HardForkBlock xs) BlockQuery
  where
  encodeBlockQueryResult :: forall (fp :: QueryFootprint) result.
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> BlockQuery (HardForkBlock xs) fp result
-> result
-> Encoding
encodeBlockQueryResult CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version (QueryIfCurrent QueryIfCurrent xs fp result1
qry) =
    case Proxy xs -> ProofNonEmpty xs
forall {a} (xs :: [a]) (proxy :: [a] -> *).
IsNonEmpty xs =>
proxy xs -> ProofNonEmpty xs
forall (proxy :: [*] -> *). proxy xs -> ProofNonEmpty xs
isNonEmpty (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs) of
      ProofNonEmpty{} ->
        BlockNodeToClientVersion (HardForkBlock (x : xs1))
-> (result1 -> Encoding)
-> Either (MismatchEraInfo (x : xs1)) result1
-> Encoding
forall (xs :: [*]) a.
SListI xs =>
BlockNodeToClientVersion (HardForkBlock xs)
-> (a -> Encoding) -> Either (MismatchEraInfo xs) a -> Encoding
encodeEitherMismatch BlockNodeToClientVersion (HardForkBlock xs)
BlockNodeToClientVersion (HardForkBlock (x : xs1))
version ((result1 -> Encoding)
 -> Either (MismatchEraInfo (x : xs1)) result1 -> Encoding)
-> (result1 -> Encoding)
-> Either (MismatchEraInfo (x : xs1)) result1
-> Encoding
forall a b. (a -> b) -> a -> b
$
          case (NP CodecConfig xs
ccfgs, BlockNodeToClientVersion (HardForkBlock xs)
HardForkNodeToClientVersion xs
version, QueryIfCurrent xs fp result1
qry) of
            (CodecConfig x
c0 :* NP CodecConfig xs1
_, HardForkNodeToClientDisabled BlockNodeToClientVersion x
v0, QZ BlockQuery x fp result1
qry') ->
              CodecConfig x
-> BlockNodeToClientVersion x
-> BlockQuery x fp result1
-> result1
-> Encoding
forall k blk (query :: * -> k -> * -> *) (fp :: k) result.
SerialiseBlockQueryResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query blk fp result
-> result
-> Encoding
forall (fp :: QueryFootprint) result.
CodecConfig x
-> BlockNodeToClientVersion x
-> BlockQuery x fp result
-> result
-> Encoding
encodeBlockQueryResult CodecConfig x
c0 BlockNodeToClientVersion x
BlockNodeToClientVersion x
v0 BlockQuery x fp result1
BlockQuery x fp result1
qry'
            (NP CodecConfig xs
_, HardForkNodeToClientDisabled BlockNodeToClientVersion x
_, QS QueryIfCurrent xs1 fp result1
qry') ->
              HardForkEncoderException -> result1 -> Encoding
forall a e. (HasCallStack, Exception e) => e -> a
throw (HardForkEncoderException -> result1 -> Encoding)
-> HardForkEncoderException -> result1 -> Encoding
forall a b. (a -> b) -> a -> b
$ NS SingleEraInfo xs1 -> HardForkEncoderException
forall (xs :: [*]).
SListI xs =>
NS SingleEraInfo xs -> HardForkEncoderException
futureEraException (QueryIfCurrent xs1 fp result1 -> NS SingleEraInfo xs1
forall (xs :: [*]) (footprint :: QueryFootprint) result.
All SingleEraBlock xs =>
QueryIfCurrent xs footprint result -> NS SingleEraInfo xs
hardForkQueryInfo QueryIfCurrent xs1 fp result1
qry')
            (NP CodecConfig xs
_, HardForkNodeToClientEnabled HardForkSpecificNodeToClientVersion
_ NP EraNodeToClientVersion xs
versions, QueryIfCurrent xs fp result1
_) ->
              NP CodecConfig xs
-> NP EraNodeToClientVersion xs
-> QueryIfCurrent xs fp result1
-> result1
-> Encoding
forall (xs :: [*]) (fp :: QueryFootprint) result.
All SerialiseConstraintsHFC xs =>
NP CodecConfig xs
-> NP EraNodeToClientVersion xs
-> QueryIfCurrent xs fp result
-> result
-> Encoding
encodeQueryIfCurrentResult NP CodecConfig xs
ccfgs NP EraNodeToClientVersion xs
versions QueryIfCurrent xs fp result1
qry
   where
    ccfgs :: NP CodecConfig xs
ccfgs = PerEraCodecConfig xs -> NP CodecConfig xs
forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs
getPerEraCodecConfig (PerEraCodecConfig xs -> NP CodecConfig xs)
-> PerEraCodecConfig xs -> NP CodecConfig xs
forall a b. (a -> b) -> a -> b
$ CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra CodecConfig (HardForkBlock xs)
ccfg
  encodeBlockQueryResult CodecConfig (HardForkBlock xs)
_ BlockNodeToClientVersion (HardForkBlock xs)
_ (QueryAnytime QueryAnytime result
qry EraIndex (x : xs1)
_) = QueryAnytime result -> result -> Encoding
forall result. QueryAnytime result -> result -> Encoding
encodeQueryAnytimeResult QueryAnytime result
qry
  encodeBlockQueryResult CodecConfig (HardForkBlock xs)
_ BlockNodeToClientVersion (HardForkBlock xs)
_ (QueryHardFork QueryHardFork (x : xs1) result
qry) = QueryHardFork (x : xs1) result -> result -> Encoding
forall (xs :: [*]) result.
SListI xs =>
QueryHardFork xs result -> result -> Encoding
encodeQueryHardForkResult QueryHardFork (x : xs1) result
qry

  decodeBlockQueryResult :: forall (fp :: QueryFootprint) result.
CodecConfig (HardForkBlock xs)
-> BlockNodeToClientVersion (HardForkBlock xs)
-> BlockQuery (HardForkBlock xs) fp result
-> forall s. Decoder s result
decodeBlockQueryResult CodecConfig (HardForkBlock xs)
ccfg BlockNodeToClientVersion (HardForkBlock xs)
version (QueryIfCurrent QueryIfCurrent xs fp result1
qry) =
    case Proxy xs -> ProofNonEmpty xs
forall {a} (xs :: [a]) (proxy :: [a] -> *).
IsNonEmpty xs =>
proxy xs -> ProofNonEmpty xs
forall (proxy :: [*] -> *). proxy xs -> ProofNonEmpty xs
isNonEmpty (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs) of
      ProofNonEmpty{} ->
        BlockNodeToClientVersion (HardForkBlock (x : xs1))
-> Decoder s result1
-> Decoder s (Either (MismatchEraInfo (x : xs1)) result1)
forall (xs :: [*]) s a.
SListI xs =>
BlockNodeToClientVersion (HardForkBlock xs)
-> Decoder s a -> Decoder s (Either (MismatchEraInfo xs) a)
decodeEitherMismatch BlockNodeToClientVersion (HardForkBlock xs)
BlockNodeToClientVersion (HardForkBlock (x : xs1))
version (Decoder s result1
 -> Decoder s (Either (MismatchEraInfo (x : xs1)) result1))
-> Decoder s result1
-> Decoder s (Either (MismatchEraInfo (x : xs1)) result1)
forall a b. (a -> b) -> a -> b
$
          case (NP CodecConfig xs
ccfgs, BlockNodeToClientVersion (HardForkBlock xs)
HardForkNodeToClientVersion xs
version, QueryIfCurrent xs fp result1
qry) of
            (CodecConfig x
c0 :* NP CodecConfig xs1
_, HardForkNodeToClientDisabled BlockNodeToClientVersion x
v0, QZ BlockQuery x fp result1
qry') ->
              CodecConfig x
-> BlockNodeToClientVersion x
-> BlockQuery x fp result1
-> forall s. Decoder s result1
forall k blk (query :: * -> k -> * -> *) (fp :: k) result.
SerialiseBlockQueryResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query blk fp result
-> forall s. Decoder s result
forall (fp :: QueryFootprint) result.
CodecConfig x
-> BlockNodeToClientVersion x
-> BlockQuery x fp result
-> forall s. Decoder s result
decodeBlockQueryResult CodecConfig x
c0 BlockNodeToClientVersion x
BlockNodeToClientVersion x
v0 BlockQuery x fp result1
BlockQuery x fp result1
qry'
            (NP CodecConfig xs
_, HardForkNodeToClientDisabled BlockNodeToClientVersion x
_, QS QueryIfCurrent xs1 fp result1
qry') ->
              HardForkEncoderException -> Decoder s result1
forall a e. (HasCallStack, Exception e) => e -> a
throw (HardForkEncoderException -> Decoder s result1)
-> HardForkEncoderException -> Decoder s result1
forall a b. (a -> b) -> a -> b
$ NS SingleEraInfo xs1 -> HardForkEncoderException
forall (xs :: [*]).
SListI xs =>
NS SingleEraInfo xs -> HardForkEncoderException
futureEraException (QueryIfCurrent xs1 fp result1 -> NS SingleEraInfo xs1
forall (xs :: [*]) (footprint :: QueryFootprint) result.
All SingleEraBlock xs =>
QueryIfCurrent xs footprint result -> NS SingleEraInfo xs
hardForkQueryInfo QueryIfCurrent xs1 fp result1
qry')
            (NP CodecConfig xs
_, HardForkNodeToClientEnabled HardForkSpecificNodeToClientVersion
_ NP EraNodeToClientVersion xs
versions, QueryIfCurrent xs fp result1
_) ->
              NP CodecConfig xs
-> NP EraNodeToClientVersion xs
-> QueryIfCurrent xs fp result1
-> forall s. Decoder s result1
forall (xs :: [*]) (fp :: QueryFootprint) result.
All SerialiseConstraintsHFC xs =>
NP CodecConfig xs
-> NP EraNodeToClientVersion xs
-> QueryIfCurrent xs fp result
-> forall s. Decoder s result
decodeQueryIfCurrentResult NP CodecConfig xs
ccfgs NP EraNodeToClientVersion xs
versions QueryIfCurrent xs fp result1
qry
   where
    ccfgs :: NP CodecConfig xs
ccfgs = PerEraCodecConfig xs -> NP CodecConfig xs
forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs
getPerEraCodecConfig (PerEraCodecConfig xs -> NP CodecConfig xs)
-> PerEraCodecConfig xs -> NP CodecConfig xs
forall a b. (a -> b) -> a -> b
$ CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra CodecConfig (HardForkBlock xs)
ccfg
  decodeBlockQueryResult CodecConfig (HardForkBlock xs)
_ BlockNodeToClientVersion (HardForkBlock xs)
_ (QueryAnytime QueryAnytime result
qry EraIndex (x : xs1)
_) = QueryAnytime result -> forall s. Decoder s result
forall result. QueryAnytime result -> forall s. Decoder s result
decodeQueryAnytimeResult QueryAnytime result
qry
  decodeBlockQueryResult CodecConfig (HardForkBlock xs)
_ BlockNodeToClientVersion (HardForkBlock xs)
_ (QueryHardFork QueryHardFork (x : xs1) result
qry) = QueryHardFork (x : xs1) result -> forall s. Decoder s result
forall (xs :: [*]) result.
SListI xs =>
QueryHardFork xs result -> forall s. Decoder s result
decodeQueryHardForkResult QueryHardFork (x : xs1) result
qry

encodeQueryIfCurrentResult ::
  All SerialiseConstraintsHFC xs =>
  NP CodecConfig xs ->
  NP EraNodeToClientVersion xs ->
  QueryIfCurrent xs fp result ->
  result ->
  Encoding
encodeQueryIfCurrentResult :: forall (xs :: [*]) (fp :: QueryFootprint) result.
All SerialiseConstraintsHFC xs =>
NP CodecConfig xs
-> NP EraNodeToClientVersion xs
-> QueryIfCurrent xs fp result
-> result
-> Encoding
encodeQueryIfCurrentResult (CodecConfig x
c :* NP CodecConfig xs1
_) (EraNodeToClientEnabled BlockNodeToClientVersion x
v :* NP EraNodeToClientVersion xs1
_) (QZ BlockQuery x fp result
qry) =
  CodecConfig x
-> BlockNodeToClientVersion x
-> BlockQuery x fp result
-> result
-> Encoding
forall k blk (query :: * -> k -> * -> *) (fp :: k) result.
SerialiseBlockQueryResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query blk fp result
-> result
-> Encoding
forall (fp :: QueryFootprint) result.
CodecConfig x
-> BlockNodeToClientVersion x
-> BlockQuery x fp result
-> result
-> Encoding
encodeBlockQueryResult CodecConfig x
c BlockNodeToClientVersion x
BlockNodeToClientVersion x
v BlockQuery x fp result
BlockQuery x fp result
qry
encodeQueryIfCurrentResult (CodecConfig x
_ :* NP CodecConfig xs1
_) (EraNodeToClientVersion x
EraNodeToClientDisabled :* NP EraNodeToClientVersion xs1
_) (QZ BlockQuery x fp result
qry) =
  BlockQuery x fp result -> result -> Encoding
forall blk (fp :: QueryFootprint) result.
SingleEraBlock blk =>
BlockQuery blk fp result -> result -> Encoding
qryDisabledEra BlockQuery x fp result
qry
 where
  qryDisabledEra ::
    forall blk fp result.
    SingleEraBlock blk =>
    BlockQuery blk fp result -> result -> Encoding
  qryDisabledEra :: forall blk (fp :: QueryFootprint) result.
SingleEraBlock blk =>
BlockQuery blk fp result -> result -> Encoding
qryDisabledEra BlockQuery blk fp result
_ result
_ = HardForkEncoderException -> Encoding
forall a e. (HasCallStack, Exception e) => e -> a
throw (HardForkEncoderException -> Encoding)
-> HardForkEncoderException -> Encoding
forall a b. (a -> b) -> a -> b
$ Proxy blk -> HardForkEncoderException
forall blk.
SingleEraBlock blk =>
Proxy blk -> HardForkEncoderException
disabledEraException (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)
encodeQueryIfCurrentResult (CodecConfig x
_ :* NP CodecConfig xs1
cs) (EraNodeToClientVersion x
_ :* NP EraNodeToClientVersion xs1
vs) (QS QueryIfCurrent xs1 fp result
qry) =
  NP CodecConfig xs1
-> NP EraNodeToClientVersion xs1
-> QueryIfCurrent xs1 fp result
-> result
-> Encoding
forall (xs :: [*]) (fp :: QueryFootprint) result.
All SerialiseConstraintsHFC xs =>
NP CodecConfig xs
-> NP EraNodeToClientVersion xs
-> QueryIfCurrent xs fp result
-> result
-> Encoding
encodeQueryIfCurrentResult NP CodecConfig xs1
cs NP EraNodeToClientVersion xs1
NP EraNodeToClientVersion xs1
vs QueryIfCurrent xs1 fp result
QueryIfCurrent xs1 fp result
qry
encodeQueryIfCurrentResult NP CodecConfig xs
Nil NP EraNodeToClientVersion xs
_ QueryIfCurrent xs fp result
qry =
  case QueryIfCurrent xs fp result
qry of {}

decodeQueryIfCurrentResult ::
  All SerialiseConstraintsHFC xs =>
  NP CodecConfig xs ->
  NP EraNodeToClientVersion xs ->
  QueryIfCurrent xs fp result ->
  (forall s. Decoder s result)
decodeQueryIfCurrentResult :: forall (xs :: [*]) (fp :: QueryFootprint) result.
All SerialiseConstraintsHFC xs =>
NP CodecConfig xs
-> NP EraNodeToClientVersion xs
-> QueryIfCurrent xs fp result
-> forall s. Decoder s result
decodeQueryIfCurrentResult (CodecConfig x
c :* NP CodecConfig xs1
_) (EraNodeToClientEnabled BlockNodeToClientVersion x
v :* NP EraNodeToClientVersion xs1
_) (QZ BlockQuery x fp result
qry) =
  CodecConfig x
-> BlockNodeToClientVersion x
-> BlockQuery x fp result
-> forall s. Decoder s result
forall k blk (query :: * -> k -> * -> *) (fp :: k) result.
SerialiseBlockQueryResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query blk fp result
-> forall s. Decoder s result
forall (fp :: QueryFootprint) result.
CodecConfig x
-> BlockNodeToClientVersion x
-> BlockQuery x fp result
-> forall s. Decoder s result
decodeBlockQueryResult CodecConfig x
c BlockNodeToClientVersion x
BlockNodeToClientVersion x
v BlockQuery x fp result
BlockQuery x fp result
qry
decodeQueryIfCurrentResult (CodecConfig x
_ :* NP CodecConfig xs1
_) (EraNodeToClientVersion x
EraNodeToClientDisabled :* NP EraNodeToClientVersion xs1
_) (QZ BlockQuery x fp result
qry) =
  BlockQuery x fp result -> forall s. Decoder s result
forall blk (fp :: QueryFootprint) result.
SingleEraBlock blk =>
BlockQuery blk fp result -> forall s. Decoder s result
qryDisabledEra BlockQuery x fp result
qry
 where
  qryDisabledEra ::
    forall blk fp result.
    SingleEraBlock blk =>
    BlockQuery blk fp result -> forall s. Decoder s result
  qryDisabledEra :: forall blk (fp :: QueryFootprint) result.
SingleEraBlock blk =>
BlockQuery blk fp result -> forall s. Decoder s result
qryDisabledEra BlockQuery blk fp result
_ = String -> Decoder s result
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s result)
-> (HardForkEncoderException -> String)
-> HardForkEncoderException
-> Decoder s result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkEncoderException -> String
forall a. Show a => a -> String
show (HardForkEncoderException -> Decoder s result)
-> HardForkEncoderException -> Decoder s result
forall a b. (a -> b) -> a -> b
$ Proxy blk -> HardForkEncoderException
forall blk.
SingleEraBlock blk =>
Proxy blk -> HardForkEncoderException
disabledEraException (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)
decodeQueryIfCurrentResult (CodecConfig x
_ :* NP CodecConfig xs1
cs) (EraNodeToClientVersion x
_ :* NP EraNodeToClientVersion xs1
vs) (QS QueryIfCurrent xs1 fp result
qry) =
  NP CodecConfig xs1
-> NP EraNodeToClientVersion xs1
-> QueryIfCurrent xs1 fp result
-> forall s. Decoder s result
forall (xs :: [*]) (fp :: QueryFootprint) result.
All SerialiseConstraintsHFC xs =>
NP CodecConfig xs
-> NP EraNodeToClientVersion xs
-> QueryIfCurrent xs fp result
-> forall s. Decoder s result
decodeQueryIfCurrentResult NP CodecConfig xs1
cs NP EraNodeToClientVersion xs1
NP EraNodeToClientVersion xs1
vs QueryIfCurrent xs1 fp result
QueryIfCurrent xs1 fp result
qry
decodeQueryIfCurrentResult NP CodecConfig xs
Nil NP EraNodeToClientVersion xs
_ QueryIfCurrent xs fp result
qry =
  case QueryIfCurrent xs fp result
qry of {}