136 lines
5.1 KiB
Haskell
136 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 ((@?=), assertFailure, testCase)
|
|
|
|
testNormalCall client = testCase "Normal call" $
|
|
do randoms <- fromList <$> replicateM 1000 (randomRIO (1, 1000))
|
|
let req = SimpleServiceRequest "NormalRequest" randoms
|
|
res <- simpleServicenormalCall client
|
|
(ClientNormalRequest req 10 mempty)
|
|
case res of
|
|
ClientErrorResponse err -> assertFailure ("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 (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 -> assertFailure ("ClientErrorResponse: " <> show err)
|
|
ClientWriterResponse Nothing _ _ _ _ -> assertFailure "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 randomIO
|
|
|
|
let checkResults [] recv =
|
|
do res <- recv
|
|
case res of
|
|
Left err -> assertFailure ("recv error: " <> show err)
|
|
Right Nothing -> pure ()
|
|
Right (Just _) -> assertFailure "recv: elements past end of stream"
|
|
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")
|
|
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 -> assertFailure ("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 (randomRIO (1, 1000))
|
|
testName <- fromString <$> replicateM 10 (randomRIO ('a', 'z'))
|
|
send (SimpleServiceRequest testName nums)
|
|
|
|
res <- recv
|
|
case res of
|
|
Left err -> assertFailure ("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 -> assertFailure ("ClientErrorResponse: " <> show err)
|
|
ClientBiDiResponse _ sts _ ->
|
|
sts @?= StatusOk
|
|
|
|
main :: IO ()
|
|
main = do
|
|
threadDelay 10000000
|
|
withGRPC $ \grpc ->
|
|
withClient grpc (ClientConfig "localhost" 50051 [] Nothing 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))
|