diff --git a/.gitignore b/.gitignore index 094ee2b3..fb2480d4 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ .stack-work/ stack*.lock +dist-newstyle \ No newline at end of file diff --git a/http2-client.cabal b/http2-client.cabal index 2c2217e4..7df05c16 100644 --- a/http2-client.cabal +++ b/http2-client.cabal @@ -22,19 +22,20 @@ library , Network.HTTP2.Client.RawConnection other-modules: Network.HTTP2.Client.Channels , Network.HTTP2.Client.Dispatch - build-depends: base >= 4.7 && < 4.20 + build-depends: base >= 4.7 && < 4.21 , async >= 2.1 && < 2.3 , bytestring >= 0.11 && < 0.13 + , case-insensitive >= 1.2 && < 1.3 , containers >= 0.5 && < 0.8 , deepseq >= 1.4 && < 1.6 - , http2 >= 4.1 && < 6 + , http2 >= 4.1 && < 5.3 , lifted-async >= 0.10 && < 0.11 , lifted-base >= 0.2 && < 0.3 , mtl >= 2.2 && < 2.4 - , network >= 2.6 && < 3.2 + , network >= 2.6 && < 3.3 , stm >= 2.4 && < 2.8 , time >= 1.8 && < 1.15 - , tls >= 1.8.0 && < 2.0.3 + , tls >= 1.8.0 && < 2.2 , transformers-base >= 0.4 && < 0.5 default-language: Haskell2010 diff --git a/src/Network/HTTP2/Client.hs b/src/Network/HTTP2/Client.hs index 0e4b8893..55d5d2d7 100644 --- a/src/Network/HTTP2/Client.hs +++ b/src/Network/HTTP2/Client.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} @@ -61,8 +62,10 @@ import Control.Concurrent.MVar.Lifted (newEmptyMVar, newMVar, putMVar, takeMVar, import Control.Exception.Lifted (SomeException, bracket, catch, throwIO) import Control.Monad (forM_, forever, void, when) import Control.Monad.IO.Class (liftIO) +import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString +import qualified Data.CaseInsensitive as CI import Data.Foldable (foldl') import Data.IORef.Lifted (atomicModifyIORef', newIORef, readIORef) import Data.Maybe (fromMaybe) @@ -78,7 +81,12 @@ import Network.HTTP2.Client.FrameConnection #if MIN_VERSION_http2(5,0,0) import "http2" Network.HTTP2.Client (Settings, maxFrameSize, initialWindowSize, maxConcurrentStreams, headerTableSize, enablePush, maxHeaderListSize) +#if !MIN_VERSION_http2(5,2,0) +pattern SettingsTokenHeaderTableSize :: SettingsKey +pattern SettingsTokenHeaderTableSize = SettingsHeaderTableSize #endif +#endif + {- | Offers credit-based flow-control. @@ -260,7 +268,7 @@ data StreamThread = CST -- | Record holding functions one can call while in an HTTP2 client stream. data Http2Stream = Http2Stream { _headers :: - HPACK.HeaderList -> + HeaderList -> (FrameFlags -> FrameFlags) -> ClientIO StreamThread -- ^ Starts the stream with HTTP headers. Flags modifier can use @@ -285,7 +293,7 @@ data Http2Stream = Http2Stream Trailers should be the last thing sent over a stream. -} -trailers :: Http2Stream -> HPACK.HeaderList -> (FrameFlags -> FrameFlags) -> ClientIO () +trailers :: Http2Stream -> HeaderList -> (FrameFlags -> FrameFlags) -> ClientIO () trailers stream hdrs flagmod = void $ _headers stream hdrs flagmod {- | Handler upon receiving a PUSH_PROMISE from the server. @@ -687,7 +695,7 @@ dispatchControlFramesStep windowUpdatesChan controlFrame@(fh, payload) control@( maybe (return ()) (_applySettings _dispatchControlHpackEncoder) - (lookup SettingsHeaderTableSize settsList) + (lookup SettingsTokenHeaderTableSize settsList) _dispatchControlAckSettings | otherwise -> do handler <- lookupAndReleaseSetSettingsHandler control @@ -756,7 +764,7 @@ dispatchHPACKFramesStep :: DispatchHPACK -> HPACKStepResult dispatchHPACKFramesStep (fh, fp) (DispatchHPACK{..}) = - let (decision, pattern) = case fp of + let (decision, pattern') = case fp of PushPromiseFrame ppSid hbf -> do (OpenPushPromise sid ppSid, Right hbf) HeadersFrame _ hbf -> @@ -766,11 +774,19 @@ dispatchHPACKFramesStep (fh, fp) (DispatchHPACK{..}) = (ForwardHeader sid, Left err) _ -> error "wrong TypeId" - in go fh decision pattern + in go fh decision pattern' where sid :: StreamId sid = HTTP2.streamId fh +#if MIN_VERSION_http2(5,2,0) + compat :: [Header] -> HeaderList + compat = fmap $ first CI.original +#else + compat :: HeaderList -> HeaderList + compat = id +#endif + go :: FrameHeader -> HPACKLoopDecision -> Either ErrorCode ByteString -> HPACKStepResult go curFh decision (Right buffer) = if not $ HTTP2.testEndHeader (HTTP2.flags curFh) @@ -794,9 +810,9 @@ dispatchHPACKFramesStep (fh, fp) (DispatchHPACK{..}) = ) else case decision of ForwardHeader sId -> - FinishedWithHeaders curFh sId (decodeHeader _dispatchHPACKDynamicTable buffer) + FinishedWithHeaders curFh sId $ fmap compat $ decodeHeader _dispatchHPACKDynamicTable buffer OpenPushPromise parentSid newSid -> - FinishedWithPushPromise curFh parentSid newSid (decodeHeader _dispatchHPACKDynamicTable buffer) + FinishedWithPushPromise curFh parentSid newSid $ fmap compat $ decodeHeader _dispatchHPACKDynamicTable buffer go curFh _ (Left err) = FailedHeaders curFh sid err @@ -1032,13 +1048,13 @@ compat_updateSettings :: Settings -> SettingsList -> Settings #if MIN_VERSION_http2(5,0,0) compat_updateSettings settings kvs = foldl' update settings kvs where - update def (SettingsHeaderTableSize,x) = def { headerTableSize = x } + update def (SettingsTokenHeaderTableSize,x) = def { headerTableSize = x } -- fixme: x should be 0 or 1 update def (SettingsEnablePush,x) = def { enablePush = x > 0 } update def (SettingsMaxConcurrentStreams,x) = def { maxConcurrentStreams = Just x } update def (SettingsInitialWindowSize,x) = def { initialWindowSize = x } update def (SettingsMaxFrameSize,x) = def { maxFrameSize = x } - update def (SettingsMaxHeaderListSize,x) = def { maxHeaderListSize = Just x } + update def (SettingsMaxHeaderListSize,x) = def { maxHeaderListSize = Just x } update def _ = def #else diff --git a/src/Network/HTTP2/Client/Dispatch.hs b/src/Network/HTTP2/Client/Dispatch.hs index 1593b34a..0b5a1c57 100644 --- a/src/Network/HTTP2/Client/Dispatch.hs +++ b/src/Network/HTTP2/Client/Dispatch.hs @@ -9,6 +9,7 @@ import Control.Exception (throwIO) import Control.Monad.Base (MonadBase, liftBase) import Data.ByteString (ByteString) import qualified Data.ByteString.Internal as ByteString +import qualified Data.CaseInsensitive as CI import Data.IORef.Lifted (IORef, atomicModifyIORef', newIORef, readIORef) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap @@ -17,13 +18,15 @@ import Foreign.Marshal.Alloc (finalizerFree, mallocBytes) import GHC.Exception (Exception) import Network.HPACK as HPACK import qualified Network.HPACK.Token as HPACK +import Network.HTTP2.Client.Channels +import Network.HTTP2.Client.Exceptions import Network.HTTP2.Frame as HTTP2 #if MIN_VERSION_http2(5,0,0) import "http2" Network.HTTP2.Client (Settings, defaultSettings) +#if MIN_VERSION_http2(5,2,0) +type HeaderList = [(ByteString, ByteString)] +#endif #endif - -import Network.HTTP2.Client.Channels -import Network.HTTP2.Client.Exceptions type DispatchChan = FramesChan FrameDecodeError diff --git a/src/Network/HTTP2/Client/Helpers.hs b/src/Network/HTTP2/Client/Helpers.hs index 575fe260..56584b02 100644 --- a/src/Network/HTTP2/Client/Helpers.hs +++ b/src/Network/HTTP2/Client/Helpers.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- | A toolbox with high-level functions to interact with an established HTTP2 @@ -11,7 +12,7 @@ module Network.HTTP2.Client.Helpers ( -- * Sending and receiving HTTP body upload , waitStream - , fromStreamResult + , fromStreamResult , StreamResult , StreamResponse -- * Diagnostics @@ -23,12 +24,16 @@ module Network.HTTP2.Client.Helpers ( import Data.Time.Clock (UTCTime, getCurrentTime) import qualified Network.HTTP2.Frame as HTTP2 import qualified Network.HPACK as HPACK +#if !MIN_VERSION_http2(5,2,0) +import Network.HPACK as HPACK (HeaderList) +#endif import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import Control.Concurrent.Lifted (threadDelay) import Control.Concurrent.Async.Lifted (race) import Network.HTTP2.Client +import Network.HTTP2.Client.Dispatch import Network.HTTP2.Client.Exceptions -- | Opaque type to express an action which timed out. @@ -57,10 +62,10 @@ ping conn timeout msg = do -- | Result containing the unpacked headers and all frames received in on a -- stream. See 'StreamResponse' and 'fromStreamResult' to get a higher-level -- utility. -type StreamResult = (Either HTTP2.ErrorCode HPACK.HeaderList, [Either HTTP2.ErrorCode ByteString], Maybe HPACK.HeaderList) +type StreamResult = (Either HTTP2.ErrorCode HeaderList, [Either HTTP2.ErrorCode ByteString], Maybe HeaderList) -- | An HTTP2 response, once fully received, is made of headers and a payload. -type StreamResponse = (HPACK.HeaderList, ByteString, Maybe HPACK.HeaderList) +type StreamResponse = (HeaderList, ByteString, Maybe HeaderList) -- | Uploads a whole HTTP body at a time. --