fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

chore(auth): fix fetchUserData

Browse Source
This commit is contained in:
Sarah Vaupel 2024-03-07 15:32:07 +01:00
parent d71ff014ea
commit 95803db3a0
1 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Foundation/Yesod/Auth.hs
View File

@ -199,20 +199,22 @@ fetchUserData :: forall m site.
( MonadHandler m ( MonadHandler m
, HandlerSite m ~ UniWorX , HandlerSite m ~ UniWorX
, MonadCatch m , MonadCatch m
, MonadMask m
, MonadUnliftIO m
) )
=> UpsertUserMode => UpsertUserMode
-> Creds site -> Creds site
-> SqlPersistT m (NonEmpty UpsertUserData) -> SqlPersistT m (NonEmpty UpsertUserData)
fetchUserData upsertMode creds@Creds{..} = do fetchUserData _upsertMode creds@Creds{..} = do
userAuthConf <- getsYesod $ view _appUserAuthConf userAuthConf <- getsYesod $ view _appUserAuthConf
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
results :: NonEmpty UpsertUserData <- case userAuthConf of results :: NonEmpty UpsertUserData <- case userAuthConf of
UserAuthConfSingleSource{..} -> fmap throwLeft . runExceptT $ case userAuthConfSingleSource of UserAuthConfSingleSource{..} -> (:| []) <$> case userAuthConfSingleSource of
AuthSourceConfAzureAdV2 AzureConf{ azureConfClientId = upsertUserAzureTenantId } -> do AuthSourceConfAzureAdV2 AzureConf{ azureConfClientId = upsertUserAzureTenantId } -> do
queryOAuth2User @[(Text, [ByteString])] credsIdent >>= \case queryOAuth2User @[(Text, [ByteString])] credsIdent >>= \case
Right upsertUserAzureData -> return UpsertUserDataAzure{..} Right upsertUserAzureData -> return UpsertUserDataAzure{..}
Left _ -> throwE FetchUserDataNoResult Left _ -> throwM FetchUserDataNoResult
AuthSourceConfLdap LdapConf{..} -> do AuthSourceConfLdap LdapConf{..} -> do
ldapPool <- fmap (fromMaybe $ error "LDAP source configured, but no LDAP pool initialized") . getsYesod $ view _appLdapPool ldapPool <- fmap (fromMaybe $ error "LDAP source configured, but no LDAP pool initialized") . getsYesod $ view _appLdapPool
UpsertUserDataLdap ldapConfSourceId <$> ldapUser ldapPool creds UpsertUserDataLdap ldapConfSourceId <$> ldapUser ldapPool creds
@ -224,7 +226,7 @@ fetchUserData upsertMode creds@Creds{..} = do
(externalUserData, externalUserSource) = case res of (externalUserData, externalUserSource) = case res of
UpsertUserDataAzure{..} -> (toJSON upsertUserAzureData, AuthSourceIdAzure upsertUserAzureTenantId) UpsertUserDataAzure{..} -> (toJSON upsertUserAzureData, AuthSourceIdAzure upsertUserAzureTenantId)
UpsertUserDataLdap{..} -> (toJSON upsertUserLdapData, AuthSourceIdLdap upsertUserLdapHost) UpsertUserDataLdap{..} -> (toJSON upsertUserLdapData, AuthSourceIdLdap upsertUserLdapHost)
in void . liftHandler . runDB $ upsert ExternalUser{..} [ExternalUserData =. externalUserData, ExternalUserLastSync =. externalUserLastSync] in void $ upsert ExternalUser{..} [ExternalUserData =. externalUserData, ExternalUserLastSync =. externalUserLastSync]
return results return results