{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wno-orphans #-}

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

import           Codec.CBOR.Encoding (Encoding)
import qualified Data.ByteString.Lazy as Lazy
import           Data.SOP.BasicFunctors
import           Data.SOP.Constraint
import           Data.SOP.Dict (Dict (..), all_NP)
import           Data.SOP.Strict
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import           Ouroboros.Consensus.HardFork.Combinator.Basics
import           Ouroboros.Consensus.HardFork.Combinator.Protocol
import           Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Storage.ChainDB
import           Ouroboros.Consensus.Storage.Serialisation
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Consensus.Util ((.:))

instance SerialiseHFC xs => SerialiseDiskConstraints  (HardForkBlock xs)

{-------------------------------------------------------------------------------
  'ReconstructNestedCtxt'
-------------------------------------------------------------------------------}

instance SerialiseHFC xs => ReconstructNestedCtxt Header (HardForkBlock xs) where
  reconstructPrefixLen :: forall (proxy :: * -> *).
proxy (Header (HardForkBlock xs)) -> PrefixLen
reconstructPrefixLen  = proxy (Header (HardForkBlock xs)) -> PrefixLen
forall (xs :: [*]) (proxy :: * -> *).
SerialiseHFC xs =>
proxy (Header (HardForkBlock xs)) -> PrefixLen
forall (proxy :: * -> *).
proxy (Header (HardForkBlock xs)) -> PrefixLen
reconstructHfcPrefixLen
  reconstructNestedCtxt :: forall (proxy :: * -> *).
proxy (Header (HardForkBlock xs))
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs)
reconstructNestedCtxt = proxy (Header (HardForkBlock xs))
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs)
forall (xs :: [*]) (proxy :: * -> *).
SerialiseHFC xs =>
proxy (Header (HardForkBlock xs))
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs)
forall (proxy :: * -> *).
proxy (Header (HardForkBlock xs))
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs)
reconstructHfcNestedCtxt

{-------------------------------------------------------------------------------
  'HasBinaryBlockInfo'
-------------------------------------------------------------------------------}

instance SerialiseHFC xs => HasBinaryBlockInfo (HardForkBlock xs) where
  getBinaryBlockInfo :: HardForkBlock xs -> BinaryBlockInfo
getBinaryBlockInfo = HardForkBlock xs -> BinaryBlockInfo
forall (xs :: [*]).
SerialiseHFC xs =>
HardForkBlock xs -> BinaryBlockInfo
getHfcBinaryBlockInfo

{-------------------------------------------------------------------------------
  Blocks/headers
-------------------------------------------------------------------------------}

instance SerialiseHFC xs
      => EncodeDisk (HardForkBlock xs) (HardForkBlock xs) where
  encodeDisk :: CodecConfig (HardForkBlock xs) -> HardForkBlock xs -> Encoding
encodeDisk = CodecConfig (HardForkBlock xs) -> HardForkBlock xs -> Encoding
forall (xs :: [*]).
SerialiseHFC xs =>
CodecConfig (HardForkBlock xs) -> HardForkBlock xs -> Encoding
encodeDiskHfcBlock

instance SerialiseHFC xs
      => DecodeDisk (HardForkBlock xs) (Lazy.ByteString -> HardForkBlock xs) where
  decodeDisk :: CodecConfig (HardForkBlock xs)
-> forall s. Decoder s (ByteString -> HardForkBlock xs)
decodeDisk = CodecConfig (HardForkBlock xs)
-> Decoder s (ByteString -> HardForkBlock xs)
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

instance SerialiseHFC xs
      => EncodeDiskDepIx (NestedCtxt Header) (HardForkBlock xs) where
  encodeDiskDepIx :: CodecConfig (HardForkBlock xs)
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs) -> Encoding
encodeDiskDepIx = CodecConfig (HardForkBlock xs)
-> SomeSecond (NestedCtxt Header) (HardForkBlock xs) -> Encoding
forall (f :: * -> *) (xs :: [*]).
All (EncodeDiskDepIx (NestedCtxt f)) xs =>
CodecConfig (HardForkBlock xs)
-> SomeSecond (NestedCtxt f) (HardForkBlock xs) -> Encoding
encodeNestedCtxt

instance SerialiseHFC xs
      => DecodeDiskDepIx (NestedCtxt Header) (HardForkBlock xs) where
  decodeDiskDepIx :: forall s.
CodecConfig (HardForkBlock xs)
-> Decoder s (SomeSecond (NestedCtxt Header) (HardForkBlock xs))
decodeDiskDepIx = CodecConfig (HardForkBlock xs)
-> Decoder s (SomeSecond (NestedCtxt Header) (HardForkBlock xs))
CodecConfig (HardForkBlock xs)
-> forall s.
   Decoder s (SomeSecond (NestedCtxt Header) (HardForkBlock xs))
forall (f :: * -> *) (xs :: [*]).
All (DecodeDiskDepIx (NestedCtxt f)) xs =>
CodecConfig (HardForkBlock xs)
-> forall s.
   Decoder s (SomeSecond (NestedCtxt f) (HardForkBlock xs))
decodeNestedCtxt

instance SerialiseHFC xs
      => EncodeDiskDep (NestedCtxt Header) (HardForkBlock xs) where
  encodeDiskDep :: forall a.
CodecConfig (HardForkBlock xs)
-> NestedCtxt Header (HardForkBlock xs) a -> a -> Encoding
encodeDiskDep =
      case Dict (All (EncodeDiskDep (NestedCtxt Header))) xs
dict of
        Dict (All (EncodeDiskDep (NestedCtxt Header))) xs
Dict -> CodecConfig (HardForkBlock xs)
-> NestedCtxt Header (HardForkBlock xs) a -> a -> Encoding
forall (f :: * -> *) (xs :: [*]) a.
All (EncodeDiskDep (NestedCtxt f)) xs =>
CodecConfig (HardForkBlock xs)
-> NestedCtxt f (HardForkBlock xs) a -> a -> Encoding
encodeNested
    where
      dict :: Dict (All (EncodeDiskDep (NestedCtxt Header))) xs
      dict :: Dict (All (EncodeDiskDep (NestedCtxt Header))) xs
dict = NP (Dict (EncodeDiskDep (NestedCtxt Header))) xs
-> Dict (All (EncodeDiskDep (NestedCtxt Header))) xs
forall {k} (c :: k -> Constraint) (xs :: [k]).
NP (Dict c) xs -> Dict (All c) xs
all_NP (Proxy SerialiseConstraintsHFC
-> (forall a.
    SerialiseConstraintsHFC a =>
    Dict (EncodeDiskDep (NestedCtxt Header)) a)
-> NP (Dict (EncodeDiskDep (NestedCtxt Header))) 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 SerialiseConstraintsHFC
pSHFC Dict (EncodeDiskDep (NestedCtxt Header)) a
forall a.
SerialiseConstraintsHFC a =>
Dict (EncodeDiskDep (NestedCtxt Header)) a
forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict)

instance SerialiseHFC xs
      => DecodeDiskDep (NestedCtxt Header) (HardForkBlock xs) where
  decodeDiskDep :: forall a.
CodecConfig (HardForkBlock xs)
-> NestedCtxt Header (HardForkBlock xs) a
-> forall s. Decoder s (ByteString -> a)
decodeDiskDep =
      case Dict (All (DecodeDiskDep (NestedCtxt Header))) xs
dict of
        Dict (All (DecodeDiskDep (NestedCtxt Header))) xs
Dict -> CodecConfig (HardForkBlock xs)
-> NestedCtxt Header (HardForkBlock xs) a
-> Decoder s (ByteString -> a)
CodecConfig (HardForkBlock xs)
-> NestedCtxt Header (HardForkBlock xs) a
-> forall s. Decoder s (ByteString -> a)
forall (f :: * -> *) (xs :: [*]) a.
All (DecodeDiskDep (NestedCtxt f)) xs =>
CodecConfig (HardForkBlock xs)
-> NestedCtxt f (HardForkBlock xs) a
-> forall s. Decoder s (ByteString -> a)
decodeNested
    where
      dict :: Dict (All (DecodeDiskDep (NestedCtxt Header))) xs
      dict :: Dict (All (DecodeDiskDep (NestedCtxt Header))) xs
dict = NP (Dict (DecodeDiskDep (NestedCtxt Header))) xs
-> Dict (All (DecodeDiskDep (NestedCtxt Header))) xs
forall {k} (c :: k -> Constraint) (xs :: [k]).
NP (Dict c) xs -> Dict (All c) xs
all_NP (Proxy SerialiseConstraintsHFC
-> (forall a.
    SerialiseConstraintsHFC a =>
    Dict (DecodeDiskDep (NestedCtxt Header)) a)
-> NP (Dict (DecodeDiskDep (NestedCtxt Header))) 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 SerialiseConstraintsHFC
pSHFC Dict (DecodeDiskDep (NestedCtxt Header)) a
forall a.
SerialiseConstraintsHFC a =>
Dict (DecodeDiskDep (NestedCtxt Header)) a
forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict)

{-------------------------------------------------------------------------------
  Ledger state
-------------------------------------------------------------------------------}

instance SerialiseHFC xs
      => EncodeDisk (HardForkBlock xs) (AnnTip (HardForkBlock xs)) where
  encodeDisk :: CodecConfig (HardForkBlock xs)
-> AnnTip (HardForkBlock xs) -> Encoding
encodeDisk CodecConfig (HardForkBlock xs)
cfg =
        NP (AnnTip -.-> K Encoding) xs -> NS AnnTip 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 -> (-.->) AnnTip (K Encoding) a)
-> NP CodecConfig xs
-> NP (AnnTip -.-> 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 ((AnnTip a -> K Encoding a) -> (-.->) AnnTip (K Encoding) a
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn ((AnnTip a -> K Encoding a) -> (-.->) AnnTip (K Encoding) a)
-> (CodecConfig a -> AnnTip a -> K Encoding a)
-> CodecConfig a
-> (-.->) AnnTip (K Encoding) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Encoding -> K Encoding a
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding a)
-> (CodecConfig a -> AnnTip a -> Encoding)
-> CodecConfig a
-> AnnTip a
-> K Encoding a
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: CodecConfig a -> AnnTip a -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk)) NP CodecConfig xs
cfgs)
      (NS AnnTip xs -> Encoding)
-> (AnnTip (HardForkBlock xs) -> NS AnnTip xs)
-> AnnTip (HardForkBlock xs)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnTip (HardForkBlock xs) -> NS AnnTip xs
forall (xs :: [*]).
SListI xs =>
AnnTip (HardForkBlock xs) -> NS AnnTip xs
distribAnnTip
    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)

instance SerialiseHFC xs
      => DecodeDisk (HardForkBlock xs) (AnnTip (HardForkBlock xs)) where
  decodeDisk :: CodecConfig (HardForkBlock xs)
-> forall s. Decoder s (AnnTip (HardForkBlock xs))
decodeDisk CodecConfig (HardForkBlock xs)
cfg =
        (NS AnnTip xs -> AnnTip (HardForkBlock xs))
-> Decoder s (NS AnnTip xs)
-> Decoder s (AnnTip (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 NS AnnTip xs -> AnnTip (HardForkBlock xs)
forall (xs :: [*]).
SListI xs =>
NS AnnTip xs -> AnnTip (HardForkBlock xs)
undistribAnnTip
      (Decoder s (NS AnnTip xs) -> Decoder s (AnnTip (HardForkBlock xs)))
-> Decoder s (NS AnnTip xs)
-> Decoder s (AnnTip (HardForkBlock xs))
forall a b. (a -> b) -> a -> b
$ NP (Decoder s :.: AnnTip) xs -> Decoder s (NS AnnTip xs)
forall (xs :: [*]) s (f :: * -> *).
SListI xs =>
NP (Decoder s :.: f) xs -> Decoder s (NS f xs)
decodeNS (Proxy SerialiseConstraintsHFC
-> (forall a.
    SerialiseConstraintsHFC a =>
    CodecConfig a -> (:.:) (Decoder s) AnnTip a)
-> NP CodecConfig xs
-> NP (Decoder s :.: AnnTip) 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 (Decoder s (AnnTip a) -> (:.:) (Decoder s) AnnTip a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Decoder s (AnnTip a) -> (:.:) (Decoder s) AnnTip a)
-> (CodecConfig a -> Decoder s (AnnTip a))
-> CodecConfig a
-> (:.:) (Decoder s) AnnTip a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodecConfig a -> Decoder s (AnnTip a)
CodecConfig a -> forall s. Decoder s (AnnTip a)
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk) 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)

instance SerialiseHFC xs
      => EncodeDisk (HardForkBlock xs) (HardForkChainDepState xs) where
  encodeDisk :: CodecConfig (HardForkBlock xs)
-> HardForkChainDepState xs -> Encoding
encodeDisk CodecConfig (HardForkBlock xs)
cfg =
      NP (WrapChainDepState -.-> K Encoding) xs
-> HardForkChainDepState xs -> Encoding
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
NP (f -.-> K Encoding) xs -> HardForkState f xs -> Encoding
encodeTelescope (Proxy SerialiseConstraintsHFC
-> (forall a.
    SerialiseConstraintsHFC a =>
    CodecConfig a -> (-.->) WrapChainDepState (K Encoding) a)
-> NP CodecConfig xs
-> NP (WrapChainDepState -.-> 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 ((WrapChainDepState a -> K Encoding a)
-> (-.->) WrapChainDepState (K Encoding) a
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn ((WrapChainDepState a -> K Encoding a)
 -> (-.->) WrapChainDepState (K Encoding) a)
-> (CodecConfig a -> WrapChainDepState a -> K Encoding a)
-> CodecConfig a
-> (-.->) WrapChainDepState (K Encoding) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodecConfig a -> WrapChainDepState a -> K Encoding a
forall blk.
SerialiseDiskConstraints blk =>
CodecConfig blk -> WrapChainDepState blk -> K Encoding blk
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 -> WrapChainDepState blk -> K Encoding blk
      aux :: forall blk.
SerialiseDiskConstraints blk =>
CodecConfig blk -> WrapChainDepState blk -> K Encoding blk
aux CodecConfig blk
cfg' (WrapChainDepState ChainDepState (BlockProtocol blk)
st) = Encoding -> K Encoding blk
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding blk) -> Encoding -> K Encoding blk
forall a b. (a -> b) -> a -> b
$ CodecConfig blk -> ChainDepState (BlockProtocol blk) -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig blk
cfg' ChainDepState (BlockProtocol blk)
st

instance SerialiseHFC xs
      => DecodeDisk (HardForkBlock xs) (HardForkChainDepState xs) where
  decodeDisk :: CodecConfig (HardForkBlock xs)
-> forall s. Decoder s (HardForkChainDepState xs)
decodeDisk CodecConfig (HardForkBlock xs)
cfg =
      NP (Decoder s :.: WrapChainDepState) xs
-> Decoder s (HardForkChainDepState xs)
forall s (f :: * -> *) (xs :: [*]).
NP (Decoder s :.: f) xs -> Decoder s (HardForkState f xs)
decodeTelescope (Proxy SerialiseConstraintsHFC
-> (forall a.
    SerialiseConstraintsHFC a =>
    CodecConfig a -> (:.:) (Decoder s) WrapChainDepState a)
-> NP CodecConfig xs
-> NP (Decoder s :.: WrapChainDepState) 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 (Decoder s (WrapChainDepState a)
-> (:.:) (Decoder s) WrapChainDepState a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Decoder s (WrapChainDepState a)
 -> (:.:) (Decoder s) WrapChainDepState a)
-> (CodecConfig a -> Decoder s (WrapChainDepState a))
-> CodecConfig a
-> (:.:) (Decoder s) WrapChainDepState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainDepState (BlockProtocol a) -> WrapChainDepState a)
-> Decoder s (ChainDepState (BlockProtocol a))
-> Decoder s (WrapChainDepState a)
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChainDepState (BlockProtocol a) -> WrapChainDepState a
forall blk.
ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
WrapChainDepState (Decoder s (ChainDepState (BlockProtocol a))
 -> Decoder s (WrapChainDepState a))
-> (CodecConfig a -> Decoder s (ChainDepState (BlockProtocol a)))
-> CodecConfig a
-> Decoder s (WrapChainDepState a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodecConfig a -> Decoder s (ChainDepState (BlockProtocol a))
CodecConfig a
-> forall s. Decoder s (ChainDepState (BlockProtocol a))
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk) 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)

instance SerialiseHFC xs
      => EncodeDisk (HardForkBlock xs) (LedgerState (HardForkBlock xs) )where
  encodeDisk :: CodecConfig (HardForkBlock xs)
-> LedgerState (HardForkBlock xs) -> Encoding
encodeDisk CodecConfig (HardForkBlock xs)
cfg =
        NP (LedgerState -.-> K Encoding) xs
-> HardForkState LedgerState xs -> Encoding
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
NP (f -.-> K Encoding) xs -> HardForkState f xs -> Encoding
encodeTelescope (Proxy SerialiseConstraintsHFC
-> (forall a.
    SerialiseConstraintsHFC a =>
    CodecConfig a -> (-.->) LedgerState (K Encoding) a)
-> NP CodecConfig xs
-> NP (LedgerState -.-> 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 ((LedgerState a -> K Encoding a)
-> (-.->) LedgerState (K Encoding) a
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn ((LedgerState a -> K Encoding a)
 -> (-.->) LedgerState (K Encoding) a)
-> (CodecConfig a -> LedgerState a -> K Encoding a)
-> CodecConfig a
-> (-.->) LedgerState (K Encoding) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Encoding -> K Encoding a
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding a)
-> (CodecConfig a -> LedgerState a -> Encoding)
-> CodecConfig a
-> LedgerState a
-> K Encoding a
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: CodecConfig a -> LedgerState a -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk)) NP CodecConfig xs
cfgs)
      (HardForkState LedgerState xs -> Encoding)
-> (LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs)
-> LedgerState (HardForkBlock xs)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs
forall (xs :: [*]).
LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs
hardForkLedgerStatePerEra
    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)

instance SerialiseHFC xs
      => DecodeDisk (HardForkBlock xs) (LedgerState (HardForkBlock xs)) where
  decodeDisk :: CodecConfig (HardForkBlock xs)
-> forall s. Decoder s (LedgerState (HardForkBlock xs))
decodeDisk CodecConfig (HardForkBlock xs)
cfg =
        (HardForkState LedgerState xs -> LedgerState (HardForkBlock xs))
-> Decoder s (HardForkState LedgerState xs)
-> Decoder s (LedgerState (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 HardForkState LedgerState xs -> LedgerState (HardForkBlock xs)
forall (xs :: [*]).
HardForkState LedgerState xs -> LedgerState (HardForkBlock xs)
HardForkLedgerState
      (Decoder s (HardForkState LedgerState xs)
 -> Decoder s (LedgerState (HardForkBlock xs)))
-> Decoder s (HardForkState LedgerState xs)
-> Decoder s (LedgerState (HardForkBlock xs))
forall a b. (a -> b) -> a -> b
$ NP (Decoder s :.: LedgerState) xs
-> Decoder s (HardForkState LedgerState xs)
forall s (f :: * -> *) (xs :: [*]).
NP (Decoder s :.: f) xs -> Decoder s (HardForkState f xs)
decodeTelescope (Proxy SerialiseConstraintsHFC
-> (forall a.
    SerialiseConstraintsHFC a =>
    CodecConfig a -> (:.:) (Decoder s) LedgerState a)
-> NP CodecConfig xs
-> NP (Decoder s :.: LedgerState) 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 (Decoder s (LedgerState a) -> (:.:) (Decoder s) LedgerState a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Decoder s (LedgerState a) -> (:.:) (Decoder s) LedgerState a)
-> (CodecConfig a -> Decoder s (LedgerState a))
-> CodecConfig a
-> (:.:) (Decoder s) LedgerState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodecConfig a -> Decoder s (LedgerState a)
CodecConfig a -> forall s. Decoder s (LedgerState a)
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk) 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)