mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-23 03:29:42 +01:00
4a30625a70
* Expose the max receive message length channel argument + unittest * `ClientError` GADT ctor => `ClientErrorResponse`, expose `ClientError` Prior to this commit, the name `ClientError` was both: - The name of a data constructor name for the `ClientResult` GADT - A name of an internal sum type for capturing different kinds of client errors We want to expose the latter to users of the library, and so expose the latter and rename the former. * Remove unused `MultiWayIf` lang ext
135 lines
5.1 KiB
Haskell
135 lines
5.1 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
module Main where
|
|
|
|
import Prelude hiding (sum)
|
|
|
|
import Simple
|
|
|
|
import Control.Concurrent
|
|
import Control.Concurrent.MVar
|
|
import Control.Monad
|
|
import Control.Monad.IO.Class
|
|
import Control.Exception
|
|
import Control.Arrow
|
|
|
|
import Data.Monoid
|
|
import Data.Foldable (sum)
|
|
import Data.String
|
|
import Data.Word
|
|
import Data.Vector (fromList)
|
|
|
|
import Network.GRPC.LowLevel
|
|
import Network.GRPC.HighLevel.Client
|
|
|
|
import Proto3.Suite
|
|
|
|
import System.Random
|
|
|
|
import Test.Tasty
|
|
import Test.Tasty.HUnit ((@?=), assertString, testCase)
|
|
|
|
testNormalCall client = testCase "Normal call" $
|
|
do randoms <- fromList <$> replicateM 1000 (Fixed <$> randomRIO (1, 1000))
|
|
let req = SimpleServiceRequest "NormalRequest" randoms
|
|
res <- simpleServiceNormalCall client
|
|
(ClientNormalRequest req 10 mempty)
|
|
case res of
|
|
ClientErrorResponse err -> assertString ("ClientErrorResponse: " <> show err)
|
|
ClientNormalResponse res _ _ stsCode _ ->
|
|
do stsCode @?= StatusOk
|
|
simpleServiceResponseResponse res @?= "NormalRequest"
|
|
simpleServiceResponseNum res @?= sum randoms
|
|
|
|
testClientStreamingCall client = testCase "Client-streaming call" $
|
|
do iterationCount <- randomRIO (5, 50)
|
|
v <- newEmptyMVar
|
|
res <- simpleServiceClientStreamingCall client . ClientWriterRequest 10 mempty $ \send ->
|
|
do (finalName, totalSum) <-
|
|
fmap ((mconcat *** (sum . mconcat)) . unzip) .
|
|
replicateM iterationCount $
|
|
do randoms <- fromList <$> replicateM 1000 (Fixed <$> randomRIO (1, 1000))
|
|
name <- fromString <$> replicateM 10 (randomRIO ('a', 'z'))
|
|
send (SimpleServiceRequest name randoms)
|
|
pure (name, randoms)
|
|
putMVar v (finalName, totalSum)
|
|
|
|
(finalName, totalSum) <- readMVar v
|
|
case res of
|
|
ClientErrorResponse err -> assertString ("ClientErrorResponse: " <> show err)
|
|
ClientWriterResponse Nothing _ _ _ _ -> assertString "No response received"
|
|
ClientWriterResponse (Just res) _ _ stsCode _ ->
|
|
do stsCode @?= StatusOk
|
|
simpleServiceResponseResponse res @?= finalName
|
|
simpleServiceResponseNum res @?= totalSum
|
|
|
|
testServerStreamingCall client = testCase "Server-streaming call" $
|
|
do numCount <- randomRIO (50, 500)
|
|
nums <- replicateM numCount (Fixed <$> randomIO)
|
|
|
|
let checkResults [] recv =
|
|
do res <- recv
|
|
case res of
|
|
Left err -> assertString ("recv error: " <> show err)
|
|
Right Nothing -> pure ()
|
|
Right (Just _) -> assertString "recv: elements past end of stream"
|
|
checkResults (expNum:nums) recv =
|
|
do res <- recv
|
|
case res of
|
|
Left err -> assertString ("recv error: " <> show err)
|
|
Right Nothing -> assertString ("recv: stream ended earlier than expected")
|
|
Right (Just (SimpleServiceResponse response num)) ->
|
|
do response @?= "Test"
|
|
num @?= expNum
|
|
checkResults nums recv
|
|
res <- simpleServiceServerStreamingCall client $
|
|
ClientReaderRequest (SimpleServiceRequest "Test" (fromList nums)) 10 mempty
|
|
(\_ -> checkResults nums)
|
|
case res of
|
|
ClientErrorResponse err -> assertString ("ClientErrorResponse: " <> show err)
|
|
ClientReaderResponse _ sts _ ->
|
|
sts @?= StatusOk
|
|
|
|
testBiDiStreamingCall client = testCase "Bidi-streaming call" $
|
|
do let handleRequests (0 :: Int) _ _ done = done >> pure ()
|
|
handleRequests n recv send done =
|
|
do numCount <- randomRIO (10, 1000)
|
|
nums <- fromList <$> replicateM numCount (Fixed <$> randomRIO (1, 1000))
|
|
testName <- fromString <$> replicateM 10 (randomRIO ('a', 'z'))
|
|
send (SimpleServiceRequest testName nums)
|
|
|
|
res <- recv
|
|
case res of
|
|
Left err -> assertString ("recv error: " <> show err)
|
|
Right Nothing -> pure ()
|
|
Right (Just (SimpleServiceResponse name total)) ->
|
|
do name @?= testName
|
|
total @?= sum nums
|
|
handleRequests (n - 1) recv send done
|
|
|
|
iterations <- randomRIO (50, 500)
|
|
|
|
res <- simpleServiceBiDiStreamingCall client $
|
|
ClientBiDiRequest 10 mempty (\_ -> handleRequests iterations)
|
|
case res of
|
|
ClientErrorResponse err -> assertString ("ClientErrorResponse: " <> show err)
|
|
ClientBiDiResponse _ sts _ ->
|
|
sts @?= StatusOk
|
|
|
|
main :: IO ()
|
|
main = do
|
|
threadDelay 10000000
|
|
withGRPC $ \grpc ->
|
|
withClient grpc (ClientConfig "localhost" 50051 [] Nothing) $ \client ->
|
|
do service <- simpleServiceClient client
|
|
|
|
(defaultMain $ testGroup "Send gRPC requests"
|
|
[ testNormalCall service
|
|
, testClientStreamingCall service
|
|
, testServerStreamingCall service
|
|
, testBiDiStreamingCall service ]) `finally`
|
|
(simpleServiceDone service (ClientNormalRequest SimpleServiceDone 10 mempty))
|