diff --git a/yesod-auth/Yesod/Auth/Email.hs b/yesod-auth/Yesod/Auth/Email.hs index c705c0e1..0e5580e4 100644 --- a/yesod-auth/Yesod/Auth/Email.hs +++ b/yesod-auth/Yesod/Auth/Email.hs @@ -258,9 +258,26 @@ class ( YesodAuth site authEmail :: (YesodAuthEmail m) => AuthPlugin m authEmail = - AuthPlugin "email" dispatch login + AuthPlugin "email" dispatch emailLoginHandler 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 [whamlet| @@ -273,7 +290,7 @@ authEmail = _{Msg.RegisterLong} |] - + where loginForm extra = do emailMsg <- renderMessage' Msg.Email let emailSettings = FieldSettings { @@ -312,22 +329,6 @@ authEmail = langs <- languages master <- getYesod 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'. -- -- Since: 1.2.6