Distinguish hostnames vs "host:port" strings; minor echo client cleanup (#20)

* Remove explicit host:port parameter from clientRequest

* Save ClientConfig in Client ADT; derive host:port string as needed

* Add Port newtype and endpoint string constructor fn

* Introduce Endpoint newtype for host:port strings; derive them as needed; misc cleanup

* Clean up echo client
This commit is contained in:
Joel Stanley 2016-06-06 12:54:43 -05:00
parent 6041ae1cb9
commit d46c0c1c94
7 changed files with 119 additions and 116 deletions

View File

@ -1,37 +1,24 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
import Control.Concurrent (threadDelay)
import Control.Monad (forever)
import Data.ByteString ()
import qualified Data.Map as M
import Network.GRPC.LowLevel
import Control.Monad
import Network.GRPC.LowLevel
echoMethod :: MethodName
echoMethod = MethodName "/echo.Echo/DoEcho"
ntimes :: Int -> IO () -> IO ()
ntimes 1 f = f
ntimes n f = f >> (ntimes (n-1) f)
unregistered c = do
clientRequest c echoMethod 1 "hi" mempty
unregClient :: IO ()
unregClient = do
withGRPC $ \grpc ->
withClient grpc (ClientConfig "localhost" 50051) $ \client ->
ntimes 100000 $ do
reqResult <- clientRequest client echoMethod "localhost:50051" 1 "hi" M.empty
case reqResult of
Left x -> error $ "Got client error: " ++ show x
Right resp -> return ()
registered c = do
meth <- clientRegisterMethod c echoMethod Normal
clientRegisteredRequest c meth 1 "hi" mempty
regClient :: IO ()
regClient = do
withGRPC $ \grpc ->
withClient grpc (ClientConfig "localhost" 50051) $ \client -> ntimes 100000 $ do
regMethod <- clientRegisterMethod client echoMethod Normal
reqResult <- clientRegisteredRequest client regMethod 1 "hi" M.empty
case reqResult of
Left x -> error $ "Got client error: " ++ show x
Right resp -> return ()
run f = withGRPC $ \g -> withClient g (ClientConfig "localhost" 50051) $ \c ->
f c >>= \case
Left e -> error $ "Got client error: " ++ show e
_ -> return ()
main :: IO ()
main = regClient
main = replicateM_ 100 $ run $
registered

View File

@ -21,7 +21,7 @@ Flag Debug
flag with-examples
description: Also build example executables.
manual: True
default: False
default: True
library
build-depends:

View File

@ -28,6 +28,16 @@ newtype MethodName = MethodName {unMethodName :: String}
newtype Host = Host {unHost :: String}
deriving (Show, Eq, IsString)
newtype Port = Port {unPort :: Int}
deriving (Eq, Num, Show)
newtype Endpoint = Endpoint {unEndpoint :: String}
deriving (Show, Eq, IsString)
-- | Given a hostname and port, produces a "host:port" string
endpoint :: Host -> Port -> Endpoint
endpoint (Host h) (Port p) = Endpoint (h ++ ":" ++ show p)
-- | Represents a registered method. Methods can optionally be registered in
-- order to make the C-level request/response code simpler.
-- Before making or awaiting a registered call, the
@ -36,7 +46,7 @@ newtype Host = Host {unHost :: String}
-- Contains state for identifying that method in the underlying gRPC library.
data RegisteredMethod = RegisteredMethod {methodType :: GRPCMethodType,
methodName :: MethodName,
methodHost :: Host,
methodEndpoint :: Endpoint,
methodHandle :: C.CallHandle}
-- | Represents one GRPC call (i.e. request) on the client.

View File

@ -19,20 +19,22 @@ import Network.GRPC.LowLevel.Op
-- | Represents the context needed to perform client-side gRPC operations.
data Client = Client {clientChannel :: C.Channel,
clientCQ :: CompletionQueue,
clientHostPort :: String}
clientConfig :: ClientConfig
}
-- | Configuration necessary to set up a client.
data ClientConfig = ClientConfig {clientServerHost :: Host,
clientServerPort :: Int}
data ClientConfig = ClientConfig {serverHost :: Host,
serverPort :: Port}
clientEndpoint :: ClientConfig -> Endpoint
clientEndpoint ClientConfig{..} = endpoint serverHost serverPort
createClient :: GRPC -> ClientConfig -> IO Client
createClient grpc conf@ClientConfig{..} = do
let clientHostPort = (unHost clientServerHost)
++ ":"
++ (show clientServerPort)
clientChannel <- C.grpcInsecureChannelCreate clientHostPort nullPtr C.reserved
createClient grpc clientConfig = do
let Endpoint e = clientEndpoint clientConfig
clientChannel <- C.grpcInsecureChannelCreate e nullPtr C.reserved
clientCQ <- createCompletionQueue grpc
return $ Client{..}
return Client{..}
destroyClient :: Client -> IO ()
destroyClient Client{..} = do
@ -59,12 +61,11 @@ clientRegisterMethod :: Client
-- ^ method name, e.g. "/foo"
-> GRPCMethodType
-> IO RegisteredMethod
clientRegisterMethod Client{..} name Normal = do
clientRegisterMethod Client{..} meth Normal = do
let e = clientEndpoint clientConfig
handle <- C.grpcChannelRegisterCall clientChannel
(unMethodName name)
clientHostPort
C.reserved
return $ RegisteredMethod Normal name (Host clientHostPort) handle
(unMethodName meth) (unEndpoint e) C.reserved
return $ RegisteredMethod Normal meth e handle
clientRegisterMethod _ _ _ = error "Streaming methods not yet implemented."
-- | Create a new call on the client for a registered method.
@ -97,23 +98,22 @@ withClientRegisteredCall client regmethod timeout f = do
-- method registration machinery. In practice, we'll probably only use the
-- registered method version, but we include this for completeness and testing.
clientCreateCall :: Client
-> MethodName
-- ^ The method name
-> Host
-- ^ The host.
-> TimeoutSeconds
-> IO (Either GRPCIOError ClientCall)
clientCreateCall Client{..} method host timeout = do
-> MethodName
-> TimeoutSeconds
-> IO (Either GRPCIOError ClientCall)
clientCreateCall Client{..} meth timeout = do
let parentCall = C.Call nullPtr
C.withDeadlineSeconds timeout $ \deadline -> do
channelCreateCall clientChannel parentCall C.propagateDefaults
clientCQ method host deadline
clientCQ meth (clientEndpoint clientConfig) deadline
withClientCall :: Client -> MethodName -> Host -> TimeoutSeconds
-> (ClientCall -> IO (Either GRPCIOError a))
-> IO (Either GRPCIOError a)
withClientCall client method host timeout f = do
createResult <- clientCreateCall client method host timeout
withClientCall :: Client
-> MethodName
-> TimeoutSeconds
-> (ClientCall -> IO (Either GRPCIOError a))
-> IO (Either GRPCIOError a)
withClientCall client method timeout f = do
createResult <- clientCreateCall client method timeout
case createResult of
Left x -> return $ Left x
Right call -> f call `finally` logDestroy call
@ -201,18 +201,16 @@ clientRegisteredRequest client@(Client{..}) rm@(RegisteredMethod{..})
clientRequest :: Client
-> MethodName
-- ^ Method name, e.g. "/foo"
-> Host
-- ^ Host. Not sure if used.
-> TimeoutSeconds
-- ^ "Number of seconds until request times out"
-> ByteString
-- ^ Request body.
-> MetadataMap
-- ^ Request metadata.
-> IO (Either GRPCIOError NormalRequestResult)
clientRequest client@(Client{..}) (MethodName method) (Host host)
timeLimit body meta =
fmap join $
withClientCall client (MethodName method) (Host host) timeLimit $ \call -> do
clientRequest client@Client{..} meth timeLimit body meta =
fmap join $ do
withClientCall client meth timeLimit $ \call -> do
let ops = clientNormalRequestOps body meta
results <- runClientOps call clientCQ ops timeLimit
grpcDebug "clientRequest: ops ran."

View File

@ -237,15 +237,18 @@ channelCreateRegisteredCall
handle deadline C.reserved
return $ Right $ ClientCall call
channelCreateCall :: C.Channel -> C.Call -> C.PropagationMask -> CompletionQueue
-> MethodName -> Host -> C.CTimeSpecPtr
-> IO (Either GRPCIOError ClientCall)
channelCreateCall
chan parent mask cq@CompletionQueue{..} (MethodName methodName) (Host host)
deadline =
channelCreateCall :: C.Channel
-> C.Call
-> C.PropagationMask
-> CompletionQueue
-> MethodName
-> Endpoint
-> C.CTimeSpecPtr
-> IO (Either GRPCIOError ClientCall)
channelCreateCall chan parent mask cq@CompletionQueue{..} meth endpt deadline =
withPermission Push cq $ do
call <- C.grpcChannelCreateCall chan parent mask unsafeCQ methodName host
deadline C.reserved
call <- C.grpcChannelCreateCall chan parent mask unsafeCQ
(unMethodName meth) (unEndpoint endpt) deadline C.reserved
return $ Right $ ClientCall call
-- | Create the call object to handle a registered call.

View File

@ -24,41 +24,47 @@ import Network.GRPC.LowLevel.GRPC
import Network.GRPC.LowLevel.Op
-- | Wraps various gRPC state needed to run a server.
data Server = Server {internalServer :: C.Server, serverCQ :: CompletionQueue,
registeredMethods :: [RegisteredMethod]}
data Server = Server
{ internalServer :: C.Server
, serverCQ :: CompletionQueue
, registeredMethods :: [RegisteredMethod]
, serverConfig :: ServerConfig
}
-- | Configuration needed to start a server. There might be more fields that
-- need to be added to this in the future.
data ServerConfig =
ServerConfig {hostName :: Host,
-- ^ Name of the host the server is running on. Not sure
-- how this is used. Setting to "localhost" works fine in tests.
port :: Int,
-- ^ Port to listen for requests on.
methodsToRegister :: [(MethodName, GRPCMethodType)]
-- ^ List of (method name, method host, method type) tuples
-- specifying all methods to register. You can also handle
-- other unregistered methods with `serverHandleNormalCall`.
}
-- | Configuration needed to start a server.
data ServerConfig = ServerConfig
{ host :: Host
-- ^ Name of the host the server is running on. Not sure how this is
-- used. Setting to "localhost" works fine in tests.
, port :: Port
-- ^ Port on which to listen for requests.
, methodsToRegister :: [(MethodName, GRPCMethodType)]
-- ^ List of (method name, method type) tuples specifying all methods to
-- register. You can also handle other unregistered methods with
-- `serverHandleNormalCall`.
}
deriving (Show, Eq)
serverEndpoint :: ServerConfig -> Endpoint
serverEndpoint ServerConfig{..} = endpoint host port
startServer :: GRPC -> ServerConfig -> IO Server
startServer grpc ServerConfig{..} = do
startServer grpc conf@ServerConfig{..} = do
let e = serverEndpoint conf
server <- C.grpcServerCreate nullPtr C.reserved
let hostPort = (unHost hostName) ++ ":" ++ (show port)
actualPort <- C.grpcServerAddInsecureHttp2Port server hostPort
when (actualPort /= port) (error $ "Unable to bind port: " ++ (show port))
actualPort <- C.grpcServerAddInsecureHttp2Port server (unEndpoint e)
when (actualPort /= unPort port) $
error $ "Unable to bind port: " ++ show port
cq <- createCompletionQueue grpc
serverRegisterCompletionQueue server cq
methods <- forM methodsToRegister $
\(name, mtype) ->
serverRegisterMethod server name (Host hostPort) mtype
methods <- forM methodsToRegister $ \(name, mtype) ->
serverRegisterMethod server name e mtype
C.grpcServerStart server
return $ Server server cq methods
return $ Server server cq methods conf
stopServer :: Server -> IO ()
-- TODO: Do method handles need to be freed?
stopServer (Server server cq _) = do
stopServer (Server server cq _ _) = do
grpcDebug "stopServer: calling shutdownNotify."
shutdownNotify
grpcDebug "stopServer: cancelling all calls."
@ -94,25 +100,24 @@ withServer grpc cfg f = bracket (startServer grpc cfg) stopServer f
-- the server is started, so we do it during startup according to the
-- 'ServerConfig'.
serverRegisterMethod :: C.Server
-> MethodName
-- ^ method name, e.g. "/foo"
-> Host
-- ^ host name, e.g. "localhost". I have no idea
-- why this is needed since we have to supply a host
-- name to start a server in the first place. It doesn't
-- seem to have any effect, even if it's filled with
-- nonsense.
-> GRPCMethodType
-- ^ Type of method this will be. In the future, this
-- will be used to switch to the correct handling logic.
-- Currently, the only valid choice is 'Normal'.
-> IO RegisteredMethod
serverRegisterMethod internalServer name host Normal = do
-> MethodName
-- ^ method name, e.g. "/foo"
-> Endpoint
-- ^ Endpoint name name, e.g. "localhost:9999". I have no
-- idea why this is needed since we have to provide these
-- parameters to start a server in the first place. It
-- doesn't seem to have any effect, even if it's filled
-- with nonsense.
-> GRPCMethodType
-- ^ Type of method this will be. In the future, this will
-- be used to switch to the correct handling logic.
-- Currently, the only valid choice is 'Normal'.
-> IO RegisteredMethod
serverRegisterMethod internalServer meth e Normal = do
handle <- C.grpcServerRegisterMethod internalServer
(unMethodName name)
(unHost host)
(unMethodName meth) (unEndpoint e)
grpcDebug $ "registered method to handle " ++ show handle
return $ RegisteredMethod Normal name host handle
return $ RegisteredMethod Normal meth e handle
serverRegisterMethod _ _ _ _ = error "Streaming methods not implemented yet."
-- | Create a 'Call' with which to wait for the invocation of a registered

View File

@ -78,7 +78,7 @@ payloadLowLevelClient = TestClient $ \grpc ->
payloadLowLevelClientUnregistered :: TestClient
payloadLowLevelClientUnregistered = TestClient $ \grpc -> do
withClient grpc (ClientConfig "localhost" 50051) $ \client -> do
reqResult <- clientRequest client "/foo" "localhost" 10 "Hello!" M.empty
reqResult <- clientRequest client "/foo" 10 "Hello!" M.empty
case reqResult of
Left x -> error $ "Client got error: " ++ show x
Right (NormalRequestResult
@ -166,7 +166,7 @@ testWithClientCall =
grpcTest "Client - Create/destroy call" $ \grpc -> do
let conf = ClientConfig "localhost" 50051
withClient grpc conf $ \client -> do
result <- withClientCall client "foo" "localhost" 10 $
result <- withClientCall client "foo" 10 $
const $ return $ Right ()
case result of
Left err -> error $ show err