diff --git a/Yesod/Auth.hs b/Yesod/Auth.hs --- a/Yesod/Auth.hs +++ b/Yesod/Auth.hs @@ -25,7 +25,6 @@ import Yesod.Core import Yesod.Persist import Yesod.Json -import Text.Blaze import Language.Haskell.TH.Syntax hiding (lift) import qualified Network.Wai as W import Text.Hamlet (hamlet) @@ -36,9 +35,9 @@ import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) -import Web.Routes.Quasi (toSinglePiece, fromSinglePiece) import Yesod.Auth.Message (AuthMessage, defaultMessage) import qualified Yesod.Auth.Message as Msg +import Yesod.Form (FormMessage) data Auth = Auth @@ -61,7 +60,7 @@ , credsExtra :: [(Text, Text)] } -class (Yesod m, SinglePiece (AuthId m)) => YesodAuth m where +class (Yesod m, SinglePiece (AuthId m), RenderMessage m FormMessage) => YesodAuth m where type AuthId m -- | Default destination on successful login, if no other @@ -79,17 +78,15 @@ -- | What to show on the login page. loginHandler :: GHandler Auth m RepHtml loginHandler = defaultLayout $ do - setTitle "Login" + setTitleI Msg.LoginTitle tm <- lift getRouteToMaster mapM_ (flip apLogin tm) authPlugins renderAuthMessage :: m -> [Text] -- ^ languages - -> AuthMessage -> Html + -> AuthMessage -> Text renderAuthMessage _ _ = defaultMessage -type Texts = [Text] - mkYesodSub "Auth" [ ClassP ''YesodAuth [VarT $ mkName "master"] ] @@ -113,8 +110,6 @@ setCreds doRedirects creds = do y <- getYesod maid <- getAuthId creds - l <- languages - let mr = renderMessage Auth y l case maid of Nothing -> if doRedirects @@ -131,14 +126,14 @@ |] sendResponse rh Just ar -> do - setMessage $ mr Msg.InvalidLogin + setMessageI Msg.InvalidLogin redirect RedirectTemporary ar else return () Just aid -> do setSession credsKey $ toSinglePiece aid if doRedirects then do - setMessage $ mr Msg.NowLoggedIn + setMessageI Msg.NowLoggedIn redirectUltDest RedirectTemporary $ loginDest y else return () @@ -229,6 +224,5 @@ Just z -> redirect RedirectTemporary z Nothing -> permissionDenied "Please configure authRoute" -instance YesodAuth m => YesodMessage Auth m where - type Message Auth m = AuthMessage - renderMessage = const renderAuthMessage +instance YesodAuth m => RenderMessage m AuthMessage where + renderMessage = renderAuthMessage diff --git a/Yesod/Auth/Dummy.hs b/Yesod/Auth/Dummy.hs --- a/Yesod/Auth/Dummy.hs +++ b/Yesod/Auth/Dummy.hs @@ -9,7 +9,7 @@ ) where import Yesod.Auth -import Yesod.Form (runFormPost', stringInput) +import Yesod.Form (runInputPost, textField, ireq) import Yesod.Handler (notFound) import Text.Hamlet (hamlet) @@ -18,7 +18,7 @@ AuthPlugin "dummy" dispatch login where dispatch "POST" [] = do - ident <- runFormPost' $ stringInput "ident" + ident <- runInputPost $ ireq textField "ident" setCreds True $ Creds "dummy" ident [] dispatch _ _ = notFound url = PluginR "dummy" [] diff --git a/Yesod/Auth/Email.hs b/Yesod/Auth/Email.hs --- a/Yesod/Auth/Email.hs +++ b/Yesod/Auth/Email.hs @@ -81,7 +81,6 @@ AuthPlugin "email" dispatch $ \tm -> do y <- lift getYesod l <- lift languages - let mr = renderMessage (getAuth 'x') y l #if GHC7 [whamlet| #else @@ -90,16 +89,16 @@
- -
#{mr Msg.Email} + _{Msg.Email}
#{mr Msg.Password} + _{Msg.Password}
- + I don't have an account |] where @@ -117,9 +116,8 @@ getRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml getRegisterR = do toMaster <- getRouteToMaster - mr <- getMessageRender defaultLayout $ do - setTitle $ mr Msg.RegisterLong + setTitleI Msg.RegisterLong addWidget #if GHC7 [whamlet| @@ -136,7 +134,7 @@ postRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml postRegisterR = do y <- getYesod - email <- runFormPost' $ emailInput "email" + email <- runInputPost $ ireq emailField "email" mecreds <- getEmailCreds email (lid, verKey) <- case mecreds of @@ -153,9 +151,8 @@ tm <- getRouteToMaster let verUrl = render $ tm $ verify (toSinglePiece lid) verKey sendVerifyEmail email verKey verUrl - mr <- getMessageRender defaultLayout $ do - setTitle $ mr Msg.ConfirmationEmailSentTitle + setTitleI Msg.ConfirmationEmailSentTitle addWidget #if GHC7 [whamlet| @@ -178,13 +175,11 @@ Just _uid -> do setCreds False $ Creds "email" email [("verifiedEmail", email)] -- FIXME uid? toMaster <- getRouteToMaster - mr <- getMessageRender - setMessage $ mr Msg.AddressVerified + setMessageI Msg.AddressVerified redirect RedirectTemporary $ toMaster setpassR _ -> return () - mr <- getMessageRender defaultLayout $ do - setTitle $ mr Msg.InvalidKey + setTitleI Msg.InvalidKey addWidget #if GHC7 [whamlet| @@ -196,9 +191,9 @@ postLoginR :: YesodAuthEmail master => GHandler Auth master () postLoginR = do - (email, pass) <- runFormPost' $ (,) - <$> emailInput "email" - <*> stringInput "password" + (email, pass) <- runInputPost $ (,) + <$> ireq emailField "email" + <*> ireq textField "password" mecreds <- getEmailCreds email maid <- case (mecreds >>= emailCredsAuthId, fmap emailCredsStatus mecreds) of @@ -215,9 +210,7 @@ Just _aid -> setCreds True $ Creds "email" email [("verifiedEmail", email)] -- FIXME aid? Nothing -> do - y <- getYesod - mr <- getMessageRender - setMessage $ mr Msg.InvalidEmailPass + setMessageI Msg.InvalidEmailPass toMaster <- getRouteToMaster redirect RedirectTemporary $ toMaster LoginR @@ -225,14 +218,13 @@ getPasswordR = do toMaster <- getRouteToMaster maid <- maybeAuthId - mr <- getMessageRender case maid of Just _ -> return () Nothing -> do - setMessage $ mr Msg.BadSetPass + setMessageI Msg.BadSetPass redirect RedirectTemporary $ toMaster loginR defaultLayout $ do - setTitle $ mr Msg.SetPassTitle + setTitleI Msg.SetPassTitle addWidget #if GHC7 [whamlet| @@ -257,26 +249,23 @@ postPasswordR :: YesodAuthEmail master => GHandler Auth master () postPasswordR = do - (new, confirm) <- runFormPost' $ (,) - <$> stringInput "new" - <*> stringInput "confirm" + (new, confirm) <- runInputPost $ (,) + <$> ireq textField "new" + <*> ireq textField "confirm" toMaster <- getRouteToMaster y <- getYesod when (new /= confirm) $ do - mr <- getMessageRender - setMessage $ mr Msg.PassMismatch + setMessageI Msg.PassMismatch redirect RedirectTemporary $ toMaster setpassR maid <- maybeAuthId aid <- case maid of Nothing -> do - mr <- getMessageRender - setMessage $ mr Msg.BadSetPass + setMessageI Msg.BadSetPass redirect RedirectTemporary $ toMaster loginR Just aid -> return aid salted <- liftIO $ saltPass new setPassword aid salted - mr <- getMessageRender - setMessage $ mr Msg.PassUpdated + setMessageI Msg.PassUpdated redirect RedirectTemporary $ loginDest y saltLength :: Int diff --git a/Yesod/Auth/Facebook.hs b/Yesod/Auth/Facebook.hs --- a/Yesod/Auth/Facebook.hs +++ b/Yesod/Auth/Facebook.hs @@ -15,8 +15,6 @@ import Yesod.Form import Yesod.Handler import Yesod.Widget -import Yesod.Request (languages) -import Text.Hamlet (hamlet) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class (lift) import Data.Text (Text) @@ -46,7 +44,7 @@ render <- getUrlRender tm <- getRouteToMaster let fb = Facebook.Facebook cid secret $ render $ tm url - code <- runFormGet' $ stringInput "code" + code <- runInputGet $ ireq textField "code" at <- liftIO $ Facebook.getAccessToken fb code let Facebook.AccessToken at' = at so <- liftIO $ Facebook.getGraphData at "me" @@ -58,17 +56,13 @@ render <- lift getUrlRender let fb = Facebook.Facebook cid secret $ render $ tm url let furl = Facebook.getForwardUrl fb $ perms - y <- lift getYesod - l <- lift languages - let mr = renderMessage (getAuth 'x') y l - addHtml #if GHC7 - [hamlet| + [whamlet| #else - [$hamlet| + [$whamlet| #endif

- #{mr Msg.Facebook} + _{Msg.Facebook} |] parseCreds :: Text -> Value -> Data.Aeson.Types.Parser (Creds m) diff --git a/Yesod/Auth/HashDB.hs b/Yesod/Auth/HashDB.hs --- a/Yesod/Auth/HashDB.hs +++ b/Yesod/Auth/HashDB.hs @@ -115,9 +115,9 @@ PersistBackend (YesodDB y (GGHandler Auth y IO))) => GHandler Auth y () postLoginR = do - (mu,mp) <- runFormPost' $ (,) - <$> maybeStringInput "username" - <*> maybeStringInput "password" + (mu,mp) <- runInputPost $ (,) + <$> iopt textField "username" + <*> iopt textField "password" isValid <- case (mu,mp) of (Nothing, _ ) -> return False diff --git a/Yesod/Auth/Message.hs b/Yesod/Auth/Message.hs --- a/Yesod/Auth/Message.hs +++ b/Yesod/Auth/Message.hs @@ -33,8 +33,9 @@ | LoginViaEmail | InvalidLogin | NowLoggedIn + | LoginTitle -defaultMessage :: AuthMessage -> Html +defaultMessage :: AuthMessage -> Text defaultMessage NoOpenID = "No OpenID identifier found" defaultMessage LoginOpenID = "Login via OpenID" defaultMessage Email = "Email" @@ -45,7 +46,7 @@ defaultMessage ConfirmationEmailSentTitle = "Confirmation e-mail sent" defaultMessage (ConfirmationEmailSent email) = "A confirmation e-mail has been sent to " `mappend` - toHtml email `mappend` + email `mappend` "." defaultMessage AddressVerified = "Address verified, please set a new password" defaultMessage InvalidKeyTitle = "Invalid verification key" @@ -62,3 +63,4 @@ defaultMessage LoginViaEmail = "Login via email" defaultMessage InvalidLogin = "Invalid login" defaultMessage NowLoggedIn = "You are now logged in" +defaultMessage LoginTitle = "Login" diff --git a/Yesod/Auth/OAuth.hs b/Yesod/Auth/OAuth.hs --- a/Yesod/Auth/OAuth.hs +++ b/Yesod/Auth/OAuth.hs @@ -22,6 +22,7 @@ import Data.Text.Encoding (encodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Data.ByteString (ByteString) +import Control.Applicative ((<$>), (<*>)) oauthUrl :: Text -> AuthRoute oauthUrl name = PluginR name ["forward"] @@ -51,8 +52,9 @@ tok <- liftIO $ getTemporaryCredential oauth' redirectText RedirectTemporary (fromString $ authorizeUrl oauth' tok) dispatch "GET" [] = do - verifier <- runFormGet' $ stringInput "oauth_verifier" - oaTok <- runFormGet' $ stringInput "oauth_token" + (verifier, oaTok) <- runInputGet $ (,) + <$> ireq textField "oauth_verifier" + <*> ireq textField "oauth_token" let reqTok = Credential [ ("oauth_verifier", encodeUtf8 verifier), ("oauth_token", encodeUtf8 oaTok) ] accTok <- liftIO $ getAccessToken oauth reqTok diff --git a/Yesod/Auth/OpenId.hs b/Yesod/Auth/OpenId.hs --- a/Yesod/Auth/OpenId.hs +++ b/Yesod/Auth/OpenId.hs @@ -43,23 +43,20 @@ padding-left: 18px; |] l <- lift languages - let mr = renderMessage (getAuth 'x') y l - addHamlet #if GHC7 - [hamlet| + [whamlet| #else - [$hamlet| + [$whamlet| #endif -