http3 0.0.10 → 0.0.11

raw patch · 29 files changed

+447/−435 lines, 29 filesdep +http-semanticsdep ~http2setup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: http-semantics

Dependency ranges changed: http2

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Imports.hs +23/−17
• Network/HQ/Client.hs +13/−14
• Network/HQ/Server.hs +24/−25
• Network/HTTP3/Client.hs +6/−55
• Network/HTTP3/Config.hs +1/−1
• Network/HTTP3/Context.hs +1/−1
• Network/HTTP3/Recv.hs +6/−3
• Network/HTTP3/Send.hs +4/−3
• Network/HTTP3/Server.hs +9/−73
• Network/QPACK.hs +14/−16
• Network/QPACK/HeaderBlock/Decode.hs +11/−5
• Network/QPACK/HeaderBlock/Encode.hs +8/−7
• Network/QPACK/HeaderBlock/Prefix.hs +1/−1
• Network/QPACK/Instruction.hs +12/−5
• Network/QPACK/Table/Dynamic.hs +10/−1
• Network/QPACK/Table/RevIndex.hs +16/−16
• Network/QPACK/Table/Static.hs +2/−1
• Setup.hs +1/−0
• http3.cabal +4/−2
• test/HTTP3/Config.hs +28/−23
• test/HTTP3/Error.hs +146/−77
• test/HTTP3/ErrorSpec.hs +4/−1
• test/HTTP3/Server.hs +16/−15
• test/HTTP3/ServerSpec.hs +11/−8
• test/QPACK/InstructionSpec.hs +18/−16
• test/QPACK/QIFSpec.hs +47/−42
• test/QPACK/TableSpec.hs +3/−3
• util/qif.hs +4/−4

@@ -1,5 +1,9 @@ # Revision history for http3 +## 0.0.11++* Using http-semantics.+ ## 0.0.10  * Locking QPCK encoder

@@ -1,24 +1,28 @@ module Imports (-    ByteString(..)-  , module Control.Applicative-  , module Control.Monad-  , module Data.Bits-  , module Data.List-  , module Data.Foldable-  , module Data.Int-  , module Data.Monoid-  , module Data.Ord-  , module Data.Word-  , module Data.Maybe-  , module Numeric-  , withForeignPtr-  , mallocPlainForeignPtrBytes-  ) where+    ByteString (..),+    module Control.Applicative,+    module Control.Monad,+    module Data.Bits,+    module Data.List,+    module Data.Foldable,+    module Data.Int,+    module Data.Monoid,+    module Data.Ord,+    module Data.Word,+    module Data.Maybe,+    module Numeric,+    module Network.HTTP.Semantics,+    module Network.HTTP.Types,+    module Data.CaseInsensitive,+    withForeignPtr,+    mallocPlainForeignPtrBytes,+) where  import Control.Applicative import Control.Monad import Data.Bits hiding (Bits)-import Data.ByteString.Internal (ByteString(..))+import Data.ByteString.Internal (ByteString (..))+import Data.CaseInsensitive (foldedCase, mk, original) import Data.Foldable import Data.Int import Data.List@@ -27,5 +31,7 @@ import Data.Ord import Data.Word import Foreign.ForeignPtr-import Numeric import GHC.ForeignPtr (mallocPlainForeignPtrBytes)+import Network.HTTP.Semantics+import Network.HTTP.Types+import Numeric

@@ -12,43 +12,42 @@     H3.Config (..),     H3.allocSimpleConfig,     H3.freeSimpleConfig,-    H3.Scheme,-    H3.Authority,+    Scheme,+    Authority,      -- * HQ client-    H2.Client,+    Client,      -- * Request     Request,      -- * Creating request-    H2.requestNoBody,+    requestNoBody,      -- * Response     Response,      -- ** Accessing response-    H2.getResponseBodyChunk,+    getResponseBodyChunk, ) where  import qualified Data.ByteString as BS import Data.IORef-import Data.Maybe (fromJust) import Network.HPACK-import qualified Network.HTTP2.Client as H2-import Network.HTTP2.Client.Internal (Request (..), Response (..), Aux (..))-import Network.HTTP2.Internal (InpObj (..))-import qualified Network.HTTP2.Internal as H2+import Network.HTTP.Semantics+import Network.HTTP.Semantics.Client+import Network.HTTP.Semantics.Client.Internal import Network.QUIC (Connection)-import Network.QUIC.Internal (possibleMyStreams) import qualified Network.QUIC as QUIC+import Network.QUIC.Internal (possibleMyStreams) import qualified UnliftIO.Exception as E +import Imports import qualified Network.HTTP3.Client as H3 import Network.HTTP3.Recv (newSource, readSource)  -- | Running an HQ client.-run :: Connection -> H3.ClientConfig -> H3.Config -> H2.Client a -> IO a+run :: Connection -> H3.ClientConfig -> H3.Config -> Client a -> IO a run conn _ _ client = client (sendRequest conn) aux   where     aux =@@ -58,14 +57,14 @@  sendRequest :: Connection -> Request -> (Response -> IO a) -> IO a sendRequest conn (Request outobj) processResponse = E.bracket open close $ \strm -> do-    let hdr = H2.outObjHeaders outobj+    let hdr = outObjHeaders outobj         path = fromJust $ lookup ":path" hdr         requestLine = BS.concat ["GET ", path, "\r\n"]     QUIC.sendStream strm requestLine     QUIC.shutdownStream strm     src <- newSource strm     refH <- newIORef Nothing-    vt <- toHeaderTable []+    vt <- toTokenHeaderTable []     let readB = readSource src         rsp = Response $ InpObj vt Nothing readB refH     processResponse rsp

@@ -18,16 +18,16 @@     Request,      -- ** Accessing request-    H2.requestPath,+    requestPath,      -- * Response     Response,      -- ** Creating response-    H2.responseNoBody,-    H2.responseFile,-    H2.responseStreaming,-    H2.responseBuilder,+    responseNoBody,+    responseFile,+    responseStreaming,+    responseBuilder, ) where  import Control.Concurrent@@ -37,12 +37,11 @@ import qualified Data.ByteString.Internal as BS import Data.IORef import Foreign.ForeignPtr-import Network.HPACK (HeaderTable, toHeaderTable)-import Network.HTTP2.Internal (InpObj (..))-import qualified Network.HTTP2.Internal as H2-import Network.HTTP2.Server (PushPromise, Server)-import qualified Network.HTTP2.Server as H2-import Network.HTTP2.Server.Internal (Aux (..), Request (..), Response (..))+import Network.HPACK.Internal (toTokenHeaderTable)+import Network.HTTP.Semantics.IO+import Network.HTTP.Semantics.Server+import Network.HTTP.Semantics.Server.Internal+ import Network.QUIC (Connection, Stream) import qualified Network.QUIC as QUIC import Network.SockAddr (showSockAddrBS)@@ -80,7 +79,7 @@   where     sid = QUIC.streamId strm -recvHeader :: Stream -> SockAddr -> IO HeaderTable+recvHeader :: Stream -> SockAddr -> IO TokenHeaderTable recvHeader strm myaddr = do     (method, path) <- recvRequestLine id     let auth = showSockAddrBS myaddr@@ -90,7 +89,7 @@                 : (":scheme", "https")                 : (":authority", auth)                 : []-    toHeaderTable vt+    toTokenHeaderTable vt   where     recvRequestLine builder = do         bs <- QUIC.recvStream strm 1024@@ -105,29 +104,29 @@         path = BS.take (BS.length path0 - 2) path0  sendResponse :: Config -> Stream -> Response -> [PushPromise] -> IO ()-sendResponse conf strm (Response outobj) _ = case H2.outObjBody outobj of-    H2.OutBodyNone -> return ()-    H2.OutBodyFile (H2.FileSpec path fileoff bytecount) -> do+sendResponse conf strm (Response outobj) _ = case outObjBody outobj of+    OutBodyNone -> return ()+    OutBodyFile (FileSpec path fileoff bytecount) -> do         (pread, sentinel') <- confPositionReadMaker conf path         let timmgr = confTimeoutManager conf         refresh <- case sentinel' of-            H2.Closer closer -> do+            Closer closer -> do                 th <- T.register timmgr closer                 return $ T.tickle th-            H2.Refresher refresher -> return refresher-        let next = H2.fillFileBodyGetNext pread fileoff bytecount refresh+            Refresher refresher -> return refresher+        let next = fillFileBodyGetNext pread fileoff bytecount refresh         sendNext strm next-    H2.OutBodyBuilder builder -> do-        let next = H2.fillBuilderBodyGetNext builder+    OutBodyBuilder builder -> do+        let next = fillBuilderBodyGetNext builder         sendNext strm next-    H2.OutBodyStreaming strmbdy -> sendStreaming strm strmbdy-    H2.OutBodyStreamingUnmask _ ->+    OutBodyStreaming strmbdy -> sendStreaming strm strmbdy+    OutBodyStreamingUnmask _ ->         error "sendResponse: server does not support OutBodyStreamingUnmask" -sendNext :: Stream -> H2.DynaNext -> IO ()+sendNext :: Stream -> DynaNext -> IO () sendNext strm action = do     fp <- BS.mallocByteString 2048-    H2.Next len _reqflush mnext <- withForeignPtr fp $ \buf -> action buf 2048 65536 -- window size+    Next len _reqflush mnext <- withForeignPtr fp $ \buf -> action buf 2048 65536 -- window size     if len == 0         then return ()         else do

@@ -14,69 +14,20 @@     freeSimpleConfig,     Hooks (..),     defaultHooks,-    Scheme,-    Authority,--    -- * HTTP\/3 client-    Client,-    SendRequest,-    Aux,--    -- * Request-    Request,--    -- * Creating request-    H2.requestNoBody,-    H2.requestFile,-    H2.requestStreaming,-    H2.requestBuilder,--    -- ** Trailers maker-    H2.TrailersMaker,-    H2.NextTrailersMaker (..),-    H2.defaultTrailersMaker,-    H2.setRequestTrailersMaker,--    -- * Response-    Response,--    -- ** Accessing response-    H2.responseStatus,-    H2.responseHeaders,-    H2.responseBodySize,-    H2.getResponseBodyChunk,-    H2.getResponseTrailers,--    -- * Types-    H2.Method,-    H2.Path,-    H2.FileSpec (..),-    H2.FileOffset,-    H2.ByteCount,--    -- * RecvN-    H2.defaultReadN,--    -- * Position read for files-    H2.PositionReadMaker,-    H2.PositionRead,-    H2.Sentinel (..),-    H2.defaultPositionReadMaker,+    module Network.HTTP.Semantics.Client, ) where  import Control.Concurrent import qualified Data.ByteString.Char8 as C8 import Data.IORef-import Network.HTTP2.Client (Authority, Client, Scheme, SendRequest)-import qualified Network.HTTP2.Client as H2-import Network.HTTP2.Client.Internal (Aux (..), Request (..), Response (..))-import Network.HTTP2.Internal (InpObj (..))-import qualified Network.HTTP2.Internal as H2+import Network.HTTP.Semantics.Client+import Network.HTTP.Semantics.Client.Internal import Network.QUIC (Connection) import qualified Network.QUIC as QUIC import Network.QUIC.Internal (possibleMyStreams) import qualified UnliftIO.Exception as E +import Imports import Network.HTTP3.Config import Network.HTTP3.Context import Network.HTTP3.Control@@ -93,7 +44,7 @@     }  -- | Running an HTTP\/3 client.-run :: Connection -> ClientConfig -> Config -> H2.Client a -> IO a+run :: Connection -> ClientConfig -> Config -> Client a -> IO a run conn ClientConfig{..} conf client = E.bracket open close $ \ctx -> do     tid0 <- forkIO $ setupUnidirectional conn conf     addThreadId ctx tid0@@ -130,7 +81,7 @@     :: Context -> Scheme -> Authority -> Request -> (Response -> IO a) -> IO a sendRequest ctx scm auth (Request outobj) processResponse = do     th <- registerThread ctx-    let hdr = H2.outObjHeaders outobj+    let hdr = outObjHeaders outobj         hdr' =             (":scheme", scm)                 : (":authority", C8.pack auth)

@@ -1,6 +1,6 @@ module Network.HTTP3.Config where -import Network.HTTP2.Internal+import Network.HTTP.Semantics.Client import Network.HTTP3.Frame import Network.QUIC (Stream) import qualified System.TimeManager as T

@@ -27,7 +27,7 @@ import Control.Concurrent import qualified Data.ByteString as BS import Data.IORef-import Network.HTTP2.Internal (PositionReadMaker)+import Network.HTTP.Semantics.Client import Network.QUIC import Network.QUIC.Internal (connDebugLog, isClient, isServer) import Network.Socket (SockAddr)

@@ -11,7 +11,6 @@  import qualified Data.ByteString as BS import Data.IORef-import Network.HPACK (HeaderTable) import Network.QUIC  import Imports@@ -40,7 +39,7 @@ pushbackSource _ "" = return () pushbackSource Source{..} bs = writeIORef sourcePending $ Just bs -recvHeader :: Context -> Source -> IO (Maybe HeaderTable)+recvHeader :: Context -> Source -> IO (Maybe TokenHeaderTable) recvHeader ctx src = loop IInit   where     loop st = do@@ -64,7 +63,11 @@                 st' -> loop st'  recvBody-    :: Context -> Source -> IORef IFrame -> IORef (Maybe HeaderTable) -> IO ByteString+    :: Context+    -> Source+    -> IORef IFrame+    -> IORef (Maybe TokenHeaderTable)+    -> IO ByteString recvBody ctx src refI refH = do     st <- readIORef refI     loop st

@@ -11,9 +11,10 @@ import qualified Data.ByteString.Internal as BS import Data.IORef import Foreign.ForeignPtr-import Network.HPACK (toHeaderTable)+import Network.HPACK.Internal (toTokenHeaderTable)+import Network.HTTP.Semantics.Client+import Network.HTTP.Semantics.IO import qualified Network.HTTP.Types as HT-import Network.HTTP2.Internal hiding (timeoutClose) import Network.QUIC import qualified System.TimeManager as T import qualified UnliftIO.Exception as E@@ -25,7 +26,7 @@ sendHeader :: Context -> Stream -> T.Handle -> HT.ResponseHeaders -> IO () sendHeader ctx strm th hdrs = do     -- fixme: fixHeaders-    (ths, _) <- toHeaderTable hdrs+    (ths, _) <- toTokenHeaderTable hdrs     (hdr, "") <- qpackEncode ctx ths     let frames = [H3Frame H3FrameHeaders hdr]         frames' = onHeadersFrameCreated (getHooks ctx) frames

@@ -12,77 +12,14 @@     freeSimpleConfig,     Hooks (..),     defaultHooks,--    -- * HTTP\/3 server-    Server,--    -- * Request-    Request,--    -- ** Accessing request-    H2.requestMethod,-    H2.requestPath,-    H2.requestAuthority,-    H2.requestScheme,-    H2.requestHeaders,-    H2.requestBodySize,-    H2.getRequestBodyChunk,-    H2.getRequestTrailers,--    -- * Aux-    Aux,-    auxTimeHandle,--    -- * Response-    Response,--    -- ** Creating response-    H2.responseNoBody,-    H2.responseFile,-    H2.responseStreaming,-    H2.responseBuilder,--    -- ** Accessing response-    H2.responseBodySize,--    -- ** Trailers maker-    H2.TrailersMaker,-    H2.NextTrailersMaker (..),-    H2.defaultTrailersMaker,-    H2.setResponseTrailersMaker,--    -- * Push promise-    PushPromise,-    H2.pushPromise,-    H2.promiseRequestPath,-    H2.promiseResponse,--    -- * Types-    H2.Path,-    H2.Authority,-    H2.Scheme,-    H2.FileSpec (..),-    H2.FileOffset,-    H2.ByteCount,--    -- * RecvN-    H2.defaultReadN,--    -- * Position read for files-    H2.PositionReadMaker,-    H2.PositionRead,-    H2.Sentinel (..),-    H2.defaultPositionReadMaker,+    module Network.HTTP.Semantics.Server, ) where  import Control.Concurrent import Data.IORef-import Network.HPACK.Token-import Network.HTTP2.Internal (InpObj (..))-import qualified Network.HTTP2.Internal as H2-import Network.HTTP2.Server (PushPromise, Server)-import qualified Network.HTTP2.Server as H2-import Network.HTTP2.Server.Internal (Aux (..), Request (..), Response (..))+import Network.HTTP.Semantics+import Network.HTTP.Semantics.Server+import Network.HTTP.Semantics.Server.Internal import Network.QUIC (Connection, Stream) import qualified Network.QUIC as QUIC import qualified System.TimeManager as T@@ -96,7 +33,6 @@ import Network.HTTP3.Frame import Network.HTTP3.Recv import Network.HTTP3.Send-import Network.QPACK import Network.QPACK.Internal  -- | Running an HTTP\/3 server.@@ -136,10 +72,10 @@     case mvt of         Nothing -> QUIC.resetStream strm H3MessageError         Just ht@(_, vt) -> do-            let mMethod = getHeaderValue tokenMethod vt-                mScheme = getHeaderValue tokenScheme vt-                mAuthority = getHeaderValue tokenAuthority vt-                mPath = getHeaderValue tokenPath vt+            let mMethod = getFieldValue tokenMethod vt+                mScheme = getFieldValue tokenScheme vt+                mAuthority = getFieldValue tokenAuthority vt+                mPath = getFieldValue tokenPath vt             case (mMethod, mScheme, mAuthority, mPath) of                 (Just "CONNECT", _, Just _, _) -> return ()                 (Just _, Just _, Just _, Just _) -> return ()@@ -160,6 +96,6 @@ sendResponse     :: Context -> Stream -> T.Handle -> Response -> [PushPromise] -> IO () sendResponse ctx strm th (Response outobj) _pp = do-    sendHeader ctx strm th $ H2.outObjHeaders outobj+    sendHeader ctx strm th $ outObjHeaders outobj     sendBody ctx strm th outobj     QUIC.shutdownStream strm

@@ -33,13 +33,12 @@     CompressionAlgo (..),      -- * Re-exports-    HeaderTable,+    TokenHeaderTable,     TokenHeaderList,     ValueTable,     Header,-    HeaderList,-    getHeaderValue,-    toHeaderTable,+    getFieldValue,+    toTokenHeaderTable,     original,     foldedCase,     mk,@@ -50,15 +49,14 @@ import qualified Data.ByteString as B import Data.CaseInsensitive import Network.ByteOrder-import Network.HPACK (-    HeaderList,-    HeaderTable,-    TokenHeaderList,-    ValueTable,-    getHeaderValue,-    toHeaderTable,+import Network.HPACK.Internal (+    GCBuffer,+    Size,+    entryToken,+    toEntryToken,+    toTokenHeaderTable,  )-import Network.HPACK.Internal+import Network.HTTP.Types import Network.QUIC.Internal (stdoutLogger) import qualified UnliftIO.Exception as E @@ -76,10 +74,10 @@     TokenHeaderList -> IO (EncodedFieldSection, EncodedEncoderInstruction)  -- | QPACK decoder.-type QDecoder = EncodedFieldSection -> IO HeaderTable+type QDecoder = EncodedFieldSection -> IO TokenHeaderTable  -- | QPACK simple decoder.-type QDecoderS = EncodedFieldSection -> IO HeaderList+type QDecoderS = EncodedFieldSection -> IO [Header]  -- | Encoder instruction handler. type EncoderInstructionHandler = (Int -> IO EncodedEncoderInstruction) -> IO ()@@ -233,10 +231,10 @@         handler = encoderInstructionHandlerS dyntbl     return (dec, handler) -qpackDecoder :: DynamicTable -> EncodedFieldSection -> IO HeaderTable+qpackDecoder :: DynamicTable -> EncodedFieldSection -> IO TokenHeaderTable qpackDecoder dyntbl bs = withReadBuffer bs $ \rbuf -> decodeTokenHeader dyntbl rbuf -qpackDecoderS :: DynamicTable -> EncodedFieldSection -> IO HeaderList+qpackDecoderS :: DynamicTable -> EncodedFieldSection -> IO [Header] qpackDecoderS dyntbl bs = withReadBuffer bs $ \rbuf -> decodeTokenHeaderS dyntbl rbuf  encoderInstructionHandler

@@ -6,9 +6,15 @@ import qualified Data.ByteString.Char8 as BS8 import Data.CaseInsensitive import Network.ByteOrder-import Network.HPACK (HeaderList, HeaderTable, TokenHeader)-import Network.HPACK.Internal-import Network.HPACK.Token (toToken, tokenKey)+import Network.HPACK.Internal (+    decodeI,+    decodeS,+    decodeSimple,+    decodeSophisticated,+    entryToken,+    entryTokenHeader,+ )+import Network.HTTP.Types  import Imports import Network.QPACK.HeaderBlock.Prefix@@ -18,7 +24,7 @@ decodeTokenHeader     :: DynamicTable     -> ReadBuffer-    -> IO HeaderTable+    -> IO TokenHeaderTable decodeTokenHeader dyntbl rbuf = do     (reqip, bp) <- decodePrefix rbuf dyntbl     checkInsertionPoint dyntbl reqip@@ -27,7 +33,7 @@ decodeTokenHeaderS     :: DynamicTable     -> ReadBuffer-    -> IO HeaderList+    -> IO [Header] decodeTokenHeaderS dyntbl rbuf = do     (reqip, bp) <- decodePrefix rbuf dyntbl     debug <- getDebugQPACK dyntbl

@@ -13,14 +13,15 @@ import qualified Data.ByteString as B import Data.IORef import Network.ByteOrder-import Network.HPACK (+import Network.HPACK.Internal (     CompressionAlgo (..),     EncodeStrategy (..),-    HeaderList,-    TokenHeaderList,+    encodeI,+    encodeS,+    toEntryToken,  )-import Network.HPACK.Internal-import Network.HPACK.Token+import Network.HTTP.Semantics+import Network.HTTP.Types import qualified UnliftIO.Exception as E  import Imports@@ -42,7 +43,7 @@ encodeHeader     :: EncodeStrategy     -> DynamicTable-    -> HeaderList+    -> [Header]     -> IO (EncodedFieldSection, EncodedEncoderInstruction) encodeHeader stgy dyntbl hs = do     (hb0, insb) <- withWriteBuffer' 2048 $ \wbuf1 ->@@ -53,7 +54,7 @@     let hb = prefix `B.append` hb0     return (hb, insb)   where-    ts = map (\(k, v) -> let t = toToken k in (t, v)) hs+    ts = map (\(k, v) -> let t = toToken (foldedCase k) in (t, v)) hs  -- | Converting 'TokenHeaderList' to the QPACK format. encodeTokenHeader

@@ -11,7 +11,7 @@ ) where  import Network.ByteOrder-import Network.HPACK.Internal+import Network.HPACK.Internal (decodeI, encodeI) import qualified UnliftIO.Exception as E  import Imports

@@ -23,8 +23,15 @@ import qualified Data.ByteString.Char8 as BS8 import Data.CaseInsensitive import Network.ByteOrder-import Network.HPACK.Internal-import Network.HPACK.Token+import Network.HPACK.Internal (+    HuffmanDecoder,+    decodeH,+    decodeI,+    decodeS,+    encodeI,+    encodeS,+    entryHeaderName,+ ) import qualified UnliftIO.Exception as E  import Imports@@ -37,8 +44,8 @@  data EncoderInstruction     = SetDynamicTableCapacity Int-    | InsertWithNameReference InsIndex HeaderValue-    | InsertWithoutNameReference Token HeaderValue+    | InsertWithNameReference InsIndex FieldValue+    | InsertWithoutNameReference Token FieldValue     | Duplicate InsRelativeIndex     deriving (Eq) @@ -46,7 +53,7 @@     show (SetDynamicTableCapacity n) = "SetDynamicTableCapacity " ++ show n     show (InsertWithNameReference (Left aidx) v) =         "InsertWithNameReference \""-            ++ BS8.unpack (entryHeaderName (toStaticEntry aidx))+            ++ BS8.unpack (original (entryHeaderName (toStaticEntry aidx)))             ++ "\" \""             ++ BS8.unpack v             ++ "\""

@@ -8,7 +8,16 @@ import Data.Array.MArray (newArray) import Data.IORef import Network.ByteOrder-import Network.HPACK.Internal+import Network.HPACK.Internal (+    Entry,+    GCBuffer,+    HuffmanDecoder,+    Index,+    Size,+    decH,+    dummyEntry,+    maxNumbers,+ ) import qualified UnliftIO.Exception as E  import Imports

@@ -19,8 +19,8 @@ import Data.IORef import Data.Map.Strict (Map) import qualified Data.Map.Strict as M-import Network.HPACK.Internal-import Network.HPACK.Token+import Network.HPACK.Internal (Entry (..))+import Network.HTTP.Semantics  import Imports import Network.QPACK.Table.Static@@ -37,7 +37,7 @@  type DynamicRevIndex = Array Int (IORef ValueMap) -data KeyValue = KeyValue HeaderName HeaderValue deriving (Eq, Ord)+data KeyValue = KeyValue FieldName FieldValue deriving (Eq, Ord)  -- We always create an index for a pair of an unknown header and its value -- in Linear{H}.@@ -59,14 +59,14 @@  data StaticEntry = StaticEntry HIndex (Maybe ValueMap) deriving (Show) -type ValueMap = Map HeaderValue HIndex+type ValueMap = Map FieldValue HIndex  ----------------------------------------------------------------  staticRevIndex :: StaticRevIndex staticRevIndex = A.array (minTokenIx, 51) $ map toEnt zs   where-    toEnt (k, xs) = (quicIx $ tokenIx $ toToken k, m)+    toEnt (k, xs) = (quicIx $ tokenIx $ toToken $ foldedCase k, m)       where         m = case xs of             [] -> error "staticRevIndex"@@ -80,7 +80,7 @@         extract xs = (fst (head xs), map snd xs)  {-# INLINE lookupStaticRevIndex #-}-lookupStaticRevIndex :: Int -> HeaderValue -> RevResult+lookupStaticRevIndex :: Int -> FieldValue -> RevResult lookupStaticRevIndex ix v = case staticRevIndex `unsafeAt` ix of     StaticEntry i Nothing -> K i     StaticEntry i (Just m) -> case M.lookup v m of@@ -90,9 +90,9 @@ ----------------------------------------------------------------  newDynamicRevIndex :: IO DynamicRevIndex-newDynamicRevIndex = A.listArray (minTokenIx, maxStaticTokenIx) <$> mapM mk lst+newDynamicRevIndex = A.listArray (minTokenIx, maxStaticTokenIx) <$> mapM mk' lst   where-    mk _ = newIORef M.empty+    mk' _ = newIORef M.empty     lst = [minTokenIx .. maxStaticTokenIx]  renewDynamicRevIndex :: DynamicRevIndex -> IO ()@@ -102,7 +102,7 @@  {-# INLINE lookupDynamicStaticRevIndex #-} lookupDynamicStaticRevIndex-    :: Int -> HeaderValue -> DynamicRevIndex -> IO RevResult+    :: Int -> FieldValue -> DynamicRevIndex -> IO RevResult lookupDynamicStaticRevIndex ix v drev = do     let ref = drev `unsafeAt` ix     m <- readIORef ref@@ -112,13 +112,13 @@  {-# INLINE insertDynamicRevIndex #-} insertDynamicRevIndex-    :: Token -> HeaderValue -> HIndex -> DynamicRevIndex -> IO ()+    :: Token -> FieldValue -> HIndex -> DynamicRevIndex -> IO () insertDynamicRevIndex t v i drev = modifyIORef ref $ M.insert v i   where     ref = drev `unsafeAt` tokenIx t  {-# INLINE deleteDynamicRevIndex #-}-deleteDynamicRevIndex :: Token -> HeaderValue -> DynamicRevIndex -> IO ()+deleteDynamicRevIndex :: Token -> FieldValue -> DynamicRevIndex -> IO () deleteDynamicRevIndex t v drev = modifyIORef ref $ M.delete v   where     ref = drev `unsafeAt` tokenIx t@@ -132,7 +132,7 @@ renewOtherRevIndex ref = writeIORef ref M.empty  {-# INLINE lookupOtherRevIndex #-}-lookupOtherRevIndex :: Header -> OtherRevIdex -> IO RevResult+lookupOtherRevIndex :: (FieldName, FieldValue) -> OtherRevIdex -> IO RevResult lookupOtherRevIndex (k, v) ref = do     oth <- readIORef ref     case M.lookup (KeyValue k v) oth of@@ -140,13 +140,13 @@         Just i -> return $ KV i  {-# INLINE insertOtherRevIndex #-}-insertOtherRevIndex :: Token -> HeaderValue -> HIndex -> OtherRevIdex -> IO ()+insertOtherRevIndex :: Token -> FieldValue -> HIndex -> OtherRevIdex -> IO () insertOtherRevIndex t v i ref = modifyIORef' ref $ M.insert (KeyValue k v) i   where     k = tokenFoldedKey t  {-# INLINE deleteOtherRevIndex #-}-deleteOtherRevIndex :: Token -> HeaderValue -> OtherRevIdex -> IO ()+deleteOtherRevIndex :: Token -> FieldValue -> OtherRevIdex -> IO () deleteOtherRevIndex t v ref = modifyIORef' ref $ M.delete (KeyValue k v)   where     k = tokenFoldedKey t@@ -164,7 +164,7 @@ {-# INLINE lookupRevIndex #-} lookupRevIndex     :: Token-    -> HeaderValue+    -> FieldValue     -> RevIndex     -> IO RevResult lookupRevIndex t@Token{..} v (RevIndex dyn oth)@@ -181,7 +181,7 @@ {-# INLINE lookupRevIndex' #-} lookupRevIndex'     :: Token-    -> HeaderValue+    -> FieldValue     -> RevResult lookupRevIndex' Token{..} v     | ix >= 0 = lookupStaticRevIndex ix v

@@ -8,7 +8,8 @@  import Data.Array (Array, listArray) import Data.Array.Base (unsafeAt)-import Network.HPACK.Internal+import Network.HPACK.Internal (Entry, Index, Size, toEntry)+import Network.HTTP.Types (Header) import qualified UnliftIO.Exception as E  import Network.QPACK.Error

@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               http3-version:            0.0.10+version:            0.0.11 license:            BSD-3-Clause license-file:       LICENSE maintainer:         Kazu Yamamoto <kazu@iij.ad.jp>@@ -81,8 +81,9 @@         bytestring,         case-insensitive,         containers,-        http2 >=5.1.4 && <5.2,+        http-semantics,         http-types,+        http2 >=5.2 && <5.3,         network,         network-byte-order,         quic >= 0.1.20 && < 0.2,@@ -198,6 +199,7 @@         conduit-extra,         crypton,         hspec >=1.3,+        http-semantics,         http-types,         http2,         http3,

@@ -1,47 +1,52 @@ {-# LANGUAGE OverloadedStrings #-}  module HTTP3.Config (-    makeTestServerConfig-  , testClientConfig-  , testH3ClientConfig-  ) where+    makeTestServerConfig,+    testClientConfig,+    testH3ClientConfig,+) where  import Data.ByteString (ByteString) import qualified Data.List as L import qualified Network.HTTP3.Client as H3-import Network.TLS (Credentials(..), credentialLoadX509)+import Network.TLS (Credentials (..), credentialLoadX509)  import Network.QUIC.Client import Network.QUIC.Internal  makeTestServerConfig :: IO ServerConfig makeTestServerConfig = do-    cred <- either error id <$> credentialLoadX509 "test/servercert.pem" "test/serverkey.pem"+    cred <-+        either error id+            <$> credentialLoadX509 "test/servercert.pem" "test/serverkey.pem"     let credentials = Credentials [cred]-    return testServerConfig {-        scCredentials = credentials-      , scALPN = Just chooseALPN-      }+    return+        testServerConfig+            { scCredentials = credentials+            , scALPN = Just chooseALPN+            }  testServerConfig :: ServerConfig-testServerConfig = defaultServerConfig {-    scAddresses = [("127.0.0.1",8003)]-  }+testServerConfig =+    defaultServerConfig+        { scAddresses = [("127.0.0.1", 8003)]+        }  testClientConfig :: ClientConfig-testClientConfig = defaultClientConfig {-    ccPortName = "8003"-  , ccValidate = False-  }+testClientConfig =+    defaultClientConfig+        { ccPortName = "8003"+        , ccValidate = False+        }  chooseALPN :: Version -> [ByteString] -> IO ByteString chooseALPN _ver protos = return $ case mh3idx of-    Nothing    -> case mhqidx of-      Nothing    -> ""-      Just _     -> "hq"-    Just h3idx ->  case mhqidx of-      Nothing    -> "h3"-      Just hqidx -> if h3idx < hqidx then "h3" else "hq"+    Nothing -> case mhqidx of+        Nothing -> ""+        Just _ -> "hq"+    Just h3idx -> case mhqidx of+        Nothing -> "h3"+        Just hqidx -> if h3idx < hqidx then "h3" else "hq"   where     mh3idx = "h3" `L.elemIndex` protos     mhqidx = "hq" `L.elemIndex` protos

@@ -2,8 +2,8 @@ {-# LANGUAGE RankNTypes #-}  module HTTP3.Error (-    h3ErrorSpec-  ) where+    h3ErrorSpec,+) where  import Control.Concurrent import Data.ByteString ()@@ -24,15 +24,19 @@  type Millisecond = Int -runC :: ClientConfig -> H3.ClientConfig -> H3.Config -> Millisecond -> IO (Maybe ())+runC+    :: ClientConfig -> H3.ClientConfig -> H3.Config -> Millisecond -> IO (Maybe ()) runC qcc cconf conf ms = timeout us $ run qcc $ \conn -> do     info <- getConnectionInfo conn     case alpn info of-      Just proto | "hq" `BS.isPrefixOf` proto -> do-                       waitEstablished conn-                       putStrLn $ "Warning: " ++ C8.unpack proto ++ " is negotiated. Skipping this test. Use \"h3spec -s HTTP/3\" next time."-                       E.throwIO $ ApplicationProtocolErrorIsReceived H3InternalError ""-      _                                       -> H3.run conn cconf conf client+        Just proto | "hq" `BS.isPrefixOf` proto -> do+            waitEstablished conn+            putStrLn $+                "Warning: "+                    ++ C8.unpack proto+                    ++ " is negotiated. Skipping this test. Use \"h3spec -s HTTP/3\" next time."+            E.throwIO $ ApplicationProtocolErrorIsReceived H3InternalError ""+        _ -> H3.run conn cconf conf client   where     us = ms * 1000     client :: H3.Client ()@@ -46,60 +50,103 @@ h3ErrorSpec qcc cconf ms = do     conf0 <- runIO H3.allocSimpleConfig     describe "HTTP/3 servers" $ do-        it "MUST send H3_FRAME_UNEXPECTED if DATA is received before HEADERS [HTTP/3 4.1]" $ \_ -> do-            let conf = addHook conf0 $ setOnHeadersFrameCreated requestIllegalData-            runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]+        it+            "MUST send H3_FRAME_UNEXPECTED if DATA is received before HEADERS [HTTP/3 4.1]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnHeadersFrameCreated requestIllegalData+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]         it "MUST send H3_MESSAGE_ERROR if a pseudo-header is duplicated [HTTP/3 4.1.1]" $ \_ -> do             let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader3                 qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "")-            runC qcc' cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3MessageError]-        it "MUST send H3_MESSAGE_ERROR if mandatory pseudo-header fields are absent [HTTP/3 4.1.3]" $ \_ -> do-            let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader0-                qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "")-            runC qcc' cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3MessageError]-        it "MUST send H3_MESSAGE_ERROR if prohibited pseudo-header fields are present[HTTP/3 4.1.3]" $ \_ -> do-            let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader1-                qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "")-            runC qcc' cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3MessageError]-        it "MUST send H3_MESSAGE_ERROR if pseudo-header fields exist after fields [HTTP/3 4.1.3]" $ \_ -> do-            let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader2-                qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "")-            runC qcc' cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3MessageError]-        it "MUST send H3_MISSING_SETTINGS if the first control frame is not SETTINGS [HTTP/3 6.2.1]" $ \_ -> do-            let conf = addHook conf0 $ setOnControlFrameCreated startWithNonSettings-            runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3MissingSettings]-        it "MUST send H3_FRAME_UNEXPECTED if a DATA frame is received on a control stream [HTTP/3 7.2.1]" $ \_ -> do-            let conf = addHook conf0 $ setOnControlFrameCreated controlData-            runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]-        it "MUST send H3_FRAME_UNEXPECTED if a HEADERS frame is received on a control stream [HTTP/3 7.2.2]" $ \_ -> do-            let conf = addHook conf0 $ setOnControlFrameCreated controlHeaders-            runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]-        it "MUST send H3_FRAME_UNEXPECTED if a second SETTINGS frame is received [HTTP/3 7.2.4]" $ \_ -> do-            let conf = addHook conf0 $ setOnControlFrameCreated doubleSettings-            runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]-{- this is MAY-        it "MUST send H3_SETTINGS_ERROR if duplicate setting identifiers exist [HTTP/3 7.2.4]" $ \_ -> do-            let conf = addHook conf0 $ setOnControlFrameCreated illegalSettings0-            runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3SettingsError]--}-        it "MUST send H3_SETTINGS_ERROR if HTTP/2 settings are included [HTTP/3 7.2.4.1]" $ \_ -> do-            let conf = addHook conf0 $ setOnControlFrameCreated illegalSettings1-            runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3SettingsError]-        it "MUST send H3_FRAME_UNEXPECTED if CANCEL_PUSH is received in a request stream [HTTP/3 7.2.5]" $ \_ -> do-            let conf = addHook conf0 $ setOnHeadersFrameCreated requestCancelPush-            runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]-        it "MUST send QPACK_DECOMPRESSION_FAILED if an invalid static table index exits in a field line representation [QPACK 3.1]" $ \_ -> do-            let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader4-            runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [QpackDecompressionFailed]-        it "MUST send QPACK_ENCODER_STREAM_ERROR if a new dynamic table capacity value exceeds the limit [QPACK 4.1.3]" $ \_ -> do-            let conf = addHook conf0 $ setOnEncoderStreamCreated largeTableCapacity-            runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [QpackEncoderStreamError]-        it "MUST send H3_CLOSED_CRITICAL_STREAM if a control stream is closed [QPACK 4.2]" $ \_ -> do-            let conf = addHook conf0 $ setOnControlStreamCreated closeStream-            runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3ClosedCriticalStream]-        it "MUST send QPACK_DECODER_STREAM_ERROR if Insert Count Increment is 0 [QPACK 4.4.3]" $ \_ -> do-            let conf = addHook conf0 $ setOnDecoderStreamCreated zeroInsertCountIncrement-            runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [QpackDecoderStreamError]+            runC qcc' cconf conf ms+                `shouldThrow` applicationProtocolErrorsIn [H3MessageError]+        it+            "MUST send H3_MESSAGE_ERROR if mandatory pseudo-header fields are absent [HTTP/3 4.1.3]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader0+                    qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "")+                runC qcc' cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3MessageError]+        it+            "MUST send H3_MESSAGE_ERROR if prohibited pseudo-header fields are present[HTTP/3 4.1.3]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader1+                    qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "")+                runC qcc' cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3MessageError]+        it+            "MUST send H3_MESSAGE_ERROR if pseudo-header fields exist after fields [HTTP/3 4.1.3]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader2+                    qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "")+                runC qcc' cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3MessageError]+        it+            "MUST send H3_MISSING_SETTINGS if the first control frame is not SETTINGS [HTTP/3 6.2.1]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnControlFrameCreated startWithNonSettings+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3MissingSettings]+        it+            "MUST send H3_FRAME_UNEXPECTED if a DATA frame is received on a control stream [HTTP/3 7.2.1]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnControlFrameCreated controlData+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]+        it+            "MUST send H3_FRAME_UNEXPECTED if a HEADERS frame is received on a control stream [HTTP/3 7.2.2]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnControlFrameCreated controlHeaders+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]+        it+            "MUST send H3_FRAME_UNEXPECTED if a second SETTINGS frame is received [HTTP/3 7.2.4]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnControlFrameCreated doubleSettings+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]+        {- this is MAY+                it "MUST send H3_SETTINGS_ERROR if duplicate setting identifiers exist [HTTP/3 7.2.4]" $ \_ -> do+                    let conf = addHook conf0 $ setOnControlFrameCreated illegalSettings0+                    runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3SettingsError]+        -}+        it+            "MUST send H3_SETTINGS_ERROR if HTTP/2 settings are included [HTTP/3 7.2.4.1]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnControlFrameCreated illegalSettings1+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3SettingsError]+        it+            "MUST send H3_FRAME_UNEXPECTED if CANCEL_PUSH is received in a request stream [HTTP/3 7.2.5]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnHeadersFrameCreated requestCancelPush+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]+        it+            "MUST send QPACK_DECOMPRESSION_FAILED if an invalid static table index exits in a field line representation [QPACK 3.1]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader4+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [QpackDecompressionFailed]+        it+            "MUST send QPACK_ENCODER_STREAM_ERROR if a new dynamic table capacity value exceeds the limit [QPACK 4.1.3]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnEncoderStreamCreated largeTableCapacity+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [QpackEncoderStreamError]+        it+            "MUST send H3_CLOSED_CRITICAL_STREAM if a control stream is closed [QPACK 4.2]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnControlStreamCreated closeStream+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3ClosedCriticalStream]+        it+            "MUST send QPACK_DECODER_STREAM_ERROR if Insert Count Increment is 0 [QPACK 4.4.3]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnDecoderStreamCreated zeroInsertCountIncrement+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [QpackDecoderStreamError]  ---------------------------------------------------------------- @@ -108,22 +155,22 @@   where     hooks = H3.confHooks conf     hooks' = modify hooks-    conf' = conf { H3.confHooks = hooks' }+    conf' = conf{H3.confHooks = hooks'}  setOnControlFrameCreated :: ([H3Frame] -> [H3Frame]) -> H3.Hooks -> H3.Hooks-setOnControlFrameCreated f hooks = hooks { H3.onControlFrameCreated = f }+setOnControlFrameCreated f hooks = hooks{H3.onControlFrameCreated = f}  setOnHeadersFrameCreated :: ([H3Frame] -> [H3Frame]) -> H3.Hooks -> H3.Hooks-setOnHeadersFrameCreated f hooks = hooks { H3.onHeadersFrameCreated = f }+setOnHeadersFrameCreated f hooks = hooks{H3.onHeadersFrameCreated = f}  setOnControlStreamCreated :: (Stream -> IO ()) -> H3.Hooks -> H3.Hooks-setOnControlStreamCreated f hooks = hooks { H3.onControlStreamCreated = f }+setOnControlStreamCreated f hooks = hooks{H3.onControlStreamCreated = f}  setOnEncoderStreamCreated :: (Stream -> IO ()) -> H3.Hooks -> H3.Hooks-setOnEncoderStreamCreated f hooks = hooks { H3.onEncoderStreamCreated = f }+setOnEncoderStreamCreated f hooks = hooks{H3.onEncoderStreamCreated = f}  setOnDecoderStreamCreated :: (Stream -> IO ()) -> H3.Hooks -> H3.Hooks-setOnDecoderStreamCreated f hooks = hooks { H3.onDecoderStreamCreated = f }+setOnDecoderStreamCreated f hooks = hooks{H3.onDecoderStreamCreated = f}  ---------------------------------------------------------------- @@ -159,7 +206,11 @@ -- ,(":foo","bar") -- the presence of prohibited fields or pseudo-header fields, -- ] illegalHeader1 :: [H3Frame] -> [H3Frame]-illegalHeader1 _ = [H3Frame H3FrameHeaders "\x00\x00\xd1\xd7\x27\x02\x3a\x61\x75\x74\x6f\x72\x69\x74\x79\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\x24\x3a\x66\x6f\x6f\x03\x62\x61\x72"]+illegalHeader1 _ =+    [ H3Frame+        H3FrameHeaders+        "\x00\x00\xd1\xd7\x27\x02\x3a\x61\x75\x74\x6f\x72\x69\x74\x79\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\x24\x3a\x66\x6f\x6f\x03\x62\x61\x72"+    ]  -- [(":method","GET") -- ,(":scheme","https")@@ -168,7 +219,11 @@ -- ,(":path","/") -- pseudo-header fields after fields -- ] illegalHeader2 :: [H3Frame] -> [H3Frame]-illegalHeader2 _ = [H3Frame H3FrameHeaders "\x00\x00\xd1\xd7\x27\x02\x3a\x61\x75\x74\x6f\x72\x69\x74\x79\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\x23\x66\x6f\x6f\x03\x62\x61\x72\xc1"]+illegalHeader2 _ =+    [ H3Frame+        H3FrameHeaders+        "\x00\x00\xd1\xd7\x27\x02\x3a\x61\x75\x74\x6f\x72\x69\x74\x79\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\x23\x66\x6f\x6f\x03\x62\x61\x72\xc1"+    ]  -- [(":method","GET") -- ,(":scheme","https")@@ -176,14 +231,22 @@ -- ,(":path","/") -- ,(":method","GET")] illegalHeader3 :: [H3Frame] -> [H3Frame]-illegalHeader3 _ = [H3Frame H3FrameHeaders "\x00\x00\xd1\xd7\x50\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\xd1"]+illegalHeader3 _ =+    [ H3Frame+        H3FrameHeaders+        "\x00\x00\xd1\xd7\x50\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\xd1"+    ]  -- [(":method","GET") -- ,(":scheme","https") -- ,(":authority","127.0.0.1") -- ,(":path","/")] ++ static index 99 illegalHeader4 :: [H3Frame] -> [H3Frame]-illegalHeader4 _ = [H3Frame H3FrameHeaders "\x00\x00\xd1\xd7\x50\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\xff\x24"]+illegalHeader4 _ =+    [ H3Frame+        H3FrameHeaders+        "\x00\x00\xd1\xd7\x50\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\xff\x24"+    ]  {- -- [(SettingsQpackBlockedStreams,100)@@ -198,8 +261,12 @@ -- ,(H3SettingsKey 0x2,200) -- HTTP/2 Settings -- ,(SettingsQpackMaxTableCapacity,4096) -- ,(SettingsMaxFieldSectionSize,32768)]-illegalSettings1 :: [H3Frame]-> [H3Frame]-illegalSettings1 _ = [H3Frame H3FrameSettings "\x07\x40\x64\x02\x40\xc8\x01\x50\x00\x06\x80\x00\x80\x00"]+illegalSettings1 :: [H3Frame] -> [H3Frame]+illegalSettings1 _ =+    [ H3Frame+        H3FrameSettings+        "\x07\x40\x64\x02\x40\xc8\x01\x50\x00\x06\x80\x00\x80\x00"+    ]  ---------------------------------------------------------------- @@ -216,17 +283,19 @@ addQUICHook :: ClientConfig -> (Hooks -> Hooks) -> ClientConfig addQUICHook cc modify = cc'   where-    cc' = cc { ccHooks = modify $ ccHooks cc }+    cc' = cc{ccHooks = modify $ ccHooks cc} -setOnResetStreamReceived :: (Stream -> ApplicationProtocolError -> IO ()) -> Hooks -> Hooks-setOnResetStreamReceived f hooks = hooks { onResetStreamReceived = f }+setOnResetStreamReceived+    :: (Stream -> ApplicationProtocolError -> IO ()) -> Hooks -> Hooks+setOnResetStreamReceived f hooks = hooks{onResetStreamReceived = f}  ----------------------------------------------------------------  applicationProtocolError :: QUICException -> Bool-applicationProtocolError (ApplicationProtocolErrorIsReceived ae _) = ae `elem` [H3GeneralProtocolError,H3InternalError]+applicationProtocolError (ApplicationProtocolErrorIsReceived ae _) = ae `elem` [H3GeneralProtocolError, H3InternalError] applicationProtocolError _ = False -applicationProtocolErrorsIn :: [ApplicationProtocolError] -> QUICException -> Bool+applicationProtocolErrorsIn+    :: [ApplicationProtocolError] -> QUICException -> Bool applicationProtocolErrorsIn aes qe@(ApplicationProtocolErrorIsReceived ae _) = (ae `elem` aes) || applicationProtocolError qe-applicationProtocolErrorsIn _   _                           = False+applicationProtocolErrorsIn _ _ = False

@@ -10,4 +10,7 @@ import HTTP3.Server  spec :: Spec-spec = beforeAll setup $ afterAll teardown $ h3ErrorSpec testClientConfig testH3ClientConfig 2000 -- 2 seconds+spec =+    beforeAll setup $+        afterAll teardown $+            h3ErrorSpec testClientConfig testH3ClientConfig 2000 -- 2 seconds

@@ -2,12 +2,12 @@ {-# LANGUAGE RankNTypes #-}  module HTTP3.Server (-    setup-  , teardown-  , trailersMaker-  , firstTrailerValue-  , CH.hashInit-  ) where+    setup,+    teardown,+    trailersMaker,+    firstTrailerValue,+    CH.hashInit,+) where  import Control.Concurrent import Control.Monad@@ -42,13 +42,13 @@  server :: Server server req _aux sendResponse = case requestMethod req of-  Just "GET"  -> case requestPath req of-                   Just "/" -> sendResponse responseHello []-                   _        -> sendResponse response404 []-  Just "POST" -> case requestPath req of-                   Just "/echo" -> sendResponse (responseEcho req) []-                   _        -> sendResponse responseHello []-  _           -> sendResponse response405 []+    Just "GET" -> case requestPath req of+        Just "/" -> sendResponse responseHello []+        _ -> sendResponse response404 []+    Just "POST" -> case requestPath req of+        Just "/echo" -> sendResponse (responseEcho req) []+        _ -> sendResponse responseHello []+    _ -> sendResponse response405 []  responseHello :: Response responseHello = responseBuilder ok200 header body@@ -70,7 +70,8 @@     streamingBody write _flush = do         loop         mt <- getRequestTrailers req-        firstTrailerValue <$> mt `shouldBe` Just "b0870457df2b8cae06a88657a198d9b52f8e2b0a"+        firstTrailerValue <$> mt+            `shouldBe` Just "b0870457df2b8cae06a88657a198d9b52f8e2b0a"       where         loop = do             bs <- getRequestBodyChunk req@@ -88,5 +89,5 @@   where     ctx' = CH.hashUpdate ctx bs -firstTrailerValue :: HeaderTable -> HeaderValue+firstTrailerValue :: TokenHeaderTable -> FieldValue firstTrailerValue = snd . Prelude.head . fst

@@ -27,15 +27,17 @@ runClient :: IO () runClient = QUIC.run testClientConfig $ \conn ->     E.bracket allocSimpleConfig freeSimpleConfig $ \conf ->-      C.run conn testH3ClientConfig conf client+        C.run conn testH3ClientConfig conf client   where     client :: C.Client ()-    client sendRequest _aux = foldr1 concurrently_ [-        client0 sendRequest _aux-      , client1 sendRequest _aux-      , client2 sendRequest _aux-      , client3 sendRequest _aux-      ]+    client sendRequest _aux =+        foldr1+            concurrently_+            [ client0 sendRequest _aux+            , client1 sendRequest _aux+            , client2 sendRequest _aux+            , client3 sendRequest _aux+            ]  client0 :: C.Client () client0 sendRequest _aux = do@@ -65,6 +67,7 @@                 unless (B.null bs) comsumeBody         comsumeBody         mt <- C.getResponseTrailers rsp-        firstTrailerValue <$> mt `shouldBe` Just "b0870457df2b8cae06a88657a198d9b52f8e2b0a"+        firstTrailerValue <$> mt+            `shouldBe` Just "b0870457df2b8cae06a88657a198d9b52f8e2b0a"   where     maker = trailersMaker hashInit

@@ -3,7 +3,7 @@ module QPACK.InstructionSpec where  import Data.ByteString ()-import Network.HPACK.Token+import Network.HTTP.Semantics import Network.QPACK.Internal import Test.Hspec @@ -11,23 +11,25 @@ spec = do     describe "encodeEncoderInstructions and decodeEncoderInstructions" $ do         it "encode/decodes encode instructions properly" $ do-            let eis0 = [SetDynamicTableCapacity 4096-                       ,InsertWithNameReference (Left 92) "Warp/4.3.2.1"-                       ,InsertWithoutNameReference tokenContentType "text/plain"-                       ,Duplicate 40-                       ]-            bs1  <- encodeEncoderInstructions eis0 True-            (eis1,"") <- decodeEncoderInstructions' bs1+            let eis0 =+                    [ SetDynamicTableCapacity 4096+                    , InsertWithNameReference (Left 92) "Warp/4.3.2.1"+                    , InsertWithoutNameReference tokenContentType "text/plain"+                    , Duplicate 40+                    ]+            bs1 <- encodeEncoderInstructions eis0 True+            (eis1, "") <- decodeEncoderInstructions' bs1             eis1 `shouldBe` eis0-            bs2  <- encodeEncoderInstructions eis0 False-            (eis2,"") <- decodeEncoderInstructions' bs2+            bs2 <- encodeEncoderInstructions eis0 False+            (eis2, "") <- decodeEncoderInstructions' bs2             eis2 `shouldBe` eis0     describe "encodeDecoderInstructions and decodeDecoderInstructions" $ do         it "encode/decodes decode instructions properly" $ do-            let eis0 = [SectionAcknowledgement 10-                       ,StreamCancellation 100-                       ,InsertCountIncrement 200-                       ]-            bs1  <- encodeDecoderInstructions eis0-            (eis1,"") <- decodeDecoderInstructions bs1+            let eis0 =+                    [ SectionAcknowledgement 10+                    , StreamCancellation 100+                    , InsertCountIncrement 200+                    ]+            bs1 <- encodeDecoderInstructions eis0+            (eis1, "") <- decodeDecoderInstructions bs1             eis1 `shouldBe` eis0

@@ -9,7 +9,7 @@ import Control.Monad import Data.Attoparsec.ByteString (Parser) import qualified Data.Attoparsec.ByteString as P-import Data.ByteString (ByteString, ByteString)+import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import Data.Conduit.Attoparsec@@ -23,14 +23,14 @@ spec = do     describe "simple decoder" $ do         it "decodes well" $ do-            forM_ ["fb-req-hq","fb-resp-hq","netbsd-hq"] $ \svc ->-              forM_ ["f5","ls-qpack","nghttp3","proxygen","qthingey","quinn"] $ \impl -> do-                putStrLn $ impl ++ " with " ++ svc-                let inp = "qifs/encoded/qpack-05/" ++ impl ++ "/" ++ svc ++ ".out.4096.0.0"-                    out = "qifs/qifs/" ++ svc ++ ".qif"-                test inp out+            forM_ ["fb-req-hq", "fb-resp-hq", "netbsd-hq"] $ \svc ->+                forM_ ["f5", "ls-qpack", "nghttp3", "proxygen", "qthingey", "quinn"] $ \impl -> do+                    putStrLn $ impl ++ " with " ++ svc+                    let inp = "qifs/encoded/qpack-05/" ++ impl ++ "/" ++ svc ++ ".out.4096.0.0"+                        out = "qifs/qifs/" ++ svc ++ ".qif"+                    test inp out -data Block = Block Int ByteString deriving Show+data Block = Block Int ByteString deriving (Show)  ---------------------------------------------------------------- @@ -38,44 +38,49 @@ test efile qfile = do     (dec, insthdr) <- newQDecoderS defaultQDecoderConfig False     q <- newTQueueIO-    let recv   = atomically $ readTQueue  q+    let recv = atomically $ readTQueue q         send x = atomically $ writeTQueue q x     mvar <- newEmptyMVar     withFile qfile ReadMode $ \h -> do         tid <- forkIO $ decode dec h recv mvar-        runConduitRes (sourceFile efile .| conduitParser block .| mapM_C (liftIO . switch send insthdr))+        runConduitRes+            ( sourceFile efile .| conduitParser block .| mapM_C (liftIO . switch send insthdr)+            )         takeMVar mvar         killThread tid -switch :: (Block -> IO ())-       -> EncoderInstructionHandlerS-       -> (PositionRange, Block)-       -> IO ()+switch+    :: (Block -> IO ())+    -> EncoderInstructionHandlerS+    -> (PositionRange, Block)+    -> IO () switch send insthdr (_, blk@(Block n bs))-  | n == 0    = do+    | n == 0 = do         insthdr bs         yield-  | otherwise = send blk+    | otherwise = send blk -decode :: (ByteString -> IO HeaderList)-       -> Handle-       -> IO Block-       -> MVar ()-       -> IO ()+decode+    :: (ByteString -> IO [Header])+    -> Handle+    -> IO Block+    -> MVar ()+    -> IO () decode dec h recv mvar = loop   where     loop = do         hdr' <- fromCaseSensitive <$> headerlist h-        if hdr' == [] then-            putMVar mvar ()-          else do-            Block _ bs <- recv-            hdr <- dec bs-            hdr `shouldBe` hdr'-            loop+        if hdr' == []+            then+                putMVar mvar ()+            else do+                Block _ bs <- recv+                hdr <- dec bs+                hdr `shouldBe` hdr'+                loop -fromCaseSensitive :: HeaderList -> HeaderList-fromCaseSensitive = map (\(k,v) -> (foldedCase $ mk k,v))+fromCaseSensitive :: [Header] -> [Header]+fromCaseSensitive = map (\(k, v) -> (foldedCase $ mk k, v))  block :: Parser Block block = do@@ -91,25 +96,25 @@  ---------------------------------------------------------------- -headerlist :: Handle -> IO HeaderList+headerlist :: Handle -> IO [Header] headerlist h = loop id   where     loop b = do         ml <- line h         case ml of-          Nothing -> return $ b []-          Just l-            | l == ""   -> return $ b []-            | otherwise -> do-                  let (k,v0) = BS8.break (== '\t') l-                      v = BS8.drop 1 v0-                  loop (b . ((k,v) :))+            Nothing -> return $ b []+            Just l+                | l == "" -> return $ b []+                | otherwise -> do+                    let (k, v0) = BS8.break (== '\t') l+                        v = BS8.drop 1 v0+                    loop (b . ((mk k, v) :))  line :: Handle -> IO (Maybe ByteString) line h = do     el <- E.try $ BS8.hGetLine h     case el of-      Left (_ :: E.IOException) -> return Nothing-      Right l-        | BS8.take 1 l == "#" -> line h-        | otherwise           -> return $ Just l+        Left (_ :: E.IOException) -> return Nothing+        Right l+            | BS8.take 1 l == "#" -> line h+            | otherwise -> return $ Just l

@@ -14,7 +14,7 @@             ei' `shouldBe` ei     describe "encodeBase and decodeBase" $ do         prop "duality" $ \(Doubl base reqInsCnt) -> do-            let (s,delta) = encodeBase (InsertionPoint reqInsCnt) (BasePoint base)+            let (s, delta) = encodeBase (InsertionPoint reqInsCnt) (BasePoint base)                 BasePoint base' = decodeBase (InsertionPoint reqInsCnt) s delta             base' `shouldBe` base @@ -30,7 +30,7 @@  instance Arbitrary Triple where     arbitrary = do-        m  <- arbitrary `suchThat` (>= 3)+        m <- arbitrary `suchThat` (>= 3)         ei <- arbitrary `suchThat` (>= 0)-        di <- arbitrary `suchThat` (\n -> ei - m <= n  && n <= ei)+        di <- arbitrary `suchThat` (\n -> ei - m <= n && n <= ei)         return $ Triple m ei di

@@ -44,7 +44,7 @@         )  dumpSwitch-    :: (ByteString -> IO HeaderList)+    :: (ByteString -> IO [Header])     -> EncoderInstructionHandlerS     -> (a, Block)     -> IO ()@@ -111,7 +111,7 @@                         putStrLn "----"                         putMVar mvar () -fromCaseSensitive :: HeaderList -> HeaderList+fromCaseSensitive :: [Header] -> [Header] fromCaseSensitive = map (\(k, v) -> (foldedCase $ mk k, v))  ----------------------------------------------------------------@@ -130,7 +130,7 @@  ---------------------------------------------------------------- -headerlist :: Handle -> IO HeaderList+headerlist :: Handle -> IO [Header] headerlist h = loop id   where     loop b = do@@ -142,7 +142,7 @@                 | otherwise -> do                     let (k, v0) = BS8.break (== '\t') l                         v = BS8.drop 1 v0-                    loop (b . ((k, v) :))+                    loop (b . ((mk k, v) :))  line :: Handle -> IO (Maybe ByteString) line h = do