diff --git a/Control/Concurrent/STM/Delay.hs b/Control/Concurrent/STM/Delay.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/STM/Delay.hs
@@ -0,0 +1,217 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE Rank2Types #-}
+-- |
+-- Module:      Control.Concurrent.STM.Delay
+-- Copyright:   (c) Joseph Adams 2012
+-- License:     BSD3
+-- Maintainer:  joeyadams3.14159@gmail.com
+-- Portability: Requires GHC 7+
+--
+-- One-shot timer whose duration can be updated
+--
+-- Suppose you are managing a network connection, and want to time it out if no
+-- messages are received in over five minutes.  You can do something like this:
+--
+-- >import Control.Concurrent.Async (race_) -- from the async package
+-- >import Control.Concurrent.STM
+-- >import Control.Concurrent.STM.Delay
+-- >import Control.Exception
+-- >import Control.Monad
+-- >
+-- >manageConnection :: Connection -> IO Message -> (Message -> IO a) -> IO ()
+-- >manageConnection conn toSend onRecv =
+-- >    bracket (newDelay five_minutes) cancelDelay $ \delay ->
+-- >    foldr1 race_
+-- >        [ do atomically $ waitDelay delay
+-- >             fail "Connection timed out"
+-- >        , forever $ toSend >>= send conn
+-- >        , forever $ do
+-- >            msg <- recv conn
+-- >            updateDelay delay five_minutes
+-- >            onRecv msg
+-- >        ]
+-- >  where
+-- >    five_minutes = 5 * 60 * 1000000
+module Control.Concurrent.STM.Delay (
+    -- * Managing delays
+    Delay,
+    newDelay,
+    updateDelay,
+    cancelDelay,
+
+    -- * Waiting for expiration
+    waitDelay,
+    tryWaitDelay,
+) where
+
+import Control.Applicative      ((<$>))
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Exception        (mask_)
+import Control.Monad            (join)
+
+#if MIN_VERSION_base(4,4,0) && !mingw32_HOST_OS
+import qualified GHC.Event as Ev
+#endif
+
+-- | A 'Delay' is an updatable timer that rings only once.
+data Delay = forall k.
+             Delay !(TVar Bool)
+                   !(DelayImpl k)
+                   !k
+
+instance Eq Delay where
+    (==) (Delay a _ _) (Delay b _ _) = a == b
+
+type TimeoutCallback = IO ()
+
+data DelayImpl k = DelayImpl
+    { delayStart  :: Int -> TimeoutCallback -> IO k
+    , delayUpdate :: TimeoutCallback -> k -> Int -> IO ()
+    , delayStop   :: k -> IO ()
+    }
+
+-- | Create a new 'Delay' that will ring in the given number of microseconds.
+newDelay :: Int -> IO Delay
+newDelay t = getDelayImpl (\impl -> newDelayWith impl t)
+
+newDelayWith :: DelayImpl k -> Int -> IO Delay
+newDelayWith impl t = do
+    var <- newTVarIO False
+    k   <- delayStart impl t $ atomically $ writeTVar var True
+    return (Delay var impl k)
+
+-- | Set an existing 'Delay' to ring in the given number of microseconds
+-- (from the time 'updateDelay' is called), rather than when it was going to
+-- ring.  If the 'Delay' has already rung, do nothing.
+updateDelay :: Delay -> Int -> IO ()
+updateDelay (Delay var impl k) t =
+    delayUpdate impl (atomically $ writeTVar var True) k t
+
+-- | Set a 'Delay' so it will never ring, even if 'updateDelay' is used later.
+-- If the 'Delay' has already rung, do nothing.
+cancelDelay :: Delay -> IO ()
+cancelDelay (Delay _var impl k) =
+    delayStop impl k
+
+-- | Block until the 'Delay' rings.  If the 'Delay' has already rung,
+-- return immediately.
+waitDelay :: Delay -> STM ()
+waitDelay delay = do
+    expired <- tryWaitDelay delay
+    if expired then return ()
+               else retry
+
+-- | Non-blocking version of 'waitDelay'.
+-- Return 'True' if the 'Delay' has rung.
+tryWaitDelay :: Delay -> STM Bool
+tryWaitDelay (Delay v _ _) = readTVar v
+
+------------------------------------------------------------------------
+-- Drivers
+
+getDelayImpl :: (forall k. DelayImpl k -> IO r) -> IO r
+#if MIN_VERSION_base(4,4,0) && !mingw32_HOST_OS
+getDelayImpl cont = do
+    m <- Ev.getSystemEventManager
+    case m of
+        Nothing  -> cont implThread
+        Just mgr -> cont (implEvent mgr)
+#else
+getDelayImpl cont = cont implThread
+#endif
+
+#if MIN_VERSION_base(4,4,0) && !mingw32_HOST_OS
+-- | Use the timeout API in "GHC.Event"
+implEvent :: Ev.EventManager -> DelayImpl Ev.TimeoutKey
+implEvent mgr = DelayImpl
+    { delayStart  = Ev.registerTimeout mgr
+    , delayUpdate = \_ -> Ev.updateTimeout mgr
+    , delayStop   = Ev.unregisterTimeout mgr
+    }
+#endif
+
+-- | Use threads and threadDelay:
+--
+--  [delayStart] Fork a thread to wait the given length of time,
+--               then set the TVar.
+--
+--  [delayUpdate] Stop the existing thread and fork a new thread.
+--
+--  [delayStop] Stop the existing thread.
+implThread :: DelayImpl (MVar (Maybe TimeoutThread))
+implThread = DelayImpl
+    { delayStart  = \t io -> forkTimeoutThread t io >>= newMVar . Just
+    , delayUpdate = \io mv t -> replaceThread (Just <$> forkTimeoutThread t io) mv
+    , delayStop   = replaceThread (return Nothing)
+    }
+  where
+    replaceThread new mv =
+        join $ mask_ $ do
+            m <- takeMVar mv
+            case m of
+                Nothing -> do
+                    -- Don't create a new timer thread after the 'Delay' has
+                    -- been canceled.  Otherwise, the behavior is inconsistent
+                    -- with GHC.Event.
+                    putMVar mv Nothing
+                    return (return ())
+                Just tt -> do
+                    m' <- stopTimeoutThread tt
+                    new >>= putMVar mv
+                    return $ case m' of
+                        Nothing   -> return ()
+                        Just kill -> kill
+
+------------------------------------------------------------------------
+-- TimeoutThread
+
+data TimeoutThread = TimeoutThread !ThreadId !(MVar ())
+
+-- instance Eq TimeoutThread where
+--     (==) (TimeoutThread a _) (TimeoutThread b _) = a == b
+-- instance Ord TimeoutThread where
+--     compare (TimeoutThread a _) (TimeoutThread b _) = compare a b
+
+-- | Fork a thread to perform an action after the given number of
+-- microseconds.
+--
+-- 'forkTimeoutThread' is non-interruptible.
+forkTimeoutThread :: Int -> IO () -> IO TimeoutThread
+forkTimeoutThread t io = do
+    mv <- newMVar ()
+    tid <- compat_forkIOUnmasked $ do
+        threadDelay t
+        m <- tryTakeMVar mv
+        -- If m is Just, this thread will not be interrupted,
+        -- so no need for a 'mask' between the tryTakeMVar and the action.
+        case m of
+            Nothing -> return ()
+            Just _  -> io
+    return (TimeoutThread tid mv)
+
+-- | Prevent the 'TimeoutThread' from performing its action.  If it's too late,
+-- return 'Nothing'.  Otherwise, return an action (namely, 'killThread') for
+-- cleaning up the underlying thread.
+--
+-- 'stopTimeoutThread' has a nice property: it is /non-interruptible/.
+-- This means that, in an exception 'mask', it will not poll for exceptions.
+-- See "Control.Exception" for more info.
+--
+-- However, the action returned by 'stopTimeoutThread' /does/ poll for
+-- exceptions.  That's why 'stopTimeoutThread' returns this action rather than
+-- simply doing it.  This lets the caller do it outside of a critical section.
+stopTimeoutThread :: TimeoutThread -> IO (Maybe (IO ()))
+stopTimeoutThread (TimeoutThread tid mv) =
+    maybe Nothing (\_ -> Just (killThread tid)) <$> tryTakeMVar mv
+
+------------------------------------------------------------------------
+-- Compatibility
+
+compat_forkIOUnmasked :: IO () -> IO ThreadId
+#if MIN_VERSION_base(4,4,0)
+compat_forkIOUnmasked io = forkIOWithUnmask (\_ -> io)
+#else
+compat_forkIOUnmasked = forkIOUnmasked
+#endif
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2012, Joseph Adams
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Joseph Adams nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/stm-delay.cabal b/stm-delay.cabal
new file mode 100644
--- /dev/null
+++ b/stm-delay.cabal
@@ -0,0 +1,76 @@
+name:               stm-delay
+version:            0.1
+synopsis:           Updatable one-shot timer polled with STM
+description:
+    This library lets you create a one-shot timer, poll it using STM,
+    and update it to ring at a different time than initially specified.
+    .
+    It uses GHC event manager timeouts when available (GHC 7.2+, @-threaded@,
+    non-Windows OS), yielding performance similar to @threadDelay@ and
+    @registerDelay@.  Otherwise, it falls back to forked threads and
+    @threadDelay@.
+homepage:           https://github.com/joeyadams/haskell-stm-delay
+license:            BSD3
+license-file:       LICENSE
+author:             Joey Adams
+maintainer:         joeyadams3.14159@gmail.com
+copyright:          Copyright (c) Joseph Adams 2012
+category:           System
+build-type:         Simple
+cabal-version:      >= 1.8
+
+source-repository head
+    type:       git
+    location:   git://github.com/joeyadams/haskell-stm-delay.git
+
+library
+    exposed-modules:
+        Control.Concurrent.STM.Delay
+
+    ghc-options: -Wall -fwarn-tabs
+
+    build-depends: base >= 4.3 && < 5
+                 , stm
+
+    -- Need base >= 4.3 for:
+    --
+    --  * Control.Exception.mask
+    --
+    --  * forkIOUnmasked
+    --
+    --  * A threadDelay that doesn't give (-1) magic treatment.
+    --    See http://hackage.haskell.org/trac/ghc/ticket/2892
+    --
+    --  * GHC.Event (called System.Event in base 4.3)
+
+test-suite test
+    type: exitcode-stdio-1.0
+
+    hs-source-dirs: test
+    main-is: Main.hs
+
+    ghc-options: -Wall
+                 -fno-warn-missing-signatures
+                 -fno-warn-name-shadowing
+                 -fno-warn-unused-do-bind
+                 -fno-warn-unused-matches
+
+    build-depends: base >= 4.3 && < 5
+                 , stm
+                 , stm-delay
+
+test-suite test-threaded
+    type: exitcode-stdio-1.0
+
+    hs-source-dirs: test
+    main-is: Main.hs
+
+    ghc-options: -Wall -threaded
+                 -fno-warn-missing-signatures
+                 -fno-warn-name-shadowing
+                 -fno-warn-unused-do-bind
+                 -fno-warn-unused-matches
+
+    build-depends: base >= 4.3 && < 5
+                 , stm
+                 , stm-delay
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE CPP #-}
+
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Concurrent.STM.Delay
+
+main = trivial
+
+trivial = do
+    let new t = do
+            delay <- newDelay t
+            return (delay, atomically $ tryWaitDelay delay)
+
+    -- The delay times out at the right time, and after tryWaitDelay returns
+    -- 'True', 'updateDelay' and 'cancelDelay' have no observable effect.
+    (delay, wait) <- new 100000
+    False <- wait
+    threadDelay 50000
+    False <- wait
+    threadDelay 60000
+    True <- wait
+    updateDelay delay 1000000
+    True <- wait
+    updateDelay delay (-1)
+    True <- wait
+    cancelDelay delay
+    True <- wait
+
+    (delay, wait) <- new 100000
+    False <- wait
+    threadDelay 50000
+    False <- wait
+    updateDelay delay 200000
+    threadDelay 60000
+    False <- wait
+    threadDelay 60000
+    False <- wait   -- updateDelay sets the timer based on the current time,
+                    -- so the threadDelay 50000 doesn't count toward our total.
+    threadDelay 81000
+    True <- wait
+
+    -- 'newDelay n' where n <= 0 times out immediately,
+    -- rather than never timing out.
+    (delay, wait) <- new 0
+    threadDelay 100
+    True <- wait
+    (delay, wait) <- new (-1)
+    threadDelay 100
+    True <- wait
+
+    -- This fails on Windows without -threaded, as 'threadDelay minBound'
+    -- blocks.  It also fails on Linux using GHC 7.0.3 without -threaded.
+#if !mingw32_HOST_OS && MIN_VERSION_base(4,4,0)
+    (delay, wait) <- new minBound
+    threadDelay 1000
+    True <- wait
+#endif
+
+    -- 'newDelay maxBound' doesn't time out any time soon,
+    -- and updateDelay doesn't wait for the delay to complete.
+    --
+    -- Using maxBound currently fails on Linux 64-bit (see GHC ticket #7325),
+    -- so use a more lenient value for now.
+    --
+    -- (delay, wait) <- new maxBound
+    (delay, wait) <- new 2147483647
+    False <- wait
+    threadDelay 100000
+    False <- wait
+    updateDelay delay 100000
+    threadDelay 90000
+    False <- wait
+    threadDelay 10010
+    True <- wait
+
+    -- cancelDelay causes the delay to miss its initial deadline,
+    -- and a subsequent updateDelay has no effect.
+    (delay, wait) <- new 100000
+    False <- wait
+    threadDelay 50000
+    False <- wait
+    cancelDelay delay
+    False <- wait
+    threadDelay 60000
+    False <- wait
+    updateDelay delay 10000
+    False <- wait
+    threadDelay 20000
+    False <- wait
+    cancelDelay delay
+    False <- wait
+    threadDelay 100000
+    False <- wait
+
+    return ()