module Control.Distributed.Process.Tests.CH (tests) where

#if ! MIN_VERSION_base(4,6,0)
import Prelude hiding (catch)
#endif

import Network.Transport.Test (TestTransport(..))

import Data.Binary (Binary(..))
import Data.Typeable (Typeable)
import Data.Foldable (forM_)
import Data.Function (fix)
import Data.IORef
  ( readIORef
  , writeIORef
  , newIORef
  )
import Control.Concurrent (forkIO, threadDelay, myThreadId, throwTo, ThreadId, yield)
import Control.Concurrent.MVar
  ( MVar
  , newEmptyMVar
  , putMVar
  , takeMVar
  , readMVar
  )
import Control.Monad (replicateM_, replicateM, forever, void, unless, join)
import Control.Exception (SomeException, throwIO, ErrorCall(..))
import Control.Monad.Catch (try, catch, finally, mask, onException)
import Control.Applicative ((<|>))
import qualified Network.Transport as NT (closeEndPoint, EndPointAddress)
import Control.Distributed.Process hiding
  ( try
  , catch
  , finally
  , mask
  , onException
  )
import Control.Distributed.Process.Internal.Types
  ( LocalNode(localEndPoint)
  , ProcessExitException(..)
  , nullProcessId
  , createUnencodedMessage
  )
import Control.Distributed.Process.Node
import Control.Distributed.Process.Tests.Internal.Utils (pause)
import Control.Distributed.Process.Serializable (Serializable)
import Data.Maybe (isNothing, isJust)
import Test.HUnit (Assertion, assertBool, assertFailure)
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Control.Rematch hiding (match, isNothing, isJust)
import Control.Rematch.Run (Match(..))

newtype Ping = Ping ProcessId
  deriving (Typeable, Get Ping
[Ping] -> Put
Ping -> Put
(Ping -> Put) -> Get Ping -> ([Ping] -> Put) -> Binary Ping
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: Ping -> Put
put :: Ping -> Put
$cget :: Get Ping
get :: Get Ping
$cputList :: [Ping] -> Put
putList :: [Ping] -> Put
Binary, Int -> Ping -> ShowS
[Ping] -> ShowS
Ping -> String
(Int -> Ping -> ShowS)
-> (Ping -> String) -> ([Ping] -> ShowS) -> Show Ping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ping -> ShowS
showsPrec :: Int -> Ping -> ShowS
$cshow :: Ping -> String
show :: Ping -> String
$cshowList :: [Ping] -> ShowS
showList :: [Ping] -> ShowS
Show)

newtype Pong = Pong ProcessId
  deriving (Typeable, Get Pong
[Pong] -> Put
Pong -> Put
(Pong -> Put) -> Get Pong -> ([Pong] -> Put) -> Binary Pong
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: Pong -> Put
put :: Pong -> Put
$cget :: Get Pong
get :: Get Pong
$cputList :: [Pong] -> Put
putList :: [Pong] -> Put
Binary, Int -> Pong -> ShowS
[Pong] -> ShowS
Pong -> String
(Int -> Pong -> ShowS)
-> (Pong -> String) -> ([Pong] -> ShowS) -> Show Pong
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pong -> ShowS
showsPrec :: Int -> Pong -> ShowS
$cshow :: Pong -> String
show :: Pong -> String
$cshowList :: [Pong] -> ShowS
showList :: [Pong] -> ShowS
Show)

--------------------------------------------------------------------------------
-- Supporting definitions                                                     --
--------------------------------------------------------------------------------

expectThat :: a -> Matcher a -> Assertion
expectThat :: forall a. a -> Matcher a -> Assertion
expectThat a
a Matcher a
matcher = case Match
res of
  Match
MatchSuccess -> () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  (MatchFailure String
msg) -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure String
msg
  where res :: Match
res = Matcher a -> a -> Match
forall a. Matcher a -> a -> Match
runMatch Matcher a
matcher a
a

-- | Like fork, but throw exceptions in the child thread to the parent
forkTry :: IO () -> IO ThreadId
forkTry :: Assertion -> IO ThreadId
forkTry Assertion
p = do
  ThreadId
tid <- IO ThreadId
myThreadId
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Assertion -> (SomeException -> Assertion) -> Assertion
forall e a.
(HasCallStack, Exception e) =>
IO a -> (e -> IO a) -> IO a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch Assertion
p (\SomeException
e -> ThreadId -> SomeException -> Assertion
forall e. Exception e => ThreadId -> e -> Assertion
throwTo ThreadId
tid (SomeException
e :: SomeException))

-- | The ping server from the paper
ping :: Process ()
ping :: Process ()
ping = do
  Pong ProcessId
partner <- Process Pong
forall a. Serializable a => Process a
expect
  ProcessId
self <- Process ProcessId
getSelfPid
  ProcessId -> Ping -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
partner (ProcessId -> Ping
Ping ProcessId
self)
  Process ()
ping

verifyClient :: String -> MVar Bool -> IO ()
verifyClient :: String -> MVar Bool -> Assertion
verifyClient String
s MVar Bool
b = MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
b IO Bool -> (Bool -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
s

expectPing :: MVar Bool ->  Process ()
expectPing :: MVar Bool -> Process ()
expectPing MVar Bool
mv = Process Ping
forall a. Serializable a => Process a
expect  Process Ping -> (Ping -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Ping -> Assertion) -> Ping -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
mv (Bool -> Assertion) -> (Ping -> Bool) -> Ping -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ping -> Bool
checkPing
  where
    checkPing :: Ping -> Bool
checkPing (Ping ProcessId
_) = Bool
True

-- | Quick and dirty synchronous version of whereisRemoteAsync
whereisRemote :: NodeId -> String -> Process (Maybe ProcessId)
whereisRemote :: NodeId -> String -> Process (Maybe ProcessId)
whereisRemote NodeId
nid String
string = do
  NodeId -> String -> Process ()
whereisRemoteAsync NodeId
nid String
string
  [Match (Maybe ProcessId)] -> Process (Maybe ProcessId)
forall b. [Match b] -> Process b
receiveWait [
      (WhereIsReply -> Process (Maybe ProcessId))
-> Match (Maybe ProcessId)
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(WhereIsReply String
_ Maybe ProcessId
mPid) -> Maybe ProcessId -> Process (Maybe ProcessId)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ProcessId
mPid)
    ]

verifyWhereIsRemote :: NodeId -> String -> Process ProcessId
verifyWhereIsRemote :: NodeId -> String -> Process ProcessId
verifyWhereIsRemote NodeId
n String
s = NodeId -> String -> Process (Maybe ProcessId)
whereisRemote NodeId
n String
s Process (Maybe ProcessId)
-> (Maybe ProcessId -> Process ProcessId) -> Process ProcessId
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Process ProcessId
-> (ProcessId -> Process ProcessId)
-> Maybe ProcessId
-> Process ProcessId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Process ProcessId
forall a b. Serializable a => a -> Process b
die String
"remote name not found") ProcessId -> Process ProcessId
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return

syncBreakConnection :: (NT.EndPointAddress -> NT.EndPointAddress -> IO ()) -> LocalNode -> LocalNode -> IO ()
syncBreakConnection :: (EndPointAddress -> EndPointAddress -> Assertion)
-> LocalNode -> LocalNode -> Assertion
syncBreakConnection EndPointAddress -> EndPointAddress -> Assertion
breakConnection LocalNode
nid0 LocalNode
nid1 = do
  MVar ProcessId
m <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  ProcessId
_ <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
nid1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (ProcessId -> Assertion) -> ProcessId -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
m
  LocalNode -> Process () -> Assertion
runProcess LocalNode
nid0 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
them <- IO ProcessId -> Process ProcessId
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> Process ProcessId)
-> IO ProcessId -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
takeMVar MVar ProcessId
m
    ProcessId
pinger <- Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ Process () -> Process ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
them ()
    MonitorRef
_ <- NodeId -> Process MonitorRef
monitorNode (LocalNode -> NodeId
localNodeId LocalNode
nid1)
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ EndPointAddress -> EndPointAddress -> Assertion
breakConnection (NodeId -> EndPointAddress
nodeAddress (NodeId -> EndPointAddress) -> NodeId -> EndPointAddress
forall a b. (a -> b) -> a -> b
$ LocalNode -> NodeId
localNodeId LocalNode
nid0)
                             (NodeId -> EndPointAddress
nodeAddress (NodeId -> EndPointAddress) -> NodeId -> EndPointAddress
forall a b. (a -> b) -> a -> b
$ LocalNode -> NodeId
localNodeId LocalNode
nid1)
    NodeMonitorNotification MonitorRef
_ NodeId
_ DiedReason
_ <- Process NodeMonitorNotification
forall a. Serializable a => Process a
expect
    ProcessId -> String -> Process ()
kill ProcessId
pinger String
"finished"
    () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

data Add       = Add    ProcessId Double Double deriving (Typeable)
data Divide    = Divide ProcessId Double Double deriving (Typeable)
data DivByZero = DivByZero deriving (Typeable)

instance Binary Add where
  put :: Add -> Put
put (Add ProcessId
pid Double
x Double
y) = ProcessId -> Put
forall t. Binary t => t -> Put
put ProcessId
pid Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Put
forall t. Binary t => t -> Put
put Double
x Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Put
forall t. Binary t => t -> Put
put Double
y
  get :: Get Add
get = ProcessId -> Double -> Double -> Add
Add (ProcessId -> Double -> Double -> Add)
-> Get ProcessId -> Get (Double -> Double -> Add)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ProcessId
forall t. Binary t => Get t
get Get (Double -> Double -> Add) -> Get Double -> Get (Double -> Add)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
forall t. Binary t => Get t
get Get (Double -> Add) -> Get Double -> Get Add
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
forall t. Binary t => Get t
get

instance Binary Divide where
  put :: Divide -> Put
put (Divide ProcessId
pid Double
x Double
y) = ProcessId -> Put
forall t. Binary t => t -> Put
put ProcessId
pid Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Put
forall t. Binary t => t -> Put
put Double
x Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Put
forall t. Binary t => t -> Put
put Double
y
  get :: Get Divide
get = ProcessId -> Double -> Double -> Divide
Divide (ProcessId -> Double -> Double -> Divide)
-> Get ProcessId -> Get (Double -> Double -> Divide)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ProcessId
forall t. Binary t => Get t
get Get (Double -> Double -> Divide)
-> Get Double -> Get (Double -> Divide)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
forall t. Binary t => Get t
get Get (Double -> Divide) -> Get Double -> Get Divide
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
forall t. Binary t => Get t
get

instance Binary DivByZero where
  put :: DivByZero -> Put
put DivByZero
DivByZero = () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  get :: Get DivByZero
get = DivByZero -> Get DivByZero
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return DivByZero
DivByZero

-- The math server from the paper
math :: Process ()
math :: Process ()
math = do
  [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait
    [ (Add -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(Add ProcessId
pid Double
x Double
y) -> ProcessId -> Double -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y))
    , (Divide -> Bool) -> (Divide -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(Divide ProcessId
_   Double
_ Double
y) -> Double
y Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0)
              (\(Divide ProcessId
pid Double
x Double
y) -> ProcessId -> Double -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
y))
    , (Divide -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(Divide ProcessId
pid Double
_ Double
_) -> ProcessId -> DivByZero -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid DivByZero
DivByZero)
    ]
  Process ()
math

-- | Monitor or link to a remote node
monitorOrLink :: Bool            -- ^ 'True' for monitor, 'False' for link
              -> ProcessId       -- ^ Process to monitor/link to
              -> Maybe (MVar ()) -- ^ MVar to signal on once the monitor has been set up
              -> Process (Maybe MonitorRef)
monitorOrLink :: Bool -> ProcessId -> Maybe (MVar ()) -> Process (Maybe MonitorRef)
monitorOrLink Bool
mOrL ProcessId
pid Maybe (MVar ())
mSignal = do
  Maybe MonitorRef
result <- if Bool
mOrL then MonitorRef -> Maybe MonitorRef
forall a. a -> Maybe a
Just (MonitorRef -> Maybe MonitorRef)
-> Process MonitorRef -> Process (Maybe MonitorRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessId -> Process MonitorRef
monitor ProcessId
pid
                    else ProcessId -> Process ()
link ProcessId
pid Process ()
-> Process (Maybe MonitorRef) -> Process (Maybe MonitorRef)
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe MonitorRef -> Process (Maybe MonitorRef)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MonitorRef
forall a. Maybe a
Nothing
  -- Monitor is asynchronous, which usually does not matter but if we want a
  --  *specific* signal then it does. Therefore we wait until the MonitorRef is
  -- listed in the ProcessInfo and hope that this means the monitor has been set
  -- up.
  Maybe (MVar ()) -> (MVar () -> Process ProcessId) -> Process ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (MVar ())
mSignal ((MVar () -> Process ProcessId) -> Process ())
-> (MVar () -> Process ProcessId) -> Process ()
forall a b. (a -> b) -> a -> b
$ \MVar ()
signal -> do
    ProcessId
self <- Process ProcessId
getSelfPid
    Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do
      let waitForMOrL :: Process ()
waitForMOrL = do
            Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Assertion
threadDelay Int
100000
            Maybe ProcessInfo
mpinfo <- ProcessId -> Process (Maybe ProcessInfo)
getProcessInfo ProcessId
pid
            case Maybe ProcessInfo
mpinfo of
              Maybe ProcessInfo
Nothing -> Process ()
waitForMOrL
              Just ProcessInfo
pinfo ->
               if Bool
mOrL then
                 Bool -> Process () -> Process ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe MonitorRef
result Maybe MonitorRef -> Maybe MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId -> [(ProcessId, MonitorRef)] -> Maybe MonitorRef
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ProcessId
self (ProcessInfo -> [(ProcessId, MonitorRef)]
infoMonitors ProcessInfo
pinfo)) Process ()
waitForMOrL
               else
                 Bool -> Process () -> Process ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ProcessId -> [ProcessId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ProcessId
self ([ProcessId] -> Bool) -> [ProcessId] -> Bool
forall a b. (a -> b) -> a -> b
$ ProcessInfo -> [ProcessId]
infoLinks ProcessInfo
pinfo) Process ()
waitForMOrL
      Process ()
waitForMOrL
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
signal ()
  Maybe MonitorRef -> Process (Maybe MonitorRef)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MonitorRef
result

monitorTestProcess :: ProcessId       -- Process to monitor/link to
                   -> Bool            -- 'True' for monitor, 'False' for link
                   -> Bool            -- Should we unmonitor?
                   -> DiedReason      -- Expected cause of death
                   -> Maybe (MVar ()) -- Signal for 'monitor set up'
                   -> MVar ()         -- Signal for successful termination
                   -> Process ()
monitorTestProcess :: ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess ProcessId
theirAddr Bool
mOrL Bool
un DiedReason
reason Maybe (MVar ())
monitorSetup MVar ()
done =
  Process () -> (ProcessLinkException -> Process ()) -> Process ()
forall e a.
(HasCallStack, Exception e) =>
Process a -> (e -> Process a) -> Process a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch (do Maybe MonitorRef
mRef <- Bool -> ProcessId -> Maybe (MVar ()) -> Process (Maybe MonitorRef)
monitorOrLink Bool
mOrL ProcessId
theirAddr Maybe (MVar ())
monitorSetup
            case (Bool
un, Maybe MonitorRef
mRef) of
              (Bool
True, Maybe MonitorRef
Nothing) -> do
                ProcessId -> Process ()
unlink ProcessId
theirAddr
                Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()
              (Bool
True, Just MonitorRef
ref) -> do
                MonitorRef -> Process ()
unmonitor MonitorRef
ref
                Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()
              (Bool
False, Maybe MonitorRef
ref) -> do
                [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
                    (ProcessMonitorNotification -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(ProcessMonitorNotification MonitorRef
ref' ProcessId
pid DiedReason
reason') -> do
                              Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ do
                                HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Bad Monitor Signal"
                                           (MonitorRef -> Maybe MonitorRef
forall a. a -> Maybe a
Just MonitorRef
ref' Maybe MonitorRef -> Maybe MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe MonitorRef
ref Bool -> Bool -> Bool
&& ProcessId
pid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
theirAddr Bool -> Bool -> Bool
&&
                                              Bool
mOrL Bool -> Bool -> Bool
&& DiedReason
reason DiedReason -> DiedReason -> Bool
forall a. Eq a => a -> a -> Bool
== DiedReason
reason')
                                MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ())
                  ]
        )
        (\(ProcessLinkException ProcessId
pid DiedReason
reason') -> do
            (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"link exception unmatched" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
              ProcessId
pid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
theirAddr Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
mOrL Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
un Bool -> Bool -> Bool
&& DiedReason
reason DiedReason -> DiedReason -> Bool
forall a. Eq a => a -> a -> Bool
== DiedReason
reason')
            Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()
        )

--------------------------------------------------------------------------------
-- The tests proper                                                           --
--------------------------------------------------------------------------------

-- | Basic ping test
testPing :: TestTransport -> Assertion
testPing :: TestTransport -> Assertion
testPing TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
..} = do
  MVar ProcessId
serverAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  -- Server
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode Process ()
ping
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr ProcessId
addr

  -- Client
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
pingServer <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
serverAddr

    let numPings :: Int
numPings = Int
10000

    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      ProcessId
pid <- Process ProcessId
getSelfPid
      Int -> Process () -> Process ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numPings (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
        ProcessId -> Pong -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pingServer (ProcessId -> Pong
Pong ProcessId
pid)
        Maybe Ping
p <- Int -> Process (Maybe Ping)
forall a. Serializable a => Int -> Process (Maybe a)
expectTimeout Int
3000000
        case Maybe Ping
p of
          Just (Ping ProcessId
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Maybe Ping
Nothing       -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Failed to receive Ping"

    MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone

-- | Monitor a process on an unreachable node
testMonitorUnreachable :: TestTransport -> Bool -> Bool -> Assertion
testMonitorUnreachable :: TestTransport -> Bool -> Bool -> Assertion
testMonitorUnreachable TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} Bool
mOrL Bool
un = do
  MVar ProcessId
deadProcess <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode Process ()
forall a. Serializable a => Process a
expect
    LocalNode -> Assertion
closeLocalNode LocalNode
localNode
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
deadProcess ProcessId
addr

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
theirAddr <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
deadProcess
    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$
      ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess ProcessId
theirAddr Bool
mOrL Bool
un DiedReason
DiedDisconnect Maybe (MVar ())
forall a. Maybe a
Nothing MVar ()
done

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

-- | Monitor a process which terminates normally
testMonitorNormalTermination :: TestTransport -> Bool -> Bool -> Assertion
testMonitorNormalTermination :: TestTransport -> Bool -> Bool -> Assertion
testMonitorNormalTermination TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} Bool
mOrL Bool
un = do
  MVar ()
monitorSetup <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  MVar ProcessId
monitoredProcess <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> Assertion
forall a. MVar a -> IO a
readMVar MVar ()
monitorSetup
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
monitoredProcess ProcessId
addr

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
theirAddr <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
monitoredProcess
    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$
      ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess ProcessId
theirAddr Bool
mOrL Bool
un DiedReason
DiedNormal (MVar () -> Maybe (MVar ())
forall a. a -> Maybe a
Just MVar ()
monitorSetup) MVar ()
done

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

-- | Monitor a process which terminates abnormally
testMonitorAbnormalTermination :: TestTransport -> Bool -> Bool -> Assertion
testMonitorAbnormalTermination :: TestTransport -> Bool -> Bool -> Assertion
testMonitorAbnormalTermination TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} Bool
mOrL Bool
un = do
  MVar ()
monitorSetup <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  MVar ProcessId
monitoredProcess <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  let err :: IOError
err = String -> IOError
userError String
"Abnormal termination"

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId)
-> (Assertion -> Process ()) -> Assertion -> IO ProcessId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> IO ProcessId) -> Assertion -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
      MVar () -> Assertion
forall a. MVar a -> IO a
readMVar MVar ()
monitorSetup
      IOError -> Assertion
forall e a. Exception e => e -> IO a
throwIO IOError
err
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
monitoredProcess ProcessId
addr

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
theirAddr <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
monitoredProcess
    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$
      ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess ProcessId
theirAddr Bool
mOrL Bool
un (String -> DiedReason
DiedException (IOError -> String
forall a. Show a => a -> String
show IOError
err)) (MVar () -> Maybe (MVar ())
forall a. a -> Maybe a
Just MVar ()
monitorSetup) MVar ()
done

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

-- | Monitor a local process that is already dead
testMonitorLocalDeadProcess :: TestTransport -> Bool -> Bool -> Assertion
testMonitorLocalDeadProcess :: TestTransport -> Bool -> Bool -> Assertion
testMonitorLocalDeadProcess TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} Bool
mOrL Bool
un = do
  MVar ProcessId
processAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
processAddr ProcessId
addr

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
theirAddr <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
processAddr
    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      ProcessId -> Process MonitorRef
monitor ProcessId
theirAddr
      -- wait for the process to die
      Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect :: Process ProcessMonitorNotification
      ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess ProcessId
theirAddr Bool
mOrL Bool
un DiedReason
DiedUnknownId Maybe (MVar ())
forall a. Maybe a
Nothing MVar ()
done

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

-- | Monitor a remote process that is already dead
testMonitorRemoteDeadProcess :: TestTransport -> Bool -> Bool -> Assertion
testMonitorRemoteDeadProcess :: TestTransport -> Bool -> Bool -> Assertion
testMonitorRemoteDeadProcess TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} Bool
mOrL Bool
un = do
  MVar ()
processDead <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  MVar ProcessId
processAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId)
-> (Assertion -> Process ()) -> Assertion -> IO ProcessId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> IO ProcessId) -> Assertion -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
processDead ()
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
processAddr ProcessId
addr

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
theirAddr <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
processAddr
    MVar () -> Assertion
forall a. MVar a -> IO a
readMVar MVar ()
processDead
    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess ProcessId
theirAddr Bool
mOrL Bool
un DiedReason
DiedUnknownId Maybe (MVar ())
forall a. Maybe a
Nothing MVar ()
done

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

-- | Monitor a process that becomes disconnected
testMonitorDisconnect :: TestTransport -> Bool -> Bool -> Assertion
testMonitorDisconnect :: TestTransport -> Bool -> Bool -> Assertion
testMonitorDisconnect TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} Bool
mOrL Bool
un = do
  MVar ProcessId
processAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ProcessId
processAddr2 <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
monitorSetup <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Process ()
forall a. Serializable a => Process a
expect
    ProcessId
addr2 <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
processAddr ProcessId
addr
    MVar () -> Assertion
forall a. MVar a -> IO a
readMVar MVar ()
monitorSetup
    EndPoint -> Assertion
NT.closeEndPoint (LocalNode -> EndPoint
localEndPoint LocalNode
localNode)
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
processAddr2 ProcessId
addr2

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
theirAddr <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
processAddr
    LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
      ProcessId
lc <- IO ProcessId -> Process ProcessId
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> Process ProcessId)
-> IO ProcessId -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
processAddr2
      ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
lc ()
    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess ProcessId
theirAddr Bool
mOrL Bool
un DiedReason
DiedDisconnect (MVar () -> Maybe (MVar ())
forall a. a -> Maybe a
Just MVar ()
monitorSetup) MVar ()
done

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

-- | Test the math server (i.e., receiveWait)
testMath :: TestTransport -> Assertion
testMath :: TestTransport -> Assertion
testMath TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
serverAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar (Double, Double, DivByZero)
clientDone <- IO (MVar (Double, Double, DivByZero))
forall a. IO (MVar a)
newEmptyMVar

  -- Server
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode Process ()
math
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr ProcessId
addr

  -- Client
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
mathServer <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
serverAddr

    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      ProcessId
pid <- Process ProcessId
getSelfPid
      ProcessId -> Add -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Add
Add ProcessId
pid Double
1 Double
2)
      Double
three <- Process Double
forall a. Serializable a => Process a
expect :: Process Double
      ProcessId -> Divide -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Divide
Divide ProcessId
pid Double
8 Double
2)
      Double
four <- Process Double
forall a. Serializable a => Process a
expect :: Process Double
      ProcessId -> Divide -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Divide
Divide ProcessId
pid Double
8 Double
0)
      DivByZero
divByZ <- Process DivByZero
forall a. Serializable a => Process a
expect
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (Double, Double, DivByZero)
-> (Double, Double, DivByZero) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (Double, Double, DivByZero)
clientDone (Double
three, Double
four, DivByZero
divByZ)

  (Double, Double, DivByZero)
res <- MVar (Double, Double, DivByZero) -> IO (Double, Double, DivByZero)
forall a. MVar a -> IO a
takeMVar MVar (Double, Double, DivByZero)
clientDone
  case (Double, Double, DivByZero)
res of
    (Double
3, Double
4, DivByZero
DivByZero) -> () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Double, Double, DivByZero)
_                 -> String -> Assertion
forall a. HasCallStack => String -> a
error (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ String
"Something went horribly wrong"

-- | Send first message (i.e. connect) to an already terminated process
-- (without monitoring); then send another message to a second process on
-- the same remote node (we're checking that the remote node did not die)
testSendToTerminated :: TestTransport -> Assertion
testSendToTerminated :: TestTransport -> Assertion
testSendToTerminated TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
serverAddr1 <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ProcessId
serverAddr2 <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar Bool
clientDone <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    MVar ()
terminated <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
addr1 <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
terminated ()
    ProcessId
addr2 <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Process ()
ping
    MVar () -> Assertion
forall a. MVar a -> IO a
readMVar MVar ()
terminated
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr1 ProcessId
addr1
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr2 ProcessId
addr2

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
server1 <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
serverAddr1
    ProcessId
server2 <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
serverAddr2
    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      ProcessId
pid <- Process ProcessId
getSelfPid
      ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server1 String
"Hi"
      ProcessId -> Pong -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server2 (ProcessId -> Pong
Pong ProcessId
pid)
      MVar Bool -> Process ()
expectPing MVar Bool
clientDone

  String -> MVar Bool -> Assertion
verifyClient String
"Expected Ping from server" MVar Bool
clientDone

-- | Test (non-zero) timeout
testTimeout :: TestTransport -> Assertion
testTimeout :: TestTransport -> Assertion
testTimeout TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar Bool
done <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar

  LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    Maybe ()
res <- Int -> [Match ()] -> Process (Maybe ())
forall b. Int -> [Match b] -> Process (Maybe b)
receiveTimeout Int
1000000 [(Add -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match (\Add{} -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())]
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
done (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Maybe ()
res Maybe () -> Maybe () -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ()
forall a. Maybe a
Nothing

  String -> MVar Bool -> Assertion
verifyClient String
"Expected receiveTimeout to timeout..." MVar Bool
done

-- | Test zero timeout
testTimeout0 :: TestTransport -> Assertion
testTimeout0 :: TestTransport -> Assertion
testTimeout0 TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
serverAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar Bool
clientDone <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
      -- Variation on the venerable ping server which uses a zero timeout
      ProcessId
partner <- (Process ProcessId -> Process ProcessId) -> Process ProcessId
forall a. (a -> a) -> a
fix ((Process ProcessId -> Process ProcessId) -> Process ProcessId)
-> (Process ProcessId -> Process ProcessId) -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ \Process ProcessId
loop ->
        Int -> [Match ProcessId] -> Process (Maybe ProcessId)
forall b. Int -> [Match b] -> Process (Maybe b)
receiveTimeout Int
0 [(Pong -> Process ProcessId) -> Match ProcessId
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(Pong ProcessId
partner) -> ProcessId -> Process ProcessId
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessId
partner)]
          Process (Maybe ProcessId)
-> (Maybe ProcessId -> Process ProcessId) -> Process ProcessId
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Process ProcessId
-> (ProcessId -> Process ProcessId)
-> Maybe ProcessId
-> Process ProcessId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> Assertion
threadDelay Int
100000) Process () -> Process ProcessId -> Process ProcessId
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Process ProcessId
loop) ProcessId -> Process ProcessId
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return
      ProcessId
self <- Process ProcessId
getSelfPid
      ProcessId -> Ping -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
partner (ProcessId -> Ping
Ping ProcessId
self)
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr ProcessId
addr

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
server <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
serverAddr
    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      ProcessId
pid <- Process ProcessId
getSelfPid
      -- Send a bunch of messages. A large number of messages that the server
      -- is not interested in, and then a single message that it wants
      Int -> Process () -> Process ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
10000 (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server String
"Irrelevant message"
      ProcessId -> Pong -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server (ProcessId -> Pong
Pong ProcessId
pid)
      MVar Bool -> Process ()
expectPing MVar Bool
clientDone

  String -> MVar Bool -> Assertion
verifyClient String
"Expected Ping from server" MVar Bool
clientDone

-- | Test typed channels
testTypedChannels :: TestTransport -> Assertion
testTypedChannels :: TestTransport -> Assertion
testTypedChannels TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar (SendPort (SendPort Bool, Int))
serverChannel <- IO (MVar (SendPort (SendPort Bool, Int)))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (SendPort (SendPort Bool, Int)))
  MVar Bool
clientDone <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
      (SendPort (SendPort Bool, Int)
serverSendPort, ReceivePort (SendPort Bool, Int)
rport) <- Process
  (SendPort (SendPort Bool, Int), ReceivePort (SendPort Bool, Int))
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (SendPort (SendPort Bool, Int))
-> SendPort (SendPort Bool, Int) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (SendPort (SendPort Bool, Int))
serverChannel SendPort (SendPort Bool, Int)
serverSendPort
      (SendPort Bool
clientSendPort, Int
i) <- ReceivePort (SendPort Bool, Int) -> Process (SendPort Bool, Int)
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort (SendPort Bool, Int)
rport
      SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
clientSendPort (Int -> Bool
forall a. Integral a => a -> Bool
even Int
i)
    () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    SendPort (SendPort Bool, Int)
serverSendPort <- MVar (SendPort (SendPort Bool, Int))
-> IO (SendPort (SendPort Bool, Int))
forall a. MVar a -> IO a
readMVar MVar (SendPort (SendPort Bool, Int))
serverChannel
    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      (SendPort Bool
clientSendPort, ReceivePort Bool
rport) <- Process (SendPort Bool, ReceivePort Bool)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
      SendPort (SendPort Bool, Int) -> (SendPort Bool, Int) -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort (SendPort Bool, Int)
serverSendPort (SendPort Bool
clientSendPort, Int
5)
      Bool
ch <- ReceivePort Bool -> Process Bool
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Bool
rport
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
clientDone (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Bool
ch Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False

  String -> MVar Bool -> Assertion
verifyClient String
"Expected channel to send 'False'" MVar Bool
clientDone

-- | Test merging receive ports
testMergeChannels :: TestTransport -> Assertion
testMergeChannels :: TestTransport -> Assertion
testMergeChannels TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    LocalNode -> Bool -> String -> Assertion
testFlat LocalNode
localNode Bool
True          String
"aaabbbccc"
    LocalNode -> Bool -> String -> Assertion
testFlat LocalNode
localNode Bool
False         String
"abcabcabc"
    LocalNode -> Bool -> Bool -> String -> Assertion
testNested LocalNode
localNode Bool
True Bool
True   String
"aaabbbcccdddeeefffggghhhiii"
    LocalNode -> Bool -> Bool -> String -> Assertion
testNested LocalNode
localNode Bool
True Bool
False  String
"adgadgadgbehbehbehcficficfi"
    LocalNode -> Bool -> Bool -> String -> Assertion
testNested LocalNode
localNode Bool
False Bool
True  String
"abcabcabcdefdefdefghighighi"
    LocalNode -> Bool -> Bool -> String -> Assertion
testNested LocalNode
localNode Bool
False Bool
False String
"adgbehcfiadgbehcfiadgbehcfi"
    LocalNode -> Bool -> Assertion
testBlocked LocalNode
localNode Bool
True
    LocalNode -> Bool -> Assertion
testBlocked LocalNode
localNode Bool
False
  where
    -- Single layer of merging
    testFlat :: LocalNode -> Bool -> String -> IO ()
    testFlat :: LocalNode -> Bool -> String -> Assertion
testFlat LocalNode
localNode Bool
biased String
expected = do
      MVar Bool
done <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
      LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
        [ReceivePort Char]
rs  <- (Char -> Process (ReceivePort Char))
-> String -> Process [ReceivePort Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Char -> Process (ReceivePort Char)
charChannel String
"abc"
        ReceivePort Char
m   <- Bool -> [ReceivePort Char] -> Process (ReceivePort Char)
forall a.
Serializable a =>
Bool -> [ReceivePort a] -> Process (ReceivePort a)
mergePorts Bool
biased [ReceivePort Char]
rs
        String
xs  <- Int -> Process Char -> Process String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
9 (Process Char -> Process String) -> Process Char -> Process String
forall a b. (a -> b) -> a -> b
$ ReceivePort Char -> Process Char
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Char
m
        Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
done (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
expected
      String -> MVar Bool -> Assertion
verifyClient String
"Expected single layer merge to match expected ordering" MVar Bool
done

    -- Two layers of merging
    testNested :: LocalNode -> Bool -> Bool -> String -> IO ()
    testNested :: LocalNode -> Bool -> Bool -> String -> Assertion
testNested LocalNode
localNode Bool
biasedInner Bool
biasedOuter String
expected = do
      MVar Bool
done <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
      LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
        [[ReceivePort Char]]
rss  <- (String -> Process [ReceivePort Char])
-> [String] -> Process [[ReceivePort Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Char -> Process (ReceivePort Char))
-> String -> Process [ReceivePort Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Char -> Process (ReceivePort Char)
charChannel) [String
"abc", String
"def", String
"ghi"]
        [ReceivePort Char]
ms   <- ([ReceivePort Char] -> Process (ReceivePort Char))
-> [[ReceivePort Char]] -> Process [ReceivePort Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Bool -> [ReceivePort Char] -> Process (ReceivePort Char)
forall a.
Serializable a =>
Bool -> [ReceivePort a] -> Process (ReceivePort a)
mergePorts Bool
biasedInner) [[ReceivePort Char]]
rss
        ReceivePort Char
m    <- Bool -> [ReceivePort Char] -> Process (ReceivePort Char)
forall a.
Serializable a =>
Bool -> [ReceivePort a] -> Process (ReceivePort a)
mergePorts Bool
biasedOuter [ReceivePort Char]
ms
        String
xs   <- Int -> Process Char -> Process String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3) (Process Char -> Process String) -> Process Char -> Process String
forall a b. (a -> b) -> a -> b
$ ReceivePort Char -> Process Char
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Char
m
        Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
done (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
expected
      String -> MVar Bool -> Assertion
verifyClient String
"Expected nested channels to match expeted ordering" MVar Bool
done

    -- Test that if no messages are (immediately) available, the scheduler makes no difference
    testBlocked :: LocalNode -> Bool -> IO ()
    testBlocked :: LocalNode -> Bool -> Assertion
testBlocked LocalNode
localNode Bool
biased = do
      [MVar (SendPort Char)]
vs <- Int -> IO (MVar (SendPort Char)) -> IO [MVar (SendPort Char)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 IO (MVar (SendPort Char))
forall a. IO (MVar a)
newEmptyMVar
      MVar Bool
done <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar

      LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
        [SendPort Char]
ss <- IO [SendPort Char] -> Process [SendPort Char]
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SendPort Char] -> Process [SendPort Char])
-> IO [SendPort Char] -> Process [SendPort Char]
forall a b. (a -> b) -> a -> b
$ (MVar (SendPort Char) -> IO (SendPort Char))
-> [MVar (SendPort Char)] -> IO [SendPort Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM MVar (SendPort Char) -> IO (SendPort Char)
forall a. MVar a -> IO a
readMVar [MVar (SendPort Char)]
vs
        case [SendPort Char]
ss of
          [SendPort Char
sa, SendPort Char
sb, SendPort Char
sc] ->
            ((SendPort Char, Char) -> Process ())
-> [(SendPort Char, Char)] -> Process ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Process ()
pause Int
10000) (Process () -> Process ())
-> ((SendPort Char, Char) -> Process ())
-> (SendPort Char, Char)
-> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SendPort Char -> Char -> Process ())
-> (SendPort Char, Char) -> Process ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SendPort Char -> Char -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan)
              [ -- a, b, c
                (SendPort Char
sa, Char
'a')
              , (SendPort Char
sb, Char
'b')
              , (SendPort Char
sc, Char
'c')
                -- a, c, b
              , (SendPort Char
sa, Char
'a')
              , (SendPort Char
sc, Char
'c')
              , (SendPort Char
sb, Char
'b')
                -- b, a, c
              , (SendPort Char
sb, Char
'b')
              , (SendPort Char
sa, Char
'a')
              , (SendPort Char
sc, Char
'c')
                -- b, c, a
              , (SendPort Char
sb, Char
'b')
              , (SendPort Char
sc, Char
'c')
              , (SendPort Char
sa, Char
'a')
                -- c, a, b
              , (SendPort Char
sc, Char
'c')
              , (SendPort Char
sa, Char
'a')
              , (SendPort Char
sb, Char
'b')
                -- c, b, a
              , (SendPort Char
sc, Char
'c')
              , (SendPort Char
sb, Char
'b')
              , (SendPort Char
sa, Char
'a')
              ]
          [SendPort Char]
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"

      LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
        ([SendPort Char]
ss, [ReceivePort Char]
rs) <- [(SendPort Char, ReceivePort Char)]
-> ([SendPort Char], [ReceivePort Char])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(SendPort Char, ReceivePort Char)]
 -> ([SendPort Char], [ReceivePort Char]))
-> Process [(SendPort Char, ReceivePort Char)]
-> Process ([SendPort Char], [ReceivePort Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Process (SendPort Char, ReceivePort Char)
-> Process [(SendPort Char, ReceivePort Char)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 Process (SendPort Char, ReceivePort Char)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
        Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ ((MVar (SendPort Char), SendPort Char) -> Assertion)
-> [(MVar (SendPort Char), SendPort Char)] -> Assertion
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((MVar (SendPort Char) -> SendPort Char -> Assertion)
-> (MVar (SendPort Char), SendPort Char) -> Assertion
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MVar (SendPort Char) -> SendPort Char -> Assertion
forall a. MVar a -> a -> Assertion
putMVar) ([(MVar (SendPort Char), SendPort Char)] -> Assertion)
-> [(MVar (SendPort Char), SendPort Char)] -> Assertion
forall a b. (a -> b) -> a -> b
$ [MVar (SendPort Char)]
-> [SendPort Char] -> [(MVar (SendPort Char), SendPort Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [MVar (SendPort Char)]
vs [SendPort Char]
ss
        ReceivePort Char
m  <- Bool -> [ReceivePort Char] -> Process (ReceivePort Char)
forall a.
Serializable a =>
Bool -> [ReceivePort a] -> Process (ReceivePort a)
mergePorts Bool
biased [ReceivePort Char]
rs
        String
xs <- Int -> Process Char -> Process String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3) (Process Char -> Process String) -> Process Char -> Process String
forall a b. (a -> b) -> a -> b
$ ReceivePort Char -> Process Char
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Char
m
        Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
done (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"abcacbbacbcacabcba"

      String -> MVar Bool -> Assertion
verifyClient String
"Expected merged ports to match expected ordering" MVar Bool
done

    mergePorts :: Serializable a => Bool -> [ReceivePort a] -> Process (ReceivePort a)
    mergePorts :: forall a.
Serializable a =>
Bool -> [ReceivePort a] -> Process (ReceivePort a)
mergePorts Bool
True  = [ReceivePort a] -> Process (ReceivePort a)
forall a.
Serializable a =>
[ReceivePort a] -> Process (ReceivePort a)
mergePortsBiased
    mergePorts Bool
False = [ReceivePort a] -> Process (ReceivePort a)
forall a.
Serializable a =>
[ReceivePort a] -> Process (ReceivePort a)
mergePortsRR

    charChannel :: Char -> Process (ReceivePort Char)
    charChannel :: Char -> Process (ReceivePort Char)
charChannel Char
c = do
      (SendPort Char
sport, ReceivePort Char
rport) <- Process (SendPort Char, ReceivePort Char)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
      Int -> Process () -> Process ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
3 (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ SendPort Char -> Char -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Char
sport Char
c
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Assertion
threadDelay Int
10000 -- Make sure messages have been sent
      ReceivePort Char -> Process (ReceivePort Char)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ReceivePort Char
rport

testTerminate :: TestTransport -> Assertion
testTerminate :: TestTransport -> Assertion
testTerminate TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    Either ProcessTerminationException ()
e <- Process () -> Process (Either ProcessTerminationException ())
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try Process ()
forall a. Process a
terminate :: Process (Either ProcessTerminationException ())
    if (ProcessTerminationException -> String)
-> (() -> String)
-> Either ProcessTerminationException ()
-> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ProcessTerminationException -> String
forall a. Show a => a -> String
show () -> String
forall a. Show a => a -> String
show Either ProcessTerminationException ()
e String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessTerminationException -> String
forall a. Show a => a -> String
show ProcessTerminationException
ProcessTerminationException
      then () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      else String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Unexpected result from terminate"

testMonitorNode :: TestTransport -> Assertion
testMonitorNode :: TestTransport -> Assertion
testMonitorNode TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  [LocalNode
node1, LocalNode
node2] <- Int -> IO LocalNode -> IO [LocalNode]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (IO LocalNode -> IO [LocalNode]) -> IO LocalNode -> IO [LocalNode]
forall a b. (a -> b) -> a -> b
$ Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar Bool
done <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar

  LocalNode -> Assertion
closeLocalNode LocalNode
node1

  LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    MonitorRef
ref <- NodeId -> Process MonitorRef
monitorNode (LocalNode -> NodeId
localNodeId LocalNode
node1)
    [Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [
        (NodeMonitorNotification -> Process Bool) -> Match Bool
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(NodeMonitorNotification MonitorRef
ref' NodeId
nid DiedReason
DiedDisconnect) ->
                Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ MonitorRef
ref MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref' Bool -> Bool -> Bool
&& NodeId
nid NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
== LocalNode -> NodeId
localNodeId LocalNode
node1)
      ] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
done

  String -> MVar Bool -> Assertion
verifyClient String
"Expected NodeMonitorNotification with matching ref & nodeId" MVar Bool
done

testMonitorLiveNode :: TestTransport -> Assertion
testMonitorLiveNode :: TestTransport -> Assertion
testMonitorLiveNode TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  [LocalNode
node1, LocalNode
node2] <- Int -> IO LocalNode -> IO [LocalNode]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (IO LocalNode -> IO [LocalNode]) -> IO LocalNode -> IO [LocalNode]
forall a b. (a -> b) -> a -> b
$ Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar ()
ready <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
readyr <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  MVar Bool
done <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar

  ProcessId
p <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node2 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    MonitorRef
ref <- NodeId -> Process MonitorRef
monitorNode (LocalNode -> NodeId
localNodeId LocalNode
node1)
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
ready ()
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
readyr
    ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p ()
    [Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [
        (NodeMonitorNotification -> Process Bool) -> Match Bool
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(NodeMonitorNotification MonitorRef
ref' NodeId
nid DiedReason
_) ->
                (Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ MonitorRef
ref MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref' Bool -> Bool -> Bool
&& NodeId
nid NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
== LocalNode -> NodeId
localNodeId LocalNode
node1))
      ] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
done

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
ready
  LocalNode -> Assertion
closeLocalNode LocalNode
node1
  MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
readyr ()

  String -> MVar Bool -> Assertion
verifyClient String
"Expected NodeMonitorNotification for LIVE node" MVar Bool
done

testMonitorChannel :: TestTransport -> Assertion
testMonitorChannel :: TestTransport -> Assertion
testMonitorChannel TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
    [LocalNode
node1, LocalNode
node2] <- Int -> IO LocalNode -> IO [LocalNode]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (IO LocalNode -> IO [LocalNode]) -> IO LocalNode -> IO [LocalNode]
forall a b. (a -> b) -> a -> b
$ Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    MVar Bool
gotNotification <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar

    ProcessId
pid <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
      SendPort ()
sport <- Process (SendPort ())
forall a. Serializable a => Process a
expect :: Process (SendPort ())
      MonitorRef
ref <- SendPort () -> Process MonitorRef
forall a. Serializable a => SendPort a -> Process MonitorRef
monitorPort SendPort ()
sport
      [Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [
          -- reason might be DiedUnknownId if the receive port is GCed before the
          -- monitor is established (TODO: not sure that this is reasonable)
          (PortMonitorNotification -> Process Bool) -> Match Bool
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(PortMonitorNotification MonitorRef
ref' SendPortId
port' DiedReason
reason) ->
                  Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ MonitorRef
ref' MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref Bool -> Bool -> Bool
&& SendPortId
port' SendPortId -> SendPortId -> Bool
forall a. Eq a => a -> a -> Bool
== SendPort () -> SendPortId
forall a. SendPort a -> SendPortId
sendPortId SendPort ()
sport Bool -> Bool -> Bool
&&
                    (DiedReason
reason DiedReason -> DiedReason -> Bool
forall a. Eq a => a -> a -> Bool
== DiedReason
DiedNormal Bool -> Bool -> Bool
|| DiedReason
reason DiedReason -> DiedReason -> Bool
forall a. Eq a => a -> a -> Bool
== DiedReason
DiedUnknownId))
        ] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
gotNotification

    LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      (SendPort ()
sport, ReceivePort ()
_) <- Process (SendPort (), ReceivePort ())
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan :: Process (SendPort (), ReceivePort ())
      ProcessId -> SendPort () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid SendPort ()
sport
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Assertion
threadDelay Int
100000

    String -> MVar Bool -> Assertion
verifyClient String
"Expected PortMonitorNotification" MVar Bool
gotNotification

testRegistry :: TestTransport -> Assertion
testRegistry :: TestTransport -> Assertion
testRegistry TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
node <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  ProcessId
pingServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node Process ()
ping
  ProcessId
deadProcess <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node (() -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

  LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    String -> ProcessId -> Process ()
register String
"ping" ProcessId
pingServer
    String -> Process (Maybe ProcessId)
whereis String
"ping" Process (Maybe ProcessId)
-> (Maybe ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Maybe ProcessId -> Assertion) -> Maybe ProcessId -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Unexpected ping" (Bool -> Assertion)
-> (Maybe ProcessId -> Bool) -> Maybe ProcessId -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ProcessId -> Maybe ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId -> Maybe ProcessId
forall a. a -> Maybe a
Just ProcessId
pingServer)
    ProcessId
us <- Process ProcessId
getSelfPid
    String -> Pong -> Process ()
forall a. Serializable a => String -> a -> Process ()
nsend String
"ping" (ProcessId -> Pong
Pong ProcessId
us)
    [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
        (Ping -> Bool) -> (Ping -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(Ping ProcessId
pid') -> ProcessId
pingServer ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid') (Process () -> Ping -> Process ()
forall a b. a -> b -> a
const (Process () -> Ping -> Process ())
-> Process () -> Ping -> Process ()
forall a b. (a -> b) -> a -> b
$ () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
      ]
    String -> Maybe Any -> ProcessId -> Process ()
forall {p}. String -> p -> ProcessId -> Process ()
checkRegException String
"dead" Maybe Any
forall a. Maybe a
Nothing ProcessId
deadProcess
    String -> Maybe ProcessId -> ProcessId -> Process ()
forall {p}. String -> p -> ProcessId -> Process ()
checkRegException String
"ping" (ProcessId -> Maybe ProcessId
forall a. a -> Maybe a
Just ProcessId
pingServer) ProcessId
deadProcess
    Process () -> Process (Either ProcessRegistrationException ())
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (String -> Process ()
unregister String
"dead") Process (Either ProcessRegistrationException ())
-> (Either ProcessRegistrationException () -> Process ())
-> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> Maybe Any
-> Either ProcessRegistrationException ()
-> Process ()
forall {b} {p} {p}.
Show b =>
p -> p -> Either ProcessRegistrationException b -> Process ()
checkReg String
"dead" Maybe Any
forall a. Maybe a
Nothing
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

  where
    checkRegException :: String -> p -> ProcessId -> Process ()
checkRegException String
name p
pid ProcessId
dead =
      Process () -> Process (Either ProcessRegistrationException ())
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (String -> ProcessId -> Process ()
register String
name ProcessId
dead) Process (Either ProcessRegistrationException ())
-> (Either ProcessRegistrationException () -> Process ())
-> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> p -> Either ProcessRegistrationException () -> Process ()
forall {b} {p} {p}.
Show b =>
p -> p -> Either ProcessRegistrationException b -> Process ()
checkReg String
name p
pid

    checkReg :: p -> p -> Either ProcessRegistrationException b -> Process ()
checkReg p
_ p
_ Either ProcessRegistrationException b
res =
      case Either ProcessRegistrationException b
res of
        Left (ProcessRegistrationException String
_ Maybe ProcessId
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Either ProcessRegistrationException b
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Registration" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Either ProcessRegistrationException b -> String
forall a. Show a => a -> String
show Either ProcessRegistrationException b
res

testRegistryRemoteProcess :: TestTransport -> Assertion
testRegistryRemoteProcess :: TestTransport -> Assertion
testRegistryRemoteProcess TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
node1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  LocalNode
node2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  ProcessId
pingServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 Process ()
ping

  LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    String -> ProcessId -> Process ()
register String
"ping" ProcessId
pingServer
    String -> Process (Maybe ProcessId)
whereis String
"ping" Process (Maybe ProcessId)
-> (Maybe ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Maybe ProcessId -> Assertion) -> Maybe ProcessId -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Unexpected ping" (Bool -> Assertion)
-> (Maybe ProcessId -> Bool) -> Maybe ProcessId -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ProcessId -> Maybe ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId -> Maybe ProcessId
forall a. a -> Maybe a
Just ProcessId
pingServer)
    ProcessId
us <- Process ProcessId
getSelfPid
    String -> Pong -> Process ()
forall a. Serializable a => String -> a -> Process ()
nsend String
"ping" (ProcessId -> Pong
Pong ProcessId
us)
    [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
        (Ping -> Bool) -> (Ping -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(Ping ProcessId
pid') -> ProcessId
pingServer ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid')
                (Process () -> Ping -> Process ()
forall a b. a -> b -> a
const (Process () -> Ping -> Process ())
-> Process () -> Ping -> Process ()
forall a b. (a -> b) -> a -> b
$ Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ())
      ]

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

testRemoteRegistry :: TestTransport -> Assertion
testRemoteRegistry :: TestTransport -> Assertion
testRemoteRegistry TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
node1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  LocalNode
node2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable

  ProcessId
pingServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 Process ()
ping
  ProcessId
deadProcess <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (() -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

  LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    let nid1 :: NodeId
nid1 = LocalNode -> NodeId
localNodeId LocalNode
node1
    NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"ping" ProcessId
pingServer
    [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
       (RegisterReply -> Bool)
-> (RegisterReply -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
_ (Just ProcessId
pid)) ->
                    String
"ping" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label' Bool -> Bool -> Bool
&& ProcessId
pid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pingServer)
               (\(RegisterReply String
_ Bool
_ Maybe ProcessId
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]

    ProcessId
pid <- NodeId -> String -> Process ProcessId
verifyWhereIsRemote NodeId
nid1 String
"ping"
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected pindServer to match pid" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ ProcessId
pingServer ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid

    ProcessId
us <- Process ProcessId
getSelfPid
    NodeId -> String -> Pong -> Process ()
forall a. Serializable a => NodeId -> String -> a -> Process ()
nsendRemote NodeId
nid1 String
"ping" (ProcessId -> Pong
Pong ProcessId
us)
    [Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [
        (Ping -> Process Bool) -> Match Bool
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(Ping ProcessId
pid') -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ ProcessId
pingServer ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid')
      ] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected Ping with ping server's ProcessId"

    -- test that if process was not registered Nothing is returned
    -- in owner field.
    NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"dead" ProcessId
deadProcess
    [Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [ (RegisterReply -> Bool)
-> (RegisterReply -> Process Bool) -> Match Bool
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
_ Maybe ProcessId
_) -> String
"dead" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label')
                          (\(RegisterReply String
_ Bool
f Maybe ProcessId
mPid) -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
f Bool -> Bool -> Bool
&& Maybe ProcessId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ProcessId
mPid))
                ] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected False Nothing in RegisterReply"

    NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"ping" ProcessId
deadProcess
    [Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [
        (RegisterReply -> Bool)
-> (RegisterReply -> Process Bool) -> Match Bool
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
False Maybe ProcessId
mPid) ->
                     String
"ping" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label' Bool -> Bool -> Bool
&& Maybe ProcessId -> Bool
forall a. Maybe a -> Bool
isJust Maybe ProcessId
mPid)
                (\(RegisterReply String
_ Bool
f (Just ProcessId
pid'')) -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
f Bool -> Bool -> Bool
&& ProcessId
pid'' ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pingServer))
      ] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected False and (Just alreadyRegisteredPid) in RegisterReply"

    NodeId -> String -> Process ()
unregisterRemoteAsync NodeId
nid1 String
"dead"
    [Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [
        (RegisterReply -> Bool)
-> (RegisterReply -> Process Bool) -> Match Bool
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
_ Maybe ProcessId
_) -> String
"dead" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label')
                (\(RegisterReply String
_ Bool
f Maybe ProcessId
mPid) -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
f Bool -> Bool -> Bool
&& Maybe ProcessId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ProcessId
mPid))
      ] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected False and Nothing in RegisterReply"

testRemoteRegistryRemoteProcess :: TestTransport -> Assertion
testRemoteRegistryRemoteProcess :: TestTransport -> Assertion
testRemoteRegistryRemoteProcess TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
node1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  LocalNode
node2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar Bool
done <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar

  ProcessId
pingServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node2 Process ()
ping

  LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    let nid1 :: NodeId
nid1 = LocalNode -> NodeId
localNodeId LocalNode
node1
    NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"ping" ProcessId
pingServer
    [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
       (RegisterReply -> Bool)
-> (RegisterReply -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
_ Maybe ProcessId
_) -> String
"ping" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label')
               (\(RegisterReply String
_ Bool
_ Maybe ProcessId
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]
    ProcessId
pid <- NodeId -> String -> Process ProcessId
verifyWhereIsRemote NodeId
nid1 String
"ping"
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected pingServer to match remote name" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ ProcessId
pingServer ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid
    ProcessId
us <- Process ProcessId
getSelfPid
    NodeId -> String -> Pong -> Process ()
forall a. Serializable a => NodeId -> String -> a -> Process ()
nsendRemote NodeId
nid1 String
"ping" (ProcessId -> Pong
Pong ProcessId
us)
    [Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [
        (Ping -> Process Bool) -> Match Bool
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(Ping ProcessId
pid') -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ ProcessId
pingServer ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid')
      ] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
done

  String -> MVar Bool -> Assertion
verifyClient String
"Expected Ping with ping server's ProcessId" MVar Bool
done

testSpawnLocal :: TestTransport -> Assertion
testSpawnLocal :: TestTransport -> Assertion
testSpawnLocal TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
node <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar Int
done <- IO (MVar Int)
forall a. IO (MVar a)
newEmptyMVar

  LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
us <- Process ProcessId
getSelfPid

    ProcessId
pid <- Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do
      SendPort Int
sport <- Process (SendPort Int)
forall a. Serializable a => Process a
expect
      SendPort Int -> Int -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Int
sport (Int
1234 :: Int)

    SendPort Int
sport <- (ReceivePort Int -> Process ()) -> Process (SendPort Int)
forall a.
Serializable a =>
(ReceivePort a -> Process ()) -> Process (SendPort a)
spawnChannelLocal ((ReceivePort Int -> Process ()) -> Process (SendPort Int))
-> (ReceivePort Int -> Process ()) -> Process (SendPort Int)
forall a b. (a -> b) -> a -> b
$
      \ReceivePort Int
rport -> (ReceivePort Int -> Process Int
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Int
rport :: Process Int) Process Int -> (Int -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessId -> Int -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
us

    ProcessId -> SendPort Int -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid SendPort Int
sport
    Process Int
forall a. Serializable a => Process a
expect Process Int -> (Int -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Int -> Assertion) -> Int -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Int -> Int -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Int
done

  Int
res <- MVar Int -> IO Int
forall a. MVar a -> IO a
takeMVar MVar Int
done
  HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 1234 :: Int" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Int
res Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
1234 :: Int)

testSpawnAsyncStrictness :: TestTransport -> Assertion
testSpawnAsyncStrictness :: TestTransport -> Assertion
testSpawnAsyncStrictness TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
node <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar Assertion
done <- IO (MVar Assertion)
forall a. IO (MVar a)
newEmptyMVar

  LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    NodeId
here <-Process NodeId
getSelfNode

    Either SomeException SpawnRef
ev <- Process SpawnRef -> Process (Either SomeException SpawnRef)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (Process SpawnRef -> Process (Either SomeException SpawnRef))
-> Process SpawnRef -> Process (Either SomeException SpawnRef)
forall a b. (a -> b) -> a -> b
$ NodeId -> Closure (Process ()) -> Process SpawnRef
spawnAsync NodeId
here (String -> Closure (Process ())
forall a. HasCallStack => String -> a
error String
"boom")
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ case Either SomeException SpawnRef
ev of
      Right SpawnRef
_ -> MVar Assertion -> Assertion -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Assertion
done (String -> Assertion
forall a. HasCallStack => String -> a
error String
"Exception didn't fire")
      Left (SomeException
_::SomeException) -> MVar Assertion -> Assertion -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Assertion
done (() -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

  IO Assertion -> Assertion
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO Assertion -> Assertion) -> IO Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$ MVar Assertion -> IO Assertion
forall a. MVar a -> IO a
takeMVar MVar Assertion
done

testReconnect :: TestTransport -> Assertion
testReconnect :: TestTransport -> Assertion
testReconnect TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  [LocalNode
node1, LocalNode
node2] <- Int -> IO LocalNode -> IO [LocalNode]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (IO LocalNode -> IO [LocalNode]) -> IO LocalNode -> IO [LocalNode]
forall a b. (a -> b) -> a -> b
$ Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  let nid1 :: NodeId
nid1 = LocalNode -> NodeId
localNodeId LocalNode
node1
  MVar ProcessId
processA <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  [MVar ()
sendTestOk, MVar ()
registerTestOk] <- Int -> IO (MVar ()) -> IO [MVar ()]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
us <- Process ProcessId
getSelfPid
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
processA ProcessId
us
    String
msg1 <- Process String
forall a. Serializable a => Process a
expect
    String
msg2 <- Process String
forall a. Serializable a => Process a
expect
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ do
      HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"messages did not match" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ String
msg1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"message 1" Bool -> Bool -> Bool
&& String
msg2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"message 3"
      MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
sendTestOk ()

  LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node2 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    {-
     - Make sure there is no implicit reconnect on normal message sending
     -}

    ProcessId
them <- IO ProcessId -> Process ProcessId
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> Process ProcessId)
-> IO ProcessId -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
processA
    ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
them String
"message 1" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> Assertion
threadDelay Int
100000)

    -- Simulate network failure
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ (EndPointAddress -> EndPointAddress -> Assertion)
-> LocalNode -> LocalNode -> Assertion
syncBreakConnection EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection LocalNode
node1 LocalNode
node2


    -- Should not arrive
    ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
them String
"message 2"

    -- Should arrive
    ProcessId -> Process ()
reconnect ProcessId
them
    ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
them String
"message 3"

    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
sendTestOk

    {-
     - Test that there *is* implicit reconnect on node controller messages
     -}

    ProcessId
us <- Process ProcessId
getSelfPid
    NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"a" ProcessId
us -- registerRemote is asynchronous
    [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
        (RegisterReply -> Bool)
-> (RegisterReply -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
_ Maybe ProcessId
_) -> String
"a" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label')
                (\(RegisterReply String
_ Bool
_ Maybe ProcessId
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]

    Maybe ProcessId
_  <- NodeId -> String -> Process (Maybe ProcessId)
whereisRemote NodeId
nid1 String
"a"


    -- Simulate network failure
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ (EndPointAddress -> EndPointAddress -> Assertion)
-> LocalNode -> LocalNode -> Assertion
syncBreakConnection EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection LocalNode
node1 LocalNode
node2

    -- This will happen due to implicit reconnect
    NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"b" ProcessId
us
    [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
        (RegisterReply -> Bool)
-> (RegisterReply -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
_ Maybe ProcessId
_) -> String
"b" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label')
                (\(RegisterReply String
_ Bool
_ Maybe ProcessId
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]

    -- Should happen
    NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"c" ProcessId
us
    [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
        (RegisterReply -> Bool)
-> (RegisterReply -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
_ Maybe ProcessId
_) -> String
"c" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label')
                (\(RegisterReply String
_ Bool
_ Maybe ProcessId
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]

    -- Check
    Maybe ProcessId
mPid <- NodeId -> String -> Process (Maybe ProcessId)
whereisRemote NodeId
nid1 String
"a"  -- this will fail because the name is removed when the node is disconnected
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected remote name to be lost" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Maybe ProcessId
mPid Maybe ProcessId -> Maybe ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ProcessId
forall a. Maybe a
Nothing
    NodeId -> String -> Process ProcessId
verifyWhereIsRemote NodeId
nid1 String
"b"  -- this will suceed because the value is set after thereconnect
    NodeId -> String -> Process ProcessId
verifyWhereIsRemote NodeId
nid1 String
"c"

    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
registerTestOk ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
registerTestOk

-- | Tests that unreliable messages arrive sorted even when there are connection
-- failures.
testUSend :: (ProcessId -> Int -> Process ())
          -> TestTransport -> Int -> Assertion
testUSend :: (ProcessId -> Int -> Process ())
-> TestTransport -> Int -> Assertion
testUSend ProcessId -> Int -> Process ()
usendPrim TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} Int
numMessages = do
  [LocalNode
node1, LocalNode
node2] <- Int -> IO LocalNode -> IO [LocalNode]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (IO LocalNode -> IO [LocalNode]) -> IO LocalNode -> IO [LocalNode]
forall a b. (a -> b) -> a -> b
$ Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  let nid1 :: NodeId
nid1 = LocalNode -> NodeId
localNodeId LocalNode
node1
      nid2 :: NodeId
nid2 = LocalNode -> NodeId
localNodeId LocalNode
node2
  MVar ProcessId
processA <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar Bool
usendTestOk <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar

  LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ (Process () -> (SomeException -> Process ()) -> Process ())
-> (SomeException -> Process ()) -> Process () -> Process ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Process () -> (SomeException -> Process ()) -> Process ()
forall e a.
(HasCallStack, Exception e) =>
Process a -> (e -> Process a) -> Process a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch (\SomeException
e -> Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Assertion
forall a. Show a => a -> Assertion
print (SomeException
e :: SomeException) ) (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
us <- Process ProcessId
getSelfPid
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
processA ProcessId
us
    ProcessId
them <- Process ProcessId
forall a. Serializable a => Process a
expect
    ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
them ()
    MonitorRef
_ <- ProcessId -> Process MonitorRef
monitor ProcessId
them
    let -- Collects messages from 'them' until the sender dies.
        -- Disconnection notifications are ignored.
        receiveMessages :: Process [Int]
        receiveMessages :: Process [Int]
receiveMessages = [Match [Int]] -> Process [Int]
forall b. [Match b] -> Process b
receiveWait
              [ (ProcessMonitorNotification -> Process [Int]) -> Match [Int]
forall a b. Serializable a => (a -> Process b) -> Match b
match ((ProcessMonitorNotification -> Process [Int]) -> Match [Int])
-> (ProcessMonitorNotification -> Process [Int]) -> Match [Int]
forall a b. (a -> b) -> a -> b
$ \ProcessMonitorNotification
mn -> case ProcessMonitorNotification
mn of
                  ProcessMonitorNotification MonitorRef
_ ProcessId
_ DiedReason
DiedDisconnect -> do
                    ProcessId -> Process MonitorRef
monitor ProcessId
them
                    Process [Int]
receiveMessages
                  ProcessMonitorNotification
_ -> [Int] -> Process [Int]
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return []
              , (Int -> Process [Int]) -> Match [Int]
forall a b. Serializable a => (a -> Process b) -> Match b
match ((Int -> Process [Int]) -> Match [Int])
-> (Int -> Process [Int]) -> Match [Int]
forall a b. (a -> b) -> a -> b
$ \Int
i -> ([Int] -> [Int]) -> Process [Int] -> Process [Int]
forall a b. (a -> b) -> Process a -> Process b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) Process [Int]
receiveMessages
              ]
    [Int]
msgs <- Process [Int]
receiveMessages
    let -- Checks that the input list is sorted.
        isSorted :: [Int] -> Bool
        isSorted :: [Int] -> Bool
isSorted (Int
x : xs :: [Int]
xs@(Int
y : [Int]
_)) = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
y Bool -> Bool -> Bool
&& [Int] -> Bool
isSorted [Int]
xs
        isSorted [Int]
_                = Bool
True
    -- The list can't be null since there are no failures after sending
    -- the last message.
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
usendTestOk (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ [Int] -> Bool
isSorted [Int]
msgs Bool -> Bool -> Bool
&& Bool -> Bool
not ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
msgs)

  LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node2 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
them <- IO ProcessId -> Process ProcessId
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> Process ProcessId)
-> IO ProcessId -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
processA
    Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
them
    Process ()
forall a. Serializable a => Process a
expect :: Process ()
    [Int] -> (Int -> Process ()) -> Process ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1..Int
numMessages] ((Int -> Process ()) -> Process ())
-> (Int -> Process ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection (NodeId -> EndPointAddress
nodeAddress NodeId
nid1) (NodeId -> EndPointAddress
nodeAddress NodeId
nid2)
      ProcessId -> Int -> Process ()
usendPrim ProcessId
them Int
i
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> Assertion
threadDelay Int
30000)

  Bool
res <- MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
usendTestOk
  HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Unexpected failure after sending last msg" Bool
res

-- | Test 'matchAny'. This repeats the 'testMath' but with a proxy server
-- in between
testMatchAny :: TestTransport -> Assertion
testMatchAny :: TestTransport -> Assertion
testMatchAny TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
proxyAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar (Double, Double, DivByZero)
clientDone <- IO (MVar (Double, Double, DivByZero))
forall a. IO (MVar a)
newEmptyMVar

  -- Math server
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
mathServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode Process ()
math
    ProcessId
proxyServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Process () -> Process ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
      Message
msg <- [Match Message] -> Process Message
forall b. [Match b] -> Process b
receiveWait [ (Message -> Process Message) -> Match Message
forall b. (Message -> Process b) -> Match b
matchAny Message -> Process Message
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ]
      Message -> ProcessId -> Process ()
forward Message
msg ProcessId
mathServer
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
proxyAddr ProcessId
proxyServer

  -- Client
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
mathServer <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
proxyAddr

    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      ProcessId
pid <- Process ProcessId
getSelfPid
      ProcessId -> Add -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Add
Add ProcessId
pid Double
1 Double
2)
      Double
three <- Process Double
forall a. Serializable a => Process a
expect :: Process Double
      ProcessId -> Divide -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Divide
Divide ProcessId
pid Double
8 Double
2)
      Double
four <- Process Double
forall a. Serializable a => Process a
expect :: Process Double
      ProcessId -> Divide -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Divide
Divide ProcessId
pid Double
8 Double
0)
      DivByZero
divByZ <- Process DivByZero
forall a. Serializable a => Process a
expect
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (Double, Double, DivByZero)
-> (Double, Double, DivByZero) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (Double, Double, DivByZero)
clientDone (Double
three, Double
four, DivByZero
divByZ)

  (Double, Double, DivByZero)
res <- MVar (Double, Double, DivByZero) -> IO (Double, Double, DivByZero)
forall a. MVar a -> IO a
takeMVar MVar (Double, Double, DivByZero)
clientDone
  case (Double, Double, DivByZero)
res of
    (Double
3, Double
4, DivByZero
DivByZero) -> () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Double, Double, DivByZero)
_                 -> String -> Assertion
forall a. HasCallStack => String -> a
error String
"Unexpected result"

-- | Test 'matchAny'. This repeats the 'testMath' but with a proxy server
-- in between, however we block 'Divide' requests ....
testMatchAnyHandle :: TestTransport -> Assertion
testMatchAnyHandle :: TestTransport -> Assertion
testMatchAnyHandle TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
proxyAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar Bool
clientDone <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar

  -- Math server
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
mathServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode Process ()
math
    ProcessId
proxyServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Process (Maybe ()) -> Process ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Process (Maybe ()) -> Process ())
-> Process (Maybe ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ do
        [Match (Maybe ())] -> Process (Maybe ())
forall b. [Match b] -> Process b
receiveWait [
            (Message -> Process (Maybe ())) -> Match (Maybe ())
forall b. (Message -> Process b) -> Match b
matchAny (ProcessId -> Message -> Process (Maybe ())
maybeForward ProcessId
mathServer)
          ]
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
proxyAddr ProcessId
proxyServer

  -- Client
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
mathServer <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
proxyAddr

    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      ProcessId
pid <- Process ProcessId
getSelfPid
      ProcessId -> Add -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Add
Add ProcessId
pid Double
1 Double
2)
      Double
three <- Process Double
forall a. Serializable a => Process a
expect :: Process Double
      ProcessId -> Divide -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Divide
Divide ProcessId
pid Double
8 Double
2)
      Maybe Double
res <- (Int -> Process (Maybe Double)
forall a. Serializable a => Int -> Process (Maybe a)
expectTimeout Int
100000) :: Process (Maybe Double)
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
clientDone (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Double
three Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
3 Bool -> Bool -> Bool
&& Maybe Double
res Maybe Double -> Maybe Double -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Double
forall a. Maybe a
Nothing

  String -> MVar Bool -> Assertion
verifyClient String
"Expected Nothing (i.e. timeout)" MVar Bool
clientDone

  where maybeForward :: ProcessId -> Message -> Process (Maybe ())
        maybeForward :: ProcessId -> Message -> Process (Maybe ())
maybeForward ProcessId
s Message
msg =
            Message -> (Add -> Process ()) -> Process (Maybe ())
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> m b) -> m (Maybe b)
handleMessage Message
msg (\m :: Add
m@(Add ProcessId
_ Double
_ Double
_) -> ProcessId -> Add -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
s Add
m)

testMatchAnyNoHandle :: TestTransport -> Assertion
testMatchAnyNoHandle :: TestTransport -> Assertion
testMatchAnyNoHandle TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
addr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
serverDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  -- Math server
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
server <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Process () -> Process ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
        [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
          (Add -> Bool) -> (Message -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (Message -> Process b) -> Match b
matchAnyIf
            -- the condition has type `Add -> Bool`
            (\(Add ProcessId
_ Double
_ Double
_) -> Bool
True)
            -- the match `AbstractMessage -> Process ()` will succeed!
            (\Message
m -> do
              -- `String -> Process ()` does *not* match the input types however
              Maybe Any
r <- (Message -> (String -> Process Any) -> Process (Maybe Any)
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> m b) -> m (Maybe b)
handleMessage Message
m (\(String
_ :: String) -> String -> Process Any
forall a b. Serializable a => a -> Process b
die String
"NONSENSE" ))
              case Maybe Any
r of
                Maybe Any
Nothing -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just Any
_  -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"NONSENSE")
          ]
        -- we *must* have removed the message from our mailbox though!!!
        Maybe ()
res <- Int -> [Match ()] -> Process (Maybe ())
forall b. Int -> [Match b] -> Process (Maybe b)
receiveTimeout Int
100000 [ (Add -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(Add ProcessId
_ Double
_ Double
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]
        Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ do
          HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected timeout!" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Maybe ()
res Maybe () -> Maybe () -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ()
forall a. Maybe a
Nothing
          MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
serverDone ()
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
addr ProcessId
server

  -- Client
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
server <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
addr

    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      ProcessId
pid <- Process ProcessId
getSelfPid
      ProcessId -> Add -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server (ProcessId -> Double -> Double -> Add
Add ProcessId
pid Double
1 Double
2)
      -- we only care about the client having sent a message, so we're done
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone
  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
serverDone

-- | Test 'matchAnyIf'. We provide an /echo/ server, but it ignores requests
-- unless the text body @/= "bar"@ - this case should time out rather than
-- removing the message from the process mailbox.
testMatchAnyIf :: TestTransport -> Assertion
testMatchAnyIf :: TestTransport -> Assertion
testMatchAnyIf TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
echoAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar (String, Maybe String, String)
clientDone <- IO (MVar (String, Maybe String, String))
forall a. IO (MVar a)
newEmptyMVar

  -- echo server
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
echoServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Process (Maybe ()) -> Process ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Process (Maybe ()) -> Process ())
-> Process (Maybe ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ do
        [Match (Maybe ())] -> Process (Maybe ())
forall b. [Match b] -> Process b
receiveWait [
            ((ProcessId, String) -> Bool)
-> (Message -> Process (Maybe ())) -> Match (Maybe ())
forall a b.
Serializable a =>
(a -> Bool) -> (Message -> Process b) -> Match b
matchAnyIf (\(ProcessId
_ :: ProcessId, (String
s :: String)) -> String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"bar")
                       Message -> Process (Maybe ())
tryHandleMessage
          ]
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
echoAddr ProcessId
echoServer

  -- Client
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
server <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
echoAddr

    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      ProcessId
pid <- Process ProcessId
getSelfPid
      ProcessId -> (ProcessId, String) -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server (ProcessId
pid, String
"foo")
      String
foo <- Process String
forall a. Serializable a => Process a
expect
      -- provoking what would be the wrong ordering is informative here...

      ProcessId -> (ProcessId, String) -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server (ProcessId
pid, String
"bar")
      Maybe String
bar <- (Int -> Process (Maybe String)
forall a. Serializable a => Int -> Process (Maybe a)
expectTimeout Int
100000) :: Process (Maybe String) -- was Double o_O !?

      ProcessId -> (ProcessId, String) -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server (ProcessId
pid, String
"baz")
      String
baz <- Process String
forall a. Serializable a => Process a
expect

      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (String, Maybe String, String)
-> (String, Maybe String, String) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (String, Maybe String, String)
clientDone (String
foo, Maybe String
bar, String
baz)

  (String, Maybe String, String)
res <- MVar (String, Maybe String, String)
-> IO (String, Maybe String, String)
forall a. MVar a -> IO a
takeMVar MVar (String, Maybe String, String)
clientDone
  let res' :: Bool
res' = (String, Maybe String, String)
res (String, Maybe String, String)
-> (String, Maybe String, String) -> Bool
forall a. Eq a => a -> a -> Bool
== (String
"foo", Maybe String
forall a. Maybe a
Nothing, String
"baz")
  HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected timeout due to type mismatch" Bool
res'

  where tryHandleMessage :: Message -> Process (Maybe ())
        tryHandleMessage :: Message -> Process (Maybe ())
tryHandleMessage Message
msg =
          Message
-> ((ProcessId, String) -> Process ()) -> Process (Maybe ())
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> m b) -> m (Maybe b)
handleMessage Message
msg (\(ProcessId
pid :: ProcessId, (String
m :: String))
                                  -> do { ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid String
m; () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return () })

testMatchMessageWithUnwrap :: TestTransport -> Assertion
testMatchMessageWithUnwrap :: TestTransport -> Assertion
testMatchMessageWithUnwrap TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
echoAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar (String, String)
clientDone <- IO (MVar (String, String))
forall a. IO (MVar a)
newEmptyMVar

    -- echo server
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
echoServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Process () -> Process ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
        Message
msg <- [Match Message] -> Process Message
forall b. [Match b] -> Process b
receiveWait [
            (Message -> Process Message) -> Match Message
matchMessage (\(Message
m :: Message) -> do
                            Message -> Process Message
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Message
m)
          ]
        Maybe (ProcessId, Message)
unwrapped <- Message -> Process (Maybe (ProcessId, Message))
forall (m :: * -> *) a.
(Monad m, Serializable a) =>
Message -> m (Maybe a)
unwrapMessage Message
msg :: Process (Maybe (ProcessId, Message))
        case Maybe (ProcessId, Message)
unwrapped of
          (Just (ProcessId
p, Message
msg')) -> Message -> ProcessId -> Process ()
forward Message
msg' ProcessId
p
          Maybe (ProcessId, Message)
Nothing -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"unable to unwrap the message"
    MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
echoAddr ProcessId
echoServer

  -- Client
  Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    ProcessId
server <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
echoAddr

    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      ProcessId
pid <- Process ProcessId
getSelfPid
      ProcessId -> (ProcessId, Message) -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server (ProcessId
pid, String -> Message
forall a. Serializable a => a -> Message
wrapMessage (String
"foo" :: String))
      String
foo <- Process String
forall a. Serializable a => Process a
expect
      ProcessId -> (ProcessId, Message) -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server (ProcessId
pid, String -> Message
forall a. Serializable a => a -> Message
wrapMessage (String
"baz" :: String))
      String
baz <- Process String
forall a. Serializable a => Process a
expect
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (String, String) -> (String, String) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (String, String)
clientDone (String
foo, String
baz)

  (String, String)
res <- MVar (String, String) -> IO (String, String)
forall a. MVar a -> IO a
takeMVar MVar (String, String)
clientDone
  HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Unexpected unwrapped results" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ (String, String)
res (String, String) -> (String, String) -> Bool
forall a. Eq a => a -> a -> Bool
== (String
"foo", String
"baz")

-- Test 'receiveChanTimeout'
testReceiveChanTimeout :: TestTransport -> Assertion
testReceiveChanTimeout :: TestTransport -> Assertion
testReceiveChanTimeout TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
mvSender <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  MVar (SendPort Bool)
sendPort <- IO (MVar (SendPort Bool))
forall a. IO (MVar a)
newEmptyMVar

  Assertion -> IO ThreadId
forkTry (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      -- Create a typed channel
      (SendPort Bool
sp, ReceivePort Bool
rp) <- Process (SendPort Bool, ReceivePort Bool)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan :: Process (SendPort Bool, ReceivePort Bool)
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (SendPort Bool) -> SendPort Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (SendPort Bool)
sendPort SendPort Bool
sp

      -- Wait for a message with a delay. No message arrives, we should get
      -- Nothing after the delay.
      Int -> ReceivePort Bool -> Process (Maybe Bool)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
100000 ReceivePort Bool
rp Process (Maybe Bool) -> (Maybe Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Process () -> (Bool -> Process ()) -> Maybe Bool -> Process ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Process () -> Bool -> Process ()
forall a b. a -> b -> a
const (Process () -> Bool -> Process ())
-> Process () -> Bool -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Expected Timeout")

      -- Let the sender know that it can send a message.
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
mvSender ()

      -- Wait for a message with a delay again. Now a message arrives after
      -- 0.1 seconds
      Bool
res <- Int -> ReceivePort Bool -> Process (Maybe Bool)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
20000000 ReceivePort Bool
rp Process (Maybe Bool)
-> (Maybe Bool -> Process Bool) -> Process Bool
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Process Bool
-> (Bool -> Process Bool) -> Maybe Bool -> Process Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Process Bool
forall a b. Serializable a => a -> Process b
die String
"Timeout") Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected result to be 'True'" Bool
res

      -- Wait for a message with zero timeout: non-blocking check. No message is
      -- available, we get Nothing
      Int -> ReceivePort Bool -> Process (Maybe Bool)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
0 ReceivePort Bool
rp Process (Maybe Bool) -> (Maybe Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Process () -> (Bool -> Process ()) -> Maybe Bool -> Process ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Process () -> Bool -> Process ()
forall a b. a -> b -> a
const (Process () -> Bool -> Process ())
-> Process () -> Bool -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Expected Timeout")

      -- Let the sender know that it can send a message.
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
mvSender ()

      -- Again, but now there is a message available
      (Process () -> Process ()) -> Process ()
forall a. (a -> a) -> a
fix ((Process () -> Process ()) -> Process ())
-> (Process () -> Process ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \Process ()
loop -> do
        Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Assertion
threadDelay Int
100000
        Maybe Bool
mb <- Int -> ReceivePort Bool -> Process (Maybe Bool)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
0 ReceivePort Bool
rp
        case Maybe Bool
mb of
          Just Bool
b -> do Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Unexpected Message" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
b
          Maybe Bool
_      -> Process ()
loop

      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()

  Assertion -> IO ThreadId
forkTry (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      SendPort Bool
sp <- IO (SendPort Bool) -> Process (SendPort Bool)
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SendPort Bool) -> Process (SendPort Bool))
-> IO (SendPort Bool) -> Process (SendPort Bool)
forall a b. (a -> b) -> a -> b
$ MVar (SendPort Bool) -> IO (SendPort Bool)
forall a. MVar a -> IO a
readMVar MVar (SendPort Bool)
sendPort

      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
mvSender
      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Assertion
threadDelay Int
100000
      SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
sp Bool
True

      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
mvSender
      SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
sp Bool
False

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

-- | Test Functor, Applicative, Alternative and Monad instances for ReceiveChan
testReceiveChanFeatures :: TestTransport -> Assertion
testReceiveChanFeatures :: TestTransport -> Assertion
testReceiveChanFeatures TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  Assertion -> IO ThreadId
forkTry (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
    LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
      (SendPort Int
spInt,  ReceivePort Int
rpInt)  <- Process (SendPort Int, ReceivePort Int)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan :: Process (SendPort Int, ReceivePort Int)
      (SendPort Bool
spBool, ReceivePort Bool
rpBool) <- Process (SendPort Bool, ReceivePort Bool)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan :: Process (SendPort Bool, ReceivePort Bool)

      -- Test Functor instance

      SendPort Int -> Int -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Int
spInt Int
2
      SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
spBool Bool
False

      ReceivePort Bool
rp1 <- [ReceivePort Bool] -> Process (ReceivePort Bool)
forall a.
Serializable a =>
[ReceivePort a] -> Process (ReceivePort a)
mergePortsBiased [Int -> Bool
forall a. Integral a => a -> Bool
even (Int -> Bool) -> ReceivePort Int -> ReceivePort Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReceivePort Int
rpInt, ReceivePort Bool
rpBool]

      ReceivePort Bool -> Process Bool
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Bool
rp1 Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected True"
      ReceivePort Bool -> Process Bool
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Bool
rp1 Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected False" (Bool -> Assertion) -> (Bool -> Bool) -> Bool -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not

      -- Test Applicative instance

      SendPort Int -> Int -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Int
spInt Int
3
      SendPort Int -> Int -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Int
spInt Int
4

      let rp2 :: ReceivePort Int
rp2 = (Int -> Int -> Int) -> ReceivePort (Int -> Int -> Int)
forall a. a -> ReceivePort a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ReceivePort (Int -> Int -> Int)
-> ReceivePort Int -> ReceivePort (Int -> Int)
forall a b. ReceivePort (a -> b) -> ReceivePort a -> ReceivePort b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReceivePort Int
rpInt ReceivePort (Int -> Int) -> ReceivePort Int -> ReceivePort Int
forall a b. ReceivePort (a -> b) -> ReceivePort a -> ReceivePort b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReceivePort Int
rpInt

      ReceivePort Int -> Process Int
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Int
rp2 Process Int -> (Int -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Int -> Assertion) -> Int -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 7" (Bool -> Assertion) -> (Int -> Bool) -> Int -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7)

      -- Test Alternative instance

      SendPort Int -> Int -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Int
spInt Int
3
      SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
spBool Bool
True

      let rp3 :: ReceivePort Bool
rp3 = (Int -> Bool
forall a. Integral a => a -> Bool
even (Int -> Bool) -> ReceivePort Int -> ReceivePort Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReceivePort Int
rpInt) ReceivePort Bool -> ReceivePort Bool -> ReceivePort Bool
forall a. ReceivePort a -> ReceivePort a -> ReceivePort a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReceivePort Bool
rpBool

      ReceivePort Bool -> Process Bool
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Bool
rp3 Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected False" (Bool -> Assertion) -> (Bool -> Bool) -> Bool -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
      ReceivePort Bool -> Process Bool
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Bool
rp3 Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected True"

      -- Test Monad instance

      SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
spBool Bool
True
      SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
spBool Bool
False
      SendPort Int -> Int -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Int
spInt Int
5

      let rp4 :: ReceivePort Int
          rp4 :: ReceivePort Int
rp4 = do Bool
b <- ReceivePort Bool
rpBool
                   if Bool
b
                     then ReceivePort Int
rpInt
                     else Int -> ReceivePort Int
forall a. a -> ReceivePort a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
7

      ReceivePort Int -> Process Int
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Int
rp4 Process Int -> (Int -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Int -> Assertion) -> Int -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 5" (Bool -> Assertion) -> (Int -> Bool) -> Int -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5)
      ReceivePort Int -> Process Int
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Int
rp4 Process Int -> (Int -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Int -> Assertion) -> Int -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 7" (Bool -> Assertion) -> (Int -> Bool) -> Int -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7)

      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

testChanLifecycle :: TestTransport -> Assertion
testChanLifecycle :: TestTransport -> Assertion
testChanLifecycle TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = let delay :: Int
delay = Int
3000000 in do
  MVar Bool
result <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
  MVar (SendPort (), ReceivePort ())
tchMV <- IO (MVar (SendPort (), ReceivePort ()))
forall a. IO (MVar a)
newEmptyMVar
  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do

    ProcessId
pid <- Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do (SendPort (), ReceivePort ())
tCh  <- Process (SendPort (), ReceivePort ())
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan :: Process (SendPort (), ReceivePort ())
                           Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (SendPort (), ReceivePort ())
-> (SendPort (), ReceivePort ()) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (SendPort (), ReceivePort ())
tchMV (SendPort (), ReceivePort ())
tCh
                           Process ()
forall a. Serializable a => Process a
expect :: Process ()
                           let (SendPort ()
sp, ReceivePort ()
_) = (SendPort (), ReceivePort ())
tCh
                           SendPort () -> () -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort ()
sp ()
                           Process ()
forall a. Serializable a => Process a
expect :: Process ()

    MonitorRef
mRefPid <- ProcessId -> Process MonitorRef
monitor ProcessId
pid

    ProcessId
cPid <- Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do
      (SendPort ()
sp', ReceivePort ()
rp) <- IO (SendPort (), ReceivePort ())
-> Process (SendPort (), ReceivePort ())
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SendPort (), ReceivePort ())
 -> Process (SendPort (), ReceivePort ()))
-> IO (SendPort (), ReceivePort ())
-> Process (SendPort (), ReceivePort ())
forall a b. (a -> b) -> a -> b
$ MVar (SendPort (), ReceivePort ())
-> IO (SendPort (), ReceivePort ())
forall a. MVar a -> IO a
takeMVar MVar (SendPort (), ReceivePort ())
tchMV
      -- say "picked up our test channel"
      ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid ()
      -- say "told pid to continue"
      Maybe ()
res <- Int -> ReceivePort () -> Process (Maybe ())
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort ()
rp
      case Maybe ()
res of
        Maybe ()
Nothing -> String -> Process ()
say String
"initial chan () missing!" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
result Bool
False)
        Just () -> do MonitorRef
_ <- ProcessId -> Process MonitorRef
monitor ProcessId
pid
                      Int -> Process ()
pause Int
10000
                      -- say "sending pid a second () will cause it to exit"
                      ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid ()

                      -- say "make sure we see a DOWN notification for pid having stopped"
                      [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [ (ProcessMonitorNotification -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(ProcessMonitorNotification
_ :: ProcessMonitorNotification) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]

                      -- now that pid has died, the send port should be useless...
                      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (SendPort (), ReceivePort ())
-> (SendPort (), ReceivePort ()) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (SendPort (), ReceivePort ())
tchMV (SendPort ()
sp', ReceivePort ()
rp)

                      -- let's verify that we do not see the message from our
                      -- parent process on the channel, once pid has died...
                      Maybe ()
recv <- Int -> ReceivePort () -> Process (Maybe ())
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort ()
rp
                      -- say $ "finished waiting for second (), writing result" ++ (show recv)
                      Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
result (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Maybe () -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ()
recv

    MonitorRef
mRefCPid <- ProcessId -> Process MonitorRef
monitor ProcessId
cPid

    [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait
        [ (ProcessMonitorNotification -> Bool)
-> (ProcessMonitorNotification -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(ProcessMonitorNotification MonitorRef
r ProcessId
_ DiedReason
_) -> MonitorRef
r MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
mRefPid)
                  (\ProcessMonitorNotification
_ -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        ]

    -- say "seen first pid die..."

    (SendPort ()
sendPort, ReceivePort ()
_) <- IO (SendPort (), ReceivePort ())
-> Process (SendPort (), ReceivePort ())
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SendPort (), ReceivePort ())
 -> Process (SendPort (), ReceivePort ()))
-> IO (SendPort (), ReceivePort ())
-> Process (SendPort (), ReceivePort ())
forall a b. (a -> b) -> a -> b
$ MVar (SendPort (), ReceivePort ())
-> IO (SendPort (), ReceivePort ())
forall a. MVar a -> IO a
takeMVar MVar (SendPort (), ReceivePort ())
tchMV
    SendPort () -> () -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort ()
sendPort ()
    -- say "sent () after owning pid died"

    -- let cPid know we've written to the channel...
    ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
cPid ()

    [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait
        [ (ProcessMonitorNotification -> Bool)
-> (ProcessMonitorNotification -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(ProcessMonitorNotification MonitorRef
r ProcessId
_ DiedReason
_) -> MonitorRef
r MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
mRefCPid)
                  (\ProcessMonitorNotification
_ -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        ]

    -- say "seen both pids die now..."

  -- and wait on the result back in IO land...
  Bool
testRes <- MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
result
  -- runProcess localNode $ say "got result..."
  HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected sending on the channel to fail, but received data!" Bool
testRes


testKillLocal :: TestTransport -> Assertion
testKillLocal :: TestTransport -> Assertion
testKillLocal TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable

  ProcessId
pid <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Assertion
threadDelay Int
1000000

  LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    MonitorRef
ref <- ProcessId -> Process MonitorRef
monitor ProcessId
pid
    ProcessId
us <- Process ProcessId
getSelfPid
    ProcessId -> String -> Process ()
kill ProcessId
pid String
"TestKill"
    ProcessMonitorNotification
mn <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
    case ProcessMonitorNotification
mn of
      ProcessMonitorNotification MonitorRef
ref' ProcessId
pid' (DiedException String
ex) ->
        case MonitorRef
ref MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref' Bool -> Bool -> Bool
&& ProcessId
pid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid' Bool -> Bool -> Bool
&& String
ex String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"killed-by=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProcessId -> String
forall a. Show a => a -> String
show ProcessId
us String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",reason=TestKill" of
          Bool
True  -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Bool
False -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Invalid ProcessMonitorNotification received"
      ProcessMonitorNotification
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"

testKillRemote :: TestTransport -> Assertion
testKillRemote :: TestTransport -> Assertion
testKillRemote TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
node1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  LocalNode
node2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable

  ProcessId
pid <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Assertion
threadDelay Int
1000000

  LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    MonitorRef
ref <- ProcessId -> Process MonitorRef
monitor ProcessId
pid
    ProcessId
us <- Process ProcessId
getSelfPid
    ProcessId -> String -> Process ()
kill ProcessId
pid String
"TestKill"
    ProcessMonitorNotification
mn <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
    case ProcessMonitorNotification
mn of
      ProcessMonitorNotification MonitorRef
ref' ProcessId
pid' (DiedException String
reason) ->
        case (MonitorRef
ref MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref', ProcessId
pid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid', String
reason String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"killed-by=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProcessId -> String
forall a. Show a => a -> String
show ProcessId
us String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",reason=TestKill") of
          (Bool
True, Bool
True, Bool
True) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          (Bool
a, Bool
b, Bool
c) -> do
            let a' :: String
a' = if Bool
a then String
"" else String
"Invalid ref"
            let b' :: String
b' = if Bool
b then String
"" else String
"Invalid pid"
            let c' :: String
c' = if Bool
c then String
"" else String
"Invalid message"
            String -> Process ()
forall a b. Serializable a => a -> Process b
die (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
a', String
b', String
c']
      ProcessMonitorNotification
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Received unexpected message"

testCatchesExit :: TestTransport -> Assertion
testCatchesExit :: TestTransport -> Assertion
testCatchesExit TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  ProcessId
_ <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
      ((String, Int) -> Process ()
forall a b. Serializable a => a -> Process b
die (String
"foobar", Int
123 :: Int))
      Process ()
-> [ProcessId -> Message -> Process (Maybe ())] -> Process ()
forall b.
Process b
-> [ProcessId -> Message -> Process (Maybe b)] -> Process b
`catchesExit` [
           (\ProcessId
_ Message
m -> Message -> (String -> Process ()) -> Process (Maybe ())
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> m b) -> m (Maybe b)
handleMessage Message
m (\(String
_ :: String) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
         , (\ProcessId
_ Message
m -> Message -> (Maybe Int -> Process ()) -> Process (Maybe ())
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> m b) -> m (Maybe b)
handleMessage Message
m (\(Maybe Int
_ :: Maybe Int) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
         , (\ProcessId
_ Message
m -> Message -> ((String, Int) -> Process ()) -> Process (Maybe ())
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> m b) -> m (Maybe b)
handleMessage Message
m (\(String
_ :: String, Int
_ :: Int)
                    -> (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()) Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
         ]

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

testHandleMessageIf :: TestTransport -> Assertion
testHandleMessageIf :: TestTransport -> Assertion
testHandleMessageIf TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar (Integer, Integer)
done <- IO (MVar (Integer, Integer))
forall a. IO (MVar a)
newEmptyMVar
  ProcessId
_ <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
self <- Process ProcessId
getSelfPid
    ProcessId -> (Integer, Integer) -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
self (Integer
5 :: Integer, Integer
10 :: Integer)
    Message
msg <- [Match Message] -> Process Message
forall b. [Match b] -> Process b
receiveWait [ (Message -> Process Message) -> Match Message
matchMessage Message -> Process Message
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ]
    Message
-> (() -> Bool) -> (() -> Process Any) -> Process (Maybe Any)
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> Bool) -> (a -> m b) -> m (Maybe b)
handleMessageIf Message
msg
                    (\() -> Bool
True)
                    (\() -> String -> Process Any
forall a b. Serializable a => a -> Process b
die String
"whoops") Process (Maybe Any) -> (Maybe Any -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Process () -> (Any -> Process ()) -> Maybe Any -> Process ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                                                    (Process () -> Any -> Process ()
forall a b. a -> b -> a
const (Process () -> Any -> Process ())
-> Process () -> Any -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Expected Mismatch")
    Message
-> ((Integer, Integer) -> Bool)
-> ((Integer, Integer) -> Process ())
-> Process (Maybe ())
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> Bool) -> (a -> m b) -> m (Maybe b)
handleMessageIf Message
msg (\(Integer
x :: Integer, Integer
y :: Integer) -> Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
5 Bool -> Bool -> Bool
&& Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
10)
                        (\(Integer, Integer)
input -> Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (Integer, Integer) -> (Integer, Integer) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (Integer, Integer)
done (Integer, Integer)
input)
    () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  (Integer, Integer)
result <- MVar (Integer, Integer) -> IO (Integer, Integer)
forall a. MVar a -> IO a
takeMVar MVar (Integer, Integer)
done
  (Integer, Integer) -> Matcher (Integer, Integer) -> Assertion
forall a. a -> Matcher a -> Assertion
expectThat (Integer, Integer)
result (Matcher (Integer, Integer) -> Assertion)
-> Matcher (Integer, Integer) -> Assertion
forall a b. (a -> b) -> a -> b
$ (Integer, Integer) -> Matcher (Integer, Integer)
forall a. (Show a, Eq a) => a -> Matcher a
equalTo (Integer
5, Integer
10)

testCatches :: TestTransport -> Assertion
testCatches :: TestTransport -> Assertion
testCatches TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  ProcessId
_ <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    NodeId
node <- Process NodeId
getSelfNode
    (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ ProcessLinkException -> Assertion
forall e a. Exception e => e -> IO a
throwIO (ProcessId -> DiedReason -> ProcessLinkException
ProcessLinkException (NodeId -> ProcessId
nullProcessId NodeId
node) DiedReason
DiedNormal))
    Process () -> [Handler ()] -> Process ()
forall a. Process a -> [Handler a] -> Process a
`catches` [
        (ProcessLinkException -> Process ()) -> Handler ()
forall a e. Exception e => (e -> Process a) -> Handler a
Handler (\(ProcessLinkException ProcessId
_ DiedReason
_) -> Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ())
      ]

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

testMaskRestoreScope :: TestTransport -> Assertion
testMaskRestoreScope :: TestTransport -> Assertion
testMaskRestoreScope TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar ProcessId
parentPid <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar ProcessId)
  MVar ProcessId
spawnedPid <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar ProcessId)

  Assertion -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ ((forall a. Process a -> Process a) -> Process ()) -> Process ()
forall b.
HasCallStack =>
((forall a. Process a -> Process a) -> Process b) -> Process b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. Process a -> Process a) -> Process ()) -> Process ())
-> ((forall a. Process a -> Process a) -> Process ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \forall a. Process a -> Process a
unmask -> do
    Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (ProcessId -> Assertion) -> ProcessId -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
parentPid
    Process ProcessId -> Process ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Process ProcessId -> Process ())
-> Process ProcessId -> Process ()
forall a b. (a -> b) -> a -> b
$ Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ Process () -> Process ()
forall a. Process a -> Process a
unmask (Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (ProcessId -> Assertion) -> ProcessId -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
spawnedPid)

  ProcessId
parent <- IO ProcessId -> IO ProcessId
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> IO ProcessId) -> IO ProcessId -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
takeMVar MVar ProcessId
parentPid
  ProcessId
child <- IO ProcessId -> IO ProcessId
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> IO ProcessId) -> IO ProcessId -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
takeMVar MVar ProcessId
spawnedPid
  ProcessId -> Matcher ProcessId -> Assertion
forall a. a -> Matcher a -> Assertion
expectThat ProcessId
parent (Matcher ProcessId -> Assertion) -> Matcher ProcessId -> Assertion
forall a b. (a -> b) -> a -> b
$ Matcher ProcessId -> Matcher ProcessId
forall a. Matcher a -> Matcher a
isNot (Matcher ProcessId -> Matcher ProcessId)
-> Matcher ProcessId -> Matcher ProcessId
forall a b. (a -> b) -> a -> b
$ ProcessId -> Matcher ProcessId
forall a. (Show a, Eq a) => a -> Matcher a
equalTo ProcessId
child

testDie :: TestTransport -> Assertion
testDie :: TestTransport -> Assertion
testDie TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  ProcessId
_ <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
      ((String, Int) -> Process ()
forall a b. Serializable a => a -> Process b
die (String
"foobar", Int
123 :: Int))
      Process ()
-> (ProcessId -> (String, Int) -> Process ()) -> Process ()
forall a b.
(Show a, Serializable a) =>
Process b -> (ProcessId -> a -> Process b) -> Process b
`catchExit` \ProcessId
_from (String, Int)
reason -> do
        -- TODO: should verify that 'from' has the right value
        let res :: Bool
res = (String, Int)
reason (String, Int) -> (String, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (String
"foobar", Int
123 :: Int)
        Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()
        if Bool
res
          then () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

testPrettyExit :: TestTransport -> Assertion
testPrettyExit :: TestTransport -> Assertion
testPrettyExit TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  ProcessId
_ <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
      (String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"timeout")
      Process () -> (ProcessExitException -> Process ()) -> Process ()
forall e a.
(HasCallStack, Exception e) =>
Process a -> (e -> Process a) -> Process a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \ex :: ProcessExitException
ex@(ProcessExitException ProcessId
from Message
_) ->
        let expected :: String
expected = String
"exit-from=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ProcessId -> String
forall a. Show a => a -> String
show ProcessId
from)
        in do
          let res :: Bool
res = (ProcessExitException -> String
forall a. Show a => a -> String
show ProcessExitException
ex) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
expected
          Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()
          if Bool
res
            then () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            else String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

testExitLocal :: TestTransport -> Assertion
testExitLocal :: TestTransport -> Assertion
testExitLocal TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar ()
supervisedDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
supervisorDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  -- XXX: we guarantee that exception handler will be set up
  -- regardless if forkProcess preserve masking state or not.
  MVar ()
handlerSetUp <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  ProcessId
pid <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
handlerSetUp ()) Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Process ()
forall a. Serializable a => Process a
expect) Process () -> (ProcessId -> String -> Process ()) -> Process ()
forall a b.
(Show a, Serializable a) =>
Process b -> (ProcessId -> a -> Process b) -> Process b
`catchExit` \ProcessId
_from String
reason -> do
        -- TODO: should verify that 'from' has the right value
        Bool
res <- Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ String
reason String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"TestExit"
        Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
supervisedDone ()
        if Bool
res
          then () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"

  LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
handlerSetUp
    MonitorRef
ref <- ProcessId -> Process MonitorRef
monitor ProcessId
pid
    ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
exit ProcessId
pid String
"TestExit"
    -- This time the client catches the exception, so it dies normally
    ProcessMonitorNotification
mn <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
    case ProcessMonitorNotification
mn of
      ProcessMonitorNotification MonitorRef
ref' ProcessId
pid' DiedReason
DiedNormal -> do
        let res :: Bool
res = MonitorRef
ref MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref' Bool -> Bool -> Bool
&& ProcessId
pid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid'
        Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
supervisorDone ()
        if Bool
res
          then () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"
      ProcessMonitorNotification
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
supervisedDone
  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
supervisorDone

testExitRemote :: TestTransport -> Assertion
testExitRemote :: TestTransport -> Assertion
testExitRemote TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
node1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  LocalNode
node2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  MVar ()
supervisedDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
supervisorDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  ProcessId
pid <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    ([Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [] :: Process ()) -- block forever
      Process () -> (ProcessId -> String -> Process ()) -> Process ()
forall a b.
(Show a, Serializable a) =>
Process b -> (ProcessId -> a -> Process b) -> Process b
`catchExit` \ProcessId
_from String
reason -> do
        -- TODO: should verify that 'from' has the right value
        Bool
res <- Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ String
reason String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"TestExit"
        Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
supervisedDone ()
        if Bool
res
          then () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"

  LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    MonitorRef
ref <- ProcessId -> Process MonitorRef
monitor ProcessId
pid
    ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
exit ProcessId
pid String
"TestExit"
    ProcessMonitorNotification
mn <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
    case ProcessMonitorNotification
mn of
      ProcessMonitorNotification MonitorRef
ref' ProcessId
pid' DiedReason
DiedNormal -> do
        Bool
res' <- Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ MonitorRef
ref MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref' Bool -> Bool -> Bool
&& ProcessId
pid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid'
        Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
supervisorDone ()
        if Bool
res'
          then () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"
      ProcessMonitorNotification
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
supervisedDone
  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
supervisorDone

testRegistryMonitoring :: TestTransport -> Assertion
testRegistryMonitoring :: TestTransport -> Assertion
testRegistryMonitoring TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
node1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  LocalNode
node2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable

  let nid :: NodeId
nid = LocalNode -> NodeId
localNodeId LocalNode
node2
  ProcessId
pid <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
self <- Process ProcessId
getSelfPid
    NodeId -> ProcessId -> Process ()
runUntilRegistered NodeId
nid ProcessId
self
    String -> Process ()
say (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ (ProcessId -> String
forall a. Show a => a -> String
show ProcessId
self) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" registered as " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
regName
    Process ()
forall a. Serializable a => Process a
expect :: Process ()
    String -> Process ()
say (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ (ProcessId -> String
forall a. Show a => a -> String
show ProcessId
self) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" exiting normally"

  LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    String -> ProcessId -> Process ()
register String
regName ProcessId
pid
    String -> Process ()
say (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ String
regName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" registered to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProcessId -> String
forall a. Show a => a -> String
show ProcessId
pid
    Maybe ProcessId
res <- String -> Process (Maybe ProcessId)
whereis String
regName
    ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid ()
    String -> Process ()
say (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ String
" sent finish signal to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProcessId -> String
forall a. Show a => a -> String
show ProcessId
pid
    ProcessId
_ <- Process ProcessId
getSelfPid
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"expected (Just pid)" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Maybe ProcessId
res Maybe ProcessId -> Maybe ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== (ProcessId -> Maybe ProcessId
forall a. a -> Maybe a
Just ProcessId
pid)


    -- This delay isn't essential!
    -- The test case passes perfectly fine without it (feel free to comment out
    -- and see), however waiting a few seconds here, makes it much more likely
    -- that in delayUntilMaybeUnregistered we will hit the match case right
    -- away, and thus not be subjected to a 20 second delay. The value of 4
    -- seconds appears to work optimally on osx and across several linux distros
    -- running in virtual machines (which is essentially what we do in CI)
    Process (Maybe Message) -> Process ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Process (Maybe Message) -> Process ())
-> Process (Maybe Message) -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> [Match Message] -> Process (Maybe Message)
forall b. Int -> [Match b] -> Process (Maybe b)
receiveTimeout Int
4000000 [ (Message -> Process Message) -> Match Message
forall b. (Message -> Process b) -> Match b
matchAny Message -> Process Message
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ]

  -- This delay doesn't serve much purpose in the happy path, however if some
  -- future patch breaks the cooperative behaviour of node controllers viz
  -- remote process registration and notification taking place via ncEffectDied,
  -- there would be the possibility of a race in the test case should we attempt
  -- to evaluate `whereis regName` on node2 right away. In case the name is still
  -- erroneously registered, observing the 20 second delay (or lack of), could at
  -- least give a hint that something is wrong, and we give up our time slice
  -- so that there's a higher change the registrations have been cleaned up
  -- in either case.
  LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ NodeId -> ProcessId -> Process ()
forall {t}. NodeId -> t -> Process ()
delayUntilMaybeUnregistered NodeId
nid ProcessId
pid

  MVar (Maybe ProcessId)
regHere <- IO (MVar (Maybe ProcessId))
forall a. IO (MVar a)
newEmptyMVar
  LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ String -> Process (Maybe ProcessId)
whereis String
regName Process (Maybe ProcessId)
-> (Maybe ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Maybe ProcessId -> Assertion) -> Maybe ProcessId -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (Maybe ProcessId) -> Maybe ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (Maybe ProcessId)
regHere
  Maybe ProcessId
res <- MVar (Maybe ProcessId) -> IO (Maybe ProcessId)
forall a. MVar a -> IO a
takeMVar MVar (Maybe ProcessId)
regHere
  case Maybe ProcessId
res of
    Maybe ProcessId
Nothing  -> () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Maybe ProcessId
_        -> HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool (String
"expected Nothing, but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProcessId -> String
forall a. Show a => a -> String
show ProcessId
pid) Bool
False

  where
    runUntilRegistered :: NodeId -> ProcessId -> Process ()
runUntilRegistered NodeId
nid ProcessId
us = do
      NodeId -> String -> Process ()
whereisRemoteAsync NodeId
nid String
regName
      [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
          (WhereIsReply -> Bool) -> (WhereIsReply -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(WhereIsReply String
n (Just ProcessId
p)) -> String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
regName Bool -> Bool -> Bool
&& ProcessId
p ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
us)
                  (Process () -> WhereIsReply -> Process ()
forall a b. a -> b -> a
const (Process () -> WhereIsReply -> Process ())
-> Process () -> WhereIsReply -> Process ()
forall a b. (a -> b) -> a -> b
$ () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        ]

    delayUntilMaybeUnregistered :: NodeId -> t -> Process ()
delayUntilMaybeUnregistered NodeId
nid t
p = do
      NodeId -> String -> Process ()
whereisRemoteAsync NodeId
nid String
regName
      Maybe ()
res <- Int -> [Match ()] -> Process (Maybe ())
forall b. Int -> [Match b] -> Process (Maybe b)
receiveTimeout Int
20000000 {- 20 sec delay -} [
          (WhereIsReply -> Bool) -> (WhereIsReply -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(WhereIsReply String
n Maybe ProcessId
p') -> String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
regName Bool -> Bool -> Bool
&& Maybe ProcessId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ProcessId
p')
                  (Process () -> WhereIsReply -> Process ()
forall a b. a -> b -> a
const (Process () -> WhereIsReply -> Process ())
-> Process () -> WhereIsReply -> Process ()
forall a b. (a -> b) -> a -> b
$ () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        ]
      case Maybe ()
res of
        Just () -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Maybe ()
Nothing -> NodeId -> t -> Process ()
delayUntilMaybeUnregistered NodeId
nid t
p

    regName :: String
regName = String
"testRegisterRemote"

testUnsafeSend :: TestTransport -> Assertion
testUnsafeSend :: TestTransport -> Assertion
testUnsafeSend TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
serverAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  IO ProcessId -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessId -> Assertion) -> IO ProcessId -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
self <- Process ProcessId
getSelfPid
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr ProcessId
self
    ProcessId
clientAddr <- Process ProcessId
forall a. Serializable a => Process a
expect
    ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
unsafeSend ProcessId
clientAddr ()

  IO ProcessId -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessId -> Assertion) -> IO ProcessId -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
serverPid <- IO ProcessId -> Process ProcessId
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> Process ProcessId)
-> IO ProcessId -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
takeMVar MVar ProcessId
serverAddr
    Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
unsafeSend ProcessId
serverPid
    Process ()
forall a. Serializable a => Process a
expect Process () -> (() -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> (() -> Assertion) -> () -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone

testUnsafeUSend :: TestTransport -> Assertion
testUnsafeUSend :: TestTransport -> Assertion
testUnsafeUSend TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
serverAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  IO ProcessId -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessId -> Assertion) -> IO ProcessId -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
self <- Process ProcessId
getSelfPid
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr ProcessId
self
    ProcessId
clientAddr <- Process ProcessId
forall a. Serializable a => Process a
expect
    ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
unsafeUSend ProcessId
clientAddr ()

  IO ProcessId -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessId -> Assertion) -> IO ProcessId -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
serverPid <- IO ProcessId -> Process ProcessId
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> Process ProcessId)
-> IO ProcessId -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
takeMVar MVar ProcessId
serverAddr
    Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
unsafeUSend ProcessId
serverPid
    Process ()
forall a. Serializable a => Process a
expect Process () -> (() -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> (() -> Assertion) -> () -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone

testUnsafeNSend :: TestTransport -> Assertion
testUnsafeNSend :: TestTransport -> Assertion
testUnsafeNSend TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable

  ProcessId
pid <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    Process ()
forall a. Serializable a => Process a
expect Process () -> (() -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> (() -> Assertion) -> () -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone

  Assertion -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    String -> ProcessId -> Process ()
register String
"foobar" ProcessId
pid
    String -> () -> Process ()
forall a. Serializable a => String -> a -> Process ()
unsafeNSend String
"foobar" ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone

testUnsafeNSendRemote :: TestTransport -> Assertion
testUnsafeNSendRemote :: TestTransport -> Assertion
testUnsafeNSendRemote TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  LocalNode
localNode1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  LocalNode
localNode2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable

  ProcessId
_ <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ProcessId -> Process ()
register String
"foobar"
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()
    Process ()
forall a. Serializable a => Process a
expect Process () -> (() -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> (() -> Assertion) -> () -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone
  Assertion -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    NodeId -> String -> () -> Process ()
forall a. Serializable a => NodeId -> String -> a -> Process ()
unsafeNSendRemote (LocalNode -> NodeId
localNodeId LocalNode
localNode1) String
"foobar" ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone

testUnsafeSendChan :: TestTransport -> Assertion
testUnsafeSendChan :: TestTransport -> Assertion
testUnsafeSendChan TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
serverAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
  IO ProcessId -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessId -> Assertion) -> IO ProcessId -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
self <- Process ProcessId
getSelfPid
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr ProcessId
self
    SendPort ()
sp <- Process (SendPort ())
forall a. Serializable a => Process a
expect
    SendPort () -> () -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
unsafeSendChan SendPort ()
sp ()

  IO ProcessId -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessId -> Assertion) -> IO ProcessId -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
serverPid <- IO ProcessId -> Process ProcessId
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> Process ProcessId)
-> IO ProcessId -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
takeMVar MVar ProcessId
serverAddr
    (SendPort ()
sp, ReceivePort ()
rp) <- Process (SendPort (), ReceivePort ())
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
    ProcessId -> SendPort () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
unsafeSend ProcessId
serverPid SendPort ()
sp
    ReceivePort () -> Process ()
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort ()
rp :: Process ()
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone

testCallLocal :: TestTransport -> Assertion
testCallLocal :: TestTransport -> Assertion
testCallLocal TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
node <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable

  -- Testing that (/=) <$> getSelfPid <*> callLocal getSelfPid.
  MVar Bool
result <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
  LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    Bool
r <- ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (ProcessId -> ProcessId -> Bool)
-> Process ProcessId -> Process (ProcessId -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Process ProcessId
getSelfPid Process (ProcessId -> Bool) -> Process ProcessId -> Process Bool
forall a b. Process (a -> b) -> Process a -> Process b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Process ProcessId -> Process ProcessId
forall a. Process a -> Process a
callLocal Process ProcessId
getSelfPid
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
result Bool
r

  MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
result IO Bool -> (Bool -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 'True'"

  -- Testing that when callLocal is interrupted, the worker is interrupted.
  IORef Bool
ibox <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
keeper <- Process ProcessId
getSelfPid
    Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do
        ProcessId
caller <- Process ProcessId
getSelfPid
        ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
keeper ProcessId
caller
        Process () -> Process () -> Process ()
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
onException
          (Process () -> Process ()
forall a. Process a -> Process a
callLocal (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
                Process () -> Process () -> Process ()
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
onException (do ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
keeper ProcessId
caller
                                Process ()
forall a. Serializable a => Process a
expect)
                            (do Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> Assertion
forall a. IORef a -> a -> Assertion
writeIORef IORef Bool
ibox Bool
True))
          (ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
keeper ())
    ProcessId
caller <- Process ProcessId
forall a. Serializable a => Process a
expect
    ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
exit ProcessId
caller String
"test"
    Process ()
forall a. Serializable a => Process a
expect :: Process ()

  IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
ibox IO Bool -> (Bool -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 'True'"

  -- Testing that when the worker raises an exception, the exception is propagated to the parent.
  IORef Bool
ibox2 <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    Either ErrorCall ()
r <- Process () -> Process (Either ErrorCall ())
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (Process () -> Process ()
forall a. Process a -> Process a
callLocal (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> Process Any
forall a. HasCallStack => String -> a
error String
"e" Process Any -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> Assertion
forall a. IORef a -> a -> Assertion
writeIORef IORef Bool
ibox2 (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ case Either ErrorCall ()
r of
      Left (ErrorCall String
"e") -> Bool
True
      Either ErrorCall ()
_ -> Bool
False

  IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
ibox IO Bool -> (Bool -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 'True'"

  -- Test that caller waits for the worker in correct situation
  IORef Bool
ibox3 <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  MVar Bool
result3 <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
  LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
keeper <- Process ProcessId
getSelfPid
    Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do
        Process () -> Process ()
forall a. Process a -> Process a
callLocal (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$
            (do ProcessId
us <- Process ProcessId
getSelfPid
                ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
keeper ProcessId
us
                () <- Process ()
forall a. Serializable a => Process a
expect
                Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO Assertion
yield)
            Process () -> Process () -> Process ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
`finally` (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> Assertion
forall a. IORef a -> a -> Assertion
writeIORef IORef Bool
ibox3 Bool
True)
        Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
result3 (Bool -> Assertion) -> IO Bool -> Assertion
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
ibox3
    ProcessId
worker <- Process ProcessId
forall a. Serializable a => Process a
expect
    ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
worker ()

  MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
result3 IO Bool -> (Bool -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 'True'"

  -- Test that caller waits for the worker in case when caller gets an exception
  IORef Bool
ibox4 <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  MVar Bool
result4 <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
  LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    ProcessId
keeper <- Process ProcessId
getSelfPid
    Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do
        ProcessId
caller <- Process ProcessId
getSelfPid
        Process () -> Process ()
forall a. Process a -> Process a
callLocal
            ((do ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
keeper ProcessId
caller
                 Process ()
forall a. Serializable a => Process a
expect)
               Process () -> Process () -> Process ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
`finally` (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> Assertion
forall a. IORef a -> a -> Assertion
writeIORef IORef Bool
ibox4 Bool
True))
            Process () -> Process () -> Process ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
`finally` (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
result4 (Bool -> Assertion) -> IO Bool -> Assertion
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
ibox4)
    ProcessId
caller <- Process ProcessId
forall a. Serializable a => Process a
expect
    ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
exit ProcessId
caller String
"hi!"

  MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
result4 IO Bool -> (Bool -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 'True'"
  -- XXX: Testing that when mask_ $ callLocal p runs p in masked state.

tests :: TestTransport -> IO [Test]
tests :: TestTransport -> IO [Test]
tests TestTransport
testtrans = [Test] -> IO [Test]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [
     String -> [Test] -> Test
testGroup String
"Basic features" [
        String -> Assertion -> Test
testCase String
"Ping"                (TestTransport -> Assertion
testPing                TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"Math"                (TestTransport -> Assertion
testMath                TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"Timeout"             (TestTransport -> Assertion
testTimeout             TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"Timeout0"            (TestTransport -> Assertion
testTimeout0            TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"SendToTerminated"    (TestTransport -> Assertion
testSendToTerminated    TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"TypedChannnels"      (TestTransport -> Assertion
testTypedChannels       TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"Terminate"           (TestTransport -> Assertion
testTerminate           TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"RegistryRemoteProcess" (TestTransport -> Assertion
testRegistryRemoteProcess      TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"RemoteRegistry"      (TestTransport -> Assertion
testRemoteRegistry      TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"RemoteRegistryRemoteProcess" (TestTransport -> Assertion
testRemoteRegistryRemoteProcess      TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"SpawnLocal"          (TestTransport -> Assertion
testSpawnLocal          TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"SpawnAsyncStrictness" (TestTransport -> Assertion
testSpawnAsyncStrictness TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"HandleMessageIf"     (TestTransport -> Assertion
testHandleMessageIf     TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"MatchAny"            (TestTransport -> Assertion
testMatchAny            TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"MatchAnyHandle"      (TestTransport -> Assertion
testMatchAnyHandle      TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"MatchAnyNoHandle"    (TestTransport -> Assertion
testMatchAnyNoHandle    TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"MatchAnyIf"          (TestTransport -> Assertion
testMatchAnyIf          TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"MatchMessageUnwrap"  (TestTransport -> Assertion
testMatchMessageWithUnwrap TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"ReceiveChanTimeout"  (TestTransport -> Assertion
testReceiveChanTimeout  TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"ReceiveChanFeatures" (TestTransport -> Assertion
testReceiveChanFeatures TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"ChanLifecycle"       (TestTransport -> Assertion
testChanLifecycle       TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"KillLocal"           (TestTransport -> Assertion
testKillLocal           TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"KillRemote"          (TestTransport -> Assertion
testKillRemote          TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"Die"                 (TestTransport -> Assertion
testDie                 TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"PrettyExit"          (TestTransport -> Assertion
testPrettyExit          TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"CatchesExit"         (TestTransport -> Assertion
testCatchesExit         TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"Catches"             (TestTransport -> Assertion
testCatches             TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"MaskRestoreScope"    (TestTransport -> Assertion
testMaskRestoreScope    TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"ExitLocal"           (TestTransport -> Assertion
testExitLocal           TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"ExitRemote"          (TestTransport -> Assertion
testExitRemote          TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"RegistryMonitoring"  (TestTransport -> Assertion
testRegistryMonitoring  TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"TextCallLocal"       (TestTransport -> Assertion
testCallLocal           TestTransport
testtrans)
      -- Unsafe Primitives
      , String -> Assertion -> Test
testCase String
"TestUnsafeSend"      (TestTransport -> Assertion
testUnsafeSend          TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"TestUnsafeUSend"     (TestTransport -> Assertion
testUnsafeUSend         TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"TestUnsafeNSend"     (TestTransport -> Assertion
testUnsafeNSend         TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"TestUnsafeNSendRemote" (TestTransport -> Assertion
testUnsafeNSendRemote TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"TestUnsafeSendChan"  (TestTransport -> Assertion
testUnsafeSendChan      TestTransport
testtrans)
      -- usend
      , String -> Assertion -> Test
testCase String
"USend"               ((ProcessId -> Int -> Process ())
-> TestTransport -> Int -> Assertion
testUSend ProcessId -> Int -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
usend         TestTransport
testtrans Int
50)
      , String -> Assertion -> Test
testCase String
"UForward"
                 ((ProcessId -> Int -> Process ())
-> TestTransport -> Int -> Assertion
testUSend (\ProcessId
p Int
m -> Message -> ProcessId -> Process ()
uforward (Int -> Message
forall a. Serializable a => a -> Message
createUnencodedMessage Int
m) ProcessId
p)
                            TestTransport
testtrans Int
50
                 )
      ]
    , String -> [Test] -> Test
testGroup String
"Monitoring and Linking" [
      -- Monitoring processes
      --
      -- The "missing" combinations in the list below don't make much sense, as
      -- we cannot guarantee that the monitor reply or link exception will not
      -- happen before the unmonitor or unlink
      String -> Assertion -> Test
testCase String
"MonitorNormalTermination"     (TestTransport -> Bool -> Bool -> Assertion
testMonitorNormalTermination   TestTransport
testtrans Bool
True  Bool
False)
    , String -> Assertion -> Test
testCase String
"MonitorAbnormalTermination"   (TestTransport -> Bool -> Bool -> Assertion
testMonitorAbnormalTermination TestTransport
testtrans Bool
True  Bool
False)
    , String -> Assertion -> Test
testCase String
"MonitorLocalDeadProcess"      (TestTransport -> Bool -> Bool -> Assertion
testMonitorLocalDeadProcess    TestTransport
testtrans Bool
True  Bool
False)
    , String -> Assertion -> Test
testCase String
"MonitorRemoteDeadProcess"     (TestTransport -> Bool -> Bool -> Assertion
testMonitorRemoteDeadProcess   TestTransport
testtrans Bool
True  Bool
False)
    , String -> Assertion -> Test
testCase String
"MonitorDisconnect"            (TestTransport -> Bool -> Bool -> Assertion
testMonitorDisconnect          TestTransport
testtrans Bool
True  Bool
False)
    , String -> Assertion -> Test
testCase String
"LinkUnreachable"              (TestTransport -> Bool -> Bool -> Assertion
testMonitorUnreachable         TestTransport
testtrans Bool
False Bool
False)
    , String -> Assertion -> Test
testCase String
"LinkNormalTermination"        (TestTransport -> Bool -> Bool -> Assertion
testMonitorNormalTermination   TestTransport
testtrans Bool
False Bool
False)
    , String -> Assertion -> Test
testCase String
"LinkAbnormalTermination"      (TestTransport -> Bool -> Bool -> Assertion
testMonitorAbnormalTermination TestTransport
testtrans Bool
False Bool
False)
    , String -> Assertion -> Test
testCase String
"LinkLocalDeadProcess"         (TestTransport -> Bool -> Bool -> Assertion
testMonitorLocalDeadProcess    TestTransport
testtrans Bool
False Bool
False)
    , String -> Assertion -> Test
testCase String
"LinkRemoteDeadProcess"        (TestTransport -> Bool -> Bool -> Assertion
testMonitorRemoteDeadProcess   TestTransport
testtrans Bool
False Bool
False)
    , String -> Assertion -> Test
testCase String
"LinkDisconnect"               (TestTransport -> Bool -> Bool -> Assertion
testMonitorDisconnect          TestTransport
testtrans Bool
False Bool
False)
    , String -> Assertion -> Test
testCase String
"UnmonitorNormalTermination"   (TestTransport -> Bool -> Bool -> Assertion
testMonitorNormalTermination   TestTransport
testtrans Bool
True  Bool
True)
    , String -> Assertion -> Test
testCase String
"UnmonitorAbnormalTermination" (TestTransport -> Bool -> Bool -> Assertion
testMonitorAbnormalTermination TestTransport
testtrans Bool
True  Bool
True)
    , String -> Assertion -> Test
testCase String
"UnmonitorDisconnect"          (TestTransport -> Bool -> Bool -> Assertion
testMonitorDisconnect          TestTransport
testtrans Bool
True  Bool
True)
    , String -> Assertion -> Test
testCase String
"UnlinkNormalTermination"      (TestTransport -> Bool -> Bool -> Assertion
testMonitorNormalTermination   TestTransport
testtrans Bool
False Bool
True)
    , String -> Assertion -> Test
testCase String
"UnlinkAbnormalTermination"    (TestTransport -> Bool -> Bool -> Assertion
testMonitorAbnormalTermination TestTransport
testtrans Bool
False Bool
True)
    , String -> Assertion -> Test
testCase String
"UnlinkDisconnect"             (TestTransport -> Bool -> Bool -> Assertion
testMonitorDisconnect          TestTransport
testtrans Bool
False Bool
True)
      -- Monitoring nodes and channels
    , String -> Assertion -> Test
testCase String
"MonitorNode"                  (TestTransport -> Assertion
testMonitorNode                TestTransport
testtrans)
    , String -> Assertion -> Test
testCase String
"MonitorLiveNode"              (TestTransport -> Assertion
testMonitorLiveNode            TestTransport
testtrans)
    , String -> Assertion -> Test
testCase String
"MonitorChannel"               (TestTransport -> Assertion
testMonitorChannel             TestTransport
testtrans)
      -- Reconnect
    ]

      -- Tests that fail occasionally and should be revised
    , String -> [Test] -> Test
testGroup String
"Flaky" [
      String -> Assertion -> Test
testCase String
"Reconnect"          (TestTransport -> Assertion
testReconnect           TestTransport
testtrans)
    , String -> Assertion -> Test
testCase String
"Registry"           (TestTransport -> Assertion
testRegistry            TestTransport
testtrans)
    , String -> Assertion -> Test
testCase String
"MergeChannels"      (TestTransport -> Assertion
testMergeChannels       TestTransport
testtrans)
    , String -> Assertion -> Test
testCase String
"MonitorUnreachable" (TestTransport -> Bool -> Bool -> Assertion
testMonitorUnreachable TestTransport
testtrans Bool
True Bool
False)
    ]
  ]