module Network.HPACK.Context (
HeaderSet
, Context
, newContextForEncoding
, newContextForDecoding
, changeContextForDecoding
, DecodeError(..)
, printContext
, emitNotEmittedForEncoding
, emitNotEmittedForDecoding
, clearRefSets
, removeRef
, newEntryForEncoding
, newEntryForDecoding
, pushRef
, isPresentIn
, Sequence(..)
, checkAndUpdate
, 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
, referenceSet :: ReferenceSet
}
printContext :: Context -> IO ()
printContext (Context hdrtbl refs) = do
putStrLn "<<<Header table>>>"
printHeaderTable hdrtbl
putStr "\n"
putStrLn "<<<Reference set>>>"
print refs
newContextForEncoding :: Size -> IO Context
newContextForEncoding maxsiz = do
hdrtbl <- newHeaderTableForEncoding maxsiz
return $ Context hdrtbl emptyReferenceSet
newContextForDecoding :: Size -> IO Context
newContextForDecoding maxsiz = do
hdrtbl <- newHeaderTableForDecoding maxsiz
return $ Context hdrtbl emptyReferenceSet
changeContextForDecoding :: Context -> Size -> IO Context
changeContextForDecoding ctx@(Context hdrtbl refs) siz
| shouldRenew hdrtbl siz = do
(hdrtbl',n) <- renewHeaderTable siz hdrtbl
let refs' = restrictIndices n refs
return $ Context hdrtbl' refs'
| otherwise = return ctx
clearRefSets :: Context -> Context
clearRefSets ctx = ctx {
referenceSet = emptyReferenceSet
}
removeRef :: Context -> Index -> Context
removeRef (Context hdrtbl refs) idx = ctx
where
refs' = removeIndex idx refs
ctx = Context hdrtbl refs'
newEntryForEncoding :: Context -> Entry -> IO ([Index],Context)
newEntryForEncoding (Context hdrtbl refs) e = do
(hdrtbl', i, is) <- insertEntry e hdrtbl
let ns = getCommon is refs
refs' = addIndex 1 $ restrictIndices i $ adjustReferenceSet refs
ctx = Context hdrtbl' refs'
return (ns, ctx)
newEntryForDecoding :: Context -> Entry -> IO Context
newEntryForDecoding (Context hdrtbl refs) e = do
(hdrtbl', i, _) <- insertEntry e hdrtbl
let refs' = addIndex 1 $ restrictIndices i $ adjustReferenceSet refs
return $ Context hdrtbl' refs'
pushRef :: Context -> Index -> Context
pushRef (Context hdrtbl refs) idx = ctx
where
refs' = addIndex idx refs
ctx = Context hdrtbl refs'
emitNotEmittedForEncoding :: Context -> IO ([Index],Context)
emitNotEmittedForEncoding (Context hdrtbl refs) = do
let (removedIndces,refs') = renewForEncoding refs
ctx' = Context hdrtbl refs'
return (removedIndces, ctx')
emitNotEmittedForDecoding :: Context -> IO (HeaderSet,Context)
emitNotEmittedForDecoding ctx@(Context hdrtbl refs) = do
hs <- getNotEmitted ctx
let refs' = renewForDecoding refs
ctx' = Context hdrtbl refs'
return (hs,ctx')
getNotEmitted :: Context -> IO HeaderSet
getNotEmitted ctx = do
let is = getNotEmittedIndices $ referenceSet ctx
hdrtbl = headerTable ctx
map (fromEntry . snd) <$> mapM (which hdrtbl) is
isPresentIn :: Index -> Context -> Bool
isPresentIn idx ctx = idx `isMember` referenceSet ctx
checkAndUpdate :: Index -> Context -> (Sequence, Context)
checkAndUpdate idx ctx = (s, ctx')
where
(s,refs') = lookupAndUpdate idx $ referenceSet ctx
ctx' = ctx { referenceSet = refs' }
whichTable :: Index -> Context -> IO (WhichTable, Entry)
whichTable idx ctx = which hdrtbl idx
where
hdrtbl = headerTable ctx
lookupHeader :: Header -> Context -> HeaderCache
lookupHeader h ctx = lookupTable h (headerTable ctx)
getEntry :: Index -> Context -> IO Entry
getEntry idx ctx = snd <$> whichTable idx ctx