From d958dba1f707614e8d3c75596ba0a080835871ff Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Fri, 7 Apr 2023 16:56:12 +0200 Subject: [PATCH 1/3] io-sim: make singleTimeoutExperiment more robust. Make singleTimeoutExperiment as robust as the original in network-mux --- io-sim/test/Test/Control/Monad/IOSim.hs | 103 +++++++++++++++++---- io-sim/test/Test/Control/Monad/IOSimPOR.hs | 20 +++- 2 files changed, 100 insertions(+), 23 deletions(-) diff --git a/io-sim/test/Test/Control/Monad/IOSim.hs b/io-sim/test/Test/Control/Monad/IOSim.hs index 1eac22cc..68c7cc51 100644 --- a/io-sim/test/Test/Control/Monad/IOSim.hs +++ b/io-sim/test/Test/Control/Monad/IOSim.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE RankNTypes #-} @@ -11,6 +12,10 @@ module Test.Control.Monad.IOSim ( tests , TestThreadGraph (..) -- * Timeout tests + , WithSanityCheck (..) + , withSanityCheck + , ignoreSanityCheck + , isSanityCheckIgnored , TimeoutConstraints , TimeoutDuration , ActionDuration @@ -47,7 +52,6 @@ import Test.Tasty.QuickCheck import GHC.Conc (ThreadStatus(..)) - tests :: TestTree tests = testGroup "IO simulator" @@ -1033,6 +1037,8 @@ type TimeoutConstraints m = , MonadTimer m , MonadMask m , MonadThrow (STM m) + , MonadSay m + , MonadMaskingState m ) instance Arbitrary DiffTime where @@ -1053,7 +1059,7 @@ singleTimeoutExperiment :: TimeoutConstraints m => TimeoutDuration -> ActionDuration - -> m Property + -> m (WithSanityCheck Property) singleTimeoutExperiment intendedTimeoutDuration intendedActionDuration = do @@ -1062,6 +1068,7 @@ singleTimeoutExperiment intendedTimeoutDuration -- Allow the action to run for intendedTimeoutDuration result <- timeout intendedTimeoutDuration $ do + getMaskingState >>= say . show -- Simulate an action that should take intendedActionDuration threadDelay intendedActionDuration @@ -1074,12 +1081,33 @@ singleTimeoutExperiment intendedTimeoutDuration intendedActionDuration before after result +data WithSanityCheck prop + = WithSanityCheck prop + + -- | The first one represents the property without sanity check, the other one + -- sanity check (which failed). It is kept to keep its `counterexample`s. + | WithSanityCheckFailure prop prop + deriving (Functor) + +ignoreSanityCheck :: WithSanityCheck prop -> prop +ignoreSanityCheck (WithSanityCheck prop) = prop +ignoreSanityCheck (WithSanityCheckFailure prop _) = prop + +withSanityCheck :: WithSanityCheck Property -> Property +withSanityCheck (WithSanityCheck prop) = prop +withSanityCheck (WithSanityCheckFailure prop sanityCheck) = prop .&&. sanityCheck + +isSanityCheckIgnored :: WithSanityCheck prop -> Bool +isSanityCheckIgnored WithSanityCheck{} = False +isSanityCheckIgnored WithSanityCheckFailure {} = True + + experimentResult :: TimeoutDuration -> ActionDuration -> Time -> Time -> Maybe Time - -> Property + -> WithSanityCheck Property experimentResult intendedTimeoutDuration intendedActionDuration before after result = @@ -1087,29 +1115,46 @@ experimentResult intendedTimeoutDuration [ "intendedTimeoutDuration: " ++ show intendedTimeoutDuration , "intendedActionDuration: " ++ show intendedActionDuration , "actualOverallDuration: " ++ show actualOverallDuration - ] $ timeoutCheck + ] <$> + if ignoredSanityCheck + then WithSanityCheckFailure timeoutCheck sanityCheck + else WithSanityCheck $ sanityCheck .&&. timeoutCheck where actualOverallDuration = diffTime after before + intendedOverallDuration = min intendedTimeoutDuration intendedActionDuration + + ignoredSanityCheck = + actualOverallDuration < intendedOverallDuration + || actualOverallDuration > intendedOverallDuration + + sanityCheck = counterexample "sanityCheckLow" sanityCheckLow + .&&. counterexample "sanityCheckHigh" sanityCheckHigh + + sanityCheckLow = + actualOverallDuration >= intendedOverallDuration + + sanityCheckHigh = + actualOverallDuration <= intendedOverallDuration timeoutCheck = case result of Nothing -> counterexamples - [ "timeout fired" + [ "timeout fired (but should not have)" , "violation of timeout property:\n" ++ - " actualOverallDuration == intendedTimeoutDuration" + " actualOverallDuration >= intendedTimeoutDuration" ] $ - actualOverallDuration === intendedTimeoutDuration + actualOverallDuration >= intendedTimeoutDuration Just afterAction -> let actualActionDuration = diffTime afterAction before in counterexamples [ "actualActionDuration: " ++ show actualActionDuration - , "timeout did not fire" + , "timeout did not fire (but should not have)" , "violation of timeout property:\n" ++ - " actualActionDuration == intendedTimeoutDuration" + " actualActionDuration <= intendedTimeoutDuration" ] $ - actualActionDuration === intendedActionDuration + actualActionDuration <= intendedActionDuration prop_timeout @@ -1117,19 +1162,39 @@ prop_timeout -> ActionDuration -> Property prop_timeout intendedTimeoutDuration intendedActionDuration = - runSimOrThrow (singleTimeoutExperiment intendedTimeoutDuration intendedActionDuration) + runSimOrThrow (withSanityCheck <$> + singleTimeoutExperiment + intendedTimeoutDuration + intendedActionDuration) + prop_timeouts :: [(TimeoutDuration, ActionDuration)] -> Property -prop_timeouts times = runSimOrThrow $ - conjoin <$> - sequence - [ counterexample ("failure on timeout test #" ++ show n) - <$> singleTimeoutExperiment intendedTimeoutDuration - intendedActionDuration - | ((intendedTimeoutDuration, - intendedActionDuration), n) <- zip times [1 :: Int ..] ] +prop_timeouts times = + counterexample (ppTrace_ trace) $ + either (\e -> counterexample (show e) False) id $ + traceResult False trace + where + trace = + runSimTrace $ + conjoin' <$> + sequence + [ fmap (counterexample ("failure on timeout test #" ++ show n)) + <$> singleTimeoutExperiment intendedTimeoutDuration + intendedActionDuration + | ((intendedTimeoutDuration, + intendedActionDuration), n) <- zip times [1 :: Int ..] ] + + maxFailures = 0 + + conjoin' :: [WithSanityCheck Property] -> Property + conjoin' props = + conjoin (ignoreSanityCheck `map` props) + .&&. let numFailures = length (filter isSanityCheckIgnored props) + in counterexample + ("too many failures: " ++ show numFailures ++ " ≰ " ++ show maxFailures) + (numFailures <= maxFailures) -- -- MonadMask properties diff --git a/io-sim/test/Test/Control/Monad/IOSimPOR.hs b/io-sim/test/Test/Control/Monad/IOSimPOR.hs index e6ea2620..f2c65fc3 100644 --- a/io-sim/test/Test/Control/Monad/IOSimPOR.hs +++ b/io-sim/test/Test/Control/Monad/IOSimPOR.hs @@ -38,7 +38,9 @@ import Control.Monad.IOSim import GHC.Generics import Test.Control.Monad.IOSim (TimeoutDuration, ActionDuration, - singleTimeoutExperiment) + WithSanityCheck (..), ignoreSanityCheck, + isSanityCheckIgnored, singleTimeoutExperiment, + withSanityCheck) import Test.Control.Monad.Utils import Test.Control.Monad.STM @@ -855,7 +857,7 @@ prop_timeout intendedTimeoutDuration intendedActionDuration = experiment :: IOSim s Property experiment = do exploreRaces - singleTimeoutExperiment intendedTimeoutDuration intendedActionDuration + withSanityCheck <$> singleTimeoutExperiment intendedTimeoutDuration intendedActionDuration prop_timeouts :: [(TimeoutDuration, ActionDuration)] @@ -868,14 +870,24 @@ prop_timeouts times = exploreSimTrace id experiment $ \_ trace -> experiment :: IOSim s Property experiment = do exploreRaces - conjoin <$> + conjoin' <$> sequence - [ counterexample ("failure on timeout test #" ++ show n) + [ fmap (counterexample ("failure on timeout test #" ++ show n)) <$> singleTimeoutExperiment intendedTimeoutDuration intendedActionDuration | ((intendedTimeoutDuration, intendedActionDuration), n) <- zip times [1 :: Int ..] ] + maxFailures = 0 + + conjoin' :: [WithSanityCheck Property] -> Property + conjoin' props = + conjoin (ignoreSanityCheck `map` props) + .&&. let numFailures = length (filter isSanityCheckIgnored props) + in counterexample + ("too many failures: " ++ show numFailures ++ " ≰ " ++ show maxFailures) + (numFailures <= maxFailures) + -- -- MonadMask properties -- From 7aa939d14b0fb26ca4ab88b6f5e12486fdf8fc74 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Fri, 7 Apr 2023 16:57:07 +0200 Subject: [PATCH 2/3] io-sim: unmask exceptions after killing timeout assassin thread --- io-sim/src/Control/Monad/IOSim/Internal.hs | 10 +++++----- io-sim/src/Control/Monad/IOSimPOR/Internal.hs | 8 ++++---- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/io-sim/src/Control/Monad/IOSim/Internal.hs b/io-sim/src/Control/Monad/IOSim/Internal.hs index 2ed624c5..4313ce36 100644 --- a/io-sim/src/Control/Monad/IOSim/Internal.hs +++ b/io-sim/src/Control/Monad/IOSim/Internal.hs @@ -257,14 +257,14 @@ schedule !thread@Thread{ locked <- readSTRef isLockedRef case locked of Locked etid -> do - let -- Kill the assassin throwing thread and carry on the - -- continuation + let -- Kill the assassin throwing thread then unmask exceptions and + -- carry on the continuation thread' = thread { threadControl = ThreadControl (ThrowTo (toException ThreadKilled) etid - (k (Just x))) - ctl' + (Return ())) + (MaskFrame (\_ -> k (Just x)) maskst ctl') , threadMasking = MaskedUninterruptible } schedule thread' simstate @@ -939,7 +939,7 @@ unblockThreads !wakeup !simstate@SimState {runqueue, threads} = -- receive a 'ThreadKilled' exception. -- forkTimeoutInterruptThreads :: forall s a. - [(ThreadId, TimeoutId, STRef s IsLocked, IsLocked)] + [(ThreadId, TimeoutId, STRef s IsLocked, IsLocked)] -> SimState s a -> ST s (SimState s a) forkTimeoutInterruptThreads timeoutExpired simState@SimState {threads} = diff --git a/io-sim/src/Control/Monad/IOSimPOR/Internal.hs b/io-sim/src/Control/Monad/IOSimPOR/Internal.hs index c735cf30..7ace2d5a 100644 --- a/io-sim/src/Control/Monad/IOSimPOR/Internal.hs +++ b/io-sim/src/Control/Monad/IOSimPOR/Internal.hs @@ -363,14 +363,14 @@ schedule thread@Thread{ locked <- readSTRef isLockedRef case locked of Locked etid -> do - let -- Kill the exception throwing thread and carry on the - -- continuation + let -- Kill the assassin throwing thread then unmask exceptions and + -- carry on the continuation thread' = thread { threadControl = ThreadControl (ThrowTo (toException ThreadKilled) etid - (k (Just x))) - ctl' + (Return ())) + (MaskFrame (\_ -> k (Just x)) maskst ctl') , threadMasking = MaskedUninterruptible } schedule thread' simstate From eefb53f0c79d2175eb6bb74053bcd7f22cd79588 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Fri, 7 Apr 2023 18:04:16 +0200 Subject: [PATCH 3/3] io-sim: make sure we use unique thread ids If one stacks multiple `timeouts` in the same thread we could end up with multiple threads with the same `ThreadId`. --- io-sim/src/Control/Monad/IOSim/Internal.hs | 73 +++++++-------- io-sim/src/Control/Monad/IOSimPOR/Internal.hs | 89 ++++++++++--------- io-sim/test/Test/Control/Monad/IOSim.hs | 27 ++++++ io-sim/test/Test/Control/Monad/IOSimPOR.hs | 33 +++++++ 4 files changed, 143 insertions(+), 79 deletions(-) diff --git a/io-sim/src/Control/Monad/IOSim/Internal.hs b/io-sim/src/Control/Monad/IOSim/Internal.hs index 4313ce36..520c28d9 100644 --- a/io-sim/src/Control/Monad/IOSim/Internal.hs +++ b/io-sim/src/Control/Monad/IOSim/Internal.hs @@ -942,58 +942,60 @@ forkTimeoutInterruptThreads :: forall s a. [(ThreadId, TimeoutId, STRef s IsLocked, IsLocked)] -> SimState s a -> ST s (SimState s a) -forkTimeoutInterruptThreads timeoutExpired simState@SimState {threads} = +forkTimeoutInterruptThreads timeoutExpired simState = foldlM (\st@SimState{ runqueue = runqueue, threads = threads' } - (t0, t1, isLockedRef) + (t, isLockedRef) -> do - let threads'' = Map.insert (threadId t0) t0 - . Map.insert (threadId t1) t1 + let threads'' = Map.insert (threadId t) t $ threads' - runqueue' = Deque.snoc (threadId t1) runqueue + runqueue' = Deque.snoc (threadId t) runqueue - writeSTRef isLockedRef (Locked (threadId t1)) + writeSTRef isLockedRef (Locked (threadId t)) return st { runqueue = runqueue', threads = threads'' }) - simState + simState' throwToThread where -- can only throw exception if the thread exists and if the mutually -- exclusive lock exists and is still 'NotLocked' - toThrow = [ (tid, tmid, ref, t) - | (tid, tmid, ref, locked) <- timeoutExpired - , Just t <- [Map.lookup tid threads] - , NotLocked <- [locked] - ] + toThrow :: [(ThreadId, TimeoutId, STRef s IsLocked)] + toThrow = [ (tid, tmid, ref) + | (tid, tmid, ref, NotLocked) <- timeoutExpired ] + -- we launch a thread responsible for throwing an AsyncCancelled exception -- to the thread which timeout expired - throwToThread :: [(Thread s a, Thread s a, STRef s IsLocked)] - throwToThread = - [ let nextId = threadNextTId t - tid' = childThreadId tid nextId - in ( t { threadNextTId = succ nextId } - , Thread { threadId = tid', - threadControl = - ThreadControl - (ThrowTo (toException (TimeoutException tmid)) - tid - (Return ())) - ForkFrame, - threadBlocked = False, - threadMasking = Unmasked, - threadThrowTo = [], - threadClockId = threadClockId t, - threadLabel = Just "timeout-forked-thread", - threadNextTId = 1 - } - , ref ) - | (tid, tmid, ref, t) <- toThrow - ] + throwToThread :: [(Thread s a, STRef s IsLocked)] + (simState', throwToThread) = List.mapAccumR fn simState toThrow + where + fn :: SimState s a + -> (ThreadId, TimeoutId, STRef s IsLocked) + -> (SimState s a, (Thread s a, STRef s IsLocked)) + fn state@SimState { threads } (tid, tmid, ref) = + let t = threads Map.! tid + nextId = threadNextTId t + in ( state { threads = Map.insert tid t { threadNextTId = succ nextId } threads } + , ( Thread { threadId = childThreadId tid nextId, + threadControl = + ThreadControl + (ThrowTo (toException (TimeoutException tmid)) + tid + (Return ())) + ForkFrame, + threadBlocked = False, + threadMasking = Unmasked, + threadThrowTo = [], + threadClockId = threadClockId t, + threadLabel = Just "timeout-forked-thread", + threadNextTId = 1 + } + , ref ) + ) -- | Iterate through the control stack to find an enclosing exception handler -- of the right type, or unwind all the way to the top level for the thread. @@ -1040,8 +1042,7 @@ unwindControlStack e thread = unwind maskst (TimeoutFrame tmid _ k ctl) = case fromException e of -- Exception came from timeout expiring - Just (TimeoutException tmid') -> - assert (tmid == tmid') + Just (TimeoutException tmid') | tmid == tmid' -> Right thread { threadControl = ThreadControl (k Nothing) ctl } -- Exception came from a different exception _ -> unwind maskst ctl diff --git a/io-sim/src/Control/Monad/IOSimPOR/Internal.hs b/io-sim/src/Control/Monad/IOSimPOR/Internal.hs index 7ace2d5a..52c6280f 100644 --- a/io-sim/src/Control/Monad/IOSimPOR/Internal.hs +++ b/io-sim/src/Control/Monad/IOSimPOR/Internal.hs @@ -1165,62 +1165,66 @@ forkTimeoutInterruptThreads :: forall s a. [(ThreadId, TimeoutId, STRef s IsLocked, IsLocked)] -> SimState s a -> ST s (SimState s a) -forkTimeoutInterruptThreads timeoutExpired simState@SimState {threads} = +forkTimeoutInterruptThreads timeoutExpired simState = foldlM (\st@SimState{ runqueue = runqueue, threads = threads' } - (t0, t1, isLockedRef) + (t, isLockedRef) -> do - let threads'' = Map.insert (threadId t0) t0 - . Map.insert (threadId t1) t1 + let threads'' = Map.insert (threadId t) t $ threads' - runqueue' = insertThread t1 runqueue - writeSTRef isLockedRef (Locked (threadId t1)) + runqueue' = insertThread t runqueue + writeSTRef isLockedRef (Locked (threadId t)) return st { runqueue = runqueue', threads = threads'' }) - simState + simState' throwToThread where -- can only throw exception if the thread exists and if the mutually -- exclusive lock exists and is still 'NotLocked' - toThrow = [ (tid, tmid, ref, t) - | (tid, tmid, ref, locked) <- timeoutExpired - , Just t <- [Map.lookup tid threads] - , NotLocked <- [locked] - ] + toThrow :: [(ThreadId, TimeoutId, STRef s IsLocked)] + toThrow = [ (tid, tmid, ref) + | (tid, tmid, ref, NotLocked) <- timeoutExpired ] + -- we launch a thread responsible for throwing an AsyncCancelled exception -- to the thread which timeout expired - throwToThread :: [(Thread s a, Thread s a, STRef s IsLocked)] - throwToThread = - [ let nextId = threadNextTId t - tid' = childThreadId tid nextId - in ( t { threadNextTId = nextId + 1 } - , Thread { threadId = tid', - threadControl = - ThreadControl - (ThrowTo (toException (TimeoutException tmid)) - tid - (Return ())) - ForkFrame, - threadBlocked = False, - threadDone = False, - threadMasking = Unmasked, - threadThrowTo = [], - threadClockId = threadClockId t, - threadLabel = Just "timeout-forked-thread", - threadNextTId = 1, - threadStep = 0, - threadVClock = insertVClock tid' 0 - $ threadVClock t, - threadEffect = mempty, - threadRacy = threadRacy t - } - , ref) - | (tid, tmid, ref, t) <- toThrow - ] + throwToThread :: [(Thread s a, STRef s IsLocked)] + (simState', throwToThread) = List.mapAccumR fn simState toThrow + where + fn :: SimState s a + -> (ThreadId, TimeoutId, STRef s IsLocked) + -> (SimState s a, (Thread s a, STRef s IsLocked)) + fn state@SimState { threads } (tid, tmid, ref) = + let t = threads Map.! tid + nextId = threadNextTId t + tid' = childThreadId tid nextId + in ( state { threads = Map.insert tid t { threadNextTId = succ nextId } threads } + , ( Thread { threadId = tid', + threadControl = + ThreadControl + (ThrowTo (toException (TimeoutException tmid)) + tid + (Return ())) + ForkFrame, + threadBlocked = False, + threadDone = False, + threadMasking = Unmasked, + threadThrowTo = [], + threadClockId = threadClockId t, + threadLabel = Just "timeout-forked-thread", + threadNextTId = 1, + threadStep = 0, + threadVClock = insertVClock tid' 0 + $ threadVClock t, + threadEffect = mempty, + threadRacy = threadRacy t + } + , ref ) + ) + -- | Iterate through the control stack to find an enclosing exception handler -- of the right type, or unwind all the way to the top level for the thread. @@ -1267,10 +1271,9 @@ unwindControlStack e thread = unwind maskst (TimeoutFrame tmid isLockedRef k ctl) = case fromException e of -- Exception came from timeout expiring - Just (TimeoutException tmid') -> - assert (tmid == tmid') + Just (TimeoutException tmid') | tmid == tmid' -> Right thread { threadControl = ThreadControl (k Nothing) ctl } - -- Exception came from a different exception + -- Exception came from a different exception _ -> unwind maskst ctl atLeastInterruptibleMask :: MaskingState -> MaskingState diff --git a/io-sim/test/Test/Control/Monad/IOSim.hs b/io-sim/test/Test/Control/Monad/IOSim.hs index 68c7cc51..45c5df24 100644 --- a/io-sim/test/Test/Control/Monad/IOSim.hs +++ b/io-sim/test/Test/Control/Monad/IOSim.hs @@ -66,6 +66,7 @@ tests = prop_timeout_no_deadlock_IO , testProperty "prop_timeout" prop_timeout , testProperty "prop_timeouts" prop_timeouts + , testProperty "prop_stacked_timeouts" prop_stacked_timeouts , testProperty "threadId order (IOSim)" (withMaxSuccess 1000 prop_threadId_order_order_Sim) , testProperty "forkIO order (IOSim)" (withMaxSuccess 1000 prop_fork_order_ST) , testProperty "order (IO)" (expectFailure prop_fork_order_IO) @@ -1196,6 +1197,32 @@ prop_timeouts times = ("too many failures: " ++ show numFailures ++ " ≰ " ++ show maxFailures) (numFailures <= maxFailures) + +prop_stacked_timeouts :: TimeoutDuration + -> TimeoutDuration + -> ActionDuration + -> Property +prop_stacked_timeouts timeout0 timeout1 actionDuration = + runSimOrThrow experiment === predicted + where + experiment :: IOSim s (Maybe (Maybe ())) + experiment = timeout timeout0 (timeout timeout1 (threadDelay actionDuration)) + + predicted | timeout0 == 0 + = Nothing + + | timeout1 == 0 + = Just Nothing + + | actionDuration <= min timeout0 timeout1 + = Just (Just ()) + + | timeout0 < timeout1 + = Nothing + + | otherwise -- i.e. timeout0 >= timeout1 + = Just Nothing + -- -- MonadMask properties -- diff --git a/io-sim/test/Test/Control/Monad/IOSimPOR.hs b/io-sim/test/Test/Control/Monad/IOSimPOR.hs index f2c65fc3..dd1af78c 100644 --- a/io-sim/test/Test/Control/Monad/IOSimPOR.hs +++ b/io-sim/test/Test/Control/Monad/IOSimPOR.hs @@ -61,6 +61,7 @@ tests = prop_timeout_no_deadlock_Sim , testProperty "prop_timeout" prop_timeout , testProperty "prop_timeouts" prop_timeouts + , testProperty "prop_stacked_timeouts" prop_stacked_timeouts , testProperty "threadId order (IOSim)" (withMaxSuccess 1000 prop_threadId_order_order_Sim) , testProperty "forkIO order (IOSim)" (withMaxSuccess 1000 prop_fork_order_ST) , testGroup "throw/catch unit tests" @@ -888,6 +889,38 @@ prop_timeouts times = exploreSimTrace id experiment $ \_ trace -> ("too many failures: " ++ show numFailures ++ " ≰ " ++ show maxFailures) (numFailures <= maxFailures) + +prop_stacked_timeouts :: DiffTime + -> DiffTime + -> DiffTime + -> Property +prop_stacked_timeouts timeout0 timeout1 actionDuration = + exploreSimTrace id experiment $ \_ trace -> + case traceResult False trace of + Right result -> result === predicted + Left e -> counterexample (show e) False + where + experiment :: IOSim s (Maybe (Maybe ())) + experiment = exploreRaces + >> timeout timeout0 (timeout timeout1 (threadDelay actionDuration)) + + predicted | timeout0 == 0 + = Nothing + + | timeout1 == 0 + = Just Nothing + + -- This differs from `IOSim` case; `IOSimPOR` is using + -- different scheduler. + | actionDuration < min timeout0 timeout1 + = Just (Just ()) + + | timeout0 < timeout1 + = Nothing + + | otherwise -- i.e. timeout0 >= timeout1 + = Just Nothing + -- -- MonadMask properties --