servant-http2-client 0.1.0.0 → 0.1.0.1
raw patch · 3 files changed
+54/−48 lines, 3 filesdep ~binarydep ~bytestringdep ~case-insensitivePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: binary, bytestring, case-insensitive, containers, exceptions, http-media, http-types, http2, http2-client, mtl, servant-client-core, text, transformers
API changes (from Hackage documentation)
Files
- ChangeLog.md +3/−0
- servant-http2-client.cabal +27/−27
- src/Network/HTTP2/Client/Servant.hs +24/−21
ChangeLog.md view
@@ -2,5 +2,8 @@ ## Unreleased changes +## v0.1.0.1+- compact transfers for requests with no body or when chunking has empty bytestrings (see https://github.com/lucasdicioccio/servant-http2-client/issues/1 and https://github.com/yesodweb/wai/issues/717)+ ## v0.1.0.0 - initial release
servant-http2-client.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 1637fc4fd7ba4a0e9a44eb9e134093e35f8bcd5548e8997d635cbfb834599852+-- hash: e352f7dda8407f7f694c6418b746407bfd6e634a996cd13a2dba4fdf7164dcc0 name: servant-http2-client-version: 0.1.0.0+version: 0.1.0.1 synopsis: Generate HTTP2 clients from Servant API descriptions. description: Please see the README on GitHub at <https://github.com/lucasdicioccio/servant-http2-client#readme> category: Web@@ -36,19 +36,19 @@ ghc-options: -Wall build-depends: base >=4.7 && <5- , binary- , bytestring- , case-insensitive- , containers- , exceptions- , http-media- , http-types- , http2- , http2-client- , mtl- , servant-client-core- , text- , transformers+ , binary >=0.8.5.1 && <0.9+ , bytestring >=0.10.8.2 && <0.11+ , case-insensitive >=1.2.0.11 && <1.3+ , containers >=0.5.11.0 && <0.6+ , exceptions >=0.10.0 && <0.11+ , http-media >=0.7.1.3 && <0.8+ , http-types >=0.12.2 && <0.13+ , http2 >=1.6.3 && <1.7+ , http2-client >=0.8.0.1 && <0.9+ , mtl >=2.2.2 && <2.3+ , servant-client-core >=0.14.1 && <0.15+ , text >=1.2.3.1 && <1.3+ , transformers >=0.5.5.0 && <0.6 default-language: Haskell2010 test-suite servant-http2-client-test@@ -63,21 +63,21 @@ aeson , async , base >=4.7 && <5- , binary- , bytestring- , case-insensitive- , containers+ , binary >=0.8.5.1 && <0.9+ , bytestring >=0.10.8.2 && <0.11+ , case-insensitive >=1.2.0.11 && <1.3+ , containers >=0.5.11.0 && <0.6 , data-default-class- , exceptions- , http-media- , http-types- , http2- , http2-client- , mtl+ , exceptions >=0.10.0 && <0.11+ , http-media >=0.7.1.3 && <0.8+ , http-types >=0.12.2 && <0.13+ , http2 >=1.6.3 && <1.7+ , http2-client >=0.8.0.1 && <0.9+ , mtl >=2.2.2 && <2.3 , servant , servant-client-core , servant-http2-client- , text+ , text >=1.2.3.1 && <1.3 , tls- , transformers+ , transformers >=0.5.5.0 && <0.6 default-language: Haskell2010
src/Network/HTTP2/Client/Servant.hs view
@@ -13,6 +13,7 @@ ) where import Data.IORef (newIORef, readIORef, writeIORef)+import Data.Maybe (isJust) import Data.Foldable (traverse_) import Control.Exception (throwIO) import Control.Monad (unless, when, (>=>))@@ -77,7 +78,8 @@ traverse_ (handle . pure) (filter (not . ByteString.null) bss) -- | Pulls data segments from ByteSegments and calls 'upload' on it.-sendSegments+-- Ignores empty segments.+sendNonEmptySegments :: Http2Client -> Http2Stream -> OutgoingFlowControl@@ -86,12 +88,12 @@ -- ^ Stream -> ByteSegments -> IO ()-sendSegments http2client stream ocfc osfc segments =+sendNonEmptySegments http2client stream ocfc osfc segments = segments go where go getChunk = do dat <- getChunk- upload dat id http2client ocfc stream osfc+ when (not $ ByteString.null dat) $ upload dat id http2client ocfc stream osfc -- | Prepare an HTTP2 request to a given server. makeRequest@@ -99,31 +101,31 @@ -- ^ Server's Authority. -> Request -- ^ The HTTP request.- -> IO (HeaderList, ByteSegments)+ -> IO (HeaderList, Maybe ByteSegments) makeRequest authority req = do let go ct obj = case obj of (RequestBodyBS bs) -> pure $- (onlySegment bs,+ (Just $ onlySegment bs, [ ("Content-Type", renderHeader ct) , ("Content-Length", ByteString.pack $ show $ ByteString.length bs) ]) (RequestBodyLBS lbs) -> pure $- (multiSegments $ toChunks lbs,+ (Just $ multiSegments $ toChunks lbs, [ ("Content-Type", renderHeader ct) ]) (RequestBodyBuilder n builder) -> let lbs = toLazyByteString builder in pure $- (multiSegments $ toChunks lbs,+ (Just $ multiSegments $ toChunks lbs, [ ("Content-Type", renderHeader ct) , ("Content-Length", ByteString.pack $ show n) ]) (RequestBodyStream n act) -> pure $- (act,+ (Just act, [ ("Content-Type", renderHeader ct) , ("Content-Length", ByteString.pack $ show n) ]) (RequestBodyStreamChunked act) -> pure $- (act,+ (Just act, [ ("Content-Type", renderHeader ct) , ("Transfer-Encoding", "chunked") ])@@ -131,7 +133,7 @@ again >>= go ct (bodyIO,bodyheaders) <- case requestBody req of- Nothing -> pure (onlySegment "", [])+ Nothing -> pure (Nothing, []) (Just (r,ct)) -> go ct r let headersPairs = baseHeaders <> reqHeaders <> bodyheaders pure (headersPairs, bodyIO)@@ -155,15 +157,16 @@ H2ClientEnv authority http2client <- ask let icfc = _incomingFlowControl http2client let ocfc = _outgoingFlowControl http2client- let headersFlags = id - (headersPairs, bodyIO) <- liftIO $ makeRequest authority req+ (headersPairs, mBodyIO) <- liftIO $ makeRequest authority req+ let headersFlags = if isJust mBodyIO then id else setEndStream http2rsp <- liftIO $ withHttp2Stream http2client $ \stream -> let initStream = headers stream headersPairs headersFlags handler _ osfc = do- sendSegments http2client stream ocfc osfc bodyIO- sendData http2client stream setEndStream ""+ flip traverse_ mBodyIO (\bodyIO -> do+ sendNonEmptySegments http2client stream ocfc osfc bodyIO+ sendData http2client stream setEndStream "") streamResult <- waitStream stream icfc resetPushPromises pure $ fromStreamResult streamResult in (StreamDefinition initStream handler)@@ -198,8 +201,8 @@ _ <- _consumeCredit isfc len _addCredit isfc len _ <- _updateWindow isfc- _ <- _consumeCredit icfc len- _addCredit icfc len+ -- connection-level flow control already accounted for in the+ -- 'creditDataFramesStep' of 'dispatchLoop' in http2-client _ <- _updateWindow icfc pure () @@ -209,16 +212,16 @@ H2ClientEnv authority http2client <- ask let icfc = _incomingFlowControl http2client let ocfc = _outgoingFlowControl http2client- let headersFlags = id-- (headersPairs, bodyIO) <- liftIO $ makeRequest authority req+ (headersPairs, mBodyIO) <- liftIO $ makeRequest authority req+ let headersFlags = if isJust mBodyIO then id else setEndStream ret <- liftIO $ withHttp2Stream http2client $ \stream -> let initStream = headers stream headersPairs headersFlags handler isfc osfc = do -- Send the request- sendSegments http2client stream ocfc osfc bodyIO- sendData http2client stream setEndStream ""+ flip traverse_ mBodyIO (\bodyIO -> do+ sendNonEmptySegments http2client stream ocfc osfc bodyIO+ sendData http2client stream setEndStream "") -- Waits for headers and returns the response object to the -- caller. pure $ StreamingResponse (\handleGenResponse -> do