Merge pull request #18 from awakenetworks/fix-crash

Fix client method registration functions

examples/echo/echo-client/Main.hs

@@ -27,7 +27,7 @@ regClient :: IO ()
 regClient = do
   withGRPC $ \grpc ->
     withClient grpc (ClientConfig "localhost" 50051) $ \client -> ntimes 100000 $ do
-      regMethod <- clientRegisterMethod client echoMethod "localhost:50051" Normal
+      regMethod <- clientRegisterMethod client echoMethod Normal
       reqResult <- clientRegisteredRequest client regMethod 1 "hi" M.empty
       case reqResult of
         Left x -> error $ "Got client error: " ++ show x

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

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" $