warp-grpc 0.2.0.0 → 0.3.0.0
raw patch · 5 files changed
+81/−32 lines, 5 filesdep ~basedep ~waidep ~warp
Dependency ranges changed: base, wai, warp, warp-tls
Files
- ChangeLog.md +4/−0
- src/Network/GRPC/Server/Handlers.hs +17/−1
- src/Network/GRPC/Server/Helpers.hs +21/−17
- src/Network/GRPC/Server/Wai.hs +33/−8
- warp-grpc.cabal +6/−6
ChangeLog.md view
@@ -2,6 +2,10 @@ ## Unreleased changes +## 0.3.0.0++Support for warp-3.3.x .+ ## 0.2.0.0 Support for different Protocol Buffers serialization libraries.
src/Network/GRPC/Server/Handlers.hs view
@@ -1,8 +1,10 @@+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-} module Network.GRPC.Server.Handlers where import Control.Concurrent.Async (concurrently)@@ -13,10 +15,24 @@ import Data.ByteString.Lazy (toStrict) import Network.GRPC.HTTP2.Encoding import Network.GRPC.HTTP2.Types (path, GRPCStatus(..), GRPCStatusCode(..))+#if MIN_VERSION_wai(3,2,2) import Network.Wai (Request, getRequestBodyChunk, strictRequestBody)+#else+import Network.Wai (Request, requestBody, strictRequestBody)+#endif +#if MIN_VERSION_base(4,11,0)+#else+import Data.Monoid ((<>))+#endif+ import Network.GRPC.Server.Wai (WaiHandler, ServiceHandler(..), closeEarly) +#if !MIN_VERSION_wai(3,2,2)+getRequestBodyChunk :: Request -> IO ByteString+getRequestBodyChunk = requestBody+#endif+ -- | Handy type to refer to Handler for 'unary' RPCs handler. type UnaryHandler i o = Request -> i -> IO o @@ -280,4 +296,4 @@ errorOnLeftOver :: (a -> IO b) -> ByteString -> a -> IO b errorOnLeftOver f rest | ByteString.null rest = f- | otherwise = const $ closeEarly $ GRPCStatus INVALID_ARGUMENT ("left-overs: " <> rest)+ | otherwise = const $ putStrLn "left-over" >> closeEarly (GRPCStatus INVALID_ARGUMENT ("left-overs: " <> rest))
src/Network/GRPC/Server/Helpers.hs view
@@ -1,31 +1,35 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} module Network.GRPC.Server.Helpers where import qualified Data.ByteString.Char8 as ByteString-import Data.Maybe (fromMaybe)-import Network.GRPC.HTTP2.Types (GRPCStatus(..), trailerForStatusCode, grpcStatusH, grpcMessageH)+import Data.IORef+import Network.GRPC.HTTP2.Types (HeaderValue, HeaderKey, GRPCStatus(..), trailerForStatusCode, grpcStatusH, grpcMessageH)+import Network.Wai (Request)+ #if MIN_VERSION_warp(3,3,0)-import Network.HTTP2.Server (NextTrailersMaker(..))++#else+import Data.Maybe (fromMaybe)+import Network.Wai.Handler.Warp (http2dataTrailers, defaultHTTP2Data, modifyHTTP2Data) #endif-import Network.Wai (Request)-import Network.Wai.Handler.Warp (http2dataTrailers, defaultHTTP2Data, modifyHTTP2Data, HTTP2Data) --- | Helper to set the GRPCStatus on the trailers reply.-modifyGRPCStatus :: Request -> GRPCStatus -> IO ()-modifyGRPCStatus req = modifyHTTP2Data req . makeGRPCTrailers+#if MIN_VERSION_base(4,11,0)+#else+import Data.Monoid ((<>))+#endif -makeGRPCTrailers :: GRPCStatus -> (Maybe HTTP2Data -> Maybe HTTP2Data)-makeGRPCTrailers (GRPCStatus s msg) h2data =+-- | Helper to set the GRPCStatus on the trailers reply.+modifyGRPCStatus :: IORef [(HeaderKey, HeaderValue)] -> Request -> GRPCStatus -> IO () #if MIN_VERSION_warp(3,3,0)- Just $! (fromMaybe defaultHTTP2Data h2data) { http2dataTrailers = trailersMaker }+modifyGRPCStatus ref _ (GRPCStatus s msg) =+ writeIORef ref trailers #else- Just $! (fromMaybe defaultHTTP2Data h2data) { http2dataTrailers = trailers }+modifyGRPCStatus _ req (GRPCStatus s msg) = modifyHTTP2Data req $ \h2data ->+ Just $! (fromMaybe defaultHTTP2Data h2data) { http2dataTrailers = trailers } #endif where-#if MIN_VERSION_warp(3,3,0)- trailersMaker (Just _) = return $ NextTrailersMaker trailersMaker- trailersMaker Nothing = return $ Trailers trailers-#endif- trailers = if ByteString.null msg then [status] else [status, message]+ !trailers = if ByteString.null msg then [status] else [status, message] status = (grpcStatusH, trailerForStatusCode s) message = (grpcMessageH, msg)+
src/Network/GRPC/Server/Wai.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-} module Network.GRPC.Server.Wai where @@ -8,6 +9,7 @@ import qualified Data.ByteString.Char8 as ByteString import Data.ByteString.Lazy (fromStrict) import Data.Binary.Builder (Builder)+import Data.IORef import Data.Maybe (fromMaybe) import qualified Data.CaseInsensitive as CI import qualified Data.List as List@@ -15,7 +17,16 @@ import Network.GRPC.HTTP2.Types (GRPCStatus(..), GRPCStatusCode(..), grpcStatusH, grpcMessageH, grpcContentTypeHV, grpcEncodingH, grpcAcceptEncodingH) import Network.HTTP.Types (status200, status404) import Network.Wai (Application, Request(..), rawPathInfo, responseLBS, responseStream, requestHeaders)+import Network.Wai.Handler.Warp (http2dataTrailers, defaultHTTP2Data, modifyHTTP2Data)+#if MIN_VERSION_warp(3,3,0)+import Network.HTTP2.Server (NextTrailersMaker(..))+#endif +#if MIN_VERSION_base(4,11,0)+#else+import Data.Monoid ((<>))+#endif+ import Network.GRPC.Server.Helpers (modifyGRPCStatus) -- | A Wai Handler for a request.@@ -62,6 +73,11 @@ -- This lookup may be inefficient for large amount of services. grpcService :: [Compression] -> [ServiceHandler] -> (Application -> Application) grpcService compressions services app = \req rep -> do+ r <- newIORef []+#if MIN_VERSION_warp(3,3,0)+ modifyHTTP2Data req $ \h2data -> + Just $! (fromMaybe defaultHTTP2Data h2data) { http2dataTrailers = trailersMaker r }+#endif case lookupHandler (rawPathInfo req) services of Just handler -> -- Handler that catches early GRPC termination and other exceptions.@@ -72,9 +88,11 @@ -- These exceptions are swallowed from the WAI "onException" -- handler, so we'll need a better way to handle this case. let grpcHandler write flush =- (doHandle handler req write flush)- `catches` [ Handler $ \(e::GRPCStatus) -> modifyGRPCStatus req e- , Handler $ \(e::SomeException) -> modifyGRPCStatus req (GRPCStatus INTERNAL $ ByteString.pack $ show e )+ doHandle r handler req write flush+ `catches` [ Handler $ \(e::GRPCStatus) ->+ modifyGRPCStatus r req e+ , Handler $ \(e::SomeException) -> + modifyGRPCStatus r req (GRPCStatus INTERNAL $ ByteString.pack $ show e) ] in (rep $ responseStream status200 hdrs200 grpcHandler) Nothing ->@@ -88,24 +106,31 @@ lookupHandler :: ByteString -> [ServiceHandler] -> Maybe WaiHandler lookupHandler p plainHandlers = grpcWaiHandler <$> List.find (\(ServiceHandler rpcPath _) -> rpcPath == p) plainHandlers- doHandle handler req write flush = do+ doHandle r handler req write flush = do let bestCompression = lookupEncoding req compressions let pickedCompression = fromMaybe (Encoding uncompressed) bestCompression let hopefulDecompression = lookupDecoding req compressions let pickedDecompression = fromMaybe (Decoding uncompressed) hopefulDecompression + putStrLn "running handler" _ <- handler pickedDecompression pickedCompression req write flush- modifyGRPCStatus req (GRPCStatus OK "WAI handler ended.")+ putStrLn "setting GRPC status"+ modifyGRPCStatus r req (GRPCStatus OK "WAI handler ended.") +#if MIN_VERSION_warp(3,3,0)+ trailersMaker r Nothing = Trailers <$> readIORef r+ trailersMaker r _ = return $ NextTrailersMaker (trailersMaker r)+#endif+ -- | Looks-up header for encoding outgoing messages. requestAcceptEncodingNames :: Request -> [ByteString]-requestAcceptEncodingNames req = fromMaybe [] $- ByteString.split ',' <$> lookup grpcAcceptEncodingH (requestHeaders req)+requestAcceptEncodingNames req = maybe [] (ByteString.split ',') $+ lookup grpcAcceptEncodingH (requestHeaders req) -- | Looks-up the compression to use from a set of known algorithms. lookupEncoding :: Request -> [Compression] -> Maybe Encoding-lookupEncoding req compressions = fmap Encoding $+lookupEncoding req compressions = Encoding <$> safeHead [ c | c <- compressions , n <- requestAcceptEncodingNames req , n == grpcCompressionHV c
warp-grpc.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 5cc20b886f598a4b752f762493d70b24c9979d6893ffd1e239e260d1b36bd47b+-- hash: 794fc7769141a0b3e1da1800fa7e22733da3750f11b1d80f2558372cf578b90e name: warp-grpc-version: 0.2.0.0+version: 0.3.0.0 synopsis: A minimal gRPC server on top of Warp. description: Please see the README on Github at <https://github.com/haskell-grpc-native/http2-grpc-haskell/blob/master/warp-grpc/README.md> category: Networking@@ -40,14 +40,14 @@ ghc-options: -Wall build-depends: async >=2.2.1 && <3- , base >=4.11 && <5+ , base >=4.10 && <5 , binary >=0.8.5 && <0.9 , bytestring >=0.10.8 && <0.11 , case-insensitive >=1.2.0 && <1.3 , http-types >=0.12 && <0.13 , http2 >=1.6 && <3 , http2-grpc-types >=0.5 && <0.6- , wai >=3.2 && <3.3- , warp >=3.2.24 && <3.3- , warp-tls >=3.2 && <3.3+ , wai >=3.2 && <3.4+ , warp >=3.2.23 && <3.4+ , warp-tls >=3.2 && <3.4 default-language: Haskell2010