http2 (empty) → 0.0.0
raw patch · 35 files changed
+2430/−0 lines, 35 filesdep +arraydep +basedep +blaze-buildersetup-changed
Dependencies added: array, base, blaze-builder, bytestring, case-insensitive, doctest, hashtables, hspec, http-types, http2
Files
- LICENSE +29/−0
- Network/HPACK.hs +55/−0
- Network/HPACK/Context.hs +169/−0
- Network/HPACK/Context/HeaderSet.hs +33/−0
- Network/HPACK/Context/ReferenceSet.hs +58/−0
- Network/HPACK/HeaderBlock.hs +16/−0
- Network/HPACK/HeaderBlock/Decode.hs +92/−0
- Network/HPACK/HeaderBlock/Encode.hs +75/−0
- Network/HPACK/HeaderBlock/From.hs +55/−0
- Network/HPACK/HeaderBlock/HeaderField.hs +33/−0
- Network/HPACK/HeaderBlock/Integer.hs +86/−0
- Network/HPACK/HeaderBlock/String.hs +19/−0
- Network/HPACK/HeaderBlock/To.hs +77/−0
- Network/HPACK/Huffman.hs +14/−0
- Network/HPACK/Huffman/Bit.hs +56/−0
- Network/HPACK/Huffman/Code.hs +90/−0
- Network/HPACK/Huffman/Request.hs +288/−0
- Network/HPACK/Huffman/Response.hs +288/−0
- Network/HPACK/Table.hs +69/−0
- Network/HPACK/Table/Entry.hs +77/−0
- Network/HPACK/Table/Header.hs +136/−0
- Network/HPACK/Table/Static.hs +147/−0
- Network/HPACK/Types.hs +47/−0
- Setup.hs +2/−0
- http2.cabal +78/−0
- test/BitSpec.hs +12/−0
- test/DecodeSpec.hs +25/−0
- test/HeaderBlock.hs +127/−0
- test/HeaderBlockSpec.hs +46/−0
- test/HexString.hs +17/−0
- test/HuffmanRequestSpec.hs +39/−0
- test/HuffmanResponseSpec.hs +43/−0
- test/IntegerSpec.hs +22/−0
- test/Spec.hs +1/−0
- test/doctests.hs +9/−0
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2013, IIJ Innovation Institute Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in+ the documentation and/or other materials provided with the+ distribution.+ * Neither the name of the copyright holders nor the names of its+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Network/HPACK.hs view
@@ -0,0 +1,55 @@+module Network.HPACK (+ -- * Type+ ByteStream+ , HeaderSet+ , Context+ , newContext+ , DecodeError(..)+ -- * Request+ , encodeRequestHeader+ , decodeRequestHeader+ -- * Response+ , encodeResponseHeader+ , decodeResponseHeader+ ) where++import Control.Applicative ((<$>))+import Control.Arrow (first)+import Network.HPACK.Context+import Network.HPACK.HeaderBlock+import Network.HPACK.Huffman+import Network.HPACK.Types++----------------------------------------------------------------++-- | Converting 'HeaderSet' for HTTP request to the low level format.+encodeRequestHeader :: HeaderSet+ -> Context+ -> IO (ByteStream, Context)+encodeRequestHeader hs ctx =+ first (toByteStream huffmanEncodeInRequest) <$> toHeaderBlock hs ctx++-- | Converting the low level format for HTTP request to 'HeaderSet'.+-- 'DecodeError' would be thrown.+decodeRequestHeader :: ByteStream+ -> Context+ -> IO (HeaderSet, Context)+decodeRequestHeader bs ctx =+ fromHeaderBlock (fromByteStream huffmanDecodeInRequest bs) ctx++----------------------------------------------------------------++-- | Converting 'HeaderSet' for HTTP response to the low level format.+encodeResponseHeader :: HeaderSet+ -> Context+ -> IO (ByteStream, Context)+encodeResponseHeader hs ctx =+ first (toByteStream huffmanEncodeInResponse) <$> toHeaderBlock hs ctx++-- | Converting the low level format for HTTP response to 'HeaderSet'.+-- 'DecodeError' would be thrown.+decodeResponseHeader :: ByteStream+ -> Context+ -> IO (HeaderSet, Context)+decodeResponseHeader bs ctx =+ fromHeaderBlock (fromByteStream huffmanDecodeInResponse bs) ctx
+ Network/HPACK/Context.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE BangPatterns #-}++module Network.HPACK.Context (+ -- * Types+ HeaderSet -- re-exporting+ , Context+ , newContext+ , DecodeError(..)+ , printContext+ -- * Initialization and final results+ , clearHeaderSet+ , getHeaderSet+ , emitNotEmitted+ -- * Processing+ , clearRefSets+ , removeRef+ , newEntry+ , pushRef+ , emitOnly+ -- * Auxiliary functions+ , isPresentIn+ , getEntry+ -- * Table+ , whichTable+ , lookupHeader+ ) where++import Control.Applicative ((<$>))+import Network.HPACK.Context.HeaderSet+import Network.HPACK.Context.ReferenceSet+import Network.HPACK.Table+import Network.HPACK.Types++----------------------------------------------------------------++-- | Context for encoding/decoding.+data Context = Context {+ headerTable :: !HeaderTable -- ^ A cache of headers+ , oldReferenceSet :: ReferenceSet -- ^ References for not emitted+ , newReferenceSet :: ReferenceSet -- ^ References for already mitted+ , headerSet :: HeaderSet -- ^ Emitted header set.+ -- Encode: the previous ones.+ -- Decode: the results.+ }++-- | Printing 'Context'+printContext :: Context -> IO ()+printContext (Context hdrtbl oldref newref hdrset) = do+ putStrLn "<<<Header table>>>"+ printHeaderTable hdrtbl+ putStr "\n"+ putStrLn "<<<Reference set (old)>>>"+ print $ getIndices oldref+ putStr "\n"+ putStrLn "<<<Reference set (new)>>>"+ print $ getIndices newref+ putStr "\n"+ putStrLn "<<<Headers>>>"+ printHeaderSet hdrset++----------------------------------------------------------------++-- | Creating a new 'Context'.+-- The first argument is the size of 'HeaderTable'.+newContext :: Size -> IO Context+newContext maxsiz = do+ hdrtbl <- newHeaderTable maxsiz+ return $ Context hdrtbl+ emptyReferenceSet+ emptyReferenceSet+ emptyHeaderSet++----------------------------------------------------------------++-- | The reference set is emptied.+clearRefSets :: Context -> IO Context+clearRefSets ctx = return ctx {+ oldReferenceSet = emptyReferenceSet+ , newReferenceSet = emptyReferenceSet+ }++-- | The entry is removed from the reference set.+removeRef :: Context -> Index -> IO Context+removeRef ctx idx = return ctx { oldReferenceSet = removeIndex idx oldref }+ where+ oldref = oldReferenceSet ctx++-- | The header field is emitted.+-- The header field is inserted at the beginning of the header table.+-- A reference to the new entry is added to the reference set.+newEntry :: Context -> Entry -> IO Context+newEntry (Context hdrtbl oldref newref hdrset) e = do+ (hdrtbl', is) <- insertEntry e hdrtbl+ let oldref' = removeIndices is $ adjustReferenceSet oldref+ newref' = addIndex 1 $ removeIndices is $ adjustReferenceSet newref+ hdrset' = insertHeader (fromEntry e) hdrset+ return $ Context hdrtbl' oldref' newref' hdrset'++-- | The header field corresponding to the referenced entry is emitted.+-- The referenced header table entry is added to the reference set.+pushRef :: Context -> Index -> Entry -> IO Context+pushRef (Context hdrtbl oldref newref hdrset) idx e = return ctx+ where+ hdrset' = insertHeader (fromEntry e) hdrset+ newref' = addIndex idx newref+ ctx = Context hdrtbl oldref newref' hdrset'++-- | The header field is emitted.+emitOnly :: Context -> Header -> IO Context+emitOnly (Context hdrtbl oldref newref hdrset) h = return ctx+ where+ hdrset' = insertHeader h hdrset+ ctx = Context hdrtbl oldref newref hdrset'++----------------------------------------------------------------++-- | Emitting non-emitted headers.+emitNotEmitted :: Context -> IO Context+emitNotEmitted ctx = emit ctx <$> getNotEmitted ctx++-- | Emit non-emitted headers.+emit :: Context -> HeaderSet -> Context+emit (Context hdrtbl oldref newref hdrset) notEmitted = ctx+ where+ hdrset' = meregeHeaderSet hdrset notEmitted+ oldref' = mergeReferenceSet newref oldref+ ctx = Context hdrtbl oldref' emptyReferenceSet hdrset'++getNotEmitted :: Context -> IO HeaderSet+getNotEmitted ctx = do+ let is = getIndices $ oldReferenceSet 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` oldref+ where+ oldref = oldReferenceSet ctx++----------------------------------------------------------------++-- | Which table does 'Index' refer to?+whichTable :: Index -> Context -> IO (WhichTable, Entry)+whichTable idx ctx = which hdrtbl idx+ where+ hdrtbl = headerTable ctx++-- | Which table contains 'Header'?+lookupHeader :: Header -> Context -> IO HeaderCache+lookupHeader h ctx = lookupTable h (headerTable ctx)++----------------------------------------------------------------++-- | Getting 'Entry' by 'Index'.+getEntry :: Index -> Context -> IO Entry+getEntry idx ctx = snd <$> whichTable idx ctx++----------------------------------------------------------------++-- | Clearing 'HeaderSet' in 'Context' for the next decode.+clearHeaderSet :: Context -> Context+clearHeaderSet ctx = ctx { headerSet = emptyHeaderSet }++-- | Getting 'HeaderSet' as emitted headers.+getHeaderSet :: Context -> HeaderSet+getHeaderSet = headerSet
+ Network/HPACK/Context/HeaderSet.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.HPACK.Context.HeaderSet where++import qualified Data.ByteString.Char8 as BS+import Network.HPACK.Table+import Network.HPACK.Types++-- | Header set.+type HeaderSet = [Header]++-- | Empty header set.+emptyHeaderSet :: HeaderSet+emptyHeaderSet = []++-- | Printing 'HeaderSet'.+printHeaderSet :: HeaderSet -> IO ()+printHeaderSet hs = mapM_ printHeader hs+ where+ printHeader (k,v) = do+ BS.putStr $ fromHeaderName k+ putStr ": "+ BS.putStr v+ putStr "\n"++-- | Merging the emitted header set and the non-emitted header set.+meregeHeaderSet :: HeaderSet -> HeaderSet -> HeaderSet+meregeHeaderSet hdrset notEmitted = reverse $ notEmitted ++ hdrset++-- | Inserting 'Header' to 'HeaderSet'.+insertHeader :: Header -> HeaderSet -> HeaderSet+insertHeader = (:)+
+ Network/HPACK/Context/ReferenceSet.hs view
@@ -0,0 +1,58 @@+module Network.HPACK.Context.ReferenceSet (+ -- * Type+ ReferenceSet+ , emptyReferenceSet+ -- * Index and reference set+ , getIndices+ , isMember+ , addIndex+ , removeIndex+ , removeIndices+ -- * Managing reference set+ , adjustReferenceSet+ , mergeReferenceSet+ ) where++import Data.List (delete, (\\))+import Network.HPACK.Table++----------------------------------------------------------------++-- | Type for the reference set.+data ReferenceSet = ReferenceSet [Index] deriving Show++-- | Empty reference set.+emptyReferenceSet :: ReferenceSet+emptyReferenceSet = ReferenceSet []++----------------------------------------------------------------++-- | Get all 'Index' from 'ReferenceSet'.+getIndices :: ReferenceSet -> [Index]+getIndices (ReferenceSet is) = is++-- | Is 'Index' a member of 'ReferenceSet'?+isMember :: Index -> ReferenceSet -> Bool+isMember idx (ReferenceSet is) = idx `elem` is++-- | Adding 'Index' to 'ReferenceSet'.+addIndex :: Index -> ReferenceSet -> ReferenceSet+addIndex idx (ReferenceSet is) = ReferenceSet $ idx : is++-- | Removing 'Index' from 'ReferenceSet'.+removeIndex :: Index -> ReferenceSet -> ReferenceSet+removeIndex idx (ReferenceSet is) = ReferenceSet $ delete idx is++-- | Removing a set of 'Index' from 'ReferenceSet'.+removeIndices :: [Index] -> ReferenceSet -> ReferenceSet+removeIndices idcs (ReferenceSet is) = ReferenceSet $ is \\ idcs++----------------------------------------------------------------++-- | Incrementing all 'Index' by one.+adjustReferenceSet :: ReferenceSet -> ReferenceSet+adjustReferenceSet (ReferenceSet is) = ReferenceSet $ map (+1) is++-- | Merging two 'ReferenceSet'.+mergeReferenceSet :: ReferenceSet -> ReferenceSet -> ReferenceSet+mergeReferenceSet (ReferenceSet xs) (ReferenceSet ys) = ReferenceSet $ xs ++ ys
+ Network/HPACK/HeaderBlock.hs view
@@ -0,0 +1,16 @@+module Network.HPACK.HeaderBlock (+ -- * Types for header block+ module Network.HPACK.HeaderBlock.HeaderField+ -- * Header block from/to Low level+ , toByteStream+ , fromByteStream+ -- * Header block from/to header set+ , toHeaderBlock+ , fromHeaderBlock+ ) where++import Network.HPACK.HeaderBlock.Decode+import Network.HPACK.HeaderBlock.Encode+import Network.HPACK.HeaderBlock.From+import Network.HPACK.HeaderBlock.HeaderField+import Network.HPACK.HeaderBlock.To
+ Network/HPACK/HeaderBlock/Decode.hs view
@@ -0,0 +1,92 @@+module Network.HPACK.HeaderBlock.Decode (+ fromByteStream+ ) where++import Data.Bits (testBit, clearBit, (.&.))+import qualified Data.ByteString as BS+import Data.Word (Word8)+import Network.HPACK.HeaderBlock.HeaderField+import qualified Network.HPACK.HeaderBlock.Integer as I+import qualified Network.HPACK.HeaderBlock.String as S+import Network.HPACK.Huffman+import Network.HPACK.Types++----------------------------------------------------------------++-- | Converting the low level format to 'HeaderBlock'.+fromByteStream :: HuffmanDecoding -> ByteStream -> HeaderBlock+fromByteStream hd bs = go $ BS.unpack bs+ where+ go [] = []+ go ws = hf : go ws'+ where+ (hf, ws') = toHeaderField hd ws++toHeaderField :: HuffmanDecoding -> [Word8] -> (HeaderField, [Word8])+toHeaderField _ [] = error "toHeaderField"+toHeaderField hd (w:ws)+ | w `testBit` 7 = indexed w ws+ | w `testBit` 6 = withoutIndexing hd w ws+ | otherwise = incrementalIndexing hd w ws++----------------------------------------------------------------++indexed :: Word8 -> [Word8] -> (HeaderField, [Word8])+indexed w ws = (Indexed idx , ws)+ where+ idx = fromIntegral $ clearBit w 7++withoutIndexing :: HuffmanDecoding -> Word8 -> [Word8] -> (HeaderField, [Word8])+withoutIndexing hd w ws+ | isIndexedName w = indexedName NotAdd hd w ws+ | otherwise = newName NotAdd hd ws++incrementalIndexing :: HuffmanDecoding -> Word8 -> [Word8] -> (HeaderField, [Word8])+incrementalIndexing hd w ws+ | isIndexedName w = indexedName Add hd w ws+ | otherwise = newName Add hd ws++----------------------------------------------------------------++indexedName :: Indexing -> HuffmanDecoding -> Word8 -> [Word8] -> (HeaderField, [Word8])+indexedName indexing hd w ws = (hf, ws'')+ where+ p = mask6 w+ (idx,ws') = I.parseInteger 6 p ws+ (val,ws'') = headerStuff hd ws'+ hf = Literal indexing (Idx idx) val++newName :: Indexing -> HuffmanDecoding -> [Word8] -> (HeaderField, [Word8])+newName indexing hd ws = (hf, ws'')+ where+ (key,ws') = headerStuff hd ws+ (val,ws'') = headerStuff hd ws'+ name = toHeaderName key+ hf = Literal indexing (Lit name) val++----------------------------------------------------------------++headerStuff :: HuffmanDecoding -> [Word8] -> (HeaderStuff, [Word8])+headerStuff _ [] = error "headerStuff"+headerStuff hd (w:ws) = (hs, ws'')+ where+ p = dropHuffman w+ huff = isHuffman w+ (len, ws') = I.parseInteger 7 p ws+ (hs, ws'') = S.parseString hd huff len ws'++----------------------------------------------------------------++mask6 :: Word8 -> Word8+mask6 w = w .&. 63++isIndexedName :: Word8 -> Bool+isIndexedName w = mask6 w /= 0++----------------------------------------------------------------++isHuffman :: Word8 -> Bool+isHuffman w = w `testBit` 7++dropHuffman :: Word8 -> Word8+dropHuffman w = w `clearBit` 7
+ Network/HPACK/HeaderBlock/Encode.hs view
@@ -0,0 +1,75 @@+module Network.HPACK.HeaderBlock.Encode (+ toByteStream+ ) where++import Blaze.ByteString.Builder (Builder)+import qualified Blaze.ByteString.Builder as BB+import Data.Bits (setBit)+import Data.List (foldl')+import Data.Monoid ((<>), mempty)+import Data.Word (Word8)+import Network.HPACK.HeaderBlock.HeaderField+import qualified Network.HPACK.HeaderBlock.Integer as I+import qualified Network.HPACK.HeaderBlock.String as S+import Network.HPACK.Huffman+import Network.HPACK.Types++----------------------------------------------------------------++-- | Converting 'HeaderBlock' to the low level format.+toByteStream :: HuffmanEncoding -> HeaderBlock -> ByteStream+toByteStream he hbs = BB.toByteString $ foldl' (<>) mempty $ map toBB hbs+ where+ toBB = fromHeaderField he++fromHeaderField :: HuffmanEncoding -> HeaderField -> Builder+fromHeaderField _ (Indexed idx) = index idx+fromHeaderField he (Literal NotAdd (Idx idx) v) = indexedName he set01 idx v+fromHeaderField he (Literal NotAdd (Lit key) v) = newName he set01 key v+fromHeaderField he (Literal Add (Idx idx) v) = indexedName he set00 idx v+fromHeaderField he (Literal Add (Lit key) v) = newName he set00 key v++----------------------------------------------------------------++index :: Int -> Builder+index = BB.fromWord8 . set1 . I.encodeOne++-- Using Huffman encoding+indexedName :: HuffmanEncoding -> Setter -> Int -> HeaderValue -> Builder+indexedName he set idx v = pre <> vlen <> val+ where+ (p:ps) = I.encode 6 idx+ pre = BB.fromWord8s $ set p : ps+ value = S.encode he v+ valueLen = length value -- FIXME: performance+ vlen = BB.fromWord8s $ setH $ I.encode 7 valueLen+ val = BB.fromWord8s value++-- Using Huffman encoding+newName :: HuffmanEncoding -> Setter -> HeaderName -> HeaderValue -> Builder+newName he set ck v = pre <> klen <> key <> vlen <> val+ where+ pre = BB.fromWord8 $ set 0+ k = fromHeaderName ck+ key0 = S.encode he k+ keyLen = length key0 -- FIXME: performance+ value = S.encode he v+ valueLen = length value -- FIXME: performance+ klen = BB.fromWord8s $ setH $ I.encode 7 keyLen+ vlen = BB.fromWord8s $ setH $ I.encode 7 valueLen+ key = BB.fromWord8s key0+ val = BB.fromWord8s value++----------------------------------------------------------------++type Setter = Word8 -> Word8++-- Assuming MSBs are 0.+set1, set01, set00 :: Setter+set1 x = x `setBit` 7+set01 x = x `setBit` 6+set00 = id++setH :: [Word8] -> [Word8]+setH [] = error "setH"+setH (x:xs) = (x `setBit` 7) : xs
+ Network/HPACK/HeaderBlock/From.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE BangPatterns #-}++module Network.HPACK.HeaderBlock.From (+ fromHeaderBlock+ , decodeStep+ ) where++import Control.Applicative ((<$>))+import Network.HPACK.Context+import Network.HPACK.HeaderBlock.HeaderField+import Network.HPACK.Table++----------------------------------------------------------------++-- | Decoding 'HeaderBlock' to 'HeaderSet'.+fromHeaderBlock :: HeaderBlock+ -> Context+ -> IO (HeaderSet, Context)+fromHeaderBlock (r:rs) !ctx = decodeStep ctx r >>= fromHeaderBlock rs+fromHeaderBlock [] !ctx = decodeFinal ctx++----------------------------------------------------------------++-- | Decoding step for one 'HeaderField'. Exporting for the+-- test purpose.+decodeStep :: Context -> HeaderField -> IO Context+decodeStep !ctx (Indexed idx)+ | idx == 0 = clearRefSets ctx+ | isPresent = removeRef ctx idx+ | otherwise = do+ w <- whichTable idx ctx+ case w of+ (InStaticTable, e) -> newEntry ctx e+ (InHeaderTable, e) -> pushRef ctx idx e+ where+ isPresent = idx `isPresentIn` ctx+decodeStep !ctx (Literal NotAdd naming v) = do+ k <- fromNaming naming ctx+ emitOnly ctx (k,v)+decodeStep !ctx (Literal Add naming v) = do+ k <- fromNaming naming ctx+ newEntry ctx $ toEntry (k,v)++decodeFinal :: Context -> IO (HeaderSet, Context)+decodeFinal ctx = do+ !ctx' <- emitNotEmitted ctx+ let !hs = getHeaderSet ctx'+ !ctx'' = clearHeaderSet ctx'+ return (hs, ctx'')++----------------------------------------------------------------++fromNaming :: Naming -> Context -> IO HeaderName+fromNaming (Lit k) _ = return k+fromNaming (Idx idx) ctx = entryHeaderName <$> getEntry idx ctx
+ Network/HPACK/HeaderBlock/HeaderField.hs view
@@ -0,0 +1,33 @@+module Network.HPACK.HeaderBlock.HeaderField (+ -- * Type+ HeaderBlock+ , emptyHeaderBlock+ , HeaderField(..)+ , HeaderName -- re-exporting+ , HeaderValue -- re-exporting+ , Index -- re-exporting+ , Indexing(..)+ , Naming(..)+ ) where++import Network.HPACK.Types++----------------------------------------------------------------++-- | Type for header block.+type HeaderBlock = [HeaderField]++-- | Empty header block.+emptyHeaderBlock :: HeaderBlock+emptyHeaderBlock = []++-- | Type for representation.+data HeaderField = Indexed Index+ | Literal Indexing Naming HeaderValue+ deriving (Eq,Show)++-- | Whether or not adding to a table.+data Indexing = Add | NotAdd deriving (Eq,Show)++-- | Index or literal.+data Naming = Idx Index | Lit HeaderName deriving (Eq,Show)
+ Network/HPACK/HeaderBlock/Integer.hs view
@@ -0,0 +1,86 @@+module Network.HPACK.HeaderBlock.Integer (+ encode+ , encodeOne+ , decode+ , decodeOne+ , parseInteger+ ) where++import Data.Array (Array, listArray, (!))+import Data.Word (Word8)++----------------------------------------------------------------++powerArray :: Array Int Int+powerArray = listArray (1,8) [1,3,7,15,31,63,127,255]++----------------------------------------------------------------++-- | Integer encoding. The first argument is N of prefix.+--+-- >>> encode 5 10+-- [10]+-- >>> encode 5 1337+-- [31,154,10]+-- >>> encode 8 42+-- [42]+encode :: Int -> Int -> [Word8]+encode n i+ | i < p = fromIntegral i : []+ | otherwise = fromIntegral p : encode' (i - p)+ where+ p = powerArray ! n++encode' :: Int -> [Word8]+encode' i+ | i < 128 = fromIntegral i : []+ | otherwise = fromIntegral (r + 128) : encode' q+ where+ (q,r) = i `divMod` 128++----------------------------------------------------------------++-- | Integer encoding.+encodeOne :: Int -> Word8+encodeOne = fromIntegral++----------------------------------------------------------------++-- | Integer decoding. The first argument is N of prefix.+--+-- >>> decode 5 [10]+-- 10+-- >>> decode 5 [31,154,10]+-- 1337+-- >>> decode 8 [42]+-- 42+decode :: Int -> [Word8] -> Int+decode _ [] = error "decode"+decode n ws+ | i < p = i+ | otherwise = foldr1 (\x y -> x - 128 + y * 128) is + i+ where+ p = powerArray ! n+ (i:is) = map fromIntegral ws++-- | Integer decoding.+decodeOne :: Word8 -> Int+decodeOne = fromIntegral++----------------------------------------------------------------++parseInteger :: Int -> Word8 -> [Word8] -> (Int, [Word8])+parseInteger n w ws+ | i < p = (i, ws)+ | otherwise = (len, rest)+ where+ p = powerArray ! n+ i = fromIntegral w+ (ws', rest) = split ws+ len = decode n (w:ws')++split :: [Word8] -> ([Word8],[Word8])+split [] = error "split"+split (w:ws)+ | w >= 128 = let (xs,ys) = split ws in (w:xs, ys)+ | otherwise = ([w], ws)
+ Network/HPACK/HeaderBlock/String.hs view
@@ -0,0 +1,19 @@+module Network.HPACK.HeaderBlock.String where++import qualified Data.ByteString as BS+import Data.Word (Word8)+import Network.HPACK.Huffman+import Network.HPACK.Types++encode :: HuffmanEncoding -> HeaderStuff -> [Word8]+encode he h = he $ BS.unpack h++decode :: HuffmanDecoding -> [Word8] -> HeaderStuff+decode hd ws = BS.pack $ hd ws++parseString :: HuffmanDecoding -> Bool -> Int -> [Word8] -> (HeaderStuff, [Word8])+parseString hd isHuffman len ws = (conv es, ws')+ where+ (es, ws') = splitAt len ws+ conv | isHuffman = decode hd+ | otherwise = BS.pack
+ Network/HPACK/HeaderBlock/To.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE BangPatterns #-}++module Network.HPACK.HeaderBlock.To (+ toHeaderBlock+ ) where++import Control.Applicative ((<$>))+import Network.HPACK.Context+import Network.HPACK.HeaderBlock.HeaderField+import Network.HPACK.Table++-- | Encoding 'HeaderSet' to 'HeaderBlock'.+toHeaderBlock :: HeaderSet+ -> Context+ -> IO (HeaderBlock, Context)+toHeaderBlock hs !ctx = encodeInit ctx >>= toHeaderBlock' hs++toHeaderBlock' :: HeaderSet+ -> (DL, Context)+ -> IO (HeaderBlock, Context)+toHeaderBlock' (h:hs) !ctx = encodeStep ctx h >>= toHeaderBlock' hs+toHeaderBlock' [] !ctx = encodeFinal ctx++----------------------------------------------------------------+-- A simple encoding strategy to reset the reference set first+-- by 'Index 0' and uses indexing as much as possible.++encodeStep :: (DL,Context) -> Header -> IO (DL,Context)+encodeStep (!dl,!ctx) h@(k,v) = do+ cache <- lookupHeader h ctx+ let e = toEntry h+ case cache of+ None -> do+ let dl' = dl << Literal Add (Lit k) v+ ctx' <- newEntry ctx e+ return (dl', ctx')+ KeyOnly InStaticTable i -> do+ let dl' = dl << Literal Add (Idx i) v+ ctx' <- newEntry ctx e+ return (dl', ctx')+ KeyOnly InHeaderTable i -> do+ let dl' = dl << Literal Add (Idx i) v+ ctx' <- newEntry ctx e+ return (dl', ctx')+ KeyValue InStaticTable i -> do+ let dl' = dl << Indexed i+ ctx' <- newEntry ctx e+ return (dl', ctx')+ KeyValue InHeaderTable i -> do+ let dl' = dl << Indexed i+ ctx' <- pushRef ctx i e+ return (dl', ctx')++encodeInit :: Context -> IO (DL, Context)+encodeInit ctx = do+ ctx' <- clearHeaderSet <$> clearRefSets ctx+ let initialHeaderBlock = initResult $ Indexed 0+ return (initialHeaderBlock, ctx')++encodeFinal :: (DL, Context) -> IO (HeaderBlock, Context)+encodeFinal (dl,ctx) = do+ !ctx' <- emitNotEmitted ctx+ let !hb = getResult dl+ return (hb, ctx')++----------------------------------------------------------------++type DL = HeaderBlock -> HeaderBlock++(<<) :: DL -> HeaderField -> DL+dl << entry = dl . (entry :)++initResult :: HeaderField -> DL+initResult hf = (hf :)++getResult :: DL -> HeaderBlock+getResult dl = dl []
+ Network/HPACK/Huffman.hs view
@@ -0,0 +1,14 @@+module Network.HPACK.Huffman (+ -- * Type+ HuffmanEncoding+ , HuffmanDecoding+ -- * Encoding/decoding+ , huffmanEncodeInRequest+ , huffmanDecodeInRequest+ , huffmanEncodeInResponse+ , huffmanDecodeInResponse+ ) where++import Network.HPACK.Huffman.Request+import Network.HPACK.Huffman.Response+import Network.HPACK.Huffman.Code
+ Network/HPACK/Huffman/Bit.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE BangPatterns #-}++module Network.HPACK.Huffman.Bit (+ B(..)+ , Bits+ , fromBits+ , toBits+ ) where++import Data.List (foldl')+import Data.Word (Word8)++-- | Data type for Bit.+data B = F -- ^ Zero+ | T -- ^ One+ deriving (Eq,Ord,Show)++fromBit :: B -> Word8+fromBit F = 0+fromBit T = 1++toBit :: Word8 -> B+toBit 0 = F+toBit 1 = T+toBit _ = error "toBit"++-- | Bit sequence.+type Bits = [B]++-- | From 'Bits' of length 8 to 'Word8'.+--+-- >>> fromBits [T,F,T,F,T,F,T,F]+-- 170+-- >>> fromBits [F,T,F,T,F,T,F,T]+-- 85+fromBits :: Bits -> Word8+fromBits = foldl' (\x y -> x * 2 + y) 0 . map fromBit++-- | From 'Word8' to 'Bits' of length 8.+--+-- >>> toBits 170+-- [T,F,T,F,T,F,T,F]+-- >>> toBits 85+-- [F,T,F,T,F,T,F,T]+toBits :: Word8 -> Bits+toBits = toBits' [] 0++toBits' :: Bits -> Int -> Word8 -> Bits+toBits' bs !cnt 0+ | cnt == 8 = bs+ | otherwise = replicate (8 - cnt) F ++ bs -- filling missing bits from MSB+toBits' bs !cnt x = toBits' (b:bs) (cnt + 1) q+ where+ q = x `div` 2+ r = x `mod` 2+ b = toBit r
+ Network/HPACK/Huffman/Code.hs view
@@ -0,0 +1,90 @@+module Network.HPACK.Huffman.Code (+ -- * Huffman encoding+ Encoder+ , toEncoder+ , HuffmanEncoding+ , encode+ -- * Huffman decoding+ , Decoder+ , toDecoder+ , HuffmanDecoding+ , decode+ ) where++import Control.Arrow (second)+import Data.Array (Array, (!), listArray)+import Data.List (partition)+import Data.Word (Word8)+import Network.HPACK.Huffman.Bit++----------------------------------------------------------------++-- | Huffman encoding.+type HuffmanEncoding = [Word8] -> [Word8]++-- | Huffman decoding.+type HuffmanDecoding = [Word8] -> [Word8]++----------------------------------------------------------------++-- | Type for Huffman encoding.+newtype Encoder = Encoder (Array Int Bits)++idxEos :: Int+idxEos = 256++enc :: Encoder -> Int -> Bits+enc (Encoder ary) i = ary ! i++-- | Creating 'Encoder'.+toEncoder :: [Bits] -> Encoder+toEncoder bs = Encoder $ listArray (0,idxEos) bs++-- | Huffman encoding.+encode :: Encoder -> HuffmanEncoding+encode encoder ws = map fromBits $ group8 bits+ where+ bits = concatMap (enc encoder . fromIntegral) ws+ group8 xs+ | null zs = eos ys : []+ | otherwise = ys : group8 zs+ where+ (ys,zs) = splitAt 8 xs+ eos xs+ | length xs == 8 = xs+ | otherwise = take 8 (xs ++ enc encoder idxEos)++----------------------------------------------------------------++-- | Type for Huffman decoding.+data Decoder = Tip Int | Bin Decoder Decoder deriving Show++dec :: Decoder -> Bits -> (Int,Bits)+dec (Tip i) xs = (i,xs)+dec (Bin l _) (F:xs) = dec l xs+dec (Bin _ r) (T:xs) = dec r xs+dec _ [] = (-1,[])++-- | Creating 'Decoder'.+toDecoder :: [Bits] -> Decoder+toDecoder decoder = build $ zip [0..idxEos] decoder++build :: [(Int,Bits)] -> Decoder+build [(i,[])] = Tip i+build xs = Bin (build fs) (build ts)+ where+ (fs',ts') = partition ((==) F . head . snd) xs+ fs = map (second tail) fs'+ ts = map (second tail) ts'++-- | Huffman decoding.+decode :: Decoder -> HuffmanDecoding+decode decoder ws = decodeBits decoder (concatMap toBits ws)++decodeBits :: Decoder -> Bits -> [Word8]+decodeBits _ [] = []+decodeBits decoder xs+ | i < 0 = []+ | otherwise = fromIntegral i : decodeBits decoder ys+ where+ (i,ys) = dec decoder xs
+ Network/HPACK/Huffman/Request.hs view
@@ -0,0 +1,288 @@+module Network.HPACK.Huffman.Request (+ huffmanEncodeInRequest+ , huffmanDecodeInRequest+ ) where++import Network.HPACK.Huffman.Bit+import Network.HPACK.Huffman.Code++----------------------------------------------------------------++encoderForRequest :: Encoder+encoderForRequest = toEncoder huffmanRequest++-- | Hoffman encoding in HTTP/2.0 request.+huffmanEncodeInRequest :: HuffmanEncoding+huffmanEncodeInRequest = encode encoderForRequest++----------------------------------------------------------------++decoderForRequest :: Decoder+decoderForRequest = toDecoder huffmanRequest++-- | Hoffman decoding in HTTP/2.0 request.+huffmanDecodeInRequest :: HuffmanDecoding+huffmanDecodeInRequest = decode decoderForRequest++----------------------------------------------------------------++huffmanRequest :: [Bits]+huffmanRequest = [+ [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,T]+ , [T,T,T,F,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,F,T]+ , [T,F,F,T,F,F]+ , [T,T,F,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,F]+ , [T,T,T,T,T,T,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,F,T,T]+ , [T,T,T,T,T,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,F,T,F,F,T]+ , [T,F,F,T,F,T]+ , [F,F,T,F,F]+ , [F,F,F,F]+ , [F,F,T,F,T]+ , [F,F,T,T,F]+ , [F,F,T,T,T]+ , [T,F,F,T,T,F]+ , [T,F,F,T,T,T]+ , [T,F,T,F,F,F]+ , [T,F,T,F,F,T]+ , [T,F,T,F,T,F]+ , [T,F,T,F,T,T]+ , [T,F,T,T,F,F]+ , [T,T,T,T,F,T,T,F,F]+ , [T,T,T,F,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F]+ , [T,F,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,F,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,F,T,T]+ , [T,T,F,T,T,T,T]+ , [T,T,T,F,T,F,T,T]+ , [T,T,T,F,T,T,F,F]+ , [T,T,T,F,T,T,F,T]+ , [T,T,T,F,T,T,T,F]+ , [T,T,T,F,F,F,F]+ , [T,T,T,T,F,T,T,T,F]+ , [T,T,T,T,F,T,T,T,T]+ , [T,T,T,T,T,F,F,F,F]+ , [T,T,T,T,T,F,F,F,T]+ , [T,T,T,T,T,T,T,F,T,T]+ , [T,T,T,T,T,F,F,T,F]+ , [T,T,T,F,T,T,T,T]+ , [T,T,T,T,T,F,F,T,T]+ , [T,T,T,T,T,F,T,F,F]+ , [T,T,T,T,T,F,T,F,T]+ , [T,T,T,T,T,F,T,T,F]+ , [T,T,T,T,T,F,T,T,T]+ , [T,T,T,T,F,F,F,F]+ , [T,T,T,T,F,F,F,T]+ , [T,T,T,T,T,T,F,F,F]+ , [T,T,T,T,T,T,F,F,T]+ , [T,T,T,T,T,T,F,T,F]+ , [T,T,T,T,T,T,F,T,T]+ , [T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,F,T]+ , [T,F,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F]+ , [F,T,F,F,F]+ , [T,F,T,T,T,T]+ , [F,T,F,F,T]+ , [T,T,F,F,F,F]+ , [F,F,F,T]+ , [T,T,F,F,F,T]+ , [T,T,F,F,T,F]+ , [T,T,F,F,T,T]+ , [F,T,F,T,F]+ , [T,T,T,F,F,F,T]+ , [T,T,T,F,F,T,F]+ , [F,T,F,T,T]+ , [T,T,F,T,F,F]+ , [F,T,T,F,F]+ , [F,T,T,F,T]+ , [F,T,T,T,F]+ , [T,T,T,T,F,F,T,F]+ , [F,T,T,T,T]+ , [T,F,F,F,F]+ , [T,F,F,F,T]+ , [T,T,F,T,F,T]+ , [T,T,T,F,F,T,T]+ , [T,T,F,T,T,F]+ , [T,T,T,T,F,F,T,T]+ , [T,T,T,T,F,T,F,F]+ , [T,T,T,T,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,F]+ ]
+ Network/HPACK/Huffman/Response.hs view
@@ -0,0 +1,288 @@+module Network.HPACK.Huffman.Response (+ huffmanEncodeInResponse+ , huffmanDecodeInResponse+ ) where++import Network.HPACK.Huffman.Bit+import Network.HPACK.Huffman.Code++----------------------------------------------------------------++encoderForResponse :: Encoder+encoderForResponse = toEncoder huffmanResponse++-- | Hoffman encoding in HTTP/2.0 request.+huffmanEncodeInResponse :: HuffmanEncoding+huffmanEncodeInResponse = encode encoderForResponse++----------------------------------------------------------------++decoderForResponse :: Decoder+decoderForResponse = toDecoder huffmanResponse++-- | Hoffman decoding in HTTP/2.0 request.+huffmanDecodeInResponse :: HuffmanDecoding+huffmanDecodeInResponse = decode decoderForResponse++----------------------------------------------------------------++huffmanResponse :: [Bits]+huffmanResponse = [+ [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,T]+ , [F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,F,T,F]+ , [T,T,F,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,F,T,T,F,F]+ , [T,T,T,T,T,T,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,F,T,T]+ , [T,T,T,T,F,T,T,F,T]+ , [T,T,T,T,F,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,F,T,T]+ , [T,T,T,T,T,T,T,T,F,T,F]+ , [T,F,F,F,T,F]+ , [T,F,F,F,T,T]+ , [T,F,F,T,F,F]+ , [T,T,F,T,F,T,T]+ , [F,F,F,T]+ , [F,F,T,F]+ , [F,F,T,T]+ , [F,T,F,F,F]+ , [F,T,F,F,T]+ , [F,T,F,T,F]+ , [T,F,F,T,F,T]+ , [T,F,F,T,T,F]+ , [F,T,F,T,T]+ , [F,T,T,F,F]+ , [F,T,T,F,T]+ , [T,T,T,T,F,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F]+ , [T,T,F,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T]+ , [T,T,F,T,T,F,T]+ , [T,T,T,F,T,F,T,F]+ , [T,T,T,F,T,F,T,T]+ , [T,T,T,F,T,T,F,F]+ , [T,T,T,F,T,T,F,T]+ , [T,T,T,F,T,T,T,F]+ , [T,F,F,T,T,T]+ , [T,T,T,T,T,F,F,F,F]+ , [T,T,T,F,T,T,T,T]+ , [T,T,T,T,F,F,F,F]+ , [T,T,T,T,T,T,T,F,F,T]+ , [T,T,T,T,T,F,F,F,T]+ , [T,F,T,F,F,F]+ , [T,T,T,T,F,F,F,T]+ , [T,T,T,T,F,F,T,F]+ , [T,T,T,T,T,F,F,T,F]+ , [T,T,T,T,T,T,T,F,T,F]+ , [T,T,T,T,T,F,F,T,T]+ , [T,F,T,F,F,T]+ , [F,T,T,T,F]+ , [T,T,T,T,T,F,T,F,F]+ , [T,T,T,T,T,F,T,F,T]+ , [T,T,T,T,F,F,T,T]+ , [T,T,T,T,T,T,T,F,T,T]+ , [T,T,T,T,T,F,T,T,F]+ , [T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,T,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F]+ , [F,T,T,T,T]+ , [T,T,F,T,T,T,F]+ , [T,F,T,F,T,F]+ , [T,F,T,F,T,T]+ , [T,F,F,F,F]+ , [T,T,F,T,T,T,T]+ , [T,T,T,F,F,F,F]+ , [T,T,T,F,F,F,T]+ , [T,F,T,T,F,F]+ , [T,T,T,T,T,T,F,F,F]+ , [T,T,T,T,T,T,F,F,T]+ , [T,T,T,F,F,T,F]+ , [T,F,T,T,F,T]+ , [T,F,T,T,T,F]+ , [T,F,T,T,T,T]+ , [T,T,F,F,F,F]+ , [T,T,T,T,T,T,F,T,F]+ , [T,T,F,F,F,T]+ , [T,T,F,F,T,F]+ , [T,T,F,F,T,T]+ , [T,T,F,T,F,F]+ , [T,T,T,F,F,T,T]+ , [T,T,T,T,F,T,F,F]+ , [T,T,T,F,T,F,F]+ , [T,T,T,T,F,T,F,T]+ , [T,T,T,T,T,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,T,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,F,T,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,F,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,F,T,T]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,F]+ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F,T]]+
+ Network/HPACK/Table.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE TupleSections #-}++module Network.HPACK.Table (+ -- * Header table+ HeaderTable+ , newHeaderTable+ , printHeaderTable+ -- * Insertion+ , insertEntry+ -- * Lookup+ , HeaderCache(..)+ , lookupTable+ -- * Entry+ , module Network.HPACK.Table.Entry+ -- * Which tables+ , WhichTable(..)+ , which+ ) where++import Control.Applicative ((<$>))+import Control.Exception (throwIO)+import Data.Array.IO (readArray)+import Network.HPACK.Table.Entry+import Network.HPACK.Table.Header+import Network.HPACK.Table.Static+import Network.HPACK.Types++----------------------------------------------------------------++data HeaderCache = None | KeyOnly WhichTable Index | KeyValue WhichTable Index++-- | Looking up the static table and the header table.+lookupTable :: Header -> HeaderTable -> IO HeaderCache+lookupTable h@(k,v) hdrtbl = do+ miv <- toIndexValue k hdrtbl+ case miv of+ Just (i,val)+ | val == v -> return $ KeyValue (whic i hdrtbl) i+ | otherwise -> return $ KeyOnly (whic i hdrtbl) i+ Nothing+ | isColon h -> do+ mi <- toStaticColonIndex h+ case mi of+ Just i -> return $ KeyValue InStaticTable (i + numOfEntries hdrtbl)+ Nothing -> return $ None+ | otherwise -> return $ None++whic :: Int -> HeaderTable -> WhichTable+whic i hdrtbl+ | i <= numOfEntries hdrtbl = InHeaderTable+ | otherwise = InStaticTable++----------------------------------------------------------------++-- | Which table does `Index` refer to?+data WhichTable = InHeaderTable | InStaticTable deriving Eq++----------------------------------------------------------------++-- | Which table does 'Index' belong to?+which :: HeaderTable -> Index -> IO (WhichTable, Entry)+which (HeaderTable maxN off n tbl _ _) idx+ | idx <= n = (InHeaderTable,) <$> readArray tbl pidx+ | 1 <= stcidx && stcidx <= stcsiz = return (InStaticTable, toStaticEntry stcidx)+ | otherwise = throwIO $ IndexOverrun idx+ where+ stcsiz = staticTableSize+ stcidx = idx - n+ pidx = (off + idx + maxN) `mod` maxN
+ Network/HPACK/Table/Entry.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE BangPatterns, OverloadedStrings #-}++module Network.HPACK.Table.Entry (+ -- * Type+ Size+ , Entry+ , Header -- re-exporting+ , HeaderName -- re-exporting+ , HeaderValue -- re-exporting+ , Index -- re-exporting+ -- * Header and Entry+ , toEntry+ , fromEntry+ -- * Getters+ , entrySize+ , entryHeaderName+ , entryHeaderValue+ -- * For initialization+ , dummyEntry+ , maxNumbers+ ) where++import qualified Data.ByteString as BS+import Network.HPACK.Types++----------------------------------------------------------------++-- | Size in bytes.+type Size = Int++-- | Type for table entry. Size includes the 32 bytes magic number.+type Entry = (Size,Header)++----------------------------------------------------------------++headerSizeMagicNumber :: Size+headerSizeMagicNumber = 32++headerSize :: Header -> Size+headerSize (k,v) = BS.length (fromHeaderName k)+ + BS.length v+ + headerSizeMagicNumber++----------------------------------------------------------------++-- | From 'Header' to 'Entry'.+toEntry :: Header -> Entry+toEntry h = (siz,h)+ where+ !siz = headerSize h++-- | From 'Entry' to 'Header'.+fromEntry :: Entry -> Header+fromEntry = snd++----------------------------------------------------------------++-- | Getting the size of 'Entry'.+entrySize :: Entry -> Size+entrySize = fst++-- | Getting 'HeaderName'.+entryHeaderName :: Entry -> HeaderName+entryHeaderName (_,(k,_)) = k++-- | Getting 'HeaderValue'.+entryHeaderValue :: Entry -> HeaderValue+entryHeaderValue (_,(_,v)) = v++----------------------------------------------------------------++-- | Dummy 'Entry' to initialize a table.+dummyEntry :: Entry+dummyEntry = (0,("dummy","dummy"))++maxNumbers :: Size -> Int+maxNumbers siz = siz `div` headerSizeMagicNumber
+ Network/HPACK/Table/Header.hs view
@@ -0,0 +1,136 @@+module Network.HPACK.Table.Header (+ -- * Type+ HeaderTable(..)+ , newHeaderTable+ , printHeaderTable+ -- * Utilities+ , insertEntry+ , toIndexValue+ ) where++import Data.Array.IO (IOArray, newArray, readArray, writeArray)+import qualified Data.ByteString.Char8 as BS+import Network.HPACK.Table.Entry+import Network.HPACK.Types++----------------------------------------------------------------++-- | Type for header table.+data HeaderTable = HeaderTable {+ maxNumOfEntries :: Int+ , offset :: Index+ , numOfEntries :: Int+ , circularTable :: !(IOArray Index Entry)+ , headerTableSize :: Size+ , maxHeaderTableSize :: Size+ }++----------------------------------------------------------------++-- | Printing 'HeaderTable'.+printHeaderTable :: HeaderTable -> IO ()+printHeaderTable (HeaderTable maxN off n tbl tblsiz _) = do+ es <- mapM (readArray tbl . adj maxN) [beg .. end]+ let ts = zip [1..] es+ mapM_ printEntry ts+ putStrLn $ " Table size: " ++ show tblsiz+ where+ beg = off + 1+ end = off + n++printEntry :: (Index,Entry) -> IO ()+printEntry (i,e) = do+ putStr "[ "+ putStr $ show i+ putStr "] (s = "+ putStr $ show $ entrySize e+ putStr ") "+ BS.putStr $ fromHeaderName $ entryHeaderName e+ putStr ": "+ BS.putStrLn $ entryHeaderValue e++----------------------------------------------------------------++-- | Creating 'HeaderTable'.+-- The default maxHeaderTableSize is 4096 bytes,+-- an array has 128 entries, resulting 1024 bytes in 64bit machine+newHeaderTable :: Size -> IO HeaderTable+newHeaderTable maxsiz = do+ tbl <- newArray (0,end) dummyEntry+ return HeaderTable {+ maxNumOfEntries = maxN+ , offset = end+ , numOfEntries = 0+ , circularTable = tbl+ , headerTableSize = 0+ , maxHeaderTableSize = maxsiz+ }+ where+ maxN = maxNumbers maxsiz+ end = maxN - 1++----------------------------------------------------------------++-- | Inserting 'Entry' to 'HeaderTable'.+-- New 'HeaderTable' and a set of dropped 'Index'+-- are returned.+insertEntry :: Entry -> HeaderTable -> IO (HeaderTable,[Index])+insertEntry e hdrtbl = insertOne e hdrtbl >>= adjustTableSize++insertOne :: Entry -> HeaderTable -> IO HeaderTable+insertOne e hdrtbl@(HeaderTable maxN off n tbl tsize _) = do+ writeArray tbl i e+ return $ hdrtbl {+ offset = off'+ , numOfEntries = n + 1+ , headerTableSize = tsize'+ }+ where+ i = off+ tsize' = tsize + entrySize e+ off' = adj maxN (off - 1)++adjustTableSize :: HeaderTable -> IO (HeaderTable, [Index])+adjustTableSize hdrtbl = adjust hdrtbl []++adjust :: HeaderTable -> [Index] -> IO (HeaderTable, [Index])+adjust hdrtbl is+ | tsize <= maxtsize = return (hdrtbl, is)+ | otherwise = do+ (hdrtbl', i) <- removeOne hdrtbl+ adjust hdrtbl' (i:is)+ where+ tsize = headerTableSize hdrtbl+ maxtsize = maxHeaderTableSize hdrtbl++removeOne :: HeaderTable -> IO (HeaderTable,Index)+removeOne hdrtbl@(HeaderTable maxN off n tbl tsize _) = do+ let i = adj maxN (off + n)+ e <- readArray tbl i+ writeArray tbl i dummyEntry -- let the entry GCed+ let tsize' = tsize - entrySize e+ let hdrtbl' = hdrtbl {+ numOfEntries = n - 1+ , headerTableSize = tsize'+ }+ return (hdrtbl',n)++----------------------------------------------------------------++toIndexValue :: HeaderName -> HeaderTable -> IO (Maybe (Index, HeaderValue))+toIndexValue k (HeaderTable maxN off n tbl _ _) = go 1+ where+ go i+ | i > n = return Nothing+ | otherwise = do+ let idx = adj maxN (off + i)+ e <- readArray tbl idx+ if entryHeaderName e == k then+ return $ Just (i, entryHeaderValue e)+ else+ go (i+1)++----------------------------------------------------------------++adj :: Int -> Int -> Int+adj maxN x = (x + maxN) `mod` maxN
+ Network/HPACK/Table/Static.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.HPACK.Table.Static (+ staticTableSize+ , toStaticEntry+ , toStaticIndex+ , toStaticColonIndex+ , isColon+ ) where++import Data.Array (Array, listArray, (!))+import Data.HashTable.IO (BasicHashTable)+import qualified Data.HashTable.IO as I+import Network.HPACK.Table.Entry+import Network.HPACK.Types+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.ByteString.Char8 as H++----------------------------------------------------------------++-- | The size of static table.+staticTableSize :: Size+staticTableSize = 60++-- | Get 'Entry' from the static table.+--+-- >>> toStaticEntry 8+-- (42,(":status","200"))+-- >>> toStaticEntry 49+-- (37,("range",""))+toStaticEntry :: Index -> Entry+toStaticEntry idx = staticTable ! idx++-- | Pre-defined static table.+staticTable :: Array Index Entry+staticTable = listArray (1,60) $ map toEntry staticTableList++----------------------------------------------------------------++-- | Get 'Index' from the static table.+--+-- >>> toStaticIndex ":status"+-- Just 13+-- >>> toStaticIndex "date"+-- Just 32+-- >>> toStaticIndex "user-agent"+-- Just 57+toStaticIndex :: HeaderName -> IO (Maybe Index)+toStaticIndex k = I.lookup staticHashTable k++staticHashTable :: BasicHashTable HeaderName Index+staticHashTable = unsafePerformIO $ I.fromList alist+ where+ alist = zip (map fst staticTableList) [1 ..]++----------------------------------------------------------------++-- | Get 'Index' from the static table.+-- Only colon headers.+--+-- >>> toStaticColonIndex (":path","/index.html")+-- Just 5+-- >>> toStaticColonIndex (":status","200")+-- Just 8+toStaticColonIndex :: Header -> IO (Maybe Index)+toStaticColonIndex h = I.lookup staticColonHashTable h++staticColonHashTable :: BasicHashTable Header Index+staticColonHashTable = unsafePerformIO $ I.fromList alist+ where+ alist = zip staticColonHeaderList [1 ..]++----------------------------------------------------------------++staticColonHeaderList :: [Header]++staticColonHeaderList = takeWhile isColon staticTableList++-- | Checking if 'HeaderName' starts with colon.+isColon :: Header -> Bool+isColon h = H.head (fromHeaderName (fst h)) == ':'++----------------------------------------------------------------++staticTableList :: [Header]+staticTableList = [+ (":authority","")+ , (":method","GET")+ , (":method","POST")+ , (":path","/")+ , (":path","/index.html")+ , (":scheme","http")+ , (":scheme","https")+ , (":status","200")+ , (":status","500")+ , (":status","404")+ , (":status","403")+ , (":status","400")+ , (":status","401")+ , ("accept-charset","")+ , ("accept-encoding","")+ , ("accept-language","")+ , ("accept-ranges","")+ , ("accept","")+ , ("access-control-allow-origin","")+ , ("age","")+ , ("allow","")+ , ("authorization","")+ , ("cache-control","")+ , ("content-disposition","")+ , ("content-encoding","")+ , ("content-language","")+ , ("content-length","")+ , ("content-location","")+ , ("content-range","")+ , ("content-type","")+ , ("cookie","")+ , ("date","")+ , ("etag","")+ , ("expect","")+ , ("expires","")+ , ("from","")+ , ("host","")+ , ("if-match","")+ , ("if-modified-since","")+ , ("if-none-match","")+ , ("if-range","")+ , ("if-unmodified-since","")+ , ("last-modified","")+ , ("link","")+ , ("location","")+ , ("max-forwards","")+ , ("proxy-authenticate","")+ , ("proxy-authorization","")+ , ("range","")+ , ("referer","")+ , ("refresh","")+ , ("retry-after","")+ , ("server","")+ , ("set-cookie","")+ , ("strict-transport-security","")+ , ("transfer-encoding","")+ , ("user-agent","")+ , ("vary","")+ , ("via","")+ , ("www-authenticate","")+ ]
+ Network/HPACK/Types.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Network.HPACK.Types (+ -- * Header+ HeaderName+ , HeaderValue+ , HeaderStuff+ , fromHeaderName+ , toHeaderName+ , Header+ -- * Misc+ , ByteStream+ , Index+ , DecodeError(..)+ ) where++import Control.Exception as E+import Data.ByteString (ByteString)+import Data.CaseInsensitive (foldedCase, mk)+import Data.Typeable+import Network.HTTP.Types (HeaderName, Header)++-- | Header value.+type HeaderValue = ByteString++-- | To be a 'HeaderName' or 'HeaderValue'.+type HeaderStuff = ByteString++-- | Converting 'HeaderName' to 'HeaderStuff'.+fromHeaderName :: HeaderName -> HeaderStuff+fromHeaderName = foldedCase++-- | Converting 'HeaderStuff' to 'HeaderName'.+toHeaderName :: HeaderStuff -> HeaderName+toHeaderName = mk++-- | Byte stream in HTTP request/response.+type ByteStream = ByteString++-- | Index for table.+type Index = Int++-- | Errors for decoder.+data DecodeError = IndexOverrun Index -- ^ Index is out of range+ deriving (Show,Typeable)++instance Exception DecodeError
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ http2.cabal view
@@ -0,0 +1,78 @@+Name: http2+Version: 0.0.0+Author: Kazu Yamamoto <kazu@iij.ad.jp>+Maintainer: Kazu Yamamoto <kazu@iij.ad.jp>+License: BSD3+License-File: LICENSE+Synopsis: HTTP/2.0 library including HPACK+Description: HTTP/2.0 library including HPACK.+ Currently only HPACK 06 is supported.+Category: Network+Cabal-Version: >= 1.10+Build-Type: Simple++Library+ Default-Language: Haskell2010+ GHC-Options: -Wall+ Exposed-Modules: Network.HPACK+ Network.HPACK.Context+ Network.HPACK.Context.HeaderSet+ Network.HPACK.Context.ReferenceSet+ Network.HPACK.Huffman+ Network.HPACK.Huffman.Bit+ Network.HPACK.Huffman.Code+ Network.HPACK.Huffman.Request+ Network.HPACK.Huffman.Response+ Network.HPACK.HeaderBlock+ Network.HPACK.HeaderBlock.Decode+ Network.HPACK.HeaderBlock.Encode+ Network.HPACK.HeaderBlock.From+ Network.HPACK.HeaderBlock.HeaderField+ Network.HPACK.HeaderBlock.Integer+ Network.HPACK.HeaderBlock.String+ Network.HPACK.HeaderBlock.To+ Network.HPACK.Table+ Network.HPACK.Table.Entry+ Network.HPACK.Table.Header+ Network.HPACK.Table.Static+ Network.HPACK.Types+ Build-Depends: base >= 4 && < 5+ , array+ , blaze-builder+ , bytestring+ , case-insensitive+ , hashtables+ , http-types++Test-Suite doctest+ Type: exitcode-stdio-1.0+ Default-Language: Haskell2010+ HS-Source-Dirs: test+ Ghc-Options: -Wall+ Main-Is: doctests.hs+ Build-Depends: base+ , doctest >= 0.9.3++Test-Suite spec+ Type: exitcode-stdio-1.0+ Default-Language: Haskell2010+ HS-Source-Dirs: test+ Ghc-Options: -Wall+ Main-Is: Spec.hs+ Other-Modules: BitSpec+ DecodeSpec+ HeaderBlockSpec+ HuffmanRequestSpec+ HuffmanResponseSpec+ IntegerSpec+ HeaderBlock+ HexString+ Build-Depends: base+ , bytestring+ , http2+ , hspec >= 1.3++Source-Repository head+ Type: git+ Location: git://github.com/kazu-yamamoto/http2+
+ test/BitSpec.hs view
@@ -0,0 +1,12 @@+module BitSpec where++import Network.HPACK.Huffman.Bit+import Test.Hspec+import Test.Hspec.QuickCheck++spec :: Spec+spec = do+ describe "toBits and fromBits" $ do+ prop "duality" $ \n ->+ let i = fromIntegral $ abs (n :: Int) `mod` 256+ in fromBits (toBits i) == i
+ test/DecodeSpec.hs view
@@ -0,0 +1,25 @@+module DecodeSpec where++import Network.HPACK.Context+import Network.HPACK.HeaderBlock+import Test.Hspec++import HeaderBlock++spec :: Spec+spec = do+ describe "fromHeaderBlock" $ do+ it "decodes HeaderSet in request" $ do+ (h1,c1) <- newContext 4096 >>= fromHeaderBlock e31+ h1 `shouldBe` e31h+ (h2,c2) <- fromHeaderBlock e32 c1+ h2 `shouldBe` e32h+ (h3,_) <- fromHeaderBlock e33 c2+ h3 `shouldBe` e33h+ it "decodes HeaderSet in response" $ do+ (h1,c1) <- newContext 256 >>= fromHeaderBlock e51+ h1 `shouldBe` e51h+ (h2,c2) <- fromHeaderBlock e52 c1+ h2 `shouldBe` e52h+ (h3,_) <- fromHeaderBlock e53 c2+ h3 `shouldBe` e53h
+ test/HeaderBlock.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE OverloadedStrings #-}++module HeaderBlock where++import qualified Data.ByteString as BS+import Network.HPACK.Context+import Network.HPACK.HeaderBlock+import Network.HPACK.Types++import HexString++----------------------------------------------------------------++e31 :: HeaderBlock+e31 = [+ Indexed 2+ , Indexed 7+ , Indexed 6+ , Literal Add (Idx 4) "www.example.com"+ ]++e31h :: HeaderSet+e31h = [(":method","GET")+ ,(":scheme","http")+ ,(":path","/")+ ,(":authority","www.example.com")+ ]++e31b :: ByteStream+e31b = BS.pack $ fromHexString "828786048bdb6d883e68d1cb1225ba7f"++e32 :: HeaderBlock+e32 = [+ Literal Add (Idx 27) "no-cache"+ ]++e32h :: HeaderSet+e32h = [("cache-control","no-cache")+ ,(":method","GET")+ ,(":scheme","http")+ ,(":path","/")+ ,(":authority","www.example.com")]++e32b :: ByteStream+e32b = BS.pack $ fromHexString "1b8663654a1398ff"++e33 :: HeaderBlock+e33 = [+ Indexed 0+ , Indexed 5+ , Indexed 12+ , Indexed 11+ , Indexed 4+ , Literal Add (Lit "custom-key") "custom-value"+ ]++e33h :: HeaderSet+e33h = [(":method","GET")+ ,(":scheme","https")+ ,(":path","/index.html")+ ,(":authority","www.example.com")+ ,("custom-key","custom-value")+ ]++e33b :: ByteStream+e33b = BS.pack $ fromHexString "80858c8b8400884eb08b749790fa7f894eb08b74979a17a8ff"++----------------------------------------------------------------++e51 :: HeaderBlock+e51 = [+ Literal Add (Idx 8) "302"+ , Literal Add (Idx 24) "private"+ , Literal Add (Idx 34) "Mon, 21 Oct 2013 20:13:21 GMT"+ , Literal Add (Idx 48) "https://www.example.com"+ ]++e51h :: HeaderSet+e51h = [(":status","302")+ ,("cache-control","private")+ ,("date","Mon, 21 Oct 2013 20:13:21 GMT")+ ,("location","https://www.example.com")+ ]++e51b :: ByteStream+e51b = BS.pack $ fromHexString "0882409f1886c31b39bf387f2292a2fba20320f2ab303124018b490d3209e8773093e39e7864dd7afd3d3d248747db87284955f6ff"++e52 :: HeaderBlock+e52 = [+ Indexed 4+ , Indexed 12+ ]++e52h :: HeaderSet+e52h = [(":status","200")+ ,("cache-control","private")+ ,("date","Mon, 21 Oct 2013 20:13:21 GMT")+ ,("location","https://www.example.com")+ ]++e52b :: ByteStream+e52b = BS.pack $ fromHexString "848c"++e53 :: HeaderBlock+e53 = [+ Indexed 3+ , Indexed 4+ , Indexed 4+ , Literal Add (Idx 3) "Mon, 21 Oct 2013 20:13:22 GMT"+ , Literal Add (Idx 29) "gzip"+ , Indexed 4+ , Indexed 4+ , Indexed 3+ , Indexed 3+ , Literal Add (Idx 58) "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1"+ ]++e53h :: HeaderSet+e53h = [("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")]++e53b :: ByteStream+e53b = BS.pack $ fromHexString "8384840392a2fba20320f2ab303124018b490d3309e8771d84e1fbb30f848483833ab3df7dfb36d3d9e1fcfc3fafe7abfcfefcbfaf3edf2f977fd36ff7fd79f6f977fd3de16bfa46fe10d889447de1ce18e565f76c2f"
+ test/HeaderBlockSpec.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++module HeaderBlockSpec where++import qualified Data.ByteString.Char8 as BS+import Network.HPACK.HeaderBlock+import Network.HPACK.Huffman+import Network.HPACK.Types+import Test.Hspec+import Test.Hspec.QuickCheck++import HeaderBlock++spec :: Spec+spec = do+ describe "toByteStream" $ do+ it "encodes HeaderBlock" $ do+ toByteStream huffmanEncodeInRequest e31 `shouldBe` e31b+ toByteStream huffmanEncodeInRequest e32 `shouldBe` e32b+ toByteStream huffmanEncodeInRequest e33 `shouldBe` e33b+ toByteStream huffmanEncodeInResponse e51 `shouldBe` e51b+ toByteStream huffmanEncodeInResponse e52 `shouldBe` e52b+ toByteStream huffmanEncodeInResponse e53 `shouldBe` e53b++ describe "fromByteStream" $ do+ it "encodes HeaderBlock" $ do+ fromByteStream huffmanDecodeInRequest e31b `shouldBe` e31+ fromByteStream huffmanDecodeInRequest e32b `shouldBe` e32+ fromByteStream huffmanDecodeInRequest e33b `shouldBe` e33+ fromByteStream huffmanDecodeInResponse e51b `shouldBe` e51+ fromByteStream huffmanDecodeInResponse e52b `shouldBe` e52+ fromByteStream huffmanDecodeInResponse e53b `shouldBe` e53+ describe "toByteStream & fromByteStream" $ do+ prop "duality for request" $ \k v -> do+ putStrLn $ "K length" ++ show (length k)+ putStrLn $ "V length" ++ show (length v)+ let key = toHeaderName $ BS.pack ('k':k)+ val = BS.pack ('v':v)+ hb = [Literal Add (Lit key) val]+ fromByteStream huffmanDecodeInRequest+ (toByteStream huffmanEncodeInRequest hb) `shouldBe` hb+ prop "duality for response" $ \v -> do+ let val = BS.pack ('v':v)+ hb = [Literal Add (Idx 3) val]+ fromByteStream huffmanDecodeInResponse+ (toByteStream huffmanEncodeInResponse hb) `shouldBe` hb
+ test/HexString.hs view
@@ -0,0 +1,17 @@+module HexString where++import Numeric+import Text.Printf+import Data.Word (Word8)++fromHexString :: String -> [Word8]+fromHexString = map fromHex . group2+ where+ fromHex = fst . head . readHex+ group2 [] = []+ group2 xs = ys : group2 zs+ where+ (ys,zs) = splitAt 2 xs++toHexString :: [Word8] -> String+toHexString = concatMap (printf "%02x")
+ test/HuffmanRequestSpec.hs view
@@ -0,0 +1,39 @@+module HuffmanRequestSpec where++import Data.Char+import Network.HPACK.Huffman.Request+import Test.Hspec+import Test.Hspec.QuickCheck++import HexString++shouldBeEncoded :: String -> String -> Expectation+shouldBeEncoded inp out = enc inp `shouldBe` out+ where+ enc = toHexString . huffmanEncodeInRequest . toW+ toW = map (fromIntegral . ord)++shouldBeDecoded :: String -> String -> Expectation+shouldBeDecoded inp out = dec inp `shouldBe` out+ where+ dec = toS . huffmanDecodeInRequest . fromHexString+ toS = map (chr . fromIntegral)++spec :: Spec+spec = do+ describe "huffmanEncodeInRequest and huffmanDecodeInRequest" $ do+ prop "duality" $ \ns ->+ let is = map ((`mod` 255) . abs) ns+ in huffmanDecodeInRequest (huffmanEncodeInRequest is) == is+ describe "huffmanEncodeInRequest" $ do+ it "encodes in request" $ do+ "www.example.com" `shouldBeEncoded` "db6d883e68d1cb1225ba7f"+ "no-cache" `shouldBeEncoded` "63654a1398ff"+ "custom-key" `shouldBeEncoded` "4eb08b749790fa7f"+ "custom-value" `shouldBeEncoded` "4eb08b74979a17a8ff"+ describe "huffmanDecodeInRequest" $ do+ it "decodes in request" $ do+ "db6d883e68d1cb1225ba7f" `shouldBeDecoded` "www.example.com"+ "63654a1398ff" `shouldBeDecoded` "no-cache"+ "4eb08b749790fa7f" `shouldBeDecoded` "custom-key"+ "4eb08b74979a17a8ff" `shouldBeDecoded` "custom-value"
+ test/HuffmanResponseSpec.hs view
@@ -0,0 +1,43 @@+module HuffmanResponseSpec where++import Data.Char+import Network.HPACK.Huffman.Response+import Test.Hspec+import Test.Hspec.QuickCheck++import HexString++shouldBeEncoded :: String -> String -> Expectation+shouldBeEncoded inp out = enc inp `shouldBe` out+ where+ enc = toHexString . huffmanEncodeInResponse . toW+ toW = map (fromIntegral . ord)++shouldBeDecoded :: String -> String -> Expectation+shouldBeDecoded inp out = dec inp `shouldBe` out+ where+ dec = toS . huffmanDecodeInResponse . fromHexString+ toS = map (chr . fromIntegral)++spec :: Spec+spec = do+ describe "huffmanEncodeInResponse and huffmanDecodeInResponse" $ do+ prop "duality" $ \ns ->+ let is = map ((`mod` 255) . abs) ns+ in huffmanDecodeInResponse (huffmanEncodeInResponse is) == is+ describe "huffmanEncodeInResponse" $ do+ it "encodes in response" $ do+ "private" `shouldBeEncoded` "c31b39bf387f"+ "Mon, 21 Oct 2013 20:13:21 GMT" `shouldBeEncoded` "a2fba20320f2ab303124018b490d3209e877"+ "https://www.example.com" `shouldBeEncoded` "e39e7864dd7afd3d3d248747db87284955f6ff"+ "Mon, 21 Oct 2013 20:13:22 GMT" `shouldBeEncoded` "a2fba20320f2ab303124018b490d3309e877"+ "gzip" `shouldBeEncoded` "e1fbb30f"+ "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" `shouldBeEncoded` "df7dfb36d3d9e1fcfc3fafe7abfcfefcbfaf3edf2f977fd36ff7fd79f6f977fd3de16bfa46fe10d889447de1ce18e565f76c2f"+ describe "huffmanDecodeInResponse" $ do+ it "decodes in response" $ do+ "c31b39bf387f" `shouldBeDecoded` "private"+ "a2fba20320f2ab303124018b490d3209e877"`shouldBeDecoded` "Mon, 21 Oct 2013 20:13:21 GMT"+ "e39e7864dd7afd3d3d248747db87284955f6ff" `shouldBeDecoded` "https://www.example.com"+ "a2fba20320f2ab303124018b490d3309e877" `shouldBeDecoded` "Mon, 21 Oct 2013 20:13:22 GMT"+ "e1fbb30f" `shouldBeDecoded` "gzip"+ "df7dfb36d3d9e1fcfc3fafe7abfcfefcbfaf3edf2f977fd36ff7fd79f6f977fd3de16bfa46fe10d889447de1ce18e565f76c2f" `shouldBeDecoded` "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1"
+ test/IntegerSpec.hs view
@@ -0,0 +1,22 @@+module IntegerSpec where++import Network.HPACK.HeaderBlock.Integer+import Test.Hspec+import Test.Hspec.QuickCheck++dual :: Int -> Int -> Bool+dual n i = decode n (encode n x) == x+ where+ x = abs i++spec :: Spec+spec = do+ describe "encode and decode" $ do+ prop "duality" $ dual 1+ prop "duality" $ dual 2+ prop "duality" $ dual 3+ prop "duality" $ dual 4+ prop "duality" $ dual 5+ prop "duality" $ dual 6+ prop "duality" $ dual 7+ prop "duality" $ dual 8
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/doctests.hs view
@@ -0,0 +1,9 @@+module Main where++import Test.DocTest++main :: IO ()+main = doctest [+ "-XOverloadedStrings"+ , "Network/HPACK.hs"+ ]