{-# 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           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 => 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) 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 :: MapKind).
LedgerState (SimpleBlock c ext) mk -> MockState (SimpleBlock c ext)
simpleLedgerState
instance 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 :: MapKind).
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 :: MapKind).
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 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 HasNetworkProtocolVersion (MockBlock ext) where
  -- Use defaults

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, Serialise (MockLedgerConfig SimpleMockCrypto ext), MockProtocolSpecific SimpleMockCrypto 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) (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 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 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)