haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Dummy: Check for JSON first

Browse Source
This commit is contained in:
3v0k4 2019-08-23 00:48:17 +02:00
parent 657b790a3d
commit baa6bfb3a8
1 changed files with 10 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
yesod-auth/Yesod/Auth/Dummy.hs
View File

@ -36,10 +36,9 @@ module Yesod.Auth.Dummy
) where ) where
import Yesod.Auth import Yesod.Auth
import Yesod.Form (FormResult(..), runInputPostResult, textField, ireq) import Yesod.Form (runInputPost, textField, ireq)
import Yesod.Core import Yesod.Core
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T
import Data.Aeson.Types (Result(..), Parser) import Data.Aeson.Types (Result(..), Parser)
import qualified Data.Aeson.Types as A (parseEither, withObject) import qualified Data.Aeson.Types as A (parseEither, withObject)
@ -51,18 +50,16 @@ authDummy =
AuthPlugin "dummy" dispatch login AuthPlugin "dummy" dispatch login
where where
dispatch "POST" [] = do dispatch "POST" [] = do
formResult <- runInputPostResult $ ireq textField "ident" (jsonResult :: Result Value) <- parseCheckJsonBody
eIdent <- case formResult of eIdent <- case jsonResult of
FormSuccess ident -> Success val -> return $ A.parseEither identParser val
return $ Right ident Error err -> return $ Left err
_ -> do
(jsonResult :: Result Value) <- parseCheckJsonBody
case jsonResult of
Success val -> return $ A.parseEither identParser val
Error err -> return $ Left err
case eIdent of case eIdent of
Right ident -> setCredsRedirect $ Creds "dummy" ident [] Right ident ->
Left err -> invalidArgs [T.pack err] setCredsRedirect $ Creds "dummy" ident []
Left _ -> do
ident <- runInputPost $ ireq textField "ident"
setCredsRedirect $ Creds "dummy" ident []
dispatch _ _ = notFound dispatch _ _ = notFound
url = PluginR "dummy" [] url = PluginR "dummy" []
login authToMaster = do login authToMaster = do