From ad4ae713c8c87c13616582389fda05a6dba8d962 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <>
Date: Sat, 15 Aug 2020 16:37:13 +0200
Subject: [PATCH] fix(guess-user): fix ldap-lookup condition and refactor

---
 src/Handler/Utils/Users.hs | 51 ++++++++++++++++++++++++++------------
 1 file changed, 35 insertions(+), 16 deletions(-)

diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs
index b17fc5f36..681b3099e 100644
--- a/src/Handler/Utils/Users.hs
+++ b/src/Handler/Utils/Users.hs
@@ -96,7 +96,6 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)
       users <- retrieveUsers
       let users' = sortBy (flip closeness) users
 
-          -- TODO enhance
           matchesMatriculation :: Entity User -> Maybe Bool
           matchesMatriculation = preview $ _entityVal . _userMatrikelnummer . to (\userMatr ->
             any (\p -> all ((== userMatr) . Just) (p ^.. folded . _PLVariable . _guessUserMatrikelnummer)
@@ -106,21 +105,23 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)
           closeness :: Entity User -> Entity User -> Ordering
           closeness ul ur = maximum $ impureNonNull $ criteria <&> \term -> 
             let
+              matches userField name = _entityVal . userField . to (`matchesName` name)
               comp True  userField guess = (term ^.. folded . _PLVariable . guess) <&> \name ->
-                compare (       ul ^. _entityVal . userField . to (`matchesName` name))
-                        (       ur ^. _entityVal . userField . to (`matchesName` name))
+                compare (       ul ^. userField `matches` name)
+                        (       ur ^. userField `matches` name)
               comp False userField guess = (term ^.. folded . _PLNegated  . guess) <&> \name ->
-                compare (Down $ ul ^. _entityVal . userField . to (`matchesName` name))
-                        (Down $ ur ^. _entityVal . userField . to (`matchesName` name))
-            in mconcat $ concat
+                compare (Down $ ul ^. userField `matches` name)
+                        (Down $ ur ^. userField `matches` name)
+            in mconcat $ concat $
                  [ pure $ compare (Down $ matchesMatriculation ul) (Down $ matchesMatriculation ur)
-                 , comp True  _userSurname     _guessUserSurname
-                 , comp False _userSurname     _guessUserSurname
-                 , comp True  _userFirstName   _guessUserFirstName
-                 , comp False _userFirstName   _guessUserFirstName
-                 , comp True  _userDisplayName _guessUserDisplayName
-                 , comp False _userDisplayName _guessUserDisplayName
-                 ]
+                 ] <>
+                 [ comp b userField guess
+                 | (userField,guess) <- [(_userSurname    , _guessUserSurname)
+                                        ,(_userFirstName  , _guessUserFirstName)
+                                        ,(_userDisplayName, _guessUserDisplayName)
+                                        ]
+                  , b <- [True,False]
+                  ]
           
           takeClosest []  = []
           takeClosest [x] = [x]
@@ -134,6 +135,25 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)
               ldapData <- campusUserMatr' ldapPool FailoverUnlimited userMatr
               for ldapData $ upsertCampusUser UpsertCampusUser
 
+      let
+        getTermMatr :: [PredLiteral GuessUserInfo] -> Maybe UserMatriculation
+        getTermMatr = getTermMatrAux Nothing where
+          getTermMatrAux acc [] = acc
+          getTermMatrAux acc (PLVariable (GuessUserMatrikelnummer matr):xs)
+            | Just matr' <- acc, matr == matr' = getTermMatrAux acc xs
+            | Nothing    <- acc                = getTermMatrAux (Just matr) xs
+            | otherwise                        = Nothing
+          getTermMatrAux acc (PLNegated  (GuessUserMatrikelnummer matr):xs)
+            | Just matr' <- acc, matr /= matr' = getTermMatrAux acc xs
+            | Nothing    <- acc                = getTermMatrAux acc xs
+            | otherwise                        = Nothing
+          getTermMatrAux acc (_:xs) = getTermMatrAux acc xs
+
+        convertLdapResults :: [Entity User] -> Maybe (Either (NonEmpty (Entity User)) (Entity User))
+        convertLdapResults []  = Nothing
+        convertLdapResults [x] = Just $ Right x
+        convertLdapResults xs  = Just $ Left $ NonEmpty.fromList xs
+      
       if
         | x : [] <- users'
         , fromMaybe False (matchesMatriculation x) || didLdap
@@ -146,8 +166,7 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)
         , fromMaybe False (matchesMatriculation x) || didLdap
           -> return $ Just $ Left $ NonEmpty.fromList xs
         | not didLdap
-        , userMatr : userMatrs' <- criteria ^.. folded . folded . _PLVariable . _guessUserMatrikelnummer
-        , all (== userMatr) userMatrs'
-          -> doLdap userMatr >>= maybe (go True) (return . Just . Right)
+        , userMatrs <- (Set.toList . Set.fromList . catMaybes) $ getTermMatr <$> criteria
+          -> mapM doLdap userMatrs >>= maybe (go True) (return . Just) . convertLdapResults . catMaybes
         | otherwise
           -> return Nothing