mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-14 07:09:41 +01:00
Fix C API to make it work with gRPC 1.46.3
This commit is contained in:
parent
ffdd8f97ca
commit
d970b473bc
4 changed files with 36 additions and 22 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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',
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in a new issue