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

fix(avs): do not associate users by AvsInfoPersonEmail

Browse Source
This commit is contained in:
Steffen Jost 2024-07-02 15:27:56 +02:00
parent ff9014ce05
commit 9e2f2214ce
2 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -484,18 +484,18 @@ createAvsUserById muid api = do
case Set.toList contactRes of case Set.toList contactRes of
[] -> throwM $ AvsUserUnknownByAvs api [] -> throwM $ AvsUserUnknownByAvs api
(_:_:_) -> throwM $ AvsUserAmbiguous api (_:_:_) -> throwM $ AvsUserAmbiguous api
[AvsDataContact{avsContactPersonInfo=cpi, avsContactFirmInfo=firmInfo, avsContactPersonID}] [adc@AvsDataContact{avsContactPersonInfo=cpi, avsContactFirmInfo=firmInfo, avsContactPersonID}]
| avsContactPersonID /= api -> throwM $ AvsIdMismatch api avsContactPersonID | avsContactPersonID /= api -> throwM $ AvsIdMismatch api avsContactPersonID
| otherwise -> do | otherwise -> do
-- check for matching existing user -- check for matching existing user
let internalPersNo :: Maybe Text = cpi ^? _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo let internalPersNo :: Maybe Text = cpi ^? _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo
persMail :: Maybe UserEmail = cpi ^? _avsInfoPersonEMail . _Just . from _CI -- persMail :: Maybe UserEmail = cpi ^? _avsInfoPersonEMail . _Just . from _CI
oldUsr <- runDB $ do oldUsr <- runDB $ do
mbUid <- if isJust muid mbUid <- if isJust muid
then return muid then return muid
else firstJustM $ catMaybes else firstJustM $ catMaybes
[ internalPersNo <&> (\ipn -> getKeyByFilter [UserCompanyPersonalNumber ==. Just ipn]) -- must ensure filter isnt ==. Nothing [ internalPersNo <&> (\ipn -> getKeyByFilter [UserCompanyPersonalNumber ==. Just ipn]) -- must ensure filter isnt ==. Nothing
, persMail <&> guessUserByEmail -- , persMail <&> guessUserByEmail -- this did not work, as unfortunately, superiors are sometimes listed under _avsInfoPersonEMail!
] ]
mbUAvs <- (getBy . UniqueUserAvsUser) `traverseJoin` mbUid mbUAvs <- (getBy . UniqueUserAvsUser) `traverseJoin` mbUid
return (mbUid, mbUAvs) return (mbUid, mbUAvs)
@ -533,9 +533,9 @@ createAvsUserById muid api = do
, audFirstName = cpi ^. _avsInfoFirstName & Text.strip , audFirstName = cpi ^. _avsInfoFirstName & Text.strip
, audSurname = cpi ^. _avsInfoLastName & Text.strip , audSurname = cpi ^. _avsInfoLastName & Text.strip
, audDisplayName = cpi ^. _avsInfoDisplayName , audDisplayName = cpi ^. _avsInfoDisplayName
, audDisplayEmail = persMail & fromMaybe mempty , audDisplayEmail = adc ^. _avsContactPrimaryEmail . to (fromMaybe mempty) . from _CI
, audEmail = persMail & fromMaybe ("AVSNO:" <> cpi ^. _avsInfoPersonNo . from _CI) , audEmail = "AVSNO:" <> cpi ^. _avsInfoPersonNo . from _CI
, audIdent = persMail & fromMaybe ("AVSID:" <> ciShow api ) , audIdent = "AVSID:" <> ciShow api
, audAuth = maybe AuthKindNoLogin (const AuthKindLDAP) internalPersNo , audAuth = maybe AuthKindNoLogin (const AuthKindLDAP) internalPersNo
, audMatriculation = cpi ^. _avsInfoPersonNo & Just , audMatriculation = cpi ^. _avsInfoPersonNo & Just
, audSex = Nothing , audSex = Nothing

2
src/Handler/Utils/AvsUpdate.hs
View File

@ -109,7 +109,7 @@ data CU_UserAvs_User
| CU_UA_UserMatrikelnummer | CU_UA_UserMatrikelnummer
| CU_UA_UserCompanyPersonalNumber | CU_UA_UserCompanyPersonalNumber
| CU_UA_UserLdapPrimaryKey | CU_UA_UserLdapPrimaryKey
-- CU_UA_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead -- CU_UA_UserDisplayEmail -- use _avsContactPrimaryEmail instead
deriving (Show, Eq) deriving (Show, Eq)
instance MkCheckUpdate CU_UserAvs_User where instance MkCheckUpdate CU_UserAvs_User where