Generalize endpoint in ClientConfig (#151)

gRPC library supports DNS as a default name-system, but others are supported as well: https://github.com/grpc/grpc/blob/master/doc/naming.md This PR generalizes `ClientConfig` such that any arbitrary endpoints are supported instead of only DNS based TCP/IP connections to a server. The server code is unmodified as that involves lot more work; it can be considered in a future PR. This is a breaking change, but clients only require minimal change to move to the new structure.
awakesecurity · May 25, 2023 · 53614aa · 53614aa
1 parent 0b37ef5
commit 53614aa
Show file tree

Hide file tree

Showing 11 changed files with 27 additions and 37 deletions.
diff --git a/bench/Bench.hs b/bench/Bench.hs
@@ -97,7 +97,7 @@ serverOpts =
 
 main :: IO ()
 main = bracket startServer stopServer $ const $ withGRPC $ \grpc ->
-  withClient grpc (ClientConfig "localhost" 50051 [] Nothing Nothing) $ \c -> do
+  withClient grpc (ClientConfig "localhost:50051" [] Nothing Nothing) $ \c -> do
     rmAdd <- clientRegisterMethodNormal c addMethod
     rmClientStream <- clientRegisterMethodClientStreaming c addClientStreamMethod
     rmServerStream <- clientRegisterMethodServerStreaming c addServerStreamMethod

diff --git a/core/grpc-haskell-core.cabal b/core/grpc-haskell-core.cabal
@@ -1,5 +1,5 @@
 name:                grpc-haskell-core
-version:             0.4.0
+version:             0.5.0
 synopsis:            Haskell implementation of gRPC layered on shared C library.
 homepage:            https://github.com/awakenetworks/gRPC-haskell
 license:             Apache-2.0

diff --git a/core/src/Network/GRPC/LowLevel/Client.hs b/core/src/Network/GRPC/LowLevel/Client.hs
@@ -56,8 +56,7 @@ data ClientSSLConfig = ClientSSLConfig
 
 -- | Configuration necessary to set up a client.
 
-data ClientConfig = ClientConfig {clientServerHost :: Host,
-                                  clientServerPort :: Port,
+data ClientConfig = ClientConfig {clientServerEndpoint :: Endpoint,
                                   clientArgs :: [C.Arg],
                                   -- ^ Optional arguments for setting up the
                                   -- channel on the client. Supplying an empty
@@ -74,9 +73,6 @@ data ClientConfig = ClientConfig {clientServerHost :: Host,
                                   -- pseudo-header will be set to the supplied value.
                                  }
 
-clientEndpoint :: ClientConfig -> Endpoint
-clientEndpoint ClientConfig{..} = endpoint clientServerHost clientServerPort
-
 addMetadataCreds :: C.ChannelCredentials
                     -> Maybe C.ClientMetadataCreate
                     -> IO C.ChannelCredentials
@@ -86,7 +82,7 @@ addMetadataCreds c (Just create) = do
   C.compositeChannelCredentialsCreate c callCreds C.reserved
 
 createChannel :: ClientConfig -> C.GrpcChannelArgs -> IO C.Channel
-createChannel conf@ClientConfig{..} chanargs =
+createChannel ClientConfig{..} chanargs =
   case clientSSLConfig of
     Nothing -> C.grpcInsecureChannelCreate e chanargs C.reserved
     Just (ClientSSLConfig rootCertPath Nothing plugin) ->
@@ -101,7 +97,7 @@ createChannel conf@ClientConfig{..} chanargs =
          C.withChannelCredentials rootCert privKey clientCert $ \creds -> do
            creds' <- addMetadataCreds creds plugin
            C.secureChannelCreate creds' e chanargs C.reserved
-  where (Endpoint e) = clientEndpoint conf
+  where (Endpoint e) = clientServerEndpoint
 
 createClient :: GRPC -> ClientConfig -> IO Client
 createClient grpc clientConfig =
@@ -138,7 +134,7 @@ clientRegisterMethod :: Client
                      -> MethodName
                      -> IO (C.CallHandle)
 clientRegisterMethod Client{..} meth = do
-  let host = fromMaybe (unEndpoint (clientEndpoint clientConfig)) (clientAuthority clientConfig)
+  let host = fromMaybe (unEndpoint (clientServerEndpoint clientConfig)) (clientAuthority clientConfig)
   C.grpcChannelRegisterCall clientChannel
                             (unMethodName meth)
                             host
@@ -149,7 +145,7 @@ clientRegisterMethodNormal :: Client
                            -> MethodName
                            -> IO (RegisteredMethod 'Normal)
 clientRegisterMethodNormal c meth = do
-  let e = clientEndpoint (clientConfig c)
+  let e = clientServerEndpoint (clientConfig c)
   h <- clientRegisterMethod c meth
   return $ RegisteredMethodNormal meth e h
 
@@ -158,15 +154,15 @@ clientRegisterMethodClientStreaming :: Client
                                     -> MethodName
                                     -> IO (RegisteredMethod 'ClientStreaming)
 clientRegisterMethodClientStreaming c meth = do
-  let e = clientEndpoint (clientConfig c)
+  let e = clientServerEndpoint (clientConfig c)
   h <- clientRegisterMethod c meth
   return $  RegisteredMethodClientStreaming meth e h
 
 clientRegisterMethodServerStreaming :: Client
                                     -> MethodName
                                     -> IO (RegisteredMethod 'ServerStreaming)
 clientRegisterMethodServerStreaming c meth = do
-  let e = clientEndpoint (clientConfig c)
+  let e = clientServerEndpoint (clientConfig c)
   h <- clientRegisterMethod c meth
   return $ RegisteredMethodServerStreaming meth e h
 
@@ -175,7 +171,7 @@ clientRegisterMethodBiDiStreaming :: Client
                                   -> MethodName
                                   -> IO (RegisteredMethod 'BiDiStreaming)
 clientRegisterMethodBiDiStreaming c meth = do
-  let e = clientEndpoint (clientConfig c)
+  let e = clientServerEndpoint (clientConfig c)
   h <- clientRegisterMethod c meth
   return $ RegisteredMethodBiDiStreaming meth e h
 

diff --git a/core/src/Network/GRPC/LowLevel/Client/Unregistered.hs b/core/src/Network/GRPC/LowLevel/Client/Unregistered.hs
@@ -16,7 +16,7 @@ import qualified Network.GRPC.Unsafe.Time                           as C
 import           Network.GRPC.LowLevel.Call
 import           Network.GRPC.LowLevel.Client                       (Client (..),
                                                                      NormalRequestResult (..),
-                                                                     clientEndpoint,
+                                                                     clientServerEndpoint,
                                                                      compileNormalRequestResults)
 import           Network.GRPC.LowLevel.CompletionQueue              (TimeoutSeconds)
 import qualified Network.GRPC.LowLevel.CompletionQueue.Unregistered as U
@@ -34,7 +34,7 @@ clientCreateCall Client{..} meth timeout = do
   let parentCall = C.Call nullPtr
   C.withDeadlineSeconds timeout $ \deadline -> do
     U.channelCreateCall clientChannel parentCall C.propagateDefaults
-      clientCQ meth (clientEndpoint clientConfig) deadline
+      clientCQ meth (clientServerEndpoint clientConfig) deadline
 
 withClientCall :: Client
                -> MethodName

diff --git a/core/tests/LowLevelTests.hs b/core/tests/LowLevelTests.hs
@@ -339,7 +339,7 @@ testAuthMetadataPropagate = testCase "auth metadata inherited by children" $ do
                                             (Just "tests/ssl/localhost.crt")
                                             Nothing
                                             (Just server1ClientPlugin)),
-                  clientServerPort = 50052
+                  clientServerEndpoint = "localhost:50052"
                 }
 
     server = do
@@ -673,7 +673,7 @@ testCustomUserAgent =
   where
     clientArgs = [UserAgentPrefix "prefix!", UserAgentSuffix "suffix!"]
     client =
-      TestClient (ClientConfig "localhost" 50051 clientArgs Nothing Nothing) $
+      TestClient (ClientConfig "localhost:50051" clientArgs Nothing Nothing) $
         \c -> do rm <- clientRegisterMethodNormal c "/foo"
                  void $ clientRequest c rm 4 "" mempty
     server = TestServer (serverConf (["/foo"],[],[],[])) $ \s -> do
@@ -694,8 +694,7 @@ testClientCompression =
   where
     client =
       TestClient (ClientConfig
-                   "localhost"
-                   50051
+                   "localhost:50051"
                    [CompressionAlgArg GrpcCompressDeflate]
                    Nothing
                    Nothing) $ \c -> do
@@ -712,8 +711,7 @@ testClientServerCompression :: TestTree
 testClientServerCompression =
   csTest' "client/server compression: no errors" client server
   where
-    cconf = ClientConfig "localhost"
-                         50051
+    cconf = ClientConfig "localhost:50051"
                          [CompressionAlgArg GrpcCompressDeflate]
                          Nothing
                          Nothing
@@ -743,8 +741,7 @@ testClientServerCompressionLvl :: TestTree
 testClientServerCompressionLvl =
   csTest' "client/server compression: no errors" client server
   where
-    cconf = ClientConfig "localhost"
-                         50051
+    cconf = ClientConfig "localhost:50051"
                          [CompressionLevelArg GrpcCompressLevelHigh]
                          Nothing
                          Nothing
@@ -789,7 +786,7 @@ testClientMaxReceiveMessageLengthChannelArg = do
       rm <- clientRegisterMethodNormal c "/foo"
       clientRequest c rm 1 pay mempty >>= k
       where
-        conf = ClientConfig "localhost" 50051 [MaxReceiveMessageLength n] Nothing Nothing
+        conf = ClientConfig "localhost:50051" [MaxReceiveMessageLength n] Nothing Nothing
 
     -- Expect success when the max recv payload size is set to 4 bytes, and we
     -- are sent 4.
@@ -887,7 +884,7 @@ stdTestClient :: (Client -> IO ()) -> TestClient
 stdTestClient = TestClient stdClientConf
 
 stdClientConf :: ClientConfig
-stdClientConf = ClientConfig "localhost" 50051 [] Nothing Nothing
+stdClientConf = ClientConfig "localhost:50051" [] Nothing Nothing
 
 data TestServer = TestServer ServerConfig (Server -> IO ())
 

diff --git a/core/tests/LowLevelTests/Op.hs b/core/tests/LowLevelTests/Op.hs
@@ -79,7 +79,7 @@ serverConf :: ServerConfig
 serverConf = ServerConfig "localhost" 50051 [("/foo")] [] [] [] [] Nothing
 
 clientConf :: ClientConfig
-clientConf = ClientConfig "localhost" 50051 [] Nothing Nothing
+clientConf = ClientConfig "localhost:50051" [] Nothing Nothing
 
 clientEmptySendOps :: [Op]
 clientEmptySendOps =

diff --git a/examples/echo/echo-hs/EchoClient.hs b/examples/echo/echo-hs/EchoClient.hs
@@ -14,12 +14,12 @@ import qualified Data.Text.Lazy                   as TL
 import           Echo
 import           Network.GRPC.HighLevel.Client
 import           Network.GRPC.LowLevel
+import           Network.GRPC.LowLevel.Call       (Endpoint(..))
 import           Options.Generic
 import           Prelude                          hiding (FilePath)
 
 data Args = Args
-  { bind       :: Maybe ByteString <?> "grpc endpoint hostname (default \"localhost\")"
-  , port       :: Maybe Int        <?> "grpc endpoint port (default 50051)"
+  { endpoint   :: Maybe ByteString <?> "grpc endpoint (default \"localhost:50051\")"
   , payload    :: Maybe TL.Text    <?> "string to echo (default \"hullo!\")"
   } deriving (Generic, Show)
 instance ParseRecord Args
@@ -32,8 +32,7 @@ main = do
     rqt      = EchoRequest pay
     expected = EchoResponse pay
     cfg      = ClientConfig
-                 (Host . fromMaybe "localhost" . unHelpful $ bind)
-                 (Port . fromMaybe 50051       . unHelpful $ port)
+                 (Endpoint . fromMaybe "localhost:50051" . unHelpful $ endpoint)
                  [] Nothing Nothing
   withGRPC $ \g -> withClient g cfg $ \c -> do
     Echo{..} <- echoClient c

diff --git a/examples/hellos/hellos-client/Main.hs b/examples/hellos/hellos-client/Main.hs
@@ -110,7 +110,7 @@ doHelloBi c n = do
 
 highlevelMain :: IO ()
 highlevelMain = withGRPC $ \g ->
-  withClient g (ClientConfig "localhost" 50051 [] Nothing Nothing) $ \c -> do
+  withClient g (ClientConfig "localhost:50051" [] Nothing Nothing) $ \c -> do
     let n = 100000
     putStrLn "-------------- HelloSS --------------"
     doHelloSS c n

diff --git a/examples/tutorial/ArithmeticClient.hs b/examples/tutorial/ArithmeticClient.hs
@@ -7,8 +7,7 @@ import           Arithmetic
 import           Network.GRPC.HighLevel.Generated
 
 clientConfig :: ClientConfig
-clientConfig = ClientConfig { clientServerHost = "localhost"
-                            , clientServerPort = 50051
+clientConfig = ClientConfig { clientServerEndpoint = "localhost:50051"
                             , clientArgs = []
                             , clientSSLConfig = Nothing
                             , clientAuthority = Nothing

diff --git a/examples/tutorial/TUTORIAL.md b/examples/tutorial/TUTORIAL.md
@@ -155,8 +155,7 @@ The client-side code generated for us is `arithmeticClient`, which takes a `Clie
 
 ```haskell
 clientConfig :: ClientConfig
-clientConfig = ClientConfig { clientServerHost = "localhost"
-                            , clientServerPort = 50051
+clientConfig = ClientConfig { clientServerEndpoint = "localhost:50051"
                             , clientArgs = []
                             , clientSSLConfig = Nothing
                             , clientAuthority = Nothing

diff --git a/tests/TestClient.hs b/tests/TestClient.hs
@@ -124,7 +124,7 @@ main :: IO ()
 main = do
   threadDelay 10000000
   withGRPC $ \grpc ->
-   withClient grpc (ClientConfig "localhost" 50051 [] Nothing Nothing) $ \client ->
+   withClient grpc (ClientConfig "localhost:50051" [] Nothing Nothing) $ \client ->
     do service <- simpleServiceClient client
 
        (defaultMain $ testGroup "Send gRPC requests"