@@ -44,7 +44,7 @@ data ValidHeaders = ValidHeaders {
4444 , vhAuth :: !(Maybe ByteString)
4545 , vhCL :: !(Maybe Int)
4646 , vhHeader :: !RequestHeaders
47− }
47+ } deriving Show
4848
4949type MkReq = ValidHeaders -> IO ByteString -> Request
5050
@@ -83,53 +83,70 @@ data Pseudo = Pseudo {
8383 , colonPath :: !(Maybe ByteString)
8484 , colonAuth :: !(Maybe ByteString)
8585 , contentLen :: !(Maybe ByteString)
86− }
86+ } deriving Show
8787
8888emptyPseudo :: Pseudo
8989emptyPseudo = Pseudo Nothing Nothing Nothing Nothing
9090
91+-- |
92+--
93+-- >>> validateHeaders [(":method","GET"),(":path","path")]
94+-- Just (ValidHeaders {vhMethod = "GET", vhPath = "path", vhAuth = Nothing, vhCL = Nothing, vhHeader = []})
95+-- >>> validateHeaders [(":method","GET"),(":path","path"),(":authority","authority"),("accept-language","en")]
96+-- Just (ValidHeaders {vhMethod = "GET", vhPath = "path", vhAuth = Just "authority", vhCL = Nothing, vhHeader = [("accept-language","en")]})
97+-- >>> validateHeaders [(":method","GET"),(":path","path"),("cookie","a=b"),("accept-language","en"),("cookie","c=d"),("cookie","e=f")]
98+-- Just (ValidHeaders {vhMethod = "GET", vhPath = "path", vhAuth = Nothing, vhCL = Nothing, vhHeader = [("accept-language","en"),("cookie","a=b; c=d; e=f")]})
9199validateHeaders :: HeaderList -> Maybe ValidHeaders
92−validateHeaders hs = case pseudo hs (emptyPseudo,id) of
93− Just (Pseudo (Just m) (Just p) ma mcl, h)
100+validateHeaders hs = case pseudo hs emptyPseudo of
101+ Just (Pseudo (Just m) (Just p) ma mcl, !h)
94102 -> Just $! ValidHeaders m p ma (readInt <$> mcl) h
95103 _ -> Nothing
96104 where
97− pseudo [] (!p,!b) = Just (p,b [])
98− pseudo h@((k,v):kvs) (!p,!b)
105+ pseudo [] !p = Just (p,[])
106+ pseudo h@((k,v):kvs) !p
99107 | k == ":method" = if isJust (colonMethod p) then
100108 Nothing
101109 else
102− pseudo kvs (p { colonMethod = Just v },b)
110+ pseudo kvs (p { colonMethod = Just v })
103111 | k == ":path" = if isJust (colonPath p) then
104112 Nothing
105113 else
106− pseudo kvs (p { colonPath = Just v },b)
114+ pseudo kvs (p { colonPath = Just v })
107115 | k == ":authority" = if isJust (colonAuth p) then
108116 Nothing
109117 else
110− pseudo kvs (p { colonAuth = Just v },b)
111− | k == ":scheme" = pseudo kvs (p,b) -- fixme: how to store :scheme?
118+ pseudo kvs (p { colonAuth = Just v })
119+ | k == ":scheme" = pseudo kvs p -- fixme: how to store :scheme?
112120 | isPseudo k = Nothing
113− | otherwise = normal h (p,b)
121+ | otherwise = normal h (p,id,id)
114122
115− normal [] (!p,!b) = Just (p,b [])
116− normal ((k,v):kvs) (!p,!b)
123+ normal [] (!p,b,c) = Just (p, mkH b c)
124+ normal ((k,v):kvs) (!p,b,c)
117125 | isPseudo k = Nothing
118126 | k == "connection" = Nothing
119127 | k == "te" = if v == "trailers" then
120− normal kvs (p, b . ((mk k,v) :))
128+ normal kvs (p, b . ((mk k,v) :), c)
121129 else
122130 Nothing
123131 | k == "content-length"
124− = normal kvs (p { contentLen = Just v }, b . ((mk k,v) :))
132+ = normal kvs (p { contentLen = Just v }, b . ((mk k,v) :), c)
125133 | k == "host" = if isJust (colonAuth p) then
126− normal kvs (p,b)
134+ normal kvs (p, b, c)
127135 else
128− normal kvs (p { colonAuth = Just v },b)
136+ normal kvs (p { colonAuth = Just v }, b, c)
137+ | k == "cookie" = normal kvs (p, b, c . (v:))
129138 | otherwise = case BS.find isUpper k of
130− Nothing -> normal kvs (p, b . ((mk k,v) :))
139+ Nothing -> normal kvs (p, b . ((mk k,v) :), c)
131140 Just _ -> Nothing
132141
142+ mkH b c = h
143+ where
144+ !h = b anchor
145+ !cookieList = c []
146+ !anchor
147+ | null cookieList = []
148+ | otherwise = let !v = BS.intercalate "; " cookieList
149+ in [("cookie",v)]
133150 isPseudo "" = False
134151 isPseudo k = BS.head k == _colon
135152