diff options
author | Kjetil Orbekk <kjetil.orbekk@gmail.com> | 2015-10-11 15:36:10 -0400 |
---|---|---|
committer | Kjetil Orbekk <kjetil.orbekk@gmail.com> | 2015-10-11 15:36:10 -0400 |
commit | 4fe1a71b481527b7145e59c27eae3d3fd4060c74 (patch) | |
tree | 5c28bdc722ae5cbc3074efebfe293fcfd5f2611b /src | |
parent | e9ea90182193cb6a813244bc676a8fe2f573fa29 (diff) |
Almost working authentication.
Diffstat (limited to 'src')
-rw-r--r-- | src/Authentication.hs | 21 |
1 files changed, 20 insertions, 1 deletions
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 + |