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

module Test.Consensus.MiniProtocol.ObjectDiffusion.PerasCert.Smoke
  ( tests
  , genPerasCert
  , genValidatedPerasCert
  ) where

import Control.Monad (join)
import Control.Tracer (contramap, nullTracer)
import Data.Functor.Identity (Identity (..))
import qualified Data.Map as Map
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.PerasCert
import Ouroboros.Consensus.Storage.PerasCertDB.API
  ( AddPerasCertResult (..)
  , PerasCertDB
  , PerasCertTicketNo
  )
import qualified Ouroboros.Consensus.Storage.PerasCertDB.API as PerasCertDB
import qualified Ouroboros.Consensus.Storage.PerasCertDB.Impl as PerasCertDB
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.PerasCert.Smoke"
    [ TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"PerasCertDiffusion smoke test" Property
prop_smoke
    ]

genPerasCert :: Gen (PerasCert TestBlock)
genPerasCert :: Gen (PerasCert TestBlock)
genPerasCert = do
  pcCertRound <- 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
  pcCertBoostedBlock <- genPointTestBlock
  pure $ PerasCert{pcCertRound, pcCertBoostedBlock}

instance WithId (PerasCert blk) PerasRoundNo where
  getId :: PerasCert blk -> PerasRoundNo
getId = PerasCert blk -> PerasRoundNo
forall blk. PerasCert blk -> PerasRoundNo
pcCertRound

instance WithId (WithArrivalTime (ValidatedPerasCert blk)) PerasRoundNo where
  getId :: WithArrivalTime (ValidatedPerasCert blk) -> PerasRoundNo
getId = PerasCert blk -> PerasRoundNo
forall blk. PerasCert blk -> PerasRoundNo
pcCertRound (PerasCert blk -> PerasRoundNo)
-> (WithArrivalTime (ValidatedPerasCert blk) -> PerasCert blk)
-> WithArrivalTime (ValidatedPerasCert blk)
-> PerasRoundNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidatedPerasCert blk -> PerasCert blk
forall blk. ValidatedPerasCert blk -> PerasCert blk
vpcCert (ValidatedPerasCert blk -> PerasCert blk)
-> (WithArrivalTime (ValidatedPerasCert blk)
    -> ValidatedPerasCert blk)
-> WithArrivalTime (ValidatedPerasCert blk)
-> PerasCert blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithArrivalTime (ValidatedPerasCert blk) -> ValidatedPerasCert blk
forall a. WithArrivalTime a -> a
forgetArrivalTime

genValidatedPerasCert :: Gen (ValidatedPerasCert TestBlock)
genValidatedPerasCert :: Gen (ValidatedPerasCert TestBlock)
genValidatedPerasCert =
  PerasCert TestBlock -> PerasWeight -> ValidatedPerasCert TestBlock
forall blk. PerasCert blk -> PerasWeight -> ValidatedPerasCert blk
ValidatedPerasCert
    (PerasCert TestBlock
 -> PerasWeight -> ValidatedPerasCert TestBlock)
-> Gen (PerasCert TestBlock)
-> Gen (PerasWeight -> ValidatedPerasCert TestBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PerasCert TestBlock)
genPerasCert
    Gen (PerasWeight -> ValidatedPerasCert TestBlock)
-> Gen PerasWeight -> Gen (ValidatedPerasCert TestBlock)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PerasWeight -> Gen PerasWeight
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PerasParams -> PerasWeight
perasWeight PerasParams
mkPerasParams)

newCertDB ::
  (IOLike m, StandardHash blk) => [WithArrivalTime (ValidatedPerasCert blk)] -> m (PerasCertDB m blk)
newCertDB :: forall (m :: * -> *) blk.
(IOLike m, StandardHash blk) =>
[WithArrivalTime (ValidatedPerasCert blk)] -> m (PerasCertDB m blk)
newCertDB [WithArrivalTime (ValidatedPerasCert blk)]
certs = do
  db <- Complete PerasCertDbArgs m blk -> m (PerasCertDB m blk)
forall (m :: * -> *) blk.
(IOLike m, StandardHash blk) =>
Complete PerasCertDbArgs m blk -> m (PerasCertDB m blk)
PerasCertDB.createDB (forall (f :: * -> *) (m :: * -> *) blk.
Tracer m (TraceEvent blk) -> PerasCertDbArgs f m blk
PerasCertDB.PerasCertDbArgs @Identity Tracer m (TraceEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer)
  mapM_
    ( \WithArrivalTime (ValidatedPerasCert blk)
cert -> do
        result <- m (m AddPerasCertResult) -> m AddPerasCertResult
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m AddPerasCertResult) -> m AddPerasCertResult)
-> m (m AddPerasCertResult) -> m AddPerasCertResult
forall a b. (a -> b) -> a -> b
$ STM m (m AddPerasCertResult) -> m (m AddPerasCertResult)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (m AddPerasCertResult) -> m (m AddPerasCertResult))
-> STM m (m AddPerasCertResult) -> m (m AddPerasCertResult)
forall a b. (a -> b) -> a -> b
$ PerasCertDB m blk
-> WithArrivalTime (ValidatedPerasCert blk)
-> STM m (m AddPerasCertResult)
forall (m :: * -> *) blk.
PerasCertDB m blk
-> WithArrivalTime (ValidatedPerasCert blk)
-> STM m (m AddPerasCertResult)
PerasCertDB.addCert PerasCertDB m blk
db WithArrivalTime (ValidatedPerasCert blk)
cert
        case result of
          AddPerasCertResult
AddedPerasCertToDB -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          AddPerasCertResult
PerasCertAlreadyInDB -> 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 AddedPerasCertToDB, but cert was already in DB")
    )
    certs
  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 (ValidatedPerasCert TestBlock)) PerasRoundNo)
-> (ListWithUniqueIds
      (WithArrivalTime (ValidatedPerasCert TestBlock)) PerasRoundNo
    -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Gen (WithArrivalTime (ValidatedPerasCert TestBlock))
-> Gen
     (ListWithUniqueIds
        (WithArrivalTime (ValidatedPerasCert TestBlock)) PerasRoundNo)
forall idTy a.
(Ord idTy, WithId a idTy) =>
Gen a -> Gen (ListWithUniqueIds a idTy)
genListWithUniqueIds (Gen (ValidatedPerasCert TestBlock)
-> Gen (WithArrivalTime (ValidatedPerasCert TestBlock))
forall a. Gen a -> Gen (WithArrivalTime a)
genWithArrivalTime Gen (ValidatedPerasCert TestBlock)
genValidatedPerasCert)) ((ListWithUniqueIds
    (WithArrivalTime (ValidatedPerasCert TestBlock)) PerasRoundNo
  -> Property)
 -> Property)
-> (ListWithUniqueIds
      (WithArrivalTime (ValidatedPerasCert TestBlock)) PerasRoundNo
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$
      \(ListWithUniqueIds [WithArrivalTime (ValidatedPerasCert TestBlock)]
watValidatedCerts) ->
        let
          mkPoolInterfaces ::
            forall m.
            IOLike m =>
            m
              ( ObjectPoolReader PerasRoundNo (PerasCert TestBlock) PerasCertTicketNo m
              , ObjectPoolWriter PerasRoundNo (PerasCert TestBlock) m
              , m [PerasCert TestBlock]
              )
          mkPoolInterfaces :: forall (m :: * -> *).
IOLike m =>
m (ObjectPoolReader
     PerasRoundNo (PerasCert TestBlock) PerasCertTicketNo m,
   ObjectPoolWriter PerasRoundNo (PerasCert TestBlock) m,
   m [PerasCert TestBlock])
mkPoolInterfaces = do
            outboundPool <- [WithArrivalTime (ValidatedPerasCert TestBlock)]
-> m (PerasCertDB m TestBlock)
forall (m :: * -> *) blk.
(IOLike m, StandardHash blk) =>
[WithArrivalTime (ValidatedPerasCert blk)] -> m (PerasCertDB m blk)
newCertDB [WithArrivalTime (ValidatedPerasCert TestBlock)]
watValidatedCerts
            inboundPool <- newCertDB []

            let outboundPoolReader = PerasCertDB m TestBlock
-> ObjectPoolReader
     PerasRoundNo (PerasCert TestBlock) PerasCertTicketNo m
forall (m :: * -> *) blk.
IOLike m =>
PerasCertDB m blk
-> ObjectPoolReader
     PerasRoundNo (PerasCert blk) PerasCertTicketNo m
makePerasCertPoolReaderFromCertDB PerasCertDB m TestBlock
outboundPool
                inboundPoolWriter = SystemTime m
-> PerasCertDB m TestBlock
-> ObjectPoolWriter PerasRoundNo (PerasCert TestBlock) m
forall blk (m :: * -> *).
(StandardHash blk, IOLike m) =>
SystemTime m
-> PerasCertDB m blk
-> ObjectPoolWriter PerasRoundNo (PerasCert blk) m
makePerasCertPoolWriterFromCertDB SystemTime m
forall (m :: * -> *). Applicative m => SystemTime m
mockSystemTime PerasCertDB m TestBlock
inboundPool
                getAllInboundPoolContent = do
                  certsMap <-
                    STM
  m
  (Map
     PerasCertTicketNo
     (m (WithArrivalTime (ValidatedPerasCert TestBlock))))
-> m (Map
        PerasCertTicketNo
        (m (WithArrivalTime (ValidatedPerasCert TestBlock))))
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM
   m
   (Map
      PerasCertTicketNo
      (m (WithArrivalTime (ValidatedPerasCert TestBlock))))
 -> m (Map
         PerasCertTicketNo
         (m (WithArrivalTime (ValidatedPerasCert TestBlock)))))
-> STM
     m
     (Map
        PerasCertTicketNo
        (m (WithArrivalTime (ValidatedPerasCert TestBlock))))
-> m (Map
        PerasCertTicketNo
        (m (WithArrivalTime (ValidatedPerasCert TestBlock))))
forall a b. (a -> b) -> a -> b
$
                      PerasCertDB m TestBlock
-> PerasCertTicketNo
-> STM
     m
     (Map
        PerasCertTicketNo
        (m (WithArrivalTime (ValidatedPerasCert TestBlock))))
forall (m :: * -> *) blk.
PerasCertDB m blk
-> PerasCertTicketNo
-> STM
     m
     (Map
        PerasCertTicketNo (m (WithArrivalTime (ValidatedPerasCert blk))))
PerasCertDB.getCertsAfter PerasCertDB m TestBlock
inboundPool (PerasCertTicketNo
PerasCertDB.zeroPerasCertTicketNo)
                  certs' <- sequence (Map.elems certsMap)
                  pure $ vpcCert . forgetArrivalTime <$> certs'

            return (outboundPoolReader, inboundPoolWriter, getAllInboundPoolContent)
         in
          ProtocolConstants
-> [PerasCert TestBlock]
-> (forall (m :: * -> *).
    IOLike m =>
    ObjectDiffusionOutbound PerasRoundNo (PerasCert TestBlock) m ()
    -> Channel
         m (AnyMessage (ObjectDiffusion PerasRoundNo (PerasCert TestBlock)))
    -> Tracer m TestName
    -> m ())
-> (forall (m :: * -> *).
    IOLike m =>
    ObjectDiffusionInboundPipelined
      PerasRoundNo (PerasCert TestBlock) m ()
    -> Channel
         m (AnyMessage (ObjectDiffusion PerasRoundNo (PerasCert TestBlock)))
    -> Tracer m TestName
    -> m ())
-> (forall (m :: * -> *).
    IOLike m =>
    m (ObjectPoolReader
         PerasRoundNo (PerasCert TestBlock) PerasCertTicketNo m,
       ObjectPoolWriter PerasRoundNo (PerasCert TestBlock) m,
       m [PerasCert 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 (ValidatedPerasCert TestBlock)
 -> PerasCert TestBlock)
-> [WithArrivalTime (ValidatedPerasCert TestBlock)]
-> [PerasCert TestBlock]
forall a b. (a -> b) -> [a] -> [b]
map (ValidatedPerasCert TestBlock -> PerasCert TestBlock
forall blk. ValidatedPerasCert blk -> PerasCert blk
vpcCert (ValidatedPerasCert TestBlock -> PerasCert TestBlock)
-> (WithArrivalTime (ValidatedPerasCert TestBlock)
    -> ValidatedPerasCert TestBlock)
-> WithArrivalTime (ValidatedPerasCert TestBlock)
-> PerasCert TestBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithArrivalTime (ValidatedPerasCert TestBlock)
-> ValidatedPerasCert TestBlock
forall a. WithArrivalTime a -> a
forgetArrivalTime) [WithArrivalTime (ValidatedPerasCert TestBlock)]
watValidatedCerts)
            ObjectDiffusionOutbound PerasRoundNo (PerasCert TestBlock) m ()
-> Channel
     m (AnyMessage (ObjectDiffusion PerasRoundNo (PerasCert TestBlock)))
-> Tracer m TestName
-> m ()
forall (m :: * -> *).
IOLike m =>
ObjectDiffusionOutbound PerasRoundNo (PerasCert TestBlock) m ()
-> Channel
     m (AnyMessage (ObjectDiffusion PerasRoundNo (PerasCert 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
  PerasRoundNo (PerasCert TestBlock) m ()
-> Channel
     m (AnyMessage (ObjectDiffusion PerasRoundNo (PerasCert TestBlock)))
-> Tracer m TestName
-> m ()
forall (m :: * -> *).
IOLike m =>
ObjectDiffusionInboundPipelined
  PerasRoundNo (PerasCert TestBlock) m ()
-> Channel
     m (AnyMessage (ObjectDiffusion PerasRoundNo (PerasCert 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
     PerasRoundNo (PerasCert TestBlock) PerasCertTicketNo m,
   ObjectPoolWriter PerasRoundNo (PerasCert TestBlock) m,
   m [PerasCert TestBlock])
forall (m :: * -> *).
IOLike m =>
m (ObjectPoolReader
     PerasRoundNo (PerasCert TestBlock) PerasCertTicketNo m,
   ObjectPoolWriter PerasRoundNo (PerasCert TestBlock) m,
   m [PerasCert 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 ()