users-test 0.4.0.0 → 0.5.0.0
raw patch · 3 files changed
+29/−39 lines, 3 filesdep −aesondep ~users
Dependencies removed: aeson
Dependency ranges changed: users
Files
- LICENSE +1/−1
- src/Web/Users/TestSpec.hs +25/−34
- users-test.cabal +3/−4
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015 Alexander Thiemann+Copyright (c) 2015 - 2016 Alexander Thiemann Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the
src/Web/Users/TestSpec.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DeriveGeneric #-} module Web.Users.TestSpec ( makeUsersSpec ) where@@ -9,30 +8,16 @@ import Control.Concurrent (threadDelay) import Control.Monad-import Data.Aeson-import GHC.Generics import Test.Hspec import qualified Data.Text as T -type DummyUser = User DummyDetails--data DummyDetails- = DummyDetails- { dd_foo :: Bool- , _dd_bar :: Int- } deriving (Show, Eq, Generic)--instance FromJSON DummyDetails-instance ToJSON DummyDetails--mkUser :: T.Text -> T.Text -> DummyUser+mkUser :: T.Text -> T.Text -> User mkUser name email = User { u_name = name , u_email = email , u_password = makePassword "1234" , u_active = False- , u_more = DummyDetails True 21 } assertRight :: Show a => IO (Either a b) -> (b -> IO ()) -> IO ()@@ -77,29 +62,30 @@ it "list and count should be correct" $ assertRight (createUser backend userA) $ \userId1 -> assertRight (createUser backend userB) $ \userId2 ->- do allUsers <- listUsers backend Nothing+ do allUsers <- listUsers backend Nothing (SortAsc UserFieldId) unless ((userId1, hidePassword userA) `elem` allUsers && (userId2, hidePassword userB) `elem` allUsers) (expectationFailure $ "create users not in user list:" ++ show allUsers) countUsers backend `shouldReturn` 2+ it "sorting should work" $+ assertRight (createUser backend userA) $ \_ ->+ assertRight (createUser backend userB) $ \_ ->+ assertRight (createUser backend userC) $ \userId3 ->+ do allUsers <- listUsers backend Nothing (SortAsc UserFieldName)+ head allUsers `shouldBe` (userId3, hidePassword userC) it "updating and loading users should work" $ assertRight (createUser backend userA) $ \userIdA -> assertRight (createUser backend userB) $ \_ ->- do assertRight (updateUser backend userIdA (\(user :: DummyUser) -> user { u_name = "changed" })) $ const (return ())- assertLeft (updateUser backend userIdA (\(user :: DummyUser) -> user { u_name = "foo2" }))+ do assertRight (updateUser backend userIdA (\user -> user { u_name = "changed" })) $ const (return ())+ assertLeft (updateUser backend userIdA (\user -> user { u_name = "foo2" })) "succeeded to set username to already used username" $ \err -> err `shouldBe` UsernameAlreadyExists- assertLeft (updateUser backend userIdA (\(user :: DummyUser) -> user { u_email = "bar2@baz.com" }))+ assertLeft (updateUser backend userIdA (\user -> user { u_email = "bar2@baz.com" })) "succeeded to set email to already used email" $ \err -> err `shouldBe` EmailAlreadyExists- updateUserDetails backend userIdA (\d -> d { dd_foo = False }) userA' <- getUserById backend userIdA userA' `shouldBe` (Just $ (hidePassword userA) { u_name = "changed"- , u_more =- (u_more userA)- { dd_foo = False- } }) userIdA' <- getUserIdByName backend "changed" userIdA' `shouldBe` Just userIdA@@ -107,9 +93,10 @@ assertRight (createUser backend userA) $ \userIdA -> assertRight (createUser backend userB) $ \userIdB -> do deleteUser backend userIdA- (allUsers :: [(UserId b, DummyUser)]) <- listUsers backend Nothing+ (allUsers :: [(UserId b, User)]) <-+ listUsers backend Nothing (SortAsc UserFieldId) map fst allUsers `shouldBe` [userIdB]- getUserById backend userIdA `shouldReturn` (Nothing :: Maybe DummyUser)+ getUserById backend userIdA `shouldReturn` (Nothing :: Maybe User) it "reusing a deleted users name should work" $ assertRight (createUser backend userA) $ \userIdA -> do deleteUser backend userIdA@@ -134,11 +121,14 @@ authUser backend "bar@baz.com' OR 1 = 1; --" (PasswordPlain "' OR 1 = 1; --") 500 `shouldReturn` Nothing it "sessionless auth with valid userdata should work" $ assertRight (createUser backend userA) $ \userIdA ->- do withAuthUser backend "bar@baz.com" ((== DummyDetails True 21) . u_more) (return . (== userIdA)) `shouldReturn` Just True- withAuthUser backend "bar@baz.com" ((== DummyDetails True 21) . u_more) (return . (/= userIdA)) `shouldReturn` Just False+ do withAuthUser backend "bar@baz.com" ((== "bar@baz.com") . u_email)+ (return . (== userIdA)) `shouldReturn` Just True+ withAuthUser backend "bar@baz.com" ((== "bar@baz.com") . u_email)+ (return . (/= userIdA)) `shouldReturn` Just False it "sessionless auth with invalid userdata should fail" $ assertRight (createUser backend userA) $ \userIdA ->- withAuthUser backend "bar@baz.com" ((/= DummyDetails True 21) . u_more) (return . (/= userIdA)) `shouldReturn` Nothing+ withAuthUser backend "bar@baz.com" ((/= "bar@baz.com") . u_email)+ (return . (/= userIdA)) `shouldReturn` Nothing it "forcing a session works" $ assertRight (createUser backend userA) $ \userIdA -> assertJust (createSession backend userIdA 500) "session id missing" $ \_ -> return ()@@ -159,13 +149,13 @@ do it "generates a valid token for a user" $ assertRight (createUser backend userA) $ \userIdA -> do token <- requestPasswordReset backend userIdA 500- verifyPasswordResetToken backend token `shouldReturn` (Just (hidePassword userA) :: Maybe DummyUser)+ verifyPasswordResetToken backend token `shouldReturn` (Just (hidePassword userA) :: Maybe User) it "a valid token should reset the password" $ assertRight (createUser backend userA) $ \userIdA -> do withAuthedUserNoCreate "foo" "1234" 500 0 userIdA $ const (return ()) -- old login token <- requestPasswordReset backend userIdA 500 housekeepBackend backend- verifyPasswordResetToken backend token `shouldReturn` (Just (hidePassword userA) :: Maybe DummyUser)+ verifyPasswordResetToken backend token `shouldReturn` (Just (hidePassword userA) :: Maybe User) assertRight (applyNewPassword backend token $ makePassword "foobar") $ const $ return () withAuthedUserNoCreate "foo" "foobar" 500 0 userIdA $ const (return ()) -- new login it "expired tokens should not do any harm" $@@ -173,7 +163,7 @@ do withAuthedUserNoCreate "foo" "1234" 500 0 userIdA $ const (return ()) -- old login token <- requestPasswordReset backend userIdA 1 threadDelay (seconds 1)- verifyPasswordResetToken backend token `shouldReturn` (Nothing :: Maybe DummyUser)+ verifyPasswordResetToken backend token `shouldReturn` (Nothing :: Maybe User) assertLeft (applyNewPassword backend token $ makePassword "foobar") "Reset password with expired token" $ const $ return () withAuthedUserNoCreate "foo" "1234" 500 0 userIdA $ const (return ()) -- still old login@@ -181,7 +171,7 @@ assertRight (createUser backend userA) $ \userIdA -> do withAuthedUserNoCreate "foo" "1234" 500 0 userIdA $ const (return ()) -- old login let token = PasswordResetToken "Foooooooo!!!!"- verifyPasswordResetToken backend token `shouldReturn` (Nothing :: Maybe DummyUser)+ verifyPasswordResetToken backend token `shouldReturn` (Nothing :: Maybe User) assertLeft (applyNewPassword backend token $ makePassword "foobar") "Reset password with random token" $ const $ return () withAuthedUserNoCreate "foo" "1234" 500 0 userIdA $ const (return ()) -- still old login@@ -219,6 +209,7 @@ seconds x = x * 1000000 userA = mkUser "foo" "bar@baz.com" userB = mkUser "foo2" "bar2@baz.com"+ userC = mkUser "alex" "aaaa@bbbbbb.com" withAuthedUser = withAuthedUser' "foo" "1234" 500 0 withAuthedUserT = withAuthedUser' "foo" "1234" withAuthedUser' username pass sTime extTime action =
users-test.cabal view
@@ -1,5 +1,5 @@ name: users-test-version: 0.4.0.0+version: 0.5.0.0 synopsis: Library to test backends for the users library description: Provides HSpec helpers for backends of <http://hackage.haskell.org/package/users users package>. .@@ -10,7 +10,7 @@ license-file: LICENSE author: Alexander Thiemann <mail@athiemann.net> maintainer: Alexander Thiemann <mail@athiemann.net>-copyright: (c) 2015 Alexander Thiemann+copyright: (c) 2015 - 2016 Alexander Thiemann category: Web build-type: Simple cabal-version: >=1.10@@ -23,10 +23,9 @@ library exposed-modules: Web.Users.TestSpec build-depends:- aeson >=0.8, base >=4.6 && <5, hspec >=2.1,- users >=0.4.0.0,+ users >=0.5.0.0, text >=1.2 hs-source-dirs: src default-language: Haskell2010