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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
{-# LANGUAGE OverloadedStrings, LambdaCase #-}
module Main where
import Control.Concurrent
import Control.Monad
import Control.Monad.Trans
import Data.Time
import Database.Redis
import Text.Printf
nRequests, nClients :: Int
nRequests = 100000
nClients = 50
main :: IO ()
main = do
----------------------------------------------------------------------
-- Preparation
--
conn <- connect defaultConnectInfo
runRedis conn $ do
_ <- flushall
mset [ ("k1","v1"), ("k2","v2"), ("k3","v3")
, ("k4","v4"), ("k5","v5") ] >>= \case
Left _ -> error "error"
_ -> return ()
return ()
----------------------------------------------------------------------
-- Spawn clients
--
start <- newEmptyMVar
done <- newEmptyMVar
replicateM_ nClients $ forkIO $ do
runRedis conn $ forever $ do
action <- liftIO $ takeMVar start
action
liftIO $ putMVar done ()
let timeAction name nActions action = do
startT <- getCurrentTime
-- each clients runs ACTION nRepetitions times
let nRepetitions = nRequests `div` nClients `div` nActions
replicateM_ nClients $ putMVar start (replicateM_ nRepetitions action)
replicateM_ nClients $ takeMVar done
stopT <- getCurrentTime
let deltaT = realToFrac $ diffUTCTime stopT startT
-- the real # of reqs send. We might have lost some due to 'div'.
actualReqs = nRepetitions * nActions * nClients
rqsPerSec = fromIntegral actualReqs / deltaT :: Double
putStrLn $ printf "%-20s %10.2f Req/s" (name :: String) rqsPerSec
----------------------------------------------------------------------
-- Benchmarks
--
timeAction "ping" 1 $ do
ping >>= \case
Right Pong -> return ()
_ -> error "error"
return ()
timeAction "get" 1 $ do
get "key" >>= \case
Right Nothing -> return ()
_ -> error "error"
return ()
timeAction "mget" 1 $ do
mget ["k1","k2","k3","k4","k5"] >>= \case
Right vs -> do
let expected = map Just ["v1","v2","v3","v4","v5"]
case vs == expected of
True -> return ()
_ -> error "error"
return ()
_ -> error "error"
timeAction "ping (pipelined)" 100 $ do
pongs <- replicateM 100 ping
let expected = replicate 100 (Right Pong)
case pongs == expected of
True -> return ()
_ -> error "error"
return ()
timeAction "multiExec get 1" 1 $ do
multiExec (get "foo") >>= \case
TxSuccess _ -> return ()
_ -> error "error"
return ()
timeAction "multiExec get 50" 50 $ do
res <- multiExec $ do
rs <- replicateM 50 (get "foo")
return $ fmap length (sequence rs)
case res of
TxSuccess 50 -> return ()
_ -> error "error"
return ()
timeAction "multiExec get 1000" 1000 $ do
res <- multiExec $ do
rs <- replicateM 1000 (get "foo")
return $ fmap length (sequence rs)
case res of
TxSuccess 1000 -> return ()
_ -> error "error"
return ()
|
