Event Manager: Make one-shot a per-registration property

Summary:
Currently the event manager has a global flag for whether to create
epoll-like notifications as one-shot (e.g. EPOLLONESHOT, where an fd
will be deactivated after its first event) or standard multi-shot
notifications.

Unfortunately this means that the event manager may export either
one-shot or multi-shot semantics to the user. Even worse, the user has
no way of knowing which semantics are being delivered. This resulted in
breakage in the usb[1] library which deadlocks after notifications on
its fd are disabled after the first event is delivered.  This patch
reworks one-shot event support to allow the user to choose whether
one-shot or multi-shot semantics are desired on a per-registration
basis. The event manager can then decide whether to use a one-shot or
multi-shot epoll.

A registration is now defined by a set of Events (as before) as well as
a Lifetime (either one-shot or multi-shot). We lend monoidal structure
to Lifetime choosing OneShot as the identity. This allows us to combine
Lifetime/Event pairs of an fd to give the longest desired lifetime of
the registration and the full set of Events for which we want
notification.

[1] https://github.com/basvandijk/usb/issues/7

Test Plan: Add more test cases and validate

Reviewers: tibbe, AndreasVoellmy, hvr, austin

Reviewed By: austin

Subscribers: thomie, carter, simonmar

Differential Revision: https://phabricator.haskell.org/D347

1 files changed, 48 insertions, 0 deletions

diff --git a/libraries/base/GHC/Event/Internal.hs b/libraries/base/GHC/Event/Internal.hs
index f1bd45ebc5..c18bd7f394 100644
--- a/libraries/base/GHC/Event/Internal.hs
+++ b/libraries/base/GHC/Event/Internal.hs
@@ -16,6 +16,12 @@ module GHC.Event.Internal
     , evtWrite
     , evtClose
     , eventIs
+    -- * Lifetimes
+    , Lifetime(..)
+    , EventLifetime
+    , eventLifetime
+    , elLifetime
+    , elEvent
     -- * Timeout type
     , Timeout(..)
     -- * Helpers
@@ -77,6 +83,46 @@ evtConcat :: [Event] -> Event
 evtConcat = foldl' evtCombine evtNothing
 {-# INLINE evtConcat #-}
 
+-- | The lifetime of a registration.
+data Lifetime = OneShot | MultiShot
+              deriving (Show, Eq)
+
+-- | The longer of two lifetimes.
+elSupremum :: Lifetime -> Lifetime -> Lifetime
+elSupremum OneShot OneShot = OneShot
+elSupremum _       _       = MultiShot
+{-# INLINE elSupremum #-}
+
+instance Monoid Lifetime where
+    mempty = OneShot
+    mappend = elSupremum
+
+-- | A pair of an event and lifetime
+--
+-- Here we encode the event in the bottom three bits and the lifetime
+-- in the fourth bit.
+newtype EventLifetime = EL Int
+                      deriving (Show, Eq)
+
+instance Monoid EventLifetime where
+    mempty = EL 0
+    EL a `mappend` EL b = EL (a .|. b)
+
+eventLifetime :: Event -> Lifetime -> EventLifetime
+eventLifetime (Event e) l = EL (e .|. lifetimeBit l)
+  where
+    lifetimeBit OneShot   = 0
+    lifetimeBit MultiShot = 8
+{-# INLINE eventLifetime #-}
+
+elLifetime :: EventLifetime -> Lifetime
+elLifetime (EL x) = if x .&. 8 == 0 then OneShot else MultiShot
+{-# INLINE elLifetime #-}
+
+elEvent :: EventLifetime -> Event
+elEvent (EL x) = Event (x .&. 0x7)
+{-# INLINE elEvent #-}
+
 -- | A type alias for timeouts, specified in seconds.
 data Timeout = Timeout {-# UNPACK #-} !Double
              | Forever
@@ -101,6 +147,8 @@ data Backend = forall a. Backend {
                   -> Event    -- new events to watch for ('mempty' to delete)
                   -> IO Bool
 
+    -- | Register interest in new events on a given file descriptor, set
+    -- to be deactivated after the first event.
     , _beModifyFdOnce :: a
                          -> Fd    -- file descriptor
                          -> Event -- new events to watch