From 9aa7f0001830bf6fa2fbb38b9946dc24815fd0e0 Mon Sep 17 00:00:00 2001
From: Kjetil Orbekk <kjetil.orbekk@gmail.com>
Date: Mon, 12 Oct 2015 08:13:12 -0400
Subject: Authentication module to check if tokens are valid.

Keeps a cache of valid tokens to avoid multiple lookups.
---
 src/Authentication.hs | 23 +++++++++++++----------
 1 file 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
-- 
cgit v1.2.3