http2 1.4.0 → 1.4.1
raw patch · 7 files changed
+105/−143 lines, 7 files
Files
- ChangeLog.md +4/−0
- Network/HPACK/Table.hs +18/−20
- Network/HPACK/Table/DoubleHashMap.hs +0/−69
- Network/HPACK/Table/Dynamic.hs +26/−37
- Network/HPACK/Table/RevIndex.hs +40/−0
- Network/HPACK/Table/Static.hs +15/−15
- http2.cabal +2/−2
ChangeLog.md view
@@ -1,3 +1,7 @@+## 1.4.1++* The reverse indices for static and dynamic are combined for performance.+ ## 1.4.0 * Providing dequeueSTM, isEmpty and isEmptySTM. Users can compose
Network/HPACK/Table.hs view
@@ -29,9 +29,10 @@ import Control.Applicative ((<$>)) #endif import Control.Exception (throwIO)+import qualified Data.Map as M import Network.HPACK.Table.Dynamic import Network.HPACK.Table.Entry-import qualified Network.HPACK.Table.DoubleHashMap as DHM+import Network.HPACK.Table.RevIndex import Network.HPACK.Table.Static import Network.HPACK.Types @@ -51,26 +52,23 @@ -- | Resolving an index from a header. -- Static table is prefer to dynamic table. lookupTable :: Header -> DynamicTable -> HeaderCache-lookupTable h dyntbl = case reverseIndex dyntbl of- Nothing -> None- Just rev -> case DHM.search h rev of- DHM.N -> case mstatic of- DHM.N -> None- DHM.K sidx -> KeyOnly InStaticTable (fromSIndexToIndex dyntbl sidx)- DHM.KV sidx -> KeyValue InStaticTable (fromSIndexToIndex dyntbl sidx)- DHM.K hidx -> case mstatic of- DHM.N -> KeyOnly InDynamicTable (fromHIndexToIndex dyntbl hidx)- DHM.K sidx -> KeyOnly InStaticTable (fromSIndexToIndex dyntbl sidx)- DHM.KV sidx -> KeyValue InStaticTable (fromSIndexToIndex dyntbl sidx)- DHM.KV hidx -> case mstatic of- DHM.N -> KeyValue InDynamicTable (fromHIndexToIndex dyntbl hidx)- DHM.K _ -> KeyValue InDynamicTable (fromHIndexToIndex dyntbl hidx)- DHM.KV sidx -> KeyValue InStaticTable (fromSIndexToIndex dyntbl sidx)- where- mstatic = DHM.search h staticHashMap+lookupTable (k,v) dyntbl = case reverseIndex dyntbl of+ Nothing -> None+ Just (Outer rev) -> case M.lookup k rev of+ Nothing -> None+ Just (Inner ss ds) -> case lookup v ss of+ Just sidx -> KeyValue InStaticTable $ fromSIndexToIndex sidx+ Nothing -> case lookup v ds of+ Just didx -> KeyValue InDynamicTable $ fromDIndexToIndex dyntbl didx+ Nothing -> case ss of+ ((_,sidx):_) -> KeyOnly InStaticTable $ fromSIndexToIndex sidx+ [] -> case ds of+ ((_,didx):_) -> KeyOnly InDynamicTable $ fromDIndexToIndex dyntbl didx+ _ -> error "search" ---------------------------------------------------------------- +{-# INLINE isIn #-} isIn :: Int -> DynamicTable -> Bool isIn idx DynamicTable{..} = idx > staticTableSize @@ -81,5 +79,5 @@ | isSIndexValid sidx = return (InStaticTable, toStaticEntry sidx) | otherwise = throwIO $ IndexOverrun idx where- hidx = fromIndexToHIndex dyntbl idx- sidx = fromIndexToSIndex dyntbl idx+ hidx = fromIndexToDIndex dyntbl idx+ sidx = fromIndexToSIndex idx
− Network/HPACK/Table/DoubleHashMap.hs
@@ -1,69 +0,0 @@-{-# LANGUAGE BangPatterns #-}--module Network.HPACK.Table.DoubleHashMap (- DoubleHashMap- , empty- , insert- , delete- , fromList- , deleteList- , Res(..)- , search- ) where--import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as H-import Data.List (foldl')-import Network.HPACK.Types--newtype DoubleHashMap a =- DoubleHashMap (HashMap HeaderName (HashMap HeaderValue a)) deriving Show--empty :: DoubleHashMap a-empty = DoubleHashMap H.empty--insert :: Ord a => Header -> a -> DoubleHashMap a -> DoubleHashMap a-insert (k,v) p (DoubleHashMap m) = case H.lookup k m of- Nothing -> let inner = H.singleton v p- in DoubleHashMap $ H.insert k inner m- Just inner -> let inner' = H.insert v p inner- in DoubleHashMap $ H.adjust (const inner') k m--delete :: Ord a => Header -> DoubleHashMap a -> DoubleHashMap a-delete (k,v) dhm@(DoubleHashMap outer) = case H.lookup k outer of- Nothing -> dhm -- Non-smart implementation makes duplicate keys.- -- It is likely to happen to delete the same key- -- in multiple times.- Just inner -> case H.lookup v inner of- Nothing -> dhm -- see above- _ -> delete' inner- where- delete' inner- | H.null inner' = DoubleHashMap $ H.delete k outer- | otherwise = DoubleHashMap $ H.adjust (const inner') k outer- where- inner' = H.delete v inner--fromList :: Ord a => [(a,Header)] -> DoubleHashMap a-fromList alist = hashinner- where- ins !hp (!a,!dhm) = insert dhm a hp- !hashinner = foldl' ins empty alist--deleteList :: Ord a => [Header] -> DoubleHashMap a -> DoubleHashMap a-deleteList hs hp = foldl' (flip delete) hp hs--data Res a = N | K !a | KV !a--search :: Ord a => Header -> DoubleHashMap a -> Res a-search (k,v) (DoubleHashMap outer) = case H.lookup k outer of- Nothing -> N- Just inner -> case H.lookup v inner of- Nothing -> case top inner of- Nothing -> error "DoubleHashMap.search"- Just a -> K a- Just a -> KV a---- | Take an arbitrary entry. O(1) thanks to lazy evaluation.-top :: HashMap k v -> Maybe v-top = H.foldr (\v _ -> Just v) Nothing
Network/HPACK/Table/Dynamic.hs view
@@ -14,22 +14,34 @@ , resetLimitForEncoding , insertEntry , toHeaderEntry- , fromHIndexToIndex- , fromIndexToHIndex- , fromSIndexToIndex- , fromIndexToSIndex+ , fromDIndexToIndex+ , fromIndexToDIndex ) where import Control.Monad (forM) import Data.Array.IO (IOArray, newArray, readArray, writeArray) import qualified Data.ByteString.Char8 as BS import Data.IORef-import qualified Network.HPACK.Table.DoubleHashMap as DHM import Network.HPACK.Table.Entry+import Network.HPACK.Table.RevIndex import Network.HPACK.Table.Static ---------------------------------------------------------------- +{-# INLINE fromDIndexToIndex #-}+fromDIndexToIndex :: DynamicTable -> DIndex -> Index+fromDIndexToIndex DynamicTable{..} (DIndex didx) = idx+ where+ idx = adj maxNumOfEntries (didx - offset) + staticTableSize++{-# INLINE fromIndexToDIndex #-}+fromIndexToDIndex :: DynamicTable -> Index -> DIndex+fromIndexToDIndex DynamicTable{..} idx = DIndex didx+ where+ didx = adj maxNumOfEntries (idx + offset - staticTableSize)++----------------------------------------------------------------+ type Table = IOArray Index Entry {-@@ -74,7 +86,7 @@ -- | Header to the index in Dynamic Table for encoder. -- Static Table is not included. -- Nothing for decoder.- , reverseIndex :: !(Maybe (DHM.DoubleHashMap HIndex))+ , reverseIndex :: !(Maybe Outer) } adj :: Int -> Int -> Int@@ -139,38 +151,15 @@ ---------------------------------------------------------------- --- Physical array index for Dynamic Table.-newtype HIndex = HIndex Int deriving (Eq, Ord, Show)--------------------------------------------------------------------fromHIndexToIndex :: DynamicTable -> HIndex -> Index-fromHIndexToIndex DynamicTable{..} (HIndex hidx) = idx- where- idx = adj maxNumOfEntries (hidx - offset) + staticTableSize--fromIndexToHIndex :: DynamicTable -> Index -> HIndex-fromIndexToHIndex DynamicTable{..} idx = HIndex hidx- where- hidx = adj maxNumOfEntries (idx + offset - staticTableSize)--fromSIndexToIndex :: DynamicTable -> SIndex -> Index-fromSIndexToIndex _ sidx = fromStaticIndex sidx--fromIndexToSIndex :: DynamicTable -> Index -> SIndex-fromIndexToSIndex _ idx = toStaticIndex idx------------------------------------------------------------------- -- | Creating 'DynamicTable'. newDynamicTableForEncoding :: Size -> IO DynamicTable-newDynamicTableForEncoding maxsiz = newDynamicTable maxsiz maxsiz (Just DHM.empty)+newDynamicTableForEncoding maxsiz = newDynamicTable maxsiz maxsiz (Just defaultRevIndex) -- | Creating 'DynamicTable'. newDynamicTableForDecoding :: Size -> IO DynamicTable newDynamicTableForDecoding maxsiz = newDynamicTable maxsiz maxsiz Nothing -newDynamicTable :: Size -> Size -> Maybe (DHM.DoubleHashMap HIndex) -> IO DynamicTable+newDynamicTable :: Size -> Size -> Maybe Outer -> IO DynamicTable newDynamicTable maxsiz dlim mhp = do tbl <- newArray (0,end) dummyEntry lim <- newIORef Nothing@@ -197,7 +186,7 @@ dlim = limitForDecoding olddyntbl mhp = case reverseIndex olddyntbl of Nothing -> Nothing- _ -> Just DHM.empty+ _ -> Just defaultRevIndex renewDynamicTable _ olddyntbl = return olddyntbl copyTable :: DynamicTable -> DynamicTable -> IO DynamicTable@@ -231,7 +220,7 @@ (dyntbl', hs) <- insertFront e dyntbl >>= adjustTableSize let dyntbl'' = case reverseIndex dyntbl' of Nothing -> dyntbl'- Just rev -> dyntbl' { reverseIndex = Just (DHM.deleteList hs rev) }+ Just rev -> dyntbl' { reverseIndex = Just (deleteDynamicList hs rev) } return dyntbl'' insertFront :: Entry -> DynamicTable -> IO DynamicTable@@ -249,7 +238,7 @@ offset' = adj maxNumOfEntries (offset - 1) reverseIndex' = case reverseIndex of Nothing -> Nothing- Just rev -> Just $ DHM.insert (entryHeader e) (HIndex i) rev+ Just rev -> Just $ insertDynamic (entryHeader e) (DIndex i) rev adjustTableSize :: DynamicTable -> IO (DynamicTable, [Header]) adjustTableSize dyntbl = adjust dyntbl []@@ -276,7 +265,7 @@ headerTableSize' = headerTableSize + entrySize e reverseIndex' = case reverseIndex of Nothing -> Nothing- Just rev -> Just $ DHM.insert (entryHeader e) (HIndex i) rev+ Just rev -> Just $ insertDynamic (entryHeader e) (DIndex i) rev ---------------------------------------------------------------- @@ -295,5 +284,5 @@ ---------------------------------------------------------------- -toHeaderEntry :: DynamicTable -> HIndex -> IO Entry-toHeaderEntry DynamicTable{..} (HIndex hidx) = readArray circularTable hidx+toHeaderEntry :: DynamicTable -> DIndex -> IO Entry+toHeaderEntry DynamicTable{..} (DIndex didx) = readArray circularTable didx
+ Network/HPACK/Table/RevIndex.hs view
@@ -0,0 +1,40 @@+module Network.HPACK.Table.RevIndex where++import Data.Map (Map)+import qualified Data.Map as M+import Network.HPACK.Types+import Network.HPACK.Table.Static++-- Physical array index for Dynamic Table.+-- Defining here due to dependency, sigh.+newtype DIndex = DIndex Int deriving (Eq, Ord, Show)++data Inner = Inner [(HeaderValue, SIndex)] [(HeaderValue, DIndex)] deriving Show++newtype Outer = Outer (Map HeaderName Inner) deriving Show++defaultRevIndex :: Outer+defaultRevIndex = Outer $ foldr op M.empty lst+ where+ lst = zip staticTableList $ map SIndex [1..]+ op ((k,v),i) m = M.alter f k m+ where+ f Nothing = Just $ Inner [(v,i)] []+ f (Just (Inner ss ds)) = Just $ Inner ((v,i):ss) ds++insertDynamic :: Header -> DIndex -> Outer -> Outer+insertDynamic (k,v) didx (Outer rev) = Outer $ M.alter f k rev+ where+ f Nothing = Just $ Inner [] [(v,didx)]+ f (Just (Inner ss ds)) = Just $ Inner ss ((v,didx):ds)++deleteDynamic :: Header -> Map HeaderName Inner -> Map HeaderName Inner+deleteDynamic (k,v) rev = M.alter f k rev+ where+ f Nothing = Nothing+ f (Just (Inner ss ds)) = case filter (\(a,_) -> a /= v) ds of+ [] -> Nothing+ ds' -> Just $ Inner ss ds'++deleteDynamicList :: [Header] -> Outer -> Outer+deleteDynamicList hs (Outer rev) = Outer $ foldr deleteDynamic rev hs
Network/HPACK/Table/Static.hs view
@@ -2,28 +2,33 @@ module Network.HPACK.Table.Static ( SIndex(..)- , fromStaticIndex- , toStaticIndex+ , fromSIndexToIndex+ , fromIndexToSIndex , isSIndexValid , toStaticEntry- , staticHashMap- , staticTableSize -- fixme+ , staticTableSize+ , staticTableList ) where import Data.Array (Array, listArray, (!)) import Network.HPACK.Table.Entry-import qualified Network.HPACK.Table.DoubleHashMap as DHM ---------------------------------------------------------------- +-- Physical array index for Static Table. newtype SIndex = SIndex Int deriving (Eq,Ord,Show) -fromStaticIndex :: SIndex -> Int-fromStaticIndex (SIndex sidx) = sidx+{-# INLINE fromSIndexToIndex #-}+fromSIndexToIndex :: SIndex -> Index+fromSIndexToIndex (SIndex idx) = idx -toStaticIndex :: Int -> SIndex-toStaticIndex = SIndex+{-# INLINE fromIndexToSIndex #-}+fromIndexToSIndex :: Index -> SIndex+fromIndexToSIndex idx = SIndex idx +----------------------------------------------------------------++{-# INLINE isSIndexValid #-} isSIndexValid :: SIndex -> Bool isSIndexValid (SIndex sidx) = 1 <= sidx && sidx <= staticTableSize @@ -33,6 +38,7 @@ staticTableSize :: Size staticTableSize = length staticTableList +{-# INLINE toStaticEntry #-} -- | Get 'Entry' from the static table. -- -- >>> toStaticEntry (SIndex 1)@@ -47,12 +53,6 @@ -- | Pre-defined static table. staticTable :: Array Index Entry staticTable = listArray (1,staticTableSize) $ map toEntry staticTableList--staticHashMap :: DHM.DoubleHashMap SIndex-staticHashMap = DHM.fromList alist- where- is = map toStaticIndex [1..]- alist = zip is staticTableList ----------------------------------------------------------------
http2.cabal view
@@ -1,5 +1,5 @@ Name: http2-Version: 1.4.0+Version: 1.4.1 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -48,9 +48,9 @@ Network.HPACK.HeaderBlock.String Network.HPACK.HeaderBlock.To Network.HPACK.Table- Network.HPACK.Table.DoubleHashMap Network.HPACK.Table.Dynamic Network.HPACK.Table.Entry+ Network.HPACK.Table.RevIndex Network.HPACK.Table.Static Network.HPACK.Types Network.HTTP2.Decode