chore(azure): implement azureUser variant

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 ----