{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Serialisation for on-disk storage.
--
-- We have separate classes for on-disk and on-the-wire serialisation, because
-- the encoding formats of the same type may differ, depending on the context.
--
-- We separate the encoder from the decoder, because sometimes the encoded
-- type will differ from the decoded one. For example, we encode a @blk@, but
-- decode an @'Lazy.ByteString' -> blk@ (when reading something from disk, we
-- have the precise bytestring that we can pass in as the annotation). If we
-- coupled the encoder to the decoder, we wouldn't be able to cleanly model
-- this use case. Moreover, sometimes we only need a single direction.
module Ouroboros.Consensus.Storage.Serialisation (
    -- * Serialisation to/from disk storage
    DecodeDisk (..)
  , EncodeDisk (..)
    -- * Support for dependent pairs
  , DecodeDiskDep (..)
  , DecodeDiskDepIx (..)
  , EncodeDiskDep (..)
  , EncodeDiskDepIx (..)
    -- * Serialised header
  , SerialisedHeader (..)
  , castSerialisedHeader
  , decodeTrivialSerialisedHeader
  , encodeTrivialSerialisedHeader
  , serialisedHeaderFromPair
  , serialisedHeaderToPair
    -- * Reconstruct nested type
  , PrefixLen (..)
  , ReconstructNestedCtxt (..)
  , addPrefixLen
  , takePrefix
    -- * Binary block info
  , BinaryBlockInfo (..)
  , HasBinaryBlockInfo (..)
    -- * Re-exported for convenience
  , SizeInBytes
    -- * Exported for the benefit of tests
  , decodeDepPair
  , encodeDepPair
  ) where

import           Cardano.Binary (enforceSize)
import           Codec.CBOR.Decoding (Decoder)
import           Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as CBOR
import           Codec.Serialise
import qualified Data.ByteString.Lazy as Lazy
import           Data.ByteString.Short (ShortByteString)
import           Data.SOP.BasicFunctors
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Protocol.Abstract
import           Ouroboros.Consensus.Storage.Common (BinaryBlockInfo (..),
                     PrefixLen (..), addPrefixLen, takePrefix)
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Consensus.Util (ShowProxy (..))
import           Ouroboros.Consensus.Util.RedundantConstraints
import           Ouroboros.Network.Block (Serialised (..), fromSerialised,
                     mkSerialised)
import           Ouroboros.Network.SizeInBytes (SizeInBytes)

{-------------------------------------------------------------------------------
  Serialisation to/from disk storage
-------------------------------------------------------------------------------}

-- | Encode a type @a@ so that it can be stored on disk.
--
-- There is no version negotiation for on disk serialisation. However,
-- instances can still decide to perform versioning internally to maintain
-- compatibility.
class EncodeDisk blk a where
  encodeDisk :: CodecConfig blk -> a -> Encoding

  -- When the config is not needed, we provide a default implementation using
  -- 'Serialise'
  default encodeDisk
    :: Serialise a
    => CodecConfig blk -> a -> Encoding
  encodeDisk CodecConfig blk
_ccfg = a -> Encoding
forall a. Serialise a => a -> Encoding
encode

-- | Decode a type @a@ read from disk.
--
-- There is no version negotiation for on disk serialisation. However,
-- instances can still decide to perform versioning internally to maintain
-- compatibility.
class DecodeDisk blk a where
  decodeDisk :: CodecConfig blk -> forall s. Decoder s a

  -- When the config is not needed, we provide a default implementation using
  -- 'Serialise'
  default decodeDisk
    :: Serialise a
    => CodecConfig blk -> forall s. Decoder s a
  decodeDisk CodecConfig blk
_ccfg = Decoder s a
forall s. Decoder s a
forall a s. Serialise a => Decoder s a
decode

{-------------------------------------------------------------------------------
  Dependent pairs
-------------------------------------------------------------------------------}

-- | Encode dependent index
class EncodeDiskDepIx f blk where
  encodeDiskDepIx :: CodecConfig blk -> SomeSecond f blk -> Encoding

  default encodeDiskDepIx
    :: TrivialDependency (f blk)
    => CodecConfig blk -> SomeSecond f blk -> Encoding
  encodeDiskDepIx CodecConfig blk
_ SomeSecond f blk
_ = () -> Encoding
forall a. Serialise a => a -> Encoding
encode ()
    where
      ()
_ = Proxy (TrivialDependency (f blk)) -> ()
forall (c :: Constraint) (proxy :: Constraint -> *).
c =>
proxy c -> ()
keepRedundantConstraint (forall {k} (t :: k). Proxy t
forall (t :: Constraint). Proxy t
Proxy @(TrivialDependency (f blk)))

-- | Encode a dependent value
class EncodeDiskDep f blk where
  encodeDiskDep :: CodecConfig blk -> f blk a -> a -> Encoding

  default encodeDiskDep
    :: ( TrivialDependency (f blk)
       , EncodeDisk blk (TrivialIndex (f blk))
       )
    => CodecConfig blk -> f blk a -> a -> Encoding
  encodeDiskDep CodecConfig blk
cfg f blk a
ctxt = CodecConfig blk -> TrivialIndex (f blk) -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig blk
cfg (TrivialIndex (f blk) -> Encoding)
-> (a -> TrivialIndex (f blk)) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f blk a -> a -> TrivialIndex (f blk)
forall (f :: * -> *) a.
TrivialDependency f =>
f a -> a -> TrivialIndex f
fromTrivialDependency f blk a
ctxt

-- | Decode dependent index
class DecodeDiskDepIx f blk where
  decodeDiskDepIx :: CodecConfig blk -> Decoder s (SomeSecond f blk)

  default decodeDiskDepIx
    :: TrivialDependency (f blk)
    => CodecConfig blk -> Decoder s (SomeSecond f blk)
  decodeDiskDepIx CodecConfig blk
_ = (\() -> f blk (TrivialIndex (f blk)) -> SomeSecond f blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond f blk (TrivialIndex (f blk))
forall (f :: * -> *). TrivialDependency f => f (TrivialIndex f)
indexIsTrivial) (() -> SomeSecond f blk)
-> Decoder s () -> Decoder s (SomeSecond f blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ()
forall s. Decoder s ()
forall a s. Serialise a => Decoder s a
decode

-- | Decode a dependent value
--
-- Typical usage: @f = NestedCtxt Header@.
class DecodeDiskDep f blk where
  decodeDiskDep :: CodecConfig blk -> f blk a -> forall s. Decoder s (Lazy.ByteString -> a)

  default decodeDiskDep
    :: ( TrivialDependency (f blk)
       , DecodeDisk blk (Lazy.ByteString -> TrivialIndex (f blk))
       )
    => CodecConfig blk -> f blk a -> forall s. Decoder s (Lazy.ByteString -> a)
  decodeDiskDep CodecConfig blk
cfg f blk a
ctxt =
      (\ByteString -> TrivialIndex (f blk)
f -> f blk a -> TrivialIndex (f blk) -> a
forall (f :: * -> *) a.
TrivialDependency f =>
f a -> TrivialIndex f -> a
toTrivialDependency f blk a
ctxt (TrivialIndex (f blk) -> a)
-> (ByteString -> TrivialIndex (f blk)) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> TrivialIndex (f blk)
f) ((ByteString -> TrivialIndex (f blk)) -> ByteString -> a)
-> Decoder s (ByteString -> TrivialIndex (f blk))
-> Decoder s (ByteString -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig blk
-> forall s. Decoder s (ByteString -> TrivialIndex (f blk))
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig blk
cfg

instance (EncodeDiskDepIx f blk, EncodeDiskDep f blk)
       => EncodeDisk blk (DepPair (f blk)) where
  encodeDisk :: CodecConfig blk -> DepPair (f blk) -> Encoding
encodeDisk CodecConfig blk
ccfg = CodecConfig blk -> GenDepPair Serialised (f blk) -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig blk
ccfg (GenDepPair Serialised (f blk) -> Encoding)
-> (DepPair (f blk) -> GenDepPair Serialised (f blk))
-> DepPair (f blk)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodecConfig blk -> DepPair (f blk) -> GenDepPair Serialised (f blk)
forall (f :: * -> * -> *) blk.
EncodeDiskDep f blk =>
CodecConfig blk -> DepPair (f blk) -> GenDepPair Serialised (f blk)
encodeDepPair CodecConfig blk
ccfg

instance (DecodeDiskDepIx f blk, DecodeDiskDep f blk)
       => DecodeDisk blk (DepPair (f blk)) where
  decodeDisk :: CodecConfig blk -> forall s. Decoder s (DepPair (f blk))
decodeDisk CodecConfig blk
ccfg = CodecConfig blk
-> forall s. Decoder s (GenDepPair Serialised (f blk))
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig blk
ccfg Decoder s (GenDepPair Serialised (f blk))
-> (GenDepPair Serialised (f blk) -> Decoder s (DepPair (f blk)))
-> Decoder s (DepPair (f blk))
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodecConfig blk
-> GenDepPair Serialised (f blk) -> Decoder s (DepPair (f blk))
forall (f :: * -> * -> *) blk s.
DecodeDiskDep f blk =>
CodecConfig blk
-> GenDepPair Serialised (f blk) -> Decoder s (DepPair (f blk))
decodeDepPair CodecConfig blk
ccfg

{-------------------------------------------------------------------------------
  Internal: support for serialisation of dependent pairs
-------------------------------------------------------------------------------}

encodeDepPair :: EncodeDiskDep f blk
              => CodecConfig blk
              -> DepPair (f blk) -> GenDepPair Serialised (f blk)
encodeDepPair :: forall (f :: * -> * -> *) blk.
EncodeDiskDep f blk =>
CodecConfig blk -> DepPair (f blk) -> GenDepPair Serialised (f blk)
encodeDepPair CodecConfig blk
ccfg (DepPair f blk a
fa a
a) =
    f blk a -> Serialised a -> GenDepPair Serialised (f blk)
forall (f :: * -> *) a (g :: * -> *). f a -> g a -> GenDepPair g f
GenDepPair f blk a
fa ((a -> Encoding) -> a -> Serialised a
forall a. (a -> Encoding) -> a -> Serialised a
mkSerialised (CodecConfig blk -> f blk a -> a -> Encoding
forall a. CodecConfig blk -> f blk a -> a -> Encoding
forall (f :: * -> * -> *) blk a.
EncodeDiskDep f blk =>
CodecConfig blk -> f blk a -> a -> Encoding
encodeDiskDep CodecConfig blk
ccfg f blk a
fa) a
a)

decodeDepPair :: DecodeDiskDep f blk
              => CodecConfig blk
              -> GenDepPair Serialised (f blk) -> Decoder s (DepPair (f blk))
decodeDepPair :: forall (f :: * -> * -> *) blk s.
DecodeDiskDep f blk =>
CodecConfig blk
-> GenDepPair Serialised (f blk) -> Decoder s (DepPair (f blk))
decodeDepPair CodecConfig blk
ccfg (GenDepPair f blk a
fa Serialised a
serialised) =
    f blk a -> a -> DepPair (f blk)
forall (f :: * -> *) a. f a -> a -> DepPair f
DepPair f blk a
fa (a -> DepPair (f blk))
-> Decoder s a -> Decoder s (DepPair (f blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. Decoder s (ByteString -> a))
-> Serialised a -> forall s. Decoder s a
forall a.
(forall s. Decoder s (ByteString -> a))
-> Serialised a -> forall s. Decoder s a
fromSerialised (CodecConfig blk -> f blk a -> forall s. Decoder s (ByteString -> a)
forall a.
CodecConfig blk -> f blk a -> forall s. Decoder s (ByteString -> a)
forall (f :: * -> * -> *) blk a.
DecodeDiskDep f blk =>
CodecConfig blk -> f blk a -> forall s. Decoder s (ByteString -> a)
decodeDiskDep CodecConfig blk
ccfg f blk a
fa) Serialised a
serialised

instance EncodeDiskDepIx f blk => EncodeDisk blk (GenDepPair Serialised (f blk)) where
  encodeDisk :: CodecConfig blk -> GenDepPair Serialised (f blk) -> Encoding
encodeDisk CodecConfig blk
ccfg (GenDepPair f blk a
fa Serialised a
serialised) = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
        Word -> Encoding
CBOR.encodeListLen Word
2
      , CodecConfig blk -> SomeSecond f blk -> Encoding
forall (f :: * -> * -> *) blk.
EncodeDiskDepIx f blk =>
CodecConfig blk -> SomeSecond f blk -> Encoding
encodeDiskDepIx CodecConfig blk
ccfg (f blk a -> SomeSecond f blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond f blk a
fa)
      , Serialised a -> Encoding
forall a. Serialise a => a -> Encoding
encode Serialised a
serialised
      ]

instance DecodeDiskDepIx f blk => DecodeDisk blk (GenDepPair Serialised (f blk)) where
  decodeDisk :: CodecConfig blk
-> forall s. Decoder s (GenDepPair Serialised (f blk))
decodeDisk CodecConfig blk
ccfg = do
      Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"DecodeDisk GenDepPair" Int
2
      SomeSecond f blk b
fa <- CodecConfig blk -> Decoder s (SomeSecond f blk)
forall s. CodecConfig blk -> Decoder s (SomeSecond f blk)
forall (f :: * -> * -> *) blk s.
DecodeDiskDepIx f blk =>
CodecConfig blk -> Decoder s (SomeSecond f blk)
decodeDiskDepIx CodecConfig blk
ccfg
      Serialised b
serialised   <- Decoder s (Serialised b)
forall s. Decoder s (Serialised b)
forall a s. Serialise a => Decoder s a
decode
      GenDepPair Serialised (f blk)
-> Decoder s (GenDepPair Serialised (f blk))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenDepPair Serialised (f blk)
 -> Decoder s (GenDepPair Serialised (f blk)))
-> GenDepPair Serialised (f blk)
-> Decoder s (GenDepPair Serialised (f blk))
forall a b. (a -> b) -> a -> b
$ f blk b -> Serialised b -> GenDepPair Serialised (f blk)
forall (f :: * -> *) a (g :: * -> *). f a -> g a -> GenDepPair g f
GenDepPair f blk b
fa Serialised b
serialised

{-------------------------------------------------------------------------------
  Serialised header

  TODO: Not entirely sure we /want/ default instances for EncodeDisk/DecodeDisk
  for 'SerialisedHeader'.
-------------------------------------------------------------------------------}

-- | A 'Serialised' header along with context identifying what kind of header
-- it is.
--
-- The 'SerialiseNodeToNodeDep' for 'Header' will decide how to actually
-- encode this.
newtype SerialisedHeader blk = SerialisedHeaderFromDepPair {
      forall blk.
SerialisedHeader blk
-> GenDepPair Serialised (NestedCtxt Header blk)
serialisedHeaderToDepPair :: GenDepPair Serialised (NestedCtxt Header blk)
    }

deriving instance HasNestedContent Header blk => Show (SerialisedHeader blk)
instance ShowProxy blk => ShowProxy (SerialisedHeader blk) where
    showProxy :: Proxy (SerialisedHeader blk) -> String
showProxy Proxy (SerialisedHeader blk)
_ = String
"SerialisedHeader " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy blk -> String
forall {k} (p :: k). ShowProxy p => Proxy p -> String
showProxy (Proxy blk
forall {k} (t :: k). Proxy t
Proxy :: Proxy blk)

-- | Only needed for the 'ChainSyncServer'
type instance HeaderHash (SerialisedHeader blk) = HeaderHash blk
instance StandardHash blk => StandardHash (SerialisedHeader blk)

serialisedHeaderToPair ::
     SerialisedHeader blk
  -> (SomeSecond (NestedCtxt Header) blk, Lazy.ByteString)
serialisedHeaderToPair :: forall blk.
SerialisedHeader blk
-> (SomeSecond (NestedCtxt Header) blk, ByteString)
serialisedHeaderToPair SerialisedHeader blk
hdr =
    case SerialisedHeader blk
-> GenDepPair Serialised (NestedCtxt Header blk)
forall blk.
SerialisedHeader blk
-> GenDepPair Serialised (NestedCtxt Header blk)
serialisedHeaderToDepPair SerialisedHeader blk
hdr of
      GenDepPair NestedCtxt Header blk a
ctxt (Serialised ByteString
bs) -> (NestedCtxt Header blk a -> SomeSecond (NestedCtxt Header) blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond NestedCtxt Header blk a
ctxt, ByteString
bs)

serialisedHeaderFromPair ::
     (SomeSecond (NestedCtxt Header) blk, Lazy.ByteString)
  -> SerialisedHeader blk
serialisedHeaderFromPair :: forall blk.
(SomeSecond (NestedCtxt Header) blk, ByteString)
-> SerialisedHeader blk
serialisedHeaderFromPair (SomeSecond NestedCtxt Header blk b
ctxt, ByteString
bs) =
    GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
forall blk.
GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
SerialisedHeaderFromDepPair (GenDepPair Serialised (NestedCtxt Header blk)
 -> SerialisedHeader blk)
-> GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
forall a b. (a -> b) -> a -> b
$
      NestedCtxt Header blk b
-> Serialised b -> GenDepPair Serialised (NestedCtxt Header blk)
forall (f :: * -> *) a (g :: * -> *). f a -> g a -> GenDepPair g f
GenDepPair NestedCtxt Header blk b
ctxt (ByteString -> Serialised b
forall {k} (a :: k). ByteString -> Serialised a
Serialised ByteString
bs)

castSerialisedHeader ::
     (forall a. NestedCtxt_ blk Header a -> NestedCtxt_ blk' Header a)
  -> SerialisedHeader blk -> SerialisedHeader blk'
castSerialisedHeader :: forall blk blk'.
(forall a. NestedCtxt_ blk Header a -> NestedCtxt_ blk' Header a)
-> SerialisedHeader blk -> SerialisedHeader blk'
castSerialisedHeader forall a. NestedCtxt_ blk Header a -> NestedCtxt_ blk' Header a
f =
      GenDepPair Serialised (NestedCtxt Header blk')
-> SerialisedHeader blk'
forall blk.
GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
SerialisedHeaderFromDepPair
    (GenDepPair Serialised (NestedCtxt Header blk')
 -> SerialisedHeader blk')
-> (SerialisedHeader blk
    -> GenDepPair Serialised (NestedCtxt Header blk'))
-> SerialisedHeader blk
-> SerialisedHeader blk'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. NestedCtxt Header blk a -> NestedCtxt Header blk' a)
-> GenDepPair Serialised (NestedCtxt Header blk)
-> GenDepPair Serialised (NestedCtxt Header blk')
forall (f :: * -> *) (f' :: * -> *) (g :: * -> *).
(forall a. f a -> f' a) -> GenDepPair g f -> GenDepPair g f'
depPairFirst ((NestedCtxt_ blk Header a -> NestedCtxt_ blk' Header a)
-> NestedCtxt Header blk a -> NestedCtxt Header blk' a
forall blk (f :: * -> *) a blk'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f a)
-> NestedCtxt f blk a -> NestedCtxt f blk' a
castNestedCtxt NestedCtxt_ blk Header a -> NestedCtxt_ blk' Header a
forall a. NestedCtxt_ blk Header a -> NestedCtxt_ blk' Header a
f)
    (GenDepPair Serialised (NestedCtxt Header blk)
 -> GenDepPair Serialised (NestedCtxt Header blk'))
-> (SerialisedHeader blk
    -> GenDepPair Serialised (NestedCtxt Header blk))
-> SerialisedHeader blk
-> GenDepPair Serialised (NestedCtxt Header blk')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialisedHeader blk
-> GenDepPair Serialised (NestedCtxt Header blk)
forall blk.
SerialisedHeader blk
-> GenDepPair Serialised (NestedCtxt Header blk)
serialisedHeaderToDepPair

instance EncodeDiskDepIx (NestedCtxt Header) blk
      => EncodeDisk blk (SerialisedHeader blk) where
  encodeDisk :: CodecConfig blk -> SerialisedHeader blk -> Encoding
encodeDisk CodecConfig blk
ccfg = CodecConfig blk
-> GenDepPair Serialised (NestedCtxt Header blk) -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig blk
ccfg (GenDepPair Serialised (NestedCtxt Header blk) -> Encoding)
-> (SerialisedHeader blk
    -> GenDepPair Serialised (NestedCtxt Header blk))
-> SerialisedHeader blk
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialisedHeader blk
-> GenDepPair Serialised (NestedCtxt Header blk)
forall blk.
SerialisedHeader blk
-> GenDepPair Serialised (NestedCtxt Header blk)
serialisedHeaderToDepPair

instance DecodeDiskDepIx (NestedCtxt Header) blk
      => DecodeDisk blk (SerialisedHeader blk) where
  decodeDisk :: CodecConfig blk -> forall s. Decoder s (SerialisedHeader blk)
decodeDisk CodecConfig blk
ccfg = GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
forall blk.
GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
SerialisedHeaderFromDepPair (GenDepPair Serialised (NestedCtxt Header blk)
 -> SerialisedHeader blk)
-> Decoder s (GenDepPair Serialised (NestedCtxt Header blk))
-> Decoder s (SerialisedHeader blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig blk
-> forall s.
   Decoder s (GenDepPair Serialised (NestedCtxt Header blk))
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig blk
ccfg

-- | Encode the header without the 'NestedCtxt'
--
-- Uses CBOR-in-CBOR
encodeTrivialSerialisedHeader ::
     forall blk. TrivialDependency (NestedCtxt_ blk Header)
  => SerialisedHeader blk -> Encoding
encodeTrivialSerialisedHeader :: forall blk.
TrivialDependency (NestedCtxt_ blk Header) =>
SerialisedHeader blk -> Encoding
encodeTrivialSerialisedHeader =
      Serialised Any -> Encoding
forall a. Serialise a => a -> Encoding
encode
    (Serialised Any -> Encoding)
-> (SerialisedHeader blk -> Serialised Any)
-> SerialisedHeader blk
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Serialised Any
forall {k} (a :: k). ByteString -> Serialised a
Serialised
    (ByteString -> Serialised Any)
-> (SerialisedHeader blk -> ByteString)
-> SerialisedHeader blk
-> Serialised Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeSecond (NestedCtxt Header) blk, ByteString) -> ByteString
forall a b. (a, b) -> b
snd
    ((SomeSecond (NestedCtxt Header) blk, ByteString) -> ByteString)
-> (SerialisedHeader blk
    -> (SomeSecond (NestedCtxt Header) blk, ByteString))
-> SerialisedHeader blk
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialisedHeader blk
-> (SomeSecond (NestedCtxt Header) blk, ByteString)
forall blk.
SerialisedHeader blk
-> (SomeSecond (NestedCtxt Header) blk, ByteString)
serialisedHeaderToPair
  where
    ()
_ = Proxy (TrivialDependency (NestedCtxt_ blk Header)) -> ()
forall (c :: Constraint) (proxy :: Constraint -> *).
c =>
proxy c -> ()
keepRedundantConstraint (forall {k} (t :: k). Proxy t
forall (t :: Constraint). Proxy t
Proxy @(TrivialDependency (NestedCtxt_ blk Header)))

-- | Inverse to 'encodeTrivialSerialisedHeader'
decodeTrivialSerialisedHeader ::
     forall blk. TrivialDependency (NestedCtxt_ blk Header)
  => forall s. Decoder s (SerialisedHeader blk)
decodeTrivialSerialisedHeader :: forall blk s.
TrivialDependency (NestedCtxt_ blk Header) =>
Decoder s (SerialisedHeader blk)
decodeTrivialSerialisedHeader =
    ( (SomeSecond (NestedCtxt Header) blk, ByteString)
-> SerialisedHeader blk
forall blk.
(SomeSecond (NestedCtxt Header) blk, ByteString)
-> SerialisedHeader blk
serialisedHeaderFromPair
    ((SomeSecond (NestedCtxt Header) blk, ByteString)
 -> SerialisedHeader blk)
-> (Serialised Any
    -> (SomeSecond (NestedCtxt Header) blk, ByteString))
-> Serialised Any
-> SerialisedHeader blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NestedCtxt Header blk (TrivialIndex (NestedCtxt_ blk Header))
-> SomeSecond (NestedCtxt Header) blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (NestedCtxt_ blk Header (TrivialIndex (NestedCtxt_ blk Header))
-> NestedCtxt Header blk (TrivialIndex (NestedCtxt_ blk Header))
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt NestedCtxt_ blk Header (TrivialIndex (NestedCtxt_ blk Header))
forall (f :: * -> *). TrivialDependency f => f (TrivialIndex f)
indexIsTrivial), )
    (ByteString -> (SomeSecond (NestedCtxt Header) blk, ByteString))
-> (Serialised Any -> ByteString)
-> Serialised Any
-> (SomeSecond (NestedCtxt Header) blk, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Serialised Any -> ByteString
forall {k} (a :: k). Serialised a -> ByteString
unSerialised
    ) (Serialised Any -> SerialisedHeader blk)
-> Decoder s (Serialised Any) -> Decoder s (SerialisedHeader blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Serialised Any)
forall s. Decoder s (Serialised Any)
forall a s. Serialise a => Decoder s a
decode

{-------------------------------------------------------------------------------
  Reconstruct nested type
-------------------------------------------------------------------------------}

class HasNestedContent f blk => ReconstructNestedCtxt f blk where
  -- | Number of bytes required to reconstruct the nested context.
  --
  -- This will be the /minimum/ length of the 'ShortByteString' passed to
  -- 'reconstructNestedCtxt'.
  reconstructPrefixLen :: proxy (f blk) -> PrefixLen

  -- | Reconstruct the type of nested contents
  --
  -- TODO: Allow to fail.
  reconstructNestedCtxt ::
       proxy (f blk)
    -> ShortByteString  -- ^ First bytes ('reconstructPrefixLen') of the block
    -> SizeInBytes      -- ^ Block size
    -> SomeSecond (NestedCtxt f) blk

  -- Defaults if there is only one type

  default reconstructPrefixLen ::
        TrivialDependency (NestedCtxt_ blk f)
     => proxy (f blk) -> PrefixLen
  reconstructPrefixLen proxy (f blk)
_ = Word8 -> PrefixLen
PrefixLen Word8
0
    where
      ()
_ = Proxy (TrivialDependency (NestedCtxt_ blk f)) -> ()
forall (c :: Constraint) (proxy :: Constraint -> *).
c =>
proxy c -> ()
keepRedundantConstraint (forall {k} (t :: k). Proxy t
forall (t :: Constraint). Proxy t
Proxy @(TrivialDependency (NestedCtxt_ blk f)))

  default reconstructNestedCtxt ::
       TrivialDependency (NestedCtxt_ blk f)
    => proxy (f blk)
    -> ShortByteString  -- ^ First bytes ('reconstructPrefixLen') of the block
    -> SizeInBytes      -- ^ Block size
    -> SomeSecond (NestedCtxt f) blk
  reconstructNestedCtxt proxy (f blk)
_ ShortByteString
_ SizeInBytes
_ = NestedCtxt f blk (TrivialIndex (NestedCtxt_ blk f))
-> SomeSecond (NestedCtxt f) blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond NestedCtxt f blk (TrivialIndex (NestedCtxt f blk))
NestedCtxt f blk (TrivialIndex (NestedCtxt_ blk f))
forall (f :: * -> *). TrivialDependency f => f (TrivialIndex f)
indexIsTrivial

{-------------------------------------------------------------------------------
  Binary block info
-------------------------------------------------------------------------------}

class HasBinaryBlockInfo blk where
  -- | Return information about the serialised block, i.e., how to extract the
  -- bytes corresponding to the header from the serialised block.
  getBinaryBlockInfo :: blk -> BinaryBlockInfo

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

instance EncodeDisk blk (ChainDepState (BlockProtocol blk))
      => EncodeDisk blk (WrapChainDepState blk) where
  encodeDisk :: CodecConfig blk -> WrapChainDepState blk -> Encoding
encodeDisk CodecConfig blk
cfg (WrapChainDepState ChainDepState (BlockProtocol blk)
st) = 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 DecodeDisk blk (ChainDepState (BlockProtocol blk))
      => DecodeDisk blk (WrapChainDepState blk) where
  decodeDisk :: CodecConfig blk -> forall s. Decoder s (WrapChainDepState blk)
decodeDisk CodecConfig blk
cfg = ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
forall blk.
ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
WrapChainDepState (ChainDepState (BlockProtocol blk) -> WrapChainDepState blk)
-> Decoder s (ChainDepState (BlockProtocol blk))
-> Decoder s (WrapChainDepState blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig blk
-> forall s. Decoder s (ChainDepState (BlockProtocol blk))
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig blk
cfg

instance EncodeDisk blk blk
      => EncodeDisk blk (I blk) where
  encodeDisk :: CodecConfig blk -> I blk -> Encoding
encodeDisk CodecConfig blk
cfg (I blk
b) = CodecConfig blk -> blk -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig blk
cfg blk
b

instance DecodeDisk blk blk
      => DecodeDisk blk (I blk) where
  decodeDisk :: CodecConfig blk -> forall s. Decoder s (I blk)
decodeDisk CodecConfig blk
cfg = blk -> I blk
forall a. a -> I a
I (blk -> I blk) -> Decoder s blk -> Decoder s (I blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig blk -> forall s. Decoder s blk
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig blk
cfg

instance DecodeDisk blk (a -> f blk)
      => DecodeDisk blk (((->) a :.: f) blk) where
  decodeDisk :: CodecConfig blk -> forall s. Decoder s ((:.:) ((->) a) f blk)
decodeDisk CodecConfig blk
cfg = (a -> f blk) -> (:.:) ((->) a) f blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp ((a -> f blk) -> (:.:) ((->) a) f blk)
-> Decoder s (a -> f blk) -> Decoder s ((:.:) ((->) a) f blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig blk -> forall s. Decoder s (a -> f blk)
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig blk
cfg