eeva/gRPC-haskell
1
0
Fork 0
mirror of https://github.com/unclechu/gRPC-haskell.git synced 2024-11-22 19:19:42 +01:00
Code Issues Projects Releases Wiki Activity

Client helpers, re-exports, and fixups (#70)

Browse source 
* Derive `Show` instance for `ClientSSLKeyCertPair`

* Add a couple client helper functions & add additional exports

* Add `grpc-haskell-core` target; add `c2hs` dep

* Fix examples broken by #68

* rm `build-tools` and `include-dirs` directives from toplevel `.cabal`

* More `ClientConfig` fixes

* Ensure examples are built
This commit is contained in:
intractable 2018-10-14 17:52:59 -05:00 committed by GitHub
parent c80269089c
commit 28288a17b7
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
9 changed files with 121 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
bench/Bench.hs
View file

@ -97,7 +97,7 @@ serverOpts =
main :: IO ()
main = bracket startServer stopServer $ const $ withGRPC $ \grpc ->
withClient grpc (ClientConfig "localhost" 50051 [] Nothing) $ \c -> do
withClient grpc (ClientConfig "localhost" 50051 [] Nothing Nothing) $ \c -> do
rmAdd <- clientRegisterMethodNormal c addMethod
rmClientStream <- clientRegisterMethodClientStreaming c addClientStreamMethod
rmServerStream <- clientRegisterMethodServerStreaming c addServerStreamMethod

5
core/src/Network/GRPC/LowLevel/Client.hs
View file

@ -37,8 +37,9 @@ data Client = Client {clientChannel :: C.Channel,
}
data ClientSSLKeyCertPair = ClientSSLKeyCertPair
{clientPrivateKey :: FilePath,
clientCert :: FilePath}
{ clientPrivateKey :: FilePath,
clientCert :: FilePath
} deriving Show
-- | SSL configuration for the client. It's perfectly acceptable for both fields
-- to be 'Nothing', in which case default fallbacks will be used for the server

2
examples/echo/echo-hs/EchoClient.hs
View file

@ -36,7 +36,7 @@ main = do
cfg = ClientConfig
(Host . fromMaybe "localhost" . unHelpful $ bind)
(Port . fromMaybe 50051 . unHelpful $ port)
[] Nothing
[] Nothing Nothing
withGRPC $ \g -> withClient g cfg $ \c -> do
Echo{..} <- echoClient c
echoDoEcho (ClientNormalRequest rqt 5 mempty) >>= \case

2
examples/hellos/hellos-client/Main.hs
View file

@ -110,7 +110,7 @@ doHelloBi c n = do
highlevelMain :: IO ()
highlevelMain = withGRPC $ \g ->
withClient g (ClientConfig "localhost" 50051 [] Nothing) $ \c -> do
withClient g (ClientConfig "localhost" 50051 [] Nothing Nothing) $ \c -> do
let n = 100000
putStrLn "-------------- HelloSS --------------"
doHelloSS c n

1
examples/tutorial/ArithmeticClient.hs
View file

@ -11,6 +11,7 @@ clientConfig = ClientConfig { clientServerHost = "localhost"
, clientServerPort = 50051
, clientArgs = []
, clientSSLConfig = Nothing
, clientAuthority = Nothing
}
main :: IO ()

1
examples/tutorial/TUTORIAL.md
View file

@ -159,6 +159,7 @@ clientConfig = ClientConfig { clientServerHost = "localhost"
, clientServerPort = 50051
, clientArgs = []
, clientSSLConfig = Nothing
, clientAuthority = Nothing
}
main :: IO ()

3
grpc-haskell.cabal
View file

@ -30,6 +30,7 @@ library
, grpc-haskell-core
, async ==2.1.*
, managed >= 1.0.5
exposed-modules:
Network.GRPC.HighLevel
@ -37,10 +38,8 @@ library
Network.GRPC.HighLevel.Server
Network.GRPC.HighLevel.Server.Unregistered
Network.GRPC.HighLevel.Client
build-tools: c2hs
default-language: Haskell2010
ghc-options: -Wall -fwarn-incomplete-patterns -fno-warn-unused-do-bind
include-dirs: include
hs-source-dirs: src
default-extensions: CPP
CC-Options: -std=c99

33
release.nix
View file

@ -213,7 +213,10 @@ let
(haskellPackagesNew.callPackage ./nix/proto3-suite.nix {});
grpc-haskell-core =
usesGRPC (haskellPackagesNew.callPackage ./core { });
usesGRPC
(pkgs.haskell.lib.overrideCabal
(haskellPackagesNew.callPackage ./core { })
(_: { buildDepends = [ haskellPackagesNew.c2hs ]; }));
grpc-haskell-no-tests =
usesGRPC
@ -242,11 +245,18 @@ let
]);
in rec {
configureFlags = (oldDerivation.configureFlags or []) ++ [
"--flags=with-examples"
];
buildDepends = [
pkgs.makeWrapper
# Give our nix-shell its own cabal so we don't pick up one
# from the user's environment by accident.
haskellPackagesNew.cabal-install
# And likewise for c2hs
haskellPackagesNew.c2hs
];
patches = [ tests/tests.patch ];
@ -299,11 +309,18 @@ let
pkgs = import nixpkgs { inherit config; };
in
{ grpc-haskell-linux = linuxPkgs.haskellPackages.grpc-haskell;
grpc-haskell-darwin = darwinPkgs.haskellPackages.grpc-haskell;
grpc-haskell = pkgs.haskellPackages.grpc-haskell;
grpc-haskell-no-tests = pkgs.haskellPackages.grpc-haskell-no-tests;
grpc-linux = linuxPkgs.grpc;
grpc-darwin = darwinPkgs.grpc;
grpc = pkgs.grpc;
{
grpc-haskell-core-linux = linuxPkgs.haskellPackages.grpc-haskell-core;
grpc-haskell-core-darwin = darwinPkgs.haskellPackages.grpc-haskell-core;
grpc-haskell-core = pkgs.haskellPackages.grpc-haskell-core;
grpc-haskell-linux = linuxPkgs.haskellPackages.grpc-haskell;
grpc-haskell-darwin = darwinPkgs.haskellPackages.grpc-haskell;
grpc-haskell = pkgs.haskellPackages.grpc-haskell;
grpc-haskell-no-tests = pkgs.haskellPackages.grpc-haskell-no-tests;
grpc-linux = linuxPkgs.grpc;
grpc-darwin = darwinPkgs.grpc;
grpc = pkgs.grpc;
}

118
src/Network/GRPC/HighLevel/Client.hs
View file

@ -1,44 +1,58 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
module Network.GRPC.HighLevel.Client
( RegisteredMethod
, TimeoutSeconds
, MetadataMap(..)
, StatusDetails(..)
, GRPCMethodType(..)
, StreamRecv
, StreamSend
, WritesDone
, LL.Client
, ServiceClient
, ClientError(..)
( ClientError(..)
, ClientRegisterable(..)
, ClientRequest(..)
, ClientResult(..)
, ClientRegisterable(..)
, GRPCMethodType(..)
, MetadataMap(..)
, RegisteredMethod
, ServiceClient
, StatusCode(..)
, StatusDetails(..)
, StreamRecv
, StreamSend
, TimeoutSeconds
, WritesDone
, LL.Client
, LL.ClientConfig(..)
, LL.ClientSSLConfig(..)
, LL.ClientSSLKeyCertPair(..)
, LL.Host(..)
, LL.Port(..)
, clientRequest
-- * Client utility functions
, acquireClient
, simplifyUnary
)
where
import qualified Network.GRPC.LowLevel.Client as LL
import qualified Network.GRPC.LowLevel.Call as LL
import Network.GRPC.LowLevel.CompletionQueue (TimeoutSeconds)
import Network.GRPC.LowLevel ( GRPCMethodType(..)
, StatusCode(..)
, StatusDetails(..)
, MetadataMap(..)
, GRPCIOError(..)
, StreamRecv
, StreamSend )
import Network.GRPC.LowLevel.Op (WritesDone)
import Network.GRPC.HighLevel.Server (convertRecv, convertSend)
import Proto3.Suite (Message, toLazyByteString, fromByteString)
import Proto3.Wire.Decode (ParseError)
import qualified Data.ByteString.Lazy as BL
import Control.Monad.Managed (Managed, liftIO,
managed)
import qualified Data.ByteString.Lazy as BL
import Network.GRPC.HighLevel.Server (convertRecv,
convertSend)
import Network.GRPC.LowLevel (GRPCIOError (..),
GRPCMethodType (..),
MetadataMap (..),
StatusCode (..),
StatusDetails (..),
StreamRecv, StreamSend)
import qualified Network.GRPC.LowLevel as LL
import Network.GRPC.LowLevel.CompletionQueue (TimeoutSeconds)
import Network.GRPC.LowLevel.Op (WritesDone)
import Proto3.Suite (Message, fromByteString,
toLazyByteString)
import Proto3.Wire.Decode (ParseError)
newtype RegisteredMethod (mt :: GRPCMethodType) request response
= RegisteredMethod (LL.RegisteredMethod mt)
@ -121,3 +135,45 @@ clientRequest client (RegisteredMethod method) (ClientBiDiRequest timeout meta h
mkResponse (Left ioError_) = ClientErrorResponse (ClientIOError ioError_)
mkResponse (Right (meta_, rspCode_, details_)) =
ClientBiDiResponse meta_ rspCode_ details_
acquireClient
:: LL.ClientConfig
-- ^ The client configuration (host, port, SSL settings, etc)
-> (LL.Client -> IO (ServiceClient service))
-- ^ The client implementation (typically generated)
-> Managed (ServiceClient service)
acquireClient cfg impl = do
g <- managed LL.withGRPC
c <- managed (LL.withClient g cfg)
liftIO (impl c)
-- | A utility for simplifying gRPC client requests in common cases; you can use
-- this to avoid 'ClientRequest' and 'ClientResponse' pattern-matching
-- boilerplate at call sites.
simplifyUnary :: TimeoutSeconds
-- ^ RPC call timeout, in seconds
-> MetadataMap
-- ^ RPC call metadata
-> (ClientError -> IO (b, StatusDetails))
-- ^ Handler for client errors
-> (b -> StatusCode -> StatusDetails -> IO (b, StatusDetails))
-- ^ Handler for non-StatusOK responses
-> (ClientRequest 'Normal a b -> IO (ClientResult 'Normal b))
-- ^ gRPC function implementation (typically generated by gRPC-haskell)
-> (a -> IO (b, StatusDetails))
-- ^ The simplified happy-path (StatusOk) unary call action
simplifyUnary timeout meta clientError nonStatusOkError f x = do
let request = ClientNormalRequest x timeout meta
response <- f request
case response of
ClientNormalResponse y _ _ StatusOk details
-> pure (y, details)
ClientNormalResponse y _ _ code details
-> nonStatusOkError y code details
ClientErrorResponse err
-> clientError err