chore(azure): implement azureUser variant

This commit is contained in:
Sarah Vaupel 2024-01-30 21:50:56 +01:00
parent f4b8417deb
commit 43bf25a5bd

View File

@ -7,12 +7,13 @@
module Auth.OAuth2 module Auth.OAuth2
( apAzure ( apAzure
, azurePrimaryKey, azureUserPrincipalName, azureUserDisplayName, azureUserGivenName, azureUserSurname, azureUserMail, azureUserTelephone, azureUserMobile, azureUserPreferredLanguage , azurePrimaryKey, azureUserPrincipalName, azureUserDisplayName, azureUserGivenName, azureUserSurname, azureUserMail, azureUserTelephone, azureUserMobile, azureUserPreferredLanguage
, azureUser , azureUser, azureUser'
, AzureUserException(..) , AzureUserException(..), _AzureUserError, _AzureUserNoResult, _AzureUserAmbiguous
, oauth2MockServer , oauth2MockServer
, mockPluginName , mockPluginName
) where ) where
import qualified Data.CaseInsensitive as CI
import Data.Text import Data.Text
import Import.NoFoundation import Import.NoFoundation
@ -32,6 +33,8 @@ data AzureUserException = AzureUserError
instance Exception AzureUserException instance Exception AzureUserException
makePrisms ''AzureUserException
azurePrimaryKey, azureUserPrincipalName, azureUserDisplayName, azureUserGivenName, azureUserSurname, azureUserMail, azureUserTelephone, azureUserMobile, azureUserPreferredLanguage :: Text azurePrimaryKey, azureUserPrincipalName, azureUserDisplayName, azureUserGivenName, azureUserSurname, azureUserMail, azureUserTelephone, azureUserMobile, azureUserPreferredLanguage :: Text
azurePrimaryKey = "id" azurePrimaryKey = "id"
@ -45,8 +48,9 @@ azureUserMobile = "mobilePhone"
azureUserPreferredLanguage = "preferredLanguage" azureUserPreferredLanguage = "preferredLanguage"
-- | User lookup in an OAuth2 database with given credentials -- | User lookup in Microsoft Graph with given credentials
azureUser :: ( MonadUnliftIO m azureUser :: ( MonadMask m
, MonadUnliftIO m
-- , MonadThrow m -- , MonadThrow m
) )
=> AzureConf => AzureConf
@ -59,6 +63,17 @@ azureUser _conf _creds = fmap throwLeft . liftIO . runExceptT $ do
[res] -> return res [res] -> return res
_multiple -> throwE AzureUserAmbiguous _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 ---- ---- OAuth2 development auth plugin ----