{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -Wno-orphans #-}

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

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.SupportsMempool
import           Ouroboros.Consensus.Mock.Ledger
import           Ouroboros.Consensus.Mock.Node.Abstract
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 => EncodeDisk (MockBlock ext) (MockBlock ext)
instance Serialise ext => DecodeDisk (MockBlock ext) (Lazy.ByteString -> MockBlock ext) where
  decodeDisk :: CodecConfig (MockBlock ext)
-> forall s. Decoder s (ByteString -> MockBlock ext)
decodeDisk CodecConfig (MockBlock ext)
_ = MockBlock ext -> ByteString -> MockBlock ext
forall a b. a -> b -> a
const (MockBlock ext -> ByteString -> MockBlock ext)
-> Decoder s (MockBlock ext)
-> Decoder s (ByteString -> 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 => EncodeDisk (MockBlock ext) (Header (MockBlock ext))
instance Serialise 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 EncodeDisk (MockBlock ext) (LedgerState (MockBlock ext))
instance DecodeDisk (MockBlock ext) (LedgerState (MockBlock ext))

instance 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 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 Serialise 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 => 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 => 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 => 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) => SerialiseNodeToClientConstraints (MockBlock ext)

instance Serialise 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 SerialiseNodeToClient (MockBlock ext) (MockError (MockBlock ext))
instance SerialiseNodeToClient (MockBlock ext) SlotNo

instance SerialiseNodeToClient (MockBlock ext) (SomeSecond BlockQuery (MockBlock ext)) where
  encodeNodeToClient :: CodecConfig (MockBlock ext)
-> BlockNodeToClientVersion (MockBlock ext)
-> SomeSecond BlockQuery (MockBlock ext)
-> Encoding
encodeNodeToClient CodecConfig (MockBlock ext)
_ BlockNodeToClientVersion (MockBlock ext)
_ (SomeSecond BlockQuery (MockBlock ext) b
R:BlockQuerySimpleBlock'result SimpleMockCrypto ext b
QueryLedgerTip) = () -> Encoding
forall a. Serialise a => a -> Encoding
encode ()
  decodeNodeToClient :: CodecConfig (MockBlock ext)
-> BlockNodeToClientVersion (MockBlock ext)
-> forall s. Decoder s (SomeSecond BlockQuery (MockBlock ext))
decodeNodeToClient CodecConfig (MockBlock ext)
_ BlockNodeToClientVersion (MockBlock ext)
_ = (\() -> BlockQuery (MockBlock ext) (Point (MockBlock ext))
-> SomeSecond BlockQuery (MockBlock ext)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery (MockBlock ext) (Point (MockBlock ext))
forall c ext.
BlockQuery (SimpleBlock c ext) (Point (SimpleBlock c ext))
QueryLedgerTip) (() -> SomeSecond BlockQuery (MockBlock ext))
-> Decoder s ()
-> Decoder s (SomeSecond 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 SerialiseResult (MockBlock ext) (BlockQuery (MockBlock ext)) where
  encodeResult :: forall result.
CodecConfig (MockBlock ext)
-> BlockNodeToClientVersion (MockBlock ext)
-> BlockQuery (MockBlock ext) result
-> result
-> Encoding
encodeResult CodecConfig (MockBlock ext)
_ BlockNodeToClientVersion (MockBlock ext)
_ BlockQuery (MockBlock ext) result
R:BlockQuerySimpleBlock'result SimpleMockCrypto ext result
QueryLedgerTip = result -> Encoding
forall a. Serialise a => a -> Encoding
encode
  decodeResult :: forall result.
CodecConfig (MockBlock ext)
-> BlockNodeToClientVersion (MockBlock ext)
-> BlockQuery (MockBlock ext) result
-> forall s. Decoder s result
decodeResult CodecConfig (MockBlock ext)
_ BlockNodeToClientVersion (MockBlock ext)
_ BlockQuery (MockBlock ext) result
R:BlockQuerySimpleBlock'result SimpleMockCrypto ext 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 SameDepIndex (NestedCtxt_ (SimpleBlock c ext) f)
instance HasNestedContent f (SimpleBlock c ext)

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