diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/Network/HPACK/Table.hs b/Network/HPACK/Table.hs --- a/Network/HPACK/Table.hs +++ b/Network/HPACK/Table.hs @@ -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 diff --git a/Network/HPACK/Table/DoubleHashMap.hs b/Network/HPACK/Table/DoubleHashMap.hs deleted file mode 100644 --- a/Network/HPACK/Table/DoubleHashMap.hs +++ /dev/null @@ -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 diff --git a/Network/HPACK/Table/Dynamic.hs b/Network/HPACK/Table/Dynamic.hs --- a/Network/HPACK/Table/Dynamic.hs +++ b/Network/HPACK/Table/Dynamic.hs @@ -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 diff --git a/Network/HPACK/Table/RevIndex.hs b/Network/HPACK/Table/RevIndex.hs new file mode 100644 --- /dev/null +++ b/Network/HPACK/Table/RevIndex.hs @@ -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 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 @@ -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 ---------------------------------------------------------------- diff --git a/http2.cabal b/http2.cabal --- a/http2.cabal +++ b/http2.cabal @@ -1,5 +1,5 @@ Name: http2 -Version: 1.4.0 +Version: 1.4.1 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto 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