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

yesod-auth: user defined layout

Browse Source
This commit is contained in:
Greg Weber 2014-01-08 14:35:13 -08:00
parent 12480b2d2a
commit d817d37c9c
2 changed files with 21 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
yesod-auth/Yesod/Auth.hs
View File

@ -91,6 +91,10 @@ data Creds master = Creds
class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage) => YesodAuth master where
type AuthId master
-- | specify the layout. Uses defaultLayout by default
authLayout :: WidgetT master IO () -> HandlerT master IO Html
authLayout = defaultLayout
-- | Default destination on successful login, if no other
-- destination exists.
loginDest :: master -> Route master
@ -109,7 +113,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
loginHandler :: AuthHandler master RepHtml
loginHandler = do
tp <- getRouteToParent
lift $ defaultLayout $ do
lift $ authLayout $ do
setTitleI Msg.LoginTitle
master <- getYesod
mapM_ (flip apLogin tp) (authPlugins master)
@ -273,7 +277,7 @@ setCreds doRedirects creds = do
Nothing -> do
sendResponseStatus unauthorized401 =<< (
selectRep $ do
provideRep $ defaultLayout $ toWidget [shamlet|<h1>Invalid login|]
provideRep $ authLayout $ toWidget [shamlet|<h1>Invalid login|]
provideJsonMessage "Invalid Login"
)
Just ar -> loginErrorMessageMasterI ar Msg.InvalidLogin
@ -288,6 +292,15 @@ setCreds doRedirects creds = do
provideJsonMessage "Login Successful"
sendResponse res
-- | same as defaultLayoutJson, but uses authLayout
authLayoutJson :: (YesodAuth site, ToJSON j)
=> WidgetT site IO () -- ^ HTML
-> HandlerT site IO j -- ^ JSON
-> HandlerT site IO TypedContent
authLayoutJson w json = selectRep $ do
provideRep $ authLayout w
provideRep $ fmap toJSON json
-- | Clears current user credentials for the session.
--
-- Since 1.1.7
@ -304,7 +317,7 @@ clearCreds doRedirects = do
getCheckR :: AuthHandler master TypedContent
getCheckR = lift $ do
creds <- maybeAuthId
defaultLayoutJson (do
authLayoutJson (do
setTitle "Authentication Status"
toWidget $ html' creds) (return $ jsonCreds creds)
where

10
yesod-auth/Yesod/Auth/Email.hs
View File

@ -168,7 +168,7 @@ class (YesodAuth site, PathPiece (AuthEmailId site)) => YesodAuthEmail site wher
--
-- Since 1.2.2
confirmationEmailSentResponse :: Text -> HandlerT site IO Html
confirmationEmailSentResponse identifier = defaultLayout $ do
confirmationEmailSentResponse identifier = authLayout $ do
setTitleI Msg.ConfirmationEmailSentTitle
[whamlet|<p>_{Msg.ConfirmationEmailSent identifier}|]
@ -221,7 +221,7 @@ getRegisterR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html
getRegisterR = do
email <- newIdent
tp <- getRouteToParent
lift $ defaultLayout $ do
lift $ authLayout $ do
setTitleI Msg.RegisterLong
[whamlet|
<p>_{Msg.EnterEmail}
@ -275,7 +275,7 @@ getForgotPasswordR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO
getForgotPasswordR = do
tp <- getRouteToParent
email <- newIdent
lift $ defaultLayout $ do
lift $ authLayout $ do
setTitleI Msg.PasswordResetTitle
[whamlet|
<p>_{Msg.PasswordResetPrompt}
@ -307,7 +307,7 @@ getVerifyR lid key = do
lift $ setLoginLinkKey uid
redirect setpassR
_ -> return ()
lift $ defaultLayout $ do
lift $ authLayout $ do
setTitleI Msg.InvalidKey
[whamlet|
$newline never
@ -358,7 +358,7 @@ getPasswordR = do
Nothing -> loginErrorMessageI LoginR Msg.BadSetPass
tp <- getRouteToParent
needOld <- maybe (return True) (lift . needOldPassword) maid
lift $ defaultLayout $ do
lift $ authLayout $ do
setTitleI Msg.SetPassTitle
[whamlet|
$newline never