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

chore: userLookupAndUpsert contd

Browse Source
This commit is contained in:
Sarah Vaupel 2024-03-08 09:55:51 +01:00
parent 8c4ec00c35
commit 2480efc345
2 changed files with 8 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Handler/Utils/Avs.hs
View File

@ -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

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

@ -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