http2-client-grpc 0.7.0.0 → 0.8.0.0
raw patch · 7 files changed
+133/−214 lines, 7 filesdep −lensdep −proto-lensdep ~bytestringdep ~http2dep ~http2-grpc-typessetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies removed: lens, proto-lens
Dependency ranges changed: bytestring, http2, http2-grpc-types, tls
API changes (from Hackage documentation)
- Network.GRPC.Client: RPC :: RPC s
- Network.GRPC.Client: data InvalidParse
- Network.GRPC.Client: data InvalidState
- Network.GRPC.Client: data RPC s (m :: Symbol)
- Network.GRPC.Client: data StreamReplyDecodingError
- Network.GRPC.Client: newtype RPCCall s (meth :: Symbol) a
- Network.GRPC.Client.Helpers: unaryOutput :: (Applicative f, Field3 a1 b1 (Either c1 a2) (Either c1 b2)) => (a2 -> f b2) -> Either c2 (Either c3 a1) -> f (Either c2 (Either c3 b1))
+ Network.GRPC.Client: [rpcFromCall] :: RPCCall r a -> r
+ Network.GRPC.Client: data RPCCall r a
+ Network.GRPC.Client: newtype InvalidParse
+ Network.GRPC.Client: newtype InvalidState
+ Network.GRPC.Client: newtype StreamReplyDecodingError
- Network.GRPC.Client: Abort :: BiDiStep s meth a
+ Network.GRPC.Client: Abort :: BiDiStep i o a
- Network.GRPC.Client: Finalize :: OutgoingEvent s meth b
+ Network.GRPC.Client: Finalize :: OutgoingEvent i b
- Network.GRPC.Client: Headers :: HeaderList -> IncomingEvent s meth a
+ Network.GRPC.Client: Headers :: HeaderList -> IncomingEvent o a
- Network.GRPC.Client: Invalid :: SomeException -> IncomingEvent s meth a
+ Network.GRPC.Client: Invalid :: SomeException -> IncomingEvent o a
- Network.GRPC.Client: RPCCall :: (Http2Client -> Http2Stream -> IncomingFlowControl -> OutgoingFlowControl -> Encoding -> Decoding -> ClientIO a) -> RPCCall s a
+ Network.GRPC.Client: RPCCall :: r -> (Http2Client -> Http2Stream -> IncomingFlowControl -> OutgoingFlowControl -> Encoding -> Decoding -> ClientIO a) -> RPCCall r a
- Network.GRPC.Client: RecvMessage :: MethodOutput s meth -> IncomingEvent s meth a
+ Network.GRPC.Client: RecvMessage :: o -> IncomingEvent o a
- Network.GRPC.Client: SendInput :: !CompressMode -> !MethodInput s meth -> BiDiStep s meth a
+ Network.GRPC.Client: SendInput :: !CompressMode -> !i -> BiDiStep i o a
- Network.GRPC.Client: SendMessage :: CompressMode -> MethodInput s meth -> OutgoingEvent s meth b
+ Network.GRPC.Client: SendMessage :: CompressMode -> i -> OutgoingEvent i b
- Network.GRPC.Client: Trailers :: HeaderList -> IncomingEvent s meth a
+ Network.GRPC.Client: Trailers :: HeaderList -> IncomingEvent o a
- Network.GRPC.Client: WaitOutput :: HandleMessageStep s meth a -> HandleTrailersStep a -> BiDiStep s meth a
+ Network.GRPC.Client: WaitOutput :: HandleMessageStep i o a -> HandleTrailersStep a -> BiDiStep i o a
- Network.GRPC.Client: [runRPC] :: RPCCall s a -> Http2Client -> Http2Stream -> IncomingFlowControl -> OutgoingFlowControl -> Encoding -> Decoding -> ClientIO a
+ Network.GRPC.Client: [runRPC] :: RPCCall r a -> Http2Client -> Http2Stream -> IncomingFlowControl -> OutgoingFlowControl -> Encoding -> Decoding -> ClientIO a
- Network.GRPC.Client: data BiDiStep s meth a
+ Network.GRPC.Client: data BiDiStep i o a
- Network.GRPC.Client: data IncomingEvent s meth a
+ Network.GRPC.Client: data IncomingEvent o a
- Network.GRPC.Client: data OutgoingEvent s meth b
+ Network.GRPC.Client: data OutgoingEvent i b
- Network.GRPC.Client: generalHandler :: (Service s, HasMethod s meth) => RPC s meth -> a -> (a -> IncomingEvent s meth a -> ClientIO a) -> b -> (b -> ClientIO (b, OutgoingEvent s meth b)) -> RPCCall s meth (a, b)
+ Network.GRPC.Client: generalHandler :: (GRPCInput r i, GRPCOutput r o) => r -> a -> (a -> IncomingEvent o a -> ClientIO a) -> b -> (b -> ClientIO (b, OutgoingEvent i b)) -> RPCCall r (a, b)
- Network.GRPC.Client: open :: (Service s, HasMethod s meth) => Http2Client -> Authority -> HeaderList -> Timeout -> Encoding -> Decoding -> RPCCall s meth a -> ClientIO (Either TooMuchConcurrency a)
+ Network.GRPC.Client: open :: IsRPC r => Http2Client -> Authority -> HeaderList -> Timeout -> Encoding -> Decoding -> RPCCall r a -> ClientIO (Either TooMuchConcurrency a)
- Network.GRPC.Client: singleRequest :: (Service s, HasMethod s meth) => RPC s meth -> MethodInput s meth -> RPCCall s meth (RawReply (MethodOutput s meth))
+ Network.GRPC.Client: singleRequest :: (GRPCInput r i, GRPCOutput r o) => r -> i -> RPCCall r (RawReply o)
- Network.GRPC.Client: steppedBiDiStream :: (Service s, HasMethod s meth, MethodStreamingType s meth ~ 'BiDiStreaming) => RPC s meth -> a -> RunBiDiStep s meth a -> RPCCall s meth a
+ Network.GRPC.Client: steppedBiDiStream :: (GRPCInput r i, GRPCOutput r o) => r -> a -> RunBiDiStep i o a -> RPCCall r a
- Network.GRPC.Client: streamReply :: (Service s, HasMethod s meth, MethodStreamingType s meth ~ 'ServerStreaming) => RPC s meth -> a -> MethodInput s meth -> (a -> HeaderList -> MethodOutput s meth -> ClientIO a) -> RPCCall s meth (a, HeaderList, HeaderList)
+ Network.GRPC.Client: streamReply :: (GRPCInput r i, GRPCOutput r o) => r -> a -> i -> (a -> HeaderList -> o -> ClientIO a) -> RPCCall r (a, HeaderList, HeaderList)
- Network.GRPC.Client: streamRequest :: (Service s, HasMethod s meth, MethodStreamingType s meth ~ 'ClientStreaming) => RPC s meth -> a -> (a -> ClientIO (a, Either StreamDone (CompressMode, MethodInput s meth))) -> RPCCall s meth (a, RawReply (MethodOutput s meth))
+ Network.GRPC.Client: streamRequest :: (GRPCInput r i, GRPCOutput r o) => r -> a -> (a -> ClientIO (a, Either StreamDone (CompressMode, i))) -> RPCCall r (a, RawReply o)
- Network.GRPC.Client: type HandleMessageStep s meth a = HeaderList -> a -> MethodOutput s meth -> ClientIO a
+ Network.GRPC.Client: type HandleMessageStep i o a = HeaderList -> a -> o -> ClientIO a
- Network.GRPC.Client: type RawReply a = Either ErrorCode (CIHeaderList, Maybe CIHeaderList, (Either String a))
+ Network.GRPC.Client: type RawReply a = Either ErrorCode (CIHeaderList, Maybe CIHeaderList, Either String a)
- Network.GRPC.Client.Helpers: rawGeneralStream :: (Service s, HasMethod s m) => RPC s m -> GrpcClient -> a -> (a -> IncomingEvent s m a -> ClientIO a) -> b -> (b -> ClientIO (b, OutgoingEvent s m b)) -> ClientIO (Either TooMuchConcurrency (a, b))
+ Network.GRPC.Client.Helpers: rawGeneralStream :: (GRPCInput r i, GRPCOutput r o) => r -> GrpcClient -> a -> (a -> IncomingEvent o a -> ClientIO a) -> b -> (b -> ClientIO (b, OutgoingEvent i b)) -> ClientIO (Either TooMuchConcurrency (a, b))
- Network.GRPC.Client.Helpers: rawSteppedBidirectional :: (Service s, HasMethod s m, MethodStreamingType s m ~ 'BiDiStreaming) => RPC s m -> GrpcClient -> a -> RunBiDiStep s m a -> ClientIO (Either TooMuchConcurrency a)
+ Network.GRPC.Client.Helpers: rawSteppedBidirectional :: (GRPCInput r i, GRPCOutput r o) => r -> GrpcClient -> a -> RunBiDiStep i o a -> ClientIO (Either TooMuchConcurrency a)
- Network.GRPC.Client.Helpers: rawStreamClient :: (Service s, HasMethod s m, MethodStreamingType s m ~ 'ClientStreaming) => RPC s m -> GrpcClient -> a -> (a -> ClientIO (a, Either StreamDone (CompressMode, MethodInput s m))) -> ClientIO (Either TooMuchConcurrency (a, RawReply (MethodOutput s m)))
+ Network.GRPC.Client.Helpers: rawStreamClient :: (GRPCInput r i, GRPCOutput r o) => r -> GrpcClient -> a -> (a -> ClientIO (a, Either StreamDone (CompressMode, i))) -> ClientIO (Either TooMuchConcurrency (a, RawReply o))
- Network.GRPC.Client.Helpers: rawStreamServer :: (Service s, HasMethod s m, MethodStreamingType s m ~ 'ServerStreaming) => RPC s m -> GrpcClient -> a -> MethodInput s m -> (a -> HeaderList -> MethodOutput s m -> ClientIO a) -> ClientIO (Either TooMuchConcurrency (a, HeaderList, HeaderList))
+ Network.GRPC.Client.Helpers: rawStreamServer :: (GRPCInput r i, GRPCOutput r o) => r -> GrpcClient -> a -> i -> (a -> HeaderList -> o -> ClientIO a) -> ClientIO (Either TooMuchConcurrency (a, HeaderList, HeaderList))
- Network.GRPC.Client.Helpers: rawUnary :: (Service s, HasMethod s m) => RPC s m -> GrpcClient -> MethodInput s m -> ClientIO (Either TooMuchConcurrency (RawReply (MethodOutput s m)))
+ Network.GRPC.Client.Helpers: rawUnary :: (GRPCInput r i, GRPCOutput r o) => r -> GrpcClient -> i -> ClientIO (Either TooMuchConcurrency (RawReply o))
Files
- Changelog.md +4/−0
- LICENSE +1/−1
- README.md +1/−73
- Setup.hs +2/−3
- http2-client-grpc.cabal +10/−12
- src/Network/GRPC/Client.hs +90/−91
- src/Network/GRPC/Client/Helpers.hs +25/−34
Changelog.md view
@@ -2,6 +2,10 @@ ## Unreleased changes +## 0.8.0.0++Fork `http2-client-grpc` to drop dependency on `proto-lens`.+ ## 0.6.0.0 Update to http2-client-0.9.0.0
LICENSE view
@@ -1,4 +1,4 @@-Copyright Author name here (c) 2017+Copyright Lucas Di Cioccio (c) 2017 All rights reserved.
README.md view
@@ -1,75 +1,3 @@ # http2-client-grpc -A native HTTP2 gRPC client library using `proto-lens` and `http2-client`.--## Summary--This project provides a library that leverages the code generated using-proto-lens (in particular, proto-lens-protoc) to implement the client-side of-gRPC services.--## Usage--### Prerequisites--In addition to a working Haskell dev environment, you need to:-- build the `proto-lens-protoc` executable (`proto-lens`)-- install the `protoc` executable--### Adding .proto files to a Haskell package--In order to run gRPC:--- generate the `Proto` stubs in some `gen` directory--A single `protoc` invocation may be enough for both Proto and GRPC outputs:--```bash-protoc "--plugin=protoc-gen-haskell-protolens=${protolens}" \- --haskell-protolens_out=./gen \- -I "${protodir1} \- -I "${protodir2} \- ${first.proto} \- ${second.proto}-```--- add the `gen` sourcedir for the generated to your .cabal/package.yaml file (cf. 'hs-source-dirs').-- add the generated Proto modules to the 'exposed-modules' (or 'other-modules') keys--A reliable way to list the module names is the following bash invocation:--```bash-find gen -name "*.hs" | sed -e 's/gen\///' | sed -e 's/\.hs$//' | tr '/' '.'-```--Unlike `proto-lens`, this project does not yet provide a modified `Setup.hs`.-As a result, we cannot automate these steps from within Cabal/Stack. Hence,-you'll have to automate these steps outside your Haskell toolchain.--## Calling a GRPC service--In short, use `http2-client` with the `Network.GRPC.call` function and let the types guide you.--### Example--You'll find an example leveraging the awesome `grpcb.in` service at https://github.com/lucasdicioccio/http2-client-grpc-example .--### gRPC service mapping--The Protobuf format specifies the notion of Service which can have one or more-RPCs. The gRPC protocal maps these services onto HTTP2 headers and HTTP2-frames. In general, gRPC implementation generate one inlined function per RPC.-This implementation differs by decoupling the HTTP2 transport and leveraging-generics to provide generic functions. This design allows the-`Network.GRPC.call` to be type safe and multi-usage. For instance, you can wrap-this function with whatever metrics/benchmark code and have all your RPC calls-be monitored in a uniform way.--## Status--This library is currently an early-stage library. Expect breaking changes.--## Next steps--- provide function to map raw results into commonly-understood GRPC errors-- (nice-to-have) support effectful compression (Zlib pure compression is supported)+A native HTTP2 gRPC client library using `http2-client`.
Setup.hs view
@@ -1,3 +1,2 @@-import Data.ProtoLens.Setup--main = defaultMain "."+import Distribution.Simple+main = defaultMain
http2-client-grpc.cabal view
@@ -1,13 +1,13 @@ name: http2-client-grpc-version: 0.7.0.0+version: 0.8.0.0 synopsis: Implement gRPC-over-HTTP2 clients.-description: A gRPC over http2-client using proto-lens to generate client code.-homepage: https://github.com/lucasdicioccio/http2-client-grpc#readme+description: A gRPC over http2-client.+homepage: https://github.com/haskell-grpc-native/http2-grpc-haskell/blob/master/http2-client-grpc/README.md license: BSD3 license-file: LICENSE-author: Lucas DiCioccio+author: Lucas DiCioccio, Alejandro Serrano maintainer: lucas@dicioccio.fr-copyright: 2017 Lucas DiCioccio+copyright: 2017 - 2019 Lucas DiCioccio, Alejandro Serrano category: Network build-type: Simple extra-source-files: README.md Changelog.md@@ -20,18 +20,16 @@ build-depends: base >= 4.11 && < 5 , async >= 2.2 && < 2.3 , binary >= 0.8 && < 0.9- , bytestring >= 0.10.8 && < 0.10.9+ , bytestring >= 0.10.8 && < 0.11 , case-insensitive >= 1.2.0 && < 1.3 , data-default-class >= 0.1 && <0.2- , lens >= 4.16 && < 4.18 , lifted-async >= 0.10 && < 0.11 , lifted-base >= 0.2 && < 0.3- , http2 >= 1.6 && < 1.7+ , http2 >= 1.6 && < 2.1 , http2-client >= 0.9 && < 0.10- , http2-grpc-types >= 0.4 && < 0.5- , proto-lens >= 0.5 && < 0.6+ , http2-grpc-types >= 0.5 && < 0.6 , text >= 1.2 && < 1.3- , tls >= 1.4 && < 1.5+ , tls >= 1.4 && < 1.6 default-language: Haskell2010 test-suite http2-client-grpc-test@@ -45,4 +43,4 @@ source-repository head type: git- location: https://github.com/lucasdicioccio/http2-client-grpc+ location: https://github.com/haskell-grpc-native/http2-grpc-haskell
src/Network/GRPC/Client.hs view
@@ -47,8 +47,7 @@ -- inspiration from the existing RPC functions and learn how to write one. module Network.GRPC.Client ( -- * Building blocks.- RPC(..)- , RPCCall(..)+ RPCCall(..) , CIHeaderList , Authority , Timeout(..)@@ -84,7 +83,6 @@ import Control.Concurrent.Async.Lifted (concurrently) import Control.Exception (SomeException, Exception(..), throwIO) import Control.Monad.IO.Class (liftIO)-import Data.ByteString.Char8 (unpack) import Data.ByteString.Lazy (toStrict) import Data.Binary.Builder (toLazyByteString) import Data.Binary.Get (Decoder(..), pushChunk, pushEndOfInput)@@ -93,8 +91,6 @@ import Data.CaseInsensitive (CI) import qualified Data.CaseInsensitive as CI import Data.Monoid ((<>))-import Data.ProtoLens.Service.Types (Service(..), HasMethod, HasMethodImpl(..), StreamingType(..))-import GHC.TypeLits (Symbol) import Network.GRPC.HTTP2.Types import Network.GRPC.HTTP2.Encoding@@ -115,7 +111,7 @@ -- - 1st item: initial HTTP2 response -- - 2nd item: second (trailers) HTTP2 response -- - 3rd item: proper gRPC answer-type RawReply a = Either ErrorCode (CIHeaderList, Maybe CIHeaderList, (Either String a))+type RawReply a = Either ErrorCode (CIHeaderList, Maybe CIHeaderList, Either String a) -- | gRPC disables HTTP2 push-promises. --@@ -128,8 +124,11 @@ throwOnPushPromise _ _ _ _ _ = lift $ throwIO UnallowedPushPromiseReceived -- | Wait for an RPC reply.-waitReply :: (Service s, HasMethod s meth) => RPC s meth -> Decoding -> Http2Stream -> IncomingFlowControl -> ClientIO (RawReply (MethodOutput s meth))-waitReply rpc decoding stream flowControl = do+waitReply+ :: (GRPCOutput r o)+ => r -> Decoding -> Http2Stream -> IncomingFlowControl+ -> ClientIO (RawReply o)+waitReply rpc decoding stream flowControl = format . fromStreamResult <$> waitStream stream flowControl throwOnPushPromise where decompress = _getDecodingCompression decoding@@ -141,8 +140,10 @@ -- presence of a message indicate an error -- TODO: double check this is true in general case lookup grpcMessageH hdrs2 of- Nothing -> fromDecoder $ pushEndOfInput $ flip pushChunk dat $ decodeOutput rpc decompress- Just errMsg -> Left $ unpack errMsg+ Nothing -> fromDecoder $ pushEndOfInput+ $ flip pushChunk dat+ $ decodeOutput rpc decompress+ Just errMsg -> Left $ ByteString.unpack errMsg return (hdrs2, trls2, res) @@ -151,27 +152,25 @@ -- | Exception raised when a ServerStreaming RPC results in a decoding -- error.-data StreamReplyDecodingError = StreamReplyDecodingError String deriving Show+newtype StreamReplyDecodingError = StreamReplyDecodingError String deriving Show instance Exception StreamReplyDecodingError where -- | Exception raised when a ServerStreaming RPC results in an invalid -- state machine.-data InvalidState = InvalidState String- deriving Show+newtype InvalidState = InvalidState String deriving Show instance Exception InvalidState where -- | Newtype helper used to uniformize all type of streaming modes when -- passing arguments to the 'open' call.-newtype RPCCall s (meth ::Symbol) a = RPCCall {- runRPC :: Http2Client -> Http2Stream -> IncomingFlowControl -> OutgoingFlowControl -> Encoding -> Decoding -> ClientIO a+data RPCCall r a = RPCCall {+ rpcFromCall :: r+ , runRPC :: Http2Client -> Http2Stream+ -> IncomingFlowControl -> OutgoingFlowControl+ -> Encoding -> Decoding -> ClientIO a } --- | Helper to get the proxy object from an RPCCall.-rpcFromCall :: RPCCall s meth a -> RPC s meth-rpcFromCall _ = RPC- -- | Main handler to perform gRPC calls to a service.-open :: (Service s, HasMethod s meth)+open :: (IsRPC r) => Http2Client -- ^ A connected HTTP2 client. -> Authority@@ -184,7 +183,7 @@ -- ^ Compression used for encoding. -> Decoding -- ^ Compression allowed for decoding- -> RPCCall s meth a+ -> RPCCall r a -- ^ The actual RPC handler. -> ClientIO (Either TooMuchConcurrency a) open conn authority extraheaders timeout encoding decoding call = do@@ -203,33 +202,32 @@ ] <> extraheaders withHttp2Stream conn $ \stream -> let- initStream = headers stream request (setEndHeader)- handler isfc osfc = do- (runRPC call) conn stream isfc osfc encoding decoding+ initStream = headers stream request setEndHeader+ handler isfc osfc = runRPC call conn stream isfc osfc encoding decoding in StreamDefinition initStream handler -- | gRPC call for Server Streaming. streamReply- :: (Service s, HasMethod s meth, MethodStreamingType s meth ~ 'ServerStreaming)- => RPC s meth+ :: (GRPCInput r i, GRPCOutput r o)+ => r -- ^ RPC to call. -> a -- ^ An initial state.- -> MethodInput s meth+ -> i -- ^ The input.- -> (a -> HeaderList -> MethodOutput s meth -> ClientIO a)+ -> (a -> HeaderList -> o -> ClientIO a) -- ^ A state-passing handler that is called with the message read.- -> RPCCall s meth (a, HeaderList, HeaderList)-streamReply rpc v0 req handler = RPCCall $ \conn stream isfc osfc encoding decoding -> do+ -> RPCCall r (a, HeaderList, HeaderList)+streamReply rpc v0 req handler = RPCCall rpc $ \conn stream isfc osfc encoding decoding -> let { loop v1 decode hdrs = _waitEvent stream >>= \case- (StreamPushPromiseEvent _ _ _) ->+ StreamPushPromiseEvent {} -> lift $ throwIO UnallowedPushPromiseReceived- (StreamHeadersEvent _ trls) ->+ StreamHeadersEvent _ trls -> return (v1, hdrs, trls)- (StreamErrorEvent _ _) ->+ StreamErrorEvent _ _ -> lift $ throwIO (InvalidState "stream error")- (StreamDataEvent _ dat) -> do+ StreamDataEvent _ dat -> do liftIO $ _addCredit isfc (ByteString.length dat) _ <- liftIO $ _consumeCredit isfc (ByteString.length dat) _ <- _updateWindow isfc@@ -246,13 +244,13 @@ where handleAllChunks decoding v1 hdrs decode dat exitLoop = case pushChunk decode dat of- (Done unusedDat _ (Right val)) -> do+ Done unusedDat _ (Right val) -> do v2 <- handler v1 hdrs val let decompress = _getDecodingCompression decoding handleAllChunks decoding v2 hdrs (decodeOutput rpc decompress) unusedDat exitLoop- (Done _ _ (Left err)) -> do+ Done _ _ (Left err) -> lift $ throwIO (StreamReplyDecodingError $ "done-error: " ++ err)- (Fail _ _ err) -> do+ Fail _ _ err -> lift $ throwIO (StreamReplyDecodingError $ "fail-error: " ++ err) partial@(Partial _) -> exitLoop v1 partial hdrs@@ -263,15 +261,15 @@ -- | gRPC call for Client Streaming. streamRequest- :: (Service s, HasMethod s meth, MethodStreamingType s meth ~ 'ClientStreaming)- => RPC s meth+ :: (GRPCInput r i, GRPCOutput r o)+ => r -- ^ RPC to call. -> a -- ^ An initial state.- -> (a -> ClientIO (a, Either StreamDone (CompressMode, MethodInput s meth)))+ -> (a -> ClientIO (a, Either StreamDone (CompressMode, i))) -- ^ A state-passing action to retrieve the next message to send to the server.- -> RPCCall s meth (a, RawReply (MethodOutput s meth))-streamRequest rpc v0 handler = RPCCall $ \conn stream isfc streamFlowControl encoding decoding ->+ -> RPCCall r (a, RawReply o)+streamRequest rpc v0 handler = RPCCall rpc$ \conn stream isfc streamFlowControl encoding decoding -> let ocfc = _outgoingFlowControl conn go v1 = do (v2, nextEvent) <- handler v1@@ -280,7 +278,8 @@ let compress = case doCompress of Compressed -> _getEncodingCompression encoding Uncompressed -> uncompressed- sendSingleMessage rpc msg (Encoding compress) id conn ocfc stream streamFlowControl+ sendSingleMessage rpc msg (Encoding compress) id+ conn ocfc stream streamFlowControl go v2 Left _ -> do sendData conn stream setEndStream ""@@ -290,9 +289,9 @@ -- | Serialize and send a single message. sendSingleMessage- :: (Service s, HasMethod s meth)- => RPC s meth- -> MethodInput s meth+ :: (GRPCInput r i)+ => r+ -> i -> Encoding -> FlagSetter -> Http2Client@@ -317,28 +316,28 @@ -- | gRPC call for an unary request. singleRequest- :: (Service s, HasMethod s meth)- => RPC s meth+ :: (GRPCInput r i, GRPCOutput r o)+ => r -- ^ RPC to call.- -> MethodInput s meth+ -> i -- ^ RPC's input.- -> RPCCall s meth (RawReply (MethodOutput s meth))-singleRequest rpc msg = RPCCall $ \conn stream isfc osfc encoding decoding -> do+ -> RPCCall r (RawReply o)+singleRequest rpc msg = RPCCall rpc $ \conn stream isfc osfc encoding decoding -> do let ocfc = _outgoingFlowControl conn sendSingleMessage rpc msg encoding setEndStream conn ocfc stream osfc waitReply rpc decoding stream isfc -- | Handler for received message.-type HandleMessageStep s meth a = HeaderList -> a -> MethodOutput s meth -> ClientIO a+type HandleMessageStep i o a = HeaderList -> a -> o -> ClientIO a -- | Handler for received trailers. type HandleTrailersStep a = HeaderList -> a -> HeaderList -> ClientIO a -data BiDiStep s meth a =+data BiDiStep i o a = Abort -- ^ Finalize and return the current state.- | SendInput !CompressMode !(MethodInput s meth)+ | SendInput !CompressMode !i -- ^ Sends a single message.- | WaitOutput (HandleMessageStep s meth a) (HandleTrailersStep a)+ | WaitOutput (HandleMessageStep i o a) (HandleTrailersStep a) -- ^ Wait for information from the server, handlers can modify the state. -- | State-based function.@@ -351,15 +350,15 @@ -- See 'BiDiStep' and 'RunBiDiStep' to understand the type of programs one can -- write with this function. steppedBiDiStream- :: (Service s, HasMethod s meth, MethodStreamingType s meth ~ 'BiDiStreaming)- => RPC s meth+ :: (GRPCInput r i, GRPCOutput r o)+ => r -- ^ RPC to call. -> a -- ^ An initial state.- -> RunBiDiStep s meth a+ -> RunBiDiStep i o a -- ^ The program.- -> RPCCall s meth a-steppedBiDiStream rpc v0 handler = RPCCall $ \conn stream isfc streamFlowControl encoding decoding ->+ -> RPCCall r a+steppedBiDiStream rpc v0 handler = RPCCall rpc $ \conn stream isfc streamFlowControl encoding decoding -> let ocfc = _outgoingFlowControl conn decompress = _getDecodingCompression decoding newDecoder = decodeOutput rpc decompress@@ -373,33 +372,33 @@ Uncompressed -> uncompressed sendSingleMessage rpc msg (Encoding compress) id conn ocfc stream streamFlowControl handler v1 >>= goStep hdrs decode- goStep jhdrs@(Just hdrs) decode unchanged@(v1, WaitOutput handleMsg handleEof) = do+ goStep jhdrs@(Just hdrs) decode unchanged@(v1, WaitOutput handleMsg handleEof) = _waitEvent stream >>= \case- (StreamPushPromiseEvent _ _ _) ->+ StreamPushPromiseEvent {} -> lift $ throwIO UnallowedPushPromiseReceived- (StreamHeadersEvent _ trls) -> do+ StreamHeadersEvent _ trls -> do v2 <- handleEof hdrs v1 trls -- TODO: consider failing the decoder here handler v2 >>= goStep jhdrs newDecoder- (StreamErrorEvent _ _) ->+ StreamErrorEvent _ _ -> lift $ throwIO (InvalidState "stream error")- (StreamDataEvent _ dat) -> do+ StreamDataEvent _ dat -> do liftIO $ _addCredit isfc (ByteString.length dat) _ <- liftIO $ _consumeCredit isfc (ByteString.length dat) _ <- _updateWindow isfc case pushChunk decode dat of- (Done unusedDat _ (Right val)) -> do+ Done unusedDat _ (Right val) -> do v2 <- handleMsg hdrs v1 val handler v2 >>= goStep jhdrs (pushChunk newDecoder unusedDat)- (Done _ _ (Left err)) -> do+ Done _ _ (Left err) -> lift $ throwIO $ InvalidParse $ "done-err: " ++ err- (Fail _ _ err) ->+ Fail _ _ err -> lift $ throwIO $ InvalidParse $ "done-fail: " ++ err- partial@(Partial _) -> do+ partial@(Partial _) -> goStep jhdrs partial unchanged- goStep Nothing decode unchanged = do+ goStep Nothing decode unchanged = _waitEvent stream >>= \case- (StreamHeadersEvent _ hdrs) ->+ StreamHeadersEvent _ hdrs -> goStep (Just hdrs) decode unchanged _ -> lift $ throwIO (InvalidState "no headers")@@ -408,14 +407,14 @@ -- | Exception raised when a BiDiStreaming RPC results in an invalid -- parse.-data InvalidParse = InvalidParse String deriving Show+newtype InvalidParse = InvalidParse String deriving Show instance Exception InvalidParse where -- | An event for the incoming loop of 'generalHandler'.-data IncomingEvent s meth a =+data IncomingEvent o a = Headers HeaderList -- ^ The server sent some initial metadata with the headers.- | RecvMessage (MethodOutput s meth)+ | RecvMessage o -- ^ The server send a message. | Trailers HeaderList -- ^ The server send final metadata (the loop stops).@@ -423,10 +422,10 @@ -- ^ Something went wrong (the loop stops). -- | An event for the outgoing loop of 'generalHandler'.-data OutgoingEvent s meth b =+data OutgoingEvent i b = Finalize -- ^ The client is done with the RPC (the loop stops).- | SendMessage CompressMode (MethodInput s meth)+ | SendMessage CompressMode i -- ^ The client sends a message to the server. -- | General RPC handler for decorrelating the handling of received@@ -441,19 +440,19 @@ -- and stops on Trailers or Invalid. The other loop waits for messages to send to -- the server or finalize and returns. generalHandler - :: (Service s, HasMethod s meth)- => RPC s meth+ :: (GRPCInput r i, GRPCOutput r o)+ => r -- ^ RPC to call. -> a -- ^ An initial state for the incoming loop.- -> (a -> IncomingEvent s meth a -> ClientIO a)+ -> (a -> IncomingEvent o a -> ClientIO a) -- ^ A state-passing function for the incoming loop. -> b -- ^ An initial state for the outgoing loop.- -> (b -> ClientIO (b, OutgoingEvent s meth b))+ -> (b -> ClientIO (b, OutgoingEvent i b)) -- ^ A state-passing function for the outgoing loop.- -> RPCCall s meth (a,b)-generalHandler rpc v0 handle w0 next = RPCCall $ \conn stream isfc osfc encoding decoding ->+ -> RPCCall r (a,b)+generalHandler rpc v0 handle w0 next = RPCCall rpc $ \conn stream isfc osfc encoding decoding -> go conn stream isfc osfc encoding decoding where go conn stream isfc osfc encoding decoding =@@ -476,28 +475,28 @@ outGoingLoop v2 incomingLoop Nothing decode v1 = _waitEvent stream >>= \case- (StreamHeadersEvent _ hdrs) ->+ StreamHeadersEvent _ hdrs -> handle v1 (Headers hdrs) >>= incomingLoop (Just hdrs) decode _ -> handle v1 (Invalid $ toException $ InvalidState "no headers") incomingLoop jhdrs decode v1 = _waitEvent stream >>= \case- (StreamHeadersEvent _ hdrs) ->+ StreamHeadersEvent _ hdrs -> handle v1 (Trailers hdrs)- (StreamDataEvent _ dat) -> do+ StreamDataEvent _ dat -> do liftIO $ _addCredit isfc (ByteString.length dat) _ <- liftIO $ _consumeCredit isfc (ByteString.length dat) _ <- _updateWindow isfc case pushChunk decode dat of- (Done unusedDat _ (Right val)) ->+ Done unusedDat _ (Right val) -> handle v1 (RecvMessage val) >>= incomingLoop jhdrs (pushChunk newDecoder unusedDat)- partial@(Partial _) -> do+ partial@(Partial _) -> incomingLoop jhdrs partial v1- (Done _ _ (Left err)) -> do+ Done _ _ (Left err) -> handle v1 (Invalid $ toException $ InvalidParse $ "invalid-done-parse: " ++ err)- (Fail _ _ err) ->+ Fail _ _ err -> handle v1 (Invalid $ toException $ InvalidParse $ "invalid-parse: " ++ err)- (StreamPushPromiseEvent _ _ _) ->+ StreamPushPromiseEvent {} -> handle v1 (Invalid $ toException UnallowedPushPromiseReceived)- (StreamErrorEvent _ _) ->+ StreamErrorEvent {} -> handle v1 (Invalid $ toException $ InvalidState "stream error")
src/Network/GRPC/Client/Helpers.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-} -- | Set of helpers helping with writing gRPC clients with not much exposure of -- the http2-client complexity.@@ -14,7 +15,6 @@ -- are not planned in this library and should be added at higher-levels. module Network.GRPC.Client.Helpers where -import Control.Lens import Control.Concurrent.Async.Lifted (Async, async, cancel) import Control.Concurrent.Lifted (threadDelay) import Control.Exception (throwIO)@@ -23,15 +23,14 @@ import qualified Data.ByteString.Char8 as ByteString import Data.ByteString.Char8 (ByteString) import Data.Default.Class (def)-import Data.ProtoLens.Service.Types (Service(..), HasMethod, HasMethodImpl(..), StreamingType(..)) import qualified Network.TLS as TLS import qualified Network.TLS.Extra.Cipher as TLS import Network.HPACK (HeaderList) import Network.HTTP2.Client (ClientIO, ClientError, newHttp2FrameConnection, newHttp2Client, Http2Client(..), IncomingFlowControl(..), GoAwayHandler, FallBackFrameHandler, ignoreFallbackHandler, HostName, PortNumber, TooMuchConcurrency) import Network.HTTP2.Client.Helpers (ping)-import Network.GRPC.Client (RPC, open, singleRequest, streamReply, streamRequest, steppedBiDiStream, generalHandler, Authority, Timeout(..), StreamDone, CompressMode, RawReply, RunBiDiStep, IncomingEvent(..), OutgoingEvent(..))-import Network.GRPC.HTTP2.Encoding (Compression, Encoding(..), Decoding(..), gzip)+import Network.GRPC.Client+import Network.GRPC.HTTP2.Encoding -- | A simplified gRPC Client connected via an HTTP2Client to a given server. -- Each call from one client will share similar headers, timeout, compression.@@ -99,6 +98,9 @@ } , TLS.clientSupported = def { TLS.supportedCiphers = TLS.ciphersuite_default } , TLS.clientDebug = def+#if MIN_VERSION_tls(1,5,0)+ , TLS.clientEarlyData = Nothing+#endif } @@ -134,41 +136,30 @@ -- | Run an unary query. rawUnary- :: (Service s, HasMethod s m)- => RPC s m+ :: (GRPCInput r i, GRPCOutput r o)+ => r -- ^ The RPC to call. -> GrpcClient -- ^ An initialized client.- -> MethodInput s m+ -> i -- ^ The input.- -> ClientIO (Either TooMuchConcurrency (RawReply (MethodOutput s m)))+ -> ClientIO (Either TooMuchConcurrency (RawReply o)) rawUnary rpc (GrpcClient client authority headers timeout compression _) input = let call = singleRequest rpc input in open client authority headers timeout (Encoding compression) (Decoding compression) call --- | Prism helper to unpack an unary gRPC call output.------ @ out <- rawUnary rpc grpc method--- print $ out ^? unaryOutput . somefield--- @-unaryOutput- :: (Applicative f, Field3 a1 b1 (Either c1 a2) (Either c1 b2)) =>- (a2 -> f b2)- -> Either c2 (Either c3 a1) -> f (Either c2 (Either c3 b1))-unaryOutput = _Right . _Right . _3 . _Right- -- | Calls for a server stream of requests. rawStreamServer- :: (Service s, HasMethod s m, MethodStreamingType s m ~ 'ServerStreaming)- => RPC s m+ :: (GRPCInput r i, GRPCOutput r o)+ => r -- ^ The RPC to call. -> GrpcClient -- ^ An initialized client. -> a -- ^ An initial state.- -> MethodInput s m+ -> i -- ^ The input of the stream request.- -> (a -> HeaderList -> MethodOutput s m -> ClientIO a)+ -> (a -> HeaderList -> o -> ClientIO a) -- ^ A state-passing handler called for each server-sent output. -- Headers are repeated for convenience but are the same for every iteration. -> ClientIO (Either TooMuchConcurrency (a, HeaderList, HeaderList))@@ -181,16 +172,16 @@ -- Messages are submitted to the HTTP2 underlying client and hence this -- function can block until the HTTP2 client has some network credit. rawStreamClient- :: (Service s, HasMethod s m, MethodStreamingType s m ~ 'ClientStreaming)- => RPC s m+ :: (GRPCInput r i, GRPCOutput r o)+ => r -- ^ The RPC to call. -> GrpcClient -- ^ An initialized client. -> a -- ^ An initial state.- -> (a -> ClientIO (a, Either StreamDone (CompressMode, MethodInput s m)))+ -> (a -> ClientIO (a, Either StreamDone (CompressMode, i))) -- ^ A state-passing step function to decide the next message.- -> ClientIO (Either TooMuchConcurrency (a, (RawReply (MethodOutput s m))))+ -> ClientIO (Either TooMuchConcurrency (a, RawReply o)) rawStreamClient rpc (GrpcClient client authority headers timeout compression _) v0 getNext = let call = streamRequest rpc v0 getNext in open client authority headers timeout (Encoding compression) (Decoding compression) call@@ -201,14 +192,14 @@ -- protocols, that is, when after sending a message a client can know how many -- messages to wait for before sending the next message. rawSteppedBidirectional- :: (Service s, HasMethod s m, MethodStreamingType s m ~ 'BiDiStreaming)- => RPC s m+ :: (GRPCInput r i, GRPCOutput r o)+ => r -- ^ The RPC to call. -> GrpcClient -- ^ An initialized client. -> a -- ^ An initial state.- -> RunBiDiStep s m a+ -> RunBiDiStep i o a -- ^ The sequential program to iterate between sending and receiving messages. -> ClientIO (Either TooMuchConcurrency a) rawSteppedBidirectional rpc (GrpcClient client authority headers timeout compression _) v0 handler =@@ -220,18 +211,18 @@ -- This handler allows to concurrently write messages and wait for incoming -- messages. rawGeneralStream- :: (Service s, HasMethod s m)- => RPC s m+ :: (GRPCInput r i, GRPCOutput r o)+ => r -- ^ The RPC to call. -> GrpcClient -- ^ An initialized client. -> a -- ^ An initial state for the incoming loop.- -> (a -> IncomingEvent s m a -> ClientIO a)+ -> (a -> IncomingEvent o a -> ClientIO a) -- ^ A state-passing function for the incoming loop. -> b -- ^ An initial state for the outgoing loop.- -> (b -> ClientIO (b, OutgoingEvent s m b))+ -> (b -> ClientIO (b, OutgoingEvent i b)) -- ^ A state-passing function for the ougoing loop. -> ClientIO (Either TooMuchConcurrency (a,b)) rawGeneralStream rpc (GrpcClient client authority headers timeout compression _) v0 handler w0 next =