{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}

-- | Tests of LeiosNotify's client and server, run against each other over
-- connected channels with a real codec.
module Test.Consensus.Leios.LeiosNotify.Protocol
  ( ExcessiveOutcome (..)
  , P
  , WhetherDisconnected (..)
  , codec
  , runPipelinedClient
  , sizeLimits
  , tests
  ) where

import qualified Codec.CBOR.Decoding as CBOR
import qualified Codec.CBOR.Encoding as CBOR
import qualified Codec.CBOR.Read as CBOR
import Control.Concurrent.Class.MonadSTM.Strict
import Control.Monad.Class.MonadAsync
import Control.Monad.Class.MonadThrow
import Control.Monad.IOSim (IOSim, runSimOrThrow)
import Control.Tracer (nullTracer)
import qualified Data.ByteString.Lazy as BSL
import Network.TypedProtocol.Codec (Codec)
import Ouroboros.Consensus.MiniProtocol.LeiosNotify.Client
import Ouroboros.Consensus.MiniProtocol.LeiosNotify.Server
import Ouroboros.Consensus.MiniProtocol.LeiosNotify.Type
import Ouroboros.Consensus.Network.LeiosNotify (runLookaheadFixedSenderPeerWithLimits)
import Ouroboros.Network.Channel (Channel, createConnectedBufferedChannels)
import Ouroboros.Network.Driver.Limits (runPipelinedPeerWithLimits)
import Ouroboros.Network.Protocol.Limits (ProtocolSizeLimits)
import Ouroboros.Network.Util.ShowProxy (ShowProxy)
import Test.Tasty
import Test.Tasty.HUnit

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"client and server"
    [ TestName -> Assertion -> TestTree
testCase TestName
"the server cancels every outstanding request when the client quits" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s OutstandingOutcome) -> OutstandingOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (Int -> IOSim s OutstandingOutcome
forall s. Int -> IOSim s OutstandingOutcome
outstandingCanceled Int
3) OutstandingOutcome -> OutstandingOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int -> Int -> OutstandingOutcome
OutstandingOutcome Int
3 Int
0
    , TestName -> Assertion -> TestTree
testCase TestName
"the server disconnects a client that exceeds its pipelining bound" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ExcessiveOutcome) -> ExcessiveOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow IOSim s ExcessiveOutcome
forall s. IOSim s ExcessiveOutcome
excessive ExcessiveOutcome -> ExcessiveOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= WhetherDisconnected -> ExcessiveOutcome
ExcessiveOutcome WhetherDisconnected
Disconnected
    ]

type P = LeiosNotify Int Int Int

codec :: Codec P CBOR.DeserialiseFailure (IOSim s) BSL.ByteString
codec :: forall s. Codec P DeserialiseFailure (IOSim s) ByteString
codec =
  (Int -> Encoding)
-> (forall s. Decoder s Int)
-> (Int -> Encoding)
-> (forall s. Decoder s Int)
-> (Int -> Encoding)
-> (forall s. Decoder s Int)
-> Codec P DeserialiseFailure (IOSim s) ByteString
forall point announcement vote (m :: * -> *).
MonadST m =>
(point -> Encoding)
-> (forall s. Decoder s point)
-> (announcement -> Encoding)
-> (forall s. Decoder s announcement)
-> (vote -> Encoding)
-> (forall s. Decoder s vote)
-> Codec
     (LeiosNotify point announcement vote)
     DeserialiseFailure
     m
     ByteString
codecLeiosNotify
    Int -> Encoding
CBOR.encodeInt
    Decoder s Int
forall s. Decoder s Int
CBOR.decodeInt
    Int -> Encoding
CBOR.encodeInt
    Decoder s Int
forall s. Decoder s Int
CBOR.decodeInt
    Int -> Encoding
CBOR.encodeInt
    Decoder s Int
forall s. Decoder s Int
CBOR.decodeInt

sizeLimits :: ProtocolSizeLimits (LeiosNotify point announcement vote) BSL.ByteString
sizeLimits :: forall point announcement vote.
ProtocolSizeLimits (LeiosNotify point announcement vote) ByteString
sizeLimits = (ByteString -> Word)
-> ProtocolSizeLimits
     (LeiosNotify point announcement vote) ByteString
forall bytes point announcement vote.
(bytes -> Word)
-> ProtocolSizeLimits (LeiosNotify point announcement vote) bytes
byteLimitsLeiosNotify (Int64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word) -> (ByteString -> Int64) -> ByteString -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length)

-- | Run a server that never replies, counting requests and refusing more than
-- @bound@.
runServer ::
  (ShowProxy point, ShowProxy announcement, ShowProxy vote) =>
  Codec (LeiosNotify point announcement vote) CBOR.DeserialiseFailure (IOSim s) BSL.ByteString ->
  StrictTVar (IOSim s) Int ->
  Int ->
  Channel (IOSim s) BSL.ByteString ->
  IOSim s ()
runServer :: forall point announcement vote s.
(ShowProxy point, ShowProxy announcement, ShowProxy vote) =>
Codec
  (LeiosNotify point announcement vote)
  DeserialiseFailure
  (IOSim s)
  ByteString
-> StrictTVar (IOSim s) Int
-> Int
-> Channel (IOSim s) ByteString
-> IOSim s ()
runServer Codec
  (LeiosNotify point announcement vote)
  DeserialiseFailure
  (IOSim s)
  ByteString
c StrictTVar (IOSim s) Int
requests Int
bound Channel (IOSim s) ByteString
chan = do
  peer <-
    IOSim s WhetherExcessiveRequests
-> STM
     (IOSim s)
     (Message (LeiosNotify point announcement vote) 'StBusy 'StIdle)
-> IOSim
     s
     (LeiosNotifyServerPeerLookahead point announcement vote (IOSim s))
forall (m :: * -> *) point announcement vote.
(MonadThrow m, MonadSTM m) =>
m WhetherExcessiveRequests
-> STM
     m (Message (LeiosNotify point announcement vote) 'StBusy 'StIdle)
-> m (LeiosNotifyServerPeerLookahead point announcement vote m)
leiosNotifyServerPeerLookahead
      ( STM (IOSim s) WhetherExcessiveRequests
-> IOSim s WhetherExcessiveRequests
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (IOSim s) WhetherExcessiveRequests
 -> IOSim s WhetherExcessiveRequests)
-> STM (IOSim s) WhetherExcessiveRequests
-> IOSim s WhetherExcessiveRequests
forall a b. (a -> b) -> a -> b
$ do
          n <- StrictTVar (IOSim s) Int -> STM (IOSim s) Int
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar (IOSim s) Int
requests
          if n >= bound
            then pure ExcessiveRequests
            else do
              writeTVar requests (n + 1)
              pure NotExcessiveRequests
      )
      STM
  (IOSim s)
  (Message (LeiosNotify point announcement vote) 'StBusy 'StIdle)
forall a. STM (IOSim s) a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
  fst
    <$> runLookaheadFixedSenderPeerWithLimits nullTracer c sizeLimits timeLimitsLeiosNotify chan peer

-- | Run the pipelined client at the given depth until @stop@ is filled,
-- counting the replies it handles.
runPipelinedClient ::
  (ShowProxy point, ShowProxy announcement, ShowProxy vote) =>
  Codec (LeiosNotify point announcement vote) CBOR.DeserialiseFailure (IOSim s) BSL.ByteString ->
  StrictTVar (IOSim s) Int ->
  Int ->
  StrictTMVar (IOSim s) () ->
  Channel (IOSim s) BSL.ByteString ->
  IOSim s ()
runPipelinedClient :: forall point announcement vote s.
(ShowProxy point, ShowProxy announcement, ShowProxy vote) =>
Codec
  (LeiosNotify point announcement vote)
  DeserialiseFailure
  (IOSim s)
  ByteString
-> StrictTVar (IOSim s) Int
-> Int
-> StrictTMVar (IOSim s) ()
-> Channel (IOSim s) ByteString
-> IOSim s ()
runPipelinedClient Codec
  (LeiosNotify point announcement vote)
  DeserialiseFailure
  (IOSim s)
  ByteString
c StrictTVar (IOSim s) Int
replies Int
depth StrictTMVar (IOSim s) ()
stop Channel (IOSim s) ByteString
chan =
  ((), Maybe ByteString) -> ()
forall a b. (a, b) -> a
fst
    (((), Maybe ByteString) -> ())
-> IOSim s ((), Maybe ByteString) -> IOSim s ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tracer
  (IOSim s) (TraceSendRecv (LeiosNotify point announcement vote))
-> Codec
     (LeiosNotify point announcement vote)
     DeserialiseFailure
     (IOSim s)
     ByteString
-> ProtocolSizeLimits
     (LeiosNotify point announcement vote) ByteString
-> ProtocolTimeLimits (LeiosNotify point announcement vote)
-> Channel (IOSim s) ByteString
-> PeerPipelined
     (LeiosNotify point announcement vote)
     'AsClient
     'StIdle
     (IOSim s)
     ()
-> IOSim s ((), Maybe ByteString)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadTimer m, MonadThrow (STM 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
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
runPipelinedPeerWithLimits
      Tracer
  (IOSim s) (TraceSendRecv (LeiosNotify point announcement vote))
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer
      Codec
  (LeiosNotify point announcement vote)
  DeserialiseFailure
  (IOSim s)
  ByteString
c
      ProtocolSizeLimits (LeiosNotify point announcement vote) ByteString
forall point announcement vote.
ProtocolSizeLimits (LeiosNotify point announcement vote) ByteString
sizeLimits
      ProtocolTimeLimits (LeiosNotify point announcement vote)
forall point announcement vote.
ProtocolTimeLimits (LeiosNotify point announcement vote)
timeLimitsLeiosNotify
      Channel (IOSim s) ByteString
chan
      ( Peer
  (LeiosNotify point announcement vote)
  'AsClient
  ('Pipelined 'Z C)
  'StIdle
  (IOSim s)
  ()
-> PeerPipelined
     (LeiosNotify point announcement vote)
     'AsClient
     'StIdle
     (IOSim s)
     ()
forall point announcement vote (m :: * -> *) a.
Peer
  (LeiosNotify point announcement vote)
  'AsClient
  ('Pipelined 'Z C)
  'StIdle
  m
  a
-> LeiosNotifyClientPeerPipelined point announcement vote m a
toLeiosNotifyClientPeerPipelined (Peer
   (LeiosNotify point announcement vote)
   'AsClient
   ('Pipelined 'Z C)
   'StIdle
   (IOSim s)
   ()
 -> PeerPipelined
      (LeiosNotify point announcement vote)
      'AsClient
      'StIdle
      (IOSim s)
      ())
-> Peer
     (LeiosNotify point announcement vote)
     'AsClient
     ('Pipelined 'Z C)
     'StIdle
     (IOSim s)
     ()
-> PeerPipelined
     (LeiosNotify point announcement vote)
     'AsClient
     'StIdle
     (IOSim s)
     ()
forall a b. (a -> b) -> a -> b
$
          STM (IOSim s) (Either () Int)
-> IOSim
     s
     (Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
      -> IOSim s ())
-> Peer
     (LeiosNotify point announcement vote)
     'AsClient
     ('Pipelined 'Z C)
     'StIdle
     (IOSim s)
     ()
forall (m :: * -> *) point announcement vote a.
(PrimMonad m, MonadSTM m) =>
STM m (Either a Int)
-> m (Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
      -> m ())
-> Peer
     (LeiosNotify point announcement vote)
     'AsClient
     ('Pipelined 'Z C)
     'StIdle
     m
     a
leiosNotifyClientPeerPipelined
            ((() -> Either () Int
forall a b. a -> Either a b
Left (() -> Either () Int) -> STM s () -> STM s (Either () Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTMVar (IOSim s) () -> STM (IOSim s) ()
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar (IOSim s) ()
stop) STM (IOSim s) (Either () Int)
-> STM (IOSim s) (Either () Int) -> STM (IOSim s) (Either () Int)
forall a. STM (IOSim s) a -> STM (IOSim s) a -> STM (IOSim s) a
forall (m :: * -> *) a. MonadSTM m => STM m a -> STM m a -> STM m a
`orElse` Either () Int -> STM s (Either () Int)
forall a. a -> STM s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either () Int
forall a b. b -> Either a b
Right Int
depth))
            ((Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
 -> IOSim s ())
-> IOSim
     s
     (Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
      -> IOSim s ())
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
  -> IOSim s ())
 -> IOSim
      s
      (Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
       -> IOSim s ()))
-> (Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
    -> IOSim s ())
-> IOSim
     s
     (Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
      -> IOSim s ())
forall a b. (a -> b) -> a -> b
$ \Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
_msg -> STM (IOSim s) () -> IOSim s ()
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (IOSim s) () -> IOSim s ()) -> STM (IOSim s) () -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ StrictTVar (IOSim s) Int -> (Int -> Int) -> STM (IOSim s) ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> (a -> a) -> STM m ()
modifyTVar StrictTVar (IOSim s) Int
replies (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
      )

data OutstandingOutcome = OutstandingOutcome Int Int
  deriving (OutstandingOutcome -> OutstandingOutcome -> Bool
(OutstandingOutcome -> OutstandingOutcome -> Bool)
-> (OutstandingOutcome -> OutstandingOutcome -> Bool)
-> Eq OutstandingOutcome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutstandingOutcome -> OutstandingOutcome -> Bool
== :: OutstandingOutcome -> OutstandingOutcome -> Bool
$c/= :: OutstandingOutcome -> OutstandingOutcome -> Bool
/= :: OutstandingOutcome -> OutstandingOutcome -> Bool
Eq, Int -> OutstandingOutcome -> ShowS
[OutstandingOutcome] -> ShowS
OutstandingOutcome -> TestName
(Int -> OutstandingOutcome -> ShowS)
-> (OutstandingOutcome -> TestName)
-> ([OutstandingOutcome] -> ShowS)
-> Show OutstandingOutcome
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutstandingOutcome -> ShowS
showsPrec :: Int -> OutstandingOutcome -> ShowS
$cshow :: OutstandingOutcome -> TestName
show :: OutstandingOutcome -> TestName
$cshowList :: [OutstandingOutcome] -> ShowS
showList :: [OutstandingOutcome] -> ShowS
Show)

-- | Fill the pipeline, then quit: the server sees every request, and the
-- client handles none of the cancellations, since it is already quitting.
outstandingCanceled :: Int -> IOSim s OutstandingOutcome
outstandingCanceled :: forall s. Int -> IOSim s OutstandingOutcome
outstandingCanceled Int
depth = 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 Natural
10
  requests <- newTVarIO 0
  replies <- newTVarIO 0
  stop <- newEmptyTMVarIO
  withAsync (runServer codec requests depth serverChan) $ \Async (IOSim s) ()
server ->
    IOSim s ()
-> (Async (IOSim s) () -> IOSim s OutstandingOutcome)
-> IOSim s OutstandingOutcome
forall a b.
IOSim s a -> (Async (IOSim s) a -> IOSim s b) -> IOSim s b
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
withAsync (Codec P DeserialiseFailure (IOSim s) ByteString
-> StrictTVar (IOSim s) Int
-> Int
-> StrictTMVar (IOSim s) ()
-> Channel (IOSim s) ByteString
-> IOSim s ()
forall point announcement vote s.
(ShowProxy point, ShowProxy announcement, ShowProxy vote) =>
Codec
  (LeiosNotify point announcement vote)
  DeserialiseFailure
  (IOSim s)
  ByteString
-> StrictTVar (IOSim s) Int
-> Int
-> StrictTMVar (IOSim s) ()
-> Channel (IOSim s) ByteString
-> IOSim s ()
runPipelinedClient Codec P DeserialiseFailure (IOSim s) ByteString
forall s. Codec P DeserialiseFailure (IOSim s) ByteString
codec StrictTVar (IOSim s) Int
replies Int
depth StrictTMVar (IOSim s) ()
stop Channel (IOSim s) ByteString
clientChan) ((Async (IOSim s) () -> IOSim s OutstandingOutcome)
 -> IOSim s OutstandingOutcome)
-> (Async (IOSim s) () -> IOSim s OutstandingOutcome)
-> IOSim s OutstandingOutcome
forall a b. (a -> b) -> a -> b
$ \Async (IOSim s) ()
client -> do
      STM (IOSim s) () -> IOSim s ()
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (IOSim s) () -> IOSim s ()) -> STM (IOSim s) () -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ StrictTVar (IOSim s) Int -> STM (IOSim s) Int
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar (IOSim s) Int
requests STM (IOSim s) Int -> (Int -> STM (IOSim s) ()) -> STM (IOSim s) ()
forall a b.
STM (IOSim s) a -> (a -> STM (IOSim s) b) -> STM (IOSim s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> STM (IOSim s) ()
Bool -> STM s ()
forall (m :: * -> *). MonadSTM m => Bool -> STM m ()
check (Bool -> STM s ()) -> (Int -> Bool) -> Int -> STM s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
depth)
      STM (IOSim s) () -> IOSim s ()
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (IOSim s) () -> IOSim s ()) -> STM (IOSim s) () -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ StrictTMVar (IOSim s) () -> () -> STM (IOSim s) ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> a -> STM m ()
putTMVar StrictTMVar (IOSim s) ()
stop ()
      Async (IOSim s) () -> IOSim s ()
forall a. Async (IOSim s) a -> IOSim s a
forall (m :: * -> *) a. MonadAsync m => Async m a -> m a
wait Async (IOSim s) ()
client
      Async (IOSim s) () -> IOSim s ()
forall a. Async (IOSim s) a -> IOSim s a
forall (m :: * -> *) a. MonadAsync m => Async m a -> m a
wait Async (IOSim s) ()
server
      Int -> Int -> OutstandingOutcome
OutstandingOutcome (Int -> Int -> OutstandingOutcome)
-> IOSim s Int -> IOSim s (Int -> OutstandingOutcome)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar (IOSim s) Int -> IOSim s Int
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO StrictTVar (IOSim s) Int
requests IOSim s (Int -> OutstandingOutcome)
-> IOSim s Int -> IOSim s OutstandingOutcome
forall a b. IOSim s (a -> b) -> IOSim s a -> IOSim s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictTVar (IOSim s) Int -> IOSim s Int
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO StrictTVar (IOSim s) Int
replies

data WhetherDisconnected = Disconnected | NotDisconnected
  deriving (WhetherDisconnected -> WhetherDisconnected -> Bool
(WhetherDisconnected -> WhetherDisconnected -> Bool)
-> (WhetherDisconnected -> WhetherDisconnected -> Bool)
-> Eq WhetherDisconnected
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WhetherDisconnected -> WhetherDisconnected -> Bool
== :: WhetherDisconnected -> WhetherDisconnected -> Bool
$c/= :: WhetherDisconnected -> WhetherDisconnected -> Bool
/= :: WhetherDisconnected -> WhetherDisconnected -> Bool
Eq, Int -> WhetherDisconnected -> ShowS
[WhetherDisconnected] -> ShowS
WhetherDisconnected -> TestName
(Int -> WhetherDisconnected -> ShowS)
-> (WhetherDisconnected -> TestName)
-> ([WhetherDisconnected] -> ShowS)
-> Show WhetherDisconnected
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WhetherDisconnected -> ShowS
showsPrec :: Int -> WhetherDisconnected -> ShowS
$cshow :: WhetherDisconnected -> TestName
show :: WhetherDisconnected -> TestName
$cshowList :: [WhetherDisconnected] -> ShowS
showList :: [WhetherDisconnected] -> ShowS
Show)

newtype ExcessiveOutcome = ExcessiveOutcome WhetherDisconnected
  deriving (ExcessiveOutcome -> ExcessiveOutcome -> Bool
(ExcessiveOutcome -> ExcessiveOutcome -> Bool)
-> (ExcessiveOutcome -> ExcessiveOutcome -> Bool)
-> Eq ExcessiveOutcome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExcessiveOutcome -> ExcessiveOutcome -> Bool
== :: ExcessiveOutcome -> ExcessiveOutcome -> Bool
$c/= :: ExcessiveOutcome -> ExcessiveOutcome -> Bool
/= :: ExcessiveOutcome -> ExcessiveOutcome -> Bool
Eq, Int -> ExcessiveOutcome -> ShowS
[ExcessiveOutcome] -> ShowS
ExcessiveOutcome -> TestName
(Int -> ExcessiveOutcome -> ShowS)
-> (ExcessiveOutcome -> TestName)
-> ([ExcessiveOutcome] -> ShowS)
-> Show ExcessiveOutcome
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExcessiveOutcome -> ShowS
showsPrec :: Int -> ExcessiveOutcome -> ShowS
$cshow :: ExcessiveOutcome -> TestName
show :: ExcessiveOutcome -> TestName
$cshowList :: [ExcessiveOutcome] -> ShowS
showList :: [ExcessiveOutcome] -> ShowS
Show)

-- | A client pipelining one request more than the server allows.
excessive :: IOSim s ExcessiveOutcome
excessive :: forall s. IOSim s ExcessiveOutcome
excessive = 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 Natural
10
  requests <- newTVarIO 0
  replies <- newTVarIO 0
  stop <- newEmptyTMVarIO
  withAsync (runPipelinedClient codec replies 3 stop clientChan) $ \Async (IOSim s) ()
_client ->
    IOSim s () -> IOSim s ExcessiveOutcome
forall s. IOSim s () -> IOSim s ExcessiveOutcome
disconnectedBy (IOSim s () -> IOSim s ExcessiveOutcome)
-> IOSim s () -> IOSim s ExcessiveOutcome
forall a b. (a -> b) -> a -> b
$ Codec P DeserialiseFailure (IOSim s) ByteString
-> StrictTVar (IOSim s) Int
-> Int
-> Channel (IOSim s) ByteString
-> IOSim s ()
forall point announcement vote s.
(ShowProxy point, ShowProxy announcement, ShowProxy vote) =>
Codec
  (LeiosNotify point announcement vote)
  DeserialiseFailure
  (IOSim s)
  ByteString
-> StrictTVar (IOSim s) Int
-> Int
-> Channel (IOSim s) ByteString
-> IOSim s ()
runServer Codec P DeserialiseFailure (IOSim s) ByteString
forall s. Codec P DeserialiseFailure (IOSim s) ByteString
codec StrictTVar (IOSim s) Int
requests Int
2 Channel (IOSim s) ByteString
serverChan

disconnectedBy :: IOSim s () -> IOSim s ExcessiveOutcome
disconnectedBy :: forall s. IOSim s () -> IOSim s ExcessiveOutcome
disconnectedBy IOSim s ()
server =
  IOSim s () -> IOSim s (Either ExnLeiosNotifyExcessiveRequests ())
forall e a. Exception e => IOSim s a -> IOSim s (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try IOSim s ()
server IOSim s (Either ExnLeiosNotifyExcessiveRequests ())
-> (Either ExnLeiosNotifyExcessiveRequests ()
    -> IOSim s ExcessiveOutcome)
-> IOSim s ExcessiveOutcome
forall a b. IOSim s a -> (a -> IOSim s b) -> IOSim s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ExnLeiosNotifyExcessiveRequests
ExnLeiosNotifyExcessiveRequests -> ExcessiveOutcome -> IOSim s ExcessiveOutcome
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExcessiveOutcome -> IOSim s ExcessiveOutcome)
-> ExcessiveOutcome -> IOSim s ExcessiveOutcome
forall a b. (a -> b) -> a -> b
$ WhetherDisconnected -> ExcessiveOutcome
ExcessiveOutcome WhetherDisconnected
Disconnected
    Right () -> ExcessiveOutcome -> IOSim s ExcessiveOutcome
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExcessiveOutcome -> IOSim s ExcessiveOutcome)
-> ExcessiveOutcome -> IOSim s ExcessiveOutcome
forall a b. (a -> b) -> a -> b
$ WhetherDisconnected -> ExcessiveOutcome
ExcessiveOutcome WhetherDisconnected
NotDisconnected