Browse files

Include cookies in rspHeaders, in addition to rspCookies

(flip (++)) was chosen under the assumption that there will usually
be more cookies in rspCookies than in rspHeaders
  • Loading branch information...
1 parent cd3dc3e commit f417f4eb8ad3f6a914867fdb15278299309767f2 @lpsmith committed Jan 30, 2011
Showing with 1 addition and 1 deletion.
  1. +1 −1 src/Snap/Internal/Http/Server.hs
View
2 src/Snap/Internal/Http/Server.hs
@@ -776,7 +776,7 @@ sendResponse req rsp' buffer writeEnd' onSendFile = do
where
f h = if null cookies
then h
- else Map.insert "Set-Cookie" cookies h
+ else Map.insertWith (flip (++)) "Set-Cookie" cookies h
cookies = fmap cookieToBS . Map.elems $ rspCookies r

2 comments on commit f417f4e

@snapframework

This change is OK w/ me (and I will pull it later) but I would prefer it if the stuff you're trying to do was included in our Cookie object also.

@lpsmith
Owner

Well, I never added it to the Cookie record, I just did this:

addHttpCookie :: Cookie            -- ^ cookie value
              -> Response          -- ^ response to modify
              -> Response
addHttpCookie (Cookie k v mbExpTime mbDomain mbPath) = updateHeaders f
  where
    f       = Map.insertWith' (++) "Set-Cookie" [cookie]
    cookie  = Char8.concat [k, "=", v, path, exptime, domain, "; httponly"]
    path    = maybe "" (Char8.append "; path=") mbPath
    domain  = maybe "" (Char8.append "; domain=") mbDomain
    exptime = maybe "" (Char8.append "; expires=" . fmt) mbExpTime
    fmt = Char8.pack . formatTime defaultTimeLocale "%a, %d-%b-%Y %H:%M:%S GMT"

Which is identical to the older addCookie, except for the "; httponly" bit. And, there are other things we don't support, such as expiring 8 hours in the future, instead of at 6:24 pm (UTC), which should arguably be supported as well, but at least this gives people a workaround if there is some obscure cookie thing we don't support.

Please sign in to comment.