{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Consensus.MiniProtocol.ObjectDiffusion.PerasVote.Smoke
  ( tests
  , genPerasVoterId
  , genPerasVoteStake
  , genPerasVote
  , genValidatedPerasVote
  ) where

import qualified Cardano.Crypto.DSIGN.Class as SL
import qualified Cardano.Crypto.Seed as SL
import qualified Cardano.Ledger.Keys as SL
import Control.Monad (join)
import Control.Tracer (contramap, nullTracer)
import Data.Data (Typeable)
import qualified Data.Map as Map
import Data.Ratio ((%))
import Data.String (IsString (..))
import Network.TypedProtocol.Driver.Simple (runPeer, runPipelinedPeer)
import Ouroboros.Consensus.Block.SupportsPeras
import Ouroboros.Consensus.BlockchainTime.WallClock.Types
  ( WithArrivalTime (..)
  , forgetArrivalTime
  )
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.API
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.PerasVote
import Ouroboros.Consensus.Storage.PerasVoteDB
  ( AddPerasVoteResult (..)
  , PerasVoteDB
  , PerasVoteTicketNo
  , zeroPerasVoteTicketNo
  )
import qualified Ouroboros.Consensus.Storage.PerasVoteDB as PerasVoteDB
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Network.Block (StandardHash)
import Ouroboros.Network.Protocol.ObjectDiffusion.Codec
import Ouroboros.Network.Protocol.ObjectDiffusion.Inbound
  ( objectDiffusionInboundPeerPipelined
  )
import Ouroboros.Network.Protocol.ObjectDiffusion.Outbound (objectDiffusionOutboundPeer)
import Test.Consensus.MiniProtocol.ObjectDiffusion.Smoke
  ( ListWithUniqueIds (..)
  , WithId
  , genListWithUniqueIds
  , genPointTestBlock
  , genProtocolConstants
  , genWithArrivalTime
  , getId
  , mockSystemTime
  , prop_smoke_object_diffusion
  )
import Test.QuickCheck
import Test.Tasty
import Test.Tasty.QuickCheck (testProperty)
import Test.Util.TestBlock

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"ObjectDiffusion.PerasVote.Smoke"
    [ TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"PerasVoteDiffusion smoke test" Property
prop_smoke
    ]

genPerasVoterId :: Gen PerasVoterId
genPerasVoterId :: Gen PerasVoterId
genPerasVoterId = do
  bytes <- TestName -> ByteString
forall a. IsString a => TestName -> a
fromString (TestName -> ByteString) -> Gen TestName -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Char -> Gen TestName
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
32 Gen Char
forall a. Arbitrary a => Gen a
arbitrary
  let signKey = Seed -> SignKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
SL.genKeyDSIGN (ByteString -> Seed
SL.mkSeedFromBytes ByteString
bytes)
      verKey = SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
SL.deriveVerKeyDSIGN SignKeyDSIGN DSIGN
signKey
      keyHash = VKey kd -> KeyHash kd
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey (VerKeyDSIGN DSIGN -> VKey kd
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey VerKeyDSIGN DSIGN
verKey)
  pure (PerasVoterId keyHash)

genPerasVoteStake :: Gen PerasVoteStake
genPerasVoteStake :: Gen PerasVoteStake
genPerasVoteStake = do
  stake <- (Integer
1 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
%) (Integer -> Ratio Integer) -> Gen Integer -> Gen (Ratio Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
2, Integer
10)
  pure (PerasVoteStake stake)

genPerasVote :: Gen (PerasVote TestBlock)
genPerasVote :: Gen (PerasVote TestBlock)
genPerasVote = do
  pvVoteRound <- Word64 -> PerasRoundNo
PerasRoundNo (Word64 -> PerasRoundNo) -> Gen Word64 -> Gen PerasRoundNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
  pvVoteBlock <- genPointTestBlock
  pvVoteVoterId <- genPerasVoterId
  pure $ PerasVote{pvVoteRound, pvVoteBlock, pvVoteVoterId}

instance WithId (PerasVote blk) (PerasVoteId blk) where
  getId :: PerasVote blk -> PerasVoteId blk
getId = PerasVote blk -> PerasVoteId blk
forall vote blk. HasPerasVoteId vote blk => vote -> PerasVoteId blk
getPerasVoteId

instance WithId (WithArrivalTime (ValidatedPerasVote blk)) (PerasVoteId blk) where
  getId :: WithArrivalTime (ValidatedPerasVote blk) -> PerasVoteId blk
getId = PerasVote blk -> PerasVoteId blk
forall vote blk. HasPerasVoteId vote blk => vote -> PerasVoteId blk
getPerasVoteId (PerasVote blk -> PerasVoteId blk)
-> (WithArrivalTime (ValidatedPerasVote blk) -> PerasVote blk)
-> WithArrivalTime (ValidatedPerasVote blk)
-> PerasVoteId blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidatedPerasVote blk -> PerasVote blk
forall blk. ValidatedPerasVote blk -> PerasVote blk
vpvVote (ValidatedPerasVote blk -> PerasVote blk)
-> (WithArrivalTime (ValidatedPerasVote blk)
    -> ValidatedPerasVote blk)
-> WithArrivalTime (ValidatedPerasVote blk)
-> PerasVote blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithArrivalTime (ValidatedPerasVote blk) -> ValidatedPerasVote blk
forall a. WithArrivalTime a -> a
forgetArrivalTime

genValidatedPerasVote :: Gen (ValidatedPerasVote TestBlock)
genValidatedPerasVote :: Gen (ValidatedPerasVote TestBlock)
genValidatedPerasVote =
  PerasVote TestBlock
-> PerasVoteStake -> ValidatedPerasVote TestBlock
forall blk.
PerasVote blk -> PerasVoteStake -> ValidatedPerasVote blk
ValidatedPerasVote
    (PerasVote TestBlock
 -> PerasVoteStake -> ValidatedPerasVote TestBlock)
-> Gen (PerasVote TestBlock)
-> Gen (PerasVoteStake -> ValidatedPerasVote TestBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PerasVote TestBlock)
genPerasVote
    Gen (PerasVoteStake -> ValidatedPerasVote TestBlock)
-> Gen PerasVoteStake -> Gen (ValidatedPerasVote TestBlock)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PerasVoteStake
genPerasVoteStake

newVoteDB ::
  (IOLike m, StandardHash blk, Typeable blk) =>
  [WithArrivalTime (ValidatedPerasVote blk)] -> m (PerasVoteDB m blk)
newVoteDB :: forall (m :: * -> *) blk.
(IOLike m, StandardHash blk, Typeable blk) =>
[WithArrivalTime (ValidatedPerasVote blk)] -> m (PerasVoteDB m blk)
newVoteDB [WithArrivalTime (ValidatedPerasVote blk)]
votes = do
  db <- Complete PerasVoteDbArgs m blk -> m (PerasVoteDB m blk)
forall (m :: * -> *) blk.
(IOLike m, StandardHash blk, Typeable blk) =>
Complete PerasVoteDbArgs m blk -> m (PerasVoteDB m blk)
PerasVoteDB.createDB (Tracer m (TraceEvent blk)
-> HKD Identity (PerasCfg blk) -> Complete PerasVoteDbArgs m blk
forall (f :: * -> *) (m :: * -> *) blk.
Tracer m (TraceEvent blk)
-> HKD f (PerasCfg blk) -> PerasVoteDbArgs f m blk
PerasVoteDB.PerasVoteDbArgs Tracer m (TraceEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer HKD Identity (PerasCfg blk)
PerasParams
mkPerasParams)
  mapM_
    ( \WithArrivalTime (ValidatedPerasVote blk)
vote -> do
        result <- m (m (AddPerasVoteResult blk)) -> m (AddPerasVoteResult blk)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m (AddPerasVoteResult blk)) -> m (AddPerasVoteResult blk))
-> m (m (AddPerasVoteResult blk)) -> m (AddPerasVoteResult blk)
forall a b. (a -> b) -> a -> b
$ STM m (m (AddPerasVoteResult blk))
-> m (m (AddPerasVoteResult blk))
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (m (AddPerasVoteResult blk))
 -> m (m (AddPerasVoteResult blk)))
-> STM m (m (AddPerasVoteResult blk))
-> m (m (AddPerasVoteResult blk))
forall a b. (a -> b) -> a -> b
$ PerasVoteDB m blk
-> WithArrivalTime (ValidatedPerasVote blk)
-> STM m (m (AddPerasVoteResult blk))
forall (m :: * -> *) blk.
PerasVoteDB m blk
-> WithArrivalTime (ValidatedPerasVote blk)
-> STM m (m (AddPerasVoteResult blk))
PerasVoteDB.addVote PerasVoteDB m blk
db WithArrivalTime (ValidatedPerasVote blk)
vote
        case result of
          AddPerasVoteResult blk
PerasVoteAlreadyInDB -> IOError -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (TestName -> IOError
userError TestName
"Expected AddedPerasVote..., but vote was already in DB")
          AddPerasVoteResult blk
AddedPerasVoteButDidntGenerateNewCert -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          AddedPerasVoteAndGeneratedNewCert ValidatedPerasCert blk
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    )
    votes
  pure db

prop_smoke :: Property
prop_smoke :: Property
prop_smoke =
  Gen ProtocolConstants
-> (ProtocolConstants -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen ProtocolConstants
genProtocolConstants ((ProtocolConstants -> Property) -> Property)
-> (ProtocolConstants -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ProtocolConstants
protocolConstants ->
    Gen
  (ListWithUniqueIds
     (WithArrivalTime (ValidatedPerasVote TestBlock))
     (PerasVoteId TestBlock))
-> (ListWithUniqueIds
      (WithArrivalTime (ValidatedPerasVote TestBlock))
      (PerasVoteId TestBlock)
    -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Gen (WithArrivalTime (ValidatedPerasVote TestBlock))
-> Gen
     (ListWithUniqueIds
        (WithArrivalTime (ValidatedPerasVote TestBlock))
        (PerasVoteId TestBlock))
forall idTy a.
(Ord idTy, WithId a idTy) =>
Gen a -> Gen (ListWithUniqueIds a idTy)
genListWithUniqueIds (Gen (ValidatedPerasVote TestBlock)
-> Gen (WithArrivalTime (ValidatedPerasVote TestBlock))
forall a. Gen a -> Gen (WithArrivalTime a)
genWithArrivalTime Gen (ValidatedPerasVote TestBlock)
genValidatedPerasVote)) ((ListWithUniqueIds
    (WithArrivalTime (ValidatedPerasVote TestBlock))
    (PerasVoteId TestBlock)
  -> Property)
 -> Property)
-> (ListWithUniqueIds
      (WithArrivalTime (ValidatedPerasVote TestBlock))
      (PerasVoteId TestBlock)
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$
      \(ListWithUniqueIds [WithArrivalTime (ValidatedPerasVote TestBlock)]
watValidatedVotes) ->
        let
          mkPoolInterfaces ::
            forall m.
            IOLike m =>
            m
              ( ObjectPoolReader (PerasVoteId TestBlock) (PerasVote TestBlock) PerasVoteTicketNo m
              , ObjectPoolWriter (PerasVoteId TestBlock) (PerasVote TestBlock) m
              , m [PerasVote TestBlock]
              )
          mkPoolInterfaces :: forall (m :: * -> *).
IOLike m =>
m (ObjectPoolReader
     (PerasVoteId TestBlock) (PerasVote TestBlock) PerasVoteTicketNo m,
   ObjectPoolWriter (PerasVoteId TestBlock) (PerasVote TestBlock) m,
   m [PerasVote TestBlock])
mkPoolInterfaces = do
            outboundPool <- [WithArrivalTime (ValidatedPerasVote TestBlock)]
-> m (PerasVoteDB m TestBlock)
forall (m :: * -> *) blk.
(IOLike m, StandardHash blk, Typeable blk) =>
[WithArrivalTime (ValidatedPerasVote blk)] -> m (PerasVoteDB m blk)
newVoteDB [WithArrivalTime (ValidatedPerasVote TestBlock)]
watValidatedVotes
            inboundPool <- newVoteDB []

            let outboundPoolReader = PerasVoteDB m TestBlock
-> ObjectPoolReader
     (PerasVoteId TestBlock) (PerasVote TestBlock) PerasVoteTicketNo m
forall (m :: * -> *) blk.
IOLike m =>
PerasVoteDB m blk
-> ObjectPoolReader
     (PerasVoteId blk) (PerasVote blk) PerasVoteTicketNo m
makePerasVotePoolReaderFromVoteDB PerasVoteDB m TestBlock
outboundPool
                stakeDistr =
                  Map PerasVoterId PerasVoteStake -> PerasVoteStakeDistr
PerasVoteStakeDistr (Map PerasVoterId PerasVoteStake -> PerasVoteStakeDistr)
-> Map PerasVoterId PerasVoteStake -> PerasVoteStakeDistr
forall a b. (a -> b) -> a -> b
$
                    [(PerasVoterId, PerasVoteStake)] -> Map PerasVoterId PerasVoteStake
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                      [ (PerasVote TestBlock -> PerasVoterId
forall blk. PerasVote blk -> PerasVoterId
pvVoteVoterId (ValidatedPerasVote TestBlock -> PerasVote TestBlock
forall blk. ValidatedPerasVote blk -> PerasVote blk
vpvVote ValidatedPerasVote TestBlock
v), ValidatedPerasVote TestBlock -> PerasVoteStake
forall blk. ValidatedPerasVote blk -> PerasVoteStake
vpvVoteStake ValidatedPerasVote TestBlock
v)
                      | WithArrivalTime RelativeTime
_ ValidatedPerasVote TestBlock
v <- [WithArrivalTime (ValidatedPerasVote TestBlock)]
watValidatedVotes
                      ]
                inboundPoolWriter =
                  SystemTime m
-> STM m PerasVoteStakeDistr
-> PerasVoteDB m TestBlock
-> ObjectPoolWriter (PerasVoteId TestBlock) (PerasVote TestBlock) m
forall blk (m :: * -> *).
(StandardHash blk, IOLike m) =>
SystemTime m
-> STM m PerasVoteStakeDistr
-> PerasVoteDB m blk
-> ObjectPoolWriter (PerasVoteId blk) (PerasVote blk) m
makePerasVotePoolWriterFromVoteDB
                    SystemTime m
forall (m :: * -> *). Applicative m => SystemTime m
mockSystemTime
                    (PerasVoteStakeDistr -> STM m PerasVoteStakeDistr
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PerasVoteStakeDistr
stakeDistr)
                    PerasVoteDB m TestBlock
inboundPool
                getAllInboundPoolContent = do
                  votesMap <-
                    STM
  m
  (Map
     PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote TestBlock)))
-> m (Map
        PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote TestBlock)))
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM
   m
   (Map
      PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote TestBlock)))
 -> m (Map
         PerasVoteTicketNo
         (WithArrivalTime (ValidatedPerasVote TestBlock))))
-> STM
     m
     (Map
        PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote TestBlock)))
-> m (Map
        PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote TestBlock)))
forall a b. (a -> b) -> a -> b
$
                      PerasVoteDB m TestBlock
-> PerasVoteTicketNo
-> STM
     m
     (Map
        PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote TestBlock)))
forall (m :: * -> *) blk.
PerasVoteDB m blk
-> PerasVoteTicketNo
-> STM
     m
     (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk)))
PerasVoteDB.getVotesAfter PerasVoteDB m TestBlock
inboundPool PerasVoteTicketNo
zeroPerasVoteTicketNo
                  pure $ vpvVote . forgetArrivalTime <$> Map.elems votesMap

            return (outboundPoolReader, inboundPoolWriter, getAllInboundPoolContent)
         in
          ProtocolConstants
-> [PerasVote TestBlock]
-> (forall (m :: * -> *).
    IOLike m =>
    ObjectDiffusionOutbound
      (PerasVoteId TestBlock) (PerasVote TestBlock) m ()
    -> Channel
         m
         (AnyMessage
            (ObjectDiffusion (PerasVoteId TestBlock) (PerasVote TestBlock)))
    -> Tracer m TestName
    -> m ())
-> (forall (m :: * -> *).
    IOLike m =>
    ObjectDiffusionInboundPipelined
      (PerasVoteId TestBlock) (PerasVote TestBlock) m ()
    -> Channel
         m
         (AnyMessage
            (ObjectDiffusion (PerasVoteId TestBlock) (PerasVote TestBlock)))
    -> Tracer m TestName
    -> m ())
-> (forall (m :: * -> *).
    IOLike m =>
    m (ObjectPoolReader
         (PerasVoteId TestBlock) (PerasVote TestBlock) PerasVoteTicketNo m,
       ObjectPoolWriter (PerasVoteId TestBlock) (PerasVote TestBlock) m,
       m [PerasVote TestBlock]))
-> Property
forall object objectId ticketNo.
(Eq object, Show object, Ord objectId, Typeable objectId,
 Typeable object, NoThunks objectId, Show objectId,
 NoThunks object) =>
ProtocolConstants
-> [object]
-> (forall (m :: * -> *).
    IOLike m =>
    ObjectDiffusionOutbound objectId object m ()
    -> Channel m (AnyMessage (ObjectDiffusion objectId object))
    -> Tracer m TestName
    -> m ())
-> (forall (m :: * -> *).
    IOLike m =>
    ObjectDiffusionInboundPipelined objectId object m ()
    -> Channel m (AnyMessage (ObjectDiffusion objectId object))
    -> Tracer m TestName
    -> m ())
-> (forall (m :: * -> *).
    IOLike m =>
    m (ObjectPoolReader objectId object ticketNo m,
       ObjectPoolWriter objectId object m, m [object]))
-> Property
prop_smoke_object_diffusion
            ProtocolConstants
protocolConstants
            ((WithArrivalTime (ValidatedPerasVote TestBlock)
 -> PerasVote TestBlock)
-> [WithArrivalTime (ValidatedPerasVote TestBlock)]
-> [PerasVote TestBlock]
forall a b. (a -> b) -> [a] -> [b]
map (ValidatedPerasVote TestBlock -> PerasVote TestBlock
forall blk. ValidatedPerasVote blk -> PerasVote blk
vpvVote (ValidatedPerasVote TestBlock -> PerasVote TestBlock)
-> (WithArrivalTime (ValidatedPerasVote TestBlock)
    -> ValidatedPerasVote TestBlock)
-> WithArrivalTime (ValidatedPerasVote TestBlock)
-> PerasVote TestBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithArrivalTime (ValidatedPerasVote TestBlock)
-> ValidatedPerasVote TestBlock
forall a. WithArrivalTime a -> a
forgetArrivalTime) [WithArrivalTime (ValidatedPerasVote TestBlock)]
watValidatedVotes)
            ObjectDiffusionOutbound
  (PerasVoteId TestBlock) (PerasVote TestBlock) m ()
-> Channel
     m
     (AnyMessage
        (ObjectDiffusion (PerasVoteId TestBlock) (PerasVote TestBlock)))
-> Tracer m TestName
-> m ()
forall (m :: * -> *).
IOLike m =>
ObjectDiffusionOutbound
  (PerasVoteId TestBlock) (PerasVote TestBlock) m ()
-> Channel
     m
     (AnyMessage
        (ObjectDiffusion (PerasVoteId TestBlock) (PerasVote TestBlock)))
-> Tracer m TestName
-> m ()
forall {m :: * -> *} {a} {objectId} {object}.
(MonadEvaluate m, MonadThrow m, NFData a, Show objectId,
 Show object) =>
ObjectDiffusionOutbound objectId object m a
-> Channel m (AnyMessage (ObjectDiffusion objectId object))
-> Tracer m TestName
-> m ()
runOutboundPeer
            ObjectDiffusionInboundPipelined
  (PerasVoteId TestBlock) (PerasVote TestBlock) m ()
-> Channel
     m
     (AnyMessage
        (ObjectDiffusion (PerasVoteId TestBlock) (PerasVote TestBlock)))
-> Tracer m TestName
-> m ()
forall (m :: * -> *).
IOLike m =>
ObjectDiffusionInboundPipelined
  (PerasVoteId TestBlock) (PerasVote TestBlock) m ()
-> Channel
     m
     (AnyMessage
        (ObjectDiffusion (PerasVoteId TestBlock) (PerasVote TestBlock)))
-> Tracer m TestName
-> m ()
forall {m :: * -> *} {a} {objectId} {object}.
(MonadAsync m, MonadEvaluate m, MonadThrow m, NFData a,
 Show objectId, Show object) =>
ObjectDiffusionInboundPipelined objectId object m a
-> Channel m (AnyMessage (ObjectDiffusion objectId object))
-> Tracer m TestName
-> m ()
runInboundPeer
            m (ObjectPoolReader
     (PerasVoteId TestBlock) (PerasVote TestBlock) PerasVoteTicketNo m,
   ObjectPoolWriter (PerasVoteId TestBlock) (PerasVote TestBlock) m,
   m [PerasVote TestBlock])
forall (m :: * -> *).
IOLike m =>
m (ObjectPoolReader
     (PerasVoteId TestBlock) (PerasVote TestBlock) PerasVoteTicketNo m,
   ObjectPoolWriter (PerasVoteId TestBlock) (PerasVote TestBlock) m,
   m [PerasVote TestBlock])
mkPoolInterfaces
 where
  runOutboundPeer :: ObjectDiffusionOutbound objectId object m a
-> Channel m (AnyMessage (ObjectDiffusion objectId object))
-> Tracer m TestName
-> m ()
runOutboundPeer ObjectDiffusionOutbound objectId object m a
outbound Channel m (AnyMessage (ObjectDiffusion objectId object))
outboundChannel Tracer m TestName
tracer =
    Tracer m (TraceSendRecv (ObjectDiffusion objectId object))
-> Codec
     (ObjectDiffusion objectId object)
     CodecFailure
     m
     (AnyMessage (ObjectDiffusion objectId object))
-> Channel m (AnyMessage (ObjectDiffusion objectId object))
-> Peer
     (ObjectDiffusion objectId object)
     'AsServer
     'NonPipelined
     'StInit
     m
     a
-> m (a, Maybe (AnyMessage (ObjectDiffusion objectId object)))
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadEvaluate m, MonadThrow m, Exception failure, NFData failure,
 NFData a) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeer
      ((\TraceSendRecv (ObjectDiffusion objectId object)
x -> TestName
"Outbound (Client): " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TraceSendRecv (ObjectDiffusion objectId object) -> TestName
forall a. Show a => a -> TestName
show TraceSendRecv (ObjectDiffusion objectId object)
x) (TraceSendRecv (ObjectDiffusion objectId object) -> TestName)
-> Tracer m TestName
-> Tracer m (TraceSendRecv (ObjectDiffusion objectId object))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer m TestName
tracer)
      Codec
  (ObjectDiffusion objectId object)
  CodecFailure
  m
  (AnyMessage (ObjectDiffusion objectId object))
forall objectId object (m :: * -> *).
Monad m =>
Codec
  (ObjectDiffusion objectId object)
  CodecFailure
  m
  (AnyMessage (ObjectDiffusion objectId object))
codecObjectDiffusionId
      Channel m (AnyMessage (ObjectDiffusion objectId object))
outboundChannel
      (ObjectDiffusionOutbound objectId object m a
-> Peer
     (ObjectDiffusion objectId object)
     'AsServer
     'NonPipelined
     'StInit
     m
     a
forall objectId object (m :: * -> *) a.
Monad m =>
ObjectDiffusionOutbound objectId object m a
-> Peer
     (ObjectDiffusion objectId object)
     'AsServer
     'NonPipelined
     'StInit
     m
     a
objectDiffusionOutboundPeer ObjectDiffusionOutbound objectId object m a
outbound)
      m (a, Maybe (AnyMessage (ObjectDiffusion objectId object)))
-> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  runInboundPeer :: ObjectDiffusionInboundPipelined objectId object m a
-> Channel m (AnyMessage (ObjectDiffusion objectId object))
-> Tracer m TestName
-> m ()
runInboundPeer ObjectDiffusionInboundPipelined objectId object m a
inbound Channel m (AnyMessage (ObjectDiffusion objectId object))
inboundChannel Tracer m TestName
tracer =
    Tracer m (TraceSendRecv (ObjectDiffusion objectId object))
-> Codec
     (ObjectDiffusion objectId object)
     CodecFailure
     m
     (AnyMessage (ObjectDiffusion objectId object))
-> Channel m (AnyMessage (ObjectDiffusion objectId object))
-> PeerPipelined
     (ObjectDiffusion objectId object) 'AsClient 'StInit m a
-> m (a, Maybe (AnyMessage (ObjectDiffusion objectId object)))
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadThrow m, Exception failure,
 NFData failure, NFData a) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
runPipelinedPeer
      ((\TraceSendRecv (ObjectDiffusion objectId object)
x -> TestName
"Inbound (Server): " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TraceSendRecv (ObjectDiffusion objectId object) -> TestName
forall a. Show a => a -> TestName
show TraceSendRecv (ObjectDiffusion objectId object)
x) (TraceSendRecv (ObjectDiffusion objectId object) -> TestName)
-> Tracer m TestName
-> Tracer m (TraceSendRecv (ObjectDiffusion objectId object))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer m TestName
tracer)
      Codec
  (ObjectDiffusion objectId object)
  CodecFailure
  m
  (AnyMessage (ObjectDiffusion objectId object))
forall objectId object (m :: * -> *).
Monad m =>
Codec
  (ObjectDiffusion objectId object)
  CodecFailure
  m
  (AnyMessage (ObjectDiffusion objectId object))
codecObjectDiffusionId
      Channel m (AnyMessage (ObjectDiffusion objectId object))
inboundChannel
      (ObjectDiffusionInboundPipelined objectId object m a
-> PeerPipelined
     (ObjectDiffusion objectId object) 'AsClient 'StInit m a
forall objectId object (m :: * -> *) a.
Functor m =>
ObjectDiffusionInboundPipelined objectId object m a
-> PeerPipelined
     (ObjectDiffusion objectId object) 'AsClient 'StInit m a
objectDiffusionInboundPeerPipelined ObjectDiffusionInboundPipelined objectId object m a
inbound)
      m (a, Maybe (AnyMessage (ObjectDiffusion objectId object)))
-> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()