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

chore(avs): WIP keep supervision if company keeps email or address

Browse Source
This commit is contained in:
Steffen Jost 2024-03-20 18:06:45 +01:00
parent 4a51f94a8f
commit 1c5ca24dc5
3 changed files with 47 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -351,8 +351,8 @@ avsQueryCached :: (SomeAvsQuery q, Binary q, Binary (SomeAvsResponse q), Typeabl
, MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m) => q -> m (SomeAvsResponse q)
avsQueryCached qry =
getsYesod (preview $ _appAvsConf . _Just . _avsCacheExpiry) >>= \case
(Just t) | t > 1 -> memcachedBy (Just $ Right t) qry $ avsQueryNoCache qry
_ -> avsQueryNoCache qry
Just t | t > 1 -> memcachedBy (Just $ Right t) qry $ avsQueryNoCache qry
_ -> avsQueryNoCache qry
instance SomeAvsQuery AvsQueryPerson where
type SomeAvsResponse AvsQueryPerson = AvsResponsePerson
@ -497,8 +497,8 @@ updateAvsUserByIds apids = do
CheckAvsUpdate UserDisplayEmail $ _avsFirmPrimaryEmail . to (fromMaybe mempty) . from _CI
eml_up = em_p_up <|> em_f_up -- ensure that only one email update is produced; there is no Eq instance for the Update type
frm_up = mkUpdate usr newAvsFirmInfo oldAvsFirmInfo $ -- Legacy, if company postal is stored in user; should no longer be true for new users,
CheckAvsUpdate UserPostAddress _avsFirmPostAddress -- since company address should now be referenced with UserCompany instead
usr_ups = eml_up `mcons` (frm_up `mcons` per_ups)
CheckAvsUpdate UserPostAddress _avsFirmPostAddress -- since company address should now be referenced with UserCompany instead
usr_up0 = eml_up `mcons` (frm_up `mcons` per_ups)
avs_ups = ((UserAvsNoPerson =.) <$> readMay (avsInfoPersonNo newAvsPersonInfo)) `mcons`
[ UserAvsLastSynch =. now
, UserAvsLastSynchError =. Nothing
@ -507,47 +507,46 @@ updateAvsUserByIds apids = do
]
--
-- TODO: Update UserCompany too
-- TODO #124 Add an old default supervisor to an Admin TODO-List
-- DONE #124 Add an old default supervisor to an Admin TODO-List
-- TODO #76 "sekundäre Firma wählen" -- aktuelle Firmen löschen
-- TODO #36 "company postal preference"
--
lift $ do -- no more maybeT neeed from here
update usrId usr_ups
-- update company association & supervision
oldCompanyMb <- join <$> (getAvsCompany `traverse` oldAvsFirmInfo)
let oldCompanyId = entityKey <$> oldCompanyMb
newCompanyId <- upsertAvsCompany newAvsFirmInfo oldAvsFirmInfo
newCompanyMb <- get newCompanyId
-- TODO: possibly change postal preferences
let _prefPostal = maybe True companyPrefersPostal newCompanyMb
-- _primaryCompanyIdMb <- getUserPrimaryCompany usrId (pure . companyShorthand)
-- possibly add to usr_ups!
-- case (oldAvsFirmInfo, oldCompanyMb, newCompanyMb) of
case oldAvsFirmInfo of
Entity{entityKey=newCompanyId, entityVal=newCompany} <- upsertAvsCompany newAvsFirmInfo oldAvsFirmInfo
oldCompanyEnt <- getAvsCompany `traverseJoin` oldAvsFirmInfo
let oldCompanyId = entityKey <$> oldCompanyEnt
oldCompanyMb = entityVal <$> oldCompanyEnt
pst_up = mkUpdate usr newCompany oldCompanyMb $ CheckAvsUpdate UserPrefersPostal _companyPrefersPostal -- possibly change postal preference TODO: only if needed
superReasonComDef = tshow SupervisorReasonCompanyDefault
usr_ups <- case oldAvsFirmInfo of
_ | oldCompanyId == Just newCompanyId -- company unchanged entirely
-> return ()
-- (Just oafi) | ((==) `on` view _avsFirmPostAddressSimple) oafi newAvsFirmInfo -- company address unchanged
-- -> return ()
-- (Just oafi) | ((==) `on` view _avsFirmPrimaryEmail) oafi newAvsFirmInfo -- company primary email unchanged
-- -> return ()
-> return usr_up0 -- => do nothing
(Just oafi) | ((==) `on` view _avsFirmPostAddressSimple) oafi newAvsFirmInfo -- company address unchanged OR
|| ((==) `on` view _avsFirmPrimaryEmail) oafi newAvsFirmInfo -- company primary email unchanged
-> do -- => just update user company association, keeping supervision privileges
void $ upsertBy (UniqueUserCompany usrId newCompanyId)
(UserCompany usrId newCompanyId False False 1 True)
[UserCompanyCompany =. newCompanyId]
whenIsJust oldCompanyId $ \ocid ->
updateWhere [UserSupervisorSupervisor ==. usrId, UserSupervisorCompany ==. Just ocid, UserSupervisorReason ==. Just superReasonComDef]
[UserSupervisorCompany =. Just newCompanyId]
return usr_up0
_ -- company changed completely
-> do -- switch company
(join <$> ((getBy . UniqueUserCompany usrId) `traverse` oldCompanyId)) >>= (\case
Nothing -> do
void $ insertUnique $ UserCompany usrId newCompanyId False False 1 True
(Just Entity{entityKey=ucidOld, entityVal=UserCompany{userCompanyCompany, userCompanySupervisor, userCompanySupervisorReroute, userCompanyPriority}}) -> do
when userCompanySupervisor $ reportAdminProblem $ AdminProblemSupervisorNewCompany usrId userCompanyCompany newCompanyId userCompanySupervisorReroute
delete ucidOld
void $ insertUnique $ UserCompany usrId newCompanyId False False userCompanyPriority True
)
(getBy . UniqueUserCompany usrId) `traverseJoin` oldCompanyId >>= \case
Nothing -> do
void $ insertUnique $ UserCompany usrId newCompanyId False False 1 True
Just Entity{entityKey=ucidOld, entityVal=UserCompany{userCompanyCompany, userCompanySupervisor, userCompanySupervisorReroute, userCompanyPriority}} -> do
when userCompanySupervisor $ reportAdminProblem $ AdminProblemSupervisorNewCompany usrId userCompanyCompany newCompanyId userCompanySupervisorReroute
delete ucidOld
void $ insertUnique $ UserCompany usrId newCompanyId False False userCompanyPriority True
-- forMM_ (get newCompanyId) $ \Company{} ->
-- void $ upsertBy (UniqueUserCompany usrId newCompanyId) (UserCompany usrId newCompanyId False False 0 True) [error "continue here"] -- TODO: better defaults
let superReasonComDef = tshow SupervisorReasonCompanyDefault
superCompanyFilter = maybe [UserSupervisorCompany ==. Nothing] (UserSupervisorCompany ~=.)
let superCompanyFilter = maybe [UserSupervisorCompany ==. Nothing] (UserSupervisorCompany ~=.)
_oldAPs <- deleteWhereCount $ (UserSupervisorUser ==. usrId) : mconcat [superCompanyFilter oldCompanyId, UserSupervisorReason ~=. superReasonComDef]
E.insertSelectWithConflict
UniqueUserSupervisor
@ -570,7 +569,7 @@ updateAvsUserByIds apids = do
_newAPs <- count $ (UserSupervisorUser ==. usrId) : mconcat [UserSupervisorCompany ~=. newCompanyId, UserSupervisorReason ~=. superReasonComDef]
-- when (oldAPs > 0 && newAPs <= 0) $ -- TODO: notify admins
-- TODO continue here
return ()
return $ pst_up `mcons` usr_up0
-- ensure firmInfo superior is at least normal supervisor, must be executed after updating company default supervisors
whenIsJust (newAvsFirmInfo ^. _avsFirmEMailSuperior) $ \supemail -> forMM_
(altM (guessUserByEmail $ supemail ^. from _CI)
@ -580,6 +579,7 @@ updateAvsUserByIds apids = do
deleteWhere [UserSupervisorUser ==.usrId, UserSupervisorSupervisor !=. supid, UserSupervisorReason ==. reasonSuperior]
void $ insertUnique $ UserSupervisor supid usrId False (Just newCompanyId) reasonSuperior
-- update stored avsinfo
update usrId usr_ups
update uaId avs_ups
return $ Set.singleton (apid, usrId)
@ -598,7 +598,8 @@ getAvsCompany afi =
, getBy $ UniqueCompanyName compName
]
upsertAvsCompany :: AvsFirmInfo -> Maybe AvsFirmInfo -> DB CompanyId
-- | insert a company from AVS firm info or update an existing one based on previous values
upsertAvsCompany :: AvsFirmInfo -> Maybe AvsFirmInfo -> DB (Entity Company)
upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
mbFirmEnt <- getAvsCompany newAvsFirmInfo
case (mbFirmEnt, mbOldAvsFirmInfo) of
@ -612,14 +613,14 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
, companyPostAddress = newAvsFirmInfo ^. _avsFirmPostAddress
, companyEmail = newAvsFirmInfo ^. _avsFirmPrimaryEmail . _Just . from _CI . re _Just
}
newId <- insert $ foldl' upd dmy firmInfo2company
reportAdminProblem $ AdminProblemNewCompany newId
return newId
newCmp <- insertEntity $ foldl' upd dmy firmInfo2company
reportAdminProblem $ AdminProblemNewCompany $ entityKey newCmp
return newCmp
(Just Entity{entityKey=firmid, entityVal=firm}, oldAvsFirmInfo) -> do -- possibly update existing company, if isJust oldAvsFirmInfo and changed occurred
let cmp_ups = mapMaybe (mkUpdate firm newAvsFirmInfo oldAvsFirmInfo) firmInfo2company
update firmid cmp_ups
return firmid
Entity firmid <$> updateGet firmid cmp_ups
where
firmInfo2company =
[ CheckAvsUpdate CompanyName $ _avsFirmFirm . from _CI

3
src/Utils.hs
View File

@ -946,6 +946,9 @@ positiveSum = maybePositive . getSum
maybeM :: Monad m => m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM dft act mb = mb >>= maybe dft act
traverseJoin :: (Applicative m, Traversable maybe, Monad maybe) => (a -> m (maybe b)) -> maybe a -> m (maybe b)
traverseJoin f x = join <$> (f `traverse` x)
maybeT :: Monad m => m a -> MaybeT m a -> m a
maybeT x m = runMaybeT m >>= maybe x return

4
src/Utils/Persist.hs
View File

@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>, Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
@ -41,6 +41,6 @@ fromPersistValueErrorSql _ = fromPersistValueError (tshow $ typeRep @a) (tshow $
infix 4 ~=.
-- | is Equal or Nothing
-- | is Equal or Nothing, do not confuse with Database.Esqueleto.Utils(~=.) which does the same for proper Esqueleto queries
(~=.) :: PersistField a => EntityField v (Maybe a) -> a -> [Filter v]
(~=.) f v = [f ==. Just v] ||. [f ==. Nothing]