@@ -6,8 +6,9 @@ module Network.Wai.Handler.Warp.HTTP2.HPACK (
66 , hpackEncodeHeaderLoop
77 , hpackDecodeHeader
88 , just
9− , addNecessaryHeaders
9+ , fixHeaders
1010 , addHeader -- testing
11+ , deleteUnnecessaryHeaders
1112 ) where
1213
1314import qualified Control.Exception as E
@@ -34,12 +35,12 @@ addHeader t v tbl ths = case getHeaderValue t tbl of
3435 Nothing -> (t,v) : ths
3536 _ -> ths
3637
37−addNecessaryHeaders :: Context
38− -> Rspn
39− -> InternalInfo
40− -> S.Settings
41− -> IO TokenHeaderList
42−addNecessaryHeaders Context{..} rspn ii settings = do
38+fixHeaders :: Context
39+ -> Rspn
40+ -> InternalInfo
41+ -> S.Settings
42+ -> IO TokenHeaderList
43+fixHeaders Context{..} rspn ii settings = do
4344 date <- getDate ii
4445 let !s = rspnStatus rspn
4546 !status = packStatus s
@@ -48,7 +49,25 @@ addNecessaryHeaders Context{..} rspn ii settings = do
4849 !ths1 = addHeader tokenServer defServer tbl ths0
4950 !ths2 = addHeader tokenDate date tbl ths1
5051 !ths3 = (tokenStatus, status) : ths2
51− return ths3
52+ !ths4 = deleteUnnecessaryHeaders ths3 tbl
53+ return ths4
54+
55+deleteUnnecessaryHeaders :: TokenHeaderList -> ValueTable -> TokenHeaderList
56+deleteUnnecessaryHeaders htl0 tbl0 = loop headersToBeRemoved htl0
57+ where
58+ loop [] thl = thl
59+ loop (t:ts) thl = case getHeaderValue t tbl0 of
60+ Nothing -> thl
61+ _ -> let !thl' = filter ((/= t) . fst) thl
62+ in loop ts thl'
63+
64+headersToBeRemoved :: [Token]
65+headersToBeRemoved = [ tokenConnection
66+ , tokenTransferEncoding
67+ -- Keep-Alive:
68+ -- Proxy-Connection:
69+ -- Upgrade:
70+ ]
5271
5372----------------------------------------------------------------
5473