Fix C API to make it work with gRPC 1.46.3

This commit is contained in:
Viacheslav Lotsmanov 2022-07-28 04:40:26 +03:00
parent ffdd8f97ca
commit d970b473bc
No known key found for this signature in database
GPG key ID: D276FF7467007335
4 changed files with 36 additions and 22 deletions

View file

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

View file

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

View file

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

View file

@ -20,7 +20,6 @@ import Network.GRPC.LowLevel.GRPC.MetadataMap (MetadataMap)
#include <grpc_haskell.h>
{#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