diff --git a/Network/HPACK.hs b/Network/HPACK.hs --- a/Network/HPACK.hs +++ b/Network/HPACK.hs @@ -1,4 +1,4 @@ --- | HPACK: encoding and decoding a header set. +-- | HPACK: encoding and decoding a header list. module Network.HPACK ( -- * Encoding and decoding HPACKEncoding @@ -16,7 +16,7 @@ -- * Errors for decoding , DecodeError(..) -- * Headers - , HeaderSet + , HeaderList , Header , HeaderName , HeaderValue @@ -29,29 +29,29 @@ import Control.Applicative ((<$>)) import Control.Arrow (second) import Control.Exception (throwIO) -import Network.HPACK.Context (Context, newContextForEncoding, newContextForDecoding, HeaderSet) +import Network.HPACK.Context (Context, newContextForEncoding, newContextForDecoding, HeaderList) import Network.HPACK.HeaderBlock (toHeaderBlock, fromHeaderBlock, toByteStream, fromByteStream) import Network.HPACK.Table (Size) import Network.HPACK.Types ---------------------------------------------------------------- --- | HPACK encoding, from 'HeaderSet' to 'ByteStream'. -type HPACKEncoding = Context -> HeaderSet -> IO (Context, ByteStream) +-- | HPACK encoding, from 'HeaderList' to 'ByteStream'. +type HPACKEncoding = Context -> HeaderList -> IO (Context, ByteStream) --- | HPACK decoding, from 'ByteStream' to 'HeaderSet'. -type HPACKDecoding = Context -> ByteStream -> IO (Context, HeaderSet) +-- | HPACK decoding, from 'ByteStream' to 'HeaderList'. +type HPACKDecoding = Context -> ByteStream -> IO (Context, HeaderList) ---------------------------------------------------------------- --- | Converting 'HeaderSet' for HTTP request to the low level format. +-- | Converting 'HeaderList' for HTTP request to the low level format. encodeHeader :: EncodeStrategy -> HPACKEncoding encodeHeader stgy ctx hs = second toBS <$> toHeaderBlock algo ctx hs where algo = compressionAlgo stgy toBS = toByteStream (useHuffman stgy) --- | Converting the low level format for HTTP request to 'HeaderSet'. +-- | Converting the low level format for HTTP request to 'HeaderList'. -- 'DecodeError' would be thrown. decodeHeader :: HPACKDecoding decodeHeader ctx bs = either throwIO (fromHeaderBlock ctx) ehb diff --git a/Network/HPACK/Context.hs b/Network/HPACK/Context.hs --- a/Network/HPACK/Context.hs +++ b/Network/HPACK/Context.hs @@ -1,25 +1,16 @@ module Network.HPACK.Context ( -- * Types - HeaderSet -- re-exporting + HeaderList -- re-exporting , Context , newContextForEncoding , newContextForDecoding , changeContextForDecoding , DecodeError(..) , printContext - -- * Initialization and final results - , emitNotEmittedForEncoding - , emitNotEmittedForDecoding -- * Processing - , clearRefSets - , removeRef , newEntryForEncoding , newEntryForDecoding - , pushRef -- * Auxiliary functions - , isPresentIn - , Sequence(..) - , checkAndUpdate , getEntry -- * Table , whichTable @@ -27,8 +18,7 @@ ) where import Control.Applicative ((<$>)) -import Network.HPACK.Context.HeaderSet -import Network.HPACK.Context.ReferenceSet +import Network.HPACK.Context.HeaderList import Network.HPACK.Table import Network.HPACK.Types @@ -38,118 +28,44 @@ -- This is destructive! data Context = Context { headerTable :: !HeaderTable -- ^ A cache of headers - , referenceSet :: ReferenceSet -- ^ Reference set } -- | Printing 'Context' printContext :: Context -> IO () -printContext (Context hdrtbl refs) = do +printContext (Context hdrtbl) = do putStrLn "<<
>>" printHeaderTable hdrtbl putStr "\n" - putStrLn "<<>>" - print refs ---------------------------------------------------------------- -- | Creating a new 'Context'. -- The first argument is the size of a header table. newContextForEncoding :: Size -> IO Context -newContextForEncoding maxsiz = do - hdrtbl <- newHeaderTableForEncoding maxsiz - return $ Context hdrtbl emptyReferenceSet +newContextForEncoding maxsiz = Context <$> newHeaderTableForEncoding maxsiz -- | Creating a new 'Context'. -- The first argument is the size of a header table. newContextForDecoding :: Size -> IO Context -newContextForDecoding maxsiz = do - hdrtbl <- newHeaderTableForDecoding maxsiz - return $ Context hdrtbl emptyReferenceSet +newContextForDecoding maxsiz = Context <$> newHeaderTableForDecoding maxsiz +-- | Changing the size of Header Table in 'Context'. changeContextForDecoding :: Context -> Size -> IO Context -changeContextForDecoding ctx@(Context hdrtbl refs) siz - | shouldRenew hdrtbl siz = do - (hdrtbl',n) <- renewHeaderTable siz hdrtbl - let refs' = restrictIndices n refs - return $ Context hdrtbl' refs' - | otherwise = return ctx +changeContextForDecoding ctx@(Context hdrtbl) siz + | shouldRenew hdrtbl siz = Context <$> renewHeaderTable siz hdrtbl + | otherwise = return ctx ---------------------------------------------------------------- --- | The reference set is emptied. -clearRefSets :: Context -> Context -clearRefSets ctx = ctx { - referenceSet = emptyReferenceSet - } - --- | The entry is removed from the reference set. -removeRef :: Context -> Index -> Context -removeRef (Context hdrtbl refs) idx = ctx - where - refs' = removeIndex idx refs - ctx = Context hdrtbl refs' - -- | The header field is inserted at the beginning of the header table. -- A reference to the new entry is added to the reference set. -newEntryForEncoding :: Context -> Entry -> IO ([Index],Context) -newEntryForEncoding (Context hdrtbl refs) e = do - (hdrtbl', i, is) <- insertEntry e hdrtbl - let ns = getCommon is refs - refs' = addIndex 1 $ restrictIndices i $ adjustReferenceSet refs - ctx = Context hdrtbl' refs' - return (ns, ctx) +newEntryForEncoding :: Context -> Entry -> IO Context +newEntryForEncoding (Context hdrtbl) e = Context <$> insertEntry e hdrtbl -- | The header field is inserted at the beginning of the header table. -- A reference to the new entry is added to the reference set. newEntryForDecoding :: Context -> Entry -> IO Context -newEntryForDecoding (Context hdrtbl refs) e = do - (hdrtbl', i, _) <- insertEntry e hdrtbl - let refs' = addIndex 1 $ restrictIndices i $ adjustReferenceSet refs - return $ Context hdrtbl' refs' - --- | The referenced header table entry is added to the reference set. -pushRef :: Context -> Index -> Context -pushRef (Context hdrtbl refs) idx = ctx - where - -- isPresentIn ensures that idx does not exist in - -- newref and oldref. - refs' = addIndex idx refs - ctx = Context hdrtbl refs' - ----------------------------------------------------------------- - --- | Emitting non-emitted headers. -emitNotEmittedForEncoding :: Context -> IO ([Index],Context) -emitNotEmittedForEncoding (Context hdrtbl refs) = do - let (removedIndces,refs') = renewForEncoding refs - ctx' = Context hdrtbl refs' - return (removedIndces, ctx') - --- | Emitting non-emitted headers. -emitNotEmittedForDecoding :: Context -> IO (HeaderSet,Context) -emitNotEmittedForDecoding ctx@(Context hdrtbl refs) = do - hs <- getNotEmitted ctx - let refs' = renewForDecoding refs - ctx' = Context hdrtbl refs' - return (hs,ctx') - -getNotEmitted :: Context -> IO HeaderSet -getNotEmitted ctx = do - let is = getNotEmittedIndices $ referenceSet ctx - hdrtbl = headerTable ctx - map (fromEntry . snd) <$> mapM (which hdrtbl) is - ----------------------------------------------------------------- - --- | Is 'Index' present in the reference set? -isPresentIn :: Index -> Context -> Bool -isPresentIn idx ctx = idx `isMember` referenceSet ctx - -checkAndUpdate :: Index -> Context -> (Sequence, Context) -checkAndUpdate idx ctx = (s, ctx') - where - (s,refs') = lookupAndUpdate idx $ referenceSet ctx - ctx' = ctx { referenceSet = refs' } +newEntryForDecoding (Context hdrtbl) e = Context <$> insertEntry e hdrtbl ---------------------------------------------------------------- diff --git a/Network/HPACK/Context/HeaderList.hs b/Network/HPACK/Context/HeaderList.hs new file mode 100644 --- /dev/null +++ b/Network/HPACK/Context/HeaderList.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.HPACK.Context.HeaderList where + +import qualified Data.ByteString.Char8 as BS +import Network.HPACK.Table + +-- | Header list. +type HeaderList = [Header] + +-- | Printing 'HeaderList'. +printHeaderList :: HeaderList -> IO () +printHeaderList hs = mapM_ printHeader hs + where + printHeader (k,v) = do + BS.putStr k + putStr ": " + BS.putStr v + putStr "\n" diff --git a/Network/HPACK/Context/HeaderSet.hs b/Network/HPACK/Context/HeaderSet.hs deleted file mode 100644 --- a/Network/HPACK/Context/HeaderSet.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Network.HPACK.Context.HeaderSet where - -import qualified Data.ByteString.Char8 as BS -import Network.HPACK.Table - --- | Header set. -type HeaderSet = [Header] - --- | Printing 'HeaderSet'. -printHeaderSet :: HeaderSet -> IO () -printHeaderSet hs = mapM_ printHeader hs - where - printHeader (k,v) = do - BS.putStr k - putStr ": " - BS.putStr v - putStr "\n" diff --git a/Network/HPACK/Context/ReferenceSet.hs b/Network/HPACK/Context/ReferenceSet.hs deleted file mode 100644 --- a/Network/HPACK/Context/ReferenceSet.hs +++ /dev/null @@ -1,96 +0,0 @@ -module Network.HPACK.Context.ReferenceSet ( - -- * Type - ReferenceSet - , emptyReferenceSet - -- * Index and reference set - , isMember - , addIndex - , removeIndex - , restrictIndices - -- * Managing reference set - , getNotEmittedIndices - , adjustReferenceSet - , renewForEncoding - , renewForDecoding - , Sequence(..) - , lookupAndUpdate - , getCommon - ) where - -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as M -import Network.HPACK.Table - ----------------------------------------------------------------- - -data Status = Old -- E: Initial state for encoding - | NotEmitted -- E&D: Initial state for decoding - | Emitted -- E&D: - deriving (Eq,Show) - --- | Type for the reference set. -newtype ReferenceSet = ReferenceSet (Map Index Status) deriving Show --- Must not use IntMap because its mapKeysMonotonic is slow - --- | Empty reference set. -emptyReferenceSet :: ReferenceSet -emptyReferenceSet = ReferenceSet M.empty - ----------------------------------------------------------------- - --- | Is 'Index' a member of 'ReferenceSet'? -isMember :: Index -> ReferenceSet -> Bool -isMember idx (ReferenceSet m) = idx `M.member` m - --- | Adding 'Index' to 'ReferenceSet'. -addIndex :: Index -> ReferenceSet -> ReferenceSet -addIndex idx (ReferenceSet m) = ReferenceSet $ M.insert idx Emitted m - --- | Removing 'Index' from 'ReferenceSet'. -removeIndex :: Index -> ReferenceSet -> ReferenceSet -removeIndex idx (ReferenceSet m) = ReferenceSet $ M.delete idx m - -restrictIndices :: Index -> ReferenceSet -> ReferenceSet -restrictIndices idx (ReferenceSet m) = - ReferenceSet $ M.filterWithKey (\k _ -> k <= idx) m - ----------------------------------------------------------------- - --- | Get all not emitted 'Index' from 'ReferenceSet'. -getNotEmittedIndices :: ReferenceSet -> [Index] -getNotEmittedIndices (ReferenceSet m) = M.keys $ M.filter (== NotEmitted) m - --- | Renewing 'ReferenceSet' for the next encoding step. -renewForEncoding :: ReferenceSet -> ([Index],ReferenceSet) -renewForEncoding (ReferenceSet m) = (removedIndces, ReferenceSet m') - where - (oldm,newm) = M.partition (== Old) m - removedIndces = M.keys oldm - m' = M.map (const Old) newm - --- | Renewing 'ReferenceSet' for the next decoding step. -renewForDecoding :: ReferenceSet -> ReferenceSet -renewForDecoding (ReferenceSet m) = ReferenceSet m' - where - m' = M.map (const NotEmitted) m - --- | Incrementing all 'Index' by one. -adjustReferenceSet :: ReferenceSet -> ReferenceSet -adjustReferenceSet (ReferenceSet m) = ReferenceSet $ M.mapKeysMonotonic (+1) m - -data Sequence = Z | E0 | E2 | E4 - -lookupAndUpdate :: Index -> ReferenceSet -> (Sequence,ReferenceSet) -lookupAndUpdate idx rs@(ReferenceSet m) = case M.lookup idx m of - Nothing -> (Z, rs) - Just Old -> (E0, ReferenceSet $ M.adjust (const NotEmitted) idx m) - Just NotEmitted -> (E4, ReferenceSet $ M.adjust (const Emitted) idx m) - Just Emitted -> (E2, rs) - -getCommon :: [Index] -> ReferenceSet -> [Index] -getCommon is (ReferenceSet m) = go is [] - where - go [] ret = ret - go (n:ns) ret = case M.lookup n m of - Just NotEmitted -> go ns (n:ret) - _ -> go ns ret diff --git a/Network/HPACK/HeaderBlock.hs b/Network/HPACK/HeaderBlock.hs --- a/Network/HPACK/HeaderBlock.hs +++ b/Network/HPACK/HeaderBlock.hs @@ -4,7 +4,8 @@ -- * Header block from/to Low level , toByteStream , fromByteStream - -- * Header block from/to header set + , fromByteStreamDebug + -- * Header block from/to header list , toHeaderBlock , fromHeaderBlock ) where diff --git a/Network/HPACK/HeaderBlock/Decode.hs b/Network/HPACK/HeaderBlock/Decode.hs --- a/Network/HPACK/HeaderBlock/Decode.hs +++ b/Network/HPACK/HeaderBlock/Decode.hs @@ -1,5 +1,6 @@ module Network.HPACK.HeaderBlock.Decode ( fromByteStream + , fromByteStreamDebug ) where import Data.Bits (testBit, clearBit, (.&.)) @@ -24,13 +25,26 @@ (hf, bs') <- toHeaderField bs go bs' (builder << hf) +-- | Converting the low level format to 'HeaderBlock'. +-- 'HeaderBlock' forms a pair with corresponding 'ByteString'. +fromByteStreamDebug :: ByteStream -> Either DecodeError [(ByteString,HeaderField)] +fromByteStreamDebug inp = go inp empty + where + go bs builder + | BS.null bs = Right $ run builder + | otherwise = do + (hf, bs') <- toHeaderField bs + let len = BS.length bs - BS.length bs' + consumed = BS.take len bs + go bs' (builder << (consumed,hf)) + toHeaderField :: ByteString -> Either DecodeError (HeaderField, ByteString) toHeaderField bs | BS.null bs = Left EmptyBlock | w `testBit` 7 = indexed w bs' | w `testBit` 6 = incrementalIndexing w bs' - | w `testBit` 5 = if w `testBit` 4 then clear w bs' else maxSize w bs' + | w `testBit` 5 = maxSize w bs' | w `testBit` 4 = neverIndexing w bs' | otherwise = withoutIndexing w bs' where @@ -51,14 +65,11 @@ | isIndexedName1 w = indexedName Add w ws 6 mask6 | otherwise = newName Add ws -clear :: Word8 -> ByteString -> Either DecodeError (HeaderField, ByteString) -clear _ ws = Right (Clear, ws) - maxSize :: Word8 -> ByteString -> Either DecodeError (HeaderField, ByteString) maxSize w ws = Right (ChangeTableSize siz, ws') where - w' = mask4 w - (siz, ws') = I.parseInteger 4 w' ws + w' = mask5 w + (siz, ws') = I.parseInteger 5 w' ws withoutIndexing :: Word8 -> ByteString -> Either DecodeError (HeaderField, ByteString) @@ -110,6 +121,9 @@ mask6 :: Word8 -> Word8 mask6 w = w .&. 63 + +mask5 :: Word8 -> Word8 +mask5 w = w .&. 31 mask4 :: Word8 -> Word8 mask4 w = w .&. 15 diff --git a/Network/HPACK/HeaderBlock/Encode.hs b/Network/HPACK/HeaderBlock/Encode.hs --- a/Network/HPACK/HeaderBlock/Encode.hs +++ b/Network/HPACK/HeaderBlock/Encode.hs @@ -23,7 +23,6 @@ toBB = fromHeaderField huff fromHeaderField :: Bool -> HeaderField -> Builder -fromHeaderField _ Clear = clear fromHeaderField _ (ChangeTableSize siz) = change siz fromHeaderField _ (Indexed idx) = index idx fromHeaderField huff (Literal Add (Idx idx) v) = indexedName huff 6 set01 idx v @@ -35,13 +34,10 @@ ---------------------------------------------------------------- -clear :: Builder -clear = BB.fromWord8s [48] - change :: Int -> Builder change i = BB.fromWord8s (w':ws) where - (w:ws) = I.encode 4 i + (w:ws) = I.encode 5 i w' = set001 w index :: Int -> Builder diff --git a/Network/HPACK/HeaderBlock/From.hs b/Network/HPACK/HeaderBlock/From.hs --- a/Network/HPACK/HeaderBlock/From.hs +++ b/Network/HPACK/HeaderBlock/From.hs @@ -16,15 +16,15 @@ type Ctx = (Context, Builder Header) type Step = Ctx -> HeaderField -> IO Ctx --- | Decoding 'HeaderBlock' to 'HeaderSet'. +-- | Decoding 'HeaderBlock' to 'HeaderList'. fromHeaderBlock :: Context -> HeaderBlock - -> IO (Context, HeaderSet) + -> IO (Context, HeaderList) fromHeaderBlock !ctx rs = decodeLoop rs (ctx,empty) ---------------------------------------------------------------- -decodeLoop :: HeaderBlock -> Ctx -> IO (Context, HeaderSet) +decodeLoop :: HeaderBlock -> Ctx -> IO (Context, HeaderList) decodeLoop (r:rs) !ctx = decodeStep ctx r >>= decodeLoop rs decodeLoop [] !ctx = decodeFinal ctx @@ -33,30 +33,23 @@ -- | Decoding step for one 'HeaderField'. Exporting for the -- test purpose. decodeStep :: Step -decodeStep (!ctx,!builder) Clear = return (clearRefSets ctx,builder) decodeStep (!ctx,!builder) (ChangeTableSize siz) = do ctx' <- changeContextForDecoding ctx siz return (ctx',builder) -decodeStep (!ctx,!builder) (Indexed idx) - | isPresent = return (removeRef ctx idx, builder) - | otherwise = do +decodeStep (!ctx,!builder) (Indexed idx) = do w <- whichTable idx ctx case w of (InStaticTable, e) -> do - c <- newEntryForDecoding ctx e let b = builder << fromEntry e - return (c,b) + return (ctx,b) (InHeaderTable, e) -> do - let c = pushRef ctx idx + let c = ctx b = builder << fromEntry e return (c,b) - where - isPresent = idx `isPresentIn` ctx decodeStep (!ctx,!builder) (Literal NotAdd naming v) = do k <- fromNaming naming ctx let b = builder << (k,v) return (ctx, b) --- fixme: how to treat Never? decodeStep (!ctx,!builder) (Literal Never naming v) = do k <- fromNaming naming ctx let b = builder << (k,v) @@ -69,11 +62,8 @@ c <- newEntryForDecoding ctx e return (c,b) -decodeFinal :: Ctx -> IO (Context, HeaderSet) -decodeFinal (!ctx, !builder) = do - (hs,!ctx') <- emitNotEmittedForDecoding ctx - let hs' = run builder ++ hs - return (ctx', hs') +decodeFinal :: Ctx -> IO (Context, HeaderList) +decodeFinal (!ctx, !builder) = return (ctx, run builder) ---------------------------------------------------------------- diff --git a/Network/HPACK/HeaderBlock/HeaderField.hs b/Network/HPACK/HeaderBlock/HeaderField.hs --- a/Network/HPACK/HeaderBlock/HeaderField.hs +++ b/Network/HPACK/HeaderBlock/HeaderField.hs @@ -22,8 +22,7 @@ emptyHeaderBlock = [] -- | Type for representation. -data HeaderField = Clear - | ChangeTableSize Int +data HeaderField = ChangeTableSize Int | Indexed Index | Literal Indexing Naming HeaderValue deriving (Eq,Show) diff --git a/Network/HPACK/HeaderBlock/To.hs b/Network/HPACK/HeaderBlock/To.hs --- a/Network/HPACK/HeaderBlock/To.hs +++ b/Network/HPACK/HeaderBlock/To.hs @@ -4,7 +4,6 @@ toHeaderBlock ) where -import Data.List (foldl') import Network.HPACK.Builder import Network.HPACK.Context import Network.HPACK.HeaderBlock.HeaderField @@ -14,27 +13,22 @@ type Ctx = (Context, Builder HeaderField) type Step = Ctx -> Header -> IO Ctx --- | Encoding 'HeaderSet' to 'HeaderBlock'. +-- | Encoding 'HeaderList' to 'HeaderBlock'. toHeaderBlock :: CompressionAlgo -> Context - -> HeaderSet + -> HeaderList -> IO (Context, HeaderBlock) -toHeaderBlock Naive !ctx hs = reset ctx >>= encodeLoop naiveStep hs -toHeaderBlock Static !ctx hs = reset ctx >>= encodeLoop staticStep hs -toHeaderBlock Linear !ctx hs = reset ctx >>= encodeLoop linearStep hs -toHeaderBlock Diff !ctx hs = encodeLoop diffStep hs (ctx, empty) +toHeaderBlock Naive !ctx hs = encodeLoop naiveStep hs (ctx,empty) +toHeaderBlock Static !ctx hs = encodeLoop staticStep hs (ctx,empty) +toHeaderBlock Linear !ctx hs = encodeLoop linearStep hs (ctx,empty) ---------------------------------------------------------------- encodeFinal :: Ctx -> IO (Context, HeaderBlock) -encodeFinal (!ctx, !builder) = do - (is,!ctx') <- emitNotEmittedForEncoding ctx - let builder' = foldl' (\b i -> b << Indexed i) builder is - !hb = run builder' - return (ctx', hb) +encodeFinal (!ctx, !builder) = return (ctx, run builder) encodeLoop :: Step - -> HeaderSet + -> HeaderList -> Ctx -> IO (Context, HeaderBlock) encodeLoop step (h:hs) !ctx = step ctx h >>= encodeLoop step hs @@ -42,15 +36,6 @@ ---------------------------------------------------------------- --- for naiveStep and linearStep -reset :: Context -> IO Ctx -reset ctx = do - let ctx' = clearRefSets ctx - initialHeaderBlock = singleton Clear - return (ctx', initialHeaderBlock) - ----------------------------------------------------------------- - naiveStep :: Step naiveStep (!ctx,!builder) (k,v) = do let builder' = builder << Literal NotAdd (Lit k) v @@ -59,16 +44,15 @@ ---------------------------------------------------------------- staticStep :: Step -staticStep (!ctx,!builder) h@(k,v) = do - let cache = lookupHeader h ctx - b = case cache of - None -> Literal NotAdd (Lit k) v - KeyOnly InStaticTable i -> Literal NotAdd (Idx i) v - KeyOnly InHeaderTable _ -> Literal NotAdd (Lit k) v - KeyValue InStaticTable i -> Literal NotAdd (Idx i) v - KeyValue InHeaderTable _ -> Literal NotAdd (Lit k) v - let builder' = builder << b - return (ctx, builder') +staticStep (!ctx,!builder) h@(k,v) = return (ctx, builder') + where + b = case lookupHeader h ctx of + None -> Literal NotAdd (Lit k) v + KeyOnly InStaticTable i -> Literal NotAdd (Idx i) v + KeyOnly InHeaderTable _ -> Literal NotAdd (Lit k) v + KeyValue InStaticTable i -> Literal NotAdd (Idx i) v + KeyValue InHeaderTable _ -> Literal NotAdd (Lit k) v + builder' = builder << b ---------------------------------------------------------------- -- A simple encoding strategy to reset the reference set first @@ -77,33 +61,7 @@ linearStep :: Step linearStep cb@(!ctx,!builder) h = smartStep linear cb h where - linear i - | i `isPresentIn` ctx = do - let b = builder << Indexed i << Indexed i - return (ctx,b) - | otherwise = do - let b = builder << Indexed i - c = pushRef ctx i - return (c,b) - ----------------------------------------------------------------- --- See http://lists.w3.org/Archives/Public/ietf-http-wg/2013JulSep/1135.html - -diffStep :: Step -diffStep cb@(!ctx,!builder) h = smartStep diff cb h - where - diff i = case checkAndUpdate i ctx of - (Z, ctx') -> do - let b = builder << Indexed i - c = pushRef ctx' i - return (c,b) - (E0, ctx') -> return (ctx', builder) - (E2, ctx') -> do - let b = builder << Indexed i << Indexed i - return (ctx',b) - (E4, ctx') -> do - let b = builder << Indexed i << Indexed i << Indexed i << Indexed i - return (ctx',b) + linear i = return (ctx,builder << Indexed i) ---------------------------------------------------------------- @@ -114,16 +72,9 @@ None -> check cb h (Lit k) KeyOnly InStaticTable i -> check cb h (Idx i) KeyOnly InHeaderTable i -> check cb h (Idx i) - KeyValue InStaticTable i -> do - let e = toEntry h - (is,ctx') <- newEntryForEncoding ctx e - let builder' = double is builder << Indexed i - return (ctx', builder') + KeyValue InStaticTable i -> return (ctx, builder << Indexed i) KeyValue InHeaderTable i -> func i -double :: [Index] -> Builder HeaderField -> Builder HeaderField -double is bldr = foldl' (\b i -> b << Indexed i << Indexed i) bldr is - check :: Ctx -> Header -> Naming -> IO Ctx check (ctx,builder) h@(k,v) x | k `elem` headersNotToIndex = do @@ -131,8 +82,8 @@ return (ctx, builder') | otherwise = do let e = toEntry h - (is,ctx') <- newEntryForEncoding ctx e - let builder' = double is builder << Literal Add x v + ctx' <- newEntryForEncoding ctx e + let builder' = builder << Literal Add x v return (ctx', builder') headersNotToIndex :: [HeaderName] diff --git a/Network/HPACK/Table.hs b/Network/HPACK/Table.hs --- a/Network/HPACK/Table.hs +++ b/Network/HPACK/Table.hs @@ -5,12 +5,12 @@ HeaderTable , newHeaderTableForEncoding , newHeaderTableForDecoding + , shouldRenew , renewHeaderTable , printHeaderTable - , shouldRenew -- * Insertion , insertEntry - -- * Lookup + -- * Header to index , HeaderCache(..) , lookupTable -- * Entry @@ -66,7 +66,9 @@ , headerTableSize :: !Size -- | The max header table size (defined in HPACK) , maxHeaderTableSize :: !Size - -- | Header-to-index + -- | Header to the index in Header Table for encoder. + -- Static Table is not included. + -- Nothing for decoder. , reverseIndex :: Maybe (HP.HashPSQ HIndex) } @@ -81,7 +83,7 @@ es <- mapM (readArray circularTable . adj maxNumOfEntries) [beg .. end] let ts = zip [1..] es mapM_ printEntry ts - putStrLn $ " Table size: " ++ show headerTableSize + putStrLn $ " Table size: " ++ show headerTableSize ++ "/" ++ show maxHeaderTableSize print reverseIndex where beg = offset + 1 @@ -103,12 +105,14 @@ -- | Which table does `Index` refer to? data WhichTable = InHeaderTable | InStaticTable deriving (Eq,Show) +-- | Is header key-value stored in the tables? data HeaderCache = None | KeyOnly WhichTable Index | KeyValue WhichTable Index deriving Show ---------------------------------------------------------------- +-- Physical array index for Header Table. newtype HIndex = HIndex Int deriving (Eq, Ord, Show) ---------------------------------------------------------------- @@ -116,20 +120,18 @@ fromHIndexToIndex :: HeaderTable -> HIndex -> Index fromHIndexToIndex HeaderTable{..} (HIndex hidx) = idx where - idx = adj maxNumOfEntries (maxNumOfEntries + hidx - offset) + idx = adj maxNumOfEntries (hidx - offset) + staticTableSize fromIndexToHIndex :: HeaderTable -> Index -> HIndex fromIndexToHIndex HeaderTable{..} idx = HIndex hidx where - hidx = adj maxNumOfEntries (offset + idx) + hidx = adj maxNumOfEntries (idx + offset - staticTableSize) fromSIndexToIndex :: HeaderTable -> SIndex -> Index -fromSIndexToIndex HeaderTable{..} sidx = fromStaticIndex sidx + numOfEntries +fromSIndexToIndex _ sidx = fromStaticIndex sidx fromIndexToSIndex :: HeaderTable -> Index -> SIndex -fromIndexToSIndex HeaderTable{..} idx = toStaticIndex sidx - where - sidx = idx - numOfEntries +fromIndexToSIndex _ idx = toStaticIndex idx ---------------------------------------------------------------- @@ -161,23 +163,17 @@ maxN = maxNumbers maxsiz end = maxN - 1 -renewHeaderTable :: Size -> HeaderTable -> IO (HeaderTable, Int) -renewHeaderTable maxsiz oldhdrtbl = do - putStrLn $ "numOfEntries oldhdrtbl: " ++ show (numOfEntries oldhdrtbl) - hdrtbl <- newHeaderTable maxsiz mhp - newhdrtbl <- copyTable oldhdrtbl hdrtbl - putStrLn $ "numOfEntries newhdrtbl: " ++ show (numOfEntries newhdrtbl) - return (newhdrtbl, numOfEntries newhdrtbl) +-- | Renewing 'HeaderTable' with necessary entries copied. +renewHeaderTable :: Size -> HeaderTable -> IO HeaderTable +renewHeaderTable maxsiz oldhdrtbl = + newHeaderTable maxsiz mhp >>= copyTable oldhdrtbl where mhp = case reverseIndex oldhdrtbl of Nothing -> Nothing _ -> Just HP.empty copyTable :: HeaderTable -> HeaderTable -> IO HeaderTable -copyTable oldhdrtbl newhdrtbl = do - ents <- getEntries oldhdrtbl - putStrLn $ "length of entries: " ++ show (length ents) - copyEntries newhdrtbl ents +copyTable oldhdrtbl newhdrtbl = getEntries oldhdrtbl >>= copyEntries newhdrtbl getEntries :: HeaderTable -> IO [Entry] getEntries HeaderTable{..} = forM [1 .. numOfEntries] readTable @@ -192,6 +188,7 @@ copyEntries hdrtbl' es | otherwise = return hdrtbl +-- | Is the size of 'HeaderTable' really changed? shouldRenew :: HeaderTable -> Size -> Bool shouldRenew HeaderTable{..} maxsiz = maxHeaderTableSize /= maxsiz @@ -201,13 +198,13 @@ -- New 'HeaderTable', the largest new 'Index' -- and a set of dropped OLD 'Index' -- are returned. -insertEntry :: Entry -> HeaderTable -> IO (HeaderTable,Index,[Index]) +insertEntry :: Entry -> HeaderTable -> IO HeaderTable insertEntry e hdrtbl = do - (hdrtbl', is, hs) <- insertFront e hdrtbl >>= adjustTableSize + (hdrtbl', hs) <- insertFront e hdrtbl >>= adjustTableSize let hdrtbl'' = case reverseIndex hdrtbl' of Nothing -> hdrtbl' Just rev -> hdrtbl' { reverseIndex = Just (HP.deleteList hs rev) } - return (hdrtbl'', numOfEntries hdrtbl'', is) + return hdrtbl'' insertFront :: Entry -> HeaderTable -> IO HeaderTable insertFront e hdrtbl@HeaderTable{..} = do @@ -226,15 +223,15 @@ Nothing -> Nothing Just rev -> Just $ HP.insert (entryHeader e) (HIndex i) rev -adjustTableSize :: HeaderTable -> IO (HeaderTable, [Index], [Header]) -adjustTableSize hdrtbl = adjust hdrtbl [] [] +adjustTableSize :: HeaderTable -> IO (HeaderTable, [Header]) +adjustTableSize hdrtbl = adjust hdrtbl [] -adjust :: HeaderTable -> [Index] -> [Header] -> IO (HeaderTable, [Index], [Header]) -adjust hdrtbl is hs - | tsize <= maxtsize = return (hdrtbl, is, hs) +adjust :: HeaderTable -> [Header] -> IO (HeaderTable, [Header]) +adjust hdrtbl hs + | tsize <= maxtsize = return (hdrtbl, hs) | otherwise = do - (hdrtbl', i, h) <- removeEnd hdrtbl - adjust hdrtbl' (i:is) (h:hs) + (hdrtbl', h) <- removeEnd hdrtbl + adjust hdrtbl' (h:hs) where tsize = headerTableSize hdrtbl maxtsize = maxHeaderTableSize hdrtbl @@ -251,15 +248,14 @@ } where i = adj maxNumOfEntries (offset + numOfEntries + 1) - hi = numOfEntries + 1 headerTableSize' = headerTableSize + entrySize e reverseIndex' = case reverseIndex of Nothing -> Nothing - Just rev -> Just $ HP.insert (entryHeader e) (HIndex hi) rev + Just rev -> Just $ HP.insert (entryHeader e) (HIndex i) rev ---------------------------------------------------------------- -removeEnd :: HeaderTable -> IO (HeaderTable,Index,Header) +removeEnd :: HeaderTable -> IO (HeaderTable,Header) removeEnd hdrtbl@HeaderTable{..} = do let i = adj maxNumOfEntries (offset + numOfEntries) e <- readArray circularTable i @@ -270,27 +266,29 @@ numOfEntries = numOfEntries - 1 , headerTableSize = tsize } - return (hdrtbl', numOfEntries - 1, h) + return (hdrtbl', h) ---------------------------------------------------------------- +-- | Resolving an index from a header. lookupTable :: Header -> HeaderTable -> HeaderCache -lookupTable h hdrtbl = case mrev of +lookupTable h hdrtbl = case reverseIndex hdrtbl of Nothing -> None Just rev -> case HP.search h rev of HP.N -> case HP.search h staticHashPSQ of HP.N -> None HP.K sidx -> KeyOnly InStaticTable (fromSIndexToIndex hdrtbl sidx) HP.KV sidx -> KeyValue InStaticTable (fromSIndexToIndex hdrtbl sidx) - HP.K hidx -> KeyOnly InHeaderTable (fromHIndexToIndex hdrtbl hidx) + HP.K hidx -> case HP.search h staticHashPSQ of + HP.N -> KeyOnly InHeaderTable (fromHIndexToIndex hdrtbl hidx) + HP.K sidx -> KeyOnly InStaticTable (fromSIndexToIndex hdrtbl sidx) + HP.KV sidx -> KeyValue InStaticTable (fromSIndexToIndex hdrtbl sidx) HP.KV hidx -> KeyValue InHeaderTable (fromHIndexToIndex hdrtbl hidx) - where - mrev = reverseIndex hdrtbl ---------------------------------------------------------------- isIn :: Int -> HeaderTable -> Bool -isIn idx HeaderTable{..} = idx <= numOfEntries +isIn idx HeaderTable{..} = idx > staticTableSize -- | Which table does 'Index' belong to? which :: HeaderTable -> Index -> IO (WhichTable, Entry) diff --git a/Network/HPACK/Table/Entry.hs b/Network/HPACK/Table/Entry.hs --- a/Network/HPACK/Table/Entry.hs +++ b/Network/HPACK/Table/Entry.hs @@ -74,9 +74,10 @@ ---------------------------------------------------------------- --- | Dummy 'Entry' to initialize a table. +-- | Dummy 'Entry' to initialize a header table. dummyEntry :: Entry dummyEntry = (0,("dummy","dummy")) +-- | How many entries can be stored in a header table? maxNumbers :: Size -> Int maxNumbers siz = siz `div` headerSizeMagicNumber diff --git a/Network/HPACK/Table/Static.hs b/Network/HPACK/Table/Static.hs --- a/Network/HPACK/Table/Static.hs +++ b/Network/HPACK/Table/Static.hs @@ -7,6 +7,7 @@ , isSIndexValid , toStaticEntry , staticHashPSQ + , staticTableSize -- fixme ) where import Data.Array (Array, listArray, (!)) @@ -30,10 +31,12 @@ -- | The size of static table. staticTableSize :: Size -staticTableSize = 60 +staticTableSize = length staticTableList -- | Get 'Entry' from the static table. -- +-- >>> toStaticEntry (SIndex 1) +-- (42,(":authority","")) -- >>> toStaticEntry (SIndex 8) -- (42,(":status","200")) -- >>> toStaticEntry (SIndex 50) @@ -43,7 +46,7 @@ -- | Pre-defined static table. staticTable :: Array Index Entry -staticTable = listArray (1,60) $ map toEntry staticTableList +staticTable = listArray (1,staticTableSize) $ map toEntry staticTableList staticHashPSQ :: HP.HashPSQ SIndex staticHashPSQ = HP.fromList alist diff --git a/Network/HPACK/Types.hs b/Network/HPACK/Types.hs --- a/Network/HPACK/Types.hs +++ b/Network/HPACK/Types.hs @@ -42,7 +42,6 @@ data CompressionAlgo = Naive -- ^ No compression | Static -- ^ Using the static table only | Linear -- ^ Using indices only - | Diff -- ^ Calculating difference -- | Strategy for HPACK encoding. data EncodeStrategy = EncodeStrategy { diff --git a/http2.cabal b/http2.cabal --- a/http2.cabal +++ b/http2.cabal @@ -1,12 +1,12 @@ Name: http2 -Version: 0.4.0 +Version: 0.5.0 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE Synopsis: HTTP/2.0 library including HPACK Description: HTTP/2.0 library including HPACK. - Currently only HPACK 08 is supported. + Currently only HPACK 09 is supported. Category: Network Cabal-Version: >= 1.10 Build-Type: Simple @@ -18,8 +18,7 @@ Other-Modules: Network.HPACK.Builder Network.HPACK.Builder.Word8 Network.HPACK.Context - Network.HPACK.Context.HeaderSet - Network.HPACK.Context.ReferenceSet + Network.HPACK.Context.HeaderList Network.HPACK.Huffman Network.HPACK.Huffman.Bit Network.HPACK.Huffman.ByteString diff --git a/test-hpack/HPACKDecode.hs b/test-hpack/HPACKDecode.hs --- a/test-hpack/HPACKDecode.hs +++ b/test-hpack/HPACKDecode.hs @@ -8,13 +8,14 @@ , CompressionAlgo(..) ) where +import Control.Applicative ((<$>)) import Control.Exception import Control.Monad (when) import qualified Data.ByteString.Char8 as B8 import Data.List (sort) import Network.HPACK import Network.HPACK.Context -import Network.HPACK.Context.HeaderSet +import Network.HPACK.Context.HeaderList import Network.HPACK.HeaderBlock import HexString @@ -53,14 +54,14 @@ -- context is destructive!!! when (debug conf) $ do putStrLn "--------------------------------" - putStrLn "---- Input headerset" - printHeaderSet $ sort hs + putStrLn "---- Input headerlist" + printHeaderList $ sort hs putStrLn "---- Input context" printContext dctx putStrLn "---- Input Hex" B8.putStrLn hex putStrLn "---- Input header block" - print hd + print bshd' dctx0 <- case size c of Nothing -> return dctx Just siz -> changeContextForDecoding dctx siz @@ -77,4 +78,6 @@ hex = wire c inp = fromHexString hex hs = headers c - hd = fromByteStream inp + bshd = fromByteStreamDebug inp + hd = map snd <$> bshd + bshd' = map (\(x,y)->(toHexString x,y)) <$> bshd diff --git a/test-hpack/Types.hs b/test-hpack/Types.hs --- a/test-hpack/Types.hs +++ b/test-hpack/Types.hs @@ -4,7 +4,7 @@ module Types ( Test(..) , Case(..) - , HeaderSet + , HeaderList ) where import Control.Applicative @@ -39,7 +39,7 @@ data Case = Case { size :: Maybe Int , wire :: ByteString - , headers :: HeaderSet + , headers :: HeaderList , seqno :: Maybe Int } deriving Show @@ -73,11 +73,11 @@ ,"seqno" .= no ] -instance FromJSON HeaderSet where +instance FromJSON HeaderList where parseJSON (Array a) = mapM parseJSON $ V.toList a parseJSON _ = mzero -instance ToJSON HeaderSet where +instance ToJSON HeaderList where toJSON hs = toJSON $ map toJSON hs instance FromJSON Header where diff --git a/test-hpack/hpack-encode.hs b/test-hpack/hpack-encode.hs --- a/test-hpack/hpack-encode.hs +++ b/test-hpack/hpack-encode.hs @@ -15,7 +15,7 @@ main = do args <- getArgs when (length args /= 3) $ do - hPutStrLn stderr "hpack-encode on/off naive|linear|diff " + hPutStrLn stderr "hpack-encode on/off naive|linear " exitFailure let [arg1,arg2,desc] = args huffman @@ -24,8 +24,7 @@ algo | arg2 == "naive" = Naive | arg2 == "static" = Static - | arg2 == "linear" = Linear - | otherwise = Diff + | otherwise = Linear stgy = EncodeStrategy algo huffman hpackEncode stgy desc diff --git a/test-hpack/hpack-stat.hs b/test-hpack/hpack-stat.hs --- a/test-hpack/hpack-stat.hs +++ b/test-hpack/hpack-stat.hs @@ -14,7 +14,7 @@ import Types hdir :: FilePath -hdir = "test-hpack/hpack-test-case/haskell-http2" +hdir = "test-hpack/hpack-test-case/nghttp2" wdir1 :: FilePath wdir1 = "test-hpack/hpack-test-case/haskell-http2-naive" @@ -23,16 +23,17 @@ wdir2 = "test-hpack/hpack-test-case/haskell-http2-naive-huffman" wdir3 :: FilePath -wdir3 = "test-hpack/hpack-test-case/haskell-http2-linear" +wdir3 = "test-hpack/hpack-test-case/haskell-http2-static" wdir4 :: FilePath -wdir4 = "test-hpack/hpack-test-case/haskell-http2-linear-huffman" +wdir4 = "test-hpack/hpack-test-case/haskell-http2-static-huffman" wdir5 :: FilePath -wdir5 = "test-hpack/hpack-test-case/haskell-http2-diff" +wdir5 = "test-hpack/hpack-test-case/haskell-http2-linear" wdir6 :: FilePath -wdir6 = "test-hpack/hpack-test-case/haskell-http2-diff-huffman" +wdir6 = "test-hpack/hpack-test-case/haskell-http2-linear-huffman" + main :: IO () diff --git a/test/DecodeSpec.hs b/test/DecodeSpec.hs --- a/test/DecodeSpec.hs +++ b/test/DecodeSpec.hs @@ -1,29 +1,25 @@ module DecodeSpec where -import Data.List (sort) import Network.HPACK.Context import Network.HPACK.HeaderBlock import Test.Hspec import HeaderBlock -shouldBeSameAs :: (Ord a, Show a) => [a] -> [a] -> Expectation -shouldBeSameAs xs ys = sort xs `shouldBe` sort ys - spec :: Spec spec = do describe "fromHeaderBlock" $ do - it "decodes HeaderSet in request" $ do + it "decodes HeaderList in request" $ do (c1,h1) <- newContextForDecoding 4096 >>= flip fromHeaderBlock d41 - h1 `shouldBeSameAs` d41h + h1 `shouldBe` d41h (c2,h2) <- fromHeaderBlock c1 d42 - h2 `shouldBeSameAs` d42h + h2 `shouldBe` d42h (_,h3) <- fromHeaderBlock c2 d43 - h3 `shouldBeSameAs` d43h - it "decodes HeaderSet in response" $ do + h3 `shouldBe` d43h + it "decodes HeaderList in response" $ do (c1,h1) <- newContextForDecoding 256 >>= flip fromHeaderBlock d61 - h1 `shouldBeSameAs` d61h + h1 `shouldBe` d61h (c2,h2) <- fromHeaderBlock c1 d62 - h2 `shouldBeSameAs` d62h + h2 `shouldBe` d62h (_,h3) <- fromHeaderBlock c2 d63 - h3 `shouldBeSameAs` d63h + h3 `shouldBe` d63h diff --git a/test/HeaderBlock.hs b/test/HeaderBlock.hs --- a/test/HeaderBlock.hs +++ b/test/HeaderBlock.hs @@ -13,112 +13,115 @@ d41 :: HeaderBlock d41 = [ Indexed 2 - , Indexed 7 , Indexed 6 - , Literal Add (Idx 4) "www.example.com" + , Indexed 4 + , Literal Add (Idx 1) "www.example.com" ] -d41h :: HeaderSet +d41h :: HeaderList d41h = [(":method","GET") - ,(":scheme","http") - ,(":path","/") - ,(":authority","www.example.com") - ] + ,(":scheme","http") + ,(":path","/") + ,(":authority","www.example.com") + ] d41b :: ByteStream -d41b = fromHexString "828786448cf1e3c2e5f23a6ba0ab90f4ff" +d41b = fromHexString "828684418cf1e3c2e5f23a6ba0ab90f4ff" d42 :: HeaderBlock d42 = [ - Literal Add (Idx 28) "no-cache" + Indexed 2 + , Indexed 6 + , Indexed 4 + , Indexed 62 + , Literal Add (Idx 24) "no-cache" ] -d42h :: HeaderSet -d42h = [("cache-control","no-cache") - ,(":method","GET") - ,(":scheme","http") - ,(":path","/") - ,(":authority","www.example.com")] +d42h :: HeaderList +d42h = [(":method","GET") + ,(":scheme","http") + ,(":path","/") + ,(":authority","www.example.com") + ,("cache-control","no-cache")] d42b :: ByteStream -d42b = fromHexString "5c86a8eb10649cbf" +d42b = fromHexString "828684be5886a8eb10649cbf" d43 :: HeaderBlock d43 = [ - Clear + Indexed 2 + , Indexed 7 , Indexed 5 - , Indexed 12 - , Indexed 11 - , Indexed 4 + , Indexed 63 , Literal Add (Lit "custom-key") "custom-value" ] -d43h :: HeaderSet +d43h :: HeaderList d43h = [(":method","GET") - ,(":scheme","https") - ,(":path","/index.html") - ,(":authority","www.example.com") - ,("custom-key","custom-value") - ] + ,(":scheme","https") + ,(":path","/index.html") + ,(":authority","www.example.com") + ,("custom-key","custom-value") + ] d43b :: ByteStream -d43b = fromHexString "30858c8b84408825a849e95ba97d7f8925a849e95bb8e8b4bf" +d43b = fromHexString "828785bf408825a849e95ba97d7f8925a849e95bb8e8b4bf" ---------------------------------------------------------------- d61 :: HeaderBlock d61 = [ Literal Add (Idx 8) "302" - , Literal Add (Idx 25) "private" - , Literal Add (Idx 35) "Mon, 21 Oct 2013 20:13:21 GMT" - , Literal Add (Idx 49) "https://www.example.com" + , Literal Add (Idx 24) "private" + , Literal Add (Idx 33) "Mon, 21 Oct 2013 20:13:21 GMT" + , Literal Add (Idx 46) "https://www.example.com" ] -d61h :: HeaderSet +d61h :: HeaderList d61h = [(":status","302") - ,("cache-control","private") - ,("date","Mon, 21 Oct 2013 20:13:21 GMT") - ,("location","https://www.example.com") - ] + ,("cache-control","private") + ,("date","Mon, 21 Oct 2013 20:13:21 GMT") + ,("location","https://www.example.com") + ] d61b :: ByteStream -d61b = fromHexString "488264025985aec3771a4b6396d07abe941054d444a8200595040b8166e082a62d1bff71919d29ad171863c78f0b97c8e9ae82ae43d3" +d61b = fromHexString "488264025885aec3771a4b6196d07abe941054d444a8200595040b8166e082a62d1bff6e919d29ad171863c78f0b97c8e9ae82ae43d3" d62 :: HeaderBlock d62 = [ - Indexed 12 + Literal Add (Idx 8) "307" + , Indexed 65 + , Indexed 64 + , Indexed 63 ] -d62h :: HeaderSet -d62h = [(":status","200") - ,("cache-control","private") - ,("date","Mon, 21 Oct 2013 20:13:21 GMT") - ,("location","https://www.example.com") - ] +d62h :: HeaderList +d62h = [(":status","307") + ,("cache-control","private") + ,("date","Mon, 21 Oct 2013 20:13:21 GMT") + ,("location","https://www.example.com") + ] d62b :: ByteStream -d62b = fromHexString "8c" +d62b = fromHexString "4883640effc1c0bf" d63 :: HeaderBlock d63 = [ - Indexed 4 - , Indexed 4 - , Literal Add (Idx 3) "Mon, 21 Oct 2013 20:13:22 GMT" - , Literal Add (Idx 30) "gzip" - , Indexed 4 - , Indexed 4 - , Indexed 3 - , Indexed 3 - ,Literal Add (Idx 59) "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" + Indexed 8 + , Indexed 65 + , Literal Add (Idx 33) "Mon, 21 Oct 2013 20:13:22 GMT" + , Indexed 64 + , Literal Add (Idx 26) "gzip" + ,Literal Add (Idx 55) "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" ] -d63h :: HeaderSet -d63h = [("cache-control","private") - ,("date","Mon, 21 Oct 2013 20:13:22 GMT") - ,("content-encoding","gzip") - ,("location","https://www.example.com") - ,(":status","200") - ,("set-cookie","foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1")] +d63h :: HeaderList +d63h = [(":status","200") + ,("cache-control","private") + ,("date","Mon, 21 Oct 2013 20:13:22 GMT") + ,("location","https://www.example.com") + ,("content-encoding","gzip") + ,("set-cookie","foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1")] d63b :: ByteStream -d63b = fromHexString "84844396d07abe941054d444a8200595040b8166e084a62d1bff5e839bd9ab848483837bad94e7821dd7f2e6c7b335dfdfcd5b3960d5af27087f3672c1ab270fb5291f9587316065c003ed4ee5b1063d5007" +d63b = fromHexString "88c16196d07abe941054d444a8200595040b8166e084a62d1bffc05a839bd9ab77ad94e7821dd7f2e6c7b335dfdfcd5b3960d5af27087f3672c1ab270fb5291f9587316065c003ed4ee5b1063d5007" diff --git a/test/HeaderBlockSpec.hs b/test/HeaderBlockSpec.hs --- a/test/HeaderBlockSpec.hs +++ b/test/HeaderBlockSpec.hs @@ -28,6 +28,7 @@ fromByteStream d61b `shouldBe` Right d61 fromByteStream d62b `shouldBe` Right d62 fromByteStream d63b `shouldBe` Right d63 + describe "toByteStream & fromByteStream" $ do prop "duality for request" $ \k v -> do let key = BS.pack ('k':k)