This commit is contained in:
Connor Clark 2016-06-03 14:03:57 -07:00
parent ce56953b24
commit a757e02c30
2 changed files with 34 additions and 16 deletions

View file

@ -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

View file

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