{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# 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 Codec.CBOR.Decoding (Decoder)
import Codec.CBOR.Encoding (Encoding)
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 (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 -> 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 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)

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)