mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-10 13:19: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 :: ClientConfig -> C.GrpcChannelArgs -> IO C.Channel
|
||||||
createChannel conf@ClientConfig{..} chanargs =
|
createChannel conf@ClientConfig{..} chanargs =
|
||||||
case clientSSLConfig of
|
case clientSSLConfig of
|
||||||
Nothing -> C.grpcInsecureChannelCreate e chanargs C.reserved
|
Nothing ->
|
||||||
|
C.withInsecureChannelCredentials $ \creds ->
|
||||||
|
C.grpcChannelCreate e creds chanargs
|
||||||
Just (ClientSSLConfig rootCertPath Nothing plugin) ->
|
Just (ClientSSLConfig rootCertPath Nothing plugin) ->
|
||||||
do rootCert <- mapM B.readFile rootCertPath
|
do rootCert <- mapM B.readFile rootCertPath
|
||||||
C.withChannelCredentials rootCert Nothing Nothing $ \creds -> do
|
C.withChannelCredentials rootCert Nothing Nothing $ \creds -> do
|
||||||
creds' <- addMetadataCreds creds plugin
|
creds' <- addMetadataCreds creds plugin
|
||||||
C.secureChannelCreate creds' e chanargs C.reserved
|
C.grpcChannelCreate e creds' chanargs
|
||||||
Just (ClientSSLConfig x (Just (ClientSSLKeyCertPair y z)) plugin) ->
|
Just (ClientSSLConfig x (Just (ClientSSLKeyCertPair y z)) plugin) ->
|
||||||
do rootCert <- mapM B.readFile x
|
do rootCert <- mapM B.readFile x
|
||||||
privKey <- Just <$> B.readFile y
|
privKey <- Just <$> B.readFile y
|
||||||
clientCert <- Just <$> B.readFile z
|
clientCert <- Just <$> B.readFile z
|
||||||
C.withChannelCredentials rootCert privKey clientCert $ \creds -> do
|
C.withChannelCredentials rootCert privKey clientCert $ \creds -> do
|
||||||
creds' <- addMetadataCreds creds plugin
|
creds' <- addMetadataCreds creds plugin
|
||||||
C.secureChannelCreate creds' e chanargs C.reserved
|
C.grpcChannelCreate e creds' chanargs
|
||||||
where (Endpoint e) = clientEndpoint conf
|
where (Endpoint e) = clientEndpoint conf
|
||||||
|
|
||||||
createClient :: GRPC -> ClientConfig -> IO Client
|
createClient :: GRPC -> ClientConfig -> IO Client
|
||||||
|
|
|
@ -143,7 +143,8 @@ serverEndpoint ServerConfig{..} = endpoint host port
|
||||||
addPort :: C.Server -> ServerConfig -> IO Int
|
addPort :: C.Server -> ServerConfig -> IO Int
|
||||||
addPort server conf@ServerConfig{..} =
|
addPort server conf@ServerConfig{..} =
|
||||||
case sslConfig of
|
case sslConfig of
|
||||||
Nothing -> C.grpcServerAddInsecureHttp2Port server e
|
Nothing ->
|
||||||
|
C.withInsecureServerCredentials $ C.grpcServerAddHttp2Port server e
|
||||||
Just ServerSSLConfig{..} ->
|
Just ServerSSLConfig{..} ->
|
||||||
do crc <- mapM B.readFile clientRootCert
|
do crc <- mapM B.readFile clientRootCert
|
||||||
spk <- B.readFile serverPrivateKey
|
spk <- B.readFile serverPrivateKey
|
||||||
|
@ -152,7 +153,7 @@ addPort server conf@ServerConfig{..} =
|
||||||
case customMetadataProcessor of
|
case customMetadataProcessor of
|
||||||
Just p -> C.setMetadataProcessor creds p
|
Just p -> C.setMetadataProcessor creds p
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
C.serverAddSecureHttp2Port server e creds
|
C.grpcServerAddHttp2Port server e creds
|
||||||
where e = unEndpoint $ serverEndpoint conf
|
where e = unEndpoint $ serverEndpoint conf
|
||||||
|
|
||||||
startServer :: GRPC -> ServerConfig -> IO Server
|
startServer :: GRPC -> ServerConfig -> IO Server
|
||||||
|
|
|
@ -44,6 +44,19 @@ deriving instance Show Channel
|
||||||
-- | Represents a server. Created on the server side.
|
-- | Represents a server. Created on the server side.
|
||||||
{#pointer *grpc_server as Server newtype #}
|
{#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
|
-- | Represents a pointer to a call. To users of the gRPC core library, this
|
||||||
-- type is abstract; we have no access to its fields.
|
-- type is abstract; we have no access to its fields.
|
||||||
{#pointer *grpc_call as Call newtype #}
|
{#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
|
-- are expected to pass a 'nullPtr' for the 'ChannelArgsPtr'. We currently don't
|
||||||
-- expose any functions for creating channel args, since they are entirely
|
-- expose any functions for creating channel args, since they are entirely
|
||||||
-- undocumented.
|
-- undocumented.
|
||||||
{#fun grpc_insecure_channel_create as ^
|
{#fun grpc_channel_create as ^
|
||||||
{useAsCString* `ByteString', `GrpcChannelArgs', unReserved `Reserved'} -> `Channel'#}
|
{useAsCString* `ByteString', `ChannelCredentials', `GrpcChannelArgs'} -> `Channel'#}
|
||||||
|
|
||||||
{#fun grpc_channel_register_call as ^
|
{#fun grpc_channel_register_call as ^
|
||||||
{`Channel', useAsCString* `ByteString',useAsCString* `ByteString',unReserved `Reserved'}
|
{`Channel', useAsCString* `ByteString',useAsCString* `ByteString',unReserved `Reserved'}
|
||||||
|
@ -258,8 +271,8 @@ getPeerPeek cstr = do
|
||||||
{#fun grpc_server_register_completion_queue as ^
|
{#fun grpc_server_register_completion_queue as ^
|
||||||
{`Server', `CompletionQueue', unReserved `Reserved'} -> `()'#}
|
{`Server', `CompletionQueue', unReserved `Reserved'} -> `()'#}
|
||||||
|
|
||||||
{#fun grpc_server_add_insecure_http2_port as ^
|
{#fun grpc_server_add_http2_port as ^
|
||||||
{`Server', useAsCString* `ByteString'} -> `Int'#}
|
{`Server', useAsCString* `ByteString', `ServerCredentials'} -> `Int'#}
|
||||||
|
|
||||||
-- | Starts a server. To shut down the server, call these in order:
|
-- | Starts a server. To shut down the server, call these in order:
|
||||||
-- 'grpcServerShutdownAndNotify', 'grpcServerCancelAllCalls',
|
-- 'grpcServerShutdownAndNotify', 'grpcServerCancelAllCalls',
|
||||||
|
|
|
@ -20,7 +20,6 @@ import Network.GRPC.LowLevel.GRPC.MetadataMap (MetadataMap)
|
||||||
#include <grpc_haskell.h>
|
#include <grpc_haskell.h>
|
||||||
|
|
||||||
{#import Network.GRPC.Unsafe#}
|
{#import Network.GRPC.Unsafe#}
|
||||||
{#import Network.GRPC.Unsafe.ChannelArgs#}
|
|
||||||
{#import Network.GRPC.Unsafe.Metadata#}
|
{#import Network.GRPC.Unsafe.Metadata#}
|
||||||
{#import Network.GRPC.Unsafe.Op#}
|
{#import Network.GRPC.Unsafe.Op#}
|
||||||
|
|
||||||
|
@ -49,10 +48,6 @@ instance Storable AuthContext where
|
||||||
|
|
||||||
{#pointer *call_credentials as ^ newtype#}
|
{#pointer *call_credentials as ^ newtype#}
|
||||||
|
|
||||||
{#pointer *channel_credentials as ^ newtype#}
|
|
||||||
|
|
||||||
{#pointer *server_credentials as ^ newtype#}
|
|
||||||
|
|
||||||
withAuthPropertyIterator :: AuthContext
|
withAuthPropertyIterator :: AuthContext
|
||||||
-> (AuthPropertyIterator -> IO a)
|
-> (AuthPropertyIterator -> IO a)
|
||||||
-> IO a
|
-> IO a
|
||||||
|
@ -169,6 +164,8 @@ getAuthProperties ctx = withAuthPropertyIterator ctx $ \i -> do
|
||||||
{#fun unsafe ssl_credentials_create_internal as ^
|
{#fun unsafe ssl_credentials_create_internal as ^
|
||||||
{`CString', `CString', `CString'} -> `ChannelCredentials'#}
|
{`CString', `CString', `CString'} -> `ChannelCredentials'#}
|
||||||
|
|
||||||
|
{#fun insecure_credentials_create as ^ {} -> `ChannelCredentials'#}
|
||||||
|
|
||||||
sslChannelCredentialsCreate :: Maybe ByteString
|
sslChannelCredentialsCreate :: Maybe ByteString
|
||||||
-> Maybe ByteString
|
-> Maybe ByteString
|
||||||
-> Maybe ByteString
|
-> Maybe ByteString
|
||||||
|
@ -195,6 +192,10 @@ withChannelCredentials :: Maybe ByteString
|
||||||
withChannelCredentials x y z = bracket (sslChannelCredentialsCreate x y z)
|
withChannelCredentials x y z = bracket (sslChannelCredentialsCreate x y z)
|
||||||
channelCredentialsRelease
|
channelCredentialsRelease
|
||||||
|
|
||||||
|
withInsecureChannelCredentials :: (ChannelCredentials -> IO a) -> IO a
|
||||||
|
withInsecureChannelCredentials =
|
||||||
|
bracket (insecureCredentialsCreate) channelCredentialsRelease
|
||||||
|
|
||||||
-- * Call Credentials
|
-- * Call Credentials
|
||||||
|
|
||||||
{#fun call_set_credentials as ^
|
{#fun call_set_credentials as ^
|
||||||
|
@ -219,6 +220,8 @@ withChannelCredentials x y z = bracket (sslChannelCredentialsCreate x y z)
|
||||||
`SslClientCertificateRequestType'}
|
`SslClientCertificateRequestType'}
|
||||||
-> `ServerCredentials'#}
|
-> `ServerCredentials'#}
|
||||||
|
|
||||||
|
{#fun insecure_server_credentials_create as ^ {} -> `ServerCredentials'#}
|
||||||
|
|
||||||
sslServerCredentialsCreate :: Maybe ByteString
|
sslServerCredentialsCreate :: Maybe ByteString
|
||||||
-- ^ PEM encoding of the client root certificates.
|
-- ^ PEM encoding of the client root certificates.
|
||||||
-- Can be 'Nothing' if SSL authentication of
|
-- 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)
|
withServerCredentials a b c d = bracket (sslServerCredentialsCreate a b c d)
|
||||||
serverCredentialsRelease
|
serverCredentialsRelease
|
||||||
|
|
||||||
-- * Creating Secure Clients/Servers
|
withInsecureServerCredentials :: (ServerCredentials -> IO a) -> IO a
|
||||||
|
withInsecureServerCredentials =
|
||||||
{#fun server_add_secure_http2_port as ^
|
bracket (insecureServerCredentialsCreate) serverCredentialsRelease
|
||||||
{`Server',useAsCString* `ByteString', `ServerCredentials'} -> `Int'#}
|
|
||||||
|
|
||||||
{#fun secure_channel_create as ^
|
|
||||||
{`ChannelCredentials',useAsCString* `ByteString', `GrpcChannelArgs', unReserved `Reserved'}
|
|
||||||
-> `Channel'#}
|
|
||||||
|
|
||||||
-- * Custom metadata processing -- server side
|
-- * Custom metadata processing -- server side
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue