1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Client where
import Control.Concurrent.Async
import qualified Control.Exception as E
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 Network.HTTP2.Client
import Monitor
data Options = Options
{ optPerformance :: Int
, optNumOfReqs :: Int
, optMonitor :: Bool
}
deriving (Show)
client :: Options -> [Path] -> Client ()
client Options{..} paths sendRequest _aux = do
labelMe "h2c client"
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)
clientNReqs :: Int -> SendRequest -> Path -> IO ()
clientNReqs n0 sendRequest path = do
labelMe "h2c clinet N requests"
loop n0
where
req = requestNoBody methodGet path []
loop 0 = return ()
loop n = do
sendRequest req $ \rsp -> do
print $ responseStatus rsp
getResponseBodyChunk rsp >>= C8.putStrLn
loop (n - 1)
-- Path is dummy
clientPF :: Int -> SendRequest -> Path -> IO ()
clientPF n sendRequest _ = do
labelMe "h2c clinet performance"
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
|
