chore(azure): implement azureUser variant
This commit is contained in:
parent
f4b8417deb
commit
43bf25a5bd
@ -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 ----
|
||||||
|
|||||||
Reference in New Issue
Block a user