From 2480efc345a2bde7a80f45b494aaa01a59eb8dfa Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <sarah.vaupel@uniworx.de>
Date: Fri, 8 Mar 2024 09:55:51 +0100
Subject: [PATCH] chore: userLookupAndUpsert contd

---
 src/Handler/Utils/Avs.hs   | 13 ++++++-------
 src/Handler/Utils/Users.hs |  4 ++--
 2 files changed, 8 insertions(+), 9 deletions(-)

diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs
index 790479aff..3743dcd8f 100644
--- a/src/Handler/Utils/Avs.hs
+++ b/src/Handler/Utils/Avs.hs
@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022-23 Steffen Jost <s.jost@fraport.de>
+-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -35,8 +35,7 @@ import qualified Data.Set             as Set
 import qualified Data.Map             as Map
 import qualified Data.Text            as Text
 import qualified Data.CaseInsensitive as CI
--- import Auth.LDAP (ldapUserPrincipalName)
-import Foundation.Yesod.Auth (ldapLookupAndUpsert) -- , CampusUserConversionException())
+import Foundation.Yesod.Auth (userLookupAndUpsert)
 
 import Handler.Utils.Company
 import Handler.Utils.Qualification
@@ -355,12 +354,12 @@ guessAvsUser someid = do
             [Entity uid _] -> return $ Just uid
             _              -> return Nothing
         uid -> return uid
-    Nothing -> try (runDB $ ldapLookupAndUpsert someid) >>= \case
+    Nothing -> try (runDB $ userLookupAndUpsert someid UpsertUserGuessUser) >>= \case
       Right Entity{entityKey=uid, entityVal=User{userCompanyPersonalNumber=Just persNo}} -> 
         maybeM (return $ Just uid) (return . Just) (maybeUpsertAvsUserByCard (Right $ mkAvsInternalPersonalNo persNo))
       Right Entity{entityKey=uid} -> return $ Just uid
       other -> do -- attempt to recover by trying other ids
-        whenIsLeft other (\(err::SomeException) -> $logInfoS "AVS" $ "upsertAvsUser LDAP error " <> tshow err) -- this line primarily forces exception type to catch-all      
+        whenIsLeft other (\(err::SomeException) -> $logInfoS "AVS" $ "upsertAvsUser external error " <> tshow err) -- this line primarily forces exception type to catch-all      
         runDB . runMaybeT $ 
           let someIdent = stripCI someid
           in    MaybeT (getKeyBy $ UniqueEmail          someIdent)
@@ -370,7 +369,7 @@ guessAvsUser someid = do
 upsertAvsUser :: Text -> Handler (Maybe UserId) -- TODO: change to Entity
 upsertAvsUser (discernAvsCardPersonalNo -> Just someid) = maybeCatchAll $ upsertAvsUserByCard someid    -- Note: Right case is any number; it could be AvsCardNumber or AvsInternalPersonalNumber; we cannot know, but the latter is much more likely and useful to users!
 upsertAvsUser otherId = -- attempt LDAP lookup to find by eMail
-  try (runDB $ ldapLookupAndUpsert otherId) >>= \case
+  try (runDB $ userLookupAndUpsert otherId UpsertUserGuessUser) >>= \case
     Right Entity{entityVal=User{userCompanyPersonalNumber=Just persNo}} -> maybeCatchAll $ upsertAvsUserByCard (Right $ mkAvsInternalPersonalNo persNo)
     other -> do -- attempt to recover by trying other ids
       whenIsLeft other (\(err::SomeException) -> $logInfoS "AVS" $ "upsertAvsUser LDAP error " <> tshow err) -- this line primarily forces exception type to catch-all      
@@ -421,7 +420,7 @@ upsertAvsUserById api = do
               (_:_) -> throwM $ AvsUserAmbiguous api
               [] -> do
                 upsRes :: Either SomeException (Entity User)
-                  <- try $ ldapLookupAndUpsert persNo -- TODO: do azure lookup and upsert if appropriate
+                  <- try $ userLookupAndUpsert persNo UpsertUserGuessUser -- TODO: do azure lookup and upsert if appropriate
                 $logInfoS "AVS" $ "No matching existing user found. Attempted LDAP upsert returned: " <> tshow upsRes
                 case upsRes of
                   Right Entity{entityKey=uid} -> insertUniqueEntity $ UserAvs api uid avsPersonPersonNo now Nothing -- pin/addr are updated in next step anyway
diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs
index 24b395ca1..2580d1700 100644
--- a/src/Handler/Utils/Users.hs
+++ b/src/Handler/Utils/Users.hs
@@ -237,9 +237,9 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)
           -- TODO: Generalize
           doLdap userMatr = do
             ldapPool' <- getsYesod $ view _appLdapPool
-            fmap join . for ldapPool' $ \ldapPool@(upsertUserLdapConf,_) -> do
+            fmap join . for ldapPool' $ \ldapPool@(LdapConf{ ldapConfSourceId = upsertUserLdapHost },_) -> do
               ldapData <- ldapUserMatr' ldapPool userMatr
-              for ldapData $ \upsertUserLdapData -> upsertUser UpsertUserGuessUser UpsertUserDataLdap{..}
+              for ldapData $ \upsertUserLdapData -> upsertUser UpsertUserGuessUser $ UpsertUserDataLdap{..} :| []
 
       let
         getTermMatr :: [PredLiteral GuessUserInfo] -> Maybe UserMatriculation