From 4fe1a71b481527b7145e59c27eae3d3fd4060c74 Mon Sep 17 00:00:00 2001
From: Kjetil Orbekk <kjetil.orbekk@gmail.com>
Date: Sun, 11 Oct 2015 15:36:10 -0400
Subject: Almost working authentication.

---
 src/Authentication.hs | 21 ++++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

(limited to 'src/Authentication.hs')

diff --git a/src/Authentication.hs b/src/Authentication.hs
index 2908309..3b0e479 100644
--- a/src/Authentication.hs
+++ b/src/Authentication.hs
@@ -7,12 +7,18 @@
 module Authentication (User, queryUser) where
 
 import Data.Aeson
+import Data.Maybe
+import Data.Either.Extra
 import GHC.Generics
 import Network.HTTP.Conduit
 import Data.ByteString.Lazy.Char8 (unpack)
 import Control.Exception
+import Control.Monad.Trans
+import Control.Monad.Trans.Either
+import Control.Concurrent.MVar
 
 makeUrl = ("https://www.googleapis.com/oauth2/v3/tokeninfo?id_token="++)
+type Token = String
 
 data User = User
   { email :: String
@@ -21,7 +27,7 @@ data User = User
 
 instance FromJSON User
 
-queryUser :: String -> IO (Maybe User)
+queryUser :: Token -> IO (Maybe User)
 queryUser token = (queryUser' token) `catch` \e -> do
   print (e :: HttpException)
   return Nothing
@@ -29,3 +35,16 @@ queryUser token = (queryUser' token) `catch` \e -> do
 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
+            ts <- lift $ readMVar tokenCache
+            _ <- test (token `elem` ts)
+            user <- lift $ queryUser token
+            return False
+
+          test False = return ()
+          test True = left True
+
-- 
cgit v1.2.3