diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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 diff --git a/src/Web/Users/TestSpec.hs b/src/Web/Users/TestSpec.hs --- a/src/Web/Users/TestSpec.hs +++ b/src/Web/Users/TestSpec.hs @@ -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 = diff --git a/users-test.cabal b/users-test.cabal --- a/users-test.cabal +++ b/users-test.cabal @@ -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 . . @@ -10,7 +10,7 @@ license-file: LICENSE author: Alexander Thiemann maintainer: Alexander Thiemann -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