From 7a510b315d62131e5fb47da8c1398144c57d4587 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <sarah.vaupel@protonmail.com>
Date: Thu, 18 Apr 2024 22:27:51 +0200
Subject: [PATCH] fix(auth): use appsettings for azure tenant id; refactor
 azure lookup url methods

---
 src/Auth/OAuth2.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/src/Auth/OAuth2.hs b/src/Auth/OAuth2.hs
index 88bcff790..55c1997da 100644
--- a/src/Auth/OAuth2.hs
+++ b/src/Auth/OAuth2.hs
@@ -3,6 +3,7 @@
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
 
 module Auth.OAuth2
   ( apAzure
@@ -152,12 +153,13 @@ instance Exception UserDataException
 queryOAuth2User :: forall j m.
                    ( FromJSON j
                    , MonadHandler m
+                   , HasAppSettings (HandlerSite m)
                    , MonadThrow m
                    )
                 => Text -- ^ User identifier (arbitrary needle)
                 -> m (Either UserDataException j)
 queryOAuth2User userID = runExceptT $ do
-  (queryUrl, tokenUrl) <- liftIO mkBaseUrls
+  (queryUrl, tokenUrl) <- mkBaseUrls
   req <- parseRequest $ "GET " ++ queryUrl ++ unpack userID
   mTokens <- lookupSessionJson SessionOAuth2Token
   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
 
 
-mkBaseUrls :: IO (String, String)
+mkBaseUrls :: (MonadHandler m, HasAppSettings (HandlerSite m)) => m (String, String)
 mkBaseUrls = do
 # 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/"
          , "https://login.microsoftonline.com/" ++ tenantID ++ "/oauth2/v2.0" )
 # 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
   return ( base ++ "/users/query?id="
          , base ++ "/token" )