gRPC-haskell/tests/TestClient.hs

136 lines
5.1 KiB
Haskell
Raw Normal View History

2016-08-13 00:48:28 +02:00
{-# 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
2016-08-13 00:48:28 +02:00
import System.Random
import Test.Tasty
import Test.Tasty.HUnit ((@?=), assertFailure, testCase)
2016-08-13 00:48:28 +02:00
testNormalCall client = testCase "Normal call" $
2019-06-18 21:51:25 +02:00
do randoms <- fromList <$> replicateM 1000 (randomRIO (1, 1000))
2016-08-13 00:48:28 +02:00
let req = SimpleServiceRequest "NormalRequest" randoms
res <- simpleServicenormalCall client
2016-08-13 00:48:28 +02:00
(ClientNormalRequest req 10 mempty)
case res of
ClientErrorResponse err -> assertFailure ("ClientErrorResponse: " <> show err)
2016-08-13 00:48:28 +02:00
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 ->
2016-08-13 00:48:28 +02:00
do (finalName, totalSum) <-
fmap ((mconcat *** (sum . mconcat)) . unzip) .
replicateM iterationCount $
2019-06-18 21:51:25 +02:00
do randoms <- fromList <$> replicateM 1000 (randomRIO (1, 1000))
2016-08-13 00:48:28 +02:00
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 -> assertFailure ("ClientErrorResponse: " <> show err)
ClientWriterResponse Nothing _ _ _ _ -> assertFailure "No response received"
2016-08-13 00:48:28 +02:00
ClientWriterResponse (Just res) _ _ stsCode _ ->
do stsCode @?= StatusOk
simpleServiceResponseResponse res @?= finalName
simpleServiceResponseNum res @?= totalSum
testServerStreamingCall client = testCase "Server-streaming call" $
do numCount <- randomRIO (50, 500)
2019-06-18 21:51:25 +02:00
nums <- replicateM numCount randomIO
2016-08-13 00:48:28 +02:00
let checkResults [] recv =
do res <- recv
case res of
Left err -> assertFailure ("recv error: " <> show err)
2016-08-13 00:48:28 +02:00
Right Nothing -> pure ()
Right (Just _) -> assertFailure "recv: elements past end of stream"
2016-08-13 00:48:28 +02:00
checkResults (expNum:nums) recv =
do res <- recv
case res of
Left err -> assertFailure ("recv error: " <> show err)
Right Nothing -> assertFailure ("recv: stream ended earlier than expected")
2016-08-13 00:48:28 +02:00
Right (Just (SimpleServiceResponse response num)) ->
do response @?= "Test"
num @?= expNum
checkResults nums recv
res <- simpleServiceserverStreamingCall client $
2016-08-13 00:48:28 +02:00
ClientReaderRequest (SimpleServiceRequest "Test" (fromList nums)) 10 mempty
(\_ _ -> checkResults nums)
2016-08-13 00:48:28 +02:00
case res of
ClientErrorResponse err -> assertFailure ("ClientErrorResponse: " <> show err)
2016-08-13 00:48:28 +02:00
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)
2019-06-18 21:51:25 +02:00
nums <- fromList <$> replicateM numCount (randomRIO (1, 1000))
2016-08-13 00:48:28 +02:00
testName <- fromString <$> replicateM 10 (randomRIO ('a', 'z'))
send (SimpleServiceRequest testName nums)
res <- recv
case res of
Left err -> assertFailure ("recv error: " <> show err)
2016-08-13 00:48:28 +02:00
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)
2016-08-13 00:48:28 +02:00
case res of
ClientErrorResponse err -> assertFailure ("ClientErrorResponse: " <> show err)
2016-08-13 00:48:28 +02:00
ClientBiDiResponse _ sts _ ->
sts @?= StatusOk
main :: IO ()
main = do
threadDelay 10000000
withGRPC $ \grpc ->
withClient grpc (ClientConfig "localhost" 50051 [] Nothing Nothing) $ \client ->
2016-08-13 00:48:28 +02:00
do service <- simpleServiceClient client
(defaultMain $ testGroup "Send gRPC requests"
[ testNormalCall service
, testClientStreamingCall service
, testServerStreamingCall service
, testBiDiStreamingCall service ]) `finally`
(simpleServicedone service (ClientNormalRequest SimpleServiceDone 10 mempty))