diff --git a/src/Network/GRPC/LowLevel/Client.hs b/src/Network/GRPC/LowLevel/Client.hs index 9d8603f..a29ee53 100644 --- a/src/Network/GRPC/LowLevel/Client.hs +++ b/src/Network/GRPC/LowLevel/Client.hs @@ -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 diff --git a/tests/LowLevelTests.hs b/tests/LowLevelTests.hs index 8022b16..fda28fb 100644 --- a/tests/LowLevelTests.hs +++ b/tests/LowLevelTests.hs @@ -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" $