@@ -0,0 +1,48 @@
1+{-# LANGUAGE DerivingStrategies, DeriveGeneric, DerivingVia #-}
2+import Network.RPC.Curryer.Server
3+import Network.RPC.Curryer.Client
4+import Criterion.Main
5+import GHC.Generics
6+import Control.Concurrent.MVar
7+import Network.Socket (SockAddr(..))
8+import Codec.Winery
9+import Control.Concurrent.Async
10+import Control.Concurrent
11+import Control.Monad
12+
13+main :: IO ()
14+main = do
15+ --start server shared across benchmarks- gather stats on round-trip requests-responses
16+ portReadyMVar <- newEmptyMVar
17+ server <- async (serve (pure Nothing) benchmarkServerMessageHandler localHostAddr 0 (Just portReadyMVar))
18+ --wait for server to be ready
19+ (SockAddrInet port _) <- takeMVar portReadyMVar
20+ clientConn <- connect (const (pure ())) localHostAddr port
21+
22+ _ <- syncWaitRequest clientConn 100
23+ defaultMain [bgroup "wait sync" [bench "100 ms" (nfIO $ syncWaitRequest clientConn 100)]]
24+
25+ putStrLn "benchmark complete"
26+ close clientConn
27+ cancel server
28+
29+data BenchRequest = WaitMillisecondsReq Int
30+ deriving (Generic, Show)
31+ deriving Serialise via WineryVariant BenchRequest
32+
33+data BenchResponse = WaitMillisecondsResp
34+ deriving (Generic, Show, Eq)
35+ deriving Serialise via WineryVariant BenchResponse
36+
37+benchmarkServerMessageHandler :: BenchRequest -> IO (HandlerResponse BenchResponse)
38+benchmarkServerMessageHandler (WaitMillisecondsReq ms) = do
39+ threadDelay (1000 * ms)
40+ pure (HandlerResponse WaitMillisecondsResp)
41+
42+--perform 10000 small synchronous requests
43+syncWaitRequest :: Connection BenchResponse -> Int -> IO Int
44+syncWaitRequest conn ms = do
45+ ret <- call conn (WaitMillisecondsReq ms)
46+ when (ret /= Right WaitMillisecondsResp) (error "ret failed")
47+ pure ms
48+