From 95803db3a0460126e56e56b6d13e08fb6967d4e7 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <sarah.vaupel@uniworx.de>
Date: Thu, 7 Mar 2024 15:32:07 +0100
Subject: [PATCH] chore(auth): fix fetchUserData

---
 src/Foundation/Yesod/Auth.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs
index bb65f2115..3d32db6f7 100644
--- a/src/Foundation/Yesod/Auth.hs
+++ b/src/Foundation/Yesod/Auth.hs
@@ -199,20 +199,22 @@ fetchUserData :: forall m site.
                  ( MonadHandler m
                  , HandlerSite m ~ UniWorX
                  , MonadCatch m
+                 , MonadMask m
+                 , MonadUnliftIO m
                  )
               => UpsertUserMode
               -> Creds site
               -> SqlPersistT m (NonEmpty UpsertUserData)
-fetchUserData upsertMode creds@Creds{..} = do
+fetchUserData _upsertMode creds@Creds{..} = do
   userAuthConf <- getsYesod $ view _appUserAuthConf
   now <- liftIO getCurrentTime
 
   results :: NonEmpty UpsertUserData <- case userAuthConf of
-    UserAuthConfSingleSource{..} -> fmap throwLeft . runExceptT $ case userAuthConfSingleSource of
+    UserAuthConfSingleSource{..} -> (:| []) <$> case userAuthConfSingleSource of
       AuthSourceConfAzureAdV2 AzureConf{ azureConfClientId = upsertUserAzureTenantId } -> do
         queryOAuth2User @[(Text, [ByteString])] credsIdent >>= \case
           Right upsertUserAzureData -> return UpsertUserDataAzure{..}
-          Left _ -> throwE FetchUserDataNoResult
+          Left _ -> throwM FetchUserDataNoResult
       AuthSourceConfLdap LdapConf{..} -> do
         ldapPool <- fmap (fromMaybe $ error "LDAP source configured, but no LDAP pool initialized") . getsYesod $ view _appLdapPool
         UpsertUserDataLdap ldapConfSourceId <$> ldapUser ldapPool creds
@@ -224,7 +226,7 @@ fetchUserData upsertMode creds@Creds{..} = do
         (externalUserData, externalUserSource) = case res of
           UpsertUserDataAzure{..} -> (toJSON upsertUserAzureData, AuthSourceIdAzure upsertUserAzureTenantId)
           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