From 6ccbb3b7ff5848ed350674cb66d33b17b3516b22 Mon Sep 17 00:00:00 2001
From: Steffen <s.jost@fraport.de>
Date: Tue, 30 Jul 2024 15:57:43 +0200
Subject: [PATCH] refactor(ldap): some minor code cleaning

---
 src/Foundation/Yesod/Auth.hs | 28 ++++++++++++++--------------
 1 file changed, 14 insertions(+), 14 deletions(-)

diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs
index f31fc4a1e..cd6b4c42b 100644
--- a/src/Foundation/Yesod/Auth.hs
+++ b/src/Foundation/Yesod/Auth.hs
@@ -107,7 +107,7 @@ authenticate creds@Creds{..} = liftHandler . runDB . withReaderT projectBackend
           | not isDummy -> res <$ update uid [ UserLastAuthentication =. Just now ]
         _other -> return res
 
-  $logDebugS "auth" $ tshow Creds{..}  
+  $logDebugS "auth" $ tshow Creds{..}
   ldapPool' <- getsYesod $ view _appLdapPool
 
   flip catches excHandlers $ case ldapPool' of
@@ -153,9 +153,9 @@ _upsertCampusUserMode mMode cs@Creds{..}
 
     defaultOther = apHash
 
-ldapLookupAndUpsert :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX, MonadMask m, MonadUnliftIO m) => Text -> SqlPersistT m (Entity User)                    
-ldapLookupAndUpsert ident = 
-  getsYesod (view _appLdapPool) >>= \case 
+ldapLookupAndUpsert :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX, MonadMask m, MonadUnliftIO m) => Text -> SqlPersistT m (Entity User)
+ldapLookupAndUpsert ident =
+  getsYesod (view _appLdapPool) >>= \case
     Nothing -> throwM $ CampusUserLdapError $ LdapHostNotResolved "No LDAP configuration in Foundation."
     Just ldapPool ->
       campusUser'' ldapPool campusUserFailoverMode ident >>= \case
@@ -188,15 +188,15 @@ upsertCampusUser upsertMode ldapData = do
   user@(Entity userId userRec) <- case oldUsers of
     Just [oldUserId] -> updateGetEntity oldUserId userUpdate
     _other           -> upsertBy (UniqueAuthentication (newUser ^. _userIdent)) newUser userUpdate
-  unless (validDisplayName (newUser ^. _userTitle) 
+  unless (validDisplayName (newUser ^. _userTitle)
                            (newUser ^. _userFirstName)
-                           (newUser ^. _userSurname) 
+                           (newUser ^. _userSurname)
                            (userRec ^. _userDisplayName)) $
-    update userId [ UserDisplayName   =. (newUser ^. _userDisplayName) ]
-  when (validEmail' (userRec ^. _userEmail)) $ do 
+    update userId [ UserDisplayName   =. (newUser ^. _userDisplayName) ]  -- update invalid display names only
+  when (validEmail' (userRec ^. _userEmail)) $ do                         -- RECALL: userRec already contains basic updates
     let emUps =  [ UserDisplayEmail   =. (newUser ^. _userEmail)  | not (validEmail' (userRec ^. _userDisplayEmail))  ]
               ++ [ UserAuthentication =. AuthLDAP                 | is _AuthNoLogin  (userRec ^. _userAuthentication) ]
-    unless (null emUps) $ update userId emUps
+    update userId emUps -- update already checks whether list is empty
     -- Attempt to update ident, too:
     unless (validEmail' (userRec ^. _userIdent)) $
       void $ maybeCatchAll (update userId [ UserIdent =. (newUser ^. _userEmail) ] >> return (Just ()))
@@ -227,7 +227,7 @@ decodeUserTest mbIdent ldapData = do
 
 
 decodeUser :: (MonadThrow m) =>  UTCTime -> UserDefaultConf -> UpsertCampusUserMode -> Ldap.AttrList [] -> m (User,_)
-decodeUser now UserDefaultConf{..} upsertMode ldapData = do    
+decodeUser now UserDefaultConf{..} upsertMode ldapData = do
     let
       userTelephone             = decodeLdap ldapUserTelephone <&> canonicalPhone
       userMobile                = decodeLdap ldapUserMobile    <&> canonicalPhone
@@ -266,7 +266,7 @@ decodeUser now UserDefaultConf{..} upsertMode ldapData = do
       --      -> return $ CI.mk userEmail
       | otherwise
         -> throwM CampusUserInvalidEmail
-        
+
     userLdapPrimaryKey <- if
       | [bs] <- ldapMap !!! ldapPrimaryKey
       , Right userLdapPrimaryKey'' <- Text.decodeUtf8' bs
@@ -305,13 +305,13 @@ decodeUser now UserDefaultConf{..} upsertMode ldapData = do
         , userPrefersPostal           = userDefaultPrefersPostal
         , ..
         }
-      userUpdate =  
+      userUpdate =
         [ UserLastAuthentication      =. Just now  | isLogin ] ++
         [ UserEmail                   =. userEmail | validEmail' userEmail ] ++
         [
-        -- UserDisplayName             =. userDisplayName -- not updated here, since users are allowed to change their DisplayName; see line 272
+        -- UserDisplayName             =. userDisplayName -- not updated here, since users are allowed to change their DisplayName; see line 191
           UserFirstName               =. userFirstName
-        , UserSurname                 =. userSurname                    
+        , UserSurname                 =. userSurname
         , UserLastLdapSynchronisation =. Just now
         , UserLdapPrimaryKey          =. userLdapPrimaryKey
         , UserMobile                  =. userMobile