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

module Test.Consensus.MiniProtocol.ObjectDiffusion.PerasCert.Smoke
  ( tests
  ) 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
  ( genProtocolConstants
  , prop_smoke_object_diffusion
  )
import Test.QuickCheck
import Test.Tasty
import Test.Tasty.QuickCheck (testProperty)
import Test.Util.Peras
  ( ListWithUniqueIds (..)
  , genListWithUniqueIds
  , genPointTestBlock
  , genRoundNo
  , genWithArrivalTime
  , mockSystemTime
  )
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
    ]

genValidatedPerasCert :: Gen (ValidatedPerasCert TestBlock)
genValidatedPerasCert :: Gen (ValidatedPerasCert TestBlock)
genValidatedPerasCert =
  PerasCert TestBlock -> PerasWeight -> ValidatedPerasCert TestBlock
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
<*> Gen PerasWeight
genPerasWeight
 where
  genPerasCert :: Gen (PerasCert' TestBlock)
genPerasCert =
    PerasRoundNo -> Point TestBlock -> PerasCert' TestBlock
forall blk. PerasRoundNo -> Point blk -> PerasCert' blk
PerasCert
      (PerasRoundNo -> Point TestBlock -> PerasCert' TestBlock)
-> Gen PerasRoundNo
-> Gen (Point TestBlock -> PerasCert' TestBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PerasRoundNo
genRoundNo
      Gen (Point TestBlock -> PerasCert' TestBlock)
-> Gen (Point TestBlock) -> Gen (PerasCert' 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
  genPerasWeight :: Gen PerasWeight
genPerasWeight =
    Word64 -> PerasWeight
PerasWeight
      (Word64 -> PerasWeight) -> Gen Word64 -> Gen PerasWeight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
15)

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. Monad 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 -> 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 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)))
-> (ListWithUniqueIds
      (WithArrivalTime (ValidatedPerasCert TestBlock))
    -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((WithArrivalTime (ValidatedPerasCert TestBlock) -> PerasRoundNo)
-> Gen (WithArrivalTime (ValidatedPerasCert TestBlock))
-> Gen
     (ListWithUniqueIds
        (WithArrivalTime (ValidatedPerasCert TestBlock)))
forall idTy a.
Ord idTy =>
(a -> idTy) -> Gen a -> Gen (ListWithUniqueIds a)
genListWithUniqueIds WithArrivalTime (ValidatedPerasCert TestBlock) -> PerasRoundNo
forall cert blk. IsPerasCert cert blk => cert -> PerasRoundNo
getPerasCertRound (Gen (ValidatedPerasCert TestBlock)
-> Gen (WithArrivalTime (ValidatedPerasCert TestBlock))
forall a. Gen a -> Gen (WithArrivalTime a)
genWithArrivalTime Gen (ValidatedPerasCert TestBlock)
genValidatedPerasCert)) ((ListWithUniqueIds
    (WithArrivalTime (ValidatedPerasCert TestBlock))
  -> Property)
 -> Property)
-> (ListWithUniqueIds
      (WithArrivalTime (ValidatedPerasCert TestBlock))
    -> 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
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])
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])
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 ()