diff --git a/yesod-auth/ChangeLog.md b/yesod-auth/ChangeLog.md index 8f08fcc1..7cce78bf 100644 --- a/yesod-auth/ChangeLog.md +++ b/yesod-auth/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.4.16 + +* Fix email provider [#1330](https://github.com/yesodweb/yesod/issues/1330) + ## 1.4.15 * Add JSON endpoints to Yesod.Auth.Email module diff --git a/yesod-auth/Yesod/Auth/Email.hs b/yesod-auth/Yesod/Auth/Email.hs index be5669a9..dd439a8c 100644 --- a/yesod-auth/Yesod/Auth/Email.hs +++ b/yesod-auth/Yesod/Auth/Email.hs @@ -455,7 +455,7 @@ registerHelper allowUsername dest = do pidentifier <- lookupPostParam "email" midentifier <- case pidentifier of Nothing -> do - (jidentifier :: Result Value) <- lift parseJsonBody + (jidentifier :: Result Value) <- lift parseCheckJsonBody case jidentifier of Error _ -> return Nothing Success val -> return $ parseMaybe parseEmail val @@ -589,7 +589,7 @@ postLoginR = do midentifier <- case result of FormSuccess (iden, pass) -> return $ Just (iden, pass) _ -> do - (creds :: Result Value) <- lift parseJsonBody + (creds :: Result Value) <- lift parseCheckJsonBody case creds of Error _ -> return Nothing Success val -> return $ parseMaybe parseCreds val @@ -718,7 +718,7 @@ parsePassword = withObject "password" (\obj -> do postPasswordR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) TypedContent postPasswordR = do maid <- lift maybeAuthId - (creds :: Result Value) <- lift parseJsonBody + (creds :: Result Value) <- lift parseCheckJsonBody let jcreds = case creds of Error _ -> Nothing Success val -> parseMaybe parsePassword val diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index cbbc6f09..face7de3 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -1,5 +1,5 @@ name: yesod-auth -version: 1.4.15 +version: 1.4.16 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin @@ -23,7 +23,7 @@ library build-depends: base >= 4 && < 5 , authenticate >= 1.3 , bytestring >= 0.9.1.4 - , yesod-core >= 1.4.20 && < 1.5 + , yesod-core >= 1.4.31 && < 1.5 , wai >= 1.4 , template-haskell , base16-bytestring diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index f32ee0e3..cb06ee5d 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.4.31 + +* Add `parseCheckJsonBody` and `requireCheckJsonBody` + ## 1.4.30 * Add `defaultMessageWidget` diff --git a/yesod-core/Yesod/Core/Json.hs b/yesod-core/Yesod/Core/Json.hs index 58c101a0..de47e2c3 100644 --- a/yesod-core/Yesod/Core/Json.hs +++ b/yesod-core/Yesod/Core/Json.hs @@ -13,8 +13,10 @@ module Yesod.Core.Json -- * Convert to a JSON value , parseJsonBody + , parseCheckJsonBody , parseJsonBody_ , requireJsonBody + , requireCheckJsonBody -- * Produce JSON values , J.Value (..) @@ -33,7 +35,7 @@ module Yesod.Core.Json , acceptsJson ) where -import Yesod.Core.Handler (HandlerT, getRequest, invalidArgs, redirect, selectRep, provideRep, rawRequestBody, ProvidedRep) +import Yesod.Core.Handler (HandlerT, getRequest, invalidArgs, redirect, selectRep, provideRep, rawRequestBody, ProvidedRep, lookupHeader) import Control.Monad.Trans.Writer (Writer) import Data.Monoid (Endo) import Yesod.Core.Content (TypedContent) @@ -121,6 +123,15 @@ parseJsonBody = do Left e -> J.Error $ show e Right value -> J.fromJSON value +-- | Same as 'parseJsonBody', but ensures that the mime type indicates +-- JSON content. +parseCheckJsonBody :: (MonadHandler m, J.FromJSON a) => m (J.Result a) +parseCheckJsonBody = do + mct <- lookupHeader "content-type" + case fmap (B8.takeWhile (/= ';')) mct of + Just "application/json" -> parseJsonBody + _ -> return $ J.Error $ "Non-JSON content type: " ++ show mct + -- | Same as 'parseJsonBody', but return an invalid args response on a parse -- error. parseJsonBody_ :: (MonadHandler m, J.FromJSON a) => m a @@ -136,6 +147,15 @@ requireJsonBody = do J.Error s -> invalidArgs [pack s] J.Success a -> return a +-- | Same as 'requireJsonBody', but ensures that the mime type +-- indicates JSON content. +requireCheckJsonBody :: (MonadHandler m, J.FromJSON a) => m a +requireCheckJsonBody = do + ra <- parseCheckJsonBody + case ra of + J.Error s -> invalidArgs [pack s] + J.Success a -> return a + -- | Convert a list of values to an 'J.Array'. array :: J.ToJSON a => [a] -> J.Value array = J.Array . V.fromList . map J.toJSON diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index a2ce9cc0..bbffd416 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.4.30 +version: 1.4.31 license: MIT license-file: LICENSE author: Michael Snoyman