From 43bf25a5bd92ba89f62bc983f0d0724d08f0d05a Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Tue, 30 Jan 2024 21:50:56 +0100 Subject: [PATCH] chore(azure): implement azureUser variant --- src/Auth/OAuth2.hs | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/src/Auth/OAuth2.hs b/src/Auth/OAuth2.hs index c3b775b7a..f30f4d7c1 100644 --- a/src/Auth/OAuth2.hs +++ b/src/Auth/OAuth2.hs @@ -7,12 +7,13 @@ module Auth.OAuth2 ( apAzure , azurePrimaryKey, azureUserPrincipalName, azureUserDisplayName, azureUserGivenName, azureUserSurname, azureUserMail, azureUserTelephone, azureUserMobile, azureUserPreferredLanguage - , azureUser - , AzureUserException(..) + , azureUser, azureUser' + , AzureUserException(..), _AzureUserError, _AzureUserNoResult, _AzureUserAmbiguous , oauth2MockServer , mockPluginName ) where +import qualified Data.CaseInsensitive as CI import Data.Text import Import.NoFoundation @@ -32,6 +33,8 @@ data AzureUserException = AzureUserError instance Exception AzureUserException +makePrisms ''AzureUserException + azurePrimaryKey, azureUserPrincipalName, azureUserDisplayName, azureUserGivenName, azureUserSurname, azureUserMail, azureUserTelephone, azureUserMobile, azureUserPreferredLanguage :: Text azurePrimaryKey = "id" @@ -45,8 +48,9 @@ azureUserMobile = "mobilePhone" azureUserPreferredLanguage = "preferredLanguage" --- | User lookup in an OAuth2 database with given credentials -azureUser :: ( MonadUnliftIO m +-- | User lookup in Microsoft Graph with given credentials +azureUser :: ( MonadMask m + , MonadUnliftIO m -- , MonadThrow m ) => AzureConf @@ -59,6 +63,17 @@ azureUser _conf _creds = fmap throwLeft . liftIO . runExceptT $ do [res] -> return res _multiple -> throwE AzureUserAmbiguous +-- | User lookup in Microsoft Graph with given user +azureUser' :: ( MonadMask m + , MonadUnliftIO m + -- , MonadThrow m + ) + => AzureConf + -> User + -> m (Maybe [(Text, [ByteString])]) -- (Either AzureUserException [(Text, [ByteString])]) +azureUser' conf User{userIdent} + = runMaybeT . catchIfMaybeT (is _AzureUserNoResult) $ azureUser conf (Creds apAzure (CI.original userIdent) []) + ---------------------------------------- ---- OAuth2 development auth plugin ----