{-# LANGUAGE OverloadedStrings #-}

module Snap.Snaplet.Auth.Handlers.Tests
  ( tests ) where


------------------------------------------------------------------------------
import           Control.Applicative
import           Control.Monad.State            as S
import           Control.Monad.Trans.Maybe      (MaybeT(..), runMaybeT)
import qualified Data.Map                       as Map
import           Data.Maybe                     (isJust, isNothing)
import           Data.Time.Clock                (diffUTCTime, getCurrentTime)
import           Test.Framework                 (Test, mutuallyExclusive,
                                                 testGroup)
import           Test.Framework.Providers.HUnit (testCase)
import           Test.HUnit                     hiding (Test, path)


------------------------------------------------------------------------------
import           Snap.Core                      (writeText)
import           Snap.Snaplet                   (Handler, with)
import           Snap.Snaplet.Auth              (AuthUser(..),
                                                 AuthFailure(..),
                                                 Password(..), Role(..))
import qualified Snap.Snaplet.Auth              as A
import           Snap.Snaplet.Test.Common.App   (App, appInit, appInit',
                                                 auth)
import qualified Snap.Test                      as ST
import           Snap.Snaplet.Test              (evalHandler, runHandler,
                                                 withTemporaryFile)


------------------------------------------------------------------------------
tests :: Test
tests = testGroup "Snap.Snaplet.Auth.Handlers"
    [mutuallyExclusive $ testGroup "createUser tests"
        [ testCreateUserGood
        , testWithCfgFile
        , testCreateUserTimely
        , testCreateUserWithRole
        , testCreateEmptyUser
        , testCreateDupUser
        , testUsernameExists 
        , testLoginByUsername 
        , testLoginByUsernameEnc
        , testLoginByUsernameNoU 
        , testLoginByUsernameInvPwd
        , testLoginByRememberTokenKO
        , testLoginByRememberTokenOK
        , testLogoutKO
        , testLogoutOK
        , testCurrentUserKO
        , testCurrentUserOK
        , testIsLoggedInKO
        , testIsLoggedInOK
        , testSaveUserKO
        , testSaveUserOK
        , testMarkAuthFail
        --, testMarkAuthFailLockedOut
        , testMarkAuthSuccess
        , testCheckPasswordAndLoginOK
        , testCheckPasswordAndLoginKO
        , testAuthenticatePasswordOK
        , testAuthenticatePasswordPwdMissing
        , testAuthenticatePasswordPwdWrong
        , testRegisterUserOK
        , testRegisterUserNoUser
        , testRegisterUserNoPwd
        , testRequireUserOK
        , testRequireUserKO
        ]
    ]

------------------------------------------------------------------------------
isJustFailure :: AuthFailure -> Maybe AuthFailure -> Bool
isJustFailure failure (Just expected) = failure == expected
isJustFailure _ _ = False


------------------------------------------------------------------------------
isLeftFailure :: AuthFailure -> Either AuthFailure AuthUser -> Bool
isLeftFailure failure (Left expected) = failure == expected
isLeftFailure _ _ = False


------------------------------------------------------------------------------
testCreateUserGood :: Test
testCreateUserGood = testCase "createUser good params" assertGoodUser
  where 
    assertGoodUser :: Assertion
    assertGoodUser = withTemporaryFile "users.json" $ do
        let hdl = with auth $ A.createUser "foo" "foo"
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg . isRight) res

    failMsg = "createUser failed: Couldn't create a new user."


------------------------------------------------------------------------------
testWithCfgFile :: Test
testWithCfgFile = testCase "createUser with config file settings" assertCfg
  where
    assertCfg :: Assertion
    assertCfg = withTemporaryFile "users.json" $ do
      let hdl = with auth $ A.createUser "foo" "foo"
      res <- runHandler Nothing (ST.get "" Map.empty) hdl
             (appInit' False True)
      either (assertFailure . show) ST.assertSuccess res


------------------------------------------------------------------------------
testCreateUserTimely :: Test
testCreateUserTimely = testCase "createUser good updatedAt" assertCreateTimely
  where
    assertCreateTimely :: Assertion
    assertCreateTimely = withTemporaryFile "users.json" $ do
      let hdl = with auth $ A.createUser "foo" "foo"
      tNow <- getCurrentTime
      let isTimely t' = maybe False (\t -> diffUTCTime tNow t < 1) t'
      res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
      case res of
        Left  e          -> assertFailure . show $ e
        Right (Left e)   -> assertFailure . show $ e
        Right (Right au) -> assertBool failMsg $ isTimely (userUpdatedAt au)
                            && isTimely (userCreatedAt au)

    failMsg = "createUser: userUpdatedAt, userCreatetAt times not set"


hush :: Either e a -> Maybe a
hush (Left _) = Nothing
hush (Right a) = Just a

------------------------------------------------------------------------------
testCreateUserWithRole :: Test
testCreateUserWithRole = testCase "createUser with role" assertUserRole
  where
    assertUserRole :: Assertion
    assertUserRole = withTemporaryFile "users.json" $ do
      let hdl = with auth $ runMaybeT $ do
            u <- MaybeT $ hush <$> A.createUser "foo" "foo"
            _ <- MaybeT $ hush <$>
                 A.saveUser (u {userRoles = [Role "admin",Role "user"]})
            MaybeT $ hush <$> A.loginByUsername "foo" (ClearText "foo") False
      res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
      case res of
        Left e           -> assertFailure $ show e
        Right Nothing    -> assertFailure "Failed saved user lookup"
        Right (Just usr) -> assertEqual "Roles don't match expectation"
                         [Role "admin",Role "user"]
                         (userRoles usr)


------------------------------------------------------------------------------
testCreateEmptyUser :: Test
testCreateEmptyUser = testCase "createUser empty username" assertEmptyUser
  where 
    assertEmptyUser :: Assertion
    assertEmptyUser = do
        let hdl = with auth $ A.createUser "" "foo"
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show)
               (assertBool failMsg . isLeftFailure UsernameMissing) res

    failMsg = "createUser: Was created an empty username despite they aren't allowed."


------------------------------------------------------------------------------
-- Is the tests execution order garanteed? When this runs, the user "foo"
-- will be already present in the backend.
testCreateDupUser :: Test
testCreateDupUser = testCase "createUser duplicate user" assertDupUser
  where 
    assertDupUser :: Assertion
    assertDupUser = do
        let hdl = with auth $ A.createUser "foo" "foo"
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show)
               (assertBool failMsg . isLeftFailure DuplicateLogin) res

    failMsg = "createUser: Expected to find a duplicate user, but I haven't."


------------------------------------------------------------------------------
-- A non desirable thing is to be couple by the temporal execution of
-- tests. The problem has been resolved using fixtures, so something like
-- that would be beneficial for next releases.
testUsernameExists :: Test
testUsernameExists = testCase "username exists" assertUserExists
  where
    assertUserExists :: Assertion
    assertUserExists = do
        let hdl = with auth $ A.usernameExists "foo"
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg) res

    failMsg = "usernameExists: Expected to return True, but it didn't."


------------------------------------------------------------------------------
testLoginByUsername :: Test
testLoginByUsername = testCase "successful loginByUsername" assertion
  where
    assertion :: Assertion
    assertion = do
        let pwd = ClearText "foo"
        res <- evalHandler Nothing (ST.get "" Map.empty) (loginByUnameHdlr pwd) appInit
        either (assertFailure . show) (assertBool failMsg . isRight) res

    failMsg = "loginByUsername: Failed with ClearText pwd."


------------------------------------------------------------------------------
-- Reused below.
loginByUnameHdlr :: Password -> Handler App App (Either AuthFailure AuthUser)
loginByUnameHdlr pwd = with auth $ A.loginByUsername "foo" pwd False


------------------------------------------------------------------------------
testLoginByUsernameEnc :: Test
testLoginByUsernameEnc = testCase "loginByUsername encrypted pwd" assertion
  where
    assertion :: Assertion
    assertion = do
        let pwd = Encrypted "foo"
        res <- evalHandler Nothing (ST.get "" Map.empty) (loginByUnameHdlr pwd) appInit
        either (assertFailure . show)
               (assertBool failMsg . isLeftFailure EncryptedPassword) res

    failMsg = "loginByUsername: Expected to find an Encrypted password, but I haven't."


------------------------------------------------------------------------------
testLoginByUsernameNoU :: Test
testLoginByUsernameNoU = testCase "loginByUsername invalid user" assertion
  where
    assertion :: Assertion
    assertion = do
        let pwd = ClearText "foo"
        let hdl = with auth $ A.loginByUsername "doesnotexist" pwd False
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show)
               (assertBool failMsg . isLeftFailure UserNotFound) res

    failMsg = "loginByUsername: Expected to fail for an invalid user, but I didn't."


------------------------------------------------------------------------------
testLoginByUsernameInvPwd :: Test
testLoginByUsernameInvPwd = testCase "loginByUsername invalid user" assertion
  where
    assertion :: Assertion
    assertion = do
        let pwd = ClearText "invalid"
        let hdl = with auth $ A.loginByUsername "foo" pwd False
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg . isLeft) res

    failMsg = "loginByUsername: Expected to fail for an invalid pwd, but I didn't."


------------------------------------------------------------------------------
testLoginByRememberTokenKO :: Test
testLoginByRememberTokenKO = testCase "loginByRememberToken no token" assertion
  where
    assertion :: Assertion
    assertion = do
        let hdl = with auth A.loginByRememberToken
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg . isLeft) res

    failMsg = "loginByRememberToken: Expected to fail for the " ++
              "absence of a token, but I didn't."


------------------------------------------------------------------------------
testLoginByRememberTokenOK :: Test
testLoginByRememberTokenOK = testCase "loginByRememberToken token" assertion
  where
    assertion :: Assertion
    assertion = do
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        case res of
          (Left e) -> assertFailure $ show e
          (Right res') -> assertBool failMsg $ isRight res'

    hdl :: Handler App App (Either AuthFailure AuthUser)
    hdl = with auth $ do
        res <- A.loginByUsername "foo" (ClearText "foo") True
        either (\e -> return (Left e)) (\_ -> A.loginByRememberToken) res

    failMsg = "loginByRememberToken: Expected to succeed but I didn't."


------------------------------------------------------------------------------
testLogoutKO :: Test
testLogoutKO = testCase "logout no user logged in." $ assertLogout hdl failMsg
  where
    hdl :: Handler App App (Maybe AuthUser)
    hdl = with auth $ do
        A.logout
        mgr <- S.get
        return (A.activeUser mgr)

    failMsg = "logout: Expected to get Nothing as the active user, " ++
              " but I didn't."


------------------------------------------------------------------------------
assertLogout :: Handler App App (Maybe AuthUser) -> String -> Assertion
assertLogout hdl failMsg = do
    res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
    either (assertFailure . show) (assertBool failMsg . isNothing) res


------------------------------------------------------------------------------
testLogoutOK :: Test
testLogoutOK = testCase "logout user logged in." $ assertLogout hdl failMsg
  where
    hdl :: Handler App App (Maybe AuthUser)
    hdl = with auth $ do
        _ <- A.loginByUsername "foo" (ClearText "foo") True
        A.logout
        mgr <- get
        return (A.activeUser mgr)

    failMsg = "logout: Expected to get Nothing as the active user, " ++
              " but I didn't."


------------------------------------------------------------------------------
testCurrentUserKO :: Test
testCurrentUserKO = testCase "currentUser unsuccesful call" assertion
  where
    assertion :: Assertion
    assertion = do
        let hdl = with auth A.currentUser
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg . isNothing) res

    failMsg = "currentUser: Expected Nothing as the current user, " ++
              " but I didn't."


------------------------------------------------------------------------------
testCurrentUserOK :: Test
testCurrentUserOK = testCase "successful currentUser call" assertion
  where
    assertion :: Assertion
    assertion = do
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg . isJust) res

    hdl :: Handler App App (Maybe AuthUser)
    hdl = with auth $ do
        res <- A.loginByUsername "foo" (ClearText "foo") True
        either (\_ -> return Nothing) (\_ -> A.currentUser) res

    failMsg = "currentUser: Expected to get the current user, " ++
              " but I didn't."


------------------------------------------------------------------------------
testIsLoggedInKO :: Test
testIsLoggedInKO = testCase "isLoggedIn, no user logged" assertion
  where
    assertion :: Assertion
    assertion = do
        let hdl = with auth A.isLoggedIn
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg . not) res

    failMsg = "isLoggedIn: Expected False, but got True."


------------------------------------------------------------------------------
testIsLoggedInOK :: Test
testIsLoggedInOK = testCase "isLoggedIn, user logged" assertion
  where
    assertion :: Assertion
    assertion = do
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg) res

    hdl :: Handler App App Bool
    hdl = with auth $ do
        _ <- A.loginByUsername "foo" (ClearText "foo") True
        A.isLoggedIn

    failMsg = "isLoggedIn: Expected True, but got False."


------------------------------------------------------------------------------
-- It fails because destroy is not yet implemented for the Json backend.
testDestroyUser :: Test
testDestroyUser = testCase "destroyUser" assertion
  where
    assertion :: Assertion
    assertion = do
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg . not) res

    hdl :: Handler App App Bool
    hdl = with auth $ do
        newUser <- A.createUser "bar" "bar"
        either (\_ -> return True)
               (\u -> A.destroyUser u >> A.usernameExists "bar")
               newUser

    failMsg = "destroyUser: I've tried to destroy an existing user, " ++
              "but user is still there."


------------------------------------------------------------------------------
testSaveUserKO :: Test
testSaveUserKO = testCase "saveUser null username" assertion
  where
    assertion :: Assertion
    assertion = do
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg . isLeft) res

    hdl :: Handler App App (Either AuthFailure AuthUser)
    hdl = with auth $ do
        user <- A.loginByUsername "foo" (ClearText "foo") True
        case user of
          (Left e) -> return $ Left e
          (Right u) -> A.saveUser (u { userLogin = "" })

    failMsg = "saveUser: I expected to fail since I'm saving an " ++
              "empty username, but I didn't."


------------------------------------------------------------------------------
-- Trying to update a Cleartext text pwd result in an error. Feature or
-- bug? (error: Json can't serialize ClearText pwd)
testSaveUserOK :: Test
testSaveUserOK = testCase "saveUser good update params" assertion
  where
    assertion :: Assertion
    assertion = do
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg . isRight) res

    hdl :: Handler App App (Either AuthFailure AuthUser)
    hdl = with auth $ do
        user <- A.loginByUsername "foo" (ClearText "foo") True
        case user of
          (Left e) -> return $ Left e
          (Right u) -> A.saveUser (u { userLoginCount = 99 })

    failMsg = "saveUser: I expected to success since I'm saving a " ++
              "valid user, but I didn't."


------------------------------------------------------------------------------
testMarkAuthFail :: Test
testMarkAuthFail = testCase "successful markAuthFail call" assertion
  where
    assertion :: Assertion
    assertion = do
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg) res

    -- Lot of destructuring here, but the idea is to test if
    -- failedLoginCount increased by 1.
    hdl :: Handler App App Bool
    hdl = with auth $ do
        user <- A.loginByUsername "foo" (ClearText "foo") True
        case user of
          (Left _) -> return False
          (Right u) ->
              let failCount = userFailedLoginCount u
                  in do
                      res <- A.markAuthFail u
                      either (\_ -> return False)
                             (\u' -> return $
                                    userFailedLoginCount u' == failCount + 1)
                             res

    failMsg = "markAuthFail: I expected to increase the userFailedLoginCount, " ++
              "but I didn't."


------------------------------------------------------------------------------
testMarkAuthFailLockedOut :: Test
testMarkAuthFailLockedOut = testCase "markAuthFail lockedOut" assertion
  where
    assertion :: Assertion
    assertion = do
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg . isLockedOut) res

    hdl :: Handler App App (Either AuthFailure AuthUser)
    hdl = with auth $ do
        user <- A.loginByUsername "bar" (ClearText "bar") True
        case user of
          (Left e) -> return $ Left e
          (Right u) ->
              let u' = u {userFailedLoginCount = 99}
                  in do
                      modify (\s -> s { A.lockout = Just (5, 1000000) })
                      A.markAuthFail u'

    failMsg = "markAuthFail: I expected the user to be LockedOut, " ++
              "but he didn't."

    isLockedOut :: Either AuthFailure AuthUser -> Bool
    isLockedOut (Left _) = False
    isLockedOut (Right u) = isJust $ userLockedOutUntil u

------------------------------------------------------------------------------
testMarkAuthSuccess :: Test
testMarkAuthSuccess = testCase "successful markAuthSuccess call" assertion
  where
    assertion :: Assertion
    assertion = do
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg) res

    hdl :: Handler App App Bool
    hdl = with auth $ do
        user <- A.loginByUsername "foo" (ClearText "foo") True
        case user of
          (Left _) -> return False
          (Right u) ->
              let count = userLoginCount u
                  in do
                      res <- A.markAuthSuccess u
                      either (\_ -> return False)
                             (\u' -> return $
                                    userLoginCount u' == count + 1)
                             res

    failMsg = "markAuthSuccess: I expected to increase the userLoginCount, " ++
              "but I didn't."


------------------------------------------------------------------------------
testCheckPasswordAndLoginOK :: Test
testCheckPasswordAndLoginOK = testCase "checkPasswordAndLogin OK" assertion
  where
    assertion :: Assertion
    assertion = do
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg . isRight) res

    hdl :: Handler App App (Either AuthFailure AuthUser)
    hdl = with auth $ do
        let pwd = ClearText "foo"
        res <- A.loginByUsername "foo" pwd False
        either (return . Left) (`A.checkPasswordAndLogin` pwd) res

    failMsg = "checkPasswordAndLogin: I expected to succeed " ++
              "but I didn't."


------------------------------------------------------------------------------
testCheckPasswordAndLoginKO :: Test
testCheckPasswordAndLoginKO = testCase "checkPasswordAndLogin KO" assertion
  where
    assertion :: Assertion
    assertion = do
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg . isLeft) res

    hdl :: Handler App App (Either AuthFailure AuthUser)
    hdl = with auth $ do
        let pwd = ClearText "wrongpass"
        res <- A.loginByUsername "foo" pwd False
        either (return . Left) (`A.checkPasswordAndLogin` pwd) res

    failMsg = "checkPasswordAndLogin: I expected to succeed " ++
              "but I didn't."


------------------------------------------------------------------------------
testAuthenticatePasswordOK :: Test
testAuthenticatePasswordOK = testCase "authenticatePassword OK" assertion
  where
    assertion :: Assertion
    assertion = do
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (assertBool failMsg . isNothing) res

    hdl :: Handler App App (Maybe AuthFailure)
    hdl = with auth $ do
        let pwd = ClearText "foo"
        res <- A.loginByUsername "foo" pwd False
        either (return . Just)
               (\u -> return $ A.authenticatePassword u pwd) res

    failMsg = "authenticatePassword: I expected to succeed " ++
              "but I didn't."


------------------------------------------------------------------------------
testAuthenticatePasswordPwdMissing :: Test
testAuthenticatePasswordPwdMissing = testCase "authenticatePassword no pwd" a
  where
    a :: Assertion
    a = do
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show)
               (assertBool failMsg . isJustFailure PasswordMissing) res

    hdl :: Handler App App (Maybe AuthFailure)
    hdl = with auth $ do
        let pwd = ClearText "foo"
        res <- A.loginByUsername "foo" pwd False
        either (return . Just)
               (\u -> let u' = u { userPassword = Nothing }
                         in return $ A.authenticatePassword u' pwd) res

    failMsg = "authenticatePassword: I expected to fail due to " ++
              " MissingPassword, but I didn't."
    

------------------------------------------------------------------------------
testAuthenticatePasswordPwdWrong :: Test
testAuthenticatePasswordPwdWrong = testCase "authenticatePassword wrong pwd" a
  where
    a :: Assertion
    a = do
        res <- evalHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show)
               (assertBool failMsg . isJustFailure IncorrectPassword) res

    hdl :: Handler App App (Maybe AuthFailure)
    hdl = with auth $ do
        let pwd = ClearText "foo"
        res <- A.loginByUsername "foo" pwd False
        either (return . Just)
               (return . flip A.authenticatePassword (ClearText "bar")) res

    failMsg = "authenticatePassword: I expected to fail due to " ++
              " IncorrectPassword, but I didn't."


------------------------------------------------------------------------------
testRegisterUserOK :: Test
testRegisterUserOK = testCase "registerUser OK" assertion
  where
    assertion :: Assertion
    assertion = do
        let hdl = with auth $ A.registerUser "user" "pwd"
        let params = Map.fromList [("user", ["fizz"]), ("pwd", ["buzz"])]
        res <- evalHandler Nothing (ST.get "" $ params) hdl appInit
        either (assertFailure . show) (assertBool failMsg . isRight) res

    failMsg = "registerUser: I expected to succeed " ++
              ", but I didn't."


------------------------------------------------------------------------------
testRegisterUserNoUser :: Test
testRegisterUserNoUser = testCase "registerUser no user given" assertion
  where
    assertion :: Assertion
    assertion = do
        let hdl = with auth $ A.registerUser "user" "pwd"
        let params = [("user", []), ("pwd", ["buzz"])]
        res <- evalHandler Nothing (ST.get "" $ Map.fromList params) hdl appInit
        either (assertFailure . show)
               (assertBool failMsg . isLeftFailure UsernameMissing) res

    failMsg = "registerUser: I expected to fail due to UsernameMissing " ++
              ", but I didn't."


------------------------------------------------------------------------------
testRegisterUserNoPwd :: Test
testRegisterUserNoPwd = testCase "registerUser no pwd given" assertion
  where
    assertion :: Assertion
    assertion = do
        let hdl = with auth $ A.registerUser "user" "pwd"
        let params = Map.fromList [("user", ["fizz"]), ("pwd", [])]
        res <- evalHandler Nothing (ST.get "" $ params) hdl appInit
        either (assertFailure . show)
               (assertBool failMsg . isLeftFailure PasswordMissing) res

    failMsg = "registerUser: I expected to fail due to PasswordMissing " ++
              ", but I didn't."


------------------------------------------------------------------------------
testRequireUserOK :: Test
testRequireUserOK = testCase "requireUser good handler exec" assertion
  where
    assertion :: Assertion
    assertion = do
        res <- runHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (ST.assertBodyContains "good") res

    hdl :: Handler App App ()
    hdl = with auth $ do
        let badHdl = writeText "bad"
        let goodHdl = writeText "good"
        A.loginByUsername "foo" (ClearText "foo") True
        A.requireUser auth badHdl goodHdl


------------------------------------------------------------------------------
testRequireUserKO :: Test
testRequireUserKO = testCase "requireUser bad handler exec" assertion
  where
    assertion :: Assertion
    assertion = do
        res <- runHandler Nothing (ST.get "" Map.empty) hdl appInit
        either (assertFailure . show) (ST.assertBodyContains "bad") res

    hdl :: Handler App App ()
    hdl = with auth $ do
        let badHdl = writeText "bad"
        let goodHdl = writeText "good"
        _ <- A.loginByUsername "doesnotexist" (ClearText "") True
        A.requireUser auth badHdl goodHdl


isRight :: Either a b -> Bool
isRight (Left _) = False
isRight (Right _) = True

isLeft :: Either a b -> Bool
isLeft (Left _) = True
isLeft (Right _) = False