From d970b473bc9ddcef96facae717458c8cb19062a0 Mon Sep 17 00:00:00 2001 From: Viacheslav Lotsmanov Date: Thu, 28 Jul 2022 04:40:26 +0300 Subject: [PATCH] Fix C API to make it work with gRPC 1.46.3 --- core/src/Network/GRPC/LowLevel/Client.hs | 8 +++++--- core/src/Network/GRPC/LowLevel/Server.hs | 5 +++-- core/src/Network/GRPC/Unsafe.chs | 21 ++++++++++++++++---- core/src/Network/GRPC/Unsafe/Security.chs | 24 +++++++++++------------ 4 files changed, 36 insertions(+), 22 deletions(-) diff --git a/core/src/Network/GRPC/LowLevel/Client.hs b/core/src/Network/GRPC/LowLevel/Client.hs index 4d68451..8f7ac50 100644 --- a/core/src/Network/GRPC/LowLevel/Client.hs +++ b/core/src/Network/GRPC/LowLevel/Client.hs @@ -88,19 +88,21 @@ addMetadataCreds c (Just create) = do createChannel :: ClientConfig -> C.GrpcChannelArgs -> IO C.Channel createChannel conf@ClientConfig{..} chanargs = case clientSSLConfig of - Nothing -> C.grpcInsecureChannelCreate e chanargs C.reserved + Nothing -> + C.withInsecureChannelCredentials $ \creds -> + C.grpcChannelCreate e creds chanargs Just (ClientSSLConfig rootCertPath Nothing plugin) -> do rootCert <- mapM B.readFile rootCertPath C.withChannelCredentials rootCert Nothing Nothing $ \creds -> do creds' <- addMetadataCreds creds plugin - C.secureChannelCreate creds' e chanargs C.reserved + C.grpcChannelCreate e creds' chanargs Just (ClientSSLConfig x (Just (ClientSSLKeyCertPair y z)) plugin) -> do rootCert <- mapM B.readFile x privKey <- Just <$> B.readFile y clientCert <- Just <$> B.readFile z C.withChannelCredentials rootCert privKey clientCert $ \creds -> do creds' <- addMetadataCreds creds plugin - C.secureChannelCreate creds' e chanargs C.reserved + C.grpcChannelCreate e creds' chanargs where (Endpoint e) = clientEndpoint conf createClient :: GRPC -> ClientConfig -> IO Client diff --git a/core/src/Network/GRPC/LowLevel/Server.hs b/core/src/Network/GRPC/LowLevel/Server.hs index fc718a4..1094897 100644 --- a/core/src/Network/GRPC/LowLevel/Server.hs +++ b/core/src/Network/GRPC/LowLevel/Server.hs @@ -143,7 +143,8 @@ serverEndpoint ServerConfig{..} = endpoint host port addPort :: C.Server -> ServerConfig -> IO Int addPort server conf@ServerConfig{..} = case sslConfig of - Nothing -> C.grpcServerAddInsecureHttp2Port server e + Nothing -> + C.withInsecureServerCredentials $ C.grpcServerAddHttp2Port server e Just ServerSSLConfig{..} -> do crc <- mapM B.readFile clientRootCert spk <- B.readFile serverPrivateKey @@ -152,7 +153,7 @@ addPort server conf@ServerConfig{..} = case customMetadataProcessor of Just p -> C.setMetadataProcessor creds p Nothing -> return () - C.serverAddSecureHttp2Port server e creds + C.grpcServerAddHttp2Port server e creds where e = unEndpoint $ serverEndpoint conf startServer :: GRPC -> ServerConfig -> IO Server diff --git a/core/src/Network/GRPC/Unsafe.chs b/core/src/Network/GRPC/Unsafe.chs index 8967537..f80f735 100644 --- a/core/src/Network/GRPC/Unsafe.chs +++ b/core/src/Network/GRPC/Unsafe.chs @@ -44,6 +44,19 @@ deriving instance Show Channel -- | Represents a server. Created on the server side. {#pointer *grpc_server as Server newtype #} +deriving instance Show Server + +-- | A server credentials object that represents a way to authenticate a server. +{#pointer *grpc_server_credentials as ServerCredentials newtype #} + +deriving instance Show ServerCredentials + +-- | A channel credentials object represents a way to authenticate a client on a +-- channel. +{#pointer *grpc_channel_credentials as ChannelCredentials newtype #} + +deriving instance Show ChannelCredentials + -- | Represents a pointer to a call. To users of the gRPC core library, this -- type is abstract; we have no access to its fields. {#pointer *grpc_call as Call newtype #} @@ -194,8 +207,8 @@ castPeek p = do -- are expected to pass a 'nullPtr' for the 'ChannelArgsPtr'. We currently don't -- expose any functions for creating channel args, since they are entirely -- undocumented. -{#fun grpc_insecure_channel_create as ^ - {useAsCString* `ByteString', `GrpcChannelArgs', unReserved `Reserved'} -> `Channel'#} +{#fun grpc_channel_create as ^ + {useAsCString* `ByteString', `ChannelCredentials', `GrpcChannelArgs'} -> `Channel'#} {#fun grpc_channel_register_call as ^ {`Channel', useAsCString* `ByteString',useAsCString* `ByteString',unReserved `Reserved'} @@ -258,8 +271,8 @@ getPeerPeek cstr = do {#fun grpc_server_register_completion_queue as ^ {`Server', `CompletionQueue', unReserved `Reserved'} -> `()'#} -{#fun grpc_server_add_insecure_http2_port as ^ - {`Server', useAsCString* `ByteString'} -> `Int'#} +{#fun grpc_server_add_http2_port as ^ + {`Server', useAsCString* `ByteString', `ServerCredentials'} -> `Int'#} -- | Starts a server. To shut down the server, call these in order: -- 'grpcServerShutdownAndNotify', 'grpcServerCancelAllCalls', diff --git a/core/src/Network/GRPC/Unsafe/Security.chs b/core/src/Network/GRPC/Unsafe/Security.chs index 7de77f1..b636877 100644 --- a/core/src/Network/GRPC/Unsafe/Security.chs +++ b/core/src/Network/GRPC/Unsafe/Security.chs @@ -20,7 +20,6 @@ import Network.GRPC.LowLevel.GRPC.MetadataMap (MetadataMap) #include {#import Network.GRPC.Unsafe#} -{#import Network.GRPC.Unsafe.ChannelArgs#} {#import Network.GRPC.Unsafe.Metadata#} {#import Network.GRPC.Unsafe.Op#} @@ -49,10 +48,6 @@ instance Storable AuthContext where {#pointer *call_credentials as ^ newtype#} -{#pointer *channel_credentials as ^ newtype#} - -{#pointer *server_credentials as ^ newtype#} - withAuthPropertyIterator :: AuthContext -> (AuthPropertyIterator -> IO a) -> IO a @@ -169,6 +164,8 @@ getAuthProperties ctx = withAuthPropertyIterator ctx $ \i -> do {#fun unsafe ssl_credentials_create_internal as ^ {`CString', `CString', `CString'} -> `ChannelCredentials'#} +{#fun insecure_credentials_create as ^ {} -> `ChannelCredentials'#} + sslChannelCredentialsCreate :: Maybe ByteString -> Maybe ByteString -> Maybe ByteString @@ -195,6 +192,10 @@ withChannelCredentials :: Maybe ByteString withChannelCredentials x y z = bracket (sslChannelCredentialsCreate x y z) channelCredentialsRelease +withInsecureChannelCredentials :: (ChannelCredentials -> IO a) -> IO a +withInsecureChannelCredentials = + bracket (insecureCredentialsCreate) channelCredentialsRelease + -- * Call Credentials {#fun call_set_credentials as ^ @@ -219,6 +220,8 @@ withChannelCredentials x y z = bracket (sslChannelCredentialsCreate x y z) `SslClientCertificateRequestType'} -> `ServerCredentials'#} +{#fun insecure_server_credentials_create as ^ {} -> `ServerCredentials'#} + sslServerCredentialsCreate :: Maybe ByteString -- ^ PEM encoding of the client root certificates. -- Can be 'Nothing' if SSL authentication of @@ -250,14 +253,9 @@ withServerCredentials :: Maybe ByteString withServerCredentials a b c d = bracket (sslServerCredentialsCreate a b c d) serverCredentialsRelease --- * Creating Secure Clients/Servers - -{#fun server_add_secure_http2_port as ^ - {`Server',useAsCString* `ByteString', `ServerCredentials'} -> `Int'#} - -{#fun secure_channel_create as ^ - {`ChannelCredentials',useAsCString* `ByteString', `GrpcChannelArgs', unReserved `Reserved'} - -> `Channel'#} +withInsecureServerCredentials :: (ServerCredentials -> IO a) -> IO a +withInsecureServerCredentials = + bracket (insecureServerCredentialsCreate) serverCredentialsRelease -- * Custom metadata processing -- server side