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