yesod-auth 1.0.2.1 → 1.1.0
raw patch · 10 files changed
+141/−45 lines, 10 filesdep ~authenticatedep ~blaze-htmldep ~hamlet
Dependency ranges changed: authenticate, blaze-html, hamlet, http-conduit, persistent, persistent-template, wai, yesod-core, yesod-form, yesod-json, yesod-persistent
Files
- Yesod/Auth.hs +5/−1
- Yesod/Auth/BrowserId.hs +1/−0
- Yesod/Auth/Dummy.hs +1/−0
- Yesod/Auth/Email.hs +11/−2
- Yesod/Auth/GoogleEmail.hs +11/−5
- Yesod/Auth/HashDB.hs +4/−3
- Yesod/Auth/Message.hs +70/−0
- Yesod/Auth/OpenId.hs +24/−11
- Yesod/Auth/Rpxnow.hs +1/−0
- yesod-auth.cabal +13/−23
Yesod/Auth.hs view
@@ -149,7 +149,10 @@ Nothing -> when doRedirects $ do case authRoute y of- Nothing -> do rh <- defaultLayout $ toWidget [shamlet| <h1>Invalid login |]+ Nothing -> do rh <- defaultLayout $ toWidget [shamlet|+$newline never+<h1>Invalid login+|] sendResponse rh Just ar -> do setMessageI Msg.InvalidLogin redirect ar@@ -168,6 +171,7 @@ where html' creds = [shamlet|+$newline never <h1>Authentication Status $maybe _ <- creds <p>Logged in.
Yesod/Auth/BrowserId.hs view
@@ -62,6 +62,7 @@ , apLogin = \toMaster -> do addScriptRemote browserIdJs toWidget [hamlet|+$newline never <p> <a href="javascript:navigator.id.getVerifiedEmail(function(a){if(a)document.location='@{toMaster complete}/'+a});"> <img src="https://browserid.org/i/sign_in_green.png">
Yesod/Auth/Dummy.hs view
@@ -24,6 +24,7 @@ url = PluginR "dummy" [] login authToMaster = toWidget [hamlet|+$newline never <form method="post" action="@{authToMaster url}"> Your new identifier is: # <input type="text" name="ident">
Yesod/Auth/Email.hs view
@@ -79,6 +79,7 @@ authEmail = AuthPlugin "email" dispatch $ \tm -> [whamlet|+$newline never <form method="post" action="@{tm loginR}"> <table> <tr>@@ -112,6 +113,7 @@ defaultLayout $ do setTitleI Msg.RegisterLong [whamlet|+$newline never <p>_{Msg.EnterEmail} <form method="post" action="@{toMaster registerR}"> <label for="email">_{Msg.Email}@@ -141,7 +143,10 @@ sendVerifyEmail email verKey verUrl defaultLayout $ do setTitleI Msg.ConfirmationEmailSentTitle- [whamlet| <p>_{Msg.ConfirmationEmailSent email} |]+ [whamlet|+$newline never+<p>_{Msg.ConfirmationEmailSent email}+|] getVerifyR :: YesodAuthEmail m => AuthEmailId m -> Text -> GHandler Auth m RepHtml@@ -161,7 +166,10 @@ _ -> return () defaultLayout $ do setTitleI Msg.InvalidKey- [whamlet| <p>_{Msg.InvalidKey} |]+ [whamlet|+$newline never+<p>_{Msg.InvalidKey}+|] postLoginR :: YesodAuthEmail master => GHandler Auth master () postLoginR = do@@ -200,6 +208,7 @@ defaultLayout $ do setTitleI Msg.SetPassTitle [whamlet|+$newline never <h3>_{Msg.SetPass} <form method="post" action="@{toMaster setpassR}"> <table>
Yesod/Auth/GoogleEmail.hs view
@@ -31,19 +31,25 @@ import qualified Data.Text as T import Control.Exception.Lifted (try, SomeException) +pid :: Text+pid = "googleemail"+ forwardUrl :: AuthRoute-forwardUrl = PluginR "googleemail" ["forward"]+forwardUrl = PluginR pid ["forward"] googleIdent :: Text googleIdent = "https://www.google.com/accounts/o8/id" authGoogleEmail :: YesodAuth m => AuthPlugin m authGoogleEmail =- AuthPlugin "googleemail" dispatch login+ AuthPlugin pid dispatch login where- complete = PluginR "googleemail" ["complete"]+ complete = PluginR pid ["complete"] login tm =- [whamlet|<a href=@{tm forwardUrl}>_{Msg.LoginGoogle}|]+ [whamlet|+$newline never+<a href=@{tm forwardUrl}>_{Msg.LoginGoogle}+|] dispatch "GET" ["forward"] = do render <- getUrlRender toMaster <- getRouteToMaster@@ -86,7 +92,7 @@ let OpenId.Identifier ident = OpenId.oirOpLocal oir memail <- lookupGetParam "openid.ext1.value.email" case (memail, "https://www.google.com/accounts/o8/id" `T.isPrefixOf` ident) of- (Just email, True) -> setCreds True $ Creds "openid" email []+ (Just email, True) -> setCreds True $ Creds pid email [] (_, False) -> do setMessage "Only Google login is supported" redirect $ toMaster LoginR
Yesod/Auth/HashDB.hs view
@@ -76,7 +76,7 @@ import Yesod.Form import Yesod.Auth import Yesod.Widget (toWidget)-import Text.Hamlet (hamlet, shamlet)+import Text.Hamlet (hamlet) import Control.Applicative ((<$>), (<*>)) import Control.Monad (replicateM,liftM)@@ -176,7 +176,7 @@ (validateUser <$> (uniq =<< mu) <*> mp) if isValid then setCreds True $ Creds "hashdb" (fromMaybe "" mu) []- else do setMessage [shamlet| Invalid username/password |]+ else do setMessage "Invalid username/password" toMaster <- getRouteToMaster redirect $ toMaster LoginR @@ -207,7 +207,7 @@ -- user exists Just (Entity uid _) -> return $ Just uid Nothing -> do- setMessage [shamlet| User not found |]+ setMessage "User not found" redirect $ authR LoginR -- | Prompt for username and password, validate that against a database@@ -221,6 +221,7 @@ , PersistUnique b (GHandler Auth m)) => (Text -> Maybe (Unique user b)) -> AuthPlugin m authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> toWidget [hamlet|+$newline never <div id="header"> <h1>Login
Yesod/Auth/Message.hs view
@@ -9,6 +9,8 @@ , swedishMessage , germanMessage , frenchMessage+ , norwegianBokmålMessage+ , japaneseMessage ) where import Data.Monoid (mappend)@@ -220,3 +222,71 @@ frenchMessage LoginTitle = "Se connecter" frenchMessage PleaseProvideUsername = "Merci de renseigner votre nom d'utilisateur" frenchMessage PleaseProvidePassword = "Merci de spécifier un mot de passe"++norwegianBokmålMessage :: AuthMessage -> Text+norwegianBokmålMessage NoOpenID = "Ingen OpenID-identifiserer funnet"+norwegianBokmålMessage LoginOpenID = "Logg inn med OpenID"+norwegianBokmålMessage LoginGoogle = "Logg inn med Google"+norwegianBokmålMessage LoginYahoo = "Logg inn med Yahoo"+norwegianBokmålMessage Email = "E-post"+norwegianBokmålMessage Password = "Passord"+norwegianBokmålMessage Register = "Registrer"+norwegianBokmålMessage RegisterLong = "Registrer en ny konto"+norwegianBokmålMessage EnterEmail = "Skriv inn e-postadressen din nedenfor og en e-postkonfirmasjon vil bli sendt."+norwegianBokmålMessage ConfirmationEmailSentTitle = "E-postkonfirmasjon sendt."+norwegianBokmålMessage (ConfirmationEmailSent email) =+ "En e-postkonfirmasjon har blitt sendt til " `mappend`+ email `mappend`+ "."+norwegianBokmålMessage AddressVerified = "Adresse verifisert, vennligst sett et nytt passord."+norwegianBokmålMessage InvalidKeyTitle = "Ugyldig verifiseringsnøkkel"+norwegianBokmålMessage InvalidKey = "Beklager, men det var en ugyldig verifiseringsnøkkel."+norwegianBokmålMessage InvalidEmailPass = "Ugyldig e-post/passord-kombinasjon"+norwegianBokmålMessage BadSetPass = "Du må være logget inn for å sette et passord."+norwegianBokmålMessage SetPassTitle = "Sett passord"+norwegianBokmålMessage SetPass = "Sett et nytt passord"+norwegianBokmålMessage NewPass = "Nytt passord"+norwegianBokmålMessage ConfirmPass = "Bekreft"+norwegianBokmålMessage PassMismatch = "Passordene stemte ikke overens, vennligst prøv igjen"+norwegianBokmålMessage PassUpdated = "Passord oppdatert"+norwegianBokmålMessage Facebook = "Logg inn med Facebook"+norwegianBokmålMessage LoginViaEmail = "Logg inn med e-post"+norwegianBokmålMessage InvalidLogin = "Ugyldig innlogging"+norwegianBokmålMessage NowLoggedIn = "Du er nå logget inn"+norwegianBokmålMessage LoginTitle = "Logg inn"+norwegianBokmålMessage PleaseProvideUsername = "Vennligst fyll inn ditt brukernavn"+norwegianBokmålMessage PleaseProvidePassword = "Vennligst fyll inn ditt passord"++japaneseMessage :: AuthMessage -> Text+japaneseMessage NoOpenID = "OpenID識別子がありません"+japaneseMessage LoginOpenID = "OpenIDでログイン"+japaneseMessage LoginGoogle = "Googleでログイン"+japaneseMessage LoginYahoo = "Yahooでログイン"+japaneseMessage Email = "Eメール"+japaneseMessage Password = "パスワード"+japaneseMessage Register = "登録"+japaneseMessage RegisterLong = "新規アカウント登録"+japaneseMessage EnterEmail = "メールアドレスを入力してください。確認メールが送られます"+japaneseMessage ConfirmationEmailSentTitle = "確認メールを送信しました"+japaneseMessage (ConfirmationEmailSent email) =+ "確認メールを " `mappend`+ email `mappend`+ " に送信しました"+japaneseMessage AddressVerified = "アドレスは認証されました。新しいパスワードを設定してください"+japaneseMessage InvalidKeyTitle = "認証キーが無効です"+japaneseMessage InvalidKey = "申し訳ありません。無効な認証キーです"+japaneseMessage InvalidEmailPass = "メールアドレスまたはパスワードが無効です"+japaneseMessage BadSetPass = "パスワードを設定するためには、ログインしてください"+japaneseMessage SetPassTitle = "パスワードの設定"+japaneseMessage SetPass = "新しいパスワードを設定する"+japaneseMessage NewPass = "新しいパスワード"+japaneseMessage ConfirmPass = "確認"+japaneseMessage PassMismatch = "パスワードが合いません。もう一度試してください"+japaneseMessage PassUpdated = "パスワードは更新されました"+japaneseMessage Facebook = "Facebookでログイン"+japaneseMessage LoginViaEmail = "Eメールでログイン"+japaneseMessage InvalidLogin = "無効なログインです"+japaneseMessage NowLoggedIn = "ログインしました"+japaneseMessage LoginTitle = "ログイン"+japaneseMessage PleaseProvideUsername = "ユーザ名を入力してください"+japaneseMessage PleaseProvidePassword = "パスワードを入力してください"
Yesod/Auth/OpenId.hs view
@@ -3,10 +3,11 @@ {-# LANGUAGE CPP #-} module Yesod.Auth.OpenId ( authOpenId- , authOpenIdExtended , forwardUrl , claimedKey+ , opLocalKey , credsIdentClaimed+ , IdentifierType (..) ) where import Yesod.Auth@@ -30,11 +31,13 @@ forwardUrl :: AuthRoute forwardUrl = PluginR "openid" ["forward"] -authOpenId :: YesodAuth m => AuthPlugin m-authOpenId = authOpenIdExtended []+data IdentifierType = Claimed | OPLocal -authOpenIdExtended :: YesodAuth m => [(Text, Text)] -> AuthPlugin m-authOpenIdExtended extensionFields =+authOpenId :: YesodAuth m+ => IdentifierType+ -> [(Text, Text)] -- ^ extension fields+ -> AuthPlugin m+authOpenId idType extensionFields = AuthPlugin "openid" dispatch login where complete = PluginR "openid" ["complete"]@@ -46,6 +49,7 @@ padding-left: 18px; |] [whamlet|+$newline never <form method="get" action="@{tm forwardUrl}"> <input type="hidden" name="openid_identifier" value="https://www.google.com/accounts/o8/id"> <button .openid-google>_{Msg.LoginGoogle}@@ -78,15 +82,15 @@ dispatch "GET" ["complete", ""] = dispatch "GET" ["complete"] -- compatibility issues dispatch "GET" ["complete"] = do rr <- getRequest- completeHelper $ reqGetParams rr+ completeHelper idType $ reqGetParams rr dispatch "POST" ["complete", ""] = dispatch "POST" ["complete"] -- compatibility issues dispatch "POST" ["complete"] = do (posts, _) <- runRequestBody- completeHelper posts+ completeHelper idType posts dispatch _ _ = notFound -completeHelper :: YesodAuth m => [(Text, Text)] -> GHandler Auth m ()-completeHelper gets' = do+completeHelper :: YesodAuth m => IdentifierType -> [(Text, Text)] -> GHandler Auth m ()+completeHelper idType gets' = do master <- getYesod eres <- lift $ try $ OpenId.authenticateClaimed gets' (authHttpManager master) toMaster <- getRouteToMaster@@ -98,8 +102,14 @@ case OpenId.oirClaimed oir of Nothing -> id Just (OpenId.Identifier i') -> ((claimedKey, i'):)- gets'' = claimed $ filter (\(k, _) -> not $ "__" `isPrefixOf` k) gets'- i = OpenId.identifier $ OpenId.oirOpLocal oir+ oplocal =+ case OpenId.oirOpLocal oir of+ OpenId.Identifier i' -> ((opLocalKey, i'):)+ gets'' = oplocal $ claimed $ filter (\(k, _) -> not $ "__" `isPrefixOf` k) gets'+ i = OpenId.identifier $+ case idType of+ OPLocal -> OpenId.oirOpLocal oir+ Claimed -> fromMaybe (OpenId.oirOpLocal oir) $ OpenId.oirClaimed oir setCreds True $ Creds "openid" i gets'' either onFailure onSuccess eres @@ -116,6 +126,9 @@ -- Since 1.0.2 claimedKey :: Text claimedKey = "__CLAIMED"++opLocalKey :: Text+opLocalKey = "__OPLOCAL" -- | A helper function which will get the claimed identifier, if available, falling back to the OP local identifier. --
Yesod/Auth/Rpxnow.hs view
@@ -25,6 +25,7 @@ login tm = do let url = {- FIXME urlEncode $ -} tm $ PluginR "rpxnow" [] toWidget [hamlet|+$newline never <iframe src="http://#{app}.rpxnow.com/openid/embed?token_url=@{url}" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px"> |] dispatch _ [] = do
yesod-auth.cabal view
@@ -1,5 +1,5 @@ name: yesod-auth-version: 1.0.2.1+version: 1.1.0 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin@@ -12,44 +12,34 @@ homepage: http://www.yesodweb.com/ description: Authentication for Yesod. -flag blaze_html_0_5- description: use blaze-html 0.5 and blaze-markup 0.5- default: True- library build-depends: base >= 4 && < 5- , authenticate >= 1.2.1 && < 1.3+ , authenticate >= 1.3 && < 1.4 , bytestring >= 0.9.1.4- , yesod-core >= 1.0 && < 1.1- , wai >= 1.2 && < 1.3+ , yesod-core >= 1.1 && < 1.2+ , wai >= 1.3 && < 1.4 , template-haskell , pureMD5 >= 2.0 && < 2.2 , random >= 1.0.0.2 && < 1.1 , text >= 0.7 && < 0.12 , mime-mail >= 0.3 && < 0.5- , yesod-persistent >= 1.0 && < 1.1- , hamlet >= 1.0 && < 1.1+ , yesod-persistent >= 1.1 && < 1.2+ , hamlet >= 1.1 && < 1.2 , shakespeare-css >= 1.0 && < 1.1- , yesod-json >= 1.0 && < 1.1+ , yesod-json >= 1.1 && < 1.2 , containers , unordered-containers- , yesod-form >= 1.0 && < 1.1+ , yesod-form >= 1.1 && < 1.2 , transformers >= 0.2.2 && < 0.4- , persistent >= 0.9 && < 0.10- , persistent-template >= 0.9 && < 0.10+ , persistent >= 1.0 && < 1.1+ , persistent-template >= 1.0 && < 1.1 , SHA >= 1.4.1.3 && < 1.6- , http-conduit >= 1.4.1.1 && < 1.5+ , http-conduit >= 1.5 && < 1.6 , aeson >= 0.5 , pwstore-fast >= 2.2 && < 3 , lifted-base >= 0.1 && < 0.2-- if flag(blaze_html_0_5)- build-depends:- blaze-html >= 0.5 && < 0.6- , blaze-markup >= 0.5.1 && < 0.6- else- build-depends:- blaze-html >= 0.4 && < 0.5+ , blaze-html >= 0.5 && < 0.6+ , blaze-markup >= 0.5.1 && < 0.6 exposed-modules: Yesod.Auth Yesod.Auth.BrowserId