Fixed content type matching

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)
 

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

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