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

Moved emailLoginHandler out of authEmail

Browse Source 
The authEmail function was getting large so I moved the
emailLoginHandler out into its own function.
This commit is contained in:
Alex Kardos 2016-03-03 21:16:18 -07:00
parent d42d38990d
commit 4b78c4d60a
1 changed files with 20 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -258,9 +258,26 @@ class ( YesodAuth site
authEmail :: (YesodAuthEmail m) => AuthPlugin m authEmail :: (YesodAuthEmail m) => AuthPlugin m
authEmail = authEmail =
AuthPlugin "email" dispatch login AuthPlugin "email" dispatch emailLoginHandler
where where
login toParent = do dispatch "GET" ["register"] = getRegisterR >>= sendResponse
dispatch "POST" ["register"] = postRegisterR >>= sendResponse
dispatch "GET" ["forgot-password"] = getForgotPasswordR >>= sendResponse
dispatch "POST" ["forgot-password"] = postForgotPasswordR >>= sendResponse
dispatch "GET" ["verify", eid, verkey] =
case fromPathPiece eid of
Nothing -> notFound
Just eid' -> getVerifyR eid' verkey >>= sendResponse
dispatch "POST" ["login"] = postLoginR >>= sendResponse
dispatch "GET" ["set-password"] = getPasswordR >>= sendResponse
dispatch "POST" ["set-password"] = postPasswordR >>= sendResponse
dispatch _ _ = notFound
getRegisterR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html
getRegisterR = registerHandler
emailLoginHandler :: YesodAuthEmail master => (Route Auth -> Route master) -> WidgetT master IO ()
emailLoginHandler toParent = do
((_,widget),enctype) <- liftWidgetT $ runFormPost loginForm ((_,widget),enctype) <- liftWidgetT $ runFormPost loginForm
[whamlet| [whamlet|
@ -273,7 +290,7 @@ authEmail =
<a href="@{toParent registerR}" .btn .btn-default> <a href="@{toParent registerR}" .btn .btn-default>
_{Msg.RegisterLong} _{Msg.RegisterLong}
|] |]
where
loginForm extra = do loginForm extra = do
emailMsg <- renderMessage' Msg.Email emailMsg <- renderMessage' Msg.Email
let emailSettings = FieldSettings { let emailSettings = FieldSettings {
@ -312,22 +329,6 @@ authEmail =
langs <- languages langs <- languages
master <- getYesod master <- getYesod
return $ renderAuthMessage master langs msg return $ renderAuthMessage master langs msg
dispatch "GET" ["register"] = getRegisterR >>= sendResponse
dispatch "POST" ["register"] = postRegisterR >>= sendResponse
dispatch "GET" ["forgot-password"] = getForgotPasswordR >>= sendResponse
dispatch "POST" ["forgot-password"] = postForgotPasswordR >>= sendResponse
dispatch "GET" ["verify", eid, verkey] =
case fromPathPiece eid of
Nothing -> notFound
Just eid' -> getVerifyR eid' verkey >>= sendResponse
dispatch "POST" ["login"] = postLoginR >>= sendResponse
dispatch "GET" ["set-password"] = getPasswordR >>= sendResponse
dispatch "POST" ["set-password"] = postPasswordR >>= sendResponse
dispatch _ _ = notFound
getRegisterR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html
getRegisterR = registerHandler
-- | Default implementation of 'registerHandler'. -- | Default implementation of 'registerHandler'.
-- --
-- Since: 1.2.6 -- Since: 1.2.6