{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Mock.Ledger.Block.PBFT
  ( SignedSimplePBft (..)
  , SimplePBftBlock
  , SimplePBftExt (..)
  , SimplePBftHeader
  , forgePBftExt
  ) where

import Cardano.Binary (ToCBOR (..))
import Cardano.Crypto.DSIGN
import Cardano.Crypto.Util
import Codec.Serialise (Serialise (..), serialise)
import qualified Data.ByteString.Lazy as BSL
import Data.Typeable (Typeable)
import Data.Void (Void)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Forecast
import Ouroboros.Consensus.Ledger.Basics
import Ouroboros.Consensus.Ledger.SupportsProtocol
import Ouroboros.Consensus.Mock.Ledger.Block
import Ouroboros.Consensus.Mock.Ledger.Forge
import Ouroboros.Consensus.Mock.Node.Abstract
import Ouroboros.Consensus.Protocol.PBFT
import qualified Ouroboros.Consensus.Protocol.PBFT.State as S
import Ouroboros.Consensus.Protocol.Signed
import Ouroboros.Consensus.Storage.Serialisation
import Ouroboros.Consensus.Util.Condense

{-------------------------------------------------------------------------------
  Instantiate the @ext@ to suit PBFT
-------------------------------------------------------------------------------}

-- | Simple block extended with the fields required for PBFT
--
-- @c@  is crypto used for the block itself
-- @c'@ is crypto used for the consensus protocol
type SimplePBftBlock c c' = SimpleBlock c (SimplePBftExt c c')

-- | Header for PBFT
type SimplePBftHeader c c' = SimpleHeader c (SimplePBftExt c c')

-- | Block extension required for PBFT
newtype SimplePBftExt c c' = SimplePBftExt
  { forall c c'.
SimplePBftExt c c' -> PBftFields c' (SignedSimplePBft c c')
simplePBftExt :: PBftFields c' (SignedSimplePBft c c')
  }
  deriving stock ((forall x. SimplePBftExt c c' -> Rep (SimplePBftExt c c') x)
-> (forall x. Rep (SimplePBftExt c c') x -> SimplePBftExt c c')
-> Generic (SimplePBftExt c c')
forall x. Rep (SimplePBftExt c c') x -> SimplePBftExt c c'
forall x. SimplePBftExt c c' -> Rep (SimplePBftExt c c') x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c c' x. Rep (SimplePBftExt c c') x -> SimplePBftExt c c'
forall c c' x. SimplePBftExt c c' -> Rep (SimplePBftExt c c') x
$cfrom :: forall c c' x. SimplePBftExt c c' -> Rep (SimplePBftExt c c') x
from :: forall x. SimplePBftExt c c' -> Rep (SimplePBftExt c c') x
$cto :: forall c c' x. Rep (SimplePBftExt c c') x -> SimplePBftExt c c'
to :: forall x. Rep (SimplePBftExt c c') x -> SimplePBftExt c c'
Generic, Int -> SimplePBftExt c c' -> ShowS
[SimplePBftExt c c'] -> ShowS
SimplePBftExt c c' -> String
(Int -> SimplePBftExt c c' -> ShowS)
-> (SimplePBftExt c c' -> String)
-> ([SimplePBftExt c c'] -> ShowS)
-> Show (SimplePBftExt c c')
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c c'. PBftCrypto c' => Int -> SimplePBftExt c c' -> ShowS
forall c c'. PBftCrypto c' => [SimplePBftExt c c'] -> ShowS
forall c c'. PBftCrypto c' => SimplePBftExt c c' -> String
$cshowsPrec :: forall c c'. PBftCrypto c' => Int -> SimplePBftExt c c' -> ShowS
showsPrec :: Int -> SimplePBftExt c c' -> ShowS
$cshow :: forall c c'. PBftCrypto c' => SimplePBftExt c c' -> String
show :: SimplePBftExt c c' -> String
$cshowList :: forall c c'. PBftCrypto c' => [SimplePBftExt c c'] -> ShowS
showList :: [SimplePBftExt c c'] -> ShowS
Show, SimplePBftExt c c' -> SimplePBftExt c c' -> Bool
(SimplePBftExt c c' -> SimplePBftExt c c' -> Bool)
-> (SimplePBftExt c c' -> SimplePBftExt c c' -> Bool)
-> Eq (SimplePBftExt c c')
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c c'.
PBftCrypto c' =>
SimplePBftExt c c' -> SimplePBftExt c c' -> Bool
$c== :: forall c c'.
PBftCrypto c' =>
SimplePBftExt c c' -> SimplePBftExt c c' -> Bool
== :: SimplePBftExt c c' -> SimplePBftExt c c' -> Bool
$c/= :: forall c c'.
PBftCrypto c' =>
SimplePBftExt c c' -> SimplePBftExt c c' -> Bool
/= :: SimplePBftExt c c' -> SimplePBftExt c c' -> Bool
Eq)
  deriving newtype SimplePBftExt c c' -> String
(SimplePBftExt c c' -> String) -> Condense (SimplePBftExt c c')
forall a. (a -> String) -> Condense a
forall c c'. PBftCrypto c' => SimplePBftExt c c' -> String
$ccondense :: forall c c'. PBftCrypto c' => SimplePBftExt c c' -> String
condense :: SimplePBftExt c c' -> String
Condense
  deriving anyclass Context -> SimplePBftExt c c' -> IO (Maybe ThunkInfo)
Proxy (SimplePBftExt c c') -> String
(Context -> SimplePBftExt c c' -> IO (Maybe ThunkInfo))
-> (Context -> SimplePBftExt c c' -> IO (Maybe ThunkInfo))
-> (Proxy (SimplePBftExt c c') -> String)
-> NoThunks (SimplePBftExt c c')
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall c c'.
(PBftCrypto c', Typeable c) =>
Context -> SimplePBftExt c c' -> IO (Maybe ThunkInfo)
forall c c'.
(PBftCrypto c', Typeable c) =>
Proxy (SimplePBftExt c c') -> String
$cnoThunks :: forall c c'.
(PBftCrypto c', Typeable c) =>
Context -> SimplePBftExt c c' -> IO (Maybe ThunkInfo)
noThunks :: Context -> SimplePBftExt c c' -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c c'.
(PBftCrypto c', Typeable c) =>
Context -> SimplePBftExt c c' -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SimplePBftExt c c' -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall c c'.
(PBftCrypto c', Typeable c) =>
Proxy (SimplePBftExt c c') -> String
showTypeOf :: Proxy (SimplePBftExt c c') -> String
NoThunks

-- | Part of the block that gets signed
--
-- We just sign the standard header, i.e., without the PBFT extensions.
-- In particular, the signature does not cover the issuer.
--
-- The signature does not cover the body explicitly, but since the standard
-- header includes a hash of the body, the signature covers the body implicitly.
data SignedSimplePBft c c' = SignedSimplePBft
  { forall c c'.
SignedSimplePBft c c' -> SimpleStdHeader c (SimplePBftExt c c')
signedSimplePBft :: SimpleStdHeader c (SimplePBftExt c c')
  }
  deriving (forall x. SignedSimplePBft c c' -> Rep (SignedSimplePBft c c') x)
-> (forall x.
    Rep (SignedSimplePBft c c') x -> SignedSimplePBft c c')
-> Generic (SignedSimplePBft c c')
forall x. Rep (SignedSimplePBft c c') x -> SignedSimplePBft c c'
forall x. SignedSimplePBft c c' -> Rep (SignedSimplePBft c c') x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c c' x.
Rep (SignedSimplePBft c c') x -> SignedSimplePBft c c'
forall c c' x.
SignedSimplePBft c c' -> Rep (SignedSimplePBft c c') x
$cfrom :: forall c c' x.
SignedSimplePBft c c' -> Rep (SignedSimplePBft c c') x
from :: forall x. SignedSimplePBft c c' -> Rep (SignedSimplePBft c c') x
$cto :: forall c c' x.
Rep (SignedSimplePBft c c') x -> SignedSimplePBft c c'
to :: forall x. Rep (SignedSimplePBft c c') x -> SignedSimplePBft c c'
Generic

type instance BlockProtocol (SimplePBftBlock c c') = PBft c'

-- | Sanity check that block and header type synonyms agree
_simplePBftHeader :: SimplePBftBlock c c' -> SimplePBftHeader c c'
_simplePBftHeader :: forall c c'. SimplePBftBlock c c' -> SimplePBftHeader c c'
_simplePBftHeader = SimpleBlock' c (SimplePBftExt c c') (SimplePBftExt c c')
-> Header
     (SimpleBlock' c (SimplePBftExt c c') (SimplePBftExt c c'))
forall c ext ext'.
SimpleBlock' c ext ext' -> Header (SimpleBlock' c ext ext')
simpleHeader

{-------------------------------------------------------------------------------
  Customization of the generic infrastructure
-------------------------------------------------------------------------------}

instance
  (SimpleCrypto c, PBftCrypto c', Serialise (PBftVerKeyHash c')) =>
  MockProtocolSpecific c (SimplePBftExt c c')
  where
  -- \| PBFT requires the ledger view; for the mock ledger, this is constant
  type MockLedgerConfig c (SimplePBftExt c c') = PBftLedgerView c'

{-------------------------------------------------------------------------------
  Evidence that SimpleBlock can support PBFT
-------------------------------------------------------------------------------}

type instance Signed (SimplePBftHeader c c') = SignedSimplePBft c c'

instance SignedHeader (SimplePBftHeader c c') where
  headerSigned :: SimplePBftHeader c c' -> Signed (SimplePBftHeader c c')
headerSigned = SimpleStdHeader c (SimplePBftExt c c') -> SignedSimplePBft c c'
forall c c'.
SimpleStdHeader c (SimplePBftExt c c') -> SignedSimplePBft c c'
SignedSimplePBft (SimpleStdHeader c (SimplePBftExt c c') -> SignedSimplePBft c c')
-> (SimplePBftHeader c c'
    -> SimpleStdHeader c (SimplePBftExt c c'))
-> SimplePBftHeader c c'
-> SignedSimplePBft c c'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimplePBftHeader c c' -> SimpleStdHeader c (SimplePBftExt c c')
forall c ext ext'.
Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext
simpleHeaderStd

instance
  ( SimpleCrypto c
  , PBftCrypto c'
  , Serialise (PBftVerKeyHash c')
  ) =>
  RunMockBlock c (SimplePBftExt c c')
  where
  mockNetworkMagic :: BlockConfig (SimpleBlock c (SimplePBftExt c c')) -> NetworkMagic
mockNetworkMagic = NetworkMagic
-> BlockConfig (SimpleBlock c (SimplePBftExt c c')) -> NetworkMagic
forall a b. a -> b -> a
const NetworkMagic
HasCallStack => NetworkMagic
constructMockNetworkMagic

instance
  ( SimpleCrypto c
  , Signable MockDSIGN (SignedSimplePBft c PBftMockCrypto)
  ) =>
  BlockSupportsProtocol (SimplePBftBlock c PBftMockCrypto)
  where
  validateView :: BlockConfig (SimplePBftBlock c PBftMockCrypto)
-> Header (SimplePBftBlock c PBftMockCrypto)
-> ValidateView (BlockProtocol (SimplePBftBlock c PBftMockCrypto))
validateView BlockConfig (SimplePBftBlock c PBftMockCrypto)
_ = ContextDSIGN (PBftDSIGN PBftMockCrypto)
-> (Header (SimplePBftBlock c PBftMockCrypto)
    -> PBftFields
         PBftMockCrypto
         (Signed (Header (SimplePBftBlock c PBftMockCrypto))))
-> Header (SimplePBftBlock c PBftMockCrypto)
-> PBftValidateView PBftMockCrypto
forall hdr c.
(SignedHeader hdr, Signable (PBftDSIGN c) (Signed hdr)) =>
ContextDSIGN (PBftDSIGN c)
-> (hdr -> PBftFields c (Signed hdr)) -> hdr -> PBftValidateView c
pbftValidateRegular () (SimplePBftExt c PBftMockCrypto
-> PBftFields PBftMockCrypto (SignedSimplePBft c PBftMockCrypto)
forall c c'.
SimplePBftExt c c' -> PBftFields c' (SignedSimplePBft c c')
simplePBftExt (SimplePBftExt c PBftMockCrypto
 -> PBftFields PBftMockCrypto (SignedSimplePBft c PBftMockCrypto))
-> (Header (SimplePBftBlock c PBftMockCrypto)
    -> SimplePBftExt c PBftMockCrypto)
-> Header (SimplePBftBlock c PBftMockCrypto)
-> PBftFields PBftMockCrypto (SignedSimplePBft c PBftMockCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (SimplePBftBlock c PBftMockCrypto)
-> SimplePBftExt c PBftMockCrypto
forall c ext ext'. Header (SimpleBlock' c ext ext') -> ext'
simpleHeaderExt)
  selectView :: BlockConfig (SimplePBftBlock c PBftMockCrypto)
-> Header (SimplePBftBlock c PBftMockCrypto)
-> SelectView (BlockProtocol (SimplePBftBlock c PBftMockCrypto))
selectView BlockConfig (SimplePBftBlock c PBftMockCrypto)
_ = Header (SimplePBftBlock c PBftMockCrypto)
-> SelectView (BlockProtocol (SimplePBftBlock c PBftMockCrypto))
Header (SimplePBftBlock c PBftMockCrypto) -> PBftSelectView
forall blk. GetHeader blk => Header blk -> PBftSelectView
mkPBftSelectView

-- | The ledger view is constant for the mock instantiation of PBFT
-- (mock blocks cannot change delegation)
instance
  ( SimpleCrypto c
  , Signable MockDSIGN (SignedSimplePBft c PBftMockCrypto)
  ) =>
  LedgerSupportsProtocol (SimplePBftBlock c PBftMockCrypto)
  where
  protocolLedgerView :: forall (mk :: * -> * -> *).
LedgerConfig (SimplePBftBlock c PBftMockCrypto)
-> Ticked (LedgerState (SimplePBftBlock c PBftMockCrypto)) mk
-> LedgerView (BlockProtocol (SimplePBftBlock c PBftMockCrypto))
protocolLedgerView LedgerConfig (SimplePBftBlock c PBftMockCrypto)
cfg Ticked (LedgerState (SimplePBftBlock c PBftMockCrypto)) mk
_ = SimpleLedgerConfig c (SimplePBftExt c PBftMockCrypto)
-> MockLedgerConfig c (SimplePBftExt c PBftMockCrypto)
forall c ext. SimpleLedgerConfig c ext -> MockLedgerConfig c ext
simpleMockLedgerConfig LedgerConfig (SimplePBftBlock c PBftMockCrypto)
SimpleLedgerConfig c (SimplePBftExt c PBftMockCrypto)
cfg
  ledgerViewForecastAt :: forall (mk :: * -> * -> *).
HasCallStack =>
LedgerConfig (SimplePBftBlock c PBftMockCrypto)
-> LedgerState (SimplePBftBlock c PBftMockCrypto) mk
-> Forecast
     (LedgerView (BlockProtocol (SimplePBftBlock c PBftMockCrypto)))
ledgerViewForecastAt LedgerConfig (SimplePBftBlock c PBftMockCrypto)
cfg LedgerState (SimplePBftBlock c PBftMockCrypto) mk
st =
    PBftLedgerView PBftMockCrypto
-> WithOrigin SlotNo -> Forecast (PBftLedgerView PBftMockCrypto)
forall a. a -> WithOrigin SlotNo -> Forecast a
constantForecastOf
      (SimpleLedgerConfig c (SimplePBftExt c PBftMockCrypto)
-> MockLedgerConfig c (SimplePBftExt c PBftMockCrypto)
forall c ext. SimpleLedgerConfig c ext -> MockLedgerConfig c ext
simpleMockLedgerConfig LedgerConfig (SimplePBftBlock c PBftMockCrypto)
SimpleLedgerConfig c (SimplePBftExt c PBftMockCrypto)
cfg)
      (LedgerState (SimplePBftBlock c PBftMockCrypto) mk
-> WithOrigin SlotNo
forall (l :: (* -> * -> *) -> *) (mk :: * -> * -> *).
GetTip l =>
l mk -> WithOrigin SlotNo
getTipSlot LedgerState (SimplePBftBlock c PBftMockCrypto) mk
st)

{-------------------------------------------------------------------------------
  Forging
-------------------------------------------------------------------------------}

type instance CannotForge (SimplePBftBlock c c') = PBftCannotForge c'

type instance ForgeStateInfo (SimplePBftBlock c c') = ()

type instance ForgeStateUpdateError (SimplePBftBlock c c') = Void

forgePBftExt ::
  forall c c'.
  ( SimpleCrypto c
  , PBftCrypto c'
  , Signable (PBftDSIGN c') (SignedSimplePBft c c')
  , ContextDSIGN (PBftDSIGN c') ~ ()
  ) =>
  ForgeExt c (SimplePBftExt c c')
forgePBftExt :: forall c c'.
(SimpleCrypto c, PBftCrypto c',
 Signable (PBftDSIGN c') (SignedSimplePBft c c'),
 ContextDSIGN (PBftDSIGN c') ~ ()) =>
ForgeExt c (SimplePBftExt c c')
forgePBftExt = (TopLevelConfig (SimpleBlock c (SimplePBftExt c c'))
 -> IsLeader (BlockProtocol (SimpleBlock c (SimplePBftExt c c')))
 -> SimpleBlock' c (SimplePBftExt c c') ()
 -> SimpleBlock c (SimplePBftExt c c'))
-> ForgeExt c (SimplePBftExt c c')
forall c ext.
(TopLevelConfig (SimpleBlock c ext)
 -> IsLeader (BlockProtocol (SimpleBlock c ext))
 -> SimpleBlock' c ext ()
 -> SimpleBlock c ext)
-> ForgeExt c ext
ForgeExt ((TopLevelConfig (SimpleBlock c (SimplePBftExt c c'))
  -> IsLeader (BlockProtocol (SimpleBlock c (SimplePBftExt c c')))
  -> SimpleBlock' c (SimplePBftExt c c') ()
  -> SimpleBlock c (SimplePBftExt c c'))
 -> ForgeExt c (SimplePBftExt c c'))
-> (TopLevelConfig (SimpleBlock c (SimplePBftExt c c'))
    -> IsLeader (BlockProtocol (SimpleBlock c (SimplePBftExt c c')))
    -> SimpleBlock' c (SimplePBftExt c c') ()
    -> SimpleBlock c (SimplePBftExt c c'))
-> ForgeExt c (SimplePBftExt c c')
forall a b. (a -> b) -> a -> b
$ \TopLevelConfig (SimpleBlock c (SimplePBftExt c c'))
_cfg IsLeader (BlockProtocol (SimpleBlock c (SimplePBftExt c c')))
isLeader SimpleBlock{Header (SimpleBlock' c (SimplePBftExt c c') ())
SimpleBody
simpleHeader :: forall c ext ext'.
SimpleBlock' c ext ext' -> Header (SimpleBlock' c ext ext')
simpleHeader :: Header (SimpleBlock' c (SimplePBftExt c c') ())
simpleBody :: SimpleBody
simpleBody :: forall c ext ext'. SimpleBlock' c ext ext' -> SimpleBody
..} ->
  let SimpleHeader{()
HeaderHash (SimpleBlock' c (SimplePBftExt c c') ())
SimpleStdHeader c (SimplePBftExt c c')
simpleHeaderStd :: forall c ext ext'.
Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext
simpleHeaderExt :: forall c ext ext'. Header (SimpleBlock' c ext ext') -> ext'
simpleHeaderHash :: HeaderHash (SimpleBlock' c (SimplePBftExt c c') ())
simpleHeaderStd :: SimpleStdHeader c (SimplePBftExt c c')
simpleHeaderExt :: ()
simpleHeaderHash :: forall c ext ext'.
Header (SimpleBlock' c ext ext')
-> HeaderHash (SimpleBlock' c ext ext')
..} = Header (SimpleBlock' c (SimplePBftExt c c') ())
simpleHeader
      ext :: SimplePBftExt c c'
      ext :: SimplePBftExt c c'
ext =
        PBftFields c' (SignedSimplePBft c c') -> SimplePBftExt c c'
forall c c'.
PBftFields c' (SignedSimplePBft c c') -> SimplePBftExt c c'
SimplePBftExt (PBftFields c' (SignedSimplePBft c c') -> SimplePBftExt c c')
-> PBftFields c' (SignedSimplePBft c c') -> SimplePBftExt c c'
forall a b. (a -> b) -> a -> b
$
          (VerKeyDSIGN (PBftDSIGN c') -> ContextDSIGN (PBftDSIGN c'))
-> IsLeader (PBft c')
-> SignedSimplePBft c c'
-> PBftFields c' (SignedSimplePBft c c')
forall c toSign.
(PBftCrypto c, Signable (PBftDSIGN c) toSign) =>
(VerKeyDSIGN (PBftDSIGN c) -> ContextDSIGN (PBftDSIGN c))
-> IsLeader (PBft c) -> toSign -> PBftFields c toSign
forgePBftFields
            (() -> VerKeyDSIGN (PBftDSIGN c') -> ()
forall a b. a -> b -> a
const ())
            IsLeader (BlockProtocol (SimpleBlock c (SimplePBftExt c c')))
IsLeader (PBft c')
isLeader
            SignedSimplePBft{signedSimplePBft :: SimpleStdHeader c (SimplePBftExt c c')
signedSimplePBft = SimpleStdHeader c (SimplePBftExt c c')
simpleHeaderStd}
   in SimpleBlock
        { simpleHeader :: Header (SimpleBlock c (SimplePBftExt c c'))
simpleHeader = (SimplePBftExt c c' -> Encoding)
-> SimpleStdHeader c (SimplePBftExt c c')
-> SimplePBftExt c c'
-> Header (SimpleBlock c (SimplePBftExt c c'))
forall c ext' ext.
SimpleCrypto c =>
(ext' -> Encoding)
-> SimpleStdHeader c ext
-> ext'
-> Header (SimpleBlock' c ext ext')
mkSimpleHeader SimplePBftExt c c' -> Encoding
forall a. Serialise a => a -> Encoding
encode SimpleStdHeader c (SimplePBftExt c c')
simpleHeaderStd SimplePBftExt c c'
ext
        , simpleBody :: SimpleBody
simpleBody = SimpleBody
simpleBody
        }

{-------------------------------------------------------------------------------
  Serialisation
-------------------------------------------------------------------------------}

instance PBftCrypto c' => Serialise (SimplePBftExt c c') where
  encode :: SimplePBftExt c c' -> Encoding
encode (SimplePBftExt PBftFields{SignedDSIGN (PBftDSIGN c') (SignedSimplePBft c c')
VerKeyDSIGN (PBftDSIGN c')
pbftIssuer :: VerKeyDSIGN (PBftDSIGN c')
pbftGenKey :: VerKeyDSIGN (PBftDSIGN c')
pbftSignature :: SignedDSIGN (PBftDSIGN c') (SignedSimplePBft c c')
pbftSignature :: forall c toSign.
PBftFields c toSign -> SignedDSIGN (PBftDSIGN c) toSign
pbftGenKey :: forall c toSign. PBftFields c toSign -> VerKeyDSIGN (PBftDSIGN c)
pbftIssuer :: forall c toSign. PBftFields c toSign -> VerKeyDSIGN (PBftDSIGN c)
..}) =
    [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
      [ VerKeyDSIGN (PBftDSIGN c') -> Encoding
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN VerKeyDSIGN (PBftDSIGN c')
pbftIssuer
      , VerKeyDSIGN (PBftDSIGN c') -> Encoding
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN VerKeyDSIGN (PBftDSIGN c')
pbftGenKey
      , SignedDSIGN (PBftDSIGN c') (SignedSimplePBft c c') -> Encoding
forall v a. DSIGNAlgorithm v => SignedDSIGN v a -> Encoding
encodeSignedDSIGN SignedDSIGN (PBftDSIGN c') (SignedSimplePBft c c')
pbftSignature
      ]
  decode :: forall s. Decoder s (SimplePBftExt c c')
decode = do
    pbftIssuer <- Decoder s (VerKeyDSIGN (PBftDSIGN c'))
forall v s. DSIGNAlgorithm v => Decoder s (VerKeyDSIGN v)
decodeVerKeyDSIGN
    pbftGenKey <- decodeVerKeyDSIGN
    pbftSignature <- decodeSignedDSIGN
    return $ SimplePBftExt PBftFields{..}

instance SimpleCrypto c => Serialise (SignedSimplePBft c c')
instance SimpleCrypto c => SignableRepresentation (SignedSimplePBft c c') where
  getSignableRepresentation :: SignedSimplePBft c c' -> ByteString
getSignableRepresentation = LazyByteString -> ByteString
BSL.toStrict (LazyByteString -> ByteString)
-> (SignedSimplePBft c c' -> LazyByteString)
-> SignedSimplePBft c c'
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedSimplePBft c c' -> LazyByteString
forall a. Serialise a => a -> LazyByteString
serialise

instance (Typeable c', SimpleCrypto c) => ToCBOR (SignedSimplePBft c c') where
  toCBOR :: SignedSimplePBft c c' -> Encoding
toCBOR = SignedSimplePBft c c' -> Encoding
forall a. Serialise a => a -> Encoding
encode

instance
  PBftCrypto c' =>
  EncodeDisk (SimplePBftBlock c c') (S.PBftState c')
  where
  encodeDisk :: CodecConfig (SimplePBftBlock c c') -> PBftState c' -> Encoding
encodeDisk = (PBftState c' -> Encoding)
-> CodecConfig (SimplePBftBlock c c') -> PBftState c' -> Encoding
forall a b. a -> b -> a
const PBftState c' -> Encoding
forall c. PBftCrypto c => PBftState c -> Encoding
S.encodePBftState

instance
  PBftCrypto c' =>
  DecodeDisk (SimplePBftBlock c c') (S.PBftState c')
  where
  decodeDisk :: CodecConfig (SimplePBftBlock c c')
-> forall s. Decoder s (PBftState c')
decodeDisk = Decoder s (PBftState c')
-> CodecConfig (SimplePBftBlock c c') -> Decoder s (PBftState c')
forall a b. a -> b -> a
const Decoder s (PBftState c')
forall s. Decoder s (PBftState c')
forall c s. PBftCrypto c => Decoder s (PBftState c)
S.decodePBftState