{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Consensus.MiniProtocol.ObjectDiffusion.PerasVote.Smoke
  ( tests
  ) where

import Control.Monad (join)
import Control.Tracer (contramap, nullTracer)
import Data.Data (Typeable)
import qualified Data.Map as Map
import Data.Ratio ((%))
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
  ( genProtocolConstants
  , prop_smoke_object_diffusion
  )
import Test.QuickCheck
import Test.Tasty
import Test.Tasty.QuickCheck (testProperty)
import Test.Util.Peras
  ( ListWithUniqueIds (..)
  , genListWithUniqueIds
  , genPointTestBlock
  , genRoundNo
  , genSeatIndex
  , genWithArrivalTime
  , mockSystemTime
  )
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
    ]

genValidatedPerasVote :: Gen (ValidatedPerasVote TestBlock)
genValidatedPerasVote :: Gen (ValidatedPerasVote TestBlock)
genValidatedPerasVote =
  PerasVote TestBlock -> VoteWeight -> ValidatedPerasVote TestBlock
PerasVote' TestBlock -> VoteWeight -> ValidatedPerasVote TestBlock
forall blk. PerasVote blk -> VoteWeight -> ValidatedPerasVote blk
ValidatedPerasVote
    (PerasVote' TestBlock
 -> VoteWeight -> ValidatedPerasVote TestBlock)
-> Gen (PerasVote' TestBlock)
-> Gen (VoteWeight -> ValidatedPerasVote TestBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PerasVote' TestBlock)
genPerasVote
    Gen (VoteWeight -> ValidatedPerasVote TestBlock)
-> Gen VoteWeight -> 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 VoteWeight
genVoteWeight
 where
  genPerasVote :: Gen (PerasVote' TestBlock)
genPerasVote =
    PerasRoundNo
-> Point TestBlock -> PerasSeatIndex -> PerasVote' TestBlock
forall blk.
PerasRoundNo -> Point blk -> PerasSeatIndex -> PerasVote' blk
PerasVote
      (PerasRoundNo
 -> Point TestBlock -> PerasSeatIndex -> PerasVote' TestBlock)
-> Gen PerasRoundNo
-> Gen (Point TestBlock -> PerasSeatIndex -> PerasVote' TestBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PerasRoundNo
genRoundNo
      Gen (Point TestBlock -> PerasSeatIndex -> PerasVote' TestBlock)
-> Gen (Point TestBlock)
-> Gen (PerasSeatIndex -> PerasVote' 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 (Point TestBlock)
genPointTestBlock
      Gen (PerasSeatIndex -> PerasVote' TestBlock)
-> Gen PerasSeatIndex -> Gen (PerasVote' 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 PerasSeatIndex
genSeatIndex
  genVoteWeight :: Gen VoteWeight
genVoteWeight =
    Rational -> VoteWeight
VoteWeight (Rational -> VoteWeight)
-> (Integer -> Rational) -> Integer -> VoteWeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%)
      (Integer -> VoteWeight) -> Gen Integer -> Gen VoteWeight
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
1, Integer
100)

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 (PerasParams blk) -> Complete PerasVoteDbArgs m blk
forall (f :: * -> *) (m :: * -> *) blk.
Tracer m (TraceEvent blk)
-> HKD f (PerasParams blk) -> PerasVoteDbArgs f m blk
PerasVoteDB.PerasVoteDbArgs Tracer m (TraceEvent blk)
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer HKD Identity (PerasParams blk)
PerasParams blk
forall blk. PerasParams blk
defaultPerasParams)
  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 -> IOException -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (TestName -> IOException
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)))
-> (ListWithUniqueIds
      (WithArrivalTime (ValidatedPerasVote TestBlock))
    -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((WithArrivalTime (ValidatedPerasVote TestBlock) -> PerasRoundNo)
-> Gen (WithArrivalTime (ValidatedPerasVote TestBlock))
-> Gen
     (ListWithUniqueIds
        (WithArrivalTime (ValidatedPerasVote TestBlock)))
forall idTy a.
Ord idTy =>
(a -> idTy) -> Gen a -> Gen (ListWithUniqueIds a)
genListWithUniqueIds WithArrivalTime (ValidatedPerasVote TestBlock) -> PerasRoundNo
forall vote blk. IsPerasVote vote blk => vote -> PerasRoundNo
getPerasVoteRound (Gen (ValidatedPerasVote TestBlock)
-> Gen (WithArrivalTime (ValidatedPerasVote TestBlock))
forall a. Gen a -> Gen (WithArrivalTime a)
genWithArrivalTime Gen (ValidatedPerasVote TestBlock)
genValidatedPerasVote)) ((ListWithUniqueIds
    (WithArrivalTime (ValidatedPerasVote TestBlock))
  -> Property)
 -> Property)
-> (ListWithUniqueIds
      (WithArrivalTime (ValidatedPerasVote TestBlock))
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$
      \(ListWithUniqueIds [WithArrivalTime (ValidatedPerasVote TestBlock)]
watValidatedVotes) ->
        let
          mkPoolInterfaces ::
            IOLike m =>
            m
              ( ObjectPoolReader PerasVoteId (PerasVote TestBlock) PerasVoteTicketNo m
              , ObjectPoolWriter PerasVoteId (PerasVote TestBlock) m
              , m [PerasVote TestBlock]
              )
          mkPoolInterfaces :: forall (m :: * -> *).
IOLike m =>
m (ObjectPoolReader
     PerasVoteId (PerasVote TestBlock) PerasVoteTicketNo m,
   ObjectPoolWriter PerasVoteId (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 (PerasVote TestBlock) PerasVoteTicketNo m
forall (m :: * -> *) blk.
IOLike m =>
PerasVoteDB m blk
-> ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
makePerasVotePoolReaderFromVoteDB PerasVoteDB m TestBlock
outboundPool
                stakeDistr =
                  Map PerasSeatIndex VoteWeight -> PerasVoteStakeDistr
PerasVoteStakeDistr (Map PerasSeatIndex VoteWeight -> PerasVoteStakeDistr)
-> Map PerasSeatIndex VoteWeight -> PerasVoteStakeDistr
forall a b. (a -> b) -> a -> b
$
                    [(PerasSeatIndex, VoteWeight)] -> Map PerasSeatIndex VoteWeight
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                      [ (PerasVote' TestBlock -> PerasSeatIndex
forall blk. PerasVote' blk -> PerasSeatIndex
pvVoteVoterId (ValidatedPerasVote TestBlock -> PerasVote TestBlock
forall blk. ValidatedPerasVote blk -> PerasVote blk
vpvVote ValidatedPerasVote TestBlock
v), ValidatedPerasVote TestBlock -> VoteWeight
forall blk. ValidatedPerasVote blk -> VoteWeight
vpvVoteWeight ValidatedPerasVote TestBlock
v)
                      | WithArrivalTime RelativeTime
_ ValidatedPerasVote TestBlock
v <- [WithArrivalTime (ValidatedPerasVote TestBlock)]
watValidatedVotes
                      ]
                inboundPoolWriter =
                  SystemTime m
-> STM m PerasVoteStakeDistr
-> PerasVoteDB m TestBlock
-> ObjectPoolWriter PerasVoteId (PerasVote TestBlock) m
forall blk (m :: * -> *).
(StandardHash blk, IOLike m) =>
SystemTime m
-> STM m PerasVoteStakeDistr
-> PerasVoteDB m blk
-> ObjectPoolWriter PerasVoteId (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 (PerasVote' TestBlock) m ()
    -> Channel
         m (AnyMessage (ObjectDiffusion PerasVoteId (PerasVote' TestBlock)))
    -> Tracer m TestName
    -> m ())
-> (forall (m :: * -> *).
    IOLike m =>
    ObjectDiffusionInboundPipelined
      PerasVoteId (PerasVote' TestBlock) m ()
    -> Channel
         m (AnyMessage (ObjectDiffusion PerasVoteId (PerasVote' TestBlock)))
    -> Tracer m TestName
    -> m ())
-> (forall (m :: * -> *).
    IOLike m =>
    m (ObjectPoolReader
         PerasVoteId (PerasVote' TestBlock) PerasVoteTicketNo m,
       ObjectPoolWriter PerasVoteId (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
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 (PerasVote' TestBlock) m ()
-> Channel
     m (AnyMessage (ObjectDiffusion PerasVoteId (PerasVote' TestBlock)))
-> Tracer m TestName
-> m ()
forall (m :: * -> *).
IOLike m =>
ObjectDiffusionOutbound PerasVoteId (PerasVote' TestBlock) m ()
-> Channel
     m (AnyMessage (ObjectDiffusion PerasVoteId (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 (PerasVote' TestBlock) m ()
-> Channel
     m (AnyMessage (ObjectDiffusion PerasVoteId (PerasVote' TestBlock)))
-> Tracer m TestName
-> m ()
forall (m :: * -> *).
IOLike m =>
ObjectDiffusionInboundPipelined
  PerasVoteId (PerasVote' TestBlock) m ()
-> Channel
     m (AnyMessage (ObjectDiffusion PerasVoteId (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 (PerasVote TestBlock) PerasVoteTicketNo m,
   ObjectPoolWriter PerasVoteId (PerasVote TestBlock) m,
   m [PerasVote TestBlock])
m (ObjectPoolReader
     PerasVoteId (PerasVote' TestBlock) PerasVoteTicketNo m,
   ObjectPoolWriter PerasVoteId (PerasVote' TestBlock) m,
   m [PerasVote' TestBlock])
forall (m :: * -> *).
IOLike m =>
m (ObjectPoolReader
     PerasVoteId (PerasVote TestBlock) PerasVoteTicketNo m,
   ObjectPoolWriter PerasVoteId (PerasVote TestBlock) m,
   m [PerasVote TestBlock])
forall (m :: * -> *).
IOLike m =>
m (ObjectPoolReader
     PerasVoteId (PerasVote' TestBlock) PerasVoteTicketNo m,
   ObjectPoolWriter PerasVoteId (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 ()