http2 5.2.3 → 5.2.4
raw patch · 5 files changed
+95/−17 lines, 5 filesdep ~http-semanticsdep ~unix-timePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: http-semantics, unix-time
API changes (from Hackage documentation)
Files
- ChangeLog.md +6/−0
- http2.cabal +3/−2
- util/Client.hs +53/−5
- util/Server.hs +24/−2
- util/h2c-client.hs +9/−8
ChangeLog.md view
@@ -1,3 +1,9 @@+## 5.2.4++* Update for latest http-semantics+ [#122](https://github.com/kazu-yamamoto/http2/pull/122)+* + ## 5.2.3 * Update for latest http-semantics
http2.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: http2-version: 5.2.3+version: 5.2.4 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto <kazu@iij.ad.jp>@@ -115,7 +115,7 @@ bytestring >=0.10, case-insensitive >=1.2 && <1.3, containers >=0.6,- http-semantics >= 0.1 && <0.2,+ http-semantics >= 0.1.1 && <0.2, http-types >=0.12 && <0.13, network >=3.1, network-byte-order >=0.1.7 && <0.2,@@ -140,6 +140,7 @@ http-types, http2, network-run >= 0.3 && <0.4,+ unix-time, unliftio if flag(devel)
util/Client.hs view
@@ -1,24 +1,38 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-} module Client where +import Control.Monad import qualified Data.ByteString.Char8 as C8+import Data.UnixTime+import Foreign.C.Types import Network.HTTP.Types+import Text.Printf import UnliftIO.Async import qualified UnliftIO.Exception as E import Network.HTTP2.Client -client :: Int -> [Path] -> Client ()-client n0 paths sendRequest _aux = do- ex <- E.try $ foldr1 concurrently_ $ map (client' n0 sendRequest) paths+data Options = Options+ { optPerformance :: Int+ , optNumOfReqs :: Int+ }+ deriving (Show)++client :: Options -> [Path] -> Client ()+client Options{..} paths sendRequest _aux = do+ let cli+ | optPerformance /= 0 = clientPF optPerformance sendRequest+ | otherwise = clientNReqs optNumOfReqs sendRequest+ ex <- E.try $ mapConcurrently_ cli paths case ex of Right () -> return () Left e -> print (e :: HTTP2Error) -client' :: Int -> SendRequest -> Path -> IO ()-client' n0 sendRequest path = loop n0+clientNReqs :: Int -> SendRequest -> Path -> IO ()+clientNReqs n0 sendRequest path = loop n0 where req = requestNoBody methodGet path [] loop 0 = return ()@@ -27,3 +41,37 @@ print $ responseStatus rsp getResponseBodyChunk rsp >>= C8.putStrLn loop (n - 1)++-- Path is dummy+clientPF :: Int -> SendRequest -> Path -> IO ()+clientPF n sendRequest _ = do+ t1 <- getUnixTime+ sendRequest req loop+ t2 <- getUnixTime+ printThroughput t1 t2 n+ where+ req = requestNoBody methodGet path []+ path = "/perf/" <> C8.pack (show n)+ loop rsp = do+ bs <- getResponseBodyChunk rsp+ when (bs /= "") $ loop rsp++printThroughput :: UnixTime -> UnixTime -> Int -> IO ()+printThroughput t1 t2 n =+ printf+ "Throughput %.2f Mbps (%d bytes in %d msecs)\n"+ bytesPerSeconds+ n+ millisecs+ where+ UnixDiffTime (CTime s) u = t2 `diffUnixTime` t1+ millisecs :: Int+ millisecs = fromIntegral s * 1000 + fromIntegral u `div` 1000+ bytesPerSeconds :: Double+ bytesPerSeconds =+ fromIntegral n+ * (1000 :: Double)+ * 8+ / fromIntegral millisecs+ / 1024+ / 1024
util/Server.hs view
@@ -8,14 +8,22 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.ByteString.Builder (byteString)+import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Char8 as C8 import Network.HTTP.Types import Network.HTTP2.Server server :: Server server req _aux sendResponse = case requestMethod req of- Just "GET"- | requestPath req == Just "/" -> sendResponse responseHello []+ Just "GET" -> case requestPath req of+ Nothing -> sendResponse response404 []+ Just path+ | path == "/" -> sendResponse responseHello []+ | "/perf/" `B.isPrefixOf` path -> do+ case C8.readInt (B.drop 6 path) of+ Nothing -> sendResponse responseHello []+ Just (n, _) -> sendResponse (responsePerf n) []+ | otherwise -> sendResponse response404 [] Just "POST" -> sendResponse (responseEcho req) [] _ -> sendResponse response404 [] @@ -24,6 +32,20 @@ where header = [("Content-Type", "text/plain")] body = byteString "Hello, world!\n"++responsePerf :: Int -> Response+responsePerf n0 = responseStreaming ok200 header streaming+ where+ header = [("Content-Type", "text/plain")]+ bs1024 = BB.byteString $ B.replicate 1024 65+ streaming write _flush = loop n0+ where+ loop 0 = return ()+ loop n+ | n < 1024 = write $ BB.byteString $ B.replicate (fromIntegral n) 65+ | otherwise = do+ write bs1024+ loop (n - 1024) response404 :: Response response404 = responseBuilder notFound404 header body
util/h2c-client.hs view
@@ -13,15 +13,11 @@ import Client -data Options = Options- { optNumOfReqs :: Int- }- deriving (Show)- defaultOptions :: Options defaultOptions = Options- { optNumOfReqs = 1+ { optPerformance = 0+ , optNumOfReqs = 1 } usage :: String@@ -30,6 +26,11 @@ options :: [OptDescr (Options -> Options)] options = [ Option+ ['t']+ ["performance"]+ (ReqArg (\n o -> o{optPerformance = read n}) "<size>")+ "measure performance"+ , Option ['n'] ["number-of-requests"] (ReqArg (\n o -> o{optNumOfReqs = read n}) "<n>")@@ -51,7 +52,7 @@ main :: IO () main = do args <- getArgs- (Options{..}, ips) <- clientOpts args+ (opts, ips) <- clientOpts args (host, port, paths) <- case ips of [] -> showUsageAndExit usage _ : [] -> showUsageAndExit usage@@ -62,4 +63,4 @@ E.bracket (allocSimpleConfig s 4096) freeSimpleConfig- (\conf -> run cliconf conf $ client optNumOfReqs paths)+ (\conf -> run cliconf conf $ client opts paths)