{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Serialisation for sending things across the network.
--
-- We separate @NodeToNode@ from @NodeToClient@ to be very explicit about what
-- gets sent where.
--
-- Unlike in "Ouroboros.Consensus.Storage.Serialisation", we don't separate the
-- encoder from the decoder, because the reasons don't apply: we always need
-- both directions and we don't have access to the bytestrings that could be
-- used for the annotations (we use CBOR-in-CBOR in those cases).
module Ouroboros.Consensus.Node.Serialisation
  ( SerialiseBlockQueryResult (..)
  , SerialiseNodeToClient (..)
  , SerialiseNodeToNode (..)
  , SerialiseResult (..)

    -- * Defaults
  , defaultDecodeCBORinCBOR
  , defaultEncodeCBORinCBOR

    -- * Re-exported for convenience
  , Some (..)
  ) where

import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import Codec.CBOR.Decoding (Decoder, decodeListLenOf)
import Codec.CBOR.Encoding (Encoding, encodeListLen)
import Codec.Serialise (Serialise (decode, encode))
import Data.Kind
import Data.SOP.BasicFunctors
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.SupportsMempool
  ( ApplyTxErr
  , GenTxId
  )
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.TypeFamilyWrappers
import Ouroboros.Consensus.Util (Some (..))
import Ouroboros.Network.Block
  ( Tip
  , decodePoint
  , decodeTip
  , encodePoint
  , encodeTip
  , unwrapCBORinCBOR
  , wrapCBORinCBOR
  )

{-------------------------------------------------------------------------------
  NodeToNode
-------------------------------------------------------------------------------}

-- | Serialise a type @a@ so that it can be sent across network via a
-- node-to-node protocol.
class SerialiseNodeToNode blk a where
  encodeNodeToNode :: CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
  decodeNodeToNode :: CodecConfig blk -> BlockNodeToNodeVersion blk -> forall s. Decoder s a

  -- When the config is not needed, we provide a default, unversioned
  -- implementation using 'Serialise'

  default encodeNodeToNode ::
    Serialise a =>
    CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
  encodeNodeToNode CodecConfig blk
_ccfg BlockNodeToNodeVersion blk
_version = a -> Encoding
forall a. Serialise a => a -> Encoding
encode

  default decodeNodeToNode ::
    Serialise a =>
    CodecConfig blk -> BlockNodeToNodeVersion blk -> forall s. Decoder s a
  decodeNodeToNode CodecConfig blk
_ccfg BlockNodeToNodeVersion blk
_version = Decoder s a
forall s. Decoder s a
forall a s. Serialise a => Decoder s a
decode

{-------------------------------------------------------------------------------
  NodeToClient
-------------------------------------------------------------------------------}

-- | Serialise a type @a@ so that it can be sent across the network via
-- node-to-client protocol.
class SerialiseNodeToClient blk a where
  encodeNodeToClient :: CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
  decodeNodeToClient :: CodecConfig blk -> BlockNodeToClientVersion blk -> forall s. Decoder s a

  -- When the config is not needed, we provide a default, unversioned
  -- implementation using 'Serialise'

  default encodeNodeToClient ::
    Serialise a =>
    CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
  encodeNodeToClient CodecConfig blk
_ccfg BlockNodeToClientVersion blk
_version = a -> Encoding
forall a. Serialise a => a -> Encoding
encode

  default decodeNodeToClient ::
    Serialise a =>
    CodecConfig blk -> BlockNodeToClientVersion blk -> forall s. Decoder s a
  decodeNodeToClient CodecConfig blk
_ccfg BlockNodeToClientVersion blk
_version = Decoder s a
forall s. Decoder s a
forall a s. Serialise a => Decoder s a
decode

{-------------------------------------------------------------------------------
  NodeToClient - SerialiseResult
-------------------------------------------------------------------------------}

-- | How to serialise the @result@ of a query.
--
-- The @LocalStateQuery@ protocol is a node-to-client protocol, hence the
-- 'NodeToClientVersion' argument.
type SerialiseResult :: Type -> (Type -> Type -> Type) -> Constraint
class SerialiseResult blk query where
  encodeResult ::
    forall result.
    CodecConfig blk ->
    BlockNodeToClientVersion blk ->
    query blk result ->
    result ->
    Encoding
  decodeResult ::
    forall result.
    CodecConfig blk ->
    BlockNodeToClientVersion blk ->
    query blk result ->
    forall s.
    Decoder s result

-- | How to serialise the @result@ of a block query.
--
-- The @LocalStateQuery@ protocol is a node-to-client protocol, hence the
-- 'NodeToClientVersion' argument.
type SerialiseBlockQueryResult :: Type -> (Type -> k -> Type -> Type) -> Constraint
class SerialiseBlockQueryResult blk query where
  encodeBlockQueryResult ::
    forall fp result.
    CodecConfig blk ->
    BlockNodeToClientVersion blk ->
    query blk fp result ->
    result ->
    Encoding
  decodeBlockQueryResult ::
    forall fp result.
    CodecConfig blk ->
    BlockNodeToClientVersion blk ->
    query blk fp result ->
    forall s.
    Decoder s result

{-------------------------------------------------------------------------------
  Defaults
-------------------------------------------------------------------------------}

-- | Uses the 'Serialise' instance, but wraps it in CBOR-in-CBOR.
--
-- Use this for the 'SerialiseNodeToNode' and/or 'SerialiseNodeToClient'
-- instance of @blk@ and/or @'Header' blk@, which require CBOR-in-CBOR to be
-- compatible with the corresponding 'Serialised' instance.
defaultEncodeCBORinCBOR :: Serialise a => a -> Encoding
defaultEncodeCBORinCBOR :: forall a. Serialise a => a -> Encoding
defaultEncodeCBORinCBOR = (a -> Encoding) -> a -> Encoding
forall a. (a -> Encoding) -> a -> Encoding
wrapCBORinCBOR a -> Encoding
forall a. Serialise a => a -> Encoding
encode

-- | Inverse of 'defaultEncodeCBORinCBOR'
defaultDecodeCBORinCBOR :: Serialise a => Decoder s a
defaultDecodeCBORinCBOR :: forall a s. Serialise a => Decoder s a
defaultDecodeCBORinCBOR = (forall s. Decoder s (ByteString -> Either DecoderError a))
-> forall s. Decoder s a
forall a.
(forall s. Decoder s (ByteString -> Either DecoderError a))
-> forall s. Decoder s a
unwrapCBORinCBOR (Either DecoderError a -> ByteString -> Either DecoderError a
forall a b. a -> b -> a
const (Either DecoderError a -> ByteString -> Either DecoderError a)
-> (a -> Either DecoderError a)
-> a
-> ByteString
-> Either DecoderError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either DecoderError a
forall a b. b -> Either a b
Right (a -> ByteString -> Either DecoderError a)
-> Decoder s a -> Decoder s (ByteString -> Either DecoderError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall s. Decoder s a
forall a s. Serialise a => Decoder s a
decode)

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

deriving newtype instance
  SerialiseNodeToNode blk blk =>
  SerialiseNodeToNode blk (I blk)

deriving newtype instance
  SerialiseNodeToClient blk blk =>
  SerialiseNodeToClient blk (I blk)

deriving newtype instance
  SerialiseNodeToNode blk (GenTxId blk) =>
  SerialiseNodeToNode blk (WrapGenTxId blk)

instance ConvertRawHash blk => SerialiseNodeToNode blk (Point blk) where
  encodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> Point blk -> Encoding
encodeNodeToNode CodecConfig blk
_ccfg BlockNodeToNodeVersion blk
_version = (HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall {k} (block :: k).
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint ((HeaderHash blk -> Encoding) -> Point blk -> Encoding)
-> (HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall a b. (a -> b) -> a -> b
$ Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)
  decodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s (Point blk)
decodeNodeToNode CodecConfig blk
_ccfg BlockNodeToNodeVersion blk
_version = (forall s. Decoder s (HeaderHash blk)) -> Decoder s (Point blk)
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall {k} (block :: k).
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint ((forall s. Decoder s (HeaderHash blk))
 -> forall s. Decoder s (Point blk))
-> (forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall a b. (a -> b) -> a -> b
$ Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)

instance ConvertRawHash blk => SerialiseNodeToNode blk (Tip blk) where
  encodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> Tip blk -> Encoding
encodeNodeToNode CodecConfig blk
_ccfg BlockNodeToNodeVersion blk
_version = (HeaderHash blk -> Encoding) -> Tip blk -> Encoding
forall {k} (blk :: k).
(HeaderHash blk -> Encoding) -> Tip blk -> Encoding
encodeTip ((HeaderHash blk -> Encoding) -> Tip blk -> Encoding)
-> (HeaderHash blk -> Encoding) -> Tip blk -> Encoding
forall a b. (a -> b) -> a -> b
$ Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)
  decodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s (Tip blk)
decodeNodeToNode CodecConfig blk
_ccfg BlockNodeToNodeVersion blk
_version = (forall s. Decoder s (HeaderHash blk)) -> Decoder s (Tip blk)
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
forall {k} (blk :: k).
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
decodeTip ((forall s. Decoder s (HeaderHash blk))
 -> forall s. Decoder s (Tip blk))
-> (forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
forall a b. (a -> b) -> a -> b
$ Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)

instance SerialiseNodeToNode blk PerasRoundNo where
  encodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> PerasRoundNo -> Encoding
encodeNodeToNode CodecConfig blk
_ccfg BlockNodeToNodeVersion blk
_version = PerasRoundNo -> Encoding
forall a. Serialise a => a -> Encoding
encode
  decodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s PerasRoundNo
decodeNodeToNode CodecConfig blk
_ccfg BlockNodeToNodeVersion blk
_version = Decoder s PerasRoundNo
forall s. Decoder s PerasRoundNo
forall a s. Serialise a => Decoder s a
decode

instance SerialiseNodeToNode blk PerasSeatIndex where
  encodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> PerasSeatIndex -> Encoding
encodeNodeToNode CodecConfig blk
_ccfg BlockNodeToNodeVersion blk
_version = Word16 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word16 -> Encoding)
-> (PerasSeatIndex -> Word16) -> PerasSeatIndex -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasSeatIndex -> Word16
unPerasSeatIndex
  decodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s PerasSeatIndex
decodeNodeToNode CodecConfig blk
_ccfg BlockNodeToNodeVersion blk
_version = Word16 -> PerasSeatIndex
PerasSeatIndex (Word16 -> PerasSeatIndex)
-> Decoder s Word16 -> Decoder s PerasSeatIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word16
forall s. Decoder s Word16
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ConvertRawHash blk => SerialiseNodeToNode blk (PerasCert' blk) where
  -- Consistent with the 'Serialise' instance for 'PerasCert' defined in Ouroboros.Consensus.Block.SupportsPeras
  encodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> PerasCert' blk -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version PerasCert{Point blk
PerasRoundNo
pcCertRound :: PerasRoundNo
pcCertBoostedBlock :: Point blk
pcCertBoostedBlock :: forall blk. PerasCert' blk -> Point blk
pcCertRound :: forall blk. PerasCert' blk -> PerasRoundNo
..} =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CodecConfig blk
-> BlockNodeToNodeVersion blk -> PerasRoundNo -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version PerasRoundNo
pcCertRound
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CodecConfig blk
-> BlockNodeToNodeVersion blk -> Point blk -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version Point blk
pcCertBoostedBlock
  decodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk
-> forall s. Decoder s (PerasCert' blk)
decodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
2
    pcCertRound <- CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s PerasRoundNo
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s a
decodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version
    pcCertBoostedBlock <- decodeNodeToNode ccfg version
    pure $ PerasCert pcCertRound pcCertBoostedBlock

instance ConvertRawHash blk => SerialiseNodeToNode blk (PerasVote' blk) where
  -- Consistent with the 'Serialise' instance for 'PerasVote' defined in Ouroboros.Consensus.Block.SupportsPeras
  encodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> PerasVote' blk -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version PerasVote{Point blk
PerasRoundNo
PerasSeatIndex
pvVoteRound :: PerasRoundNo
pvVoteBlock :: Point blk
pvVoteVoterId :: PerasSeatIndex
pvVoteBlock :: forall blk. PerasVote' blk -> Point blk
pvVoteRound :: forall blk. PerasVote' blk -> PerasRoundNo
pvVoteVoterId :: forall blk. PerasVote' blk -> PerasSeatIndex
..} =
    Word -> Encoding
encodeListLen Word
3
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CodecConfig blk
-> BlockNodeToNodeVersion blk -> PerasRoundNo -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version PerasRoundNo
pvVoteRound
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CodecConfig blk
-> BlockNodeToNodeVersion blk -> Point blk -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version Point blk
pvVoteBlock
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CodecConfig blk
-> BlockNodeToNodeVersion blk -> PerasSeatIndex -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version PerasSeatIndex
pvVoteVoterId
  decodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk
-> forall s. Decoder s (PerasVote' blk)
decodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
3
    pvVoteRound <- CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s PerasRoundNo
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s a
decodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version
    pvVoteBlock <- decodeNodeToNode ccfg version
    pvVoteVoterId <- decodeNodeToNode ccfg version
    pure $ PerasVote pvVoteRound pvVoteBlock pvVoteVoterId

instance SerialiseNodeToNode blk PerasVoteId where
  -- Consistent with the 'Serialise' instance for 'PerasVoteId' defined in Ouroboros.Consensus.Block.SupportsPeras
  encodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> PerasVoteId -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version PerasVoteId{PerasRoundNo
PerasSeatIndex
pviRoundNo :: PerasRoundNo
pviSeatIndex :: PerasSeatIndex
pviRoundNo :: PerasVoteId -> PerasRoundNo
pviSeatIndex :: PerasVoteId -> PerasSeatIndex
..} =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CodecConfig blk
-> BlockNodeToNodeVersion blk -> PerasRoundNo -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version PerasRoundNo
pviRoundNo
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CodecConfig blk
-> BlockNodeToNodeVersion blk -> PerasSeatIndex -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version PerasSeatIndex
pviSeatIndex
  decodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s PerasVoteId
decodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
2
    pviRoundNo <- CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s PerasRoundNo
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s a
decodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version
    pviSeatIndex <- decodeNodeToNode ccfg version
    pure $ PerasVoteId pviRoundNo pviSeatIndex

deriving newtype instance
  SerialiseNodeToClient blk (GenTxId blk) =>
  SerialiseNodeToClient blk (WrapGenTxId blk)

deriving newtype instance
  SerialiseNodeToClient blk (ApplyTxErr blk) =>
  SerialiseNodeToClient blk (WrapApplyTxErr blk)

deriving newtype instance
  SerialiseNodeToClient blk (LedgerConfig blk) =>
  SerialiseNodeToClient blk (WrapLedgerConfig blk)