Permalink
Browse files

Switch to Either in loginByRememberToken return type

Most login related functions were already using Either for returning
login related errors.  Convert loginByRememberToken from Maybe to
Either to be consistent with the rest of this module's error handling.

Fix unit tests for the new loginByRememberToken type
  • Loading branch information...
1 parent d21f34d commit a7e1b7fb260baa240db5c8fc69f12deb6f2f0fc5 @nurpax nurpax committed Dec 26, 2012
Showing with 12 additions and 10 deletions.
  1. +8 −6 src/Snap/Snaplet/Auth/Handlers.hs
  2. +4 −4 test/suite/Snap/Snaplet/Auth/Handlers/Tests.hs
View
14 src/Snap/Snaplet/Auth/Handlers.hs
@@ -108,16 +108,18 @@ loginByUsername unm pwd shouldRemember = do
------------------------------------------------------------------------------
-- | Remember user from the remember token if possible and perform login
--
-loginByRememberToken :: Handler b (AuthManager b) (Maybe AuthUser)
+loginByRememberToken :: Handler b (AuthManager b) (Either AuthFailure AuthUser)
loginByRememberToken = withBackend $ \impl -> do
key <- gets siteKey
cookieName_ <- gets rememberCookieName
period <- gets rememberPeriod
- runMaybeT $ do
- token <- MaybeT $ getRememberToken key cookieName_ period
- user <- MaybeT $ liftIO $ lookupByRememberToken impl
- $ decodeUtf8 token
+ runEitherT $ do
+ token <- noteT (AuthError "loginByRememberToken: no remember token") $
+ MaybeT $ getRememberToken key cookieName_ period
+ user <- noteT (AuthError "loginByRememberToken: no remember token") $
+ MaybeT $ liftIO $ lookupByRememberToken impl
+ $ decodeUtf8 token
lift $ forceLogin user
return user
@@ -142,7 +144,7 @@ currentUser = cacheOrLookup $ withBackend $ \r -> do
s <- gets session
uid <- withTop s getSessionUserId
case uid of
- Nothing -> loginByRememberToken
+ Nothing -> hush <$> loginByRememberToken
Just uid' -> liftIO $ lookupByUserId r uid'
View
8 test/suite/Snap/Snaplet/Auth/Handlers/Tests.hs
@@ -201,7 +201,7 @@ testLoginByRememberTokenKO = testCase "loginByRememberToken no token" assertion
assertion = do
let hdl = with auth loginByRememberToken
res <- evalHandler (ST.get "" Map.empty) hdl appInit
- either (assertFailure . show) (assertBool failMsg . isNothing) res
+ either (assertFailure . show) (assertBool failMsg . isLeft) res
failMsg = "loginByRememberToken: Expected to fail for the " ++
"absence of a token, but I didn't."
@@ -216,12 +216,12 @@ testLoginByRememberTokenOK = testCase "loginByRememberToken token" assertion
res <- evalHandler (ST.get "" Map.empty) hdl appInit
case res of
(Left e) -> assertFailure $ show e
- (Right res') -> assertBool failMsg $ isJust res'
+ (Right res') -> assertBool failMsg $ isRight res'
- hdl :: Handler App App (Maybe AuthUser)
+ hdl :: Handler App App (Either AuthFailure AuthUser)
hdl = with auth $ do
res <- loginByUsername "foo" (ClearText "foo") True
- either (\_ -> return Nothing) (\_ -> loginByRememberToken) res
+ either (\e -> return (Left e)) (\_ -> loginByRememberToken) res
failMsg = "loginByRememberToken: Expected to succeed but I didn't."

0 comments on commit a7e1b7f

Please sign in to comment.