uhttpc 0.1.0.0 → 0.1.1.0
raw patch · 5 files changed
+266/−65 lines, 5 filesdep +network-uridep +optparse-applicativedep −cmdargsdep ~asyncdep ~basedep ~bytestring-lexingPVP ok
version bump matches the API change (PVP)
Dependencies added: network-uri, optparse-applicative
Dependencies removed: cmdargs
Dependency ranges changed: async, base, bytestring-lexing, deepseq, network
API changes (from Hackage documentation)
Files
- CHANGELOG.md +10/−0
- Network/HTTP/MicroClient.hs +4/−2
- README.md +115/−0
- src-exe/uhttpc-bench.hs +124/−52
- uhttpc.cabal +13/−11
+ CHANGELOG.md view
@@ -0,0 +1,10 @@+## 0.1.1.0++- `uhttpc-bench`: Add support for round-robin POST requests from file+- `uhttpc-bench`: Converted to `optparse-applicative`+- Fix `ssUnread` being incorrect when push-back buffer is non-empty+- Minor optimization reducing `IORef` contention++## 0.1.0.0++- Initial release
Network/HTTP/MicroClient.hs view
@@ -47,7 +47,9 @@ , getPOSIXTimeUSecs ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative+#endif import Control.DeepSeq (NFData(rnf),deepseq) import Control.Exception import Control.Monad@@ -208,7 +210,7 @@ -- |Push-back read data into 'SockStream' ssUnRead :: ByteString -> SockStream -> IO () ssUnRead buf0 ss@(SockStream _ bufref _ _ _) =- ssDebug "ssUnRead" ss $ modifyIORef' bufref (<> buf0)+ ssDebug "ssUnRead" ss $ modifyIORef' bufref (buf0 <>) -- |Returns length of data consumed (i.e. w/o 'ssUnRead' data) ssReadCnt :: SockStream -> IO Word64@@ -253,7 +255,7 @@ | TeInvalid deriving (Show,Eq) -instance NFData TransferEncoding+instance NFData TransferEncoding where rnf !_ = () -- |Extract information from the header lines as returned by 'recvHttpHeaders' --
+ README.md view
@@ -0,0 +1,115 @@+# `uhttpc` - µHTTP client library++`uhttpc` is a simple low-level and lightweight Haskell HTTP 1.1+library providing the bare minimum required for HTTP benchmarking+purposes.++This is **not** a RFC compliant HTTP client library and **shall not**+be used as a general purpose HTTP implementation!++# `uhttpc-bench`++This Cabal package comes with an executable `uhttpc-bench` which+represents an `ab`/`weighttpd`-style HTTP benchmarking tool:++ uhttpc-bench - a Haskell-based ab/weighttp-style webserver benchmarking tool++ Simple HTTP benchmark tool similiar to ab and weighttp++ uttpc-bench [OPTIONS] <url>++ Common flags:+ -n=num number of requests (default: 1)+ -t=num threadcount (default: 1)+ -c=num concurrent clients (default: 1)+ -k enable keep alive+ --csv=FILE dump request timings as CSV (RFC4180) file+ --user-agent=ITEM specify User-Agent (default: "httpc-bench")+ -H=str add header to request+ -v --verbose enable more verbose statistics and output+ --no-stats disable statistics+ -p=FILE perform POST request with file-content as body+ -l=FILE perform a POST request per line, no quoting,+ round-robin, each client independently+ -? --help Display help message+ -V --version Print version information++# How to use it++First, install the `uhttpc` package+(This requires GHC 7.6.x or later)++ $ cabal install uhttpc++A simple example invocation:++ $ uhttpc-bench -n 100000 -t1 -c3 -k http://localhost/++ uhttpc-bench - a Haskell-based ab/weighttp-style webserver benchmarking tool++ starting benchmark...+ finished in 2.314289 seconds, 100000 reqs (3 conns), 43209.8 req/s received+ status codes: 100000 HTTP-200+ data received: 36205.098 KiB/s, 85800000 bytes total (24600000 bytes http + 61200000 bytes content)+ rtt min/avg/max = 0.034/0.068/4.252 ms++For comparison, [`weighttp`](https://github.com/lighttpd/weighttp) can be invoked with the very same arguments (in this case at least):++ $ weighttp -n 100000 -t1 -c3 -k http://localhost/++ weighttp - a lightweight and simple webserver benchmarking tool++ starting benchmark...+ spawning thread #1: 3 concurrent requests, 100000 total requests++ finished in 2 sec, 333 millisec and 421 microsec, 42855 req/s, 35908 kbyte/s+ requests: 100000 total, 100000 started, 100000 done, 100000 succeeded, 0 failed, 0 errored+ status codes: 100000 2xx, 0 3xx, 0 4xx, 0 5xx+ traffic: 85800000 bytes total, 24600000 bytes http, 61200000 bytes data++Another example invocation of `uhttpc-bench`:++ $ uhttpc-bench http://www.google.com/ -v -c8 -n1000++ uhttpc-bench - a Haskell-based ab/weighttp-style webserver benchmarking tool++ using 88-byte request header (+ 0-byte body):+ "GET / HTTP/1.1\r\nHost: www.google.com:80\r\nUser-Agent: uhttpc-bench\r\nConnection: close\r\n\r\n"++ starting benchmark...++ per-client stats:++ client spawned +0.000008 s, 125 reqs (125 conns), 8.1 req/s, finished in 15.369619 s+ rtt min/avg/med/max = 99.586/122.902/122.109/167.193 ms++ client spawned +0.000258 s, 125 reqs (125 conns), 8.1 req/s, finished in 15.383278 s+ rtt min/avg/med/max = 100.494/123.012/121.648/184.555 ms++ client spawned +0.000292 s, 125 reqs (125 conns), 8.1 req/s, finished in 15.365843 s+ rtt min/avg/med/max = 98.721/122.872/121.668/163.810 ms++ client spawned +0.000327 s, 124 reqs (124 conns), 8.1 req/s, finished in 15.346788 s+ rtt min/avg/med/max = 103.008/123.709/122.834/174.003 ms++ client spawned +0.000366 s, 126 reqs (126 conns), 8.2 req/s, finished in 15.367205 s+ rtt min/avg/med/max = 95.255/121.907/120.736/152.943 ms++ client spawned +0.000403 s, 124 reqs (124 conns), 8.1 req/s, finished in 15.357957 s+ rtt min/avg/med/max = 97.730/123.800/123.569/162.326 ms++ client spawned +0.000434 s, 125 reqs (125 conns), 8.1 req/s, finished in 15.388717 s+ rtt min/avg/med/max = 103.056/123.055/121.961/162.419 ms++ client spawned +0.000461 s, 126 reqs (126 conns), 8.2 req/s, finished in 15.394365 s+ rtt min/avg/med/max = 102.114/122.123/121.289/151.520 ms++ finished in 15.394867 seconds, 1000 reqs (1000 conns), 65.0 req/s received+ status codes: 1000 HTTP-302+ data received: 63.498 KiB/s, 1001000 bytes total (783000 bytes http + 218000 bytes content)+ rtt 2/9|25/50/75|91/98-th quantile = 103.737/108.696 | 115.124/121.688/129.944 | 137.715/148.159 ms+ rtt min/avg/max = 95.255/122.919/184.555 ms+++The `--csv` option allows to export the raw measurement data in format+suitable for offline analysis with statistical tools such as [`R`](http://www.r-project.org).
src-exe/uhttpc-bench.hs view
@@ -1,9 +1,14 @@-{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, RecordWildCards, BangPatterns #-}+{-# LANGUAGE Arrows #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} module Main (main) where import Control.Concurrent import Control.Concurrent.Async+import Control.DeepSeq (deepseq) import Control.Monad import Data.ByteString (ByteString) import qualified Data.ByteString as B@@ -18,7 +23,8 @@ import GHC.Conc.Sync (numCapabilities,getNumProcessors) import Network.HTTP.MicroClient import Network.Socket hiding (send, sendTo, recv, recvFrom)-import System.Console.CmdArgs.Implicit+import Options.Applicative+import Options.Applicative.Arrows import System.IO import System.Mem (performGC) import Text.Printf@@ -53,44 +59,62 @@ , argWait :: Double , argUrl :: String , argPostFn :: FilePath+ , argPostList :: FilePath } deriving (Show,Data,Typeable) -defaultArgs :: Args-defaultArgs = Args- { argNumReq = 1 &= typ "num" &= name "n" &= explicit- &= help "number of requests (default: 1)"- , argThrCnt = numCapabilities &= typ "num" &= explicit &= name "t"- &= help ("threadcount (default: " ++ show numCapabilities ++ ")")- , argClnCnt = 1 &= typ "num" &= name "c" &= explicit- &= help "concurrent clients (default: 1)"- , argKeepAlive = def &= name "k" &= explicit- &= help "enable keep alive"- , argHdrs = def &= typ "str" &= name "H" &= explicit- &= help "add header to request"- , argUA = "uhttpc-bench" &= name "user-agent" &= explicit- &= help "specify User-Agent (default: \"httpc-bench\")"- , argCsv = def &= typFile &= name "csv" &= explicit- &= help "dump request timings as CSV (RFC4180) file"- , argVerbose = def &= name "v" &= name "verbose" &= explicit- &= help "enable more verbose statistics and output"- , argNoStats = def &= name "no-stats" &= explicit- &= help "disable statistics"- , argPostFn = def &= typFile &= name "p" &= explicit- &= help "perform POST request with file-content as body"- , argLAddr = def &= typ "addr" &= name "local-addr" &= explicit- &= help "set specific source address for TCP connections"- , argWait = def &= typ "sec" &= name "wait" &= explicit- &= help "wait time between requests (per client) in seconds"- , argUrl = def &= argPos 0 &= typ "<url>"- } &= program "uttpc-bench"- &= summary "Simple HTTP benchmarking tool similiar to 'ab' and 'weighttp'"+argsParser :: Parser Args+argsParser = runA $ proc () -> do+ argNumReq <- asA (option auto $ value 1 <> metavar "NUM" <> short 'n'+ <> help "number of requests" <> showDefault) -< () + argThrCnt <- asA (option auto $ value numCapabilities <> metavar "NUM" <> short 't'+ <> help "thread-count" <> showDefault) -< () + argClnCnt <- asA (option auto $ value 1 <> metavar "NUM" <> short 'c'+ <> help "concurrent clients" <> showDefault) -< ()++ argKeepAlive <- asA (switch $ short 'k' <> help "enable keep alive") -< ()++ argHdrs <- asA (many (option str $ metavar "STR" <> short 'H'+ <> help "add header to request")) -< ()++ argUA <- asA (option str $ value "httpc-bench" <> metavar "UA" <> long "user-agent"+ <> help "specify User-Agent header" <> showDefault) -< ()++ argCsv <- asA (option str $ value "" <> metavar "FILE" <> long "csv"+ <> help "dump request timings as CSV (RFC4180) file") -< ()++ argVerbose <- asA (switch $ short 'v' <> long "verbose"+ <> help "enable more verbose statistics and output") -< ()++ argNoStats <- asA (switch $ long "no-stats"+ <> help "disable statistics") -< ()++ argPostFn <- asA (option str $ value "" <> metavar "FILE" <> short 'p'+ <> help "perform POST request with file-content as body") -< ()++ argPostList <- asA (option str $ value "" <> metavar "FILE" <> short 'l'+ <> help "perform a POST request per line, no quoting, round-robin, each client independently") -< ()++ argLAddr <- asA (option str $ value "" <> metavar "IPADDR" <> long "local-addr"+ <> help "set specific source address for TCP connections") -< ()++ argWait <- asA (option auto $ value 0.0 <> metavar "SECS" <> long "wait"+ <> help "wait time between requests (per client) in seconds"+ <> showDefault) -< ()++ argUrl <- asA (argument str (metavar "<URL>")) -< ()++ returnA -< Args {..}++ main :: IO () main = runInUnboundThread $ do putStrLn "uhttpc-bench - a Haskell-based ab/weighttp-style webserver benchmarking tool\n" - pargs <- cmdArgs defaultArgs+ pargs <- execParser (info (helper <*> argsParser)+ (fullDesc <> header "Simple HTTP benchmarking tool similiar to 'ab' and 'weighttp'")+ ) let verbose = argVerbose pargs (hostname,portnum,urlpath) <- either fail return $ splitUrl (argUrl pargs)@@ -137,41 +161,68 @@ putStrLn "*WARNING* client-count should be >= thread-count" ----------------------------------------------------------------------------- let isPost = not $ null (argPostFn pargs)+ let postOrGet = if null (argPostFn pargs) && null (argPostList pargs)+ then GET+ else POST - rawreqb <- if isPost- then fmap Just $ B.readFile (argPostFn pargs)- else return Nothing+ when (verbose && not (null (argPostList pargs))) $+ putStrLn "reading the input file and preparing requests...\n" + bodyList <- if not (null $ argPostList pargs) -- overrides argPostFn+ then fmap (take (fI $ argNumReq pargs) -- will at most use this+ . map Just+ . B8.lines)+ $ B.readFile (argPostList pargs)+ else if not (null $ argPostFn pargs)+ then fmap (map Just . (: [])) $ B.readFile (argPostFn pargs)+ else return [Nothing]+ let hdrs | null (argUA pargs) = map B8.pack (argHdrs pargs) | otherwise = "User-Agent: " <> B8.pack (argUA pargs) : map B8.pack (argHdrs pargs)+ mkRawreq :: Maybe B8.ByteString -> IO ByteString+ mkRawreq rawreqb = do+ let rawreqblen = maybe 0 B.length rawreqb+ msg = mkHttp11Req postOrGet+ (B8.pack urlpath)+ ("Host: " <> B8.pack hostname+ <> ":" <> B8.pack (show portnum))+ (argKeepAlive pargs)+ hdrs+ rawreqb+ -- Printed when preparing the requests, not when sending.+ when verbose $+ printf "using %d-byte request message (%d-byte body):\n %s\n\n"+ (B.length msg) rawreqblen (show msg)+ return $! msg - rawreqblen = maybe 0 B.length rawreqb- rawreq = mkHttp11Req (if isPost then POST else GET)- (B8.pack urlpath)- ("Host: " <> B8.pack hostname <> ":" <> B8.pack (show portnum))- (argKeepAlive pargs)- hdrs- rawreqb+ rawreqList <- mapM mkRawreq bodyList+ let reqList = cycle rawreqList - when verbose $- printf "using %d-byte request message (%d-byte body):\n %s\n\n" (B.length rawreq) rawreqblen (show rawreq)+ -- We make sure the list is fully evaluated _before_ we send anything.+ rawreqList `deepseq`+ when (verbose && not (null (argPostList pargs))) $+ putStrLn $ show (length rawreqList) ++ " request(s) prepared\n" putStrLn "starting benchmark..." reqCounter <- newIORef (fI (argNumReq pargs) :: Int) + let clnCnt = fI $ argClnCnt pargs+ performGC ts0' <- getTS- tss <- mapConcurrently (\() -> timeIO (doReqs lsa sa reqCounter rawreq (argWait pargs)))- (replicate (fI $ argClnCnt pargs) ())++ tss <- if clnCnt == 1+ then mapM (\() -> timeIO (doReqsAll lsa sa reqCounter reqList (argWait pargs))) [()]+ else mapConcurrently (\() -> timeIO (doReqs lsa sa reqCounter reqList (argWait pargs)))+ (replicate clnCnt ()) ts1' <- getTS performGC numReqs' <- readIORef reqCounter unless (numReqs' + fI (argClnCnt pargs) == 0) $- fail "virtual clients exited prematurely!"+ fail $ "virtual clients exited prematurely! " ++ show numReqs' unless (argNoStats pargs) $ do when verbose $ do@@ -262,16 +313,17 @@ hist xs = [ (head g, length g) | g <- group (sort xs) ] -- |repeat executing 'doReq' until req-counter goes below 0-doReqs :: Maybe SockAddr -> SockAddr -> IORef Int -> ByteString -> Double -> IO [Entry]-doReqs lsa sa cntref req wtime = go Nothing []+doReqs :: Maybe SockAddr -> SockAddr -> IORef Int -> [ByteString] -> Double -> IO [Entry]+doReqs lsa sa cntref reqList wtime = go Nothing [] reqList where- go ss a = do+ go _ _ [] = fail "internal error: request list ran out"+ go ss a (req : rest) = do notDone <- decReqCounter cntref if notDone then do (ss',r) <- doReq lsa sa ss req when (wtimeUsecs > 0) $ threadDelay wtimeUsecs- go ss' (r:a)+ go ss' (r:a) rest else do maybe (return ()) ssClose ss return a@@ -279,6 +331,26 @@ wtimeUsecs = floor $ 1000000 * wtime decReqCounter cnt = atomicModifyIORef' cnt (\n -> (n-1,n>0))++-- | Version of 'doReqs' that does all requests as indicated by req-counter at once+--+-- This updates the IORef only once and thus avoids additional overhead+doReqsAll :: Maybe SockAddr -> SockAddr -> IORef Int -> [ByteString] -> Double -> IO [Entry]+doReqsAll lsa sa cntref reqList wtime = do+ n <- atomicModifyIORef' cntref (\n -> (n-(max 0 (n+1)),(max 0 n)))+ go Nothing [] n reqList+ where+ go _ _ _ [] = fail "internal error: request list ran out"+ go ss a cnt (req : rest)+ | cnt > 0 = do+ (ss',r) <- doReq lsa sa ss req+ when (wtimeUsecs > 0) $ threadDelay wtimeUsecs+ go ss' (r:a) (cnt-1) rest+ | otherwise = do+ maybe (return ()) ssClose ss+ return a++ wtimeUsecs = floor $ 1000000 * wtime -- |single measurement entry data Entry = Entry
uhttpc.cabal view
@@ -1,12 +1,12 @@ name: uhttpc-version: 0.1.0.0+version: 0.1.1.0 synopsis: Minimal HTTP client library optimized for benchmarking homepage: https://github.com/hvr/uhttpc license: GPL-3 license-file: LICENSE author: Herbert Valerio Riedel maintainer: hvr@gnu.org-copyright: © 2013 Herbert Valerio Riedel+copyright: © 2013-2015 Herbert Valerio Riedel category: Network build-type: Simple cabal-version: >=1.10@@ -32,6 +32,8 @@ instead which aim toward full RFC compliance as well as having good performance. +extra-source-files: README.md CHANGELOG.md+ library default-language: Haskell2010 other-extensions: BangPatterns, CPP, OverloadedStrings@@ -39,15 +41,16 @@ ghc-options: -Wall -fwarn-tabs c-sources: cbits/get_posix_time.c build-depends:- base >=4.6 && <4.8,+ base >=4.6 && <4.9, bytestring ==0.10.*,- network >=2.4.0.1 && <2.6,- bytestring-lexing ==0.4.*,- deepseq ==1.3.*+ network ==2.6.*,+ network-uri ==2.6.*,+ bytestring-lexing >=0.4 && <0.6,+ deepseq >=1.1 && <1.5 executable uhttpc-bench default-language: Haskell2010- other-extensions: BangPatterns, DeriveDataTypeable, OverloadedStrings, RecordWildCards+ other-extensions: Arrows, BangPatterns, DeriveDataTypeable, OverloadedStrings, RecordWildCards hs-source-dirs: src-exe main-is: uhttpc-bench.hs ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -threaded -rtsopts@@ -57,12 +60,11 @@ base, bytestring, bytestring-lexing,+ deepseq, network, -- build-deps which need version bounds- async ==2.0.*,- bytestring-lexing ==0.4.*,- cmdargs ==0.10.*-+ async ==2.0.*,+ optparse-applicative ==0.11.* Source-Repository head Type: git