Bryan O'Sullivan avatar Bryan O'Sullivan committed 1d1a455 Merge

Merge pull request #10 from snoyberg/master

The much anticipated http-conduit pull request ;)

Comments (0)

Files changed (4)

 import qualified Data.ByteString.Lazy.Char8 as BL
 import qualified Data.Text.Format as T
 import qualified Data.Text.Lazy.IO as TL
-import qualified Network.HTTP.Enumerator as E
+import qualified Network.HTTP.Conduit as E
 import qualified Network.HTTP.LoadTest as LoadTest
 
 data Args = Args {
       let dump = object [ "config" .= cfg
                         , "environment" .= env
                         , "analysis" .= G.toJSON analysis ]
-      maybeWriteFile json $ \h -> BL.hPutStrLn h . encode $ dump
+      maybeWriteFile json $ \h -> BL.hPut h (BL.append (encode dump) "\n")
       maybeWriteFile dump_events $ \h ->
           TL.hPutStr h . toLazyText . csvEvents $ results
       maybeWriteFile output $ \h -> either (writeReport template h)

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
     }

lib/Network/HTTP/LoadTest/Types.hs

 import Data.Data (Data)
 import Data.Hashable (Hashable(hash))
 import Data.Typeable (Typeable)
-import Network.HTTP.Enumerator (Request(..), parseUrl)
-import Network.HTTP.Types (renderQuery)
+import Network.HTTP.Conduit (Request(..), parseUrl)
 import System.IO.Unsafe
 import qualified Data.ByteString.Char8 as B
 import qualified Data.CaseInsensitive as CI
 
 instance Show Req where
     show (Req req) = concatMap B.unpack
-                         [ http, host req, portie, path req
-                         , renderQuery True $ queryString req ]
+                         $ http: host req: portie: path req
+                         : if B.null (queryString req)
+                            then []
+                            else ["?", queryString req]
         where http | secure req = "https://"
                    | otherwise  = "http://"
               isDefaultPort | secure req = port req == 443
     base < 5,
     bytestring,
     case-insensitive,
+    conduit,
     criterion >= 0.6.0.0,
     deepseq,
     filepath,
     hashable >= 1.1.2.0,
     hastache,
-    http-enumerator >= 0.7,
+    http-conduit >= 1.2,
     http-types,
+    lifted-base,
     statistics >= 0.10.0.0,
     text,
     text-format >= 0.3.0.4,
     time,
+    transformers >= 0.2.2,
     unix-compat >= 0.2.2,
     unordered-containers >= 0.1.4.0,
     vector,
     cmdargs >= 0.7,
     criterion,
     deepseq,
-    http-enumerator,
+    http-conduit,
     pronk,
     network,
     text,
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.