Moved authDummy to a separate module
This commit is contained in:
parent
20b0790c25
commit
46d8398d7a
@ -4,18 +4,20 @@
|
|||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
module Yesod.Helpers.Auth
|
module Yesod.Helpers.Auth
|
||||||
( Auth
|
( -- * Subsite
|
||||||
|
Auth
|
||||||
, AuthPlugin (..)
|
, AuthPlugin (..)
|
||||||
, AuthRoute (..)
|
, AuthRoute (..)
|
||||||
, getAuth
|
, getAuth
|
||||||
, Creds (..)
|
|
||||||
, YesodAuth (..)
|
, YesodAuth (..)
|
||||||
|
-- * Plugin interface
|
||||||
|
, Creds (..)
|
||||||
, setCreds
|
, setCreds
|
||||||
|
-- * User functions
|
||||||
, maybeAuthId
|
, maybeAuthId
|
||||||
, maybeAuth
|
, maybeAuth
|
||||||
, requireAuthId
|
, requireAuthId
|
||||||
, requireAuth
|
, requireAuth
|
||||||
, authDummy
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Yesod
|
import Yesod
|
||||||
@ -81,6 +83,7 @@ mkYesodSub "Auth"
|
|||||||
credsKey :: String
|
credsKey :: String
|
||||||
credsKey = "_ID"
|
credsKey = "_ID"
|
||||||
|
|
||||||
|
-- | FIXME: won't show up till redirect
|
||||||
setCreds :: YesodAuth m => Bool -> Creds m -> GHandler s m ()
|
setCreds :: YesodAuth m => Bool -> Creds m -> GHandler s m ()
|
||||||
setCreds doRedirects creds = do
|
setCreds doRedirects creds = do
|
||||||
y <- getYesod
|
y <- getYesod
|
||||||
@ -189,20 +192,3 @@ redirectLogin = do
|
|||||||
case authRoute y of
|
case authRoute y of
|
||||||
Just z -> redirect RedirectTemporary z
|
Just z -> redirect RedirectTemporary z
|
||||||
Nothing -> permissionDenied "Please configure authRoute"
|
Nothing -> permissionDenied "Please configure authRoute"
|
||||||
|
|
||||||
authDummy :: YesodAuth m => AuthPlugin m
|
|
||||||
authDummy =
|
|
||||||
AuthPlugin "dummy" dispatch login
|
|
||||||
where
|
|
||||||
dispatch "POST" [] = do
|
|
||||||
ident <- runFormPost' $ stringInput "ident"
|
|
||||||
setCreds True $ Creds "dummy" ident []
|
|
||||||
dispatch _ _ = notFound
|
|
||||||
url = PluginR "dummy" []
|
|
||||||
login authToMaster = do
|
|
||||||
addBody [$hamlet|
|
|
||||||
%form!method=post!action=@authToMaster.url@
|
|
||||||
Your new identifier is: $
|
|
||||||
%input!type=text!name=ident
|
|
||||||
%input!type=submit!value="Dummy Login"
|
|
||||||
|]
|
|
||||||
|
|||||||
27
Yesod/Helpers/Auth/Dummy.hs
Normal file
27
Yesod/Helpers/Auth/Dummy.hs
Normal file
@ -0,0 +1,27 @@
|
|||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
-- | 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.
|
||||||
|
module Yesod.Helpers.Auth.Dummy
|
||||||
|
( authDummy
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Yesod
|
||||||
|
import Yesod.Helpers.Auth
|
||||||
|
|
||||||
|
authDummy :: YesodAuth m => AuthPlugin m
|
||||||
|
authDummy =
|
||||||
|
AuthPlugin "dummy" dispatch login
|
||||||
|
where
|
||||||
|
dispatch "POST" [] = do
|
||||||
|
ident <- runFormPost' $ stringInput "ident"
|
||||||
|
setCreds True $ Creds "dummy" ident []
|
||||||
|
dispatch _ _ = notFound
|
||||||
|
url = PluginR "dummy" []
|
||||||
|
login authToMaster = do
|
||||||
|
addBody [$hamlet|
|
||||||
|
%form!method=post!action=@authToMaster.url@
|
||||||
|
Your new identifier is: $
|
||||||
|
%input!type=text!name=ident
|
||||||
|
%input!type=submit!value="Dummy Login"
|
||||||
|
|]
|
||||||
@ -26,6 +26,7 @@ library
|
|||||||
, blaze-builder >= 0.1 && < 0.2
|
, blaze-builder >= 0.1 && < 0.2
|
||||||
, mime-mail >= 0.0 && < 0.1
|
, mime-mail >= 0.0 && < 0.1
|
||||||
exposed-modules: Yesod.Helpers.Auth
|
exposed-modules: Yesod.Helpers.Auth
|
||||||
|
Yesod.Helpers.Auth.Dummy
|
||||||
Yesod.Helpers.Auth.Email
|
Yesod.Helpers.Auth.Email
|
||||||
Yesod.Helpers.Auth.Facebook
|
Yesod.Helpers.Auth.Facebook
|
||||||
Yesod.Helpers.Auth.OpenId
|
Yesod.Helpers.Auth.OpenId
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user