Skip to content
Browse files

Merge pull request #10 from snoyberg/master

The much anticipated http-conduit pull request ;)
  • Loading branch information...
2 parents 9487197 + 379ec4d commit afa124d025f88448e7960b7c79153b5caaf1ed92 @bos committed Jan 21, 2012
Showing with 27 additions and 20 deletions.
  1. +2 −2 app/App.hs
  2. +15 −12 lib/Network/HTTP/LoadTest.hs
  3. +5 −4 lib/Network/HTTP/LoadTest/Types.hs
  4. +5 −2 pronk.cabal
View
4 app/App.hs
@@ -29,7 +29,7 @@ import qualified Data.ByteString.Char8 as B
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 {
@@ -122,7 +122,7 @@ main = withSocketsDo $ do
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)
View
27 lib/Network/HTTP/LoadTest.hs
@@ -13,19 +13,22 @@ module Network.HTTP.LoadTest
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
@@ -38,30 +41,30 @@ 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
, summElapsed = realToFrac elapsed
, 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
@@ -70,11 +73,11 @@ client Config{..} mgr interval = loop 0 [] =<< getPOSIXTime
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
}
View
9 lib/Network/HTTP/LoadTest/Types.hs
@@ -26,8 +26,7 @@ import Data.Bits (xor)
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
@@ -42,8 +41,10 @@ newtype Req = Req {
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
View
7 pronk.cabal
@@ -51,17 +51,20 @@ library
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,
@@ -84,7 +87,7 @@ executable pronk
cmdargs >= 0.7,
criterion,
deepseq,
- http-enumerator,
+ http-conduit,
pronk,
network,
text,

0 comments on commit afa124d

Please sign in to comment.
Something went wrong with that request. Please try again.