diff --git a/glue-core.cabal b/glue-core.cabal
--- a/glue-core.cabal
+++ b/glue-core.cabal
@@ -1,5 +1,5 @@
 name:                   glue-core
-version:                0.6
+version:                0.6.1
 synopsis:               Make better services and clients.
 description:            Combinator library to enhance the general functionality of services and clients.
 license:                BSD3
diff --git a/src/Glue/DogpileProtection.hs b/src/Glue/DogpileProtection.hs
--- a/src/Glue/DogpileProtection.hs
+++ b/src/Glue/DogpileProtection.hs
@@ -6,32 +6,52 @@
   dogpileProtect
 ) where
 
-import Control.Concurrent.Lifted
-import Control.Exception.Lifted
-import Control.Monad.Trans.Control
+import Control.Concurrent
+import Control.Exception
 import Data.Hashable
 import qualified Data.HashMap.Strict as M
-import Data.IORef.Lifted
+import Data.IORef
 import Glue.Types
 
--- TODO: Should make this return just BasicService, hiding the HashMap.
+data DogpileResult b = CachedValue (Either SomeException b)
+                     | RequestInProgress (IO b)
+
+type ResultMap a b = M.HashMap a (DogpileResult b)
+
+type ResultRef a b = IORef (ResultMap a b)
+
+getDogpileResult :: DogpileResult b -> IO b
+getDogpileResult (RequestInProgress requestWait) = requestWait
+getDogpileResult (CachedValue result) = either throw return result
+
+waitForMVar :: MVar (Either SomeException b) -> IO b
+waitForMVar mvar = do
+  result <- readMVar mvar
+  either throw return result
+
+getProtectedResult :: (Eq a, Hashable a)
+                   => a -> BasicService IO a b -> MVar (Either SomeException b) -> ResultRef a b -> ResultMap a b -> (ResultMap a b, IO b)
+getProtectedResult request service mvar mapRef resultMap =
+  let mvarWait = waitForMVar mvar
+      invokeService = do
+        result <- try $ service request
+        putMVar mvar result
+        atomicModifyIORef' mapRef (\mapToUpdate -> (M.insert request (CachedValue result) mapToUpdate, ()))
+        forkIO $ do
+          threadDelay (5 * 1000 * 1000)
+          atomicModifyIORef' mapRef (\mapToUpdate -> (M.delete request mapToUpdate, ()))
+      inCache = M.lookup request resultMap
+  in  maybe (M.insert request (RequestInProgress mvarWait) resultMap, invokeService >> mvarWait) (\r -> (resultMap, getDogpileResult r)) inCache
+
 -- | Dogpile protection of a service, to prevent multiple calls for the same value being submitted.
 -- | Loses the values held within m.
-dogpileProtect :: (MonadBaseControl IO m, MonadBaseControl IO n, Eq a, Hashable a) 
-               => BasicService m a b   -- ^ The service to protect.
-               -> n (IORef (M.HashMap a (ResultVar b)), BasicService m a b)
+dogpileProtect :: (Eq a, Hashable a)
+               => BasicService IO a b   -- ^ The service to protect.
+               -> IO (BasicService IO a b)
 dogpileProtect service = do
   mapRef <- newIORef M.empty
   let protectedService request = do
-                                    firstRequestMVar <- newEmptyMVar 
-                                    resultAction <- atomicModifyIORef' mapRef (\refMap -> 
-                                        let removeFromMap           = atomicModifyIORef' mapRef (\m -> (M.delete request m, ()))
-                                            invokeService           = do 
-                                                                        result <- bracketOnError (return ()) (\_ -> removeFromMap) (\_ -> service request)
-                                                                        putMVar firstRequestMVar $ Right result
-                                                                        return result
-                                            updateMap mvar          = (M.insert request mvar refMap, getResult mvar)
-                                            addToMap                = (M.insert request firstRequestMVar refMap, invokeService)
-                                        in  maybe addToMap updateMap $ M.lookup request refMap)
-                                    resultAction
-  return (mapRef, protectedService)
+        mvar <- newEmptyMVar
+        resultAction <- atomicModifyIORef' mapRef $ getProtectedResult request service mvar mapRef
+        resultAction
+  return protectedService
diff --git a/test/Glue/RetrySpec.hs b/test/Glue/RetrySpec.hs
--- a/test/Glue/RetrySpec.hs
+++ b/test/Glue/RetrySpec.hs
@@ -26,7 +26,7 @@
 spec = do
   describe "retryingService" $ do
     it "Attempts a service call multiple times" $ do
-      property $ \(request, (SmallInt failures), (SmallInt retries)) -> 
+      property $ \(request, (SmallInt failures), (SmallInt retries)) ->
         do
           ref <- liftIO $ newIORef 0
           let service req   = do
@@ -40,11 +40,11 @@
     it "Asynchronous exceptions are rethrown" $ do
       property $ \(request, retries) -> 
         do
-          ref <- liftIO $ newIORef 0
+          ref <- liftIO $ newIORef (0 :: Int)
           let service req   = do
                                 atomicModifyIORef' ref (\c -> (c + 1, ()))
                                 threadId <- myThreadId
-                                forkIO (threadDelay 10000 >> throwTo threadId UserInterrupt)
+                                _ <- forkIO (threadDelay 10000 >> throwTo threadId UserInterrupt)
                                 threadDelay 1000000
                                 return (req * 2 :: Int)
           let options       = defaultRetryOptions { maximumRetries = retries }