http2 5.0.1 → 5.1.0
raw patch · 9 files changed
+47/−20 lines, 9 filesdep +utf8-string
Dependencies added: utf8-string
Files
- ChangeLog.md +9/−0
- Network/HTTP2/Client/Run.hs +5/−2
- Network/HTTP2/H2/Context.hs +16/−3
- Network/HTTP2/H2/Receiver.hs +7/−2
- Network/HTTP2/H2/Types.hs +1/−1
- Network/HTTP2/Server.hs +2/−1
- http2.cabal +3/−2
- test/HTTP2/ClientSpec.hs +2/−7
- test/HTTP2/ServerSpec.hs +2/−2
ChangeLog.md view
@@ -1,3 +1,12 @@+## 5.1.0++* Drop frames after reset+ [#106](https://github.com/kazu-yamamoto/http2/pull/106)+* BREAKING CHANGE: Use String for Authority+ [#105](https://github.com/kazu-yamamoto/http2/pull/105)+* Properly close streams+ [#104](https://github.com/kazu-yamamoto/http2/pull/104)+ ## 5.0.1 * Allowing bytestring 0.12.
Network/HTTP2/Client/Run.hs view
@@ -14,11 +14,13 @@ import UnliftIO.Async import UnliftIO.Concurrent import UnliftIO.STM+import qualified Data.ByteString.UTF8 as UTF8 import Imports import Network.HTTP2.Client.Types import Network.HTTP2.Frame import Network.HTTP2.H2+import Network.HTTP.Types (Header) -- | Client configuration data ClientConfig = ClientConfig@@ -172,11 +174,12 @@ -- Otherwise, it would be re-enqueue because of empty -- resulting in out-of-order. -- To implement this, 'tbqNonEmpty' is used.- let hdr1+ let hdr1, hdr2 :: [Header]+ hdr1 | scheme /= "" = (":scheme", scheme) : hdr0 | otherwise = hdr0 hdr2- | auth /= "" = (":authority", auth) : hdr1+ | auth /= "" = (":authority", UTF8.fromString auth) : hdr1 | otherwise = hdr1 req' = req{outObjHeaders = hdr2} -- FLOW CONTROL: SETTINGS_MAX_CONCURRENT_STREAMS: send: respecting peer's limit
Network/HTTP2/H2/Context.hs view
@@ -32,7 +32,7 @@ data ClientInfo = ClientInfo { scheme :: ByteString- , authority :: ByteString+ , authority :: Authority } toServerInfo :: RoleInfo -> ServerInfo@@ -46,7 +46,7 @@ newServerInfo :: IO RoleInfo newServerInfo = RIS . ServerInfo <$> newTQueueIO -newClientInfo :: ByteString -> ByteString -> RoleInfo+newClientInfo :: ByteString -> Authority -> RoleInfo newClientInfo scm auth = RIC $ ClientInfo scm auth ----------------------------------------------------------------@@ -175,7 +175,20 @@ {-# INLINE setStreamState #-} setStreamState :: Context -> Stream -> StreamState -> IO ()-setStreamState _ Stream{streamState} val = writeIORef streamState val+setStreamState _ Stream{streamState} newState = do+ oldState <- readIORef streamState+ case (oldState, newState) of+ (Open _ (Body q _ _ _), Open _ (Body q' _ _ _)) | q == q' ->+ -- The stream stays open with the same body; nothing to do+ return ()+ (Open _ (Body q _ _ _), _) ->+ -- The stream is either closed, or is open with a /new/ body+ -- We need to close the old queue so that any reads from it won't block+ atomically $ writeTQueue q $ Left $ toException ConnectionIsClosed+ _otherwise ->+ -- The stream wasn't open to start with; nothing to do+ return ()+ writeIORef streamState newState opened :: Context -> Stream -> IO () opened ctx strm = setStreamState ctx strm (Open Nothing JustOpened)
Network/HTTP2/H2/Receiver.hs view
@@ -15,6 +15,7 @@ import UnliftIO.Concurrent import qualified UnliftIO.Exception as E import UnliftIO.STM+import qualified Data.ByteString.UTF8 as UTF8 import Imports hiding (delete, insert) import Network.HPACK@@ -289,7 +290,11 @@ when (ftyp == FrameHeaders) $ setPeerStreamID ctx streamId -- FLOW CONTROL: SETTINGS_MAX_CONCURRENT_STREAMS: recv: rejecting if over my limit Just <$> openOddStreamCheck ctx streamId ftyp- | otherwise = undefined -- never reach+ | otherwise =+ -- We received a frame from the server on an unknown stream+ -- (likely a previously created and then subsequently reset stream).+ -- We just drop it.+ return Nothing ---------------------------------------------------------------- @@ -365,7 +370,7 @@ (_, vt) <- hpackDecodeHeader frag streamId ctx let ClientInfo{..} = toClientInfo $ roleInfo ctx when- ( getHeaderValue tokenAuthority vt == Just authority+ ( getHeaderValue tokenAuthority vt == Just (UTF8.fromString authority) && getHeaderValue tokenScheme vt == Just scheme ) $ do
Network/HTTP2/H2/Types.hs view
@@ -28,7 +28,7 @@ type Scheme = ByteString -- | Authority.-type Authority = ByteString+type Authority = String -- | Path. type Path = ByteString
Network/HTTP2/Server.hs view
@@ -118,6 +118,7 @@ import Data.ByteString.Builder (Builder) import Data.IORef (readIORef) import qualified Network.HTTP.Types as H+import qualified Data.ByteString.UTF8 as UTF8 import Imports import Network.HPACK@@ -147,7 +148,7 @@ -- | Getting the authority from a request. requestAuthority :: Request -> Maybe Authority-requestAuthority (Request req) = getHeaderValue tokenAuthority vt+requestAuthority (Request req) = UTF8.toString <$> getHeaderValue tokenAuthority vt where (_, vt) = inpObjHeaders req
http2.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: http2-version: 5.0.1+version: 5.1.0 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto <kazu@iij.ad.jp>@@ -127,7 +127,8 @@ network-control >= 0.0.2 && < 0.1, unix-time >= 0.4.11 && < 0.5, time-manager >= 0.0.1 && < 0.1,- unliftio >= 0.2 && < 0.3+ unliftio >= 0.2 && < 0.3,+ utf8-string >= 1.0 && < 1.1 executable client main-is: client.hs
test/HTTP2/ClientSpec.hs view
@@ -8,9 +8,7 @@ import Control.Concurrent import qualified Control.Exception as E import Control.Monad-import Data.ByteString (ByteString) import Data.ByteString.Builder (byteString)-import qualified Data.ByteString.Char8 as C8 import Data.Foldable (for_) import Data.Maybe import Data.Traversable (for)@@ -32,16 +30,13 @@ host :: String host = "127.0.0.1" -host' :: ByteString-host' = C8.pack host- spec :: Spec spec = do describe "client" $ do it "receives an error if scheme is missing" $ E.bracket (forkIO $ runServer defaultServer) killThread $ \_ -> do threadDelay 10000- runClient "" host' (defaultClient []) `shouldThrow` connectionError+ runClient "" host (defaultClient []) `shouldThrow` connectionError it "receives an error if authority is missing" $ E.bracket (forkIO $ runServer defaultServer) killThread $ \_ -> do@@ -51,7 +46,7 @@ it "receives an error if authority and host are different" $ E.bracket (forkIO $ runServer defaultServer) killThread $ \_ -> do threadDelay 10000- runClient "http" host' (defaultClient [("Host", "foo")])+ runClient "http" host (defaultClient [("Host", "foo")]) `shouldThrow` connectionError it "does not deadlock (in concurrent setting)" $
test/HTTP2/ServerSpec.hs view
@@ -177,7 +177,7 @@ runClient allocConfig = runTCPClient host port $ runHTTP2Client where- auth = C8.pack host+ auth = host cliconf = C.defaultClientConfig{C.authority = auth} runHTTP2Client s = E.bracket@@ -315,7 +315,7 @@ runAttack attack = runTCPClient host port $ runHTTP2Client where- auth = C8.pack host+ auth = host cliconf = C.defaultClientConfig{C.authority = auth} runHTTP2Client s = E.bracket