eeva/gRPC-haskell
1
0
Fork 0
mirror of https://github.com/unclechu/gRPC-haskell.git synced 2025-02-17 05:35:02 +01:00
Code Issues Projects Releases Wiki Activity

fix up benchmarks to run with latest changes (#72)

Browse source
This commit is contained in:
Connor Clark 2016-08-26 10:21:59 -07:00 • committed by GitHub Enterprise
parent 01fac2d5a6
commit d18d3251e8
1 changed files with 14 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
bench/Bench.hs
View file

@ -1,19 +1,19 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE BangPatterns #-}
import Control.Concurrent
import Control.Concurrent.Async
import Control.Exception (bracket)
import Control.Monad
import Criterion.Main
import Criterion.Types (Config(..))
import Criterion.Types (Config (..))
import qualified Data.ByteString.Lazy as BL
import Data.Word
import Data.Protobuf.Wire.Class
import Data.Protobuf.Wire.Types
import Data.Word
import GHC.Generics (Generic)
import Network.GRPC.HighLevel.Server hiding (serverLoop)
import Network.GRPC.HighLevel.Server.Unregistered (serverLoop)
@ -97,7 +97,7 @@ serverOpts =
main :: IO ()
main = bracket startServer stopServer $ const $ withGRPC $ \grpc ->
withClient grpc (ClientConfig "localhost" 50051 []) $ \c -> do
withClient grpc (ClientConfig "localhost" 50051 [] Nothing) $ \c -> do
rmAdd <- clientRegisterMethodNormal c addMethod
rmClientStream <- clientRegisterMethodClientStreaming c addClientStreamMethod
rmServerStream <- clientRegisterMethodServerStreaming c addServerStreamMethod
@ -155,11 +155,12 @@ main = bracket startServer stopServer $ const $ withGRPC $ \grpc ->
when (sd /= mempty) $ fail $ "bad status details: " ++ show sd
bidiStream c rm i = do
Right (_, _, sd) <- clientRW c rm 5 mempty $ \_ recv send ->
Right (_, _, sd) <- clientRW c rm 5 mempty $ \_ recv send done -> do
forM_ (take i [2,4..]) $ \n -> do
void $ send $ encode $ AddRequest 1 1
Right (Just bs) <- recv
let Right decoded = fromByteString bs
when (decoded /= AddResponse n) $
fail $ "bidiStream: got: " ++ show decoded ++ "expected: " ++ show n
void done
when (sd /= mempty) $ fail $ "bad StatusDetails: " ++ show sd