yesod-auth-1.2.0.2/0000755000000000000000000000000012166214613012124 5ustar0000000000000000yesod-auth-1.2.0.2/yesod-auth.cabal0000644000000000000000000000612412166214613015175 0ustar0000000000000000name: yesod-auth version: 1.2.0.2 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin maintainer: Michael Snoyman synopsis: Authentication for Yesod. category: Web, Yesod stability: Stable cabal-version: >= 1.6.0 build-type: Simple homepage: http://www.yesodweb.com/ description: This package provides a pluggable mechanism for allowing users to authenticate with your site. It comes with a number of common plugins, such as OpenID, BrowserID (a.k.a., Mozilla Persona), and email. Other packages are available from Hackage as well. If you've written such an add-on, please notify me so that it can be added to this description. . * : An account authentication plugin for Yesod extra-source-files: persona_sign_in_blue.png library build-depends: base >= 4 && < 5 , authenticate >= 1.3 , bytestring >= 0.9.1.4 , yesod-core >= 1.2 && < 1.3 , wai >= 1.4 , template-haskell , pureMD5 >= 2.0 , random >= 1.0.0.2 , text >= 0.7 , mime-mail >= 0.3 , yesod-persistent >= 1.2 , hamlet >= 1.1 && < 1.2 , shakespeare-css >= 1.0 && < 1.1 , shakespeare-js >= 1.0.2 && < 1.2 , containers , unordered-containers , yesod-form >= 1.3 && < 1.4 , transformers >= 0.2.2 , persistent >= 1.2 && < 1.3 , persistent-template >= 1.2 && < 1.3 , SHA >= 1.4.1.3 , http-conduit >= 1.5 , aeson >= 0.5 , pwstore-fast >= 2.2 , lifted-base >= 0.1 , blaze-html >= 0.5 , blaze-markup >= 0.5.1 , network , http-types , file-embed , email-validate >= 1.0 , data-default , resourcet exposed-modules: Yesod.Auth Yesod.Auth.BrowserId Yesod.Auth.Dummy Yesod.Auth.Email Yesod.Auth.OpenId Yesod.Auth.Rpxnow Yesod.Auth.HashDB Yesod.Auth.Message Yesod.Auth.GoogleEmail other-modules: Yesod.Auth.Routes ghc-options: -Wall source-repository head type: git location: https://github.com/yesodweb/yesod yesod-auth-1.2.0.2/LICENSE0000644000000000000000000000207512166214613013135 0ustar0000000000000000Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. yesod-auth-1.2.0.2/persona_sign_in_blue.png0000644000000000000000000000714412166214613017024 0ustar0000000000000000PNG  IHDRm+IDATxYWTy+yƈ=iRJ`XMҥ 1"z5T1 κL ̬^[g)$;+a2&{C#0)FtU?cFa(Gtlx뾼oDQי^ƇyCFa(FCW8qg=u_X{F ݷt ϟ Г:fɽ;r`uM<+|{L?I{cEZVnK5HrUʹMzC@^H)-TaT7 /?'G;Ch"XZZʊf.+һbw&n+FzX¤ߚӁ i3iX!^¶ /H8@z`uV/LtcU7Ve$;DW߃l`¸U=lg|~6Q,/1>ѷ^}0w\Z֤}]XOr܂ L7iH¹`>+ziU?={[R3Z$P= Wd#0c=!&ۿ"&+0LMM-> Zu{J;c[cA20"X; H:{EP+"fxp,Ac7`yBܓiNubyb3ɗdCOA.Ae~An~a} OCGen5jt8^>.Ug|o9?壘8箴rH.]똒^38ʞ(=i3)xR~KiOGs#šdGqhM3!rdCs=)ڲ>&… aaa Ӿ^X.$x\w y ]FvUBRYߎrD 7E$\$9ͻ_fKV>k/ÉJtFA^I5O.F$\)4}>u8]D}x5 Rz\&4wߔLqfEL.\CeYFIrtk%hqM ^%quZVkߌפ~MT1=M}`iAi +qY1cݹX)s;h I~źKe8]34Xzō\&$"cYrޖ,ޙT$;0m$zfy\ZdIfyؖVHZ/6_c] ]X=Qu~fzb(,;Q5`z|:8krM \Sl=7.ށ.;М7o=iM הn A%{r`Kj1"]C_x>I*:YT[+R$o$؅WHۭ'rK*+ͱdeQj ,=zE/:䗩AzN#nu;ӫ"q?xX!הq5%X{[֩!qω[w@oKR'q 1O/GL$0jVgX\8вQ5Yn/:l˨Gz=)ğ c3g&=퓝pg$vB"C4.&Zi/$NՎ 7"x MB%ACN 曘:u*ٳ5i^gG1;FdS[QzlB* pv*Ȇ"I2g+xX#B~o`9hr\Cl3v5<))>\g yݏ Ƀա""ԩ 6 {T<P&RYMN,eY1mVl,f[1oS$hGrԯzvb@?#v .W女Xפ]3?9WՒ3ա|G+SVXx>[xw1sL̚5-Ak>ّ=Mj 6E7?$OVo[|1"rK%%E C~ŰnPmªLX,ß!zkG%ZEY4$?v /p鏢+j~Nzq^KĶܚ:e̊g?"@_Ir94Ϡ{]C\EEyn?Njפ]{'OҶ!gXWAu[O N铄nl"x}#{;lo0Ŵ fx\,X(wU: ƘRR7p g?Ł~"~ \N WCUT{3agpbsh~yA/> e/wiu O~Hn{åj:u6i՞3^.y#R |xGo֗tNn;әK.I>\ ٘%ӮINsoDփgp9RT.,})" > 5 #7 ufZ¾0?XwW4y8m T7m}x$AdK ?/HXm#0gc$-?uz3F"&kqL $?A~#HȤ&\l(N#^VK1(͙-@̩eO(2)¯qu4ѽ// DQ~cB# .#caڴiD^]Ų&B& f~k];O^⑜FM0'Z|z`HXXzaRa"P\(QO|l| p 7l1 CH%A&6>Z P 7 % [F #$ӝl, *gXh0`~b篂SF`"Xmɺຈ|N{aƺFaHEDiIENDB`yesod-auth-1.2.0.2/Setup.lhs0000644000000000000000000000021712166214613013734 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > import System.Cmd (system) > main :: IO () > main = defaultMain yesod-auth-1.2.0.2/Yesod/0000755000000000000000000000000012166214613013207 5ustar0000000000000000yesod-auth-1.2.0.2/Yesod/Auth.hs0000644000000000000000000003230312166214613014445 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Yesod.Auth ( -- * Subsite Auth , AuthRoute , Route (..) , AuthPlugin (..) , getAuth , YesodAuth (..) , YesodAuthPersist , AuthEntity -- * Plugin interface , Creds (..) , setCreds , clearCreds , loginErrorMessage , loginErrorMessageI -- * User functions , defaultMaybeAuthId , maybeAuth , requireAuthId , requireAuth -- * Exception , AuthException (..) -- * Helper , AuthHandler ) where import Control.Monad (when) import Control.Monad.Trans.Maybe import Yesod.Auth.Routes import Data.Aeson import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Data.Text (Text) import qualified Data.Text as T import qualified Data.HashMap.Lazy as Map import Data.Monoid (Endo) import Network.HTTP.Conduit (Manager) import qualified Network.Wai as W import Text.Hamlet (shamlet) import Yesod.Core import Yesod.Persist import Yesod.Auth.Message (AuthMessage, defaultMessage) import qualified Yesod.Auth.Message as Msg import Yesod.Form (FormMessage) import Data.Typeable (Typeable) import Control.Exception (Exception) import Network.HTTP.Types (unauthorized401) import Control.Monad.Trans.Resource (MonadResourceBase) import qualified Control.Monad.Trans.Writer as Writer type AuthRoute = Route Auth type AuthHandler master a = YesodAuth master => HandlerT Auth (HandlerT master IO) a type Method = Text type Piece = Text data AuthPlugin master = AuthPlugin { apName :: Text , apDispatch :: Method -> [Piece] -> AuthHandler master () , apLogin :: (Route Auth -> Route master) -> WidgetT master IO () } getAuth :: a -> Auth getAuth = const Auth -- | User credentials data Creds master = Creds { credsPlugin :: Text -- ^ How the user was authenticated , credsIdent :: Text -- ^ Identifier. Exact meaning depends on plugin. , credsExtra :: [(Text, Text)] } class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage) => YesodAuth master where type AuthId master -- | Default destination on successful login, if no other -- destination exists. loginDest :: master -> Route master -- | Default destination on successful logout, if no other -- destination exists. logoutDest :: master -> Route master -- | Determine the ID associated with the set of credentials. getAuthId :: Creds master -> HandlerT master IO (Maybe (AuthId master)) -- | Which authentication backends to use. authPlugins :: master -> [AuthPlugin master] -- | What to show on the login page. loginHandler :: AuthHandler master RepHtml loginHandler = do tp <- getRouteToParent lift $ defaultLayout $ do setTitleI Msg.LoginTitle master <- getYesod mapM_ (flip apLogin tp) (authPlugins master) -- | Used for i18n of messages provided by this package. renderAuthMessage :: master -> [Text] -- ^ languages -> AuthMessage -> Text renderAuthMessage _ _ = defaultMessage -- | After login and logout, redirect to the referring page, instead of -- 'loginDest' and 'logoutDest'. Default is 'False'. redirectToReferer :: master -> Bool redirectToReferer _ = False -- | Return an HTTP connection manager that is stored in the foundation -- type. This allows backends to reuse persistent connections. If none of -- the backends you're using use HTTP connections, you can safely return -- @error \"authHttpManager\"@ here. authHttpManager :: master -> Manager -- | Called on a successful login. By default, calls -- @setMessageI NowLoggedIn@. onLogin :: HandlerT master IO () onLogin = setMessageI Msg.NowLoggedIn -- | Called on logout. By default, does nothing onLogout :: HandlerT master IO () onLogout = return () -- | Retrieves user credentials, if user is authenticated. -- -- By default, this calls 'defaultMaybeAuthId' to get the user ID from the -- session. This can be overridden to allow authentication via other means, -- such as checking for a special token in a request header. This is -- especially useful for creating an API to be accessed via some means -- other than a browser. -- -- Since 1.2.0 maybeAuthId :: HandlerT master IO (Maybe (AuthId master)) default maybeAuthId :: ( YesodAuth master , PersistMonadBackend (b (HandlerT master IO)) ~ PersistEntityBackend val , b ~ YesodPersistBackend master , Key val ~ AuthId master , PersistStore (b (HandlerT master IO)) , PersistEntity val , YesodPersist master , Typeable val ) => HandlerT master IO (Maybe (AuthId master)) maybeAuthId = defaultMaybeAuthId credsKey :: Text credsKey = "_ID" -- | Retrieves user credentials from the session, if user is authenticated. -- -- This function does /not/ confirm that the credentials are valid, see -- 'maybeAuthIdRaw' for more information. -- -- Since 1.1.2 defaultMaybeAuthId :: ( YesodAuth master , PersistMonadBackend (b (HandlerT master IO)) ~ PersistEntityBackend val , b ~ YesodPersistBackend master , Key val ~ AuthId master , PersistStore (b (HandlerT master IO)) , PersistEntity val , YesodPersist master , Typeable val ) => HandlerT master IO (Maybe (AuthId master)) defaultMaybeAuthId = do ms <- lookupSession credsKey case ms of Nothing -> return Nothing Just s -> case fromPathPiece s of Nothing -> return Nothing Just aid -> fmap (fmap entityKey) $ cachedAuth aid cachedAuth :: ( YesodAuth master , PersistMonadBackend (b (HandlerT master IO)) ~ PersistEntityBackend val , b ~ YesodPersistBackend master , Key val ~ AuthId master , PersistStore (b (HandlerT master IO)) , PersistEntity val , YesodPersist master , Typeable val ) => AuthId master -> HandlerT master IO (Maybe (Entity val)) cachedAuth aid = runMaybeT $ do a <- MaybeT $ fmap unCachedMaybeAuth $ cached $ fmap CachedMaybeAuth $ runDB $ get aid return $ Entity aid a loginErrorMessageI :: (MonadResourceBase m, YesodAuth master) => Route child -> AuthMessage -> HandlerT child (HandlerT master m) a loginErrorMessageI dest msg = do toParent <- getRouteToParent lift $ loginErrorMessageMasterI (toParent dest) msg loginErrorMessageMasterI :: (YesodAuth master, MonadResourceBase m, RenderMessage master AuthMessage) => Route master -> AuthMessage -> HandlerT master m a loginErrorMessageMasterI dest msg = do mr <- getMessageRender loginErrorMessage dest (mr msg) -- | For HTML, set the message and redirect to the route. -- For JSON, send the message and a 401 status loginErrorMessage :: MonadResourceBase m => Route site -> Text -> HandlerT site m a loginErrorMessage dest msg = sendResponseStatus unauthorized401 =<< ( selectRep $ do provideRep $ do setMessage $ toHtml msg fmap asHtml $ redirect dest provideJsonMessage msg ) where asHtml :: Html -> Html asHtml = id provideJsonMessage :: Monad m => Text -> Writer.Writer (Endo [ProvidedRep m]) () provideJsonMessage msg = provideRep $ return $ object ["message" .= msg] -- | Sets user credentials for the session after checking them with authentication backends. setCreds :: YesodAuth master => Bool -- ^ if HTTP redirects should be done -> Creds master -- ^ new credentials -> HandlerT master IO () setCreds doRedirects creds = do y <- getYesod maid <- getAuthId creds case maid of Nothing -> when doRedirects $ do case authRoute y of Nothing -> do sendResponseStatus unauthorized401 =<< ( selectRep $ do provideRep $ defaultLayout $ toWidget [shamlet|

Invalid login|] provideJsonMessage "Invalid Login" ) Just ar -> loginErrorMessageMasterI ar Msg.InvalidLogin Just aid -> do setSession credsKey $ toPathPiece aid when doRedirects $ do onLogin res <- selectRep $ do provideRepType typeHtml $ do _ <- redirectUltDest $ loginDest y return () provideJsonMessage "Login Successful" sendResponse res -- | Clears current user credentials for the session. -- -- Since 1.1.7 clearCreds :: YesodAuth master => Bool -- ^ if HTTP redirect to 'logoutDest' should be done -> HandlerT master IO () clearCreds doRedirects = do y <- getYesod deleteSession credsKey when doRedirects $ do onLogout redirectUltDest $ logoutDest y getCheckR :: AuthHandler master TypedContent getCheckR = lift $ do creds <- maybeAuthId defaultLayoutJson (do setTitle "Authentication Status" toWidget $ html' creds) (return $ jsonCreds creds) where html' creds = [shamlet| $newline never

Authentication Status $maybe _ <- creds

Logged in. $nothing

Not logged in. |] jsonCreds creds = Object $ Map.fromList [ (T.pack "logged_in", Bool $ maybe False (const True) creds) ] setUltDestReferer' :: AuthHandler master () setUltDestReferer' = lift $ do master <- getYesod when (redirectToReferer master) setUltDestReferer getLoginR :: AuthHandler master RepHtml getLoginR = setUltDestReferer' >> loginHandler getLogoutR :: AuthHandler master () getLogoutR = setUltDestReferer' >> redirectToPost LogoutR postLogoutR :: AuthHandler master () postLogoutR = lift $ clearCreds True handlePluginR :: Text -> [Text] -> AuthHandler master () handlePluginR plugin pieces = do master <- lift getYesod env <- waiRequest let method = decodeUtf8With lenientDecode $ W.requestMethod env case filter (\x -> apName x == plugin) (authPlugins master) of [] -> notFound ap:_ -> apDispatch ap method pieces maybeAuth :: ( YesodAuth master , PersistMonadBackend (b (HandlerT master IO)) ~ PersistEntityBackend val , b ~ YesodPersistBackend master , Key val ~ AuthId master , PersistStore (b (HandlerT master IO)) , PersistEntity val , YesodPersist master , Typeable val ) => HandlerT master IO (Maybe (Entity val)) maybeAuth = runMaybeT $ do aid <- MaybeT maybeAuthId MaybeT $ cachedAuth aid newtype CachedMaybeAuth val = CachedMaybeAuth { unCachedMaybeAuth :: Maybe val } deriving Typeable -- | Constraint which states that the given site is an instance of @YesodAuth@ -- and that its @AuthId@ is in fact a persistent @Key@ for the given value. -- This is the common case in Yesod, and means that you can easily look up the -- full informatin on a given user. -- -- Since 1.2.0 type YesodAuthPersist master = ( YesodAuth master , PersistMonadBackend (YesodPersistBackend master (HandlerT master IO)) ~ PersistEntityBackend (AuthEntity master) , Key (AuthEntity master) ~ AuthId master , PersistStore (YesodPersistBackend master (HandlerT master IO)) , PersistEntity (AuthEntity master) , YesodPersist master , Typeable (AuthEntity master) ) -- | If the @AuthId@ for a given site is a persistent ID, this will give the -- value for that entity. E.g.: -- -- > type AuthId MySite = UserId -- > AuthEntity MySite ~ User -- -- Since 1.2.0 type AuthEntity master = KeyEntity (AuthId master) -- | Similar to 'maybeAuthId', but redirects to a login page if user is not -- authenticated. -- -- Since 1.1.0 requireAuthId :: YesodAuthPersist master => HandlerT master IO (AuthId master) requireAuthId = maybeAuthId >>= maybe redirectLogin return requireAuth :: YesodAuthPersist master => HandlerT master IO (Entity (AuthEntity master)) requireAuth = maybeAuth >>= maybe redirectLogin return redirectLogin :: Yesod master => HandlerT master IO a redirectLogin = do y <- getYesod setUltDestCurrent case authRoute y of Just z -> redirect z Nothing -> permissionDenied "Please configure authRoute" instance YesodAuth master => RenderMessage master AuthMessage where renderMessage = renderAuthMessage data AuthException = InvalidFacebookResponse deriving (Show, Typeable) instance Exception AuthException instance YesodAuth master => YesodSubDispatch Auth (HandlerT master IO) where yesodSubDispatch = $(mkYesodSubDispatch resourcesAuth) yesod-auth-1.2.0.2/Yesod/Auth/0000755000000000000000000000000012166214613014110 5ustar0000000000000000yesod-auth-1.2.0.2/Yesod/Auth/Message.hs0000644000000000000000000006273212166214613016042 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Yesod.Auth.Message ( AuthMessage (..) , defaultMessage -- * All languages , englishMessage , portugueseMessage , swedishMessage , germanMessage , frenchMessage , norwegianBokmålMessage , japaneseMessage , finnishMessage , chineseMessage , spanishMessage ) where import Data.Monoid (mappend) import Data.Text (Text) data AuthMessage = NoOpenID | LoginOpenID | LoginGoogle | LoginYahoo | Email | Password | Register | RegisterLong | EnterEmail | ConfirmationEmailSentTitle | ConfirmationEmailSent Text | AddressVerified | InvalidKeyTitle | InvalidKey | InvalidEmailPass | BadSetPass | SetPassTitle | SetPass | NewPass | ConfirmPass | PassMismatch | PassUpdated | Facebook | LoginViaEmail | InvalidLogin | NowLoggedIn | LoginTitle | PleaseProvideUsername | PleaseProvidePassword | NoIdentifierProvided | InvalidEmailAddress | PasswordResetTitle | ProvideIdentifier | SendPasswordResetEmail | PasswordResetPrompt | InvalidUsernamePass -- | Defaults to 'englishMessage'. defaultMessage :: AuthMessage -> Text defaultMessage = englishMessage englishMessage :: AuthMessage -> Text englishMessage NoOpenID = "No OpenID identifier found" englishMessage LoginOpenID = "Login via OpenID" englishMessage LoginGoogle = "Login via Google" englishMessage LoginYahoo = "Login via Yahoo" englishMessage Email = "Email" englishMessage Password = "Password" englishMessage Register = "Register" englishMessage RegisterLong = "Register a new account" englishMessage EnterEmail = "Enter your e-mail address below, and a confirmation e-mail will be sent to you." englishMessage ConfirmationEmailSentTitle = "Confirmation e-mail sent" englishMessage (ConfirmationEmailSent email) = "A confirmation e-mail has been sent to " `mappend` email `mappend` "." englishMessage AddressVerified = "Address verified, please set a new password" englishMessage InvalidKeyTitle = "Invalid verification key" englishMessage InvalidKey = "I'm sorry, but that was an invalid verification key." englishMessage InvalidEmailPass = "Invalid email/password combination" englishMessage BadSetPass = "You must be logged in to set a password" englishMessage SetPassTitle = "Set password" englishMessage SetPass = "Set a new password" englishMessage NewPass = "New password" englishMessage ConfirmPass = "Confirm" englishMessage PassMismatch = "Passwords did not match, please try again" englishMessage PassUpdated = "Password updated" englishMessage Facebook = "Login with Facebook" englishMessage LoginViaEmail = "Login via email" englishMessage InvalidLogin = "Invalid login" englishMessage NowLoggedIn = "You are now logged in" englishMessage LoginTitle = "Login" englishMessage PleaseProvideUsername = "Please fill in your username" englishMessage PleaseProvidePassword = "Please fill in your password" englishMessage NoIdentifierProvided = "No email/username provided" englishMessage InvalidEmailAddress = "Invalid email address provided" englishMessage PasswordResetTitle = "Password Reset" englishMessage ProvideIdentifier = "Email or Username" englishMessage SendPasswordResetEmail = "Send password reset email" englishMessage PasswordResetPrompt = "Enter your e-mail address or username below, and a password reset e-mail will be sent to you." englishMessage InvalidUsernamePass = "Invalid username/password combination" portugueseMessage :: AuthMessage -> Text portugueseMessage NoOpenID = "Nenhum identificador OpenID encontrado" portugueseMessage LoginOpenID = "Entrar via OpenID" portugueseMessage LoginGoogle = "Entrar via Google" portugueseMessage LoginYahoo = "Entrar via Yahoo" portugueseMessage Email = "E-mail" portugueseMessage Password = "Senha" portugueseMessage Register = "Registrar" portugueseMessage RegisterLong = "Registrar uma nova conta" portugueseMessage EnterEmail = "Por favor digite seu endereço de e-mail abaixo e um e-mail de confirmação será enviado para você." portugueseMessage ConfirmationEmailSentTitle = "E-mail de confirmação enviado" portugueseMessage (ConfirmationEmailSent email) = "Um e-mail de confirmação foi enviado para " `mappend` email `mappend` "." portugueseMessage AddressVerified = "Endereço verificado, por favor entre com uma nova senha" portugueseMessage InvalidKeyTitle = "Chave de verificação inválida" portugueseMessage InvalidKey = "Por favor nos desculpe, mas essa é uma chave de verificação inválida." portugueseMessage InvalidEmailPass = "E-mail e/ou senha inválidos" portugueseMessage BadSetPass = "Você deve entrar para definir uma senha" portugueseMessage SetPassTitle = "Definir senha" portugueseMessage SetPass = "Definir uma nova senha" portugueseMessage NewPass = "Nova senha" portugueseMessage ConfirmPass = "Confirmar" portugueseMessage PassMismatch = "Senhas não conferem, por favor tente novamente" portugueseMessage PassUpdated = "Senhas alteradas" portugueseMessage Facebook = "Entrar via Facebook" portugueseMessage LoginViaEmail = "Entrar via e-mail" portugueseMessage InvalidLogin = "Informações de login inválidas" portugueseMessage NowLoggedIn = "Você acaba de entrar no site com sucesso!" portugueseMessage LoginTitle = "Entrar no site" portugueseMessage PleaseProvideUsername = "Por favor digite seu nome de usuário" portugueseMessage PleaseProvidePassword = "Por favor digite sua senha" portugueseMessage NoIdentifierProvided = "Nenhum e-mail ou nome de usuário informado" portugueseMessage InvalidEmailAddress = "Endereço de e-mail inválido informado" portugueseMessage PasswordResetTitle = "Resetar senha" portugueseMessage ProvideIdentifier = "E-mail ou nome de usuário" portugueseMessage SendPasswordResetEmail = "Enviar e-mail para resetar senha" portugueseMessage PasswordResetPrompt = "Insira seu endereço de e-mail ou nome de usuário abaixo. Um e-mail para resetar sua senha será enviado para você." portugueseMessage InvalidUsernamePass = "Nome de usuário ou senha inválidos" spanishMessage :: AuthMessage -> Text spanishMessage NoOpenID = "No se encuentra el identificador OpenID" spanishMessage LoginOpenID = "Entrar utilizando OpenID" spanishMessage LoginGoogle = "Entrar utilizando Google" spanishMessage LoginYahoo = "Entrar utilizando Yahoo" spanishMessage Email = "Correo electrónico" spanishMessage Password = "Contraseña" spanishMessage Register = "Registrarse" spanishMessage RegisterLong = "Registrar una nueva cuenta" spanishMessage EnterEmail = "Coloque su dirección de correo electrónico, y un correo de confirmación le será enviado a su cuenta." spanishMessage ConfirmationEmailSentTitle = "La confirmación de correo ha sido enviada" spanishMessage (ConfirmationEmailSent email) = "Una confirmación de correo electrónico ha sido enviada a " `mappend` email `mappend` "." spanishMessage AddressVerified = "Dirección verificada, por favor introduzca una contraseña" spanishMessage InvalidKeyTitle = "Clave de verificación invalida" spanishMessage InvalidKey = "Lo sentimos, pero esa clave de verificación es inválida." spanishMessage InvalidEmailPass = "La combinación cuenta de correo/contraseña es inválida" spanishMessage BadSetPass = "Debe acceder a la aplicación para modificar la contraseña" spanishMessage SetPassTitle = "Modificar contraseña" spanishMessage SetPass = "Actualizar nueva contraseña" spanishMessage NewPass = "Nueva contraseña" spanishMessage ConfirmPass = "Confirmar" spanishMessage PassMismatch = "Las contraseñas no coinciden, inténtelo de nuevo" spanishMessage PassUpdated = "Contraseña actualizada" spanishMessage Facebook = "Entrar mediante Facebook" spanishMessage LoginViaEmail = "Entrar mediante una cuenta de correo" spanishMessage InvalidLogin = "Login inválido" spanishMessage NowLoggedIn = "Usted ha ingresado al sitio" spanishMessage LoginTitle = "Login" spanishMessage PleaseProvideUsername = "Por favor escriba su nombre de usuario" spanishMessage PleaseProvidePassword = "Por favor escriba su contraseña" spanishMessage NoIdentifierProvided = "No ha indicado una cuenta de correo/nombre de usuario" spanishMessage InvalidEmailAddress = "La cuenta de correo es inválida" spanishMessage PasswordResetTitle = "Contraseña actualizada" spanishMessage ProvideIdentifier = "Cuenta de correo o nombre de usuario" spanishMessage SendPasswordResetEmail = "Correo de actualización de contraseña enviado" spanishMessage PasswordResetPrompt = "Escriba su cuenta de correo o nombre de usuario, y una confirmación de actualización de contraseña será enviada a su cuenta de correo." spanishMessage InvalidUsernamePass = "Combinación de nombre de usuario/contraseña invalida" swedishMessage :: AuthMessage -> Text swedishMessage NoOpenID = "Fann ej OpenID identifierare" swedishMessage LoginOpenID = "Logga in via OpenID" swedishMessage LoginGoogle = "Logga in via Google" swedishMessage LoginYahoo = "Logga in via Yahoo" swedishMessage Email = "Epost" swedishMessage Password = "Lösenord" swedishMessage Register = "Registrera" swedishMessage RegisterLong = "Registrera ett nytt konto" swedishMessage EnterEmail = "Skriv in din epost nedan så kommer ett konfirmationsmail skickas till adressen." swedishMessage ConfirmationEmailSentTitle = "Konfirmationsmail skickat" swedishMessage (ConfirmationEmailSent email) = "Ett konfirmationsmeddelande har skickats till" `mappend` email `mappend` "." swedishMessage AddressVerified = "Adress verifierad, vänligen välj nytt lösenord" swedishMessage InvalidKeyTitle = "Ogiltig verifikationsnyckel" swedishMessage InvalidKey = "Tyvärr, du angav en ogiltig verifimationsnyckel." swedishMessage InvalidEmailPass = "Ogiltig epost/lösenord kombination" swedishMessage BadSetPass = "Du måste vara inloggad för att ange ett lösenord" swedishMessage SetPassTitle = "Ange lösenord" swedishMessage SetPass = "Ange nytt lösenord" swedishMessage NewPass = "Nytt lösenord" swedishMessage ConfirmPass = "Godkänn" swedishMessage PassMismatch = "Lösenorden matcha ej, vänligen försök igen" swedishMessage PassUpdated = "Lösenord updaterades" swedishMessage Facebook = "Logga in med Facebook" swedishMessage LoginViaEmail = "Logga in via epost" swedishMessage InvalidLogin = "Ogiltigt login" swedishMessage NowLoggedIn = "Du är nu inloggad" swedishMessage LoginTitle = "Logga in" swedishMessage PleaseProvideUsername = "Vänligen fyll i användarnamn" swedishMessage PleaseProvidePassword = "Vänligen fyll i lösenord" swedishMessage NoIdentifierProvided = "Emailadress eller användarnamn saknas" swedishMessage InvalidEmailAddress = "Ogiltig emailadress angiven" swedishMessage PasswordResetTitle = "Återställning av lösenord" swedishMessage ProvideIdentifier = "Epost eller användarnamn" swedishMessage SendPasswordResetEmail = "Skicka email för återställning av lösenord" swedishMessage PasswordResetPrompt = "Skriv in din emailadress eller användarnamn nedan och " `mappend` "ett email för återställning av lösenord kommmer att skickas till dig." swedishMessage InvalidUsernamePass = "Ogiltig kombination av användarnamn och lösenord" germanMessage :: AuthMessage -> Text germanMessage NoOpenID = "Kein OpenID-Identifier gefunden" germanMessage LoginOpenID = "Login via OpenID" germanMessage LoginGoogle = "Login via Google" germanMessage LoginYahoo = "Login via Yahoo" germanMessage Email = "Email" germanMessage Password = "Passwort" germanMessage Register = "Registrieren" germanMessage RegisterLong = "Neuen Account registrieren" germanMessage EnterEmail = "Bitte die e-Mail Adresse angeben, eine Bestätigungsmail wird verschickt." germanMessage ConfirmationEmailSentTitle = "Bestätigung verschickt." germanMessage (ConfirmationEmailSent email) = "Eine Bestätigung wurde an " `mappend` email `mappend` "versandt." germanMessage AddressVerified = "Adresse bestätigt, bitte neues Passwort angeben" germanMessage InvalidKeyTitle = "Ungültiger Bestätigungsschlüssel" germanMessage InvalidKey = "Das war leider ein ungültiger Bestätigungsschlüssel" germanMessage InvalidEmailPass = "Ungültiger Nutzername oder Passwort" germanMessage BadSetPass = "Um das Passwort zu ändern muss man eingeloggt sein" germanMessage SetPassTitle = "Passwort angeben" germanMessage SetPass = "Neues Passwort angeben" germanMessage NewPass = "Neues Passwort" germanMessage ConfirmPass = "Bestätigen" germanMessage PassMismatch = "Die Passwörter stimmten nicht überein" germanMessage PassUpdated = "Passwort überschrieben" germanMessage Facebook = "Login über Facebook" germanMessage LoginViaEmail = "Login via e-Mail" germanMessage InvalidLogin = "Ungültiger Login" germanMessage NowLoggedIn = "Login erfolgreich" germanMessage LoginTitle = "Login" germanMessage PleaseProvideUsername = "Bitte Nutzername angeben" germanMessage PleaseProvidePassword = "Bitte Passwort angeben" germanMessage NoIdentifierProvided = "Keine Email-Adresse oder kein Nutzername angegeben" germanMessage InvalidEmailAddress = "Unzulässiger Email-Anbieter" germanMessage PasswordResetTitle = "Passwort zurücksetzen" germanMessage ProvideIdentifier = "Email-Adresse oder Nutzername" germanMessage SendPasswordResetEmail = "Email zusenden um Passwort zurückzusetzen" germanMessage PasswordResetPrompt = "Nach Einhabe der Email-Adresse oder des Nutzernamen wird eine Email zugesendet mit welcher das Passwort zurückgesetzt werden kann." germanMessage InvalidUsernamePass = "Ungültige Kombination aus Nutzername und Passwort" frenchMessage :: AuthMessage -> Text frenchMessage NoOpenID = "Aucun fournisseur OpenID n'a été trouvé" frenchMessage LoginOpenID = "Se connecter avec OpenID" frenchMessage LoginGoogle = "Se connecter avec Google" frenchMessage LoginYahoo = "Se connecter avec Yahoo" frenchMessage Email = "Adresse électronique" frenchMessage Password = "Mot de passe" frenchMessage Register = "S'inscrire" frenchMessage RegisterLong = "Créer un compte" frenchMessage EnterEmail = "Entrez ci-dessous votre adresse électronique, et un message de confirmation vous sera envoyé" frenchMessage ConfirmationEmailSentTitle = "Message de confirmation" frenchMessage (ConfirmationEmailSent email) = "Un message de confirmation a été envoyé à " `mappend` email `mappend` "." frenchMessage AddressVerified = "Votre adresse électronique a été validée, merci de choisir un nouveau mot de passe." frenchMessage InvalidKeyTitle = "Clef de validation incorrecte" frenchMessage InvalidKey = "Désolé, mais cette clef de validation est incorrecte" frenchMessage InvalidEmailPass = "Le couple mot de passe/adresse électronique n'est pas correct" frenchMessage BadSetPass = "Vous devez être connecté pour choisir un mot de passe" frenchMessage SetPassTitle = "Changer de mot de passe" frenchMessage SetPass = "Choisir un nouveau mot de passe" frenchMessage NewPass = "Nouveau mot de passe" frenchMessage ConfirmPass = "Confirmation du mot de passe" frenchMessage PassMismatch = "Le deux mots de passe sont différents, veuillez les corriger" frenchMessage PassUpdated = "Le mot de passe a bien été changé" frenchMessage Facebook = "Se connecter avec Facebook" frenchMessage LoginViaEmail = "Se connecter à l'aide d'une adresse électronique" frenchMessage InvalidLogin = "Nom d'utilisateur incorrect" frenchMessage NowLoggedIn = "Vous êtes maintenant connecté" frenchMessage LoginTitle = "Se connecter" frenchMessage PleaseProvideUsername = "Merci de renseigner votre nom d'utilisateur" frenchMessage PleaseProvidePassword = "Merci de spécifier un mot de passe" frenchMessage NoIdentifierProvided = "No email/username provided" frenchMessage InvalidEmailAddress = "Invalid email address provided" frenchMessage PasswordResetTitle = "Password Reset" frenchMessage ProvideIdentifier = "Email or Username" frenchMessage SendPasswordResetEmail = "Send password reset email" frenchMessage PasswordResetPrompt = "Enter your e-mail address or username below, and a password reset e-mail will be sent to you." frenchMessage InvalidUsernamePass = "Invalid username/password combination" 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" norwegianBokmålMessage NoIdentifierProvided = "No email/username provided" norwegianBokmålMessage InvalidEmailAddress = "Invalid email address provided" norwegianBokmålMessage PasswordResetTitle = "Password Reset" norwegianBokmålMessage ProvideIdentifier = "Email or Username" norwegianBokmålMessage SendPasswordResetEmail = "Send password reset email" norwegianBokmålMessage PasswordResetPrompt = "Enter your e-mail address or username below, and a password reset e-mail will be sent to you." norwegianBokmålMessage InvalidUsernamePass = "Invalid username/password combination" 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 = "パスワードを入力してください" japaneseMessage NoIdentifierProvided = "No email/username provided" japaneseMessage InvalidEmailAddress = "Invalid email address provided" japaneseMessage PasswordResetTitle = "Password Reset" japaneseMessage ProvideIdentifier = "Email or Username" japaneseMessage SendPasswordResetEmail = "Send password reset email" japaneseMessage PasswordResetPrompt = "Enter your e-mail address or username below, and a password reset e-mail will be sent to you." japaneseMessage InvalidUsernamePass = "Invalid username/password combination" finnishMessage :: AuthMessage -> Text finnishMessage NoOpenID = "OpenID-tunnistetta ei löydy" finnishMessage LoginOpenID = "Kirjaudu OpenID-tilillä" finnishMessage LoginGoogle = "Kirjaudu Google-tilillä" finnishMessage LoginYahoo = "Kirjaudu Yahoo-tilillä" finnishMessage Email = "Sähköposti" finnishMessage Password = "Salasana" finnishMessage Register = "Luo uusi" finnishMessage RegisterLong = "Luo uusi tili" finnishMessage EnterEmail = "Kirjoita alle sähköpostiosoitteesi, johon vahvistussähköposti lähetetään." finnishMessage ConfirmationEmailSentTitle = "Vahvistussähköposti lähetetty." finnishMessage (ConfirmationEmailSent email) = "Vahvistussähköposti on lähetty osoitteeseen " `mappend` email `mappend` "." finnishMessage AddressVerified = "Sähköpostiosoite vahvistettu. Anna uusi salasana" finnishMessage InvalidKeyTitle = "Virheellinen varmistusavain" finnishMessage InvalidKey = "Valitettavasti varmistusavain on virheellinen." finnishMessage InvalidEmailPass = "Virheellinen sähköposti tai salasana." finnishMessage BadSetPass = "Kirjaudu ensin sisään asettaaksesi salasanan" finnishMessage SetPassTitle = "Salasanan asettaminen" finnishMessage SetPass = "Aseta uusi salasana" finnishMessage NewPass = "Uusi salasana" finnishMessage ConfirmPass = "Vahvista" finnishMessage PassMismatch = "Salasanat eivät täsmää" finnishMessage PassUpdated = "Salasana vaihdettu" finnishMessage Facebook = "Kirjaudu Facebook-tilillä" finnishMessage LoginViaEmail = "Kirjaudu sähköpostitilillä" finnishMessage InvalidLogin = "Kirjautuminen epäonnistui" finnishMessage NowLoggedIn = "Olet nyt kirjautunut sisään" finnishMessage LoginTitle = "Kirjautuminen" finnishMessage PleaseProvideUsername = "Käyttäjänimi puuttuu" finnishMessage PleaseProvidePassword = "Salasana puuttuu" finnishMessage NoIdentifierProvided = "Sähköpostiosoite/käyttäjänimi puuttuu" finnishMessage InvalidEmailAddress = "Annettu sähköpostiosoite ei kelpaa" finnishMessage PasswordResetTitle = "Uuden salasanan tilaaminen" finnishMessage ProvideIdentifier = "Sähköpostiosoite tai käyttäjänimi" finnishMessage SendPasswordResetEmail = "Lähetä uusi salasana sähköpostitse" finnishMessage PasswordResetPrompt = "Anna sähköpostiosoitteesi tai käyttäjätunnuksesi alla, niin lähetämme uuden salasanan sähköpostitse." finnishMessage InvalidUsernamePass = "Virheellinen käyttäjänimi tai salasana." chineseMessage :: AuthMessage -> Text chineseMessage NoOpenID = "无效的OpenID" chineseMessage LoginOpenID = "用OpenID登录" chineseMessage LoginGoogle = "用Google帐户登录" chineseMessage LoginYahoo = "用Yahoo帐户登录" chineseMessage Email = "邮箱" chineseMessage Password = "密码" chineseMessage Register = "注册" chineseMessage RegisterLong = "注册新帐户" chineseMessage EnterEmail = "输入你的邮箱地址，你将收到一封确认邮件。" chineseMessage ConfirmationEmailSentTitle = "确认邮件已发送" chineseMessage (ConfirmationEmailSent email) = "确认邮件已发送至 " `mappend` email `mappend` "." chineseMessage AddressVerified = "地址验证成功，请设置新密码" chineseMessage InvalidKeyTitle = "无效的验证码" chineseMessage InvalidKey = "对不起，验证码无效。" chineseMessage InvalidEmailPass = "无效的邮箱/密码组合" chineseMessage BadSetPass = "你需要登录才能设置密码" chineseMessage SetPassTitle = "设置密码" chineseMessage SetPass = "设置新密码" chineseMessage NewPass = "新密码" chineseMessage ConfirmPass = "确认" chineseMessage PassMismatch = "密码不匹配，请重新输入" chineseMessage PassUpdated = "密码更新成功" chineseMessage Facebook = "用Facebook帐户登录" chineseMessage LoginViaEmail = "用邮箱登录" chineseMessage InvalidLogin = "登录失败" chineseMessage NowLoggedIn = "登录成功" chineseMessage LoginTitle = "登录" chineseMessage PleaseProvideUsername = "请输入用户名" chineseMessage PleaseProvidePassword = "请输入密码" chineseMessage NoIdentifierProvided = "缺少邮箱/用户名" chineseMessage InvalidEmailAddress = "无效的邮箱地址" chineseMessage PasswordResetTitle = "重置密码" chineseMessage ProvideIdentifier = "邮箱或用户名" chineseMessage SendPasswordResetEmail = "发送密码重置邮件" chineseMessage PasswordResetPrompt = "输入你的邮箱地址或用户名，你将收到一封密码重置邮件。" chineseMessage InvalidUsernamePass = "无效的用户名/密码组合" yesod-auth-1.2.0.2/Yesod/Auth/GoogleEmail.hs0000644000000000000000000000650512166214613016636 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} -- | Use an email address as an identifier via Google's OpenID login system. -- -- This backend will not use the OpenID identifier at all. It only uses OpenID -- as a login system. By using this plugin, you are trusting Google to validate -- an email address, and requiring users to have a Google account. On the plus -- side, you get to use email addresses as the identifier, many users have -- existing Google accounts, the login system has been long tested (as opposed -- to BrowserID), and it requires no credential managing or setup (as opposed -- to Email). module Yesod.Auth.GoogleEmail ( authGoogleEmail , forwardUrl ) where import Yesod.Auth import qualified Web.Authenticate.OpenId as OpenId import Yesod.Core import Data.Text (Text) import qualified Yesod.Auth.Message as Msg import qualified Data.Text as T import Control.Exception.Lifted (try, SomeException) pid :: Text pid = "googleemail" forwardUrl :: AuthRoute forwardUrl = PluginR pid ["forward"] googleIdent :: Text googleIdent = "https://www.google.com/accounts/o8/id" authGoogleEmail :: YesodAuth m => AuthPlugin m authGoogleEmail = AuthPlugin pid dispatch login where complete = PluginR pid ["complete"] login tm = [whamlet|_{Msg.LoginGoogle}|] dispatch "GET" ["forward"] = do render <- getUrlRender let complete' = render complete master <- lift getYesod eres <- lift $ try $ OpenId.getForwardUrl googleIdent complete' Nothing [ ("openid.ax.type.email", "http://schema.openid.net/contact/email") , ("openid.ns.ax", "http://openid.net/srv/ax/1.0") , ("openid.ns.ax.required", "email") , ("openid.ax.mode", "fetch_request") , ("openid.ax.required", "email") , ("openid.ui.icon", "true") ] (authHttpManager master) either (\err -> loginErrorMessage LoginR $ T.pack $ show (err :: SomeException)) redirect eres dispatch "GET" ["complete", ""] = dispatch "GET" ["complete"] -- compatibility issues dispatch "GET" ["complete"] = do rr <- getRequest completeHelper $ reqGetParams rr dispatch "POST" ["complete", ""] = dispatch "POST" ["complete"] -- compatibility issues dispatch "POST" ["complete"] = do (posts, _) <- runRequestBody completeHelper posts dispatch _ _ = notFound completeHelper :: YesodAuth master => [(Text, Text)] -> AuthHandler master () completeHelper gets' = do master <- lift getYesod eres <- lift $ try $ OpenId.authenticateClaimed gets' (authHttpManager master) either onFailure onSuccess eres where onFailure err = loginErrorMessage LoginR $ T.pack $ show (err :: SomeException) onSuccess oir = do 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) -> lift $ setCreds True $ Creds pid email [] (_, False) -> loginErrorMessage LoginR "Only Google login is supported" (Nothing, _) -> loginErrorMessage LoginR "No email address provided" yesod-auth-1.2.0.2/Yesod/Auth/Routes.hs0000644000000000000000000000105012166214613015721 0ustar0000000000000000{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-} module Yesod.Auth.Routes where import Yesod.Core import Data.Text (Text) data Auth = Auth mkYesodSubData "Auth" [parseRoutes| /check CheckR GET /login LoginR GET /logout LogoutR GET POST /page/#Text/*Texts PluginR |] yesod-auth-1.2.0.2/Yesod/Auth/Dummy.hs0000644000000000000000000000163512166214613015544 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} -- | Provides a dummy authentication module that simply lets a user specify -- his/her identifier. This is not intended for real world use, just for -- testing. module Yesod.Auth.Dummy ( authDummy ) where import Yesod.Auth import Yesod.Form (runInputPost, textField, ireq) import Text.Hamlet (hamlet) import Yesod.Core authDummy :: YesodAuth m => AuthPlugin m authDummy = AuthPlugin "dummy" dispatch login where dispatch "POST" [] = do ident <- lift $ runInputPost $ ireq textField "ident" lift $ setCreds True $ Creds "dummy" ident [] dispatch _ _ = notFound url = PluginR "dummy" [] login authToMaster = toWidget [hamlet| $newline never

Your new identifier is: # |] yesod-auth-1.2.0.2/Yesod/Auth/Email.hs0000644000000000000000000003137512166214613015504 0ustar0000000000000000{-# LANGUAGE QuasiQuotes, TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternGuards #-} module Yesod.Auth.Email ( -- * Plugin authEmail , YesodAuthEmail (..) , EmailCreds (..) , saltPass -- * Routes , loginR , registerR , forgotPasswordR , setpassR , isValidPass -- * Types , Email , VerKey , VerUrl , SaltedPass , VerStatus , Identifier ) where import Network.Mail.Mime (randomString) import Yesod.Auth import System.Random import Data.Digest.Pure.MD5 import qualified Data.Text as TS import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE import Data.Text.Encoding (encodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Data.Text (Text) import Yesod.Core import qualified Crypto.PasswordStore as PS import qualified Text.Email.Validate import qualified Yesod.Auth.Message as Msg import Control.Applicative ((<$>), (<*>)) import Yesod.Form import Control.Monad (when) loginR, registerR, forgotPasswordR, setpassR :: AuthRoute loginR = PluginR "email" ["login"] registerR = PluginR "email" ["register"] forgotPasswordR = PluginR "email" ["forgot-password"] setpassR = PluginR "email" ["set-password"] verify :: Text -> Text -> AuthRoute -- FIXME verify eid verkey = PluginR "email" ["verify", eid, verkey] type Email = Text type VerKey = Text type VerUrl = Text type SaltedPass = Text type VerStatus = Bool -- | An Identifier generalizes an email address to allow users to log in with -- some other form of credentials (e.g., username). -- -- Note that any of these other identifiers must not be valid email addresses. -- -- Since 1.2.0 type Identifier = Text -- | Data stored in a database for each e-mail address. data EmailCreds site = EmailCreds { emailCredsId :: AuthEmailId site , emailCredsAuthId :: Maybe (AuthId site) , emailCredsStatus :: VerStatus , emailCredsVerkey :: Maybe VerKey , emailCredsEmail :: Email } class (YesodAuth site, PathPiece (AuthEmailId site)) => YesodAuthEmail site where type AuthEmailId site -- | Add a new email address to the database, but indicate that the address -- has not yet been verified. -- -- Since 1.1.0 addUnverified :: Email -> VerKey -> HandlerT site IO (AuthEmailId site) -- | Send an email to the given address to verify ownership. -- -- Since 1.1.0 sendVerifyEmail :: Email -> VerKey -> VerUrl -> HandlerT site IO () -- | Get the verification key for the given email ID. -- -- Since 1.1.0 getVerifyKey :: AuthEmailId site -> HandlerT site IO (Maybe VerKey) -- | Set the verification key for the given email ID. -- -- Since 1.1.0 setVerifyKey :: AuthEmailId site -> VerKey -> HandlerT site IO () -- | Verify the email address on the given account. -- -- Since 1.1.0 verifyAccount :: AuthEmailId site -> HandlerT site IO (Maybe (AuthId site)) -- | Get the salted password for the given account. -- -- Since 1.1.0 getPassword :: AuthId site -> HandlerT site IO (Maybe SaltedPass) -- | Set the salted password for the given account. -- -- Since 1.1.0 setPassword :: AuthId site -> SaltedPass -> HandlerT site IO () -- | Get the credentials for the given @Identifier@, which may be either an -- email address or some other identification (e.g., username). -- -- Since 1.2.0 getEmailCreds :: Identifier -> HandlerT site IO (Maybe (EmailCreds site)) -- | Get the email address for the given email ID. -- -- Since 1.1.0 getEmail :: AuthEmailId site -> HandlerT site IO (Maybe Email) -- | Generate a random alphanumeric string. -- -- Since 1.1.0 randomKey :: site -> IO Text randomKey _ = do stdgen <- newStdGen return $ TS.pack $ fst $ randomString 10 stdgen -- | Route to send user to after password has been set correctly. -- -- Since 1.2.0 afterPasswordRoute :: site -> Route site authEmail :: YesodAuthEmail m => AuthPlugin m authEmail = AuthPlugin "email" dispatch $ \tm -> [whamlet| $newline never
_{Msg.Email}
_{Msg.Password}
I don't have an account |] where 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 = do email <- newIdent tp <- getRouteToParent lift $ defaultLayout $ do setTitleI Msg.RegisterLong [whamlet|

_{Msg.EnterEmail}