summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Authentication.hs23
1 files changed, 13 insertions, 10 deletions
diff --git a/src/Authentication.hs b/src/Authentication.hs
index 3b0e479..0a0a49f 100644
--- a/src/Authentication.hs
+++ b/src/Authentication.hs
@@ -36,15 +36,18 @@ queryUser' token = do
response <- simpleHttp (makeUrl token)
return (decode response)
-isAuthenticated :: [[String]] -> MVar [Token] -> Token -> IO Bool
-isAuthenticated allowedUsers tokenCache token = runEitherT f >>= return . fromEither
- where f :: EitherT Bool IO Bool
- f = do
+isAuthenticated :: [String] -> MVar [Token] -> Token -> IO Bool
+isAuthenticated allowedUsers tokenCache token = runEitherT runner >>= return . fromEither
+ where runner :: EitherT Bool IO Bool
+ runner = do
ts <- lift $ readMVar tokenCache
- _ <- test (token `elem` ts)
+ _ <- leftIf (token `elem` ts) True
user <- lift $ queryUser token
- return False
-
- test False = return ()
- test True = left True
-
+ email' <- return $ fromMaybe "" (user >>= return . email)
+ _ <- leftIf (not (email' `elem` allowedUsers)) False
+ tokens <- lift $ takeMVar tokenCache
+ lift $ putMVar tokenCache (token:tokens)
+ return True
+
+ leftIf True x = left x
+ leftIf False x = right x