yesod-auth-account 1.1.0 → 1.1.0.1
raw patch · 5 files changed
+362/−4 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- README.md +2/−2
- tests/BasicTests.hs +82/−0
- tests/Foundation.hs +101/−0
- tests/NewAccount.hs +169/−0
- yesod-auth-account.cabal +8/−2
README.md view
@@ -6,7 +6,7 @@ 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/packages/yesod-auth-account).+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@@ -15,4 +15,4 @@ 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/packages/yesod-auth-account).+[haddock documentation](http://hackage.haskell.org/package/yesod-auth-account).
+ tests/BasicTests.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE OverloadedStrings #-}+module BasicTests (basicSpecs) where++import Yesod.Test+import Database.Persist.Sqlite++basicSpecs :: SpecsConn Connection+basicSpecs =+ describe "Basic tests" $ do+ it "checks the home page is not logged in" $ do+ get_ "/"+ statusIs 200+ bodyContains "Please visit the <a href=\"/auth/login\">Login page"++ it "tests an invalid login" $ do+ get_ "/auth/login"+ statusIs 200++ post "/auth/page/account/login" $ do+ byLabel "Username" "abc"+ byLabel "Password" "xxx"++ statusIs 303+ get_ "/auth/login"+ statusIs 200+ bodyContains "Invalid username or password"++ it "new account page looks ok" $ do+ get_ "/auth/page/account/newaccount"+ statusIs 200+ htmlAllContain "title" "Register a new account"+ bodyContains "Register"++ it "reset password page looks ok" $ do+ get_ "/auth/page/account/resetpassword"+ statusIs 200+ bodyContains "Send email to reset password"++ post "/auth/page/account/resetpassword" $ do+ byLabel "Username" "abc"+ addNonce++ statusIs 303+ get_ "/"+ statusIs 200+ bodyContains "Invalid username"++ it "verify page returns an error" $ do+ get_ "/auth/page/account/verify/abc/xxxxxx"+ statusIs 303+ get_ "/"+ statusIs 200+ bodyContains "invalid verification key"++ it "new password returns an error" $ do+ get_ "/auth/page/account/newpassword/abc/xxxxxx"+ statusIs 303+ get_ "/"+ statusIs 200+ bodyContains "invalid verification key"++ it "set password returns an error" $ do+ post "/auth/page/account/setpassword" $ do+ byName "f1" "xxx"+ byName "f2" "xxx"+ byName "f3" "xxx"+ byName "f4" "xxx"+ byName "f5" "xxx"++ statusIs 303+ get_ "/"+ statusIs 200+ bodyContains "As a protection against cross-site"++ it "resend verify email returns an error" $ do+ post "/auth/page/account/resendverifyemail" $ do+ byName "f1" "xxx"+ byName "f2" "xxx"++ statusIs 400+ bodyContains "As a protection against cross-site"+
+ tests/Foundation.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, TemplateHaskell, OverloadedStrings #-}+{-# LANGUAGE GADTs, MultiParamTypeClasses, TypeSynonymInstances #-}++module Foundation where++import Data.Text (Text)+import Data.ByteString (ByteString)+import Database.Persist.Sqlite+import Data.IORef+import Control.Monad.Trans (MonadIO)+import System.IO.Unsafe (unsafePerformIO)+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++lastVerifyEmailR :: IORef (Username, Text, Text) -- ^ (username, email, verify url)+{-# NOINLINE lastVerifyEmailR #-}+lastVerifyEmailR = unsafePerformIO (newIORef ("", "", ""))++lastNewPwdEmailR :: IORef (Username, Text, Text) -- ^ (username, email, verify url)+{-# NOINLINE lastNewPwdEmailR #-}+lastNewPwdEmailR = unsafePerformIO (newIORef ("", "", ""))++lastVerifyEmail :: MonadIO m => m (Username, Text, Text)+lastVerifyEmail = liftIO $ readIORef lastVerifyEmailR++lastNewPwdEmail :: MonadIO m => m (Username, Text, Text)+lastNewPwdEmail = liftIO $ readIORef lastNewPwdEmailR++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 = SqlPersist+ 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 ()++instance AccountSendEmail MyApp where+ sendVerifyEmail name email url =+ liftIO $ writeIORef lastVerifyEmailR (name, email, url)++ sendNewPasswordEmail name email url =+ liftIO $ writeIORef lastNewPwdEmailR (name, email, url)++instance YesodAuthAccount (AccountPersistDB MyApp User) MyApp where+ runAccountDB = runAccountPersistDB++getHomeR :: Handler RepHtml+getHomeR = do+ maid <- maybeAuthId+ case maid of+ Nothing -> defaultLayout $ [whamlet|+<p>Please visit the <a href="@{AuthR LoginR}">Login page</a>+|]+ Just u -> defaultLayout $ [whamlet|+<p>You are logged in as #{u}+<p><a href="@{AuthR LogoutR}">Logout</a>+|]
+ tests/NewAccount.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE OverloadedStrings #-}+module NewAccount (newAccountSpecs) where++import Yesod.Test+import Foundation+import Database.Persist.Sqlite+import Text.XML.Cursor (attribute)+import qualified Data.Text.Encoding as T++newAccountSpecs :: SpecsConn Connection+newAccountSpecs =+ describe "New account tests" $ do+ it "new account with mismatched passwords" $ do+ get_ "/auth/page/account/newaccount"+ statusIs 200+ bodyContains "Register"++ post "/auth/page/account/newaccount" $ do+ addNonce+ byLabel "Username" "abc"+ byLabel "Email" "test@example.com"+ byLabel "Password" "xxx"+ byLabel "Confirm" "yyy"++ statusIs 303+ get_ "/"+ statusIs 200+ bodyContains "Passwords did not match"++ it "creates a new account" $ do+ get_ "/auth/page/account/newaccount"+ statusIs 200++ post "/auth/page/account/newaccount" $ do+ addNonce+ byLabel "Username" "abc"+ byLabel "Email" "test@example.com"+ byLabel "Password" "xxx"+ byLabel "Confirm" "xxx"++ statusIs 303+ get_ "/"+ statusIs 200+ bodyContains "A confirmation e-mail has been sent to test@example.com"++ (username, email, verify) <- lastVerifyEmail+ assertEqual "username" username "abc"+ assertEqual "email" email "test@example.com"++ get_ "/auth/page/account/verify/abc/zzzzzz"+ statusIs 303+ get_ "/"+ statusIs 200+ bodyContains "invalid verification key"++ -- try login+ get_ "/auth/login"+ statusIs 200+ post "/auth/page/account/login" $ do+ byLabel "Username" "abc"+ byLabel "Password" "yyy"+ statusIs 303+ get_ "/auth/login"+ statusIs 200+ bodyContains "Invalid username or password"++ -- valid login+ post "/auth/page/account/login" $ do+ byLabel "Username" "abc"+ byLabel "Password" "xxx"+ statusIs 200+ bodyContains "Your email has not yet been verified"++ -- resend verify email+ post "/auth/page/account/resendverifyemail" $ do+ addNonce+ byName "f2" "abc" -- username is also a hidden field+ statusIs 303+ get_ "/"+ bodyContains "A confirmation e-mail has been sent to test@example.com"++ (username', email', verify') <- lastVerifyEmail+ assertEqual "username" username' "abc"+ assertEqual "email" email' "test@example.com"+ assertEqual "verify" True (verify /= verify')++ -- verify email+ get_ $ T.encodeUtf8 verify'+ statusIs 303+ get_ "/"+ statusIs 200+ bodyContains "You are logged in as abc"++ post_ "/auth/logout"+ statusIs 303+ get_ "/"+ statusIs 200+ bodyContains "Please visit the <a href=\"/auth/login\">Login page"++ -- valid login+ get_ "/auth/login"+ post "/auth/page/account/login" $ do+ byLabel "Username" "abc"+ byLabel "Password" "xxx"+ statusIs 303+ get_ "/"+ bodyContains "You are logged in as abc"++ -- logout+ post_ "/auth/logout"++ -- reset password+ get_ "/auth/page/account/resetpassword"+ statusIs 200+ bodyContains "Send email to reset password"+ post "/auth/page/account/resetpassword" $ do+ byLabel "Username" "abc"+ addNonce+ statusIs 303+ get_ "/"+ statusIs 200+ bodyContains "A password reset email has been sent to your email address"++ (username'', email'', newpwd) <- lastNewPwdEmail+ assertEqual "User" username'' "abc"+ assertEqual "Email" email'' "test@example.com"++ -- bad key+ get_ $ T.encodeUtf8 newpwd+ statusIs 200+ post "/auth/page/account/setpassword" $ do+ addNonce+ byLabel "New password" "www"+ byLabel "Confirm" "www"+ byName "f2" "abc"+ byName "f3" "qqqqqqqqqqqqqq"+ statusIs 403+ bodyContains "Invalid key"++ -- good key+ get_ $ T.encodeUtf8 newpwd+ statusIs 200+ post "/auth/page/account/setpassword" $ do+ addNonce+ byLabel "New password" "www"+ byLabel "Confirm" "www"+ byName "f2" "abc"+ matches <- htmlQuery "input[name=f3][type=hidden][value]"+ key <- case matches of+ [] -> error "Unable to find set password key"+ element:_ -> return $ head $ attribute "value" $ parseHTML element+ byName "f3" key+ statusIs 303+ get_ "/"+ statusIs 200+ bodyContains "Password updated"+ bodyContains "You are logged in as abc"++ post_ "/auth/logout"++ -- check new password+ get_ "/auth/login"+ post "/auth/page/account/login" $ do+ byLabel "Username" "abc"+ byLabel "Password" "www"+ statusIs 303+ get_ "/"+ statusIs 200+ bodyContains "You are logged in as abc"
yesod-auth-account.cabal view
@@ -1,5 +1,5 @@ name: yesod-auth-account-version: 1.1.0+version: 1.1.0.1 cabal-version: >= 1.8 build-type: Simple synopsis: An account authentication plugin for Yesod@@ -14,7 +14,13 @@ email, and password. The plugin provides new account, email verification, and password reset pages that can be customized to enhance the user experience. -extra-source-files: example.hs, README.md+-- Temp workaround for http://hackage.haskell.org/trac/hackage/ticket/792+extra-source-files: example.hs+ , README.md+ , tests/BasicTests.hs+ , tests/Foundation.hs+ , tests/NewAccount.hs+ source-repository head type: mercurial