Authentication module to check if tokens are valid.

Keeps a cache of valid tokens to avoid multiple lookups.

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