fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(auth): use appsettings for azure tenant id; refactor azure lookup url methods

Browse Source
This commit is contained in:
Sarah Vaupel 2024-04-18 22:27:51 +02:00
parent dc701e5c49
commit 7a510b315d
1 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Auth/OAuth2.hs
View File

@ -3,6 +3,7 @@
-- SPDX-License-Identifier: AGPL-3.0-or-later -- SPDX-License-Identifier: AGPL-3.0-or-later
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Auth.OAuth2 module Auth.OAuth2
( apAzure ( apAzure
@ -152,12 +153,13 @@ instance Exception UserDataException
queryOAuth2User :: forall j m. queryOAuth2User :: forall j m.
( FromJSON j ( FromJSON j
, MonadHandler m , MonadHandler m
, HasAppSettings (HandlerSite m)
, MonadThrow m , MonadThrow m
) )
=> Text -- ^ User identifier (arbitrary needle) => Text -- ^ User identifier (arbitrary needle)
-> m (Either UserDataException j) -> m (Either UserDataException j)
queryOAuth2User userID = runExceptT $ do queryOAuth2User userID = runExceptT $ do
(queryUrl, tokenUrl) <- liftIO mkBaseUrls (queryUrl, tokenUrl) <- mkBaseUrls
req <- parseRequest $ "GET " ++ queryUrl ++ unpack userID req <- parseRequest $ "GET " ++ queryUrl ++ unpack userID
mTokens <- lookupSessionJson SessionOAuth2Token mTokens <- lookupSessionJson SessionOAuth2Token
unless (isJust mTokens) . throwE $ UserDataInternalException "Tried to load session Oauth2 tokens, but there are none" unless (isJust mTokens) . throwE $ UserDataInternalException "Tried to load session Oauth2 tokens, but there are none"
@ -177,14 +179,14 @@ queryOAuth2User userID = runExceptT $ do
Right x -> return x Right x -> return x
mkBaseUrls :: IO (String, String) mkBaseUrls :: (MonadHandler m, HasAppSettings (HandlerSite m)) => m (String, String)
mkBaseUrls = do mkBaseUrls = do
# ifndef DEVELOPMENT # ifndef DEVELOPMENT
Just tenantID <- lookupEnv "AZURE_TENANT_ID" tenantID <- fmap (maybe (throwM $ UserDataInternalException "Could not determine tenant ID from current app configuration") show) . getsYesod . preview $ _appUserAuthConf . _userAuthConfSingleSource . _AuthSourceConfAzureAdV2 . _azureConfTenantId
return ( "https://graph.microsoft.com/v1.0/users/" return ( "https://graph.microsoft.com/v1.0/users/"
, "https://login.microsoftonline.com/" ++ tenantID ++ "/oauth2/v2.0" ) , "https://login.microsoftonline.com/" ++ tenantID ++ "/oauth2/v2.0" )
# else # else
Just port <- lookupEnv "OAUTH2_SERVER_PORT" port :: String <- liftIO $ maybe (throwM $ UserDataInternalException "Development environment variable OAUTH2_SERVER_PORT is unset") id <$> lookupEnv "OAUTH2_SERVER_PORT"
let base = "http://localhost:" ++ port let base = "http://localhost:" ++ port
return ( base ++ "/users/query?id=" return ( base ++ "/users/query?id="
, base ++ "/token" ) , base ++ "/token" )