diff --git a/Web/Mime.hs b/Web/Mime.hs index 350b127d..2e915d4e 100644 --- a/Web/Mime.hs +++ b/Web/Mime.hs @@ -6,6 +6,7 @@ module Web.Mime , contentTypeFromBS , typeByExt , ext + , simpleContentType ) where import Data.Function (on) @@ -48,6 +49,9 @@ instance ConvertSuccess ContentType [Char] where convertSuccess TypeOctet = "application/octet-stream" convertSuccess (TypeOther s) = s +simpleContentType :: ContentType -> String +simpleContentType = fst . span (/= ';') . cs + instance Eq ContentType where (==) = (==) `on` (cs :: ContentType -> String) diff --git a/Yesod/Request.hs b/Yesod/Request.hs index 1ef86487..99728b84 100644 --- a/Yesod/Request.hs +++ b/Yesod/Request.hs @@ -115,7 +115,7 @@ parseWaiRequest env session = do $ parsePost ctype clength inputLBS rawCookie = fromMaybe B.empty $ lookup W.Cookie $ W.httpHeaders env - cookies' = map (cs *** cs) $ decodeCookies rawCookie + cookies' = map (cs *** cs) $ parseCookies rawCookie acceptLang = lookup W.AcceptLanguage $ W.httpHeaders env langs = map cs $ maybe [] parseHttpAccept acceptLang langs' = case lookup langKey cookies' of diff --git a/Yesod/Response.hs b/Yesod/Response.hs index f3353651..a6b86c51 100644 --- a/Yesod/Response.hs +++ b/Yesod/Response.hs @@ -126,7 +126,8 @@ instance HasReps () where instance HasReps [(ContentType, Content)] where chooseRep a cts = return $ - case filter (\(ct, _) -> ct `elem` cts) a of + case filter (\(ct, _) -> simpleContentType ct `elem` + map simpleContentType cts) a of ((ct, c):_) -> (ct, c) _ -> case a of (x:_) -> x