{-# LANGUAGE DefaultSignatures     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# 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 (
    SerialiseNodeToClient (..)
  , SerialiseNodeToNode (..)
  , SerialiseResult (..)
    -- * Defaults
  , defaultDecodeCBORinCBOR
  , defaultEncodeCBORinCBOR
    -- * Re-exported for convenience
  , Some (..)
  ) where

import           Codec.CBOR.Decoding (Decoder)
import           Codec.CBOR.Encoding (Encoding)
import           Codec.Serialise (Serialise (decode, encode))
import           Data.SOP.BasicFunctors

import           Ouroboros.Network.Block (unwrapCBORinCBOR, wrapCBORinCBOR)
import           Ouroboros.Network.Protocol.LocalStateQuery.Codec (Some (..))

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr,
                     GenTxId)
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.TypeFamilyWrappers

{-------------------------------------------------------------------------------
  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 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 a s. Serialise a => Decoder s a
decode

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

-- | How to serialise the result of the @result@ of a query.
--
-- The @LocalStateQuery@ protocol is a node-to-client protocol, hence the
-- 'NodeToClientVersion' argument.
class SerialiseResult blk query where
  encodeResult
    :: forall result.
       CodecConfig blk
    -> BlockNodeToClientVersion blk
    -> query result
    -> result -> Encoding
  decodeResult
    :: forall result.
       CodecConfig blk
    -> BlockNodeToClientVersion blk
    -> query 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 :: 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 :: Decoder s a
defaultDecodeCBORinCBOR = (forall s. Decoder s (ByteString -> a)) -> forall s. Decoder s a
forall a.
(forall s. Decoder s (ByteString -> a)) -> forall s. Decoder s a
unwrapCBORinCBOR (a -> ByteString -> a
forall a b. a -> b -> a
const (a -> ByteString -> a)
-> Decoder s a -> Decoder s (ByteString -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall a s. Serialise a => Decoder s a
decode)

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

instance SerialiseNodeToNode blk blk
      => SerialiseNodeToNode blk (I blk) where
  encodeNodeToNode :: CodecConfig blk -> BlockNodeToNodeVersion blk -> I blk -> Encoding
encodeNodeToNode CodecConfig blk
cfg BlockNodeToNodeVersion blk
version (I blk
h) =
      CodecConfig blk -> BlockNodeToNodeVersion blk -> blk -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
cfg BlockNodeToNodeVersion blk
version blk
h
  decodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s (I blk)
decodeNodeToNode CodecConfig blk
cfg BlockNodeToNodeVersion blk
version =
      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
-> BlockNodeToNodeVersion blk -> forall s. Decoder s blk
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s a
decodeNodeToNode CodecConfig blk
cfg BlockNodeToNodeVersion blk
version

instance SerialiseNodeToClient blk blk
      => SerialiseNodeToClient blk (I blk) where
  encodeNodeToClient :: CodecConfig blk
-> BlockNodeToClientVersion blk -> I blk -> Encoding
encodeNodeToClient CodecConfig blk
cfg BlockNodeToClientVersion blk
version (I blk
h) =
      CodecConfig blk -> BlockNodeToClientVersion blk -> blk -> Encoding
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient CodecConfig blk
cfg BlockNodeToClientVersion blk
version blk
h
  decodeNodeToClient :: CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s (I blk)
decodeNodeToClient CodecConfig blk
cfg BlockNodeToClientVersion blk
version =
      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
-> BlockNodeToClientVersion blk -> forall s. Decoder s blk
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient CodecConfig blk
cfg BlockNodeToClientVersion blk
version

instance SerialiseNodeToNode blk (GenTxId     blk)
      => SerialiseNodeToNode blk (WrapGenTxId blk) where
  encodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> WrapGenTxId blk -> Encoding
encodeNodeToNode CodecConfig blk
cfg BlockNodeToNodeVersion blk
version (WrapGenTxId GenTxId blk
h) =
      CodecConfig blk
-> BlockNodeToNodeVersion blk -> GenTxId blk -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
cfg BlockNodeToNodeVersion blk
version GenTxId blk
h
  decodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk
-> forall s. Decoder s (WrapGenTxId blk)
decodeNodeToNode CodecConfig blk
cfg BlockNodeToNodeVersion blk
version =
      GenTxId blk -> WrapGenTxId blk
forall blk. GenTxId blk -> WrapGenTxId blk
WrapGenTxId (GenTxId blk -> WrapGenTxId blk)
-> Decoder s (GenTxId blk) -> Decoder s (WrapGenTxId blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s (GenTxId blk)
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s a
decodeNodeToNode CodecConfig blk
cfg BlockNodeToNodeVersion blk
version

instance SerialiseNodeToClient blk (GenTxId     blk)
      => SerialiseNodeToClient blk (WrapGenTxId blk) where
  encodeNodeToClient :: CodecConfig blk
-> BlockNodeToClientVersion blk -> WrapGenTxId blk -> Encoding
encodeNodeToClient CodecConfig blk
cfg BlockNodeToClientVersion blk
version (WrapGenTxId GenTxId blk
h) =
      CodecConfig blk
-> BlockNodeToClientVersion blk -> GenTxId blk -> Encoding
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient CodecConfig blk
cfg BlockNodeToClientVersion blk
version GenTxId blk
h
  decodeNodeToClient :: CodecConfig blk
-> BlockNodeToClientVersion blk
-> forall s. Decoder s (WrapGenTxId blk)
decodeNodeToClient CodecConfig blk
cfg BlockNodeToClientVersion blk
version =
      GenTxId blk -> WrapGenTxId blk
forall blk. GenTxId blk -> WrapGenTxId blk
WrapGenTxId (GenTxId blk -> WrapGenTxId blk)
-> Decoder s (GenTxId blk) -> Decoder s (WrapGenTxId blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig blk
-> BlockNodeToClientVersion blk
-> forall s. Decoder s (GenTxId blk)
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient CodecConfig blk
cfg BlockNodeToClientVersion blk
version

instance SerialiseNodeToClient blk (ApplyTxErr     blk)
      => SerialiseNodeToClient blk (WrapApplyTxErr blk) where
  encodeNodeToClient :: CodecConfig blk
-> BlockNodeToClientVersion blk -> WrapApplyTxErr blk -> Encoding
encodeNodeToClient CodecConfig blk
cfg BlockNodeToClientVersion blk
version (WrapApplyTxErr ApplyTxErr blk
h) =
      CodecConfig blk
-> BlockNodeToClientVersion blk -> ApplyTxErr blk -> Encoding
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient CodecConfig blk
cfg BlockNodeToClientVersion blk
version ApplyTxErr blk
h
  decodeNodeToClient :: CodecConfig blk
-> BlockNodeToClientVersion blk
-> forall s. Decoder s (WrapApplyTxErr blk)
decodeNodeToClient CodecConfig blk
cfg BlockNodeToClientVersion blk
version =
      ApplyTxErr blk -> WrapApplyTxErr blk
forall blk. ApplyTxErr blk -> WrapApplyTxErr blk
WrapApplyTxErr (ApplyTxErr blk -> WrapApplyTxErr blk)
-> Decoder s (ApplyTxErr blk) -> Decoder s (WrapApplyTxErr blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig blk
-> BlockNodeToClientVersion blk
-> forall s. Decoder s (ApplyTxErr blk)
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient CodecConfig blk
cfg BlockNodeToClientVersion blk
version