fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(guess-user): fix ldap-lookup condition and refactor

Browse Source
This commit is contained in:
Sarah Vaupel 2020-08-15 16:37:13 +02:00
parent 4154a395f4
commit ad4ae713c8
1 changed files with 35 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
src/Handler/Utils/Users.hs
View File

@ -96,7 +96,6 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)
users <- retrieveUsers users <- retrieveUsers
let users' = sortBy (flip closeness) users let users' = sortBy (flip closeness) users
-- TODO enhance
matchesMatriculation :: Entity User -> Maybe Bool matchesMatriculation :: Entity User -> Maybe Bool
matchesMatriculation = preview $ _entityVal . _userMatrikelnummer . to (\userMatr -> matchesMatriculation = preview $ _entityVal . _userMatrikelnummer . to (\userMatr ->
any (\p -> all ((== userMatr) . Just) (p ^.. folded . _PLVariable . _guessUserMatrikelnummer) 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 :: Entity User -> Entity User -> Ordering
closeness ul ur = maximum $ impureNonNull $ criteria <&> \term -> closeness ul ur = maximum $ impureNonNull $ criteria <&> \term ->
let let
matches userField name = _entityVal . userField . to (`matchesName` name)
comp True userField guess = (term ^.. folded . _PLVariable . guess) <&> \name -> comp True userField guess = (term ^.. folded . _PLVariable . guess) <&> \name ->
compare ( ul ^. _entityVal . userField . to (`matchesName` name)) compare ( ul ^. userField `matches` name)
( ur ^. _entityVal . userField . to (`matchesName` name)) ( ur ^. userField `matches` name)
comp False userField guess = (term ^.. folded . _PLNegated . guess) <&> \name -> comp False userField guess = (term ^.. folded . _PLNegated . guess) <&> \name ->
compare (Down $ ul ^. _entityVal . userField . to (`matchesName` name)) compare (Down $ ul ^. userField `matches` name)
(Down $ ur ^. _entityVal . userField . to (`matchesName` name)) (Down $ ur ^. userField `matches` name)
in mconcat $ concat in mconcat $ concat $
[ pure $ compare (Down $ matchesMatriculation ul) (Down $ matchesMatriculation ur) [ pure $ compare (Down $ matchesMatriculation ul) (Down $ matchesMatriculation ur)
, comp True _userSurname _guessUserSurname ] <>
, comp False _userSurname _guessUserSurname [ comp b userField guess
, comp True _userFirstName _guessUserFirstName | (userField,guess) <- [(_userSurname , _guessUserSurname)
, comp False _userFirstName _guessUserFirstName ,(_userFirstName , _guessUserFirstName)
, comp True _userDisplayName _guessUserDisplayName ,(_userDisplayName, _guessUserDisplayName)
, comp False _userDisplayName _guessUserDisplayName ]
] , b <- [True,False]
]
takeClosest [] = [] takeClosest [] = []
takeClosest [x] = [x] takeClosest [x] = [x]
@ -134,6 +135,25 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)
ldapData <- campusUserMatr' ldapPool FailoverUnlimited userMatr ldapData <- campusUserMatr' ldapPool FailoverUnlimited userMatr
for ldapData $ upsertCampusUser UpsertCampusUser 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 if
| x : [] <- users' | x : [] <- users'
, fromMaybe False (matchesMatriculation x) || didLdap , fromMaybe False (matchesMatriculation x) || didLdap
@ -146,8 +166,7 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)
, fromMaybe False (matchesMatriculation x) || didLdap , fromMaybe False (matchesMatriculation x) || didLdap
-> return $ Just $ Left $ NonEmpty.fromList xs -> return $ Just $ Left $ NonEmpty.fromList xs
| not didLdap | not didLdap
, userMatr : userMatrs' <- criteria ^.. folded . folded . _PLVariable . _guessUserMatrikelnummer , userMatrs <- (Set.toList . Set.fromList . catMaybes) $ getTermMatr <$> criteria
, all (== userMatr) userMatrs' -> mapM doLdap userMatrs >>= maybe (go True) (return . Just) . convertLdapResults . catMaybes
-> doLdap userMatr >>= maybe (go True) (return . Just . Right)
| otherwise | otherwise
-> return Nothing -> return Nothing