eeva/gRPC-haskell
1
0
Fork 0
mirror of https://github.com/unclechu/gRPC-haskell.git synced 2024-11-26 21:19:43 +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

27
bench/Bench.hs
View file

@ -1,27 +1,27 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE BangPatterns #-}
import Control.Concurrent import Control.Concurrent
import Control.Concurrent.Async import Control.Concurrent.Async
import Control.Exception (bracket) import Control.Exception (bracket)
import Control.Monad import Control.Monad
import Criterion.Main import Criterion.Main
import Criterion.Types (Config(..)) import Criterion.Types (Config (..))
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import Data.Word
import Data.Protobuf.Wire.Class import Data.Protobuf.Wire.Class
import Data.Protobuf.Wire.Types import Data.Protobuf.Wire.Types
import GHC.Generics (Generic) import Data.Word
import Network.GRPC.HighLevel.Server hiding (serverLoop) import GHC.Generics (Generic)
import Network.GRPC.HighLevel.Server hiding (serverLoop)
import Network.GRPC.HighLevel.Server.Unregistered (serverLoop) import Network.GRPC.HighLevel.Server.Unregistered (serverLoop)
import Network.GRPC.LowLevel import Network.GRPC.LowLevel
import Network.GRPC.LowLevel.GRPC (threadDelaySecs) import Network.GRPC.LowLevel.GRPC (threadDelaySecs)
import System.Random (randomRIO) import System.Random (randomRIO)
data AddRequest = AddRequest {addX :: Fixed Word32 data AddRequest = AddRequest {addX :: Fixed Word32
, addY :: Fixed Word32} , addY :: Fixed Word32}
deriving (Show, Eq, Ord, Generic) deriving (Show, Eq, Ord, Generic)
instance Message AddRequest instance Message AddRequest
@ -97,7 +97,7 @@ serverOpts =
main :: IO () main :: IO ()
main = bracket startServer stopServer $ const $ withGRPC $ \grpc -> 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 rmAdd <- clientRegisterMethodNormal c addMethod
rmClientStream <- clientRegisterMethodClientStreaming c addClientStreamMethod rmClientStream <- clientRegisterMethodClientStreaming c addClientStreamMethod
rmServerStream <- clientRegisterMethodServerStreaming c addServerStreamMethod rmServerStream <- clientRegisterMethodServerStreaming c addServerStreamMethod
@ -155,11 +155,12 @@ main = bracket startServer stopServer $ const $ withGRPC $ \grpc ->
when (sd /= mempty) $ fail $ "bad status details: " ++ show sd when (sd /= mempty) $ fail $ "bad status details: " ++ show sd
bidiStream c rm i = do 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 forM_ (take i [2,4..]) $ \n -> do
void $ send $ encode $ AddRequest 1 1 void $ send $ encode $ AddRequest 1 1
Right (Just bs) <- recv Right (Just bs) <- recv
let Right decoded = fromByteString bs let Right decoded = fromByteString bs
when (decoded /= AddResponse n) $ when (decoded /= AddResponse n) $
fail $ "bidiStream: got: " ++ show decoded ++ "expected: " ++ show n fail $ "bidiStream: got: " ++ show decoded ++ "expected: " ++ show n
void done
when (sd /= mempty) $ fail $ "bad StatusDetails: " ++ show sd when (sd /= mempty) $ fail $ "bad StatusDetails: " ++ show sd