{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Shelley.Node.Serialisation () where

import           Cardano.Binary
import           Cardano.Ledger.BaseTypes
import           Cardano.Ledger.Core (fromEraCBOR, toEraCBOR)
import qualified Cardano.Ledger.Core as SL
import qualified Cardano.Ledger.Shelley.API as SL
import           Cardano.Slotting.EpochInfo (epochInfoSize,
                     epochInfoSlotToRelativeTime, fixedEpochInfo,
                     hoistEpochInfo)
import           Cardano.Slotting.Time
import           Codec.Serialise (decode, encode)
import           Control.Exception (Exception, throw)
import qualified Data.ByteString.Lazy as Lazy
import           Data.Functor.Identity
import           Data.Typeable (Typeable)
import           Data.Word
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.HardFork.Combinator.Abstract.NoHardForks
import           Ouroboros.Consensus.HardFork.Combinator.PartialConfig
import           Ouroboros.Consensus.HardFork.History.EpochInfo
import           Ouroboros.Consensus.HardFork.Simple
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Query
import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId)
import           Ouroboros.Consensus.Node.Run
import           Ouroboros.Consensus.Node.Serialisation
import           Ouroboros.Consensus.Protocol.Praos (PraosState)
import           Ouroboros.Consensus.Protocol.TPraos
import           Ouroboros.Consensus.Shelley.Eras
import           Ouroboros.Consensus.Shelley.Ledger
import           Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion ()
import           Ouroboros.Consensus.Shelley.Protocol.Abstract
                     (pHeaderBlockSize, pHeaderSize)
import           Ouroboros.Consensus.Storage.Serialisation
import           Ouroboros.Network.Block (Serialised, unwrapCBORinCBOR,
                     wrapCBORinCBOR)

{-------------------------------------------------------------------------------
  EncodeDisk & DecodeDisk
-------------------------------------------------------------------------------}

instance ShelleyCompatible proto era => HasBinaryBlockInfo (ShelleyBlock proto era) where
  getBinaryBlockInfo :: ShelleyBlock proto era -> BinaryBlockInfo
getBinaryBlockInfo = ShelleyBlock proto era -> BinaryBlockInfo
forall proto era.
ShelleyCompatible proto era =>
ShelleyBlock proto era -> BinaryBlockInfo
shelleyBinaryBlockInfo

instance ShelleyCompatible proto era => SerialiseDiskConstraints (ShelleyBlock proto era)

instance ShelleyCompatible proto era => EncodeDisk (ShelleyBlock proto era) (ShelleyBlock proto era) where
  encodeDisk :: CodecConfig (ShelleyBlock proto era)
-> ShelleyBlock proto era -> Encoding
encodeDisk CodecConfig (ShelleyBlock proto era)
_ = ShelleyBlock proto era -> Encoding
forall proto era.
ShelleyCompatible proto era =>
ShelleyBlock proto era -> Encoding
encodeShelleyBlock
instance ShelleyCompatible proto era => DecodeDisk (ShelleyBlock proto era) (Lazy.ByteString -> ShelleyBlock proto era) where
  decodeDisk :: CodecConfig (ShelleyBlock proto era)
-> forall s. Decoder s (ByteString -> ShelleyBlock proto era)
decodeDisk CodecConfig (ShelleyBlock proto era)
_ = Decoder s (ByteString -> ShelleyBlock proto era)
forall s. Decoder s (ByteString -> ShelleyBlock proto era)
forall proto era s.
ShelleyCompatible proto era =>
Decoder s (ByteString -> ShelleyBlock proto era)
decodeShelleyBlock

instance ShelleyCompatible proto era => EncodeDisk (ShelleyBlock proto era) (Header (ShelleyBlock proto era)) where
  encodeDisk :: CodecConfig (ShelleyBlock proto era)
-> Header (ShelleyBlock proto era) -> Encoding
encodeDisk CodecConfig (ShelleyBlock proto era)
_ = Header (ShelleyBlock proto era) -> Encoding
forall proto era.
ShelleyCompatible proto era =>
Header (ShelleyBlock proto era) -> Encoding
encodeShelleyHeader
instance ShelleyCompatible proto era => DecodeDisk (ShelleyBlock proto era) (Lazy.ByteString -> Header (ShelleyBlock proto era)) where
  decodeDisk :: CodecConfig (ShelleyBlock proto era)
-> forall s.
   Decoder s (ByteString -> Header (ShelleyBlock proto era))
decodeDisk CodecConfig (ShelleyBlock proto era)
_ = Decoder s (ByteString -> Header (ShelleyBlock proto era))
forall s. Decoder s (ByteString -> Header (ShelleyBlock proto era))
forall proto era s.
ShelleyCompatible proto era =>
Decoder s (ByteString -> Header (ShelleyBlock proto era))
decodeShelleyHeader

instance ShelleyCompatible proto era => EncodeDisk (ShelleyBlock proto era) (LedgerState (ShelleyBlock proto era)) where
  encodeDisk :: CodecConfig (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era) -> Encoding
encodeDisk CodecConfig (ShelleyBlock proto era)
_ = LedgerState (ShelleyBlock proto era) -> Encoding
forall proto era.
ShelleyCompatible proto era =>
LedgerState (ShelleyBlock proto era) -> Encoding
encodeShelleyLedgerState
instance ShelleyCompatible proto era => DecodeDisk (ShelleyBlock proto era) (LedgerState (ShelleyBlock proto era)) where
  decodeDisk :: CodecConfig (ShelleyBlock proto era)
-> forall s. Decoder s (LedgerState (ShelleyBlock proto era))
decodeDisk CodecConfig (ShelleyBlock proto era)
_ = Decoder s (LedgerState (ShelleyBlock proto era))
forall era proto s.
ShelleyCompatible proto era =>
Decoder s (LedgerState (ShelleyBlock proto era))
decodeShelleyLedgerState

-- | @'ChainDepState' ('BlockProtocol' ('ShelleyBlock' era))@
instance ShelleyCompatible proto era => EncodeDisk (ShelleyBlock proto era) TPraosState where
  encodeDisk :: CodecConfig (ShelleyBlock proto era) -> TPraosState -> Encoding
encodeDisk CodecConfig (ShelleyBlock proto era)
_ = TPraosState -> Encoding
forall a. Serialise a => a -> Encoding
encode
-- | @'ChainDepState' ('BlockProtocol' ('ShelleyBlock' era))@
instance ShelleyCompatible proto era => DecodeDisk (ShelleyBlock proto era) TPraosState where
  decodeDisk :: CodecConfig (ShelleyBlock proto era)
-> forall s. Decoder s TPraosState
decodeDisk CodecConfig (ShelleyBlock proto era)
_ = Decoder s TPraosState
forall s. Decoder s TPraosState
forall a s. Serialise a => Decoder s a
decode

instance ShelleyCompatible proto era => EncodeDisk (ShelleyBlock proto era) PraosState where
  encodeDisk :: CodecConfig (ShelleyBlock proto era) -> PraosState -> Encoding
encodeDisk CodecConfig (ShelleyBlock proto era)
_ = PraosState -> Encoding
forall a. Serialise a => a -> Encoding
encode
-- | @'ChainDepState' ('BlockProtocol' ('ShelleyBlock' era))@
instance ShelleyCompatible proto era => DecodeDisk (ShelleyBlock proto era) PraosState where
  decodeDisk :: CodecConfig (ShelleyBlock proto era)
-> forall s. Decoder s PraosState
decodeDisk CodecConfig (ShelleyBlock proto era)
_ = Decoder s PraosState
forall s. Decoder s PraosState
forall a s. Serialise a => Decoder s a
decode
instance ShelleyCompatible proto era
  => EncodeDisk (ShelleyBlock proto era) (AnnTip (ShelleyBlock proto era)) where
  encodeDisk :: CodecConfig (ShelleyBlock proto era)
-> AnnTip (ShelleyBlock proto era) -> Encoding
encodeDisk CodecConfig (ShelleyBlock proto era)
_ = AnnTip (ShelleyBlock proto era) -> Encoding
forall proto era. AnnTip (ShelleyBlock proto era) -> Encoding
encodeShelleyAnnTip
instance ShelleyCompatible proto era
  =>  DecodeDisk (ShelleyBlock proto era) (AnnTip (ShelleyBlock proto era)) where
  decodeDisk :: CodecConfig (ShelleyBlock proto era)
-> forall s. Decoder s (AnnTip (ShelleyBlock proto era))
decodeDisk CodecConfig (ShelleyBlock proto era)
_ = Decoder s (AnnTip (ShelleyBlock proto era))
forall s proto era. Decoder s (AnnTip (ShelleyBlock proto era))
decodeShelleyAnnTip

{-------------------------------------------------------------------------------
  SerialiseNodeToNode
-------------------------------------------------------------------------------}

instance (ShelleyCompatible proto era)
  => SerialiseNodeToNodeConstraints (ShelleyBlock proto era) where
  estimateBlockSize :: Header (ShelleyBlock proto era) -> SizeInBytes
estimateBlockSize Header (ShelleyBlock proto era)
hdr = SizeInBytes
overhead SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
hdrSize SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
bodySize
    where
      -- The maximum block size is 65536, the CBOR-in-CBOR tag for this block
      -- is:
      --
      -- > D8 18          # tag(24)
      -- >    1A 00010000 # bytes(65536)
      --
      -- Which is 7 bytes, enough for up to 4294967295 bytes.
      overhead :: SizeInBytes
overhead = SizeInBytes
7 {- CBOR-in-CBOR -} SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
1 {- encodeListLen -}
      bodySize :: SizeInBytes
bodySize = Natural -> SizeInBytes
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> SizeInBytes)
-> (Header (ShelleyBlock proto era) -> Natural)
-> Header (ShelleyBlock proto era)
-> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyProtocolHeader proto -> Natural
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto -> Natural
pHeaderBlockSize (ShelleyProtocolHeader proto -> Natural)
-> (Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto)
-> Header (ShelleyBlock proto era)
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw (Header (ShelleyBlock proto era) -> SizeInBytes)
-> Header (ShelleyBlock proto era) -> SizeInBytes
forall a b. (a -> b) -> a -> b
$ Header (ShelleyBlock proto era)
hdr
      hdrSize :: SizeInBytes
hdrSize  = Natural -> SizeInBytes
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> SizeInBytes)
-> (Header (ShelleyBlock proto era) -> Natural)
-> Header (ShelleyBlock proto era)
-> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyProtocolHeader proto -> Natural
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto -> Natural
pHeaderSize (ShelleyProtocolHeader proto -> Natural)
-> (Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto)
-> Header (ShelleyBlock proto era)
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw (Header (ShelleyBlock proto era) -> SizeInBytes)
-> Header (ShelleyBlock proto era) -> SizeInBytes
forall a b. (a -> b) -> a -> b
$ Header (ShelleyBlock proto era)
hdr

-- | CBOR-in-CBOR for the annotation. This also makes it compatible with the
-- wrapped ('Serialised') variant.
instance ShelleyCompatible proto era
  => SerialiseNodeToNode (ShelleyBlock proto era) (ShelleyBlock proto era) where
  encodeNodeToNode :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToNodeVersion (ShelleyBlock proto era)
-> ShelleyBlock proto era
-> Encoding
encodeNodeToNode CodecConfig (ShelleyBlock proto era)
_ BlockNodeToNodeVersion (ShelleyBlock proto era)
_ = (ShelleyBlock proto era -> Encoding)
-> ShelleyBlock proto era -> Encoding
forall a. (a -> Encoding) -> a -> Encoding
wrapCBORinCBOR   ShelleyBlock proto era -> Encoding
forall proto era.
ShelleyCompatible proto era =>
ShelleyBlock proto era -> Encoding
encodeShelleyBlock
  decodeNodeToNode :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToNodeVersion (ShelleyBlock proto era)
-> forall s. Decoder s (ShelleyBlock proto era)
decodeNodeToNode CodecConfig (ShelleyBlock proto era)
_ BlockNodeToNodeVersion (ShelleyBlock proto era)
_ = (forall s. Decoder s (ByteString -> ShelleyBlock proto era))
-> forall s. Decoder s (ShelleyBlock proto era)
forall a.
(forall s. Decoder s (ByteString -> a)) -> forall s. Decoder s a
unwrapCBORinCBOR Decoder s (ByteString -> ShelleyBlock proto era)
forall s. Decoder s (ByteString -> ShelleyBlock proto era)
forall proto era s.
ShelleyCompatible proto era =>
Decoder s (ByteString -> ShelleyBlock proto era)
decodeShelleyBlock

-- | 'Serialised' uses CBOR-in-CBOR by default.
instance SerialiseNodeToNode (ShelleyBlock proto era) (Serialised (ShelleyBlock proto era))
  -- Default instance

-- | CBOR-in-CBOR to be compatible with the wrapped ('Serialised') variant.
instance ShelleyCompatible proto era
  => SerialiseNodeToNode (ShelleyBlock proto era) (Header (ShelleyBlock proto era)) where
  encodeNodeToNode :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToNodeVersion (ShelleyBlock proto era)
-> Header (ShelleyBlock proto era)
-> Encoding
encodeNodeToNode CodecConfig (ShelleyBlock proto era)
_ BlockNodeToNodeVersion (ShelleyBlock proto era)
_ = (Header (ShelleyBlock proto era) -> Encoding)
-> Header (ShelleyBlock proto era) -> Encoding
forall a. (a -> Encoding) -> a -> Encoding
wrapCBORinCBOR   Header (ShelleyBlock proto era) -> Encoding
forall proto era.
ShelleyCompatible proto era =>
Header (ShelleyBlock proto era) -> Encoding
encodeShelleyHeader
  decodeNodeToNode :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToNodeVersion (ShelleyBlock proto era)
-> forall s. Decoder s (Header (ShelleyBlock proto era))
decodeNodeToNode CodecConfig (ShelleyBlock proto era)
_ BlockNodeToNodeVersion (ShelleyBlock proto era)
_ = (forall s.
 Decoder s (ByteString -> Header (ShelleyBlock proto era)))
-> forall s. Decoder s (Header (ShelleyBlock proto era))
forall a.
(forall s. Decoder s (ByteString -> a)) -> forall s. Decoder s a
unwrapCBORinCBOR Decoder s (ByteString -> Header (ShelleyBlock proto era))
forall s. Decoder s (ByteString -> Header (ShelleyBlock proto era))
forall proto era s.
ShelleyCompatible proto era =>
Decoder s (ByteString -> Header (ShelleyBlock proto era))
decodeShelleyHeader

-- | We use CBOR-in-CBOR
instance SerialiseNodeToNode (ShelleyBlock proto era) (SerialisedHeader (ShelleyBlock proto era)) where
  encodeNodeToNode :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToNodeVersion (ShelleyBlock proto era)
-> SerialisedHeader (ShelleyBlock proto era)
-> Encoding
encodeNodeToNode CodecConfig (ShelleyBlock proto era)
_ BlockNodeToNodeVersion (ShelleyBlock proto era)
_ = SerialisedHeader (ShelleyBlock proto era) -> Encoding
forall blk.
TrivialDependency (NestedCtxt_ blk Header) =>
SerialisedHeader blk -> Encoding
encodeTrivialSerialisedHeader
  decodeNodeToNode :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToNodeVersion (ShelleyBlock proto era)
-> forall s. Decoder s (SerialisedHeader (ShelleyBlock proto era))
decodeNodeToNode CodecConfig (ShelleyBlock proto era)
_ BlockNodeToNodeVersion (ShelleyBlock proto era)
_ = Decoder s (SerialisedHeader (ShelleyBlock proto era))
forall s. Decoder s (SerialisedHeader (ShelleyBlock proto era))
forall blk s.
TrivialDependency (NestedCtxt_ blk Header) =>
Decoder s (SerialisedHeader blk)
decodeTrivialSerialisedHeader

-- | The @To/FromCBOR@ instances defined in @cardano-ledger@ use
-- CBOR-in-CBOR to get the annotation.
instance ShelleyCompatible proto era
  => SerialiseNodeToNode (ShelleyBlock proto era) (GenTx (ShelleyBlock proto era)) where
  encodeNodeToNode :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToNodeVersion (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Encoding
encodeNodeToNode CodecConfig (ShelleyBlock proto era)
_ BlockNodeToNodeVersion (ShelleyBlock proto era)
_ = GenTx (ShelleyBlock proto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  decodeNodeToNode :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToNodeVersion (ShelleyBlock proto era)
-> forall s. Decoder s (GenTx (ShelleyBlock proto era))
decodeNodeToNode CodecConfig (ShelleyBlock proto era)
_ BlockNodeToNodeVersion (ShelleyBlock proto era)
_ = Decoder s (GenTx (ShelleyBlock proto era))
forall s. Decoder s (GenTx (ShelleyBlock proto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance (ShelleyCompatible proto era)
  => SerialiseNodeToNode (ShelleyBlock proto era) (GenTxId (ShelleyBlock proto era)) where
  encodeNodeToNode :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToNodeVersion (ShelleyBlock proto era)
-> GenTxId (ShelleyBlock proto era)
-> Encoding
encodeNodeToNode CodecConfig (ShelleyBlock proto era)
_ BlockNodeToNodeVersion (ShelleyBlock proto era)
_ = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era
  decodeNodeToNode :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToNodeVersion (ShelleyBlock proto era)
-> forall s. Decoder s (GenTxId (ShelleyBlock proto era))
decodeNodeToNode CodecConfig (ShelleyBlock proto era)
_ BlockNodeToNodeVersion (ShelleyBlock proto era)
_ = forall era t s. (Era era, DecCBOR t) => Decoder s t
fromEraCBOR @era

{-------------------------------------------------------------------------------
  SerialiseNodeToClient
-------------------------------------------------------------------------------}

-- | Exception thrown in the encoders
data ShelleyEncoderException era proto =
    -- | A query was submitted that is not supported by the given
    -- 'ShelleyNodeToClientVersion'.
    ShelleyEncoderUnsupportedQuery
         (SomeSecond BlockQuery (ShelleyBlock proto era))
         ShelleyNodeToClientVersion
  deriving (Int -> ShelleyEncoderException era proto -> ShowS
[ShelleyEncoderException era proto] -> ShowS
ShelleyEncoderException era proto -> String
(Int -> ShelleyEncoderException era proto -> ShowS)
-> (ShelleyEncoderException era proto -> String)
-> ([ShelleyEncoderException era proto] -> ShowS)
-> Show (ShelleyEncoderException era proto)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall era proto. Int -> ShelleyEncoderException era proto -> ShowS
forall era proto. [ShelleyEncoderException era proto] -> ShowS
forall era proto. ShelleyEncoderException era proto -> String
$cshowsPrec :: forall era proto. Int -> ShelleyEncoderException era proto -> ShowS
showsPrec :: Int -> ShelleyEncoderException era proto -> ShowS
$cshow :: forall era proto. ShelleyEncoderException era proto -> String
show :: ShelleyEncoderException era proto -> String
$cshowList :: forall era proto. [ShelleyEncoderException era proto] -> ShowS
showList :: [ShelleyEncoderException era proto] -> ShowS
Show)

instance (Typeable era, Typeable proto)
  => Exception (ShelleyEncoderException era proto)

instance (NoHardForks (ShelleyBlock proto era), ShelleyCompatible proto era)
  => SerialiseNodeToClientConstraints (ShelleyBlock proto era)

-- | CBOR-in-CBOR for the annotation. This also makes it compatible with the
-- wrapped ('Serialised') variant.
instance ShelleyCompatible proto era
  => SerialiseNodeToClient (ShelleyBlock proto era) (ShelleyBlock proto era) where
  encodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> ShelleyBlock proto era
-> Encoding
encodeNodeToClient CodecConfig (ShelleyBlock proto era)
_ BlockNodeToClientVersion (ShelleyBlock proto era)
_ = (ShelleyBlock proto era -> Encoding)
-> ShelleyBlock proto era -> Encoding
forall a. (a -> Encoding) -> a -> Encoding
wrapCBORinCBOR   ShelleyBlock proto era -> Encoding
forall proto era.
ShelleyCompatible proto era =>
ShelleyBlock proto era -> Encoding
encodeShelleyBlock
  decodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> forall s. Decoder s (ShelleyBlock proto era)
decodeNodeToClient CodecConfig (ShelleyBlock proto era)
_ BlockNodeToClientVersion (ShelleyBlock proto era)
_ = (forall s. Decoder s (ByteString -> ShelleyBlock proto era))
-> forall s. Decoder s (ShelleyBlock proto era)
forall a.
(forall s. Decoder s (ByteString -> a)) -> forall s. Decoder s a
unwrapCBORinCBOR Decoder s (ByteString -> ShelleyBlock proto era)
forall s. Decoder s (ByteString -> ShelleyBlock proto era)
forall proto era s.
ShelleyCompatible proto era =>
Decoder s (ByteString -> ShelleyBlock proto era)
decodeShelleyBlock

-- | This instance uses the invariant that the 'EpochInfo' in a
-- 'ShelleyLedgerConfig' is fixed i.e. has a constant 'EpochSize' and
-- 'SlotLength'. This is not true in the case of the HFC in a
-- 'ShelleyPartialLedgerConfig', but that is handled correctly in the respective
-- 'SerialiseNodeToClient' instance for 'ShelleyPartialLedgerConfig'.
instance (NoHardForks (ShelleyBlock proto era), ShelleyCompatible proto era)
      => SerialiseNodeToClient (ShelleyBlock proto era) (ShelleyLedgerConfig era) where
  decodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> forall s. Decoder s (ShelleyLedgerConfig era)
decodeNodeToClient CodecConfig (ShelleyBlock proto era)
ccfg BlockNodeToClientVersion (ShelleyBlock proto era)
version = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ShelleyLedgerConfig" Int
3
    ShelleyPartialLedgerConfig era
partialConfig <- forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient
      @_
      @(ShelleyPartialLedgerConfig era)
      CodecConfig (ShelleyBlock proto era)
ccfg
      BlockNodeToClientVersion (ShelleyBlock proto era)
version
    EpochSize
epochSize     <- forall a s. FromCBOR a => Decoder s a
fromCBOR @EpochSize
    SlotLength
slotLength    <- forall a s. Serialise a => Decoder s a
decode @SlotLength
    ShelleyLedgerConfig era -> Decoder s (ShelleyLedgerConfig era)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShelleyLedgerConfig era -> Decoder s (ShelleyLedgerConfig era))
-> ShelleyLedgerConfig era -> Decoder s (ShelleyLedgerConfig era)
forall a b. (a -> b) -> a -> b
$ Proxy (ShelleyBlock proto era)
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig (ShelleyBlock proto era)
-> LedgerConfig (ShelleyBlock proto era)
forall blk (proxy :: * -> *).
HasPartialLedgerConfig blk =>
proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerConfig blk
forall (proxy :: * -> *).
proxy (ShelleyBlock proto era)
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig (ShelleyBlock proto era)
-> LedgerConfig (ShelleyBlock proto era)
completeLedgerConfig
      (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ShelleyBlock proto era))
      (EpochSize -> SlotLength -> EpochInfo (Except PastHorizonException)
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo EpochSize
epochSize SlotLength
slotLength)
      PartialLedgerConfig (ShelleyBlock proto era)
ShelleyPartialLedgerConfig era
partialConfig

  encodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> ShelleyLedgerConfig era
-> Encoding
encodeNodeToClient CodecConfig (ShelleyBlock proto era)
ccfg BlockNodeToClientVersion (ShelleyBlock proto era)
version ShelleyLedgerConfig era
ledgerConfig = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      Word -> Encoding
encodeListLen Word
3
    , forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient
        @_
        @(ShelleyPartialLedgerConfig era)
        CodecConfig (ShelleyBlock proto era)
ccfg
        BlockNodeToClientVersion (ShelleyBlock proto era)
version
        (Proxy (ShelleyBlock proto era)
-> LedgerConfig (ShelleyBlock proto era)
-> PartialLedgerConfig (ShelleyBlock proto era)
forall blk (proxy :: * -> *).
NoHardForks blk =>
proxy blk -> LedgerConfig blk -> PartialLedgerConfig blk
forall (proxy :: * -> *).
proxy (ShelleyBlock proto era)
-> LedgerConfig (ShelleyBlock proto era)
-> PartialLedgerConfig (ShelleyBlock proto era)
toPartialLedgerConfig (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ShelleyBlock proto era)) LedgerConfig (ShelleyBlock proto era)
ShelleyLedgerConfig era
ledgerConfig)
    , forall a. ToCBOR a => a -> Encoding
toCBOR @EpochSize EpochSize
epochSize
    , forall a. Serialise a => a -> Encoding
encode @SlotLength SlotLength
slotLength
    ]
    where
      unwrap :: Either a c -> c
unwrap          = (a -> c) -> (c -> c) -> Either a c -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                        (String -> a -> c
forall a. HasCallStack => String -> a
error String
"ShelleyLedgerConfig contains a non-fixed EpochInfo")
                        c -> c
forall a. a -> a
id
      ei :: EpochInfo (Either Text)
ei              = Globals -> EpochInfo (Either Text)
epochInfo (ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals ShelleyLedgerConfig era
ledgerConfig)
      epochSize :: EpochSize
epochSize       = Either Text EpochSize -> EpochSize
forall {a} {c}. Either a c -> c
unwrap (Either Text EpochSize -> EpochSize)
-> Either Text EpochSize -> EpochSize
forall a b. (a -> b) -> a -> b
$ EpochInfo (Either Text) -> EpochNo -> Either Text EpochSize
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m EpochSize
epochInfoSize EpochInfo (Either Text)
ei (Word64 -> EpochNo
EpochNo Word64
0)
      RelativeTime NominalDiffTime
t1 = Either Text RelativeTime -> RelativeTime
forall {a} {c}. Either a c -> c
unwrap (Either Text RelativeTime -> RelativeTime)
-> Either Text RelativeTime -> RelativeTime
forall a b. (a -> b) -> a -> b
$ EpochInfo (Either Text) -> SlotNo -> Either Text RelativeTime
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime EpochInfo (Either Text)
ei SlotNo
1
      slotLength :: SlotLength
slotLength      = NominalDiffTime -> SlotLength
mkSlotLength NominalDiffTime
t1

-- | This instance uses the invariant that the 'EpochInfo' in a
-- 'ShelleyPartialLedgerConfig' is always just a dummy value.
instance ShelleyBasedEra era
      => SerialiseNodeToClient (ShelleyBlock proto era) (ShelleyPartialLedgerConfig era) where
  decodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> forall s. Decoder s (ShelleyPartialLedgerConfig era)
decodeNodeToClient CodecConfig (ShelleyBlock proto era)
ccfg BlockNodeToClientVersion (ShelleyBlock proto era)
version = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ShelleyPartialLedgerConfig era" Int
13
    ShelleyLedgerConfig era
-> TriggerHardFork -> ShelleyPartialLedgerConfig era
forall era.
ShelleyLedgerConfig era
-> TriggerHardFork -> ShelleyPartialLedgerConfig era
ShelleyPartialLedgerConfig
      (ShelleyLedgerConfig era
 -> TriggerHardFork -> ShelleyPartialLedgerConfig era)
-> Decoder s (ShelleyLedgerConfig era)
-> Decoder s (TriggerHardFork -> ShelleyPartialLedgerConfig era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( CompactGenesis
-> Globals -> TranslationContext era -> ShelleyLedgerConfig era
forall era.
CompactGenesis
-> Globals -> TranslationContext era -> ShelleyLedgerConfig era
ShelleyLedgerConfig
        (CompactGenesis
 -> Globals -> TranslationContext era -> ShelleyLedgerConfig era)
-> Decoder s CompactGenesis
-> Decoder
     s (Globals -> TranslationContext era -> ShelleyLedgerConfig era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. FromCBOR a => Decoder s a
fromCBOR @CompactGenesis
        Decoder
  s (Globals -> TranslationContext era -> ShelleyLedgerConfig era)
-> Decoder s Globals
-> Decoder s (TranslationContext era -> ShelleyLedgerConfig era)
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
<*> (EpochInfo (Either Text)
-> Word64
-> Word64
-> Word64
-> NonZero Word64
-> Word64
-> Word64
-> Word64
-> ActiveSlotCoeff
-> Network
-> SystemStart
-> Globals
SL.Globals
              ((forall a. Identity a -> Either Text a)
-> EpochInfo Identity -> EpochInfo (Either Text)
forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> EpochInfo m -> EpochInfo n
hoistEpochInfo (a -> Either Text a
forall a b. b -> Either a b
Right (a -> Either Text a)
-> (Identity a -> a) -> Identity a -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity) (EpochInfo Identity -> EpochInfo (Either Text))
-> EpochInfo Identity -> EpochInfo (Either Text)
forall a b. (a -> b) -> a -> b
$ EpochInfo (Except PastHorizonException) -> EpochInfo Identity
toPureEpochInfo EpochInfo (Except PastHorizonException)
dummyEpochInfo)
              (Word64
 -> Word64
 -> Word64
 -> NonZero Word64
 -> Word64
 -> Word64
 -> Word64
 -> ActiveSlotCoeff
 -> Network
 -> SystemStart
 -> Globals)
-> Decoder s Word64
-> Decoder
     s
     (Word64
      -> Word64
      -> NonZero Word64
      -> Word64
      -> Word64
      -> Word64
      -> ActiveSlotCoeff
      -> Network
      -> SystemStart
      -> Globals)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. FromCBOR a => Decoder s a
fromCBOR @Word64
              Decoder
  s
  (Word64
   -> Word64
   -> NonZero Word64
   -> Word64
   -> Word64
   -> Word64
   -> ActiveSlotCoeff
   -> Network
   -> SystemStart
   -> Globals)
-> Decoder s Word64
-> Decoder
     s
     (Word64
      -> NonZero Word64
      -> Word64
      -> Word64
      -> Word64
      -> ActiveSlotCoeff
      -> Network
      -> SystemStart
      -> Globals)
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 a s. FromCBOR a => Decoder s a
fromCBOR @Word64
              Decoder
  s
  (Word64
   -> NonZero Word64
   -> Word64
   -> Word64
   -> Word64
   -> ActiveSlotCoeff
   -> Network
   -> SystemStart
   -> Globals)
-> Decoder s Word64
-> Decoder
     s
     (NonZero Word64
      -> Word64
      -> Word64
      -> Word64
      -> ActiveSlotCoeff
      -> Network
      -> SystemStart
      -> Globals)
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 a s. FromCBOR a => Decoder s a
fromCBOR @Word64
              Decoder
  s
  (NonZero Word64
   -> Word64
   -> Word64
   -> Word64
   -> ActiveSlotCoeff
   -> Network
   -> SystemStart
   -> Globals)
-> Decoder s (NonZero Word64)
-> Decoder
     s
     (Word64
      -> Word64
      -> Word64
      -> ActiveSlotCoeff
      -> Network
      -> SystemStart
      -> Globals)
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 a s. FromCBOR a => Decoder s a
fromCBOR @(NonZero Word64)
              Decoder
  s
  (Word64
   -> Word64
   -> Word64
   -> ActiveSlotCoeff
   -> Network
   -> SystemStart
   -> Globals)
-> Decoder s Word64
-> Decoder
     s
     (Word64
      -> Word64 -> ActiveSlotCoeff -> Network -> SystemStart -> Globals)
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 a s. FromCBOR a => Decoder s a
fromCBOR @Word64
              Decoder
  s
  (Word64
   -> Word64 -> ActiveSlotCoeff -> Network -> SystemStart -> Globals)
-> Decoder s Word64
-> Decoder
     s (Word64 -> ActiveSlotCoeff -> Network -> SystemStart -> Globals)
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 a s. FromCBOR a => Decoder s a
fromCBOR @Word64
              Decoder
  s (Word64 -> ActiveSlotCoeff -> Network -> SystemStart -> Globals)
-> Decoder s Word64
-> Decoder s (ActiveSlotCoeff -> Network -> SystemStart -> Globals)
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 a s. FromCBOR a => Decoder s a
fromCBOR @Word64
              Decoder s (ActiveSlotCoeff -> Network -> SystemStart -> Globals)
-> Decoder s ActiveSlotCoeff
-> Decoder s (Network -> SystemStart -> Globals)
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 a s. FromCBOR a => Decoder s a
fromCBOR @ActiveSlotCoeff
              Decoder s (Network -> SystemStart -> Globals)
-> Decoder s Network -> Decoder s (SystemStart -> Globals)
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 a s. FromCBOR a => Decoder s a
fromCBOR @SL.Network
              Decoder s (SystemStart -> Globals)
-> Decoder s SystemStart -> Decoder s Globals
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 a s. FromCBOR a => Decoder s a
fromCBOR @SystemStart
            )
        Decoder s (TranslationContext era -> ShelleyLedgerConfig era)
-> Decoder s (TranslationContext era)
-> Decoder s (ShelleyLedgerConfig era)
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 a s. FromCBOR a => Decoder s a
fromCBOR @(SL.TranslationContext era)
      )
      Decoder s (TriggerHardFork -> ShelleyPartialLedgerConfig era)
-> Decoder s TriggerHardFork
-> Decoder s (ShelleyPartialLedgerConfig era)
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 @(ShelleyBlock proto era) @TriggerHardFork CodecConfig (ShelleyBlock proto era)
ccfg BlockNodeToClientVersion (ShelleyBlock proto era)
version

  encodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> ShelleyPartialLedgerConfig era
-> Encoding
encodeNodeToClient CodecConfig (ShelleyBlock proto era)
ccfg BlockNodeToClientVersion (ShelleyBlock proto era)
version
    (ShelleyPartialLedgerConfig
      (ShelleyLedgerConfig
        CompactGenesis
myCompactGenesis
        (SL.Globals
          EpochInfo (Either Text)
_epochInfo
          Word64
slotsPerKESPeriod'
          Word64
stabilityWindow'
          Word64
randomnessStabilisationWindow'
          NonZero Word64
securityParameter'
          Word64
maxKESEvo'
          Word64
quorum'
          Word64
maxLovelaceSupply'
          ActiveSlotCoeff
activeSlotCoeff'
          Network
networkId'
          SystemStart
systemStart'
        )
        TranslationContext era
translationContext
      )
      TriggerHardFork
triggerHardFork
    )
      = Word -> Encoding
encodeListLen Word
13
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR @CompactGenesis CompactGenesis
myCompactGenesis
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR @Word64 Word64
slotsPerKESPeriod'
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR @Word64 Word64
stabilityWindow'
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR @Word64 Word64
randomnessStabilisationWindow'
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR @(NonZero Word64) NonZero Word64
securityParameter'
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR @Word64 Word64
maxKESEvo'
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR @Word64 Word64
quorum'
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR @Word64 Word64
maxLovelaceSupply'
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR @ActiveSlotCoeff ActiveSlotCoeff
activeSlotCoeff'
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR @SL.Network Network
networkId'
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR @SystemStart SystemStart
systemStart'
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR @(SL.TranslationContext era) TranslationContext era
translationContext
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient @(ShelleyBlock proto era) @TriggerHardFork CodecConfig (ShelleyBlock proto era)
ccfg BlockNodeToClientVersion (ShelleyBlock proto era)
version TriggerHardFork
triggerHardFork

-- | 'Serialised' uses CBOR-in-CBOR by default.
instance SerialiseNodeToClient (ShelleyBlock proto era) (Serialised (ShelleyBlock proto era))
  -- Default instance

-- | Uses CBOR-in-CBOR in the @To/FromCBOR@ instances to get the annotation.
instance ShelleyCompatible proto era
  => SerialiseNodeToClient (ShelleyBlock proto era) (GenTx (ShelleyBlock proto era)) where
  encodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Encoding
encodeNodeToClient CodecConfig (ShelleyBlock proto era)
_ BlockNodeToClientVersion (ShelleyBlock proto era)
_ = GenTx (ShelleyBlock proto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  decodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> forall s. Decoder s (GenTx (ShelleyBlock proto era))
decodeNodeToClient CodecConfig (ShelleyBlock proto era)
_ BlockNodeToClientVersion (ShelleyBlock proto era)
_ = Decoder s (GenTx (ShelleyBlock proto era))
forall s. Decoder s (GenTx (ShelleyBlock proto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance (ShelleyCompatible proto era)
  => SerialiseNodeToClient (ShelleyBlock proto era) (GenTxId (ShelleyBlock proto era)) where
  encodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> GenTxId (ShelleyBlock proto era)
-> Encoding
encodeNodeToClient CodecConfig (ShelleyBlock proto era)
_ BlockNodeToClientVersion (ShelleyBlock proto era)
_ = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era
  decodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> forall s. Decoder s (GenTxId (ShelleyBlock proto era))
decodeNodeToClient CodecConfig (ShelleyBlock proto era)
_ BlockNodeToClientVersion (ShelleyBlock proto era)
_ = forall era t s. (Era era, DecCBOR t) => Decoder s t
fromEraCBOR @era

-- | @'ApplyTxErr' '(ShelleyBlock era)'@
instance ShelleyBasedEra era => SerialiseNodeToClient (ShelleyBlock proto era) (SL.ApplyTxError era) where
  encodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> ApplyTxError era
-> Encoding
encodeNodeToClient CodecConfig (ShelleyBlock proto era)
_ BlockNodeToClientVersion (ShelleyBlock proto era)
_ = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era
  decodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> forall s. Decoder s (ApplyTxError era)
decodeNodeToClient CodecConfig (ShelleyBlock proto era)
_ BlockNodeToClientVersion (ShelleyBlock proto era)
_ = forall era t s. (Era era, DecCBOR t) => Decoder s t
fromEraCBOR @era

instance ShelleyCompatible proto era
      => SerialiseNodeToClient (ShelleyBlock proto era) (SomeSecond BlockQuery (ShelleyBlock proto era)) where
  encodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Encoding
encodeNodeToClient CodecConfig (ShelleyBlock proto era)
_ BlockNodeToClientVersion (ShelleyBlock proto era)
version (SomeSecond BlockQuery (ShelleyBlock proto era) b
q)
    | BlockQuery (ShelleyBlock proto era) b
-> BlockNodeToClientVersion (ShelleyBlock proto era) -> Bool
forall blk result.
BlockSupportsLedgerQuery blk =>
BlockQuery blk result -> BlockNodeToClientVersion blk -> Bool
forall result.
BlockQuery (ShelleyBlock proto era) result
-> BlockNodeToClientVersion (ShelleyBlock proto era) -> Bool
blockQueryIsSupportedOnVersion BlockQuery (ShelleyBlock proto era) b
q BlockNodeToClientVersion (ShelleyBlock proto era)
version
    = BlockQuery (ShelleyBlock proto era) b -> Encoding
forall era proto result.
ShelleyBasedEra era =>
BlockQuery (ShelleyBlock proto era) result -> Encoding
encodeShelleyQuery BlockQuery (ShelleyBlock proto era) b
q
    | Bool
otherwise
    = ShelleyEncoderException era proto -> Encoding
forall a e. Exception e => e -> a
throw (ShelleyEncoderException era proto -> Encoding)
-> ShelleyEncoderException era proto -> Encoding
forall a b. (a -> b) -> a -> b
$ SomeSecond BlockQuery (ShelleyBlock proto era)
-> ShelleyNodeToClientVersion -> ShelleyEncoderException era proto
forall era proto.
SomeSecond BlockQuery (ShelleyBlock proto era)
-> ShelleyNodeToClientVersion -> ShelleyEncoderException era proto
ShelleyEncoderUnsupportedQuery (BlockQuery (ShelleyBlock proto era) b
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) b
q) BlockNodeToClientVersion (ShelleyBlock proto era)
ShelleyNodeToClientVersion
version
  decodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> forall s.
   Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
decodeNodeToClient CodecConfig (ShelleyBlock proto era)
_ BlockNodeToClientVersion (ShelleyBlock proto era)
_ = Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall s.
Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall era proto s.
ShelleyBasedEra era =>
Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
decodeShelleyQuery

instance
  (ShelleyCompatible proto era) =>
  SerialiseResult (ShelleyBlock proto era) (BlockQuery (ShelleyBlock proto era)) where
  encodeResult :: forall result.
CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) result
-> result
-> Encoding
encodeResult CodecConfig (ShelleyBlock proto era)
_ = BlockNodeToClientVersion (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) result -> result -> Encoding
ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) result -> result -> Encoding
forall proto era result.
ShelleyCompatible proto era =>
ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) result -> result -> Encoding
encodeShelleyResult
  decodeResult :: forall result.
CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) result
-> forall s. Decoder s result
decodeResult CodecConfig (ShelleyBlock proto era)
_ = BlockNodeToClientVersion (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) result -> Decoder s result
ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) result
-> forall s. Decoder s result
forall proto era result.
ShelleyCompatible proto era =>
ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) result
-> forall s. Decoder s result
decodeShelleyResult

instance ShelleyCompatible proto era  => SerialiseNodeToClient (ShelleyBlock proto era) SlotNo where
  encodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> SlotNo
-> Encoding
encodeNodeToClient CodecConfig (ShelleyBlock proto era)
_ BlockNodeToClientVersion (ShelleyBlock proto era)
_ = SlotNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  decodeNodeToClient :: CodecConfig (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlock proto era)
-> forall s. Decoder s SlotNo
decodeNodeToClient CodecConfig (ShelleyBlock proto era)
_ BlockNodeToClientVersion (ShelleyBlock proto era)
_ = Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. FromCBOR a => Decoder s a
fromCBOR

{-------------------------------------------------------------------------------
  HFC support

  Since 'NestedCtxt' for Shelley is trivial, these instances can use defaults.
-------------------------------------------------------------------------------}

instance ShelleyBasedEra era => ReconstructNestedCtxt Header (ShelleyBlock proto era)
instance ShelleyBasedEra era => EncodeDiskDepIx (NestedCtxt Header) (ShelleyBlock proto era)
instance ShelleyCompatible proto era => EncodeDiskDep   (NestedCtxt Header) (ShelleyBlock proto era)
instance ShelleyBasedEra era => DecodeDiskDepIx (NestedCtxt Header) (ShelleyBlock proto era)
instance ShelleyCompatible proto era => DecodeDiskDep   (NestedCtxt Header) (ShelleyBlock proto era)