{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Mock.Node.Serialisation
  ( MockBlock
  , NestedCtxt_ (..)
  ) where

import Cardano.Binary (DecoderError)
import Codec.Serialise (Serialise, decode, encode, serialise)
import qualified Data.ByteString.Lazy as Lazy
import Data.Typeable (Typeable)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.HeaderValidation
  ( AnnTip
  , defaultDecodeAnnTip
  , defaultEncodeAnnTip
  )
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.Query
import Ouroboros.Consensus.Ledger.SupportsMempool
import Ouroboros.Consensus.Mock.Ledger
import Ouroboros.Consensus.Mock.Node.Abstract
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.Node.Run
import Ouroboros.Consensus.Node.Serialisation
import Ouroboros.Consensus.Storage.Serialisation
import Ouroboros.Network.Block (Serialised)

-- | Local shorthand to make the instances more readable
type MockBlock ext = SimpleBlock SimpleMockCrypto ext

{-------------------------------------------------------------------------------
  Disk

  We use the default instances relying on 'Serialise' where possible.
-------------------------------------------------------------------------------}

instance (Serialise ext, Typeable ext) => HasBinaryBlockInfo (MockBlock ext) where
  getBinaryBlockInfo :: MockBlock ext -> BinaryBlockInfo
getBinaryBlockInfo = MockBlock ext -> BinaryBlockInfo
forall c ext' ext.
(SimpleCrypto c, Serialise ext', Typeable ext, Typeable ext') =>
SimpleBlock' c ext ext' -> BinaryBlockInfo
simpleBlockBinaryBlockInfo

instance
  (Serialise ext, RunMockBlock SimpleMockCrypto ext) =>
  SerialiseDiskConstraints (MockBlock ext)

instance (Serialise ext, Typeable ext) => EncodeDisk (MockBlock ext) (MockBlock ext)
instance
  (Serialise ext, Typeable ext) =>
  DecodeDisk (MockBlock ext) (Lazy.ByteString -> Either DecoderError (MockBlock ext))
  where
  decodeDisk :: CodecConfig (MockBlock ext)
-> forall s.
   Decoder s (ByteString -> Either DecoderError (MockBlock ext))
decodeDisk CodecConfig (MockBlock ext)
_ = Either DecoderError (MockBlock ext)
-> ByteString -> Either DecoderError (MockBlock ext)
forall a b. a -> b -> a
const (Either DecoderError (MockBlock ext)
 -> ByteString -> Either DecoderError (MockBlock ext))
-> (MockBlock ext -> Either DecoderError (MockBlock ext))
-> MockBlock ext
-> ByteString
-> Either DecoderError (MockBlock ext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockBlock ext -> Either DecoderError (MockBlock ext)
forall a b. b -> Either a b
Right (MockBlock ext
 -> ByteString -> Either DecoderError (MockBlock ext))
-> Decoder s (MockBlock ext)
-> Decoder s (ByteString -> Either DecoderError (MockBlock ext))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (MockBlock ext)
forall s. Decoder s (MockBlock ext)
forall a s. Serialise a => Decoder s a
decode

instance (Serialise ext, Typeable ext) => EncodeDisk (MockBlock ext) (Header (MockBlock ext))
instance
  (Serialise ext, Typeable ext) =>
  DecodeDisk (MockBlock ext) (Lazy.ByteString -> Header (MockBlock ext))
  where
  decodeDisk :: CodecConfig (MockBlock ext)
-> forall s. Decoder s (ByteString -> Header (MockBlock ext))
decodeDisk CodecConfig (MockBlock ext)
_ = Header (MockBlock ext) -> ByteString -> Header (MockBlock ext)
forall a b. a -> b -> a
const (Header (MockBlock ext) -> ByteString -> Header (MockBlock ext))
-> Decoder s (Header (MockBlock ext))
-> Decoder s (ByteString -> Header (MockBlock ext))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Header (MockBlock ext))
forall s. Decoder s (Header (MockBlock ext))
forall a s. Serialise a => Decoder s a
decode

instance Typeable ext => EncodeDisk (MockBlock ext) (LedgerState (MockBlock ext) EmptyMK) where
  encodeDisk :: CodecConfig (MockBlock ext)
-> LedgerState (MockBlock ext) EmptyMK -> Encoding
encodeDisk CodecConfig (MockBlock ext)
_ = MockState (MockBlock ext) -> Encoding
forall a. Serialise a => a -> Encoding
encode (MockState (MockBlock ext) -> Encoding)
-> (LedgerState (MockBlock ext) EmptyMK
    -> MockState (MockBlock ext))
-> LedgerState (MockBlock ext) EmptyMK
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (MockBlock ext) EmptyMK -> MockState (MockBlock ext)
forall c ext (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk -> MockState (SimpleBlock c ext)
simpleLedgerState
instance Typeable ext => DecodeDisk (MockBlock ext) (LedgerState (MockBlock ext) EmptyMK) where
  decodeDisk :: CodecConfig (MockBlock ext)
-> forall s. Decoder s (LedgerState (MockBlock ext) EmptyMK)
decodeDisk CodecConfig (MockBlock ext)
_ = (MockState (MockBlock ext)
 -> LedgerTables (LedgerState (MockBlock ext)) EmptyMK
 -> LedgerState (MockBlock ext) EmptyMK)
-> LedgerTables (LedgerState (MockBlock ext)) EmptyMK
-> MockState (MockBlock ext)
-> LedgerState (MockBlock ext) EmptyMK
forall a b c. (a -> b -> c) -> b -> a -> c
flip MockState (MockBlock ext)
-> LedgerTables (LedgerState (MockBlock ext)) EmptyMK
-> LedgerState (MockBlock ext) EmptyMK
forall c ext (mk :: * -> * -> *).
MockState (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
SimpleLedgerState (EmptyMK
  (TxIn (LedgerState (MockBlock ext)))
  (TxOut (LedgerState (MockBlock ext)))
-> LedgerTables (LedgerState (MockBlock ext)) EmptyMK
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables EmptyMK TxIn TxOut
EmptyMK
  (TxIn (LedgerState (MockBlock ext)))
  (TxOut (LedgerState (MockBlock ext)))
forall k v. EmptyMK k v
EmptyMK) (MockState (MockBlock ext) -> LedgerState (MockBlock ext) EmptyMK)
-> Decoder s (MockState (MockBlock ext))
-> Decoder s (LedgerState (MockBlock ext) EmptyMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (MockState (MockBlock ext))
forall s. Decoder s (MockState (MockBlock ext))
forall a s. Serialise a => Decoder s a
decode

instance Typeable ext => EncodeDisk (MockBlock ext) (AnnTip (MockBlock ext)) where
  encodeDisk :: CodecConfig (MockBlock ext) -> AnnTip (MockBlock ext) -> Encoding
encodeDisk CodecConfig (MockBlock ext)
_ = (HeaderHash (MockBlock ext) -> Encoding)
-> AnnTip (MockBlock ext) -> Encoding
forall blk.
(TipInfo blk ~ HeaderHash blk) =>
(HeaderHash blk -> Encoding) -> AnnTip blk -> Encoding
defaultEncodeAnnTip Hash ShortHash (Header (MockBlock ext)) -> Encoding
HeaderHash (MockBlock ext) -> Encoding
forall a. Serialise a => a -> Encoding
encode
instance Typeable ext => DecodeDisk (MockBlock ext) (AnnTip (MockBlock ext)) where
  decodeDisk :: CodecConfig (MockBlock ext)
-> forall s. Decoder s (AnnTip (MockBlock ext))
decodeDisk CodecConfig (MockBlock ext)
_ = (forall s. Decoder s (HeaderHash (MockBlock ext)))
-> forall s. Decoder s (AnnTip (MockBlock ext))
forall blk.
(TipInfo blk ~ HeaderHash blk) =>
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (AnnTip blk)
defaultDecodeAnnTip Decoder s (Hash ShortHash (Header (MockBlock ext)))
Decoder s (HeaderHash (MockBlock ext))
forall s. Decoder s (Hash ShortHash (Header (MockBlock ext)))
forall s. Decoder s (HeaderHash (MockBlock ext))
forall a s. Serialise a => Decoder s a
decode

{-------------------------------------------------------------------------------
  NodeToNode

  We use the default, unversioned instances relying on 'Serialise' where
  possible.
-------------------------------------------------------------------------------}

instance HasNetworkProtocolVersion (MockBlock ext)

-- Use defaults

instance (Serialise ext, Typeable ext) => SerialiseNodeToNodeConstraints (MockBlock ext) where
  estimateBlockSize :: Header (MockBlock ext) -> SizeInBytes
estimateBlockSize Header (MockBlock ext)
hdr =
    SizeInBytes
7 {- CBOR-in-CBOR -} SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
1 {- encodeListLen 2 -} 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
    hdrSize :: SizeInBytes
hdrSize = Int64 -> SizeInBytes
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
Lazy.length (Header (MockBlock ext) -> ByteString
forall a. Serialise a => a -> ByteString
serialise Header (MockBlock ext)
hdr))
    bodySize :: SizeInBytes
bodySize = SimpleStdHeader SimpleMockCrypto ext -> SizeInBytes
forall c ext. SimpleStdHeader c ext -> SizeInBytes
simpleBodySize (Header (MockBlock ext) -> SimpleStdHeader SimpleMockCrypto ext
forall c ext ext'.
Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext
simpleHeaderStd Header (MockBlock ext)
hdr)

instance (Serialise ext, Typeable ext) => SerialiseNodeToNode (MockBlock ext) (MockBlock ext) where
  encodeNodeToNode :: CodecConfig (MockBlock ext)
-> BlockNodeToNodeVersion (MockBlock ext)
-> MockBlock ext
-> Encoding
encodeNodeToNode CodecConfig (MockBlock ext)
_ BlockNodeToNodeVersion (MockBlock ext)
_ = MockBlock ext -> Encoding
forall a. Serialise a => a -> Encoding
defaultEncodeCBORinCBOR
  decodeNodeToNode :: CodecConfig (MockBlock ext)
-> BlockNodeToNodeVersion (MockBlock ext)
-> forall s. Decoder s (MockBlock ext)
decodeNodeToNode CodecConfig (MockBlock ext)
_ BlockNodeToNodeVersion (MockBlock ext)
_ = Decoder s (MockBlock ext)
forall a s. Serialise a => Decoder s a
defaultDecodeCBORinCBOR

instance
  (Serialise ext, Typeable ext) =>
  SerialiseNodeToNode (MockBlock ext) (Header (MockBlock ext))
  where
  encodeNodeToNode :: CodecConfig (MockBlock ext)
-> BlockNodeToNodeVersion (MockBlock ext)
-> Header (MockBlock ext)
-> Encoding
encodeNodeToNode CodecConfig (MockBlock ext)
ccfg BlockNodeToNodeVersion (MockBlock ext)
_ = CodecConfig (MockBlock ext)
-> DepPair (NestedCtxt Header (MockBlock ext)) -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig (MockBlock ext)
ccfg (DepPair (NestedCtxt Header (MockBlock ext)) -> Encoding)
-> (Header (MockBlock ext)
    -> DepPair (NestedCtxt Header (MockBlock ext)))
-> Header (MockBlock ext)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (MockBlock ext)
-> DepPair (NestedCtxt Header (MockBlock ext))
forall (f :: * -> *) blk.
HasNestedContent f blk =>
f blk -> DepPair (NestedCtxt f blk)
unnest
  decodeNodeToNode :: CodecConfig (MockBlock ext)
-> BlockNodeToNodeVersion (MockBlock ext)
-> forall s. Decoder s (Header (MockBlock ext))
decodeNodeToNode CodecConfig (MockBlock ext)
ccfg BlockNodeToNodeVersion (MockBlock ext)
_ = DepPair (NestedCtxt Header (MockBlock ext))
-> Header (MockBlock ext)
forall (f :: * -> *) blk.
HasNestedContent f blk =>
DepPair (NestedCtxt f blk) -> f blk
nest (DepPair (NestedCtxt Header (MockBlock ext))
 -> Header (MockBlock ext))
-> Decoder s (DepPair (NestedCtxt Header (MockBlock ext)))
-> Decoder s (Header (MockBlock ext))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig (MockBlock ext)
-> forall s.
   Decoder s (DepPair (NestedCtxt Header (MockBlock ext)))
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig (MockBlock ext)
ccfg

instance SerialiseNodeToNode (MockBlock ext) (Serialised (MockBlock ext))
instance
  (Serialise ext, Typeable ext) =>
  SerialiseNodeToNode (MockBlock ext) (SerialisedHeader (MockBlock ext))
  where
  encodeNodeToNode :: CodecConfig (MockBlock ext)
-> BlockNodeToNodeVersion (MockBlock ext)
-> SerialisedHeader (MockBlock ext)
-> Encoding
encodeNodeToNode CodecConfig (MockBlock ext)
ccfg BlockNodeToNodeVersion (MockBlock ext)
_ = CodecConfig (MockBlock ext)
-> SerialisedHeader (MockBlock ext) -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig (MockBlock ext)
ccfg
  decodeNodeToNode :: CodecConfig (MockBlock ext)
-> BlockNodeToNodeVersion (MockBlock ext)
-> forall s. Decoder s (SerialisedHeader (MockBlock ext))
decodeNodeToNode CodecConfig (MockBlock ext)
ccfg BlockNodeToNodeVersion (MockBlock ext)
_ = CodecConfig (MockBlock ext)
-> forall s. Decoder s (SerialisedHeader (MockBlock ext))
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig (MockBlock ext)
ccfg
instance SerialiseNodeToNode (MockBlock ext) (GenTx (MockBlock ext))
instance SerialiseNodeToNode (MockBlock ext) (GenTxId (MockBlock ext))

{-------------------------------------------------------------------------------
  NodeToClient

  We use the default, unversioned instances relying on 'Serialise' where
  possible.
-------------------------------------------------------------------------------}

instance
  ( Serialise ext
  , Typeable ext
  , Serialise (MockLedgerConfig SimpleMockCrypto ext)
  , MockProtocolSpecific SimpleMockCrypto ext
  ) =>
  SerialiseNodeToClientConstraints (MockBlock ext)

instance (Serialise ext, Typeable ext) => SerialiseNodeToClient (MockBlock ext) (MockBlock ext) where
  encodeNodeToClient :: CodecConfig (MockBlock ext)
-> BlockNodeToClientVersion (MockBlock ext)
-> MockBlock ext
-> Encoding
encodeNodeToClient CodecConfig (MockBlock ext)
_ BlockNodeToClientVersion (MockBlock ext)
_ = MockBlock ext -> Encoding
forall a. Serialise a => a -> Encoding
defaultEncodeCBORinCBOR
  decodeNodeToClient :: CodecConfig (MockBlock ext)
-> BlockNodeToClientVersion (MockBlock ext)
-> forall s. Decoder s (MockBlock ext)
decodeNodeToClient CodecConfig (MockBlock ext)
_ BlockNodeToClientVersion (MockBlock ext)
_ = Decoder s (MockBlock ext)
forall a s. Serialise a => Decoder s a
defaultDecodeCBORinCBOR

instance SerialiseNodeToClient (MockBlock ext) (Serialised (MockBlock ext))
instance SerialiseNodeToClient (MockBlock ext) (GenTx (MockBlock ext))
instance SerialiseNodeToClient (MockBlock ext) (GenTxId (MockBlock ext))
instance Typeable ext => SerialiseNodeToClient (MockBlock ext) (MockError (MockBlock ext))
instance SerialiseNodeToClient (MockBlock ext) SlotNo

instance SerialiseNodeToClient (MockBlock ext) (SomeBlockQuery (BlockQuery (MockBlock ext))) where
  encodeNodeToClient :: CodecConfig (MockBlock ext)
-> BlockNodeToClientVersion (MockBlock ext)
-> SomeBlockQuery (BlockQuery (MockBlock ext))
-> Encoding
encodeNodeToClient CodecConfig (MockBlock ext)
_ BlockNodeToClientVersion (MockBlock ext)
_ (SomeBlockQuery BlockQuery (MockBlock ext) footprint result
R:BlockQuerySimpleBlock'fpresult
  SimpleMockCrypto ext footprint result
QueryLedgerTip) = () -> Encoding
forall a. Serialise a => a -> Encoding
encode ()
  decodeNodeToClient :: CodecConfig (MockBlock ext)
-> BlockNodeToClientVersion (MockBlock ext)
-> forall s.
   Decoder s (SomeBlockQuery (BlockQuery (MockBlock ext)))
decodeNodeToClient CodecConfig (MockBlock ext)
_ BlockNodeToClientVersion (MockBlock ext)
_ = (\() -> BlockQuery (MockBlock ext) 'QFNoTables (Point (MockBlock ext))
-> SomeBlockQuery (BlockQuery (MockBlock ext))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (MockBlock ext) 'QFNoTables (Point (MockBlock ext))
forall c ext.
BlockQuery
  (SimpleBlock c ext) 'QFNoTables (Point (SimpleBlock c ext))
QueryLedgerTip) (() -> SomeBlockQuery (BlockQuery (MockBlock ext)))
-> Decoder s ()
-> Decoder s (SomeBlockQuery (BlockQuery (MockBlock ext)))
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

instance Typeable ext => SerialiseBlockQueryResult (MockBlock ext) BlockQuery where
  encodeBlockQueryResult :: forall (fp :: QueryFootprint) result.
CodecConfig (MockBlock ext)
-> BlockNodeToClientVersion (MockBlock ext)
-> BlockQuery (MockBlock ext) fp result
-> result
-> Encoding
encodeBlockQueryResult CodecConfig (MockBlock ext)
_ BlockNodeToClientVersion (MockBlock ext)
_ BlockQuery (MockBlock ext) fp result
R:BlockQuerySimpleBlock'fpresult SimpleMockCrypto ext fp result
QueryLedgerTip = result -> Encoding
forall a. Serialise a => a -> Encoding
encode
  decodeBlockQueryResult :: forall (fp :: QueryFootprint) result.
CodecConfig (MockBlock ext)
-> BlockNodeToClientVersion (MockBlock ext)
-> BlockQuery (MockBlock ext) fp result
-> forall s. Decoder s result
decodeBlockQueryResult CodecConfig (MockBlock ext)
_ BlockNodeToClientVersion (MockBlock ext)
_ BlockQuery (MockBlock ext) fp result
R:BlockQuerySimpleBlock'fpresult SimpleMockCrypto ext fp result
QueryLedgerTip = Decoder s result
forall s. Decoder s result
forall a s. Serialise a => Decoder s a
decode

{-------------------------------------------------------------------------------
  Nested contents
-------------------------------------------------------------------------------}

data instance NestedCtxt_ (SimpleBlock c ext) f a where
  CtxtMock :: NestedCtxt_ (SimpleBlock c ext) f (f (SimpleBlock c ext))

deriving instance Show (NestedCtxt_ (SimpleBlock c ext) f a)

instance TrivialDependency (NestedCtxt_ (SimpleBlock c ext) f) where
  type TrivialIndex (NestedCtxt_ (SimpleBlock c ext) f) = f (SimpleBlock c ext)

  hasSingleIndex :: forall a b.
NestedCtxt_ (SimpleBlock c ext) f a
-> NestedCtxt_ (SimpleBlock c ext) f b -> a :~: b
hasSingleIndex NestedCtxt_ (SimpleBlock c ext) f a
R:NestedCtxt_SimpleBlock'fa c ext f a
CtxtMock NestedCtxt_ (SimpleBlock c ext) f b
R:NestedCtxt_SimpleBlock'fa c ext f b
CtxtMock = a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  indexIsTrivial :: NestedCtxt_
  (SimpleBlock c ext)
  f
  (TrivialIndex (NestedCtxt_ (SimpleBlock c ext) f))
indexIsTrivial = NestedCtxt_ (SimpleBlock c ext) f (f (SimpleBlock c ext))
NestedCtxt_
  (SimpleBlock c ext)
  f
  (TrivialIndex (NestedCtxt_ (SimpleBlock c ext) f))
forall c ext (f :: * -> *).
NestedCtxt_ (SimpleBlock c ext) f (f (SimpleBlock c ext))
CtxtMock

instance Typeable ext => SameDepIndex (NestedCtxt_ (SimpleBlock c ext) f)
instance Typeable ext => HasNestedContent f (SimpleBlock c ext)

instance (Serialise ext, Typeable ext) => ReconstructNestedCtxt Header (MockBlock ext)
instance (Serialise ext, Typeable ext) => EncodeDiskDepIx (NestedCtxt Header) (MockBlock ext)
instance (Serialise ext, Typeable ext) => EncodeDiskDep (NestedCtxt Header) (MockBlock ext)
instance (Serialise ext, Typeable ext) => DecodeDiskDepIx (NestedCtxt Header) (MockBlock ext)
instance (Serialise ext, Typeable ext) => DecodeDiskDep (NestedCtxt Header) (MockBlock ext)