{-# LANGUAGE RebindableSyntax #-}
module Network.Transport.Tests where
import Prelude hiding
( (>>=)
, return
, fail
, (>>)
#if ! MIN_VERSION_base(4,6,0)
, catch
#endif
)
import Control.Concurrent (forkIO, killThread, yield)
import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar, readMVar, tryTakeMVar, modifyMVar_, newMVar)
import Control.Exception
( evaluate
, throw
, throwIO
, bracket
, catch
, ErrorCall(..)
)
import Control.Monad (replicateM, replicateM_, when, guard, forM_, unless)
import Control.Monad.Error ()
import Control.Applicative ((<$>))
import Network.Transport
import Network.Transport.Internal (tlog, tryIO, timeoutMaybe)
import Network.Transport.Util (spawn)
import System.Random (randomIO)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 (pack)
import Data.Map (Map)
import qualified Data.Map as Map (empty, insert, delete, findWithDefault, adjust, null, toList, map)
import Data.String (fromString)
import Data.List (permutations)
import Network.Transport.Tests.Auxiliary (forkTry, runTests, trySome, randomThreadDelay)
import Network.Transport.Tests.Traced
echoServer :: EndPoint -> IO ()
echoServer :: EndPoint -> IO ()
echoServer EndPoint
endpoint = do
Map ConnectionId Connection -> IO ()
go forall k a. Map k a
Map.empty
where
go :: Map ConnectionId Connection -> IO ()
go :: Map ConnectionId Connection -> IO ()
go Map ConnectionId Connection
cs = do
Event
event <- EndPoint -> IO Event
receive EndPoint
endpoint
case Event
event of
ConnectionOpened ConnectionId
cid Reliability
rel EndPointAddress
addr -> do
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog forall a b. (a -> b) -> a -> b
$ [Char]
"Opened new connection " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ConnectionId
cid
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
addr Reliability
rel ConnectHints
defaultConnectHints
Map ConnectionId Connection -> IO ()
go (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ConnectionId
cid Connection
conn Map ConnectionId Connection
cs)
Received ConnectionId
cid [ByteString]
payload -> do
Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send (forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Received: Invalid cid " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ConnectionId
cid) ConnectionId
cid Map ConnectionId Connection
cs) [ByteString]
payload
Map ConnectionId Connection -> IO ()
go Map ConnectionId Connection
cs
ConnectionClosed ConnectionId
cid -> do
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog forall a b. (a -> b) -> a -> b
$ [Char]
"Close connection " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ConnectionId
cid
Connection -> IO ()
close (forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"ConnectionClosed: Invalid cid " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ConnectionId
cid) ConnectionId
cid Map ConnectionId Connection
cs)
Map ConnectionId Connection -> IO ()
go (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete ConnectionId
cid Map ConnectionId Connection
cs)
ReceivedMulticast MulticastAddress
_ [ByteString]
_ ->
Map ConnectionId Connection -> IO ()
go Map ConnectionId Connection
cs
ErrorEvent TransportError EventErrorCode
_ ->
[Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Echo server received error event: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Event
event
Event
EndPointClosed ->
forall (m :: * -> *) a. MonadS m => a -> m a
return ()
ping :: EndPoint -> EndPointAddress -> Int -> ByteString -> IO ()
ping :: EndPoint -> EndPointAddress -> Int -> ByteString -> IO ()
ping EndPoint
endpoint EndPointAddress
server Int
numPings ByteString
msg = do
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Connect to echo server"
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
server Reliability
ReliableOrdered ConnectHints
defaultConnectHints
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Wait for ConnectionOpened message"
ConnectionOpened ConnectionId
cid Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Send ping and wait for reply"
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numPings forall a b. (a -> b) -> a -> b
$ do
Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ByteString
msg]
Received ConnectionId
cid' [ByteString
reply] <- EndPoint -> IO Event
receive EndPoint
endpoint ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid' Bool -> Bool -> Bool
&& ByteString
reply forall a. Eq a => a -> a -> Bool
== ByteString
msg
forall (m :: * -> *) a. MonadS m => a -> m a
return ()
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Close the connection"
Connection -> IO ()
close Connection
conn
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Wait for ConnectionClosed message"
ConnectionClosed ConnectionId
cid' <- EndPoint -> IO Event
receive EndPoint
endpoint ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid'
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Ping client done"
testPingPong :: Transport -> Int -> IO ()
testPingPong :: Transport -> Int -> IO ()
testPingPong Transport
transport Int
numPings = do
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Starting ping pong test"
EndPointAddress
server <- Transport -> (EndPoint -> IO ()) -> IO EndPointAddress
spawn Transport
transport EndPoint -> IO ()
echoServer
MVar ()
result <- forall a. IO (MVar a)
newEmptyMVar
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Ping client"
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
EndPoint -> EndPointAddress -> Int -> ByteString -> IO ()
ping EndPoint
endpoint EndPointAddress
server Int
numPings ByteString
"ping"
forall a. MVar a -> a -> IO ()
putMVar MVar ()
result ()
forall a. MVar a -> IO a
takeMVar MVar ()
result
testEndPoints :: Transport -> Int -> IO ()
testEndPoints :: Transport -> Int -> IO ()
testEndPoints Transport
transport Int
numPings = do
EndPointAddress
server <- Transport -> (EndPoint -> IO ()) -> IO EndPointAddress
spawn Transport
transport EndPoint -> IO ()
echoServer
[MVar ()]
dones <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 forall a. IO (MVar a)
newEmptyMVar
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [MVar ()]
dones [Char
'A'..]) forall a b. (a -> b) -> a -> b
$ \(MVar ()
done, Char
name) -> IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
let name' :: ByteString
name' :: ByteString
name' = [Char] -> ByteString
pack [Char
name]
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog forall a b. (a -> b) -> a -> b
$ [Char]
"Ping client " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ByteString
name' forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (EndPoint -> EndPointAddress
address EndPoint
endpoint)
EndPoint -> EndPointAddress -> Int -> ByteString -> IO ()
ping EndPoint
endpoint EndPointAddress
server Int
numPings ByteString
name'
forall a. MVar a -> a -> IO ()
putMVar MVar ()
done ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [MVar ()]
dones forall a. MVar a -> IO a
takeMVar
testConnections :: Transport -> Int -> IO ()
testConnections :: Transport -> Int -> IO ()
testConnections Transport
transport Int
numPings = do
EndPointAddress
server <- Transport -> (EndPoint -> IO ()) -> IO EndPointAddress
spawn Transport
transport EndPoint -> IO ()
echoServer
MVar ()
result <- forall a. IO (MVar a)
newEmptyMVar
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
Right Connection
conn1 <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
server Reliability
ReliableOrdered ConnectHints
defaultConnectHints
ConnectionOpened ConnectionId
serv1 Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint
Right Connection
conn2 <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
server Reliability
ReliableOrdered ConnectHints
defaultConnectHints
ConnectionOpened ConnectionId
serv2 Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numPings forall a b. (a -> b) -> a -> b
$ Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn1 [ByteString
"pingA"]
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numPings forall a b. (a -> b) -> a -> b
$ Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn2 [ByteString
"pingB"]
let verifyResponse :: t -> IO ()
verifyResponse t
0 = forall a. MVar a -> a -> IO ()
putMVar MVar ()
result ()
verifyResponse t
n = do
Event
event <- EndPoint -> IO Event
receive EndPoint
endpoint
case Event
event of
Received ConnectionId
cid [ByteString
payload] -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
serv1 Bool -> Bool -> Bool
&& ByteString
payload forall a. Eq a => a -> a -> Bool
/= ByteString
"pingA") forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"Wrong message"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
serv2 Bool -> Bool -> Bool
&& ByteString
payload forall a. Eq a => a -> a -> Bool
/= ByteString
"pingB") forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"Wrong message"
t -> IO ()
verifyResponse (t
n forall a. Num a => a -> a -> a
- t
1)
Event
_ ->
t -> IO ()
verifyResponse t
n
forall {t}. (Eq t, Num t) => t -> IO ()
verifyResponse (Int
2 forall a. Num a => a -> a -> a
* Int
numPings)
forall a. MVar a -> IO a
takeMVar MVar ()
result
testCloseOneConnection :: Transport -> Int -> IO ()
testCloseOneConnection :: Transport -> Int -> IO ()
testCloseOneConnection Transport
transport Int
numPings = do
EndPointAddress
server <- Transport -> (EndPoint -> IO ()) -> IO EndPointAddress
spawn Transport
transport EndPoint -> IO ()
echoServer
MVar ()
result <- forall a. IO (MVar a)
newEmptyMVar
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
Right Connection
conn1 <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
server Reliability
ReliableOrdered ConnectHints
defaultConnectHints
ConnectionOpened ConnectionId
serv1 Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint
Right Connection
conn2 <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
server Reliability
ReliableOrdered ConnectHints
defaultConnectHints
ConnectionOpened ConnectionId
serv2 Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numPings forall a b. (a -> b) -> a -> b
$ Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn1 [ByteString
"pingA"]
Connection -> IO ()
close Connection
conn1
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
numPings forall a. Num a => a -> a -> a
* Int
2) forall a b. (a -> b) -> a -> b
$ Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn2 [ByteString
"pingB"]
let verifyResponse :: t -> IO ()
verifyResponse t
0 = forall a. MVar a -> a -> IO ()
putMVar MVar ()
result ()
verifyResponse t
n = do
Event
event <- EndPoint -> IO Event
receive EndPoint
endpoint
case Event
event of
Received ConnectionId
cid [ByteString
payload] -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
serv1 Bool -> Bool -> Bool
&& ByteString
payload forall a. Eq a => a -> a -> Bool
/= ByteString
"pingA") forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"Wrong message"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
serv2 Bool -> Bool -> Bool
&& ByteString
payload forall a. Eq a => a -> a -> Bool
/= ByteString
"pingB") forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"Wrong message"
t -> IO ()
verifyResponse (t
n forall a. Num a => a -> a -> a
- t
1)
Event
_ ->
t -> IO ()
verifyResponse t
n
forall {t}. (Eq t, Num t) => t -> IO ()
verifyResponse (Int
3 forall a. Num a => a -> a -> a
* Int
numPings)
forall a. MVar a -> IO a
takeMVar MVar ()
result
testCloseOneDirection :: Transport -> Int -> IO ()
testCloseOneDirection :: Transport -> Int -> IO ()
testCloseOneDirection Transport
transport Int
numPings = do
MVar EndPointAddress
addrA <- forall a. IO (MVar a)
newEmptyMVar
MVar EndPointAddress
addrB <- forall a. IO (MVar a)
newEmptyMVar
MVar ()
doneA <- forall a. IO (MVar a)
newEmptyMVar
MVar ()
doneB <- forall a. IO (MVar a)
newEmptyMVar
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"A"
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog (forall a. Show a => a -> [Char]
show (EndPoint -> EndPointAddress
address EndPoint
endpoint))
forall a. MVar a -> a -> IO ()
putMVar MVar EndPointAddress
addrA (EndPoint -> EndPointAddress
address EndPoint
endpoint)
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Connect to B"
Right Connection
conn <- forall a. MVar a -> IO a
readMVar MVar EndPointAddress
addrB forall (m :: * -> *) a b.
(MonadS m, Traceable a) =>
m a -> (a -> m b) -> m b
>>= \EndPointAddress
addr -> EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
addr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Wait for B"
ConnectionOpened ConnectionId
cid Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Send pings to B"
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numPings forall a b. (a -> b) -> a -> b
$ Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ByteString
"ping"]
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Close connection"
Connection -> IO ()
close Connection
conn
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Wait for pongs from B"
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numPings forall a b. (a -> b) -> a -> b
$ do Received ConnectionId
_ [ByteString]
_ <- EndPoint -> IO Event
receive EndPoint
endpoint ; forall (m :: * -> *) a. MonadS m => a -> m a
return ()
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Wait for B to close connection"
ConnectionClosed ConnectionId
cid' <- EndPoint -> IO Event
receive EndPoint
endpoint
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid')
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Done"
forall a. MVar a -> a -> IO ()
putMVar MVar ()
doneA ()
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"B"
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog (forall a. Show a => a -> [Char]
show (EndPoint -> EndPointAddress
address EndPoint
endpoint))
forall a. MVar a -> a -> IO ()
putMVar MVar EndPointAddress
addrB (EndPoint -> EndPointAddress
address EndPoint
endpoint)
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Wait for A to connect"
ConnectionOpened ConnectionId
cid Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Connect to A"
Right Connection
conn <- forall a. MVar a -> IO a
readMVar MVar EndPointAddress
addrA forall (m :: * -> *) a b.
(MonadS m, Traceable a) =>
m a -> (a -> m b) -> m b
>>= \EndPointAddress
addr -> EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
addr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Wait for pings from A"
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numPings forall a b. (a -> b) -> a -> b
$ do Received ConnectionId
_ [ByteString]
_ <- EndPoint -> IO Event
receive EndPoint
endpoint ; forall (m :: * -> *) a. MonadS m => a -> m a
return ()
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Wait for A to close connection"
ConnectionClosed ConnectionId
cid' <- EndPoint -> IO Event
receive EndPoint
endpoint
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid')
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Send pongs to A"
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numPings forall a b. (a -> b) -> a -> b
$ Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ByteString
"pong"]
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Close connection to A"
Connection -> IO ()
close Connection
conn
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Done"
forall a. MVar a -> a -> IO ()
putMVar MVar ()
doneB ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. MVar a -> IO a
takeMVar [MVar ()
doneA, MVar ()
doneB]
collect :: EndPoint -> Maybe Int -> Maybe Int -> IO [(ConnectionId, [[ByteString]])]
collect :: EndPoint
-> Maybe Int -> Maybe Int -> IO [(ConnectionId, [[ByteString]])]
collect EndPoint
endPoint Maybe Int
maxEvents Maybe Int
timeout = forall {a} {m :: * -> *}.
(Eq a, MonadS m, MonadIO m, Num a) =>
Maybe a
-> Map ConnectionId [[ByteString]]
-> Map ConnectionId [[ByteString]]
-> m [(ConnectionId, [[ByteString]])]
go Maybe Int
maxEvents forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty
where
go :: Maybe a
-> Map ConnectionId [[ByteString]]
-> Map ConnectionId [[ByteString]]
-> m [(ConnectionId, [[ByteString]])]
go (Just a
0) Map ConnectionId [[ByteString]]
open Map ConnectionId [[ByteString]]
closed = forall {m :: * -> *} {b} {b} {k} {a}.
(MonadS m, Show b) =>
Map b b -> Map k [a] -> m [(k, [a])]
finish Map ConnectionId [[ByteString]]
open Map ConnectionId [[ByteString]]
closed
go Maybe a
n Map ConnectionId [[ByteString]]
open Map ConnectionId [[ByteString]]
closed = do
Either IOError Event
mEvent <- forall (m :: * -> *) a. MonadIO m => IO a -> m (Either IOError a)
tryIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => Maybe Int -> e -> IO a -> IO a
timeoutMaybe Maybe Int
timeout ([Char] -> IOError
userError [Char]
"timeout") forall a b. (a -> b) -> a -> b
$ EndPoint -> IO Event
receive EndPoint
endPoint
case Either IOError Event
mEvent of
Left IOError
_ -> forall {m :: * -> *} {b} {b} {k} {a}.
(MonadS m, Show b) =>
Map b b -> Map k [a] -> m [(k, [a])]
finish Map ConnectionId [[ByteString]]
open Map ConnectionId [[ByteString]]
closed
Right Event
event -> do
let n' :: Maybe a
n' = (\a
x -> a
x forall a. Num a => a -> a -> a
- a
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
n
case Event
event of
ConnectionOpened ConnectionId
cid Reliability
_ EndPointAddress
_ ->
Maybe a
-> Map ConnectionId [[ByteString]]
-> Map ConnectionId [[ByteString]]
-> m [(ConnectionId, [[ByteString]])]
go Maybe a
n' (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ConnectionId
cid [] Map ConnectionId [[ByteString]]
open) Map ConnectionId [[ByteString]]
closed
ConnectionClosed ConnectionId
cid ->
let list :: [[ByteString]]
list = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid ConnectionClosed") ConnectionId
cid Map ConnectionId [[ByteString]]
open in
Maybe a
-> Map ConnectionId [[ByteString]]
-> Map ConnectionId [[ByteString]]
-> m [(ConnectionId, [[ByteString]])]
go Maybe a
n' (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete ConnectionId
cid Map ConnectionId [[ByteString]]
open) (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ConnectionId
cid [[ByteString]]
list Map ConnectionId [[ByteString]]
closed)
Received ConnectionId
cid [ByteString]
msg ->
Maybe a
-> Map ConnectionId [[ByteString]]
-> Map ConnectionId [[ByteString]]
-> m [(ConnectionId, [[ByteString]])]
go Maybe a
n' (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust ([ByteString]
msg forall a. a -> [a] -> [a]
:) ConnectionId
cid Map ConnectionId [[ByteString]]
open) Map ConnectionId [[ByteString]]
closed
ReceivedMulticast MulticastAddress
_ [ByteString]
_ ->
forall (m :: * -> *) a. MonadS m => [Char] -> m a
fail [Char]
"Unexpected multicast"
ErrorEvent TransportError EventErrorCode
_ ->
forall (m :: * -> *) a. MonadS m => [Char] -> m a
fail [Char]
"Unexpected error"
Event
EndPointClosed ->
forall (m :: * -> *) a. MonadS m => [Char] -> m a
fail [Char]
"Unexpected endpoint closure"
finish :: Map b b -> Map k [a] -> m [(k, [a])]
finish Map b b
open Map k [a]
closed =
if forall k a. Map k a -> Bool
Map.null Map b b
open
then forall (m :: * -> *) a. MonadS m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Map k [a]
closed
else forall (m :: * -> *) a. MonadS m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Open connections: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ Map b b
open)
testCloseReopen :: Transport -> Int -> IO ()
testCloseReopen :: Transport -> Int -> IO ()
testCloseReopen Transport
transport Int
numPings = do
MVar EndPointAddress
addrB <- forall a. IO (MVar a)
newEmptyMVar
MVar ()
doneB <- forall a. IO (MVar a)
newEmptyMVar
let numRepeats :: Int
numRepeats = Int
2 :: Int
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1 .. Int
numRepeats] forall a b. (a -> b) -> a -> b
$ \Int
i -> do
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"A connecting"
Right Connection
conn <- forall a. MVar a -> IO a
readMVar MVar EndPointAddress
addrB forall (m :: * -> *) a b.
(MonadS m, Traceable a) =>
m a -> (a -> m b) -> m b
>>= \EndPointAddress
addr -> EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
addr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"A pinging"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1 .. Int
numPings] forall a b. (a -> b) -> a -> b
$ \Int
j -> Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [[Char] -> ByteString
pack forall a b. (a -> b) -> a -> b
$ [Char]
"ping" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
j]
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"A closing"
Connection -> IO ()
close Connection
conn
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"A finishing"
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall a. MVar a -> a -> IO ()
putMVar MVar EndPointAddress
addrB (EndPoint -> EndPointAddress
address EndPoint
endpoint)
[(ConnectionId, [[ByteString]])]
eventss <- EndPoint
-> Maybe Int -> Maybe Int -> IO [(ConnectionId, [[ByteString]])]
collect EndPoint
endpoint (forall a. a -> Maybe a
Just (Int
numRepeats forall a. Num a => a -> a -> a
* (Int
numPings forall a. Num a => a -> a -> a
+ Int
2))) forall a. Maybe a
Nothing
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 .. Int
numRepeats] [(ConnectionId, [[ByteString]])]
eventss) forall a b. (a -> b) -> a -> b
$ \(Int
i, (ConnectionId
_, [[ByteString]]
events)) -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 .. Int
numPings] [[ByteString]]
events) forall a b. (a -> b) -> a -> b
$ \(Int
j, [ByteString]
event) -> do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([ByteString]
event forall a. Eq a => a -> a -> Bool
== [[Char] -> ByteString
pack forall a b. (a -> b) -> a -> b
$ [Char]
"ping" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
j])
forall a. MVar a -> a -> IO ()
putMVar MVar ()
doneB ()
forall a. MVar a -> IO a
takeMVar MVar ()
doneB
testParallelConnects :: Transport -> Int -> IO ()
testParallelConnects :: Transport -> Int -> IO ()
testParallelConnects Transport
transport Int
numPings = do
EndPointAddress
server <- Transport -> (EndPoint -> IO ()) -> IO EndPointAddress
spawn Transport
transport EndPoint -> IO ()
echoServer
MVar ()
done <- forall a. IO (MVar a)
newEmptyMVar
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1 .. Int
numPings] forall a b. (a -> b) -> a -> b
$ \Int
i -> IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
server Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [[Char] -> ByteString
pack forall a b. (a -> b) -> a -> b
$ [Char]
"ping" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i]
Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [[Char] -> ByteString
pack forall a b. (a -> b) -> a -> b
$ [Char]
"ping" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i]
Connection -> IO ()
close Connection
conn
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
[(ConnectionId, [[ByteString]])]
eventss <- EndPoint
-> Maybe Int -> Maybe Int -> IO [(ConnectionId, [[ByteString]])]
collect EndPoint
endpoint (forall a. a -> Maybe a
Just (Int
numPings forall a. Num a => a -> a -> a
* Int
4)) forall a. Maybe a
Nothing
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ConnectionId, [[ByteString]])]
eventss forall a b. (a -> b) -> a -> b
$ \(ConnectionId
_, [[ByteString
ping1], [ByteString
ping2]]) ->
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString
ping1 forall a. Eq a => a -> a -> Bool
== ByteString
ping2)
forall a. MVar a -> a -> IO ()
putMVar MVar ()
done ()
forall a. MVar a -> IO a
takeMVar MVar ()
done
testSelfSend :: Transport -> IO ()
testSelfSend :: Transport -> IO ()
testSelfSend Transport
transport = do
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint (EndPoint -> EndPointAddress
address EndPoint
endpoint) Reliability
ReliableOrdered
ConnectHints
defaultConnectHints
ConnectionOpened ConnectionId
_ Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint
do Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ forall a. HasCallStack => [Char] -> a
error [Char]
"bang!" ]
forall a. HasCallStack => [Char] -> a
error [Char]
"testSelfSend: send didn't fail"
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(ErrorCall [Char]
"bang!") -> forall (m :: * -> *) a. MonadS m => a -> m a
return ())
Connection -> IO ()
close Connection
conn
ConnectionClosed ConnectionId
_ <- EndPoint -> IO Event
receive EndPoint
endpoint
EndPoint -> IO ()
closeEndPoint EndPoint
endpoint
testSendAfterClose :: Transport -> Int -> IO ()
testSendAfterClose :: Transport -> Int -> IO ()
testSendAfterClose Transport
transport Int
numRepeats = do
EndPointAddress
server <- Transport -> (EndPoint -> IO ()) -> IO EndPointAddress
spawn Transport
transport EndPoint -> IO ()
echoServer
MVar ()
clientDone <- forall a. IO (MVar a)
newEmptyMVar
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
numRepeats forall a b. (a -> b) -> a -> b
$ do
Right Connection
conn1 <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
server Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Right Connection
conn2 <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
server Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Connection -> IO ()
close Connection
conn2
Left (TransportError SendErrorCode
SendClosed [Char]
_) <- Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn2 [ByteString
"ping2"]
Connection -> IO ()
close Connection
conn1
Left (TransportError SendErrorCode
SendClosed [Char]
_) <- Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn2 [ByteString
"ping2"]
forall (m :: * -> *) a. MonadS m => a -> m a
return ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
clientDone ()
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone
testCloseTwice :: Transport -> Int -> IO ()
testCloseTwice :: Transport -> Int -> IO ()
testCloseTwice Transport
transport Int
numRepeats = do
EndPointAddress
server <- Transport -> (EndPoint -> IO ()) -> IO EndPointAddress
spawn Transport
transport EndPoint -> IO ()
echoServer
MVar ()
clientDone <- forall a. IO (MVar a)
newEmptyMVar
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
numRepeats forall a b. (a -> b) -> a -> b
$ do
Right Connection
conn1 <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
server Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Right Connection
conn2 <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
server Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Connection -> IO ()
close Connection
conn2
Connection -> IO ()
close Connection
conn2
Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn1 [ByteString
"ping"]
Connection -> IO ()
close Connection
conn1
ConnectionOpened ConnectionId
cid1 Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint
ConnectionOpened ConnectionId
cid2 Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint
[Event]
ms <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 forall a b. (a -> b) -> a -> b
$ EndPoint -> IO Event
receive EndPoint
endpoint
Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [[a]] -> Bool
testStreams [Event]
ms [ [ ConnectionId -> Event
ConnectionClosed ConnectionId
cid2 ]
, [ ConnectionId -> [ByteString] -> Event
Received ConnectionId
cid1 [ByteString
"ping"]
, ConnectionId -> Event
ConnectionClosed ConnectionId
cid1 ]
]
forall (m :: * -> *) a. MonadS m => a -> m a
return ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
clientDone ()
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone
testConnectToSelf :: Transport -> Int -> IO ()
testConnectToSelf :: Transport -> Int -> IO ()
testConnectToSelf Transport
transport Int
numPings = do
MVar ()
done <- forall a. IO (MVar a)
newEmptyMVar
MVar ()
reconnect <- forall a. IO (MVar a)
newEmptyMVar
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Creating self-connection"
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint (EndPoint -> EndPointAddress
address EndPoint
endpoint) Reliability
ReliableOrdered ConnectHints
defaultConnectHints
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Talk to myself"
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog forall a b. (a -> b) -> a -> b
$ [Char]
"writing"
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog forall a b. (a -> b) -> a -> b
$ [Char]
"Sending ping"
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numPings forall a b. (a -> b) -> a -> b
$ Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ByteString
"ping"]
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog forall a b. (a -> b) -> a -> b
$ [Char]
"Closing connection"
Connection -> IO ()
close Connection
conn
forall a. MVar a -> IO a
readMVar MVar ()
reconnect
ConnectionOpened ConnectionId
cid' Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint
ConnectionClosed ConnectionId
cid'' <- EndPoint -> IO Event
receive EndPoint
endpoint ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid' forall a. Eq a => a -> a -> Bool
== ConnectionId
cid''
forall (m :: * -> *) a. MonadS m => a -> m a
return ()
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog forall a b. (a -> b) -> a -> b
$ [Char]
"reading"
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Waiting for ConnectionOpened"
ConnectionOpened ConnectionId
cid Reliability
_ EndPointAddress
addr <- EndPoint -> IO Event
receive EndPoint
endpoint
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Waiting for Received"
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numPings forall a b. (a -> b) -> a -> b
$ do
Received ConnectionId
cid' [ByteString
"ping"] <- EndPoint -> IO Event
receive EndPoint
endpoint ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid'
forall (m :: * -> *) a. MonadS m => a -> m a
return ()
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Waiting for ConnectionClosed"
ConnectionClosed ConnectionId
cid' <- EndPoint -> IO Event
receive EndPoint
endpoint ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid'
forall a. MVar a -> a -> IO ()
putMVar MVar ()
reconnect ()
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
addr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Connection -> IO ()
close Connection
conn
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Done"
forall a. MVar a -> a -> IO ()
putMVar MVar ()
done ()
forall a. MVar a -> IO a
takeMVar MVar ()
done
testConnectToSelfTwice :: Transport -> Int -> IO ()
testConnectToSelfTwice :: Transport -> Int -> IO ()
testConnectToSelfTwice Transport
transport Int
numPings = do
MVar ()
done <- forall a. IO (MVar a)
newEmptyMVar
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Talk to myself"
MVar ()
firstConnectionMade <- forall a. IO (MVar a)
newEmptyMVar
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Creating self-connection"
Right Connection
conn1 <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint (EndPoint -> EndPointAddress
address EndPoint
endpoint) Reliability
ReliableOrdered ConnectHints
defaultConnectHints
forall a. MVar a -> a -> IO ()
putMVar MVar ()
firstConnectionMade ()
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog forall a b. (a -> b) -> a -> b
$ [Char]
"writing"
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog forall a b. (a -> b) -> a -> b
$ [Char]
"Sending ping"
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numPings forall a b. (a -> b) -> a -> b
$ Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn1 [ByteString
"pingA"]
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog forall a b. (a -> b) -> a -> b
$ [Char]
"Closing connection"
Connection -> IO ()
close Connection
conn1
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
forall a. MVar a -> IO a
takeMVar MVar ()
firstConnectionMade
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Creating self-connection"
Right Connection
conn2 <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint (EndPoint -> EndPointAddress
address EndPoint
endpoint) Reliability
ReliableOrdered ConnectHints
defaultConnectHints
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog forall a b. (a -> b) -> a -> b
$ [Char]
"writing"
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog forall a b. (a -> b) -> a -> b
$ [Char]
"Sending ping"
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numPings forall a b. (a -> b) -> a -> b
$ Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn2 [ByteString
"pingB"]
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog forall a b. (a -> b) -> a -> b
$ [Char]
"Closing connection"
Connection -> IO ()
close Connection
conn2
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog forall a b. (a -> b) -> a -> b
$ [Char]
"reading"
[(ConnectionId
_, [[ByteString]]
events1), (ConnectionId
_, [[ByteString]]
events2)] <- EndPoint
-> Maybe Int -> Maybe Int -> IO [(ConnectionId, [[ByteString]])]
collect EndPoint
endpoint (forall a. a -> Maybe a
Just (Int
2 forall a. Num a => a -> a -> a
* (Int
numPings forall a. Num a => a -> a -> a
+ Int
2))) forall a. Maybe a
Nothing
Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [[ByteString]]
events1 forall a. Eq a => a -> a -> Bool
== forall a. Int -> a -> [a]
replicate Int
numPings [ByteString
"pingA"]
Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [[ByteString]]
events2 forall a. Eq a => a -> a -> Bool
== forall a. Int -> a -> [a]
replicate Int
numPings [ByteString
"pingB"]
forall (m :: * -> *). MonadIO m => [Char] -> m ()
tlog [Char]
"Done"
forall a. MVar a -> a -> IO ()
putMVar MVar ()
done ()
forall a. MVar a -> IO a
takeMVar MVar ()
done
testCloseSelf :: IO (Either String Transport) -> IO ()
testCloseSelf :: IO (Either [Char] Transport) -> IO ()
testCloseSelf IO (Either [Char] Transport)
newTransport = do
Right Transport
transport <- IO (Either [Char] Transport)
newTransport
Right EndPoint
endpoint1 <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
Right EndPoint
endpoint2 <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
Right Connection
conn1 <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint1 (EndPoint -> EndPointAddress
address EndPoint
endpoint1) Reliability
ReliableOrdered ConnectHints
defaultConnectHints
ConnectionOpened ConnectionId
_ Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint1
Right Connection
conn2 <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint1 (EndPoint -> EndPointAddress
address EndPoint
endpoint1) Reliability
ReliableOrdered ConnectHints
defaultConnectHints
ConnectionOpened ConnectionId
_ Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint1
Right Connection
conn3 <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint2 (EndPoint -> EndPointAddress
address EndPoint
endpoint2) Reliability
ReliableOrdered ConnectHints
defaultConnectHints
ConnectionOpened ConnectionId
_ Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint2
Connection -> IO ()
close Connection
conn1
ConnectionClosed ConnectionId
_ <- EndPoint -> IO Event
receive EndPoint
endpoint1
Left (TransportError SendErrorCode
SendClosed [Char]
_) <- Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn1 [ByteString
"ping"]
EndPoint -> IO ()
closeEndPoint EndPoint
endpoint1
Event
EndPointClosed <- EndPoint -> IO Event
receive EndPoint
endpoint1
Left (TransportError SendErrorCode
SendFailed [Char]
_) <- Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn2 [ByteString
"ping"]
Left (TransportError ConnectErrorCode
ConnectFailed [Char]
_) <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint1 (EndPoint -> EndPointAddress
address EndPoint
endpoint1) Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Right () <- Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn3 [ByteString
"ping"]
Received ConnectionId
_ [ByteString]
_ <- EndPoint -> IO Event
receive EndPoint
endpoint2
Transport -> IO ()
closeTransport Transport
transport
Left (TransportError SendErrorCode
SendFailed [Char]
_) <- Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn3 [ByteString
"ping"]
Left TransportError ConnectErrorCode
r <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint2 (EndPoint -> EndPointAddress
address EndPoint
endpoint2) Reliability
ReliableOrdered ConnectHints
defaultConnectHints
case TransportError ConnectErrorCode
r of
TransportError ConnectErrorCode
ConnectFailed [Char]
_ -> forall (m :: * -> *) a. MonadS m => a -> m a
return ()
TransportError ConnectErrorCode
_ -> do [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Actual: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show TransportError ConnectErrorCode
r
TransportError ConnectErrorCode
ConnectFailed [Char]
_ <- forall (m :: * -> *) a. MonadS m => a -> m a
return TransportError ConnectErrorCode
r
forall (m :: * -> *) a. MonadS m => a -> m a
return ()
forall (m :: * -> *) a. MonadS m => a -> m a
return ()
testCloseEndPoint :: Transport -> Int -> IO ()
testCloseEndPoint :: Transport -> Int -> IO ()
testCloseEndPoint Transport
transport Int
_ = do
MVar ()
serverFirstTestDone <- forall a. IO (MVar a)
newEmptyMVar
MVar ()
serverDone <- forall a. IO (MVar a)
newEmptyMVar
MVar ()
clientDone <- forall a. IO (MVar a)
newEmptyMVar
MVar EndPointAddress
clientAddr1 <- forall a. IO (MVar a)
newEmptyMVar
MVar EndPointAddress
clientAddr2 <- forall a. IO (MVar a)
newEmptyMVar
MVar EndPointAddress
serverAddr <- forall a. IO (MVar a)
newEmptyMVar
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall a. MVar a -> a -> IO ()
putMVar MVar EndPointAddress
serverAddr (EndPoint -> EndPointAddress
address EndPoint
endpoint)
do
EndPointAddress
theirAddr <- forall a. MVar a -> IO a
readMVar MVar EndPointAddress
clientAddr1
ConnectionOpened ConnectionId
cid Reliability
ReliableOrdered EndPointAddress
addr <- EndPoint -> IO Event
receive EndPoint
endpoint
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
addr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Connection -> IO ()
close Connection
conn
forall a. MVar a -> a -> IO ()
putMVar MVar ()
serverFirstTestDone ()
ConnectionClosed ConnectionId
cid' <- EndPoint -> IO Event
receive EndPoint
endpoint ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid'
forall a. MVar a -> a -> IO ()
putMVar MVar EndPointAddress
serverAddr (EndPoint -> EndPointAddress
address EndPoint
endpoint)
forall (m :: * -> *) a. MonadS m => a -> m a
return ()
do
EndPointAddress
theirAddr <- forall a. MVar a -> IO a
readMVar MVar EndPointAddress
clientAddr2
ConnectionOpened ConnectionId
cid Reliability
ReliableOrdered EndPointAddress
addr <- EndPoint -> IO Event
receive EndPoint
endpoint
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
addr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Connection -> IO ()
close Connection
conn
Received ConnectionId
cid' [ByteString
"ping"] <- EndPoint -> IO Event
receive EndPoint
endpoint ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid'
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
theirAddr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ByteString
"pong"]
ConnectionClosed ConnectionId
cid'' <- EndPoint -> IO Event
receive EndPoint
endpoint ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid''
ErrorEvent (TransportError (EventConnectionLost EndPointAddress
addr') [Char]
_) <- EndPoint -> IO Event
receive EndPoint
endpoint ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ EndPointAddress
addr' forall a. Eq a => a -> a -> Bool
== EndPointAddress
theirAddr
Left (TransportError SendErrorCode
SendFailed [Char]
_) <- Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ByteString
"pong2"]
forall (m :: * -> *) a. MonadS m => a -> m a
return ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
serverDone ()
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
do
EndPointAddress
theirAddr <- forall a. MVar a -> IO a
takeMVar MVar EndPointAddress
serverAddr
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall a. MVar a -> a -> IO ()
putMVar MVar EndPointAddress
clientAddr1 (EndPoint -> EndPointAddress
address EndPoint
endpoint)
Right Connection
_ <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
theirAddr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
ConnectionOpened ConnectionId
cid Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint
ConnectionClosed ConnectionId
cid' <- EndPoint -> IO Event
receive EndPoint
endpoint ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid'
forall a. MVar a -> IO a
readMVar MVar ()
serverFirstTestDone
EndPoint -> IO ()
closeEndPoint EndPoint
endpoint
Event
EndPointClosed <- EndPoint -> IO Event
receive EndPoint
endpoint
forall (m :: * -> *) a. MonadS m => a -> m a
return ()
do
EndPointAddress
theirAddr <- forall a. MVar a -> IO a
takeMVar MVar EndPointAddress
serverAddr
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall a. MVar a -> a -> IO ()
putMVar MVar EndPointAddress
clientAddr2 (EndPoint -> EndPointAddress
address EndPoint
endpoint)
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
theirAddr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
ConnectionOpened ConnectionId
cid Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint
ConnectionClosed ConnectionId
cid' <- EndPoint -> IO Event
receive EndPoint
endpoint ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid'
Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ByteString
"ping"]
ConnectionOpened ConnectionId
cid Reliability
ReliableOrdered EndPointAddress
addr <- EndPoint -> IO Event
receive EndPoint
endpoint
Received ConnectionId
cid' [ByteString
"pong"] <- EndPoint -> IO Event
receive EndPoint
endpoint ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid'
EndPoint -> IO ()
closeEndPoint EndPoint
endpoint
Event
EndPointClosed <- EndPoint -> IO Event
receive EndPoint
endpoint
Left (TransportError SendErrorCode
SendFailed [Char]
_) <- Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ByteString
"ping2"]
() <- Connection -> IO ()
close Connection
conn
Left (TransportError ConnectErrorCode
ConnectFailed [Char]
_) <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
theirAddr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
forall (m :: * -> *) a. MonadS m => a -> m a
return ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
clientDone ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. MVar a -> IO a
takeMVar [MVar ()
serverDone, MVar ()
clientDone]
testCloseTransport :: IO (Either String Transport) -> IO ()
testCloseTransport :: IO (Either [Char] Transport) -> IO ()
testCloseTransport IO (Either [Char] Transport)
newTransport = do
MVar ()
serverDone <- forall a. IO (MVar a)
newEmptyMVar
MVar ()
clientDone <- forall a. IO (MVar a)
newEmptyMVar
MVar EndPointAddress
clientAddr1 <- forall a. IO (MVar a)
newEmptyMVar
MVar EndPointAddress
clientAddr2 <- forall a. IO (MVar a)
newEmptyMVar
MVar EndPointAddress
serverAddr <- forall a. IO (MVar a)
newEmptyMVar
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
Right Transport
transport <- IO (Either [Char] Transport)
newTransport
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall a. MVar a -> a -> IO ()
putMVar MVar EndPointAddress
serverAddr (EndPoint -> EndPointAddress
address EndPoint
endpoint)
EndPointAddress
theirAddr1 <- forall a. MVar a -> IO a
readMVar MVar EndPointAddress
clientAddr1
ConnectionOpened ConnectionId
cid1 Reliability
ReliableOrdered EndPointAddress
addr <- EndPoint -> IO Event
receive EndPoint
endpoint
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
theirAddr1 Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Connection -> IO ()
close Connection
conn
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
addr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Connection -> IO ()
close Connection
conn
EndPointAddress
theirAddr2 <- forall a. MVar a -> IO a
readMVar MVar EndPointAddress
clientAddr2
ConnectionOpened ConnectionId
cid2 Reliability
ReliableOrdered EndPointAddress
addr' <- EndPoint -> IO Event
receive EndPoint
endpoint
Received ConnectionId
cid2' [ByteString
"ping"] <- EndPoint -> IO Event
receive EndPoint
endpoint ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid2' forall a. Eq a => a -> a -> Bool
== ConnectionId
cid2
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
theirAddr2 Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ByteString
"pong"]
Connection -> IO ()
close Connection
conn
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
addr' Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ByteString
"pong"]
[Event]
evs <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 forall a b. (a -> b) -> a -> b
$ EndPoint -> IO Event
receive EndPoint
endpoint
let expected :: [Event]
expected = [ ConnectionId -> Event
ConnectionClosed ConnectionId
cid1
, ConnectionId -> Event
ConnectionClosed ConnectionId
cid2
, TransportError EventErrorCode -> Event
ErrorEvent (forall error. error -> [Char] -> TransportError error
TransportError (EndPointAddress -> EventErrorCode
EventConnectionLost EndPointAddress
addr') [Char]
"")
]
Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Event]
expected forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. [a] -> [[a]]
permutations [Event]
evs
Left (TransportError SendErrorCode
SendFailed [Char]
_) <- Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ByteString
"pong2"]
forall a. MVar a -> a -> IO ()
putMVar MVar ()
serverDone ()
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
Right Transport
transport <- IO (Either [Char] Transport)
newTransport
EndPointAddress
theirAddr <- forall a. MVar a -> IO a
readMVar MVar EndPointAddress
serverAddr
Right EndPoint
endpoint1 <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall a. MVar a -> a -> IO ()
putMVar MVar EndPointAddress
clientAddr1 (EndPoint -> EndPointAddress
address EndPoint
endpoint1)
Right Connection
_ <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint1 EndPointAddress
theirAddr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
ConnectionOpened ConnectionId
cid Reliability
ReliableOrdered EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint1
ConnectionClosed ConnectionId
cid' <- EndPoint -> IO Event
receive EndPoint
endpoint1 ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid'
ConnectionOpened ConnectionId
cid Reliability
ReliableOrdered EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint1
ConnectionClosed ConnectionId
cid' <- EndPoint -> IO Event
receive EndPoint
endpoint1 ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid'
Right EndPoint
endpoint2 <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall a. MVar a -> a -> IO ()
putMVar MVar EndPointAddress
clientAddr2 (EndPoint -> EndPointAddress
address EndPoint
endpoint2)
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint2 EndPointAddress
theirAddr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ByteString
"ping"]
ConnectionOpened ConnectionId
cid Reliability
ReliableOrdered EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint2
Received ConnectionId
cid' [ByteString
"pong"] <- EndPoint -> IO Event
receive EndPoint
endpoint2 ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid'
ConnectionClosed ConnectionId
cid'' <- EndPoint -> IO Event
receive EndPoint
endpoint2 ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid''
ConnectionOpened ConnectionId
cid Reliability
ReliableOrdered EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint2
Received ConnectionId
cid' [ByteString
"pong"] <- EndPoint -> IO Event
receive EndPoint
endpoint2 ; Bool
True <- forall (m :: * -> *) a. MonadS m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectionId
cid forall a. Eq a => a -> a -> Bool
== ConnectionId
cid'
Transport -> IO ()
closeTransport Transport
transport
Event
EndPointClosed <- EndPoint -> IO Event
receive EndPoint
endpoint1
Event
EndPointClosed <- EndPoint -> IO Event
receive EndPoint
endpoint2
Left (TransportError SendErrorCode
SendFailed [Char]
_) <- Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ByteString
"ping2"]
() <- Connection -> IO ()
close Connection
conn
Left (TransportError ConnectErrorCode
ConnectFailed [Char]
_) <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint1 EndPointAddress
theirAddr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Left (TransportError ConnectErrorCode
ConnectFailed [Char]
_) <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint2 EndPointAddress
theirAddr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Left (TransportError NewEndPointErrorCode
NewEndPointFailed [Char]
_) <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall a. MVar a -> a -> IO ()
putMVar MVar ()
clientDone ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. MVar a -> IO a
takeMVar [MVar ()
serverDone, MVar ()
clientDone]
testConnectClosedEndPoint :: Transport -> IO ()
testConnectClosedEndPoint :: Transport -> IO ()
testConnectClosedEndPoint Transport
transport = do
MVar EndPointAddress
serverAddr <- forall a. IO (MVar a)
newEmptyMVar
MVar ()
serverClosed <- forall a. IO (MVar a)
newEmptyMVar
MVar ()
clientDone <- forall a. IO (MVar a)
newEmptyMVar
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall a. MVar a -> a -> IO ()
putMVar MVar EndPointAddress
serverAddr (EndPoint -> EndPointAddress
address EndPoint
endpoint)
EndPoint -> IO ()
closeEndPoint EndPoint
endpoint
forall a. MVar a -> a -> IO ()
putMVar MVar ()
serverClosed ()
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall a. MVar a -> IO a
readMVar MVar ()
serverClosed
Left (TransportError ConnectErrorCode
ConnectNotFound [Char]
_) <- forall a. MVar a -> IO a
readMVar MVar EndPointAddress
serverAddr forall (m :: * -> *) a b.
(MonadS m, Traceable a) =>
m a -> (a -> m b) -> m b
>>= \EndPointAddress
addr -> EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
addr Reliability
ReliableOrdered ConnectHints
defaultConnectHints
forall a. MVar a -> a -> IO ()
putMVar MVar ()
clientDone ()
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone
testExceptionOnReceive :: IO (Either String Transport) -> IO ()
testExceptionOnReceive :: IO (Either [Char] Transport) -> IO ()
testExceptionOnReceive IO (Either [Char] Transport)
newTransport = do
Right Transport
transport <- IO (Either [Char] Transport)
newTransport
Right EndPoint
endpoint1 <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
EndPoint -> IO ()
closeEndPoint EndPoint
endpoint1
Event
EndPointClosed <- EndPoint -> IO Event
receive EndPoint
endpoint1
Left SomeException
_ <- forall a. IO a -> IO (Either SomeException a)
trySome (EndPoint -> IO Event
receive EndPoint
endpoint1 forall (m :: * -> *) a b.
(MonadS m, Traceable a) =>
m a -> (a -> m b) -> m b
>>= forall a. a -> IO a
evaluate)
Right EndPoint
endpoint2 <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
Transport -> IO ()
closeTransport Transport
transport
Event
EndPointClosed <- EndPoint -> IO Event
receive EndPoint
endpoint2
Left SomeException
_ <- forall a. IO a -> IO (Either SomeException a)
trySome (EndPoint -> IO Event
receive EndPoint
endpoint2 forall (m :: * -> *) a b.
(MonadS m, Traceable a) =>
m a -> (a -> m b) -> m b
>>= forall a. a -> IO a
evaluate)
forall (m :: * -> *) a. MonadS m => a -> m a
return ()
testSendException :: IO (Either String Transport) -> IO ()
testSendException :: IO (Either [Char] Transport) -> IO ()
testSendException IO (Either [Char] Transport)
newTransport = do
Right Transport
transport <- IO (Either [Char] Transport)
newTransport
Right EndPoint
endpoint1 <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
Right EndPoint
endpoint2 <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
Right Connection
conn <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint1 (EndPoint -> EndPointAddress
address EndPoint
endpoint2) Reliability
ReliableOrdered ConnectHints
defaultConnectHints
ConnectionOpened ConnectionId
_ Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint2
Left (TransportError SendErrorCode
SendFailed [Char]
_) <- Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn (forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError [Char]
"uhoh")
ErrorEvent (TransportError (EventConnectionLost EndPointAddress
_) [Char]
_) <- EndPoint -> IO Event
receive EndPoint
endpoint1
ErrorEvent (TransportError (EventConnectionLost EndPointAddress
_) [Char]
_) <- EndPoint -> IO Event
receive EndPoint
endpoint2
Right Connection
conn2 <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint1 (EndPoint -> EndPointAddress
address EndPoint
endpoint2) Reliability
ReliableOrdered ConnectHints
defaultConnectHints
Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn2 [ByteString
"ping"]
Connection -> IO ()
close Connection
conn2
ConnectionOpened ConnectionId
_ Reliability
_ EndPointAddress
_ <- EndPoint -> IO Event
receive EndPoint
endpoint2
Received ConnectionId
_ [ByteString
"ping"] <- EndPoint -> IO Event
receive EndPoint
endpoint2
ConnectionClosed ConnectionId
_ <- EndPoint -> IO Event
receive EndPoint
endpoint2
forall (m :: * -> *) a. MonadS m => a -> m a
return ()
testKill :: IO (Either String Transport) -> Int -> IO ()
testKill :: IO (Either [Char] Transport) -> Int -> IO ()
testKill IO (Either [Char] Transport)
newTransport Int
numThreads = do
Right Transport
transport1 <- IO (Either [Char] Transport)
newTransport
Right Transport
transport2 <- IO (Either [Char] Transport)
newTransport
Right EndPoint
endpoint1 <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport1
Right EndPoint
endpoint2 <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport2
[ThreadId]
threads <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
numThreads forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ do
Int -> IO ()
randomThreadDelay Int
100
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint1 (EndPoint -> EndPointAddress
address EndPoint
endpoint2) Reliability
ReliableOrdered ConnectHints
defaultConnectHints)
(\(Right Connection
conn) -> Connection -> IO ()
close Connection
conn)
(\(Right Connection
conn) -> do Int -> IO ()
randomThreadDelay Int
100
Right () <- Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send Connection
conn [ByteString
"ping"]
Int -> IO ()
randomThreadDelay Int
100)
MVar Int
numAlive <- forall a. a -> IO (MVar a)
newMVar (Int
0 :: Int)
IO () -> IO ThreadId
forkIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ThreadId]
threads forall a b. (a -> b) -> a -> b
$ \ThreadId
tid -> do
Bool
shouldKill <- forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
if Bool
shouldKill
then Int -> IO ()
randomThreadDelay Int
600 forall (m :: * -> *) a b. MonadS m => m a -> m b -> m b
>> ThreadId -> IO ()
killThread ThreadId
tid
else forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Int
numAlive (forall (m :: * -> *) a. MonadS m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Int
1))
[(ConnectionId, [[ByteString]])]
eventss <- EndPoint
-> Maybe Int -> Maybe Int -> IO [(ConnectionId, [[ByteString]])]
collect EndPoint
endpoint2 forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Int
1000000)
let actualPings :: Int
actualPings = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ [(ConnectionId, [[ByteString]])]
eventss
Int
expectedPings <- forall a. MVar a -> IO a
takeMVar MVar Int
numAlive
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
actualPings forall a. Ord a => a -> a -> Bool
>= Int
expectedPings) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO ([Char] -> IOError
userError [Char]
"Missing pings")
testCrossing :: Transport -> Int -> IO ()
testCrossing :: Transport -> Int -> IO ()
testCrossing Transport
transport Int
numRepeats = do
[MVar EndPointAddress
aAddr, MVar EndPointAddress
bAddr] <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 forall a. IO (MVar a)
newEmptyMVar
[MVar ()
aDone, MVar ()
bDone] <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 forall a. IO (MVar a)
newEmptyMVar
[MVar ()
aGo, MVar ()
bGo] <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 forall a. IO (MVar a)
newEmptyMVar
[MVar ()
aTimeout, MVar ()
bTimeout] <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 forall a. IO (MVar a)
newEmptyMVar
let hints :: ConnectHints
hints = ConnectHints
defaultConnectHints {
connectTimeout :: Maybe Int
connectTimeout = forall a. a -> Maybe a
Just Int
5000000
}
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall a. MVar a -> a -> IO ()
putMVar MVar EndPointAddress
aAddr (EndPoint -> EndPointAddress
address EndPoint
endpoint)
EndPointAddress
theirAddress <- forall a. MVar a -> IO a
readMVar MVar EndPointAddress
bAddr
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numRepeats forall a b. (a -> b) -> a -> b
$ do
forall a. MVar a -> IO a
takeMVar MVar ()
aGo forall (m :: * -> *) a b. MonadS m => m a -> m b -> m b
>> IO ()
yield
Either (TransportError ConnectErrorCode) Connection
connectResult <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
theirAddress Reliability
ReliableOrdered ConnectHints
hints
case Either (TransportError ConnectErrorCode) Connection
connectResult of
Right Connection
conn -> Connection -> IO ()
close Connection
conn
Left (TransportError ConnectErrorCode
ConnectTimeout [Char]
_) -> forall a. MVar a -> a -> IO ()
putMVar MVar ()
aTimeout ()
Left (TransportError ConnectErrorCode
ConnectFailed [Char]
_) -> forall a. MVar a -> IO a
readMVar MVar ()
bTimeout
Left TransportError ConnectErrorCode
err -> forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IOError
userError forall a b. (a -> b) -> a -> b
$ [Char]
"testCrossed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show TransportError ConnectErrorCode
err
forall a. MVar a -> a -> IO ()
putMVar MVar ()
aDone ()
IO () -> IO ThreadId
forkTry forall a b. (a -> b) -> a -> b
$ do
Right EndPoint
endpoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
forall a. MVar a -> a -> IO ()
putMVar MVar EndPointAddress
bAddr (EndPoint -> EndPointAddress
address EndPoint
endpoint)
EndPointAddress
theirAddress <- forall a. MVar a -> IO a
readMVar MVar EndPointAddress
aAddr
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numRepeats forall a b. (a -> b) -> a -> b
$ do
forall a. MVar a -> IO a
takeMVar MVar ()
bGo forall (m :: * -> *) a b. MonadS m => m a -> m b -> m b
>> IO ()
yield
Either (TransportError ConnectErrorCode) Connection
connectResult <- EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect EndPoint
endpoint EndPointAddress
theirAddress Reliability
ReliableOrdered ConnectHints
hints
case Either (TransportError ConnectErrorCode) Connection
connectResult of
Right Connection
conn -> Connection -> IO ()
close Connection
conn
Left (TransportError ConnectErrorCode
ConnectTimeout [Char]
_) -> forall a. MVar a -> a -> IO ()
putMVar MVar ()
bTimeout ()
Left (TransportError ConnectErrorCode
ConnectFailed [Char]
_) -> forall a. MVar a -> IO a
readMVar MVar ()
aTimeout
Left TransportError ConnectErrorCode
err -> forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IOError
userError forall a b. (a -> b) -> a -> b
$ [Char]
"testCrossed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show TransportError ConnectErrorCode
err
forall a. MVar a -> a -> IO ()
putMVar MVar ()
bDone ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1 .. Int
numRepeats] forall a b. (a -> b) -> a -> b
$ \Int
_i -> do
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar ()
aTimeout
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar ()
bTimeout
Bool
b <- forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
if Bool
b then do forall a. MVar a -> a -> IO ()
putMVar MVar ()
aGo () ; forall a. MVar a -> a -> IO ()
putMVar MVar ()
bGo ()
else do forall a. MVar a -> a -> IO ()
putMVar MVar ()
bGo () ; forall a. MVar a -> a -> IO ()
putMVar MVar ()
aGo ()
IO ()
yield
forall a. MVar a -> IO a
takeMVar MVar ()
aDone
forall a. MVar a -> IO a
takeMVar MVar ()
bDone
testTransport :: IO (Either String Transport) -> IO ()
testTransport :: IO (Either [Char] Transport) -> IO ()
testTransport = ([Char] -> Bool) -> IO (Either [Char] Transport) -> IO ()
testTransportWithFilter (forall a b. a -> b -> a
const Bool
True)
testTransportWithFilter :: (String -> Bool) -> IO (Either String Transport) -> IO ()
testTransportWithFilter :: ([Char] -> Bool) -> IO (Either [Char] Transport) -> IO ()
testTransportWithFilter [Char] -> Bool
p IO (Either [Char] Transport)
newTransport = do
Right Transport
transport <- IO (Either [Char] Transport)
newTransport
[([Char], IO ())] -> IO ()
runTests forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
[ ([Char]
"PingPong", Transport -> Int -> IO ()
testPingPong Transport
transport Int
numPings)
, ([Char]
"EndPoints", Transport -> Int -> IO ()
testEndPoints Transport
transport Int
numPings)
, ([Char]
"Connections", Transport -> Int -> IO ()
testConnections Transport
transport Int
numPings)
, ([Char]
"CloseOneConnection", Transport -> Int -> IO ()
testCloseOneConnection Transport
transport Int
numPings)
, ([Char]
"CloseOneDirection", Transport -> Int -> IO ()
testCloseOneDirection Transport
transport Int
numPings)
, ([Char]
"CloseReopen", Transport -> Int -> IO ()
testCloseReopen Transport
transport Int
numPings)
, ([Char]
"ParallelConnects", Transport -> Int -> IO ()
testParallelConnects Transport
transport Int
numPings)
, ([Char]
"SelfSend", Transport -> IO ()
testSelfSend Transport
transport)
, ([Char]
"SendAfterClose", Transport -> Int -> IO ()
testSendAfterClose Transport
transport Int
100)
, ([Char]
"Crossing", Transport -> Int -> IO ()
testCrossing Transport
transport Int
10)
, ([Char]
"CloseTwice", Transport -> Int -> IO ()
testCloseTwice Transport
transport Int
100)
, ([Char]
"ConnectToSelf", Transport -> Int -> IO ()
testConnectToSelf Transport
transport Int
numPings)
, ([Char]
"ConnectToSelfTwice", Transport -> Int -> IO ()
testConnectToSelfTwice Transport
transport Int
numPings)
, ([Char]
"CloseSelf", IO (Either [Char] Transport) -> IO ()
testCloseSelf IO (Either [Char] Transport)
newTransport)
, ([Char]
"CloseEndPoint", Transport -> Int -> IO ()
testCloseEndPoint Transport
transport Int
numPings)
, ([Char]
"CloseTransport", IO (Either [Char] Transport) -> IO ()
testCloseTransport IO (Either [Char] Transport)
newTransport)
, ([Char]
"ConnectClosedEndPoint", Transport -> IO ()
testConnectClosedEndPoint Transport
transport)
, ([Char]
"ExceptionOnReceive", IO (Either [Char] Transport) -> IO ()
testExceptionOnReceive IO (Either [Char] Transport)
newTransport)
, ([Char]
"SendException", IO (Either [Char] Transport) -> IO ()
testSendException IO (Either [Char] Transport)
newTransport)
, ([Char]
"Kill", IO (Either [Char] Transport) -> Int -> IO ()
testKill IO (Either [Char] Transport)
newTransport Int
1000)
]
where
numPings :: Int
numPings = Int
10000 :: Int
testStreams :: Eq a => [a] -> [[a]] -> Bool
testStreams :: forall a. Eq a => [a] -> [[a]] -> Bool
testStreams [] [[a]]
ys = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
ys
testStreams (a
x:[a]
xs) [[a]]
ys =
case [[a]] -> [[a]] -> [[a]]
go [] [[a]]
ys of
[] -> Bool
False
[[a]]
ys' -> forall a. Eq a => [a] -> [[a]] -> Bool
testStreams [a]
xs [[a]]
ys'
where
go :: [[a]] -> [[a]] -> [[a]]
go [[a]]
_ [] = []
go [[a]]
c ([]:[[a]]
zss) = [[a]] -> [[a]] -> [[a]]
go [[a]]
c [[a]]
zss
go [[a]]
c (z' :: [a]
z'@(a
z:[a]
zs):[[a]]
zss)
| a
x forall a. Eq a => a -> a -> Bool
== a
z = ([a]
zsforall a. a -> [a] -> [a]
:[[a]]
c)forall a. [a] -> [a] -> [a]
++[[a]]
zss
| Bool
otherwise = [[a]] -> [[a]] -> [[a]]
go ([a]
z'forall a. a -> [a] -> [a]
:[[a]]
c) [[a]]
zss