From c32c97d6907d8b69e5d651bc44831001fffcfda0 Mon Sep 17 00:00:00 2001 From: Kjetil Orbekk Date: Thu, 15 Oct 2015 21:19:39 -0400 Subject: Verify client id in Authentication. --- src/Authentication.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'src/Authentication.hs') diff --git a/src/Authentication.hs b/src/Authentication.hs index bc00863..a0d3d8c 100644 --- a/src/Authentication.hs +++ b/src/Authentication.hs @@ -23,8 +23,8 @@ type Token = String data User = User { email :: String , name :: String + , aud :: String } deriving (Eq, Show, Generic) - instance FromJSON User queryUser :: Token -> IO (Maybe User) @@ -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 runner >>= return . fromEither +isAuthenticated :: [String] -> [String] -> MVar [Token] -> Token -> IO Bool +isAuthenticated clientIds allowedUsers tokenCache token = runEitherT runner >>= return . fromEither where runner :: EitherT Bool IO Bool runner = do ts <- lift $ readMVar tokenCache _ <- leftIf (token `elem` ts) True user <- lift $ queryUser token email' <- return $ fromMaybe "" (user >>= return . email) + aud' <- return $ fromMaybe "" (user >>= return . aud) + liftIO $ putStrLn $ "Trying to authenticate user: " ++ show user _ <- leftIf (not (email' `elem` allowedUsers)) False + _ <- leftIf (not (aud' `elem` clientIds)) False tokens <- lift $ takeMVar tokenCache lift $ putMVar tokenCache (token:tokens) return True -- cgit v1.2.3