{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}

-- NOTICE: Some of these tests are /unsafe/, and will fail intermittently, since
-- they rely on ordering constraints which the Cloud Haskell runtime does not
-- guarantee.

module Main where

import Control.Concurrent.MVar
  ( MVar
  , newMVar
  , putMVar
  , takeMVar
  )
import qualified Control.Exception as Ex
import Control.Exception (throwIO)
import Control.Distributed.Process hiding (call, monitor)
import Control.Distributed.Process.Closure
import Control.Distributed.Process.Node
import Control.Distributed.Process.Extras.Internal.Types
import Control.Distributed.Process.Extras.Internal.Primitives
import Control.Distributed.Process.Extras.Time
import Control.Distributed.Process.Extras.Timer
import Control.Distributed.Process.Supervisor hiding (start, shutdown)
import qualified Control.Distributed.Process.Supervisor as Supervisor
import Control.Distributed.Process.ManagedProcess.Client (shutdown)
import Control.Distributed.Process.Serializable()

import Control.Distributed.Static (staticLabel)
import Control.Monad (void, forM_, forM)
import Control.Rematch
  ( equalTo
  , is
  , isNot
  , isNothing
  , isJust
  )

import Data.ByteString.Lazy (empty)
import Data.Maybe (catMaybes)

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

import Test.HUnit (Assertion, assertFailure)
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import TestUtils hiding (waitForExit)
import qualified Network.Transport as NT
-- test utilities

expectedExitReason :: ProcessId -> String
expectedExitReason sup = "killed-by=" ++ (show sup) ++
                         ",reason=TerminatedBySupervisor"

defaultWorker :: ChildStart -> ChildSpec
defaultWorker clj =
  ChildSpec
  {
    childKey     = ""
  , childType    = Worker
  , childRestart = Temporary
  , childStop    = TerminateImmediately
  , childStart   = clj
  , childRegName = Nothing
  }

tempWorker :: ChildStart -> ChildSpec
tempWorker clj =
  (defaultWorker clj)
  {
    childKey     = "temp-worker"
  , childRestart = Temporary
  }

transientWorker :: ChildStart -> ChildSpec
transientWorker clj =
  (defaultWorker clj)
  {
    childKey     = "transient-worker"
  , childRestart = Transient
  }

intrinsicWorker :: ChildStart -> ChildSpec
intrinsicWorker clj =
  (defaultWorker clj)
  {
    childKey     = "intrinsic-worker"
  , childRestart = Intrinsic
  }

permChild :: ChildStart -> ChildSpec
permChild clj =
  (defaultWorker clj)
  {
    childKey     = "perm-child"
  , childRestart = Permanent
  }

ensureProcessIsAlive :: ProcessId -> Process ()
ensureProcessIsAlive pid = do
  result <- isProcessAlive pid
  expectThat result $ is True

runInTestContext :: LocalNode
                 -> MVar ()
                 -> RestartStrategy
                 -> [ChildSpec]
                 -> (ProcessId -> Process ())
                 -> Assertion
runInTestContext node lock rs cs proc = do
  Ex.bracket (takeMVar lock) (putMVar lock) $ \() -> runProcess node $ do
    sup <- Supervisor.start rs ParallelShutdown cs
    (proc sup) `finally` (exit sup ExitShutdown)

verifyChildWasRestarted :: ChildKey -> ProcessId -> ProcessId -> Process ()
verifyChildWasRestarted key pid sup = do
  void $ waitForExit pid
  cSpec <- lookupChild sup key
  -- TODO: handle (ChildRestarting _) too!
  case cSpec of
    Just (ref, _) -> do Just pid' <- resolve ref
                        expectThat pid' $ isNot $ equalTo pid
    _             -> do
      liftIO $ assertFailure $ "unexpected child ref: " ++ (show (key, cSpec))

verifyChildWasNotRestarted :: ChildKey -> ProcessId -> ProcessId -> Process ()
verifyChildWasNotRestarted key pid sup = do
  void $ waitForExit pid
  cSpec <- lookupChild sup key
  case cSpec of
    Just (ChildStopped, _) -> return ()
    _ -> liftIO $ assertFailure $ "unexpected child ref: " ++ (show (key, cSpec))

verifyTempChildWasRemoved :: ProcessId -> ProcessId -> Process ()
verifyTempChildWasRemoved pid sup = do
  void $ waitForExit pid
  sleepFor 500 Millis
  cSpec <- lookupChild sup "temp-worker"
  expectThat cSpec isNothing

waitForExit :: ProcessId -> Process DiedReason
waitForExit pid = do
  monitor pid >>= waitForDown

waitForDown :: Maybe MonitorRef -> Process DiedReason
waitForDown Nothing    = error "invalid mref"
waitForDown (Just ref) =
  receiveWait [ matchIf (\(ProcessMonitorNotification ref' _ _) -> ref == ref')
                        (\(ProcessMonitorNotification _ _ dr) -> return dr) ]

drainChildren :: [Child] -> ProcessId -> Process ()
drainChildren children expected = do
  -- Receive all pids then verify they arrived in the correct order.
  -- Any out-of-order messages (such as ProcessMonitorNotification) will
  -- violate the invariant asserted below, and fail the test case
  pids <- forM children $ \_ -> expect :: Process ProcessId
  let first' = head pids
  Just exp' <- resolve expected
  -- however... we do allow for the scheduler and accept `head $ tail pids` in
  -- lieu of the correct result, since when there are multiple senders we have
  -- no causal guarantees
  if first' /= exp'
     then let second' = head $ tail pids in second' `shouldBe` equalTo exp'
     else first' `shouldBe` equalTo exp'

exitIgnore :: Process ()
exitIgnore = liftIO $ throwIO ChildInitIgnore

noOp :: Process ()
noOp = return ()

blockIndefinitely :: Process ()
blockIndefinitely = runTestProcess noOp

notifyMe :: ProcessId -> Process ()
notifyMe me = getSelfPid >>= send me >> obedient

sleepy :: Process ()
sleepy = (sleepFor 5 Minutes)
           `catchExit` (\_ (_ :: ExitReason) -> return ()) >> sleepy

obedient :: Process ()
obedient = (sleepFor 5 Minutes)
           {- supervisor inserts handlers that act like we wrote:
             `catchExit` (\_ (r :: ExitReason) -> do
                             case r of
                               ExitShutdown -> return ()
                               _ -> die r)
           -}

$(remotable [ 'exitIgnore
            , 'noOp
            , 'blockIndefinitely
            , 'sleepy
            , 'obedient
            , 'notifyMe])

-- test cases start here...

normalStartStop :: ProcessId -> Process ()
normalStartStop sup = do
  ensureProcessIsAlive sup
  void $ monitor sup
  shutdown sup
  sup `shouldExitWith` DiedNormal

sequentialShutdown :: TestResult (Maybe ()) -> Process ()
sequentialShutdown result = do
  (sp, rp) <- newChan
  (sg, rg) <- newChan
  core' <- toChildStart $ runCore sp
  app'  <- toChildStart $ runApp sg
  let core = (permChild core') { childRegName = Just (LocalName "core")
                               , childStop = TerminateTimeout (Delay $ within 2 Seconds)
                               , childKey  = "child-1"
                               }
  let app  = (permChild app')  { childRegName = Just (LocalName "app")
                               , childStop = TerminateTimeout (Delay $ within 2 Seconds)
                               , childKey  = "child-2"
                               }

  sup <- Supervisor.start restartRight
                          (SequentialShutdown RightToLeft)
                          [core, app]

  () <- receiveChan rg
  exit sup ExitShutdown
  res <- receiveChanTimeout (asTimeout $ seconds 2) rp

--  whereis "core" >>= liftIO . putStrLn . ("core :" ++) . show
--  whereis "app"  >>= liftIO . putStrLn . ("app :" ++) . show

  sleepFor 1 Seconds
  stash result res

  where
    runCore :: SendPort () -> Process ()
    runCore sp = (expect >>= say) `catchExit` (\_ ExitShutdown -> sendChan sp ())

    runApp :: SendPort () -> Process ()
    runApp sg = do
      Just pid <- whereis "core"
      link pid  -- if the real "core" exits first, we go too
      sendChan sg ()
      expect >>= say

configuredTemporaryChildExitsWithIgnore ::
     ChildStart
  -> (RestartStrategy -> [ChildSpec] -> (ProcessId -> Process ()) -> Assertion)
  -> Assertion
configuredTemporaryChildExitsWithIgnore cs withSupervisor =
  let spec = tempWorker cs in do
    withSupervisor restartOne [spec] verifyExit
  where
    verifyExit :: ProcessId -> Process ()
    verifyExit sup = do
--      sa <- isProcessAlive sup
      child <- lookupChild sup "temp-worker"
      case child of
        Nothing       -> return () -- the child exited and was removed ok
        Just (ref, _) -> do
          Just pid <- resolve ref
          verifyTempChildWasRemoved pid sup

configuredNonTemporaryChildExitsWithIgnore ::
      ChildStart
   -> (RestartStrategy -> [ChildSpec] -> (ProcessId -> Process ()) -> Assertion)
   -> Assertion
configuredNonTemporaryChildExitsWithIgnore cs withSupervisor =
  let spec = transientWorker cs in do
    withSupervisor restartOne [spec] $ verifyExit spec
  where
    verifyExit :: ChildSpec -> ProcessId -> Process ()
    verifyExit spec sup = do
      sleep $ milliSeconds 100  -- make sure our super has seen the EXIT signal
      child <- lookupChild sup (childKey spec)
      case child of
        Nothing           -> liftIO $ assertFailure $ "lost non-temp spec!"
        Just (ref, spec') -> do
          rRef <- resolve ref
          maybe (return DiedNormal) waitForExit rRef
          cSpec <- lookupChild sup (childKey spec')
          case cSpec of
            Just (ChildStartIgnored, _) -> return ()
            _                           -> do
              liftIO $ assertFailure $ "unexpected lookup: " ++ (show cSpec)

startTemporaryChildExitsWithIgnore :: ChildStart -> ProcessId -> Process ()
startTemporaryChildExitsWithIgnore cs sup =
  -- if a temporary child exits with "ignore" then we must
  -- have deleted its specification from the supervisor
  let spec = tempWorker cs in do
    ChildAdded ref <- startNewChild sup spec
    Just pid <- resolve ref
    verifyTempChildWasRemoved pid sup

startNonTemporaryChildExitsWithIgnore :: ChildStart -> ProcessId -> Process ()
startNonTemporaryChildExitsWithIgnore cs sup =
  let spec = transientWorker cs in do
    ChildAdded ref <- startNewChild sup spec
    Just pid <- resolve ref
    void $ waitForExit pid
    sleep $ milliSeconds 250
    cSpec <- lookupChild sup (childKey spec)
    case cSpec of
      Just (ChildStartIgnored, _) -> return ()
      _                      -> do
        liftIO $ assertFailure $ "unexpected lookup: " ++ (show cSpec)

addChildWithoutRestart :: ChildStart -> ProcessId -> Process ()
addChildWithoutRestart cs sup =
  let spec = transientWorker cs in do
    response <- addChild sup spec
    response `shouldBe` equalTo (ChildAdded ChildStopped)

addChildThenStart :: ChildStart -> ProcessId -> Process ()
addChildThenStart cs sup =
  let spec = transientWorker cs in do
    (ChildAdded _) <- addChild sup spec
    response <- startChild sup (childKey spec)
    case response of
      ChildStartOk (ChildRunning pid) -> do
        alive <- isProcessAlive pid
        alive `shouldBe` equalTo True
      _ -> do
        liftIO $ putStrLn (show response)
        die "Ooops"

startUnknownChild :: ChildStart -> ProcessId -> Process ()
startUnknownChild cs sup = do
  response <- startChild sup (childKey (transientWorker cs))
  response `shouldBe` equalTo ChildStartUnknownId

setupChild :: ChildStart -> ProcessId -> Process (ChildRef, ChildSpec)
setupChild cs sup = do
  let spec = transientWorker cs
  response <- addChild sup spec
  response `shouldBe` equalTo (ChildAdded ChildStopped)
  Just child <- lookupChild sup "transient-worker"
  return child

addDuplicateChild :: ChildStart -> ProcessId -> Process ()
addDuplicateChild cs sup = do
  (ref, spec) <- setupChild cs sup
  dup <- addChild sup spec
  dup `shouldBe` equalTo (ChildFailedToStart $ StartFailureDuplicateChild ref)

startDuplicateChild :: ChildStart -> ProcessId -> Process ()
startDuplicateChild cs sup = do
  (ref, spec) <- setupChild cs sup
  dup <- startNewChild sup spec
  dup `shouldBe` equalTo (ChildFailedToStart $ StartFailureDuplicateChild ref)

startBadClosure :: ChildStart -> ProcessId -> Process ()
startBadClosure cs sup = do
  let spec = tempWorker cs
  child <- startNewChild sup spec
  child `shouldBe` equalTo
    (ChildFailedToStart $ StartFailureBadClosure
       "user error (Could not resolve closure: Invalid static label 'non-existing')")

-- configuredBadClosure withSupervisor = do
--   let spec = permChild (closure (staticLabel "non-existing") empty)
--   -- we make sure we don't hit the supervisor's limits
--   let strategy = RestartOne $ limit (maxRestarts 500000000) (milliSeconds 1)
--   withSupervisor strategy [spec] $ \sup -> do
-- --    ref <- monitor sup
--     children <- (listChildren sup)
--     let specs = map fst children
--     expectThat specs $ equalTo []

deleteExistingChild :: ChildStart -> ProcessId -> Process ()
deleteExistingChild cs sup = do
  let spec = transientWorker cs
  (ChildAdded ref) <- startNewChild sup spec
  result <- deleteChild sup "transient-worker"
  result `shouldBe` equalTo (ChildNotStopped ref)

deleteStoppedTempChild :: ChildStart -> ProcessId -> Process ()
deleteStoppedTempChild cs sup = do
  let spec = tempWorker cs
  ChildAdded ref <- startNewChild sup spec
  Just pid <- resolve ref
  testProcessStop pid
  -- child needs to be stopped
  waitForExit pid
  result <- deleteChild sup (childKey spec)
  result `shouldBe` equalTo ChildNotFound

deleteStoppedChild :: ChildStart -> ProcessId -> Process ()
deleteStoppedChild cs sup = do
  let spec = transientWorker cs
  ChildAdded ref <- startNewChild sup spec
  Just pid <- resolve ref
  testProcessStop pid
  -- child needs to be stopped
  waitForExit pid
  result <- deleteChild sup (childKey spec)
  result `shouldBe` equalTo ChildDeleted

permanentChildrenAlwaysRestart :: ChildStart -> ProcessId -> Process ()
permanentChildrenAlwaysRestart cs sup = do
  let spec = permChild cs
  (ChildAdded ref) <- startNewChild sup spec
  Just pid <- resolve ref
  testProcessStop pid  -- a normal stop should *still* trigger a restart
  verifyChildWasRestarted (childKey spec) pid sup

temporaryChildrenNeverRestart :: ChildStart -> ProcessId -> Process ()
temporaryChildrenNeverRestart cs sup = do
  let spec = tempWorker cs
  (ChildAdded ref) <- startNewChild sup spec
  Just pid <- resolve ref
  kill pid "bye bye"
  verifyTempChildWasRemoved pid sup

transientChildrenNormalExit :: ChildStart -> ProcessId -> Process ()
transientChildrenNormalExit cs sup = do
  let spec = transientWorker cs
  (ChildAdded ref) <- startNewChild sup spec
  Just pid <- resolve ref
  testProcessStop pid
  verifyChildWasNotRestarted (childKey spec) pid sup

transientChildrenAbnormalExit :: ChildStart -> ProcessId -> Process ()
transientChildrenAbnormalExit cs sup = do
  let spec = transientWorker cs
  (ChildAdded ref) <- startNewChild sup spec
  Just pid <- resolve ref
  kill pid "bye bye"
  verifyChildWasRestarted (childKey spec) pid sup

transientChildrenExitShutdown :: ChildStart -> ProcessId -> Process ()
transientChildrenExitShutdown cs sup = do
  let spec = transientWorker cs
  (ChildAdded ref) <- startNewChild sup spec
  Just pid <- resolve ref
  exit pid ExitShutdown
  verifyChildWasNotRestarted (childKey spec) pid sup

intrinsicChildrenAbnormalExit :: ChildStart -> ProcessId -> Process ()
intrinsicChildrenAbnormalExit cs sup = do
  let spec = intrinsicWorker cs
  ChildAdded ref <- startNewChild sup spec
  Just pid <- resolve ref
  kill pid "bye bye"
  verifyChildWasRestarted (childKey spec) pid sup

intrinsicChildrenNormalExit :: ChildStart -> ProcessId -> Process ()
intrinsicChildrenNormalExit cs sup = do
  let spec = intrinsicWorker cs
  ChildAdded ref <- startNewChild sup spec
  Just pid <- resolve ref
  testProcessStop pid
  reason <- waitForExit sup
  expectThat reason $ equalTo DiedNormal

explicitRestartRunningChild :: ChildStart -> ProcessId -> Process ()
explicitRestartRunningChild cs sup = do
  let spec = tempWorker cs
  ChildAdded ref <- startNewChild sup spec
  result <- restartChild sup (childKey spec)
  expectThat result $ equalTo $ ChildRestartFailed (StartFailureAlreadyRunning ref)

explicitRestartUnknownChild :: ProcessId -> Process ()
explicitRestartUnknownChild sup = do
  result <- restartChild sup "unknown-id"
  expectThat result $ equalTo ChildRestartUnknownId

explicitRestartRestartingChild :: ChildStart -> ProcessId -> Process ()
explicitRestartRestartingChild cs sup = do
  let spec = permChild cs
  ChildAdded _ <- startNewChild sup spec
  -- TODO: we've seen a few explosions here (presumably of the supervisor?)
  -- expecially when running with +RTS -N1 - it's possible that there's a bug
  -- tucked away that we haven't cracked just yet
  restarted <- (restartChild sup (childKey spec))
                 `catchExit` (\_ (r :: ExitReason) -> (liftIO $ putStrLn (show r)) >>
                                                      die r)
  -- this is highly timing dependent, so we have to allow for both
  -- possible outcomes - on a dual core machine, the first clause
  -- will match approx. 1 / 200 times when running with +RTS -N
  case restarted of
    ChildRestartFailed (StartFailureAlreadyRunning (ChildRestarting _)) -> return ()
    ChildRestartFailed (StartFailureAlreadyRunning (ChildRunning _)) -> return ()
    other -> liftIO $ assertFailure $ "unexpected result: " ++ (show other)

explicitRestartStoppedChild :: ChildStart -> ProcessId -> Process ()
explicitRestartStoppedChild cs sup = do
  let spec = transientWorker cs
  let key = childKey spec
  ChildAdded ref <- startNewChild sup spec
  void $ terminateChild sup key
  restarted <- restartChild sup key
  sleepFor 500 Millis
  Just (ref', _) <- lookupChild sup key
  expectThat ref $ isNot $ equalTo ref'
  case restarted of
    ChildRestartOk (ChildRunning _) -> return ()
    _ -> liftIO $ assertFailure $ "unexpected termination: " ++ (show restarted)

terminateChildImmediately :: ChildStart -> ProcessId -> Process ()
terminateChildImmediately cs sup = do
  let spec = tempWorker cs
  ChildAdded ref <- startNewChild sup spec
--  Just pid <- resolve ref
  mRef <- monitor ref
  void $ terminateChild sup (childKey spec)
  reason <- waitForDown mRef
  expectThat reason $ equalTo $ DiedException (expectedExitReason sup)

terminatingChildExceedsDelay :: ProcessId -> Process ()
terminatingChildExceedsDelay sup = do
  let spec = (tempWorker (RunClosure $(mkStaticClosure 'sleepy)))
             { childStop = TerminateTimeout (Delay $ within 1 Seconds) }
  ChildAdded ref <- startNewChild sup spec
-- Just pid <- resolve ref
  mRef <- monitor ref
  void $ terminateChild sup (childKey spec)
  reason <- waitForDown mRef
  expectThat reason $ equalTo $ DiedException (expectedExitReason sup)

terminatingChildObeysDelay :: ProcessId -> Process ()
terminatingChildObeysDelay sup = do
  let spec = (tempWorker (RunClosure $(mkStaticClosure 'obedient)))
             { childStop = TerminateTimeout (Delay $ within 1 Seconds) }
  ChildAdded child <- startNewChild sup spec
  Just pid <- resolve child
  testProcessGo pid
  void $ monitor pid
  void $ terminateChild sup (childKey spec)
  child `shouldExitWith` DiedNormal

restartAfterThreeAttempts ::
     ChildStart
  -> (RestartStrategy -> [ChildSpec] -> (ProcessId -> Process ()) -> Assertion)
  -> Assertion
restartAfterThreeAttempts cs withSupervisor = do
  let spec = permChild cs
  let strategy = RestartOne $ limit (maxRestarts 500) (seconds 2)
  withSupervisor strategy [spec] $ \sup -> do
    mapM_ (\_ -> do
      [(childRef, _)] <- listChildren sup
      Just pid <- resolve childRef
      ref <- monitor pid
      testProcessStop pid
      void $ waitForDown ref) [1..3 :: Int]
    [(_, _)] <- listChildren sup
    return ()

{-
delayedRestartAfterThreeAttempts ::
     (RestartStrategy -> [ChildSpec] -> (ProcessId -> Process ()) -> Assertion)
  -> Assertion
delayedRestartAfterThreeAttempts withSupervisor = do
  let restartPolicy = DelayedRestart Permanent (within 1 Seconds)
  let spec = (permChild $(mkStaticClosure 'blockIndefinitely))
             { childRestart = restartPolicy }
  let strategy = RestartOne $ limit (maxRestarts 2) (seconds 1)
  withSupervisor strategy [spec] $ \sup -> do
    mapM_ (\_ -> do
      [(childRef, _)] <- listChildren sup
      Just pid <- resolve childRef
      ref <- monitor pid
      testProcessStop pid
      void $ waitForDown ref) [1..3 :: Int]
    Just (ref, _) <- lookupChild sup $ childKey spec
    case ref of
      ChildRestarting _ -> return ()
      _ -> liftIO $ assertFailure $ "Unexpected ChildRef: " ++ (show ref)
    sleep $ seconds 2
    [(ref', _)] <- listChildren sup
    liftIO $ putStrLn $ "it is: " ++ (show ref')
    Just pid <- resolve ref'
    mRef <- monitor pid
    testProcessStop pid
    void $ waitForDown mRef
-}

permanentChildExceedsRestartsIntensity ::
     ChildStart
  -> (RestartStrategy -> [ChildSpec] -> (ProcessId -> Process ()) -> Assertion)
  -> Assertion
permanentChildExceedsRestartsIntensity cs withSupervisor = do
  let spec = permChild cs  -- child that exits immediately
  let strategy = RestartOne $ limit (maxRestarts 50) (seconds 2)
  withSupervisor strategy [spec] $ \sup -> do
    ref <- monitor sup
    -- if the supervisor dies whilst the call is in-flight,
    -- *this* process will exit, therefore we handle that exit reason
    void $ ((startNewChild sup spec >> return ())
             `catchExit` (\_ (_ :: ExitReason) -> return ()))
    reason <- waitForDown ref
    expectThat reason $ equalTo $
                      DiedException $ "exit-from=" ++ (show sup) ++
                                      ",reason=ReachedMaxRestartIntensity"

terminateChildIgnoresSiblings ::
     ChildStart
  -> (RestartStrategy -> [ChildSpec] -> (ProcessId -> Process ()) -> Assertion)
  -> Assertion
terminateChildIgnoresSiblings cs withSupervisor = do
  let templ = permChild cs
  let specs = [templ { childKey = (show i) } | i <- [1..3 :: Int]]
  withSupervisor restartAll specs $ \sup -> do
    let toStop = childKey $ head specs
    Just (ref, _) <- lookupChild sup toStop
    mRef <- monitor ref
    terminateChild sup toStop
    waitForDown mRef
    children <- listChildren sup
    forM_ (tail $ map fst children) $ \cRef -> do
      maybe (error "invalid ref") ensureProcessIsAlive =<< resolve cRef

restartAllWithLeftToRightSeqRestarts ::
     ChildStart
  -> (RestartStrategy -> [ChildSpec] -> (ProcessId -> Process ()) -> Assertion)
  -> Assertion
restartAllWithLeftToRightSeqRestarts cs withSupervisor = do
  let templ = permChild cs
  let specs = [templ { childKey = (show i) } | i <- [1..100 :: Int]]
  withSupervisor restartAll specs $ \sup -> do
    let toStop = childKey $ head specs
    Just (ref, _) <- lookupChild sup toStop
    children <- listChildren sup
    Just pid <- resolve ref
    kill pid "goodbye"
    forM_ (map fst children) $ \cRef -> do
      mRef <- monitor cRef
      waitForDown mRef
    forM_ (map snd children) $ \cSpec -> do
      Just (ref', _) <- lookupChild sup (childKey cSpec)
      maybe (error "invalid ref") ensureProcessIsAlive =<< resolve ref'

restartLeftWithLeftToRightSeqRestarts ::
     ChildStart
  -> (RestartStrategy -> [ChildSpec] -> (ProcessId -> Process ()) -> Assertion)
  -> Assertion
restartLeftWithLeftToRightSeqRestarts cs withSupervisor = do
  let templ = permChild cs
  let specs = [templ { childKey = (show i) } | i <- [1..500 :: Int]]
  withSupervisor restartLeft specs $ \sup -> do
    let (toRestart, _notToRestart) = splitAt 100 specs
    let toStop = childKey $ last toRestart
    Just (ref, _) <- lookupChild sup toStop
    Just pid <- resolve ref
    children <- listChildren sup
    let (children', survivors) = splitAt 100 children
    kill pid "goodbye"
    forM_ (map fst children') $ \cRef -> do
      mRef <- monitor cRef
      waitForDown mRef
    forM_ (map snd children') $ \cSpec -> do
      Just (ref', _) <- lookupChild sup (childKey cSpec)
      maybe (error "invalid ref") ensureProcessIsAlive =<< resolve ref'
    resolved <- forM (map fst survivors) resolve
    let possibleBadRestarts = catMaybes resolved
    r <- receiveTimeout (after 1 Seconds) [
        match (\(ProcessMonitorNotification _ pid' _) -> do
          case (elem pid' possibleBadRestarts) of
            True  -> liftIO $ assertFailure $ "unexpected exit from " ++ show pid'
            False -> return ())
      ]
    expectThat r isNothing

restartRightWithLeftToRightSeqRestarts ::
     ChildStart
  -> (RestartStrategy -> [ChildSpec] -> (ProcessId -> Process ()) -> Assertion)
  -> Assertion
restartRightWithLeftToRightSeqRestarts cs withSupervisor = do
  let templ = permChild cs
  let specs = [templ { childKey = (show i) } | i <- [1..50 :: Int]]
  withSupervisor restartRight specs $ \sup -> do
    let (_notToRestart, toRestart) = splitAt 40 specs
    let toStop = childKey $ head toRestart
    Just (ref, _) <- lookupChild sup toStop
    Just pid <- resolve ref
    children <- listChildren sup
    let (survivors, children') = splitAt 40 children
    kill pid "goodbye"
    forM_ (map fst children') $ \cRef -> do
      mRef <- monitor cRef
      waitForDown mRef
    forM_ (map snd children') $ \cSpec -> do
      Just (ref', _) <- lookupChild sup (childKey cSpec)
      maybe (error "invalid ref") ensureProcessIsAlive =<< resolve ref'
    resolved <- forM (map fst survivors) resolve
    let possibleBadRestarts = catMaybes resolved
    r <- receiveTimeout (after 1 Seconds) [
        match (\(ProcessMonitorNotification _ pid' _) -> do
          case (elem pid' possibleBadRestarts) of
            True  -> liftIO $ assertFailure $ "unexpected exit from " ++ show pid'
            False -> return ())
      ]
    expectThat r isNothing

restartAllWithLeftToRightRestarts :: ProcessId -> Process ()
restartAllWithLeftToRightRestarts sup = do
  self <- getSelfPid
  let templ = permChild $ RunClosure ($(mkClosure 'notifyMe) self)
  let specs = [templ { childKey = (show i) } | i <- [1..100 :: Int]]
  -- add the specs one by one
  forM_ specs $ \s -> void $ startNewChild sup s
  -- assert that we saw the startup sequence working...
  children <- listChildren sup
  drainAllChildren children
  let toStop = childKey $ head specs
  Just (ref, _) <- lookupChild sup toStop
  Just pid <- resolve ref
  kill pid "goodbye"
  -- wait for all the exit signals, so we know the children are restarting
  forM_ (map fst children) $ \cRef -> do
    Just mRef <- monitor cRef
    receiveWait [
        matchIf (\(ProcessMonitorNotification ref' _ _) -> ref' == mRef)
                (\_ -> return ())
        -- we should NOT see *any* process signalling that it has started
        -- whilst waiting for all the children to be terminated
      , match (\(pid' :: ProcessId) -> do
            liftIO $ assertFailure $ "unexpected signal from " ++ (show pid'))
      ]
  -- Now assert that all the children were restarted in the same order.
  -- THIS is the bit that is technically unsafe, though it's also unlikely
  -- to change, since the architecture of the node controller is pivotal to CH
  children' <- listChildren sup
  drainAllChildren children'
  let [c1, c2] = [map fst cs | cs <- [children, children']]
  forM_ (zip c1 c2) $ \(p1, p2) -> expectThat p1 $ isNot $ equalTo p2
  where
    drainAllChildren children = do
      -- Receive all pids then verify they arrived in the correct order.
      -- Any out-of-order messages (such as ProcessMonitorNotification) will
      -- violate the invariant asserted below, and fail the test case
      pids <- forM children $ \_ -> expect :: Process ProcessId
      forM_ pids ensureProcessIsAlive

restartAllWithRightToLeftSeqRestarts :: ProcessId -> Process ()
restartAllWithRightToLeftSeqRestarts sup = do
  self <- getSelfPid
  let templ = permChild $ RunClosure ($(mkClosure 'notifyMe) self)
  let specs = [templ { childKey = (show i) } | i <- [1..100 :: Int]]
  -- add the specs one by one
  forM_ specs $ \s -> do
    ChildAdded ref <- startNewChild sup s
    maybe (error "invalid ref") ensureProcessIsAlive =<< resolve ref
  -- assert that we saw the startup sequence working...
  let toStop = childKey $ head specs
  Just (ref, _) <- lookupChild sup toStop
  Just pid <- resolve ref
  children <- listChildren sup
  drainChildren children pid
  kill pid "fooboo"
  -- wait for all the exit signals, so we know the children are restarting
  forM_ (map fst children) $ \cRef -> do
    Just mRef <- monitor cRef
    receiveWait [
        matchIf (\(ProcessMonitorNotification ref' _ _) -> ref' == mRef)
                (\_ -> return ())
      ]
  -- ensure that both ends of the pids we've seen are in the right order...
  -- in this case, we expect the last child to be the first notification,
  -- since they were started in right to left order
  children' <- listChildren sup
  let (ref', _) = last children'
  Just pid' <- resolve ref'
  drainChildren children' pid'

expectLeftToRightRestarts :: ProcessId -> Process ()
expectLeftToRightRestarts sup = do
  self <- getSelfPid
  let templ = permChild $ RunClosure ($(mkClosure 'notifyMe) self)
  let specs = [templ { childKey = (show i) } | i <- [1..100 :: Int]]
  -- add the specs one by one
  forM_ specs $ \s -> do
    ChildAdded c <- startNewChild sup s
    Just p <- resolve c
    p' <- expect
    p' `shouldBe` equalTo p
  -- assert that we saw the startup sequence working...
  let toStop = childKey $ head specs
  Just (ref, _) <- lookupChild sup toStop
  Just pid <- resolve ref
  children <- listChildren sup
  -- wait for all the exit signals and ensure they arrive in RightToLeft order
  refs <- forM children $ \(ch, _) -> monitor ch >>= \r -> return (ch, r)
  kill pid "fooboo"
  initRes <- receiveTimeout
               (asTimeout $ seconds 1)
               [ matchIf
                 (\(ProcessMonitorNotification r _ _) -> (Just r) == (snd $ head refs))
                 (\sig@(ProcessMonitorNotification _ _ _) -> return sig) ]
  expectThat initRes $ isJust
  forM_ (reverse (filter ((/= ref) .fst ) refs)) $ \(_, Just mRef) -> do
    (ProcessMonitorNotification ref' _ _) <- expect
    if ref' == mRef then (return ()) else (die "unexpected monitor signal")
  -- in this case, we expect the first child to be the first notification,
  -- since they were started in left to right order
  children' <- listChildren sup
  let (ref', _) = head children'
  Just pid' <- resolve ref'
  drainChildren children' pid'

expectRightToLeftRestarts :: ProcessId -> Process ()
expectRightToLeftRestarts sup = do
  self <- getSelfPid
  let templ = permChild $ RunClosure ($(mkClosure 'notifyMe) self)
  let specs = [templ { childKey = (show i) } | i <- [1..10 :: Int]]
  -- add the specs one by one
  forM_ specs $ \s -> do
    ChildAdded ref <- startNewChild sup s
    maybe (error "invalid ref") ensureProcessIsAlive =<< resolve ref
  -- assert that we saw the startup sequence working...
  let toStop = childKey $ head specs
  Just (ref, _) <- lookupChild sup toStop
  Just pid <- resolve ref
  children <- listChildren sup
  drainChildren children pid
  kill pid "fooboo"
  -- wait for all the exit signals, so we know the children are restarting
  forM_ (map fst children) $ \cRef -> do
    Just mRef <- monitor cRef
    receiveWait [
        matchIf (\(ProcessMonitorNotification ref' _ _) -> ref' == mRef)
                (\_ -> return ())
        -- we should NOT see *any* process signalling that it has started
        -- whilst waiting for all the children to be terminated
      , match (\(pid' :: ProcessId) -> do
            liftIO $ assertFailure $ "unexpected signal from " ++ (show pid'))
      ]
  -- ensure that both ends of the pids we've seen are in the right order...
  -- in this case, we expect the last child to be the first notification,
  -- since they were started in right to left order
  children' <- listChildren sup
  let (ref', _) = last children'
  Just pid' <- resolve ref'
  drainChildren children' pid'

restartLeftWhenLeftmostChildDies :: ChildStart -> ProcessId -> Process ()
restartLeftWhenLeftmostChildDies cs sup = do
  let spec = permChild cs
  (ChildAdded ref) <- startNewChild sup spec
  (ChildAdded ref2) <- startNewChild sup $ spec { childKey = "child2" }
  Just pid <- resolve ref
  Just pid2 <- resolve ref2
  testProcessStop pid  -- a normal stop should *still* trigger a restart
  verifyChildWasRestarted (childKey spec) pid sup
  Just (ref3, _) <- lookupChild sup "child2"
  Just pid2' <- resolve ref3
  pid2 `shouldBe` equalTo pid2'

restartWithoutTempChildren :: ChildStart -> ProcessId -> Process ()
restartWithoutTempChildren cs sup = do
  (ChildAdded refTrans) <- startNewChild sup $ transientWorker cs
  (ChildAdded _)        <- startNewChild sup $ tempWorker cs
  (ChildAdded refPerm)  <- startNewChild sup $ permChild cs
  Just pid2 <- resolve refTrans
  Just pid3 <- resolve refPerm

  kill pid2 "foobar"
  void $ waitForExit pid2 -- this wait reduces the likelihood of a race in the test
  Nothing <- lookupChild sup "temp-worker"
  verifyChildWasRestarted "transient-worker" pid2 sup
  verifyChildWasRestarted "perm-child"       pid3 sup

restartRightWhenRightmostChildDies :: ChildStart -> ProcessId -> Process ()
restartRightWhenRightmostChildDies cs sup = do
  let spec = permChild cs
  (ChildAdded ref2) <- startNewChild sup $ spec { childKey = "child2" }
  (ChildAdded ref) <- startNewChild sup $ spec { childKey = "child1" }
  [ch1, ch2] <- listChildren sup
  (fst ch1) `shouldBe` equalTo ref2
  (fst ch2) `shouldBe` equalTo ref
  Just pid <- resolve ref
  Just pid2 <- resolve ref2
  -- ref (and therefore pid) is 'rightmost' now
  testProcessStop pid  -- a normal stop should *still* trigger a restart
  verifyChildWasRestarted "child1" pid sup
  Just (ref3, _) <- lookupChild sup "child2"
  Just pid2' <- resolve ref3
  pid2 `shouldBe` equalTo pid2'

restartLeftWithLeftToRightRestarts :: ProcessId -> Process ()
restartLeftWithLeftToRightRestarts sup = do
  self <- getSelfPid
  let templ = permChild $ RunClosure ($(mkClosure 'notifyMe) self)
  let specs = [templ { childKey = (show i) } | i <- [1..20 :: Int]]
  forM_ specs $ \s -> void $ startNewChild sup s
  -- assert that we saw the startup sequence working...
  let toStart = childKey $ head specs
  Just (ref, _) <- lookupChild sup toStart
  Just pid <- resolve ref
  children <- listChildren sup
  drainChildren children pid
  let (toRestart, _) = splitAt 7 specs
  let toStop = childKey $ last toRestart
  Just (ref', _) <- lookupChild sup toStop
  Just stopPid <- resolve ref'
  kill stopPid "goodbye"
  -- wait for all the exit signals, so we know the children are restarting
  forM_ (map fst (fst $ splitAt 7 children)) $ \cRef -> do
    mRef <- monitor cRef
    waitForDown mRef
  children' <- listChildren sup
  let (restarted, notRestarted) = splitAt 7 children'
  -- another (technically) unsafe check
  let firstRestart = childKey $ snd $ head restarted
  Just (rRef, _) <- lookupChild sup firstRestart
  Just fPid <- resolve rRef
  drainChildren restarted fPid
  let [c1, c2] = [map fst cs | cs <- [(snd $ splitAt 7 children), notRestarted]]
  forM_ (zip c1 c2) $ \(p1, p2) -> p1 `shouldBe` equalTo p2

restartRightWithLeftToRightRestarts :: ProcessId -> Process ()
restartRightWithLeftToRightRestarts sup = do
  self <- getSelfPid
  let templ = permChild $ RunClosure ($(mkClosure 'notifyMe) self)
  let specs = [templ { childKey = (show i) } | i <- [1..20 :: Int]]
  forM_ specs $ \s -> void $ startNewChild sup s
  -- assert that we saw the startup sequence working...
  let toStart = childKey $ head specs
  Just (ref, _) <- lookupChild sup toStart
  Just pid <- resolve ref
  children <- listChildren sup
  drainChildren children pid
  let (_, toRestart) = splitAt 3 specs
  let toStop = childKey $ head toRestart
  Just (ref', _) <- lookupChild sup toStop
  Just stopPid <- resolve ref'
  kill stopPid "goodbye"
  -- wait for all the exit signals, so we know the children are restarting
  forM_ (map fst (snd $ splitAt 3 children)) $ \cRef -> do
    mRef <- monitor cRef
    waitForDown mRef
  children' <- listChildren sup
  let (notRestarted, restarted) = splitAt 3 children'
  -- another (technically) unsafe check
  let firstRestart = childKey $ snd $ head restarted
  Just (rRef, _) <- lookupChild sup firstRestart
  Just fPid <- resolve rRef
  drainChildren restarted fPid
  let [c1, c2] = [map fst cs | cs <- [(fst $ splitAt 3 children), notRestarted]]
  forM_ (zip c1 c2) $ \(p1, p2) -> p1 `shouldBe` equalTo p2

restartRightWithRightToLeftRestarts :: ProcessId -> Process ()
restartRightWithRightToLeftRestarts sup = do
  self <- getSelfPid
  let templ = permChild $ RunClosure ($(mkClosure 'notifyMe) self)
  let specs = [templ { childKey = (show i) } | i <- [1..20 :: Int]]
  forM_ specs $ \s -> void $ startNewChild sup s
  -- assert that we saw the startup sequence working...
  let toStart = childKey $ head specs
  Just (ref, _) <- lookupChild sup toStart
  Just pid <- resolve ref
  children <- listChildren sup
  drainChildren children pid
  let (_, toRestart) = splitAt 3 specs
  let toStop = childKey $ head toRestart
  Just (ref', _) <- lookupChild sup toStop
  Just stopPid <- resolve ref'
  kill stopPid "goodbye"
  -- wait for all the exit signals, so we know the children are restarting
  forM_ (map fst (snd $ splitAt 3 children)) $ \cRef -> do
    mRef <- monitor cRef
    waitForDown mRef
  children' <- listChildren sup
  let (notRestarted, restarted) = splitAt 3 children'
  -- another (technically) unsafe check
  let firstRestart = childKey $ snd $ last restarted
  Just (rRef, _) <- lookupChild sup firstRestart
  Just fPid <- resolve rRef
  drainChildren restarted fPid
  let [c1, c2] = [map fst cs | cs <- [(fst $ splitAt 3 children), notRestarted]]
  forM_ (zip c1 c2) $ \(p1, p2) -> p1 `shouldBe` equalTo p2

restartLeftWithRightToLeftRestarts :: ProcessId -> Process ()
restartLeftWithRightToLeftRestarts sup = do
  self <- getSelfPid
  let templ = permChild $ RunClosure ($(mkClosure 'notifyMe) self)
  let specs = [templ { childKey = (show i) } | i <- [1..20 :: Int]]
  forM_ specs $ \s -> void $ startNewChild sup s
  -- assert that we saw the startup sequence working...
  let toStart = childKey $ head specs
  Just (ref, _) <- lookupChild sup toStart
  Just pid <- resolve ref
  children <- listChildren sup
  drainChildren children pid
  let (toRestart, _) = splitAt 7 specs
  let (restarts, toSurvive) = splitAt 7 children
  let toStop = childKey $ last toRestart
  Just (ref', _) <- lookupChild sup toStop
  Just stopPid <- resolve ref'
  kill stopPid "goodbye"
  -- wait for all the exit signals, so we know the children are restarting
  forM_ (map fst restarts) $ \cRef -> do
    mRef <- monitor cRef
    waitForDown mRef
  children' <- listChildren sup
  let (restarted, notRestarted) = splitAt 7 children'
  -- another (technically) unsafe check
  let firstRestart = childKey $ snd $ last restarted
  Just (rRef, _) <- lookupChild sup firstRestart
  Just fPid <- resolve rRef
  drainChildren (reverse restarted) fPid
  let [c1, c2] = [map fst cs | cs <- [toSurvive, notRestarted]]
  forM_ (zip c1 c2) $ \(p1, p2) -> p1 `shouldBe` equalTo p2

localChildStartLinking :: TestResult Bool -> Process ()
localChildStartLinking result = do
    s1 <- toChildStart procExpect
    s2 <- toChildStart procLinkExpect
    pid <- Supervisor.start restartOne ParallelShutdown [ (tempWorker s1) { childKey = "w1" }
                                                        , (tempWorker s2) { childKey = "w2" } ]
    [(r1, _), (r2, _)] <- listChildren pid
    Just p1 <- resolve r1
    Just p2 <- resolve r2
    monitor p1
    monitor p2
    shutdownAndWait pid
    waitForChildShutdown [p1, p2]
    stash result True
  where
    procExpect :: Process ()
    procExpect = expect >>= return

    procLinkExpect :: SupervisorPid -> Process ProcessId
    procLinkExpect p = spawnLocal $ link p >> procExpect

    waitForChildShutdown []   = return ()
    waitForChildShutdown pids = do
      p <- receiveWait [
               match (\(ProcessMonitorNotification _ p _) -> return p)
             ]
      waitForChildShutdown $ filter (/= p) pids

-- remote table definition and main

myRemoteTable :: RemoteTable
myRemoteTable = Main.__remoteTable initRemoteTable

withClosure :: (ChildStart -> ProcessId -> Process ())
            -> (Closure (Process ()))
            -> ProcessId -> Process ()
withClosure fn clj supervisor = do
  cs <- toChildStart clj
  fn cs supervisor

withChan :: (ChildStart -> ProcessId -> Process ())
         -> Process ()
         -> ProcessId
         -> Process ()
withChan fn proc supervisor = do
    cs <- toChildStart proc
    fn cs supervisor

tests :: NT.Transport -> IO [Test]
tests transport = do
  putStrLn $ concat [ "NOTICE: Branch Tests (Relying on Non-Guaranteed Message Order) "
                    , "Can Fail Intermittently"]
  localNode <- newLocalNode transport myRemoteTable
  singleTestLock <- newMVar ()
  let withSupervisor = runInTestContext localNode singleTestLock
  return
    [ testGroup "Supervisor Processes"
      [
          testGroup "Starting And Adding Children"
          [
              testCase "Normal (Managed Process) Supervisor Start Stop"
                (withSupervisor restartOne [] normalStartStop)
            , testGroup "Specified By Closure"
              [
                testCase "Add Child Without Starting"
                    (withSupervisor restartOne []
                          (withClosure addChildWithoutRestart
                           $(mkStaticClosure 'blockIndefinitely)))
              , testCase "Start Previously Added Child"
                    (withSupervisor restartOne []
                          (withClosure addChildThenStart
                           $(mkStaticClosure 'blockIndefinitely)))
              , testCase "Start Unknown Child"
                    (withSupervisor restartOne []
                          (withClosure startUnknownChild
                           $(mkStaticClosure 'blockIndefinitely)))
              , testCase "Add Duplicate Child"
                    (withSupervisor restartOne []
                          (withClosure addDuplicateChild
                             $(mkStaticClosure 'blockIndefinitely)))
              , testCase "Start Duplicate Child"
                    (withSupervisor restartOne []
                          (withClosure startDuplicateChild
                             $(mkStaticClosure 'blockIndefinitely)))
              , testCase "Started Temporary Child Exits With Ignore"
                    (withSupervisor restartOne []
                          (withClosure startTemporaryChildExitsWithIgnore
                             $(mkStaticClosure 'exitIgnore)))
              , testCase "Configured Temporary Child Exits With Ignore"
                    (configuredTemporaryChildExitsWithIgnore
                     (RunClosure $(mkStaticClosure 'exitIgnore)) withSupervisor)
              , testCase "Start Bad Closure"
                    (withSupervisor restartOne []
                     (withClosure startBadClosure
                      (closure (staticLabel "non-existing") empty)))
              , testCase "Configured Bad Closure"
                    (configuredTemporaryChildExitsWithIgnore
                     (RunClosure $(mkStaticClosure 'exitIgnore)) withSupervisor)
              , testCase "Started Non-Temporary Child Exits With Ignore"
                    (withSupervisor restartOne [] $
                     (withClosure startNonTemporaryChildExitsWithIgnore
                      $(mkStaticClosure 'exitIgnore)))
              , testCase "Configured Non-Temporary Child Exits With Ignore"
                    (configuredNonTemporaryChildExitsWithIgnore
                     (RunClosure $(mkStaticClosure 'exitIgnore)) withSupervisor)
              ]
            , testGroup "Specified By Delegate/Restarter"
              [
                testCase "Add Child Without Starting (Chan)"
                  (withSupervisor restartOne []
                   (withChan addChildWithoutRestart blockIndefinitely))
              , testCase "Start Previously Added Child"
                  (withSupervisor restartOne []
                   (withChan addChildThenStart blockIndefinitely))
              , testCase "Start Unknown Child"
                  (withSupervisor restartOne []
                   (withChan startUnknownChild blockIndefinitely))
              , testCase "Add Duplicate Child (Chan)"
                  (withSupervisor restartOne []
                   (withChan addDuplicateChild blockIndefinitely))
              , testCase "Start Duplicate Child (Chan)"
                  (withSupervisor restartOne []
                   (withChan startDuplicateChild blockIndefinitely))
              , testCase "Started Temporary Child Exits With Ignore (Chan)"
                  (withSupervisor restartOne []
                   (withChan startTemporaryChildExitsWithIgnore exitIgnore))
              , testCase "Started Non-Temporary Child Exits With Ignore (Chan)"
                  (withSupervisor restartOne [] $
                   (withChan startNonTemporaryChildExitsWithIgnore exitIgnore))
              ]
          ]
        , testGroup "Stopping And Deleting Children"
          [
            testCase "Delete Existing Child Fails"
                (withSupervisor restartOne []
                    (withClosure deleteExistingChild
                                 $(mkStaticClosure 'blockIndefinitely)))
          , testCase "Delete Stopped Temporary Child (Doesn't Exist)"
                (withSupervisor restartOne []
                    (withClosure deleteStoppedTempChild
                                 $(mkStaticClosure 'blockIndefinitely)))
          , testCase "Delete Stopped Child Succeeds"
                (withSupervisor restartOne []
                    (withClosure deleteStoppedChild
                                 $(mkStaticClosure 'blockIndefinitely)))
          , testCase "Restart Minus Dropped (Temp) Child"
                (withSupervisor restartAll []
                    (withClosure restartWithoutTempChildren
                                 $(mkStaticClosure 'blockIndefinitely)))
          , testCase "Sequential Shutdown Ordering"
             (delayedAssertion
              "expected the shutdown order to hold"
              localNode (Just ()) sequentialShutdown)
          ]
        , testGroup "Stopping and Restarting Children"
          [
            testCase "Permanent Children Always Restart (Closure)"
                (withSupervisor restartOne []
                    (withClosure permanentChildrenAlwaysRestart
                                 $(mkStaticClosure 'blockIndefinitely)))
          , testCase "Permanent Children Always Restart (Chan)"
                (withSupervisor restartOne []
                    (withChan permanentChildrenAlwaysRestart blockIndefinitely))
          , testCase "Temporary Children Never Restart (Closure)"
                (withSupervisor restartOne []
                    (withClosure temporaryChildrenNeverRestart
                                 $(mkStaticClosure 'blockIndefinitely)))
          , testCase "Temporary Children Never Restart (Chan)"
                (withSupervisor restartOne []
                    (withChan temporaryChildrenNeverRestart blockIndefinitely))
          , testCase "Transient Children Do Not Restart When Exiting Normally (Closure)"
                (withSupervisor restartOne []
                    (withClosure transientChildrenNormalExit
                                 $(mkStaticClosure 'blockIndefinitely)))
          , testCase "Transient Children Do Not Restart When Exiting Normally (Chan)"
                (withSupervisor restartOne []
                    (withChan transientChildrenNormalExit blockIndefinitely))
          , testCase "Transient Children Do Restart When Exiting Abnormally (Closure)"
                (withSupervisor restartOne []
                    (withClosure transientChildrenAbnormalExit
                                 $(mkStaticClosure 'blockIndefinitely)))
          , testCase "Transient Children Do Restart When Exiting Abnormally (Chan)"
                (withSupervisor restartOne []
                    (withChan transientChildrenAbnormalExit blockIndefinitely))
          , testCase "ExitShutdown Is Considered Normal (Closure)"
                (withSupervisor restartOne []
                    (withClosure transientChildrenExitShutdown
                                 $(mkStaticClosure 'blockIndefinitely)))
          , testCase "ExitShutdown Is Considered Normal (Chan)"
                (withSupervisor restartOne []
                    (withChan transientChildrenExitShutdown blockIndefinitely))
          , testCase "Intrinsic Children Do Restart When Exiting Abnormally (Closure)"
                (withSupervisor restartOne []
                    (withClosure intrinsicChildrenAbnormalExit
                                 $(mkStaticClosure 'blockIndefinitely)))
          , testCase "Intrinsic Children Do Restart When Exiting Abnormally (Chan)"
                (withSupervisor restartOne []
                    (withChan intrinsicChildrenAbnormalExit blockIndefinitely))
          , testCase (concat [ "Intrinsic Children Cause Supervisor Exits "
                             , "When Exiting Normally (Closure)"])
                (withSupervisor restartOne []
                    (withClosure intrinsicChildrenNormalExit
                                 $(mkStaticClosure 'blockIndefinitely)))
          , testCase (concat [ "Intrinsic Children Cause Supervisor Exits "
                             , "When Exiting Normally (Chan)"])
                (withSupervisor restartOne []
                    (withChan intrinsicChildrenNormalExit blockIndefinitely))
          , testCase "Explicit Restart Of Running Child Fails (Closure)"
                (withSupervisor restartOne []
                    (withClosure explicitRestartRunningChild
                                 $(mkStaticClosure 'blockIndefinitely)))
          , testCase "Explicit Restart Of Running Child Fails (Chan)"
                (withSupervisor restartOne []
                    (withChan explicitRestartRunningChild blockIndefinitely))
          , testCase "Explicit Restart Of Unknown Child Fails"
                (withSupervisor restartOne [] explicitRestartUnknownChild)
          , testCase "Explicit Restart Whilst Child Restarting Fails (Closure)"
                (withSupervisor
                 (RestartOne (limit (maxRestarts 500000000) (milliSeconds 1))) []
                 (withClosure explicitRestartRestartingChild $(mkStaticClosure 'noOp)))
          , testCase "Explicit Restart Whilst Child Restarting Fails (Chan)"
                (withSupervisor
                 (RestartOne (limit (maxRestarts 500000000) (milliSeconds 1))) []
                 (withChan explicitRestartRestartingChild noOp))
          , testCase "Explicit Restart Stopped Child (Closure)"
                (withSupervisor restartOne []
                    (withClosure explicitRestartStoppedChild
                                 $(mkStaticClosure 'blockIndefinitely)))
          , testCase "Explicit Restart Stopped Child (Chan)"
                (withSupervisor restartOne []
                    (withChan explicitRestartStoppedChild blockIndefinitely))
          , testCase "Immediate Child Termination (Brutal Kill) (Closure)"
                (withSupervisor restartOne []
                    (withClosure terminateChildImmediately
                                 $(mkStaticClosure 'blockIndefinitely)))
          , testCase "Immediate Child Termination (Brutal Kill) (Chan)"
                (withSupervisor restartOne []
                    (withChan terminateChildImmediately blockIndefinitely))
          -- TODO: Chan tests
          , testCase "Child Termination Exceeds Timeout/Delay (Becomes Brutal Kill)"
                (withSupervisor restartOne [] terminatingChildExceedsDelay)
          , testCase "Child Termination Within Timeout/Delay"
                (withSupervisor restartOne [] terminatingChildObeysDelay)
          ]
          -- TODO: test for init failures (expecting $ ChildInitFailed r)
        , testGroup "Branch Restarts"
          [
            testGroup "Restart All"
            [
              testCase "Terminate Child Ignores Siblings"
                  (terminateChildIgnoresSiblings
                   (RunClosure $(mkStaticClosure 'blockIndefinitely))
                   withSupervisor)
            , testCase "Restart All, Left To Right (Sequential) Restarts"
                  (restartAllWithLeftToRightSeqRestarts
                   (RunClosure $(mkStaticClosure 'blockIndefinitely))
                   withSupervisor)
            , testCase "Restart All, Right To Left (Sequential) Restarts"
                  (withSupervisor
                   (RestartAll defaultLimits (RestartEach RightToLeft)) []
                    restartAllWithRightToLeftSeqRestarts)
            , testCase "Restart All, Left To Right Stop, Left To Right Start"
                  (withSupervisor
                   (RestartAll defaultLimits (RestartInOrder LeftToRight)) []
                    restartAllWithLeftToRightRestarts)
            , testCase "Restart All, Right To Left Stop, Right To Left Start"
                  (withSupervisor
                   (RestartAll defaultLimits (RestartInOrder RightToLeft)) []
                    expectRightToLeftRestarts)
            , testCase "Restart All, Left To Right Stop, Reverse Start"
                  (withSupervisor
                   (RestartAll defaultLimits (RestartRevOrder LeftToRight)) []
                    expectRightToLeftRestarts)
            , testCase "Restart All, Right To Left Stop, Reverse Start"
                  (withSupervisor
                   (RestartAll defaultLimits (RestartRevOrder RightToLeft)) []
                    expectLeftToRightRestarts)
            ],
            testGroup "Restart Left"
            [
              testCase "Restart Left, Left To Right (Sequential) Restarts"
                  (restartLeftWithLeftToRightSeqRestarts
                   (RunClosure $(mkStaticClosure 'blockIndefinitely))
                   withSupervisor)
            , testCase "Restart Left, Leftmost Child Dies"
                  (withSupervisor restartLeft [] $
                    restartLeftWhenLeftmostChildDies
                    (RunClosure $(mkStaticClosure 'blockIndefinitely)))
            , testCase "Restart Left, Left To Right Stop, Left To Right Start"
                  (withSupervisor
                   (RestartLeft defaultLimits (RestartInOrder LeftToRight)) []
                    restartLeftWithLeftToRightRestarts)
            , testCase "Restart Left, Right To Left Stop, Right To Left Start"
                  (withSupervisor
                   (RestartLeft defaultLimits (RestartInOrder RightToLeft)) []
                    restartLeftWithRightToLeftRestarts)
            , testCase "Restart Left, Left To Right Stop, Reverse Start"
                  (withSupervisor
                   (RestartLeft defaultLimits (RestartRevOrder LeftToRight)) []
                    restartLeftWithRightToLeftRestarts)
            , testCase "Restart Left, Right To Left Stop, Reverse Start"
                  (withSupervisor
                   (RestartLeft defaultLimits (RestartRevOrder RightToLeft)) []
                    restartLeftWithLeftToRightRestarts)
            ],
            testGroup "Restart Right"
            [
              testCase "Restart Right, Left To Right (Sequential) Restarts"
                  (restartRightWithLeftToRightSeqRestarts
                   (RunClosure $(mkStaticClosure 'blockIndefinitely))
                   withSupervisor)
            , testCase "Restart Right, Rightmost Child Dies"
                  (withSupervisor restartRight [] $
                    restartRightWhenRightmostChildDies
                    (RunClosure $(mkStaticClosure 'blockIndefinitely)))
            , testCase "Restart Right, Left To Right Stop, Left To Right Start"
                  (withSupervisor
                   (RestartRight defaultLimits (RestartInOrder LeftToRight)) []
                    restartRightWithLeftToRightRestarts)
            , testCase "Restart Right, Right To Left Stop, Right To Left Start"
                  (withSupervisor
                   (RestartRight defaultLimits (RestartInOrder RightToLeft)) []
                    restartRightWithRightToLeftRestarts)
            , testCase "Restart Right, Left To Right Stop, Reverse Start"
                  (withSupervisor
                   (RestartRight defaultLimits (RestartRevOrder LeftToRight)) []
                    restartRightWithRightToLeftRestarts)
            , testCase "Restart Right, Right To Left Stop, Reverse Start"
                  (withSupervisor
                   (RestartRight defaultLimits (RestartRevOrder RightToLeft)) []
                    restartRightWithLeftToRightRestarts)
            ]
            ]
        , testGroup "Restart Intensity"
          [
            testCase "Three Attempts Before Successful Restart"
                (restartAfterThreeAttempts
                 (RunClosure $(mkStaticClosure 'blockIndefinitely)) withSupervisor)
          , testCase "Permanent Child Exceeds Restart Limits"
                (permanentChildExceedsRestartsIntensity
                 (RunClosure $(mkStaticClosure 'noOp)) withSupervisor)
--          , testCase "Permanent Child Delayed Restart"
--                (delayedRestartAfterThreeAttempts withSupervisor)
          ]
        , testGroup "ToChildStart Link Setup"
          [
            testCase "Both Local Process Instances Link Appropriately"
             (delayedAssertion
              "expected the server to return the task outcome"
              localNode True localChildStartLinking)
          ]
      ]
    ]

main :: IO ()
main = testMain $ tests