Source

pronk / lib / Network / HTTP / LoadTest.hs

Diff from to

lib/Network/HTTP/LoadTest.hs

 import Control.Applicative ((<$>))
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Concurrent.Chan (newChan, readChan, writeChan)
-import Control.Exception (catch, throwIO, try)
+import Control.Exception.Lifted (catch, throwIO, try)
 import Control.Monad (forM_, replicateM, when)
 import Data.Either (partitionEithers)
 import Data.List (nub)
 import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
-import Network.HTTP.Enumerator
+import Network.HTTP.Conduit
 import Network.HTTP.LoadTest.Types
 import Prelude hiding (catch)
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Vector as V
 import qualified Data.Vector.Algorithms.Intro as I
 import qualified Data.Vector.Generic as G
-import qualified System.Timeout as T
+import qualified System.Timeout.Lifted as T
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.Resource (ResourceT)
+import qualified Network.HTTP.Types as H
 
 run :: Config -> IO (Either [NetworkError] (V.Vector Summary))
 run cfg@Config{..} = do
   ch <- newChan
   forM_ reqs $ \numReqs -> forkIO . withManager $ \mgr -> do
     let cfg' = cfg { numRequests = numReqs }
-    writeChan ch =<< try (client cfg' mgr interval)
+    liftIO . writeChan ch =<< try (client cfg' mgr interval)
   (errs,vs) <- partitionEithers <$> replicateM concurrency (readChan ch)
   return $ case errs of
              [] -> Right . G.modify I.sort . V.concat $ vs
              _  -> Left (nub errs)
 
 client :: Config -> Manager -> POSIXTime
-       -> IO (V.Vector Summary)
-client Config{..} mgr interval = loop 0 [] =<< getPOSIXTime
+       -> ResourceT IO (V.Vector Summary)
+client Config{..} mgr interval = loop 0 [] =<< liftIO getPOSIXTime
   where
     loop !n acc now
         | n == numRequests = return (V.fromList acc)
         | otherwise = do
       !evt <- timedRequest
-      now' <- getPOSIXTime
+      now' <- liftIO getPOSIXTime
       let elapsed = now' - now
           !s = Summary {
                  summEvent = evt
                , summStart = realToFrac now'
                }
       when (elapsed < interval) $
-        threadDelay . truncate $ (interval - elapsed) * 1000000
-      loop (n+1) (s:acc) =<< getPOSIXTime
+        liftIO . threadDelay . truncate $ (interval - elapsed) * 1000000
+      loop (n+1) (s:acc) =<< liftIO getPOSIXTime
     issueRequest = httpLbs (fromReq request) mgr
                    `catch` (throwIO . NetworkError)
     timedRequest
       maybeResp <- T.timeout (truncate (timeout * 1e6)) issueRequest
       case maybeResp of
         Just resp -> return (respEvent resp)
-        _         -> closeManager mgr >> return Timeout
+        _         -> return Timeout
 
-respEvent :: Response -> Event
+respEvent :: Response L.ByteString -> Event
 respEvent resp =
     HttpResponse {
-      respCode = statusCode resp
+      respCode = H.statusCode $ statusCode resp
     , respContentLength = fromIntegral . L.length . responseBody $ resp
     }