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

chore(avs): remove company superior, if there is none anymore

Browse Source
This commit is contained in:
Steffen Jost 2024-07-12 13:44:21 +02:00
parent fee14edf36
commit 8c8ffa5183
1 changed files with 84 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -643,13 +643,13 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
-- upsert company supervisor from AvsFirmEMailSuperior -- upsert company supervisor from AvsFirmEMailSuperior
upsertCompanySuperior :: (Maybe CompanyId, AvsFirmInfo) -> Maybe AvsFirmInfo -> DB (Maybe (CompanyId, UserId)) upsertCompanySuperior :: (Maybe CompanyId, AvsFirmInfo) -> Maybe AvsFirmInfo -> DB (Maybe (CompanyId, UserId))
upsertCompanySuperior (mbCid, newAfi) mbOldAfi = runMaybeT $ do upsertCompanySuperior (mbCid, newAfi) mbOldAfi
supemail <- MaybeT . pure $ newAfi ^. _avsFirmEMailSuperior | Just supemail <- newAfi ^. _avsFirmEMailSuperior -- superior given
= runMaybeT $ do
cid <- MaybeT $ altM (pure mbCid) (getAvsCompanyId newAfi) cid <- MaybeT $ altM (pure mbCid) (getAvsCompanyId newAfi)
supid <- MaybeT $ altM (guessUserByEmail $ stripCI supemail) supid <- MaybeT $ altM (guessUserByEmail $ stripCI supemail)
(catchAVShandler True True False Nothing $ Just . entityKey <$> ldapLookupAndUpsert supemail) (catchAVShandler True True False Nothing $ Just . entityKey <$> ldapLookupAndUpsert supemail)
lift $ do lift $ do
let reasonSuperior = Just $ tshow SupervisorReasonAvsSuperior
oldChanges <- runMaybeT $ do -- remove old superior, if any oldChanges <- runMaybeT $ do -- remove old superior, if any
oldAfi <- MaybeT $ pure mbOldAfi oldAfi <- MaybeT $ pure mbOldAfi
oldEml <- MaybeT $ pure $ oldAfi ^. _avsFirmEMailSuperior oldEml <- MaybeT $ pure $ oldAfi ^. _avsFirmEMailSuperior
@ -670,7 +670,7 @@ upsertCompanySuperior (mbCid, newAfi) mbOldAfi = runMaybeT $ do
E.where_ $ newSuper E.^. UserSupervisorSupervisor E.==. E.val supid E.where_ $ newSuper E.^. UserSupervisorSupervisor E.==. E.val supid
E.&&. newSuper E.^. UserSupervisorUser E.==. newSuper E.^. UserSupervisorUser E.&&. newSuper E.^. UserSupervisorUser E.==. newSuper E.^. UserSupervisorUser
) )
deleteWhere [UserSupervisorSupervisor ==. oldSup, UserSupervisorCompany ==. Just cid, UserSupervisorReason ==. reasonSuperior] -- remove un-updateable remainders, if any deleteOldSuperior oldSup cid -- remove un-updateable remainders, if any
return (supChange, oldSup) return (supChange, oldSup)
let supChange = fst <$> oldChanges let supChange = fst <$> oldChanges
oldSup = snd <$> oldChanges oldSup = snd <$> oldChanges
@ -701,13 +701,32 @@ upsertCompanySuperior (mbCid, newAfi) mbOldAfi = runMaybeT $ do
E.<&> E.justVal cid E.<&> E.justVal cid
E.<&> E.val reasonSuperior E.<&> E.val reasonSuperior
) )
(\old new -> (\_old new ->
[ UserSupervisorCompany E.=. E.coalesce [old E.^. UserSupervisorCompany, new E.^. UserSupervisorCompany] [ -- UserSupervisorSupervisor E.=. new E.^. UserSupervisorSupervisor -- this is already given in case of conflict
, UserSupervisorReason E.=. E.coalesce [old E.^. UserSupervisorReason , new E.^. UserSupervisorReason ] UserSupervisorCompany E.=. new E.^. UserSupervisorCompany
, UserSupervisorReason E.=. new E.^. UserSupervisorReason
] ]
) )
reportAdminProblem $ AdminProblemCompanySuperiorChange supid cid oldSup reportAdminProblem $ AdminProblemCompanySuperiorChange supid cid oldSup
return (cid,supid) return (cid,supid)
| Just oldSupeEmail <- mbOldAfi ^? _Just . _avsFirmEMailSuperior . _Just -- no more superior, delete old one
= do
void $ runMaybeT $ do
oldAfi <- MaybeT $ pure mbOldAfi
oldCid <- MaybeT $ getAvsCompanyId oldAfi
oldSup <- MaybeT $ guessUserByEmail $ stripCI oldSupeEmail
lift $ deleteOldSuperior oldSup oldCid
return Nothing
| otherwise -- neither new nor old superior
= return Nothing
where
reasonSuperior = Just $ tshow SupervisorReasonAvsSuperior
deleteOldSuperior oldSup oldCid =
deleteWhere [ UserSupervisorSupervisor ==. oldSup
, UserSupervisorCompany ==. Just oldCid
, UserSupervisorReason ==. reasonSuperior
]
queueAvsUpdateByUID :: (MonoFoldable mono, UserId ~ Element mono) => mono -> Maybe Day -> DB Int64 queueAvsUpdateByUID :: (MonoFoldable mono, UserId ~ Element mono) => mono -> Maybe Day -> DB Int64