curryer-rpc-0.1: bench/Basic.hs

{-# LANGUAGE DerivingStrategies, DeriveGeneric, DerivingVia #-}
import Network.RPC.Curryer.Server
import Network.RPC.Curryer.Client
import Criterion.Main
import GHC.Generics
import Control.Concurrent.MVar
import Network.Socket (SockAddr(..))
import Codec.Winery
import Control.Concurrent.Async
import Control.Concurrent
import Control.Monad
import qualified Data.ByteString as BS

main :: IO ()
main = do
  --start server shared across benchmarks- gather stats on round-trip requests-responses
  portReadyMVar <- newEmptyMVar
  server <- async (serve benchmarkServerRequestHandlers () localHostAddr 0 (Just portReadyMVar))
  --wait for server to be ready
  (SockAddrInet port _) <- takeMVar portReadyMVar
  clientConn <- connect [] localHostAddr port

  _ <- syncWaitRequest clientConn 100
  let syncWait ms = nfIO (syncWaitRequest clientConn ms)
      syncByteString bs = nfIO (syncByteStringRequest clientConn bs)
      bs0 = BS.empty      
      bs100 = BS.pack (replicate 100 3)
      bs1000 = BS.pack (replicate 1000 3)
      bs1M = BS.pack (replicate 1000000 3)
  defaultMain [bgroup "wait sync" [bench "0 ms" (syncWait 0),
                                   bench "10 ms" (syncWait 10),
                                   bench "100 ms" (syncWait 100)],
                bgroup "bytestring roundtrip" [bench "0 bytes" (syncByteString bs0)
                                              ,bench "100 bytes" (syncByteString bs100)
                                              ,bench "1000 bytes" (syncByteString bs1000)
                                              ,bench "1000000 bytes" (syncByteString bs1M)
                                               ]]

    --TODO: bench for > PIPE_BUF bytes

  close clientConn 
  cancel server

data WaitMillisecondsReq = WaitMillisecondsReq Int --ask the server to respond in X milliseconds
  deriving (Generic, Show)
  deriving Serialise via WineryVariant WaitMillisecondsReq

data WaitByteStringReq = WaitByteStringReq BS.ByteString
  deriving (Generic, Show)
  deriving Serialise via WineryVariant WaitByteStringReq

data WaitMillisecondsResp = WaitMillisecondsResp
  deriving (Generic, Show, Eq)
  deriving Serialise via WineryVariant WaitMillisecondsResp

benchmarkServerRequestHandlers :: RequestHandlers a
benchmarkServerRequestHandlers =
  [RequestHandler $ \_ (WaitMillisecondsReq ms) -> do
      threadDelay (1000 * ms)
      pure WaitMillisecondsResp,
   RequestHandler $ \_ (WaitByteStringReq bs) ->
      pure bs
  ]

--perform 10000 small synchronous requests
syncWaitRequest :: Connection -> Int -> IO Int
syncWaitRequest conn ms = do
  ret <- call conn (WaitMillisecondsReq ms)
  when (ret /= Right WaitMillisecondsResp) (error "ret failed")
  pure ms

syncByteStringRequest :: Connection -> BS.ByteString -> IO BS.ByteString
syncByteStringRequest conn bs = do
  ret <- call conn (WaitByteStringReq bs)
  case ret of
    Right bs' -> pure bs'
    Left err -> error (show err)