chore: userLookupAndUpsert contd

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 (userLookupAndUpsert)
-import Foundation.Yesod.Auth (ldapLookupAndUpsert) -- , CampusUserConversionException())
 
 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

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