on master help sign in
concatenating cookies.
c007c98Kazu Yamamoto
warp/Network/Wai/Handler/Warp/HTTP2/HPACK.hs+37−10
@@ -5,6 +5,7 @@ module Network.Wai.Handler.Warp.HTTP2.HPACK where
5
5
6import Control.Arrow (first)
6import Control.Arrow (first)
7import qualified Control.Exception as E
7import qualified Control.Exception as E
8+import qualified Data.ByteString as B
8import Data.ByteString.Builder (Builder)
9import Data.ByteString.Builder (Builder)
9import qualified Data.ByteString.Char8 as B8
10import qualified Data.ByteString.Char8 as B8
10import Data.CaseInsensitive (foldedCase)
11import Data.CaseInsensitive (foldedCase)
@@ -19,23 +20,35 @@ import Network.Wai.Handler.Warp.Response
19import qualified Network.Wai.Handler.Warp.Settings as S
20import qualified Network.Wai.Handler.Warp.Settings as S
20import Network.Wai.Handler.Warp.Types
21import Network.Wai.Handler.Warp.Types
21
22
23+-- $setup
24+-- >>> :set -XOverloadedStrings
25+
26+-- Set-Cookie: contains only one cookie value.
27+-- So, we don't need to split it.
22hpackEncodeHeader :: Context -> InternalInfo -> S.Settings -> Response
28hpackEncodeHeader :: Context -> InternalInfo -> S.Settings -> Response
23 -> IO Builder
29 -> IO Builder
24−hpackEncodeHeader Context{encodeDynamicTable} ii settings rsp = do
30+hpackEncodeHeader ctx ii settings rsp = do
25− hdr1 <- addServerAndDate hdr0
31+ hdr1 <- addServerAndDate h
26 let hdr2 = (":status", status) : map (first foldedCase) hdr1
32 let hdr2 = (":status", status) : map (first foldedCase) hdr1
27− ehdrtbl <- readIORef encodeDynamicTable
33+ hpackEncodeRawHeaders ctx hdr2
28− (ehdrtbl', builder) <- encodeHeaderBuilder defaultEncodeStrategy ehdrtbl hdr2
29− writeIORef encodeDynamicTable ehdrtbl'
30− return builder
31 where
34 where
35+ s = responseStatus rsp
32− hdr0 = responseHeaders rsp
36+ h = responseHeaders rsp
33− status = B8.pack $ show $ H.statusCode $ responseStatus rsp
37+ status = B8.pack $ show $ H.statusCode $ s
34 dc = dateCacher ii
38 dc = dateCacher ii
35− rspidxhdr = indexResponseHeader hdr0
39+ rspidxhdr = indexResponseHeader h
36 defServer = S.settingsServerName settings
40 defServer = S.settingsServerName settings
37 addServerAndDate = addDate dc rspidxhdr . addServer defServer rspidxhdr
41 addServerAndDate = addDate dc rspidxhdr . addServer defServer rspidxhdr
38
42
43+hpackEncodeCIHeaders :: Context -> [H.Header] -> IO Builder
44+hpackEncodeCIHeaders ctx = hpackEncodeRawHeaders ctx . map (first foldedCase)
45+
46+hpackEncodeRawHeaders :: Context -> [(B.ByteString, B.ByteString)] -> IO Builder
47+hpackEncodeRawHeaders Context{encodeDynamicTable} hdr = do
48+ ehdrtbl <- readIORef encodeDynamicTable
49+ (ehdrtbl', builder) <- encodeHeaderBuilder defaultEncodeStrategy ehdrtbl hdr
50+ writeIORef encodeDynamicTable ehdrtbl'
51+ return builder
39
52
40----------------------------------------------------------------
53----------------------------------------------------------------
41
54
@@ -44,6 +57,20 @@ hpackDecodeHeader hdrblk Context{decodeDynamicTable} = do
44 hdrtbl <- readIORef decodeDynamicTable
57 hdrtbl <- readIORef decodeDynamicTable
45 (hdrtbl', hdr) <- decodeHeader hdrtbl hdrblk `E.onException` cleanup
58 (hdrtbl', hdr) <- decodeHeader hdrtbl hdrblk `E.onException` cleanup
46 writeIORef decodeDynamicTable hdrtbl'
59 writeIORef decodeDynamicTable hdrtbl'
47− return hdr
60+ return $ concatCookie hdr
48 where
61 where
49 cleanup = E.throwIO $ ConnectionError CompressionError "cannot decompress the header"
62 cleanup = E.throwIO $ ConnectionError CompressionError "cannot decompress the header"
63+
64+-- |
65+--
66+-- >>> concatCookie [("foo","bar")]
67+-- [("foo","bar")]
68+-- >>> concatCookie [("cookie","a=b"),("foo","bar"),("cookie","c=d"),("cookie","e=f")]
69+-- [("foo","bar"),("cookie","a=b; c=d; e=f")]
70+concatCookie :: HeaderList -> HeaderList
71+concatCookie = collect []
72+ where
73+ collect cookies (("cookie",c):rest) = collect (cookies ++ [c]) rest
74+ collect cookies (h:rest) = h : collect cookies rest
75+ collect [] [] = []
76+ collect cookies [] = [("cookie", B.intercalate "; " cookies)]