yesod-auth-account-1.2.2/ 0000755 0000000 0000000 00000000000 12203724523 013416 5 ustar 00 0000000 0000000 yesod-auth-account-1.2.2/LICENSE 0000644 0000000 0000000 00000002035 12203724523 014423 0 ustar 00 0000000 0000000 Copyright (c) 2013 John Lenz 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-account-1.2.2/example.hs 0000644 0000000 0000000 00000004462 12203724523 015413 0 ustar 00 0000000 0000000 {-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, TemplateHaskell, OverloadedStrings #-} {-# LANGUAGE GADTs, MultiParamTypeClasses, TypeSynonymInstances #-} import Data.Text (Text) import Data.ByteString (ByteString) import Database.Persist.Sqlite import Control.Monad.Logger (runStderrLoggingT) import Yesod import Yesod.Auth import Yesod.Auth.Account share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase| User username Text UniqueUsername username password ByteString emailAddress Text verified Bool verifyKey Text resetPasswordKey Text deriving Show |] instance PersistUserCredentials User where userUsernameF = UserUsername userPasswordHashF = UserPassword userEmailF = UserEmailAddress userEmailVerifiedF = UserVerified userEmailVerifyKeyF = UserVerifyKey userResetPwdKeyF = UserResetPasswordKey uniqueUsername = UniqueUsername userCreate name email key pwd = User name pwd email False key "" data MyApp = MyApp ConnectionPool mkYesod "MyApp" [parseRoutes| / HomeR GET /auth AuthR Auth getAuth |] instance Yesod MyApp instance RenderMessage MyApp FormMessage where renderMessage _ _ = defaultFormMessage instance YesodPersist MyApp where type YesodPersistBackend MyApp = SqlPersistT runDB action = do MyApp pool <- getYesod runSqlPool action pool instance YesodAuth MyApp where type AuthId MyApp = Username getAuthId = return . Just . credsIdent loginDest _ = HomeR logoutDest _ = HomeR authPlugins _ = [accountPlugin] authHttpManager _ = error "No manager needed" onLogin = return () maybeAuthId = lookupSession "_ID" instance AccountSendEmail MyApp instance YesodAuthAccount (AccountPersistDB MyApp User) MyApp where runAccountDB = runAccountPersistDB getHomeR :: Handler Html getHomeR = do maid <- maybeAuthId case maid of Nothing -> defaultLayout $ [whamlet|
Please visit the Login page |] Just u -> defaultLayout $ [whamlet|
You are logged in as #{u}
Logout
|]
main :: IO ()
main = withSqlitePool "test.db3" 10 $ \pool -> do
runStderrLoggingT $ runSqlPool (runMigration migrateAll) pool
warp 3000 $ MyApp pool
yesod-auth-account-1.2.2/README.md 0000644 0000000 0000000 00000002274 12203724523 014702 0 ustar 00 0000000 0000000 This package provides a [Yesod](http://www.yesodweb.com/) authentication plugin for accounts. Each
account consists of an username, email, and password. When initially creating an account, the email
is verified by sending a link in an email. The plugin also supports password reset via email.
The plugin provides default pages implementing all of this functionality, but it has been designed
to allow all the pages (new account page, password reset, etc.) to be customized or for the forms to
be embedded into your own pages allowing you to just ignore the routes inside the plugin. The
details are contained in the [haddock
documentation](http://hackage.haskell.org/package/yesod-auth-account).
The plugin supports any form data storage by requiring you to implement a couple of interfaces for
data access. The plugin has instances of these interfaces using persistent, but you can create your
own implementation if you are not using persistent or want more control over user data access and
storage.
A complete working example using persistent is
[example.hs](/wuzzeb/yesod-auth-account/src/tip/example.hs). Also, see the
[haddock documentation](http://hackage.haskell.org/package/yesod-auth-account).
yesod-auth-account-1.2.2/Setup.hs 0000644 0000000 0000000 00000000056 12203724523 015053 0 ustar 00 0000000 0000000 import Distribution.Simple
main = defaultMain
yesod-auth-account-1.2.2/yesod-auth-account.cabal 0000644 0000000 0000000 00000004575 12203724523 020131 0 ustar 00 0000000 0000000 name: yesod-auth-account
version: 1.2.2
cabal-version: >= 1.8
build-type: Simple
synopsis: An account authentication plugin for Yesod
category: Web
author: John Lenz Please visit the Login page
-- >|]
-- > Just u -> defaultLayout $ [whamlet|
-- > You are logged in as #{u}
-- > Logout
-- >|]
-- >
-- >main :: IO ()
-- >main = withSqlitePool "test.db3" 10 $ \pool -> do
-- > runStderrLoggingT $ runSqlPool (runMigration migrateAll) pool
-- > warp 3000 $ MyApp pool
--
accountPlugin :: YesodAuthAccount db master => AuthPlugin master
accountPlugin = AuthPlugin "account" dispatch loginWidget
where dispatch "POST" ["login"] = postLoginR >>= sendResponse
dispatch "GET" ["newaccount"] = getNewAccountR >>= sendResponse
dispatch "POST" ["newaccount"] = postNewAccountR >>= sendResponse
dispatch "GET" ["resetpassword"] = getResetPasswordR >>= sendResponse
dispatch "POST" ["resetpassword"] = postResetPasswordR >>= sendResponse
dispatch "GET" ["verify", u, k] = getVerifyR u k >>= sendResponse
dispatch "GET" ["newpassword", u, k] = getNewPasswordR u k >>= sendResponse
dispatch "POST" ["setpassword"] = postSetPasswordR >>= sendResponse
dispatch "POST" ["resendverifyemail"] = postResendVerifyEmailR >>= sendResponse
dispatch _ _ = notFound
-- | The POST target for the 'loginForm'.
loginFormPostTargetR :: AuthRoute
loginFormPostTargetR = PluginR "account" ["login"]
-- | Route for the default new account page.
--
-- See the New Account section below for customizing the new account process.
newAccountR :: AuthRoute
newAccountR = PluginR "account" ["newaccount"]
-- | Route for the reset password page.
--
-- This page allows the user to reset their password by requesting an email with a
-- reset URL be sent to them. See the Password Reset section below for customization.
resetPasswordR :: AuthRoute
resetPasswordR = PluginR "account" ["resetpassword"]
-- | The URL sent in an email for email verification
verifyR :: Username
-> T.Text -- ^ The verification key
-> AuthRoute
verifyR u k = PluginR "account" ["verify", u, k]
-- | The POST target for resending a verification email
resendVerifyR :: AuthRoute
resendVerifyR = PluginR "account" ["resendverifyemail"]
-- | The URL sent in an email when the user requests to reset their password
newPasswordR :: Username
-> T.Text -- ^ The verification key
-> AuthRoute
newPasswordR u k = PluginR "account" ["newpassword", u, k]
-- | The POST target for reseting the password
setPasswordR :: AuthRoute
setPasswordR = PluginR "account" ["setpassword"]
-- | TODO: move these into Yesod.Auth.Message
data AccountMsg = MsgUsername
| MsgForgotPassword
| MsgInvalidUsername
| MsgUsernameExists T.Text
| MsgResendVerifyEmail
| MsgResetPwdEmailSent
| MsgEmailVerified
| MsgEmailUnverified
instance RenderMessage m AccountMsg where
renderMessage _ _ MsgUsername = "Username"
renderMessage _ _ MsgForgotPassword = "Forgot password?"
renderMessage _ _ MsgInvalidUsername = "Invalid username"
renderMessage _ _ (MsgUsernameExists u) =
T.concat ["The username ", u, " already exists. Please choose an alternate username."]
renderMessage _ _ MsgResendVerifyEmail = "Resend verification email"
renderMessage _ _ MsgResetPwdEmailSent = "A password reset email has been sent to your email address."
renderMessage _ _ MsgEmailVerified = "Your email has been verified."
renderMessage _ _ MsgEmailUnverified = "Your email has not yet been verified."
---------------------------------------------------------------------------------------------------
-- | The data collected in the login form.
data LoginData = LoginData {
loginUsername :: T.Text
, loginPassword :: T.Text
} deriving Show
-- | The login form.
--
-- You can embed this form into your own pages if you want a custom rendering of this
-- form or to include a login form on your own pages. The form submission should be
-- posted to 'loginFormPostTargetR'.
loginForm :: (MonadHandler m, YesodAuthAccount db master, HandlerSite m ~ master)
=> AForm m LoginData
loginForm = LoginData <$> areq (checkM checkValidUsername textField) userSettings Nothing
<*> areq passwordField pwdSettings Nothing
where userSettings = FieldSettings (SomeMessage MsgUsername) Nothing (Just "username") Nothing []
pwdSettings = FieldSettings (SomeMessage Msg.Password) Nothing (Just "password") Nothing []
-- | A default rendering of 'loginForm' using renderDivs.
--
-- This is the widget used in the default implementation of 'loginHandler'.
-- The widget also includes links to the new account and reset password pages.
loginWidget :: YesodAuthAccount db master => (Route Auth -> Route master) -> WidgetT master IO ()
loginWidget tm = do
((_,widget), enctype) <- liftHandlerT $ runFormPostNoToken $ renderDivs loginForm
[whamlet|