mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-12-24 18:59:44 +01:00
fix test
This commit is contained in:
parent
ce56953b24
commit
a757e02c30
2 changed files with 34 additions and 16 deletions
|
@ -18,18 +18,21 @@ import Network.GRPC.LowLevel.Op
|
|||
|
||||
-- | Represents the context needed to perform client-side gRPC operations.
|
||||
data Client = Client {clientChannel :: C.Channel,
|
||||
clientCQ :: CompletionQueue}
|
||||
clientCQ :: CompletionQueue,
|
||||
clientHostPort :: String}
|
||||
|
||||
-- | Configuration necessary to set up a client.
|
||||
data ClientConfig = ClientConfig {clientServerHost :: Host,
|
||||
clientServerPort :: Int}
|
||||
|
||||
createClient :: GRPC -> ClientConfig -> IO Client
|
||||
createClient grpc ClientConfig{..} = do
|
||||
let hostPort = (unHost clientServerHost) ++ ":" ++ (show clientServerPort)
|
||||
chan <- C.grpcInsecureChannelCreate hostPort nullPtr C.reserved
|
||||
cq <- createCompletionQueue grpc
|
||||
return $ Client chan cq
|
||||
createClient grpc conf@ClientConfig{..} = do
|
||||
let clientHostPort = (unHost clientServerHost)
|
||||
++ ":"
|
||||
++ (show clientServerPort)
|
||||
clientChannel <- C.grpcInsecureChannelCreate clientHostPort nullPtr C.reserved
|
||||
clientCQ <- createCompletionQueue grpc
|
||||
return $ Client{..}
|
||||
|
||||
destroyClient :: Client -> IO ()
|
||||
destroyClient Client{..} = do
|
||||
|
@ -54,15 +57,15 @@ clientConnectivity Client{..} =
|
|||
clientRegisterMethod :: Client
|
||||
-> MethodName
|
||||
-- ^ method name, e.g. "/foo"
|
||||
-> Host
|
||||
-- ^ host name, e.g. "localhost"
|
||||
-> GRPCMethodType
|
||||
-> IO RegisteredMethod
|
||||
clientRegisterMethod Client{..} name host Normal = do
|
||||
handle <- C.grpcChannelRegisterCall clientChannel (unMethodName name)
|
||||
(unHost host) C.reserved
|
||||
return $ RegisteredMethod Normal name host handle
|
||||
clientRegisterMethod _ _ _ _ = error "Streaming methods not yet implemented."
|
||||
clientRegisterMethod Client{..} name Normal = do
|
||||
handle <- C.grpcChannelRegisterCall clientChannel
|
||||
(unMethodName name)
|
||||
clientHostPort
|
||||
C.reserved
|
||||
return $ RegisteredMethod Normal name (Host clientHostPort) handle
|
||||
clientRegisterMethod _ _ _ = error "Streaming methods not yet implemented."
|
||||
|
||||
-- | Create a new call on the client for a registered method.
|
||||
-- Returns 'Left' if the CQ is shutting down or if the job to create a call
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module LowLevelTests (lowLevelTests) where
|
||||
module LowLevelTests where
|
||||
|
||||
import Control.Concurrent.Async
|
||||
import Control.Monad
|
||||
|
@ -22,6 +22,7 @@ lowLevelTests = testGroup "Unit tests of low-level Haskell library"
|
|||
, testClientRequestNoServer
|
||||
, testServerAwaitNoClient
|
||||
, testPayloadLowLevelUnregistered
|
||||
, testWrongEndpoint
|
||||
]
|
||||
|
||||
testGRPCBracket :: TestTree
|
||||
|
@ -60,7 +61,7 @@ payloadLowLevelServer = TestServer $ \grpc -> do
|
|||
payloadLowLevelClient :: TestClient
|
||||
payloadLowLevelClient = TestClient $ \grpc ->
|
||||
withClient grpc (ClientConfig "localhost" 50051) $ \client -> do
|
||||
method <- clientRegisterMethod client "/foo" "localhost" Normal
|
||||
method <- clientRegisterMethod client "/foo" Normal
|
||||
putStrLn "registered method on client."
|
||||
let reqMeta = M.fromList [("foo_key", "foo_val")]
|
||||
reqResult <- clientRegisteredRequest client method 10 "Hello!" reqMeta
|
||||
|
@ -102,7 +103,7 @@ testClientRequestNoServer :: TestTree
|
|||
testClientRequestNoServer =
|
||||
grpcTest "Client - request timeout when server DNE" $ \grpc -> do
|
||||
withClient grpc (ClientConfig "localhost" 50051) $ \client -> do
|
||||
method <- clientRegisterMethod client "/foo" "localhost" Normal
|
||||
method <- clientRegisterMethod client "/foo" Normal
|
||||
reqResult <- clientRegisteredRequest client method 1 "Hello" M.empty
|
||||
reqResult @?= (Left GRPCIOTimeout)
|
||||
|
||||
|
@ -133,6 +134,20 @@ testPayloadLowLevel =
|
|||
grpcTest "Client/Server - low-level (registered) request/response" $
|
||||
runClientServer payloadLowLevelClient payloadLowLevelServer
|
||||
|
||||
payloadWrongEndpoint :: TestClient
|
||||
payloadWrongEndpoint = TestClient $ \grpc ->
|
||||
withClient grpc (ClientConfig "localhost" 50051) $ \client -> do
|
||||
method <- clientRegisterMethod client "/bar" Normal
|
||||
reqResult <- clientRegisteredRequest client method 1 "" M.empty
|
||||
reqResult @?= Left (GRPCIOBadStatusCode GrpcStatusDeadlineExceeded
|
||||
(StatusDetails "Deadline Exceeded"))
|
||||
|
||||
|
||||
testWrongEndpoint :: TestTree
|
||||
testWrongEndpoint =
|
||||
grpcTest "Client/Server - client requests unknown endpoint" $
|
||||
runClientServer payloadLowLevelClient payloadLowLevelServer
|
||||
|
||||
testPayloadLowLevelUnregistered :: TestTree
|
||||
testPayloadLowLevelUnregistered =
|
||||
grpcTest "Client/Server - low-level unregistered request/response" $
|
||||
|
|
Loading…
Reference in a new issue