summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKjetil Orbekk <kjetil.orbekk@gmail.com>2015-10-11 15:36:10 -0400
committerKjetil Orbekk <kjetil.orbekk@gmail.com>2015-10-11 15:36:10 -0400
commit4fe1a71b481527b7145e59c27eae3d3fd4060c74 (patch)
tree5c28bdc722ae5cbc3074efebfe293fcfd5f2611b
parente9ea90182193cb6a813244bc676a8fe2f573fa29 (diff)
Almost working authentication.
-rw-r--r--photos.cabal20
-rw-r--r--src/Authentication.hs21
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
+