{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE QuantifiedConstraints      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}

{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE ConstrainedClassMethods    #-}
{-# LANGUAGE NamedFieldPuns             #-}
module Ouroboros.Network.Protocol.ObjectDiffusion.Test
  ( tests
  , ObjectId (..)
  , Object (..)
  ) where

import Control.Monad (void)
import Data.ByteString.Lazy (ByteString)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List.NonEmpty qualified as NonEmpty

import Control.Monad.Class.MonadAsync (MonadAsync)
import Control.Monad.Class.MonadFork
import Control.Monad.Class.MonadST
import Control.Monad.ST (runST)

import Codec.Serialise (DeserialiseFailure, Serialise)
import Codec.Serialise qualified as Serialise (decode, encode)

import Network.TypedProtocol.Codec
import Network.TypedProtocol.Codec.Properties (prop_codecM, prop_codec_splitsM)
import Network.TypedProtocol.Core (IsPipelined (..))
import Network.TypedProtocol.Peer (Peer, PeerPipelined)
import Network.TypedProtocol.Proofs (connectPipelined)

import Ouroboros.Network.Channel (Channel, createConnectedBufferedChannels,
           createPipelineTestChannels)
import Ouroboros.Network.Driver (runPeer, runPipelinedPeer)
import Ouroboros.Network.Util.ShowProxy

import Ouroboros.Network.Protocol.ObjectDiffusion.Codec
import Ouroboros.Network.Protocol.ObjectDiffusion.Type

import Test.Ouroboros.Network.Protocol.Utils (prop_codec_cborM,
           prop_codec_valid_cbor_encoding, splits2, splits3)
import Test.Ouroboros.Network.Utils (DistinctList (..), renderRanges)

import Control.DeepSeq
import Control.Monad.Class.MonadThrow (MonadEvaluate, MonadThrow)
import Control.Monad.IOSim (runSimOrThrow)
import Control.Tracer (Tracer, nullTracer)
import Data.Word (Word16, Word64)
import GHC.Generics
import GHC.Natural (Natural)
import Ouroboros.Network.Protocol.ObjectDiffusion.Direct (directPipelined)
import Ouroboros.Network.Protocol.ObjectDiffusion.Examples
           (TraceObjectDiffusionTestImplem, WithCaughtUpDetection (..),
           testObjectDiffusionInbound, testObjectDiffusionOutbound)
import Ouroboros.Network.Protocol.ObjectDiffusion.Inbound
           (ObjectDiffusionInboundPipelined,
           objectDiffusionInboundPeerPipelined)
import Ouroboros.Network.Protocol.ObjectDiffusion.Outbound
           (ObjectDiffusionOutbound, objectDiffusionOutboundPeer)
import Test.QuickCheck as QC
import Test.QuickCheck.Instances.ByteString ()
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)


--
-- Test cases
--


tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"Ouroboros.Network.Protocol"
    [ TestName -> [TestTree] -> TestTree
testGroup TestName
"ObjectDiffusion"
        [ TestName
-> (AnyMessage (ObjectDiffusion ObjectId Object) -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec"                      AnyMessage (ObjectDiffusion ObjectId Object) -> Property
prop_codec
        , TestName
-> (AnyMessage (ObjectDiffusion ObjectId Object) -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec id"                   AnyMessage (ObjectDiffusion ObjectId Object) -> Property
prop_codec_id
        , TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec 2-splits"           (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ Int
-> (AnyMessage (ObjectDiffusion ObjectId Object) -> Property)
-> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSize Int
50
                                                    AnyMessage (ObjectDiffusion ObjectId Object) -> Property
prop_codec_splits2
        , TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec 3-splits"           (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ Int
-> (AnyMessage (ObjectDiffusion ObjectId Object) -> Property)
-> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSize Int
10
                                                    AnyMessage (ObjectDiffusion ObjectId Object) -> Property
prop_codec_splits3
        , TestName
-> (AnyMessage (ObjectDiffusion ObjectId Object) -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec cbor"                 AnyMessage (ObjectDiffusion ObjectId Object) -> Property
prop_codec_cbor
        , TestName
-> (AnyMessage (ObjectDiffusion ObjectId Object) -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec valid cbor"           AnyMessage (ObjectDiffusion ObjectId Object) -> Property
prop_codec_valid_cbor
        , TestName -> (ObjectDiffusionTestParams -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"direct ST"                  ObjectDiffusionTestParams -> Property
propDirectST
        , TestName -> (ObjectDiffusionTestParams -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"direct IO"                  ObjectDiffusionTestParams -> Property
propDirectIO
        , TestName
-> (ObjectDiffusionTestParams -> [Bool] -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"connect ST"                 ObjectDiffusionTestParams -> [Bool] -> Property
propConnectST
        , TestName
-> (ObjectDiffusionTestParams -> [Bool] -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"connect IO"                 ObjectDiffusionTestParams -> [Bool] -> Property
propConnectIO
        , TestName
-> (ObjectDiffusionTestParams -> ChannelSize -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"demo channel ST"            ObjectDiffusionTestParams -> ChannelSize -> Property
propDemoChannelST
        , TestName
-> (ObjectDiffusionTestParams -> ChannelSize -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"demo channel IO"            ObjectDiffusionTestParams -> ChannelSize -> Property
propDemoChannelIO
        , TestName
-> (ObjectDiffusionTestParams -> ChannelSize -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"demo channel (buffered) ST" ObjectDiffusionTestParams -> ChannelSize -> Property
propDemoChannelBufferedST
        , TestName
-> (ObjectDiffusionTestParams -> ChannelSize -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"demo channel (buffered) IO" ObjectDiffusionTestParams -> ChannelSize -> Property
propDemoChannelBufferedIO
        ]
    ]

--
-- Common types & clients and servers used in the tests in this module.
--

newtype Object = Object { Object -> ObjectId
getObjectId :: ObjectId }
  deriving (Object -> Object -> Bool
(Object -> Object -> Bool)
-> (Object -> Object -> Bool) -> Eq Object
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Object -> Object -> Bool
== :: Object -> Object -> Bool
$c/= :: Object -> Object -> Bool
/= :: Object -> Object -> Bool
Eq, Int -> Object -> ShowS
[Object] -> ShowS
Object -> TestName
(Int -> Object -> ShowS)
-> (Object -> TestName) -> ([Object] -> ShowS) -> Show Object
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Object -> ShowS
showsPrec :: Int -> Object -> ShowS
$cshow :: Object -> TestName
show :: Object -> TestName
$cshowList :: [Object] -> ShowS
showList :: [Object] -> ShowS
Show, Gen Object
Gen Object -> (Object -> [Object]) -> Arbitrary Object
Object -> [Object]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Object
arbitrary :: Gen Object
$cshrink :: Object -> [Object]
shrink :: Object -> [Object]
Arbitrary, [Object] -> Encoding
Object -> Encoding
(Object -> Encoding)
-> (forall s. Decoder s Object)
-> ([Object] -> Encoding)
-> (forall s. Decoder s [Object])
-> Serialise Object
forall s. Decoder s [Object]
forall s. Decoder s Object
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: Object -> Encoding
encode :: Object -> Encoding
$cdecode :: forall s. Decoder s Object
decode :: forall s. Decoder s Object
$cencodeList :: [Object] -> Encoding
encodeList :: [Object] -> Encoding
$cdecodeList :: forall s. Decoder s [Object]
decodeList :: forall s. Decoder s [Object]
Serialise, (forall x. Object -> Rep Object x)
-> (forall x. Rep Object x -> Object) -> Generic Object
forall x. Rep Object x -> Object
forall x. Object -> Rep Object x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Object -> Rep Object x
from :: forall x. Object -> Rep Object x
$cto :: forall x. Rep Object x -> Object
to :: forall x. Rep Object x -> Object
Generic, Object -> ()
(Object -> ()) -> NFData Object
forall a. (a -> ()) -> NFData a
$crnf :: Object -> ()
rnf :: Object -> ()
NFData)

instance ShowProxy Object where
    showProxy :: Proxy Object -> TestName
showProxy Proxy Object
_ = TestName
"Object"

newtype ObjectId = ObjectId (Maybe Word64)
  deriving (ObjectId -> ObjectId -> Bool
(ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> Bool) -> Eq ObjectId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectId -> ObjectId -> Bool
== :: ObjectId -> ObjectId -> Bool
$c/= :: ObjectId -> ObjectId -> Bool
/= :: ObjectId -> ObjectId -> Bool
Eq, Eq ObjectId
Eq ObjectId =>
(ObjectId -> ObjectId -> Ordering)
-> (ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> ObjectId)
-> (ObjectId -> ObjectId -> ObjectId)
-> Ord ObjectId
ObjectId -> ObjectId -> Bool
ObjectId -> ObjectId -> Ordering
ObjectId -> ObjectId -> ObjectId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ObjectId -> ObjectId -> Ordering
compare :: ObjectId -> ObjectId -> Ordering
$c< :: ObjectId -> ObjectId -> Bool
< :: ObjectId -> ObjectId -> Bool
$c<= :: ObjectId -> ObjectId -> Bool
<= :: ObjectId -> ObjectId -> Bool
$c> :: ObjectId -> ObjectId -> Bool
> :: ObjectId -> ObjectId -> Bool
$c>= :: ObjectId -> ObjectId -> Bool
>= :: ObjectId -> ObjectId -> Bool
$cmax :: ObjectId -> ObjectId -> ObjectId
max :: ObjectId -> ObjectId -> ObjectId
$cmin :: ObjectId -> ObjectId -> ObjectId
min :: ObjectId -> ObjectId -> ObjectId
Ord, Int -> ObjectId -> ShowS
[ObjectId] -> ShowS
ObjectId -> TestName
(Int -> ObjectId -> ShowS)
-> (ObjectId -> TestName) -> ([ObjectId] -> ShowS) -> Show ObjectId
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectId -> ShowS
showsPrec :: Int -> ObjectId -> ShowS
$cshow :: ObjectId -> TestName
show :: ObjectId -> TestName
$cshowList :: [ObjectId] -> ShowS
showList :: [ObjectId] -> ShowS
Show, [ObjectId] -> Encoding
ObjectId -> Encoding
(ObjectId -> Encoding)
-> (forall s. Decoder s ObjectId)
-> ([ObjectId] -> Encoding)
-> (forall s. Decoder s [ObjectId])
-> Serialise ObjectId
forall s. Decoder s [ObjectId]
forall s. Decoder s ObjectId
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: ObjectId -> Encoding
encode :: ObjectId -> Encoding
$cdecode :: forall s. Decoder s ObjectId
decode :: forall s. Decoder s ObjectId
$cencodeList :: [ObjectId] -> Encoding
encodeList :: [ObjectId] -> Encoding
$cdecodeList :: forall s. Decoder s [ObjectId]
decodeList :: forall s. Decoder s [ObjectId]
Serialise, (forall x. ObjectId -> Rep ObjectId x)
-> (forall x. Rep ObjectId x -> ObjectId) -> Generic ObjectId
forall x. Rep ObjectId x -> ObjectId
forall x. ObjectId -> Rep ObjectId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObjectId -> Rep ObjectId x
from :: forall x. ObjectId -> Rep ObjectId x
$cto :: forall x. Rep ObjectId x -> ObjectId
to :: forall x. Rep ObjectId x -> ObjectId
Generic, ObjectId -> ()
(ObjectId -> ()) -> NFData ObjectId
forall a. (a -> ()) -> NFData a
$crnf :: ObjectId -> ()
rnf :: ObjectId -> ()
NFData)

instance Arbitrary ObjectId where
  -- | We never generate the `Nothing` variant, since it is reserved for the sentinel value used to detect that the peer is caught up.
  arbitrary :: Gen ObjectId
arbitrary = Maybe Word64 -> ObjectId
ObjectId (Maybe Word64 -> ObjectId)
-> (Word64 -> Maybe Word64) -> Word64 -> ObjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> ObjectId) -> Gen Word64 -> Gen ObjectId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary

instance WithCaughtUpDetection ObjectId where
  caughtUpSentinel :: NonEmpty ObjectId
caughtUpSentinel = Maybe Word64 -> ObjectId
ObjectId Maybe Word64
forall a. Maybe a
Nothing ObjectId -> [ObjectId] -> NonEmpty ObjectId
forall a. a -> [a] -> NonEmpty a
:| []

instance ShowProxy ObjectId where
    showProxy :: Proxy ObjectId -> TestName
showProxy Proxy ObjectId
_ = TestName
"ObjectId"

deriving newtype instance Arbitrary NumObjectIdsAck
deriving newtype instance Arbitrary NumObjectIdsReq

instance (Arbitrary objectId, Arbitrary object)
      => Arbitrary (AnyMessage (ObjectDiffusion objectId object)) where
  arbitrary :: Gen (AnyMessage (ObjectDiffusion objectId object))
arbitrary = [Gen (AnyMessage (ObjectDiffusion objectId object))]
-> Gen (AnyMessage (ObjectDiffusion objectId object))
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ AnyMessage (ObjectDiffusion objectId object)
-> Gen (AnyMessage (ObjectDiffusion objectId object))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnyMessage (ObjectDiffusion objectId object)
 -> Gen (AnyMessage (ObjectDiffusion objectId object)))
-> AnyMessage (ObjectDiffusion objectId object)
-> Gen (AnyMessage (ObjectDiffusion objectId object))
forall a b. (a -> b) -> a -> b
$ Message (ObjectDiffusion objectId object) 'StInit 'StIdle
-> AnyMessage (ObjectDiffusion objectId object)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage Message (ObjectDiffusion objectId object) 'StInit 'StIdle
forall objectId object.
Message (ObjectDiffusion objectId object) 'StInit 'StIdle
MsgInit
    , Message
  (ObjectDiffusion objectId object)
  'StIdle
  ('StObjectIds 'StBlocking)
-> AnyMessage (ObjectDiffusion objectId object)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage
        (Message
   (ObjectDiffusion objectId object)
   'StIdle
   ('StObjectIds 'StBlocking)
 -> AnyMessage (ObjectDiffusion objectId object))
-> Gen
     (Message
        (ObjectDiffusion objectId object)
        'StIdle
        ('StObjectIds 'StBlocking))
-> Gen (AnyMessage (ObjectDiffusion objectId object))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( SingBlockingStyle 'StBlocking
-> NumObjectIdsAck
-> NumObjectIdsReq
-> Message
     (ObjectDiffusion objectId object)
     'StIdle
     ('StObjectIds 'StBlocking)
forall (blocking :: StBlockingStyle) objectId object.
SingBlockingStyle blocking
-> NumObjectIdsAck
-> NumObjectIdsReq
-> Message
     (ObjectDiffusion objectId object) 'StIdle ('StObjectIds blocking)
MsgRequestObjectIds SingBlockingStyle 'StBlocking
SingBlocking
            (NumObjectIdsAck
 -> NumObjectIdsReq
 -> Message
      (ObjectDiffusion objectId object)
      'StIdle
      ('StObjectIds 'StBlocking))
-> Gen NumObjectIdsAck
-> Gen
     (NumObjectIdsReq
      -> Message
           (ObjectDiffusion objectId object)
           'StIdle
           ('StObjectIds 'StBlocking))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen NumObjectIdsAck
forall a. Arbitrary a => Gen a
arbitrary
            Gen
  (NumObjectIdsReq
   -> Message
        (ObjectDiffusion objectId object)
        'StIdle
        ('StObjectIds 'StBlocking))
-> Gen NumObjectIdsReq
-> Gen
     (Message
        (ObjectDiffusion objectId object)
        'StIdle
        ('StObjectIds 'StBlocking))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen NumObjectIdsReq
forall a. Arbitrary a => Gen a
arbitrary
            )

    , Message
  (ObjectDiffusion objectId object)
  'StIdle
  ('StObjectIds 'StNonBlocking)
-> AnyMessage (ObjectDiffusion objectId object)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage
        (Message
   (ObjectDiffusion objectId object)
   'StIdle
   ('StObjectIds 'StNonBlocking)
 -> AnyMessage (ObjectDiffusion objectId object))
-> Gen
     (Message
        (ObjectDiffusion objectId object)
        'StIdle
        ('StObjectIds 'StNonBlocking))
-> Gen (AnyMessage (ObjectDiffusion objectId object))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( SingBlockingStyle 'StNonBlocking
-> NumObjectIdsAck
-> NumObjectIdsReq
-> Message
     (ObjectDiffusion objectId object)
     'StIdle
     ('StObjectIds 'StNonBlocking)
forall (blocking :: StBlockingStyle) objectId object.
SingBlockingStyle blocking
-> NumObjectIdsAck
-> NumObjectIdsReq
-> Message
     (ObjectDiffusion objectId object) 'StIdle ('StObjectIds blocking)
MsgRequestObjectIds SingBlockingStyle 'StNonBlocking
SingNonBlocking
            (NumObjectIdsAck
 -> NumObjectIdsReq
 -> Message
      (ObjectDiffusion objectId object)
      'StIdle
      ('StObjectIds 'StNonBlocking))
-> Gen NumObjectIdsAck
-> Gen
     (NumObjectIdsReq
      -> Message
           (ObjectDiffusion objectId object)
           'StIdle
           ('StObjectIds 'StNonBlocking))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen NumObjectIdsAck
forall a. Arbitrary a => Gen a
arbitrary
            Gen
  (NumObjectIdsReq
   -> Message
        (ObjectDiffusion objectId object)
        'StIdle
        ('StObjectIds 'StNonBlocking))
-> Gen NumObjectIdsReq
-> Gen
     (Message
        (ObjectDiffusion objectId object)
        'StIdle
        ('StObjectIds 'StNonBlocking))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen NumObjectIdsReq
forall a. Arbitrary a => Gen a
arbitrary
            )

    , Message
  (ObjectDiffusion objectId object)
  ('StObjectIds 'StBlocking)
  'StIdle
-> AnyMessage (ObjectDiffusion objectId object)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage
        (Message
   (ObjectDiffusion objectId object)
   ('StObjectIds 'StBlocking)
   'StIdle
 -> AnyMessage (ObjectDiffusion objectId object))
-> (BlockingReplyList 'StBlocking objectId
    -> Message
         (ObjectDiffusion objectId object)
         ('StObjectIds 'StBlocking)
         'StIdle)
-> BlockingReplyList 'StBlocking objectId
-> AnyMessage (ObjectDiffusion objectId object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockingReplyList 'StBlocking objectId
-> Message
     (ObjectDiffusion objectId object)
     ('StObjectIds 'StBlocking)
     'StIdle
forall (blocking :: StBlockingStyle) objectId object.
BlockingReplyList blocking objectId
-> Message
     (ObjectDiffusion objectId object) ('StObjectIds blocking) 'StIdle
MsgReplyObjectIds
        (BlockingReplyList 'StBlocking objectId
 -> AnyMessage (ObjectDiffusion objectId object))
-> (NonEmptyList objectId
    -> BlockingReplyList 'StBlocking objectId)
-> NonEmptyList objectId
-> AnyMessage (ObjectDiffusion objectId object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( NonEmpty objectId -> BlockingReplyList 'StBlocking objectId
forall a. NonEmpty a -> BlockingReplyList 'StBlocking a
BlockingReply
            (NonEmpty objectId -> BlockingReplyList 'StBlocking objectId)
-> (NonEmptyList objectId -> NonEmpty objectId)
-> NonEmptyList objectId
-> BlockingReplyList 'StBlocking objectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [objectId] -> NonEmpty objectId
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
            ([objectId] -> NonEmpty objectId)
-> (NonEmptyList objectId -> [objectId])
-> NonEmptyList objectId
-> NonEmpty objectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyList objectId -> [objectId]
forall a. NonEmptyList a -> [a]
QC.getNonEmpty
            )
        (NonEmptyList objectId
 -> AnyMessage (ObjectDiffusion objectId object))
-> Gen (NonEmptyList objectId)
-> Gen (AnyMessage (ObjectDiffusion objectId object))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonEmptyList objectId)
forall a. Arbitrary a => Gen a
arbitrary

    , Message
  (ObjectDiffusion objectId object)
  ('StObjectIds 'StNonBlocking)
  'StIdle
-> AnyMessage (ObjectDiffusion objectId object)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage
        (Message
   (ObjectDiffusion objectId object)
   ('StObjectIds 'StNonBlocking)
   'StIdle
 -> AnyMessage (ObjectDiffusion objectId object))
-> (BlockingReplyList 'StNonBlocking objectId
    -> Message
         (ObjectDiffusion objectId object)
         ('StObjectIds 'StNonBlocking)
         'StIdle)
-> BlockingReplyList 'StNonBlocking objectId
-> AnyMessage (ObjectDiffusion objectId object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockingReplyList 'StNonBlocking objectId
-> Message
     (ObjectDiffusion objectId object)
     ('StObjectIds 'StNonBlocking)
     'StIdle
forall (blocking :: StBlockingStyle) objectId object.
BlockingReplyList blocking objectId
-> Message
     (ObjectDiffusion objectId object) ('StObjectIds blocking) 'StIdle
MsgReplyObjectIds
        (BlockingReplyList 'StNonBlocking objectId
 -> AnyMessage (ObjectDiffusion objectId object))
-> ([objectId] -> BlockingReplyList 'StNonBlocking objectId)
-> [objectId]
-> AnyMessage (ObjectDiffusion objectId object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [objectId] -> BlockingReplyList 'StNonBlocking objectId
forall a. [a] -> BlockingReplyList 'StNonBlocking a
NonBlockingReply
        ([objectId] -> AnyMessage (ObjectDiffusion objectId object))
-> Gen [objectId]
-> Gen (AnyMessage (ObjectDiffusion objectId object))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [objectId]
forall a. Arbitrary a => Gen a
arbitrary

    , Message (ObjectDiffusion objectId object) 'StIdle 'StObjects
-> AnyMessage (ObjectDiffusion objectId object)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage
        (Message (ObjectDiffusion objectId object) 'StIdle 'StObjects
 -> AnyMessage (ObjectDiffusion objectId object))
-> ([objectId]
    -> Message (ObjectDiffusion objectId object) 'StIdle 'StObjects)
-> [objectId]
-> AnyMessage (ObjectDiffusion objectId object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [objectId]
-> Message (ObjectDiffusion objectId object) 'StIdle 'StObjects
forall objectId object.
[objectId]
-> Message (ObjectDiffusion objectId object) 'StIdle 'StObjects
MsgRequestObjects
        ([objectId] -> AnyMessage (ObjectDiffusion objectId object))
-> Gen [objectId]
-> Gen (AnyMessage (ObjectDiffusion objectId object))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [objectId]
forall a. Arbitrary a => Gen a
arbitrary

    , Message (ObjectDiffusion objectId object) 'StObjects 'StIdle
-> AnyMessage (ObjectDiffusion objectId object)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage
        (Message (ObjectDiffusion objectId object) 'StObjects 'StIdle
 -> AnyMessage (ObjectDiffusion objectId object))
-> ([object]
    -> Message (ObjectDiffusion objectId object) 'StObjects 'StIdle)
-> [object]
-> AnyMessage (ObjectDiffusion objectId object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [object]
-> Message (ObjectDiffusion objectId object) 'StObjects 'StIdle
forall object objectId.
[object]
-> Message (ObjectDiffusion objectId object) 'StObjects 'StIdle
MsgReplyObjects
        ([object] -> AnyMessage (ObjectDiffusion objectId object))
-> Gen [object]
-> Gen (AnyMessage (ObjectDiffusion objectId object))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [object]
forall a. Arbitrary a => Gen a
arbitrary

    , Message (ObjectDiffusion objectId object) 'StIdle 'StDone
-> AnyMessage (ObjectDiffusion objectId object)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage
        (Message (ObjectDiffusion objectId object) 'StIdle 'StDone
 -> AnyMessage (ObjectDiffusion objectId object))
-> Gen (Message (ObjectDiffusion objectId object) 'StIdle 'StDone)
-> Gen (AnyMessage (ObjectDiffusion objectId object))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message (ObjectDiffusion objectId object) 'StIdle 'StDone
-> Gen (Message (ObjectDiffusion objectId object) 'StIdle 'StDone)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Message (ObjectDiffusion objectId object) 'StIdle 'StDone
forall objectId object.
Message (ObjectDiffusion objectId object) 'StIdle 'StDone
MsgDone
    ]

instance (Eq objectId, Eq object)
      => Eq (AnyMessage (ObjectDiffusion objectId object)) where

  == :: AnyMessage (ObjectDiffusion objectId object)
-> AnyMessage (ObjectDiffusion objectId object) -> Bool
(==) (AnyMessage Message (ObjectDiffusion objectId object) st st'
R:MessageObjectDiffusionfromto objectId object st st'
MsgInit)
       (AnyMessage Message (ObjectDiffusion objectId object) st st'
R:MessageObjectDiffusionfromto objectId object st st'
MsgInit) = Bool
True

  (==) (AnyMessage (MsgRequestObjectIds SingBlockingStyle blocking
SingBlocking NumObjectIdsAck
ackNo  NumObjectIdsReq
reqNo))
       (AnyMessage (MsgRequestObjectIds SingBlockingStyle blocking
SingBlocking NumObjectIdsAck
ackNo' NumObjectIdsReq
reqNo')) =
    (NumObjectIdsAck
ackNo, NumObjectIdsReq
reqNo) (NumObjectIdsAck, NumObjectIdsReq)
-> (NumObjectIdsAck, NumObjectIdsReq) -> Bool
forall a. Eq a => a -> a -> Bool
== (NumObjectIdsAck
ackNo', NumObjectIdsReq
reqNo')

  (==) (AnyMessage (MsgRequestObjectIds SingBlockingStyle blocking
SingNonBlocking NumObjectIdsAck
ackNo  NumObjectIdsReq
reqNo))
       (AnyMessage (MsgRequestObjectIds SingBlockingStyle blocking
SingNonBlocking NumObjectIdsAck
ackNo' NumObjectIdsReq
reqNo')) =
    (NumObjectIdsAck
ackNo, NumObjectIdsReq
reqNo) (NumObjectIdsAck, NumObjectIdsReq)
-> (NumObjectIdsAck, NumObjectIdsReq) -> Bool
forall a. Eq a => a -> a -> Bool
== (NumObjectIdsAck
ackNo', NumObjectIdsReq
reqNo')

  (==) (AnyMessage (MsgReplyObjectIds (BlockingReply NonEmpty objectId
objectIds)))
       (AnyMessage (MsgReplyObjectIds (BlockingReply NonEmpty objectId
objectIds'))) =
    NonEmpty objectId
objectIds NonEmpty objectId -> NonEmpty objectId -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty objectId
objectIds'

  (==) (AnyMessage (MsgReplyObjectIds (NonBlockingReply [objectId]
objectIds)))
       (AnyMessage (MsgReplyObjectIds (NonBlockingReply [objectId]
objectIds'))) =
    [objectId]
objectIds [objectId] -> [objectId] -> Bool
forall a. Eq a => a -> a -> Bool
== [objectId]
objectIds'

  (==) (AnyMessage (MsgRequestObjects [objectId]
objectIds))
       (AnyMessage (MsgRequestObjects [objectId]
objectIds')) = [objectId]
objectIds [objectId] -> [objectId] -> Bool
forall a. Eq a => a -> a -> Bool
== [objectId]
objectIds'

  (==) (AnyMessage (MsgReplyObjects [object]
txs))
       (AnyMessage (MsgReplyObjects [object]
txs')) = [object]
txs [object] -> [object] -> Bool
forall a. Eq a => a -> a -> Bool
== [object]
txs'

  (==) (AnyMessage Message (ObjectDiffusion objectId object) st st'
R:MessageObjectDiffusionfromto objectId object st st'
MsgDone)
       (AnyMessage Message (ObjectDiffusion objectId object) st st'
R:MessageObjectDiffusionfromto objectId object st st'
MsgDone) = Bool
True

  AnyMessage (ObjectDiffusion objectId object)
_ == AnyMessage (ObjectDiffusion objectId object)
_ = Bool
False


codec :: MonadST m
      => Codec
           (ObjectDiffusion ObjectId Object)
           DeserialiseFailure
           m ByteString
codec :: forall (m :: * -> *).
MonadST m =>
Codec
  (ObjectDiffusion ObjectId Object) DeserialiseFailure m ByteString
codec = (ObjectId -> Encoding)
-> (forall s. Decoder s ObjectId)
-> (Object -> Encoding)
-> (forall s. Decoder s Object)
-> Codec
     (ObjectDiffusion ObjectId Object) DeserialiseFailure m ByteString
forall objectId object (m :: * -> *).
MonadST m =>
(objectId -> Encoding)
-> (forall s. Decoder s objectId)
-> (object -> Encoding)
-> (forall s. Decoder s object)
-> Codec
     (ObjectDiffusion objectId object) DeserialiseFailure m ByteString
codecObjectDiffusion
          ObjectId -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode Decoder s ObjectId
forall s. Decoder s ObjectId
forall a s. Serialise a => Decoder s a
Serialise.decode
          Object -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode Decoder s Object
forall s. Decoder s Object
forall a s. Serialise a => Decoder s a
Serialise.decode


-- | Check the codec round trip property.
--
prop_codec
  :: AnyMessage (ObjectDiffusion ObjectId Object)
  -> Property
prop_codec :: AnyMessage (ObjectDiffusion ObjectId Object) -> Property
prop_codec AnyMessage (ObjectDiffusion ObjectId Object)
msg =
  (forall s. ST s Property) -> Property
forall a. (forall s. ST s a) -> a
runST (Codec
  (ObjectDiffusion ObjectId Object)
  DeserialiseFailure
  (ST s)
  ByteString
-> AnyMessage (ObjectDiffusion ObjectId Object) -> ST s Property
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps), Show (AnyMessage ps),
 Show failure) =>
Codec ps failure m bytes -> AnyMessage ps -> m Property
prop_codecM Codec
  (ObjectDiffusion ObjectId Object)
  DeserialiseFailure
  (ST s)
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (ObjectDiffusion ObjectId Object) DeserialiseFailure m ByteString
codec AnyMessage (ObjectDiffusion ObjectId Object)
msg)

-- | Check the codec round trip property for the id codec.
--
prop_codec_id
  :: AnyMessage (ObjectDiffusion ObjectId Object)
  -> Property
prop_codec_id :: AnyMessage (ObjectDiffusion ObjectId Object) -> Property
prop_codec_id AnyMessage (ObjectDiffusion ObjectId Object)
msg =
  (forall s. ST s Property) -> Property
forall a. (forall s. ST s a) -> a
runST (Codec
  (ObjectDiffusion ObjectId Object)
  CodecFailure
  (ST s)
  (AnyMessage (ObjectDiffusion ObjectId Object))
-> AnyMessage (ObjectDiffusion ObjectId Object) -> ST s Property
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps), Show (AnyMessage ps),
 Show failure) =>
Codec ps failure m bytes -> AnyMessage ps -> m Property
prop_codecM Codec
  (ObjectDiffusion ObjectId Object)
  CodecFailure
  (ST s)
  (AnyMessage (ObjectDiffusion ObjectId Object))
forall objectId object (m :: * -> *).
Monad m =>
Codec
  (ObjectDiffusion objectId object)
  CodecFailure
  m
  (AnyMessage (ObjectDiffusion objectId object))
codecObjectDiffusionId AnyMessage (ObjectDiffusion ObjectId Object)
msg)

-- | Check for data chunk boundary problems in the codec using 2 chunks.
--
prop_codec_splits2
  :: AnyMessage (ObjectDiffusion ObjectId Object)
  -> Property
prop_codec_splits2 :: AnyMessage (ObjectDiffusion ObjectId Object) -> Property
prop_codec_splits2 AnyMessage (ObjectDiffusion ObjectId Object)
msg =
  (forall s. ST s Property) -> Property
forall a. (forall s. ST s a) -> a
runST ((ByteString -> [[ByteString]])
-> Codec
     (ObjectDiffusion ObjectId Object)
     DeserialiseFailure
     (ST s)
     ByteString
-> AnyMessage (ObjectDiffusion ObjectId Object)
-> ST s Property
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps), Show (AnyMessage ps), Show failure,
 Monoid bytes) =>
(bytes -> [[bytes]])
-> Codec ps failure m bytes -> AnyMessage ps -> m Property
prop_codec_splitsM ByteString -> [[ByteString]]
splits2 Codec
  (ObjectDiffusion ObjectId Object)
  DeserialiseFailure
  (ST s)
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (ObjectDiffusion ObjectId Object) DeserialiseFailure m ByteString
codec AnyMessage (ObjectDiffusion ObjectId Object)
msg)

-- | Check for data chunk boundary problems in the codec using 3 chunks.
--
prop_codec_splits3
  :: AnyMessage (ObjectDiffusion ObjectId Object)
  -> Property
prop_codec_splits3 :: AnyMessage (ObjectDiffusion ObjectId Object) -> Property
prop_codec_splits3 AnyMessage (ObjectDiffusion ObjectId Object)
msg =
  AnyMessage (ObjectDiffusion ObjectId Object)
-> Property -> Property
forall objectId object.
AnyMessage (ObjectDiffusion objectId object)
-> Property -> Property
labelMsg AnyMessage (ObjectDiffusion ObjectId Object)
msg (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
  (forall s. ST s Property) -> Property
forall a. (forall s. ST s a) -> a
runST ((ByteString -> [[ByteString]])
-> Codec
     (ObjectDiffusion ObjectId Object)
     DeserialiseFailure
     (ST s)
     ByteString
-> AnyMessage (ObjectDiffusion ObjectId Object)
-> ST s Property
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps), Show (AnyMessage ps), Show failure,
 Monoid bytes) =>
(bytes -> [[bytes]])
-> Codec ps failure m bytes -> AnyMessage ps -> m Property
prop_codec_splitsM ByteString -> [[ByteString]]
splits3 Codec
  (ObjectDiffusion ObjectId Object)
  DeserialiseFailure
  (ST s)
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (ObjectDiffusion ObjectId Object) DeserialiseFailure m ByteString
codec AnyMessage (ObjectDiffusion ObjectId Object)
msg)

prop_codec_cbor
  :: AnyMessage (ObjectDiffusion ObjectId Object)
  -> Property
prop_codec_cbor :: AnyMessage (ObjectDiffusion ObjectId Object) -> Property
prop_codec_cbor AnyMessage (ObjectDiffusion ObjectId Object)
msg =
  (forall s. ST s Property) -> Property
forall a. (forall s. ST s a) -> a
runST (CodecF
  (ObjectDiffusion ObjectId Object)
  DeserialiseFailure
  (ST s)
  SomeMessage
  ByteString
-> AnyMessage (ObjectDiffusion ObjectId Object) -> ST s Property
forall ps (m :: * -> *) (f :: ps -> *).
Monad m =>
CodecF ps DeserialiseFailure m f ByteString
-> AnyMessage ps -> m Property
prop_codec_cborM CodecF
  (ObjectDiffusion ObjectId Object)
  DeserialiseFailure
  (ST s)
  SomeMessage
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (ObjectDiffusion ObjectId Object) DeserialiseFailure m ByteString
codec AnyMessage (ObjectDiffusion ObjectId Object)
msg)

-- | Check that the encoder produces a valid CBOR.
--
prop_codec_valid_cbor
  :: AnyMessage (ObjectDiffusion ObjectId Object)
  -> Property
prop_codec_valid_cbor :: AnyMessage (ObjectDiffusion ObjectId Object) -> Property
prop_codec_valid_cbor = CodecF
  (ObjectDiffusion ObjectId Object)
  DeserialiseFailure
  IO
  SomeMessage
  ByteString
-> AnyMessage (ObjectDiffusion ObjectId Object) -> Property
forall ps (f :: ps -> *).
CodecF ps DeserialiseFailure IO f ByteString
-> AnyMessage ps -> Property
prop_codec_valid_cbor_encoding CodecF
  (ObjectDiffusion ObjectId Object)
  DeserialiseFailure
  IO
  SomeMessage
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (ObjectDiffusion ObjectId Object) DeserialiseFailure m ByteString
codec


labelMsg :: AnyMessage (ObjectDiffusion objectId object) -> Property -> Property
labelMsg :: forall objectId object.
AnyMessage (ObjectDiffusion objectId object)
-> Property -> Property
labelMsg (AnyMessage Message (ObjectDiffusion objectId object) st st'
msg) =
  TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
label (case Message (ObjectDiffusion objectId object) st st'
msg of
           Message (ObjectDiffusion objectId object) st st'
R:MessageObjectDiffusionfromto objectId object st st'
MsgInit                -> TestName
"MsgInit"
           MsgRequestObjectIds {} -> TestName
"MsgRequestObjectIds"
           MsgReplyObjectIds BlockingReplyList blocking objectId
as   -> TestName
"MsgReplyObjectIds " TestName -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> TestName
renderRanges Int
3 (BlockingReplyList blocking objectId -> Int
forall a. BlockingReplyList blocking a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length BlockingReplyList blocking objectId
as)
           MsgRequestObjects [objectId]
as   -> TestName
"MsgRequestObjects " TestName -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> TestName
renderRanges Int
3 ([objectId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [objectId]
as)
           MsgReplyObjects [object]
as     -> TestName
"MsgReplyObjects "   TestName -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> TestName
renderRanges Int
3 ([object] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [object]
as)
           Message (ObjectDiffusion objectId object) st st'
R:MessageObjectDiffusionfromto objectId object st st'
MsgDone                -> TestName
"MsgDone"
        )

--
-- Direct client and server tests
--

data ObjectDiffusionTestParams =
     ObjectDiffusionTestParams {
       ObjectDiffusionTestParams -> ChannelSize
testMaxUnacked            :: Positive (Small Word16),
       ObjectDiffusionTestParams -> ChannelSize
testMaxObjectIdsToRequest :: Positive (Small Word16),
       ObjectDiffusionTestParams -> ChannelSize
testMaxObjectsToRequest   :: Positive (Small Word16),
       ObjectDiffusionTestParams -> DistinctList Object
testObjects               :: DistinctList Object
     }
  deriving Int -> ObjectDiffusionTestParams -> ShowS
[ObjectDiffusionTestParams] -> ShowS
ObjectDiffusionTestParams -> TestName
(Int -> ObjectDiffusionTestParams -> ShowS)
-> (ObjectDiffusionTestParams -> TestName)
-> ([ObjectDiffusionTestParams] -> ShowS)
-> Show ObjectDiffusionTestParams
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectDiffusionTestParams -> ShowS
showsPrec :: Int -> ObjectDiffusionTestParams -> ShowS
$cshow :: ObjectDiffusionTestParams -> TestName
show :: ObjectDiffusionTestParams -> TestName
$cshowList :: [ObjectDiffusionTestParams] -> ShowS
showList :: [ObjectDiffusionTestParams] -> ShowS
Show

instance Arbitrary ObjectDiffusionTestParams where
  arbitrary :: Gen ObjectDiffusionTestParams
arbitrary =
    ChannelSize
-> ChannelSize
-> ChannelSize
-> DistinctList Object
-> ObjectDiffusionTestParams
ObjectDiffusionTestParams (ChannelSize
 -> ChannelSize
 -> ChannelSize
 -> DistinctList Object
 -> ObjectDiffusionTestParams)
-> Gen ChannelSize
-> Gen
     (ChannelSize
      -> ChannelSize -> DistinctList Object -> ObjectDiffusionTestParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ChannelSize
forall a. Arbitrary a => Gen a
arbitrary
                              Gen
  (ChannelSize
   -> ChannelSize -> DistinctList Object -> ObjectDiffusionTestParams)
-> Gen ChannelSize
-> Gen
     (ChannelSize -> DistinctList Object -> ObjectDiffusionTestParams)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ChannelSize
forall a. Arbitrary a => Gen a
arbitrary
                              Gen
  (ChannelSize -> DistinctList Object -> ObjectDiffusionTestParams)
-> Gen ChannelSize
-> Gen (DistinctList Object -> ObjectDiffusionTestParams)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ChannelSize
forall a. Arbitrary a => Gen a
arbitrary
                              Gen (DistinctList Object -> ObjectDiffusionTestParams)
-> Gen (DistinctList Object) -> Gen ObjectDiffusionTestParams
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (DistinctList Object)
forall a. Arbitrary a => Gen a
arbitrary

  shrink :: ObjectDiffusionTestParams -> [ObjectDiffusionTestParams]
shrink (ObjectDiffusionTestParams ChannelSize
a ChannelSize
b ChannelSize
c DistinctList Object
d) =
    [ ChannelSize
-> ChannelSize
-> ChannelSize
-> DistinctList Object
-> ObjectDiffusionTestParams
ObjectDiffusionTestParams ChannelSize
a' ChannelSize
b' ChannelSize
c' DistinctList Object
d'
    | (ChannelSize
a', ChannelSize
b', ChannelSize
c', DistinctList Object
d') <- (ChannelSize, ChannelSize, ChannelSize, DistinctList Object)
-> [(ChannelSize, ChannelSize, ChannelSize, DistinctList Object)]
forall a. Arbitrary a => a -> [a]
shrink (ChannelSize
a, ChannelSize
b, ChannelSize
c, DistinctList Object
d) ]

type ChannelSize = Positive (Small Word16)

positiveWord16ToNat :: ChannelSize -> Natural
positiveWord16ToNat :: ChannelSize -> Natural
positiveWord16ToNat (Positive (Small Word16
n)) = Word16 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
n

testInboundPipelined
  :: Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
  -> ObjectDiffusionTestParams
  -> ObjectDiffusionInboundPipelined ObjectId Object m [Object]
testInboundPipelined :: forall (m :: * -> *).
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> ObjectDiffusionInboundPipelined ObjectId Object m [Object]
testInboundPipelined
  Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
tracer
  ObjectDiffusionTestParams {
    testMaxUnacked :: ObjectDiffusionTestParams -> ChannelSize
testMaxUnacked            = Positive (Small Word16
maxUnacked),
    testMaxObjectIdsToRequest :: ObjectDiffusionTestParams -> ChannelSize
testMaxObjectIdsToRequest = Positive (Small Word16
maxObjectIdsToRequest),
    testMaxObjectsToRequest :: ObjectDiffusionTestParams -> ChannelSize
testMaxObjectsToRequest   = Positive (Small Word16
maxObjectsToRequest)
  } =
    Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> (Object -> ObjectId)
-> Word16
-> Word16
-> Word16
-> ObjectDiffusionInboundPipelined ObjectId Object m [Object]
forall objectId object (m :: * -> *).
(Ord objectId, WithCaughtUpDetection objectId) =>
Tracer m (TraceObjectDiffusionTestImplem objectId object)
-> (object -> objectId)
-> Word16
-> Word16
-> Word16
-> ObjectDiffusionInboundPipelined objectId object m [object]
testObjectDiffusionInbound
      Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
tracer
      Object -> ObjectId
getObjectId
      Word16
maxUnacked
      Word16
maxObjectIdsToRequest
      Word16
maxObjectsToRequest

testOutbound
  :: Monad m
  => Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
  -> ObjectDiffusionTestParams
  -> ObjectDiffusionOutbound ObjectId Object m ()
testOutbound :: forall (m :: * -> *).
Monad m =>
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> ObjectDiffusionOutbound ObjectId Object m ()
testOutbound
  Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
tracer
  ObjectDiffusionTestParams {
    testMaxUnacked :: ObjectDiffusionTestParams -> ChannelSize
testMaxUnacked = Positive (Small Word16
maxUnacked),
    testObjects :: ObjectDiffusionTestParams -> DistinctList Object
testObjects    = DistinctList [Object]
objects
  } =
    Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> (Object -> ObjectId)
-> Word16
-> [Object]
-> ObjectDiffusionOutbound ObjectId Object m ()
forall objectId object (m :: * -> *).
(Ord objectId, Show objectId, Monad m,
 WithCaughtUpDetection objectId) =>
Tracer m (TraceObjectDiffusionTestImplem objectId object)
-> (object -> objectId)
-> Word16
-> [object]
-> ObjectDiffusionOutbound objectId object m ()
testObjectDiffusionOutbound
      Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
tracer
      Object -> ObjectId
getObjectId
      Word16
maxUnacked
      [Object]
objects

-- | Run a simple object diffusion client and server, directly on the wrappers,
-- without going via the 'Peer'.
propDirectST :: ObjectDiffusionTestParams
             -> Property
propDirectST :: ObjectDiffusionTestParams -> Property
propDirectST params :: ObjectDiffusionTestParams
params@ObjectDiffusionTestParams{DistinctList Object
testObjects :: ObjectDiffusionTestParams -> DistinctList Object
testObjects :: DistinctList Object
testObjects} = (forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ do
  objects <- ObjectDiffusionOutbound ObjectId Object (IOSim s) ()
-> ObjectDiffusionInboundPipelined
     ObjectId Object (IOSim s) [Object]
-> IOSim s [Object]
forall objectId object (m :: * -> *) a b.
Monad m =>
ObjectDiffusionOutbound objectId object m a
-> ObjectDiffusionInboundPipelined objectId object m b -> m b
directPipelined
               (Tracer (IOSim s) (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> ObjectDiffusionOutbound ObjectId Object (IOSim s) ()
forall (m :: * -> *).
Monad m =>
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> ObjectDiffusionOutbound ObjectId Object m ()
testOutbound         Tracer (IOSim s) (TraceObjectDiffusionTestImplem ObjectId Object)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer ObjectDiffusionTestParams
params)
               (Tracer (IOSim s) (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> ObjectDiffusionInboundPipelined
     ObjectId Object (IOSim s) [Object]
forall (m :: * -> *).
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> ObjectDiffusionInboundPipelined ObjectId Object m [Object]
testInboundPipelined Tracer (IOSim s) (TraceObjectDiffusionTestImplem ObjectId Object)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer ObjectDiffusionTestParams
params)
  pure $ objects === fromDistinctList testObjects

propDirectIO :: ObjectDiffusionTestParams
             -> Property
propDirectIO :: ObjectDiffusionTestParams -> Property
propDirectIO params :: ObjectDiffusionTestParams
params@ObjectDiffusionTestParams{DistinctList Object
testObjects :: ObjectDiffusionTestParams -> DistinctList Object
testObjects :: DistinctList Object
testObjects} = IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
  objects <- ObjectDiffusionOutbound ObjectId Object IO ()
-> ObjectDiffusionInboundPipelined ObjectId Object IO [Object]
-> IO [Object]
forall objectId object (m :: * -> *) a b.
Monad m =>
ObjectDiffusionOutbound objectId object m a
-> ObjectDiffusionInboundPipelined objectId object m b -> m b
directPipelined
               (Tracer IO (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> ObjectDiffusionOutbound ObjectId Object IO ()
forall (m :: * -> *).
Monad m =>
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> ObjectDiffusionOutbound ObjectId Object m ()
testOutbound         Tracer IO (TraceObjectDiffusionTestImplem ObjectId Object)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer ObjectDiffusionTestParams
params)
               (Tracer IO (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> ObjectDiffusionInboundPipelined ObjectId Object IO [Object]
forall (m :: * -> *).
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> ObjectDiffusionInboundPipelined ObjectId Object m [Object]
testInboundPipelined Tracer IO (TraceObjectDiffusionTestImplem ObjectId Object)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer ObjectDiffusionTestParams
params)
  pure $ objects === fromDistinctList testObjects


-- | Wrap the inbound (client) test implem as a pipelined typed-protocol 'PeerPipelined'.
testInboundPeerPipelined
  :: Monad m
  => Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
  -> ObjectDiffusionTestParams
  -> PeerPipelined (ObjectDiffusion ObjectId Object) AsClient StInit m [Object]
testInboundPeerPipelined :: forall (m :: * -> *).
Monad m =>
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> PeerPipelined
     (ObjectDiffusion ObjectId Object) 'AsClient 'StInit m [Object]
testInboundPeerPipelined Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
tracer ObjectDiffusionTestParams
params =
    ObjectDiffusionInboundPipelined ObjectId Object m [Object]
-> PeerPipelined
     (ObjectDiffusion ObjectId Object) 'AsClient 'StInit m [Object]
forall objectId object (m :: * -> *) a.
Functor m =>
ObjectDiffusionInboundPipelined objectId object m a
-> PeerPipelined
     (ObjectDiffusion objectId object) 'AsClient 'StInit m a
objectDiffusionInboundPeerPipelined (Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> ObjectDiffusionInboundPipelined ObjectId Object m [Object]
forall (m :: * -> *).
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> ObjectDiffusionInboundPipelined ObjectId Object m [Object]
testInboundPipelined Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
tracer ObjectDiffusionTestParams
params)

-- | Wrap the outbound (server) implem as a non-pipelined typed-protocol 'Peer'.
testOutboundPeer
  :: Monad m
  => Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
  -> ObjectDiffusionTestParams
  -> Peer (ObjectDiffusion ObjectId Object) AsServer NonPipelined StInit m ()
testOutboundPeer :: forall (m :: * -> *).
Monad m =>
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> Peer
     (ObjectDiffusion ObjectId Object)
     'AsServer
     'NonPipelined
     'StInit
     m
     ()
testOutboundPeer Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
tracer ObjectDiffusionTestParams
params =
    ObjectDiffusionOutbound ObjectId Object m ()
-> Peer
     (ObjectDiffusion ObjectId Object)
     'AsServer
     'NonPipelined
     'StInit
     m
     ()
forall objectId object (m :: * -> *) a.
Monad m =>
ObjectDiffusionOutbound objectId object m a
-> Peer
     (ObjectDiffusion objectId object)
     'AsServer
     'NonPipelined
     'StInit
     m
     a
objectDiffusionOutboundPeer (Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> ObjectDiffusionOutbound ObjectId Object m ()
forall (m :: * -> *).
Monad m =>
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> ObjectDiffusionOutbound ObjectId Object m ()
testOutbound Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
tracer ObjectDiffusionTestParams
params)

-- | Run a simple object diffusion client and server, using 'connectPipelined'
-- via the typed-protocol 'Peer' and 'PeerPipelined'.
propConnectST
  :: ObjectDiffusionTestParams
  -> [Bool]
  -> Property
propConnectST :: ObjectDiffusionTestParams -> [Bool] -> Property
propConnectST params :: ObjectDiffusionTestParams
params@ObjectDiffusionTestParams{DistinctList Object
testObjects :: ObjectDiffusionTestParams -> DistinctList Object
testObjects :: DistinctList Object
testObjects} [Bool]
choices = (forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ do
    (objects, _, _) <- [Bool]
-> PeerPipelined
     (ObjectDiffusion ObjectId Object)
     'AsClient
     'StInit
     (IOSim s)
     [Object]
-> Peer
     (ObjectDiffusion ObjectId Object)
     (FlipAgency 'AsClient)
     'NonPipelined
     'StInit
     (IOSim s)
     ()
-> IOSim
     s ([Object], (), TerminalStates (ObjectDiffusion ObjectId Object))
forall ps (pr :: PeerRole) (st :: ps) (m :: * -> *) a b.
(Monad m, SingI pr) =>
[Bool]
-> PeerPipelined ps pr st m a
-> Peer ps (FlipAgency pr) 'NonPipelined st m b
-> m (a, b, TerminalStates ps)
connectPipelined
                         [Bool]
choices
                         (Tracer (IOSim s) (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> PeerPipelined
     (ObjectDiffusion ObjectId Object)
     'AsClient
     'StInit
     (IOSim s)
     [Object]
forall (m :: * -> *).
Monad m =>
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> PeerPipelined
     (ObjectDiffusion ObjectId Object) 'AsClient 'StInit m [Object]
testInboundPeerPipelined Tracer (IOSim s) (TraceObjectDiffusionTestImplem ObjectId Object)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer ObjectDiffusionTestParams
params)
                         (Tracer (IOSim s) (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> Peer
     (ObjectDiffusion ObjectId Object)
     'AsServer
     'NonPipelined
     'StInit
     (IOSim s)
     ()
forall (m :: * -> *).
Monad m =>
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> Peer
     (ObjectDiffusion ObjectId Object)
     'AsServer
     'NonPipelined
     'StInit
     m
     ()
testOutboundPeer         Tracer (IOSim s) (TraceObjectDiffusionTestImplem ObjectId Object)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer ObjectDiffusionTestParams
params)
    pure $ objects === fromDistinctList testObjects

propConnectIO
  :: ObjectDiffusionTestParams
  -> [Bool]
  -> Property
propConnectIO :: ObjectDiffusionTestParams -> [Bool] -> Property
propConnectIO params :: ObjectDiffusionTestParams
params@ObjectDiffusionTestParams{DistinctList Object
testObjects :: ObjectDiffusionTestParams -> DistinctList Object
testObjects :: DistinctList Object
testObjects} [Bool]
choices = IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
    (objects, _, _) <- [Bool]
-> PeerPipelined
     (ObjectDiffusion ObjectId Object) 'AsClient 'StInit IO [Object]
-> Peer
     (ObjectDiffusion ObjectId Object)
     (FlipAgency 'AsClient)
     'NonPipelined
     'StInit
     IO
     ()
-> IO
     ([Object], (), TerminalStates (ObjectDiffusion ObjectId Object))
forall ps (pr :: PeerRole) (st :: ps) (m :: * -> *) a b.
(Monad m, SingI pr) =>
[Bool]
-> PeerPipelined ps pr st m a
-> Peer ps (FlipAgency pr) 'NonPipelined st m b
-> m (a, b, TerminalStates ps)
connectPipelined
                         [Bool]
choices
                         (Tracer IO (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> PeerPipelined
     (ObjectDiffusion ObjectId Object) 'AsClient 'StInit IO [Object]
forall (m :: * -> *).
Monad m =>
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> PeerPipelined
     (ObjectDiffusion ObjectId Object) 'AsClient 'StInit m [Object]
testInboundPeerPipelined Tracer IO (TraceObjectDiffusionTestImplem ObjectId Object)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer ObjectDiffusionTestParams
params)
                         (Tracer IO (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> Peer
     (ObjectDiffusion ObjectId Object)
     'AsServer
     'NonPipelined
     'StInit
     IO
     ()
forall (m :: * -> *).
Monad m =>
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> Peer
     (ObjectDiffusion ObjectId Object)
     'AsServer
     'NonPipelined
     'StInit
     m
     ()
testOutboundPeer         Tracer IO (TraceObjectDiffusionTestImplem ObjectId Object)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer ObjectDiffusionTestParams
params)
    pure $ objects === fromDistinctList testObjects


-- | Run the object diffusion protocol over a pair of connected channels,
-- using the codec, 'runPeer' for the server and 'runPipelinedPeer' for the
-- pipelined client.
objectDiffusionDemoPipelined
  :: forall m.
     ( MonadST       m
     , MonadFork     m
     , MonadThrow    m
     , MonadEvaluate m
     , MonadAsync    m
     )
  => Channel m ByteString
  -> Channel m ByteString
  -> ObjectDiffusionTestParams
  -> m [Object]
objectDiffusionDemoPipelined :: forall (m :: * -> *).
(MonadST m, MonadFork m, MonadThrow m, MonadEvaluate m,
 MonadAsync m) =>
Channel m ByteString
-> Channel m ByteString -> ObjectDiffusionTestParams -> m [Object]
objectDiffusionDemoPipelined Channel m ByteString
clientChan Channel m ByteString
serverChan ObjectDiffusionTestParams
params = do
  let server :: Peer
  (ObjectDiffusion ObjectId Object)
  'AsServer
  'NonPipelined
  'StInit
  m
  ()
server = Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> Peer
     (ObjectDiffusion ObjectId Object)
     'AsServer
     'NonPipelined
     'StInit
     m
     ()
forall (m :: * -> *).
Monad m =>
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> Peer
     (ObjectDiffusion ObjectId Object)
     'AsServer
     'NonPipelined
     'StInit
     m
     ()
testOutboundPeer         Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer ObjectDiffusionTestParams
params
      client :: PeerPipelined
  (ObjectDiffusion ObjectId Object) 'AsClient 'StInit m [Object]
client = Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> PeerPipelined
     (ObjectDiffusion ObjectId Object) 'AsClient 'StInit m [Object]
forall (m :: * -> *).
Monad m =>
Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
-> ObjectDiffusionTestParams
-> PeerPipelined
     (ObjectDiffusion ObjectId Object) 'AsClient 'StInit m [Object]
testInboundPeerPipelined Tracer m (TraceObjectDiffusionTestImplem ObjectId Object)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer ObjectDiffusionTestParams
params

  -- We only fork the server, and we run the client to completion to extract the
  -- list of objects received as the result.
  _      <- m () -> m (ThreadId m)
forall (m :: * -> *). MonadFork m => m () -> m (ThreadId m)
forkIO (m ((), Maybe ByteString) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ((), Maybe ByteString) -> m ())
-> m ((), Maybe ByteString) -> m ()
forall a b. (a -> b) -> a -> b
$ Tracer m (TraceSendRecv (ObjectDiffusion ObjectId Object))
-> Codec
     (ObjectDiffusion ObjectId Object) DeserialiseFailure m ByteString
-> Channel m ByteString
-> Peer
     (ObjectDiffusion ObjectId Object)
     'AsServer
     'NonPipelined
     'StInit
     m
     ()
-> m ((), Maybe ByteString)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadEvaluate m, MonadThrow m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeer          Tracer m (TraceSendRecv (ObjectDiffusion ObjectId Object))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer Codec
  (ObjectDiffusion ObjectId Object) DeserialiseFailure m ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (ObjectDiffusion ObjectId Object) DeserialiseFailure m ByteString
codec Channel m ByteString
serverChan Peer
  (ObjectDiffusion ObjectId Object)
  'AsServer
  'NonPipelined
  'StInit
  m
  ()
server)
  (r, _) <-                runPipelinedPeer nullTracer codec clientChan client
  pure r

-- | Run the object diffusion demo over pipeline test channels.

-- With 'createPipelineTestChannels', the peer is responsible for not exceeding the channel buffer size, and the test will fail if it does.
-- So we make sure the buffer size is greater or equal than the upper bound of pipelined requests, which is 2 * 'testMaxUnacked'
-- (see how this upper bound is computed in 'NodeToNode.hs' -> 'MiniProtocolParameters' -> 'perasCertDiffusionMaxObjectsUnacknowledged')

propDemoChannelST
  :: ObjectDiffusionTestParams
  -> ChannelSize
  -> Property
propDemoChannelST :: ObjectDiffusionTestParams -> ChannelSize -> Property
propDemoChannelST params :: ObjectDiffusionTestParams
params@ObjectDiffusionTestParams{DistinctList Object
testObjects :: ObjectDiffusionTestParams -> DistinctList Object
testObjects :: DistinctList Object
testObjects, ChannelSize
testMaxUnacked :: ObjectDiffusionTestParams -> ChannelSize
testMaxUnacked :: ChannelSize
testMaxUnacked} ChannelSize
chanSize = (forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ do
    let actualChanSize :: Natural
actualChanSize = ChannelSize -> Natural
positiveWord16ToNat ChannelSize
chanSize Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
`max` Natural
2 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* (ChannelSize -> Natural
positiveWord16ToNat ChannelSize
testMaxUnacked)
    (clientChan, serverChan) <- Natural
-> IOSim
     s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
forall (m :: * -> *) a.
MonadSTM m =>
Natural -> m (Channel m a, Channel m a)
createPipelineTestChannels Natural
actualChanSize
    objects <- objectDiffusionDemoPipelined clientChan serverChan params
    pure $ objects === fromDistinctList testObjects

propDemoChannelIO
  :: ObjectDiffusionTestParams
  -> ChannelSize
  -> Property
propDemoChannelIO :: ObjectDiffusionTestParams -> ChannelSize -> Property
propDemoChannelIO params :: ObjectDiffusionTestParams
params@ObjectDiffusionTestParams{DistinctList Object
testObjects :: ObjectDiffusionTestParams -> DistinctList Object
testObjects :: DistinctList Object
testObjects, ChannelSize
testMaxUnacked :: ObjectDiffusionTestParams -> ChannelSize
testMaxUnacked :: ChannelSize
testMaxUnacked} ChannelSize
chanSize = IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
    let actualChanSize :: Natural
actualChanSize = ChannelSize -> Natural
positiveWord16ToNat ChannelSize
chanSize Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
`max` Natural
2 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* (ChannelSize -> Natural
positiveWord16ToNat ChannelSize
testMaxUnacked)
    (clientChan, serverChan) <- Natural -> IO (Channel IO ByteString, Channel IO ByteString)
forall (m :: * -> *) a.
MonadSTM m =>
Natural -> m (Channel m a, Channel m a)
createPipelineTestChannels Natural
actualChanSize
    objects <- objectDiffusionDemoPipelined clientChan serverChan params
    pure $ objects === fromDistinctList testObjects

-- | Run the object diffusion demo over buffered channels.
propDemoChannelBufferedST
  :: ObjectDiffusionTestParams
  -> ChannelSize
  -> Property
propDemoChannelBufferedST :: ObjectDiffusionTestParams -> ChannelSize -> Property
propDemoChannelBufferedST params :: ObjectDiffusionTestParams
params@ObjectDiffusionTestParams{DistinctList Object
testObjects :: ObjectDiffusionTestParams -> DistinctList Object
testObjects :: DistinctList Object
testObjects} ChannelSize
chanSize = (forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ do
    (clientChan, serverChan) <- Natural
-> IOSim
     s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
forall (m :: * -> *) a.
MonadLabelledSTM m =>
Natural -> m (Channel m a, Channel m a)
createConnectedBufferedChannels (ChannelSize -> Natural
positiveWord16ToNat ChannelSize
chanSize)
    objects <- objectDiffusionDemoPipelined clientChan serverChan params
    pure $ objects === fromDistinctList testObjects

propDemoChannelBufferedIO
  :: ObjectDiffusionTestParams
  -> ChannelSize
  -> Property
propDemoChannelBufferedIO :: ObjectDiffusionTestParams -> ChannelSize -> Property
propDemoChannelBufferedIO params :: ObjectDiffusionTestParams
params@ObjectDiffusionTestParams{DistinctList Object
testObjects :: ObjectDiffusionTestParams -> DistinctList Object
testObjects :: DistinctList Object
testObjects} ChannelSize
chanSize = IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
    (clientChan, serverChan) <- Natural -> IO (Channel IO ByteString, Channel IO ByteString)
forall (m :: * -> *) a.
MonadLabelledSTM m =>
Natural -> m (Channel m a, Channel m a)
createConnectedBufferedChannels (ChannelSize -> Natural
positiveWord16ToNat ChannelSize
chanSize)
    objects <- objectDiffusionDemoPipelined clientChan serverChan params
    pure $ objects === fromDistinctList testObjects