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.

---
 photos.cabal          | 20 +++++++++++---------
 src/Authentication.hs | 21 ++++++++++++++++++++-
 2 files changed, 31 insertions(+), 10 deletions(-)

diff --git a/photos.cabal b/photos.cabal
index d0339bf..5bc02bc 100644
--- a/photos.cabal
+++ b/photos.cabal
@@ -21,16 +21,18 @@ executable photos
   default-language:    Haskell2010
   build-depends:
       base >= 4.7 && < 5
-    , servant
-    , bytestring
-    , servant-server
     , aeson
-    , warp
-    , wai
-    , wai-extra
-    , hflags
+    , bytestring
     , directory
-    , transformers
-    , filepath
     , either
+    , extra
+    , filepath
+    , hflags
     , http-conduit
+    , mtl
+    , servant
+    , servant-server
+    , transformers
+    , wai
+    , wai-extra
+    , warp
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