module Network.HPACK.Context (
HeaderSet
, Context
, newContext
, DecodeError(..)
, printContext
, clearHeaderSet
, getHeaderSet
, emitNotEmitted
, clearRefSets
, removeRef
, newEntry
, pushRef
, emitOnly
, isPresentIn
, getEntry
, whichTable
, lookupHeader
) where
import Control.Applicative ((<$>))
import Network.HPACK.Context.HeaderSet
import Network.HPACK.Context.ReferenceSet
import Network.HPACK.Table
import Network.HPACK.Types
data Context = Context {
headerTable :: !HeaderTable
, oldReferenceSet :: ReferenceSet
, newReferenceSet :: ReferenceSet
, headerSet :: HeaderSet
}
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
newContext :: Size -> IO Context
newContext maxsiz = do
hdrtbl <- newHeaderTable maxsiz
return $ Context hdrtbl
emptyReferenceSet
emptyReferenceSet
emptyHeaderSet
clearRefSets :: Context -> IO Context
clearRefSets ctx = return ctx {
oldReferenceSet = emptyReferenceSet
, newReferenceSet = emptyReferenceSet
}
removeRef :: Context -> Index -> IO Context
removeRef (Context hdrtbl oldref newref hdrset) idx = return ctx
where
oldref' = removeIndex idx oldref
newref' = removeIndex idx newref
ctx = Context hdrtbl oldref' newref' hdrset
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'
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'
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'
emitNotEmitted :: Context -> IO Context
emitNotEmitted ctx = emit ctx <$> getNotEmitted ctx
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
isPresentIn :: Index -> Context -> Bool
isPresentIn idx ctx = idx `isMember` oldref || idx `isMember` newref
where
oldref = oldReferenceSet ctx
newref = newReferenceSet ctx
whichTable :: Index -> Context -> IO (WhichTable, Entry)
whichTable idx ctx = which hdrtbl idx
where
hdrtbl = headerTable ctx
lookupHeader :: Header -> Context -> IO HeaderCache
lookupHeader h ctx = lookupTable h (headerTable ctx)
getEntry :: Index -> Context -> IO Entry
getEntry idx ctx = snd <$> whichTable idx ctx
clearHeaderSet :: Context -> Context
clearHeaderSet ctx = ctx { headerSet = emptyHeaderSet }
getHeaderSet :: Context -> HeaderSet
getHeaderSet = headerSet