diff --git a/Control/Timeout.hs b/Control/Timeout.hs
--- a/Control/Timeout.hs
+++ b/Control/Timeout.hs
@@ -6,6 +6,7 @@
 -- The number of threads used is constant.
 module Control.Timeout (
      addTimeout
+   , addTimeoutAtomic
    , cancelTimeout
    , TimeoutTag) where
 
@@ -119,17 +120,38 @@
 addTimeout :: Float  -- ^ the number of seconds in the future to perform the action
            -> (IO ())  -- ^ the action to perform
            -> IO TimeoutTag
-addTimeout delta action = do
+addTimeout delta action =
+  addTimeoutAtomic delta action >>= atomically
+
+-- | Similar in function to addTimeout above, this call splits the IO and STM
+--   parts of the process so that a timeout can be added atomically. Consider
+--   the following code:
+--
+--      * We add a timeout with an action which reads from a global TVar
+--
+--      * We add the TimeoutTag (in case we wish to handle the timeout) and
+--        some bookkeeping data to the global TVar and trigger some external
+--        action (i.e. a network request)
+--
+--  In this case, the timeout could occur before the bookkeeping is added. Now
+--  the timeout code won't find the correct state. If we switch the two actions
+--  then we don't have the TimeoutTag to add to the bookkeeping structure and we
+--  would need another TVar, or some such, to fill in later.
+addTimeoutAtomic :: Float  -- ^ the number of seconds in the future to perform the action
+                 -> (IO ())  -- ^ the action to perform
+                 -> IO (STM TimeoutTag)  -- ^ an action to add the timeout and return the tag
+addTimeoutAtomic delta action = do
   currentTime <- getPOSIXTime
   let future = currentTime + (fromRational $ toRational delta)
-  tag <- atomically (do
-    m <- readTVar timeouts
-    case Map.lookup future m of
-         Nothing -> do writeTVar timeouts $ Map.insert future [(0, action)] m
-                       return $ TimeoutTag (future, 0)
-         Just xs -> do let magic = 1 + (maximum $ map fst xs)
-                       writeTVar timeouts $ Map.insert future ((magic, action) : xs) m
-                       return $ TimeoutTag (future, magic))
+      stmAction :: STM TimeoutTag
+      stmAction = do
+        m <- readTVar timeouts
+        case Map.lookup future m of
+             Nothing -> do writeTVar timeouts $ Map.insert future [(0, action)] m
+                           return $ TimeoutTag (future, 0)
+             Just xs -> do let magic = 1 + (maximum $ map fst xs)
+                           writeTVar timeouts $ Map.insert future ((magic, action) : xs) m
+                           return $ TimeoutTag (future, magic)
   -- If the manager thread isn't running, start it now.
   startp <- atomically (do
     started <- readTVar managerThreadStarted
@@ -137,7 +159,7 @@
     return $ not started)
   when startp $ forkIO (timeoutManagerThread timeouts signal 0 Nothing) >> return ()
 
-  return tag
+  return stmAction
 
 -- | Remove a timeout. This function never fails, but will return False if the
 --   given timeout couldn't be found. This may be because cancelTimeout has
diff --git a/control-timeout.cabal b/control-timeout.cabal
--- a/control-timeout.cabal
+++ b/control-timeout.cabal
@@ -1,5 +1,5 @@
 name:            control-timeout
-version:         0.1
+version:         0.1.1
 license:         BSD3
 license-file:    LICENSE
 author:          Adam Langley <agl@imperialviolet.org>
@@ -8,7 +8,6 @@
 category:        Control
 build-depends:   base, containers, time, stm
 stability:       provisional
-tested-with:     GHC == 6.8.1
+tested-with:     GHC == 6.8.2
 exposed-modules: Control.Timeout
-ghc-options:     -O2
 extra-source-files: test/TimeoutTest.hs