diff --git a/yesod-auth/ChangeLog.md b/yesod-auth/ChangeLog.md index 11ab2e5b..70e199e4 100644 --- a/yesod-auth/ChangeLog.md +++ b/yesod-auth/ChangeLog.md @@ -4,6 +4,10 @@ * Email: Fix typo in `defaultEmailLoginHandler` template [#1605](https://github.com/yesodweb/yesod/pull/1605) +## 1.6.8 + +* Dummy: Add support for JSON submissions [#1619](https://github.com/yesodweb/yesod/pull/1619) + ## 1.6.7 * Redirect behavior of `clearCreds` depends on request type [#1598](https://github.com/yesodweb/yesod/pull/1598) diff --git a/yesod-auth/Yesod/Auth/Dummy.hs b/yesod-auth/Yesod/Auth/Dummy.hs index 721d6311..b768a72f 100644 --- a/yesod-auth/Yesod/Auth/Dummy.hs +++ b/yesod-auth/Yesod/Auth/Dummy.hs @@ -2,24 +2,67 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Provides a dummy authentication module that simply lets a user specify --- his/her identifier. This is not intended for real world use, just for --- testing. +-- their identifier. This is not intended for real world use, just for +-- testing. This plugin supports form submissions via JSON (since 1.6.8). +-- +-- = Using the JSON Login Endpoint +-- +-- We are assuming that you have declared `authRoute` as follows +-- +-- @ +-- Just $ AuthR LoginR +-- @ +-- +-- If you are using a different one, then you have to adjust the +-- endpoint accordingly. +-- +-- @ +-- Endpoint: \/auth\/page\/dummy +-- Method: POST +-- JSON Data: { +-- "ident": "my identifier" +-- } +-- @ +-- +-- Remember to add the following headers: +-- +-- - Accept: application\/json +-- - Content-Type: application\/json + module Yesod.Auth.Dummy ( authDummy ) where import Yesod.Auth -import Yesod.Form (runInputPost, textField, ireq) +import Yesod.Form (FormResult(..), runInputPostResult, textField, ireq) import Yesod.Core +import Data.Text (Text) +import qualified Data.Text as T +import Data.Aeson.Types (Result(..), Parser) +import qualified Data.Aeson.Types as A (parseEither, withObject) + +identParser :: Value -> Parser Text +identParser = A.withObject "Ident" (.: "ident") authDummy :: YesodAuth m => AuthPlugin m authDummy = AuthPlugin "dummy" dispatch login where dispatch "POST" [] = do - ident <- runInputPost $ ireq textField "ident" - setCredsRedirect $ Creds "dummy" ident [] + formResult <- runInputPostResult $ ireq textField "ident" + eIdent <- case formResult of + FormSuccess ident -> + return $ Right ident + _ -> do + (jsonResult :: Result Value) <- parseCheckJsonBody + case jsonResult of + Success val -> return $ A.parseEither identParser val + Error err -> return $ Left err + case eIdent of + Right ident -> setCredsRedirect $ Creds "dummy" ident [] + Left err -> invalidArgs [T.pack err] dispatch _ _ = notFound url = PluginR "dummy" [] login authToMaster = do diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index 12a5a12b..0fc45986 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -1,5 +1,5 @@ name: yesod-auth -version: 1.6.7 +version: 1.6.8 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin