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

fix(supervisors): reroute to non-avs supervisors too

Browse Source
This commit is contained in:
Steffen Jost 2023-02-10 12:00:54 +01:00
parent 87e1219ebb
commit 1cc6240354
2 changed files with 23 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -491,23 +491,27 @@ lookupAvsUsers apis = do
-- | Like `Handler.Utils.getReceivers`, but calls upsertAvsUserById on each user to ensure that postal address is up-to-date -- | Like `Handler.Utils.getReceivers`, but calls upsertAvsUserById on each user to ensure that postal address is up-to-date
updateReceivers :: UserId -> Handler (Entity User, [Entity User], Bool) updateReceivers :: UserId -> Handler (Entity User, [Entity User], Bool)
updateReceivers uid = do updateReceivers uid = do
(underling :: Entity User, avsUnderling :: Maybe (Entity UserAvs), avsSupers :: [Entity UserAvs]) <- runDB $ (,,) (underling :: Entity User, avsUnderling :: Maybe (Entity UserAvs), avsSupers :: [(Entity UserSupervisor, Maybe (Entity UserAvs))]) <- runDB $ (,,)
<$> getJustEntity uid <$> getJustEntity uid
<*> getBy (UniqueUserAvsUser uid) <*> getBy (UniqueUserAvsUser uid)
<*> (E.select $ do <*> (E.select $ do
(usrSuper :& usrAvs) <- (usrSuper :& usrAvs) <-
E.from $ E.table @UserSupervisor E.from $ E.table @UserSupervisor
`E.innerJoin` E.table @UserAvs `E.leftJoin` E.table @UserAvs
`E.on` (\(usrSuper :& userAvs) ->usrSuper E.^. UserSupervisorSupervisor E.==. userAvs E.^. UserAvsUser) `E.on` (\(usrSuper :& userAvs) -> usrSuper E.^. UserSupervisorSupervisor E.=?. userAvs E.?. UserAvsUser)
E.where_ $ (usrSuper E.^. UserSupervisorUser E.==. E.val uid) E.where_ $ (usrSuper E.^. UserSupervisorUser E.==. E.val uid)
E.&&. (usrSuper E.^. UserSupervisorRerouteNotifications) E.&&. (usrSuper E.^. UserSupervisorRerouteNotifications)
pure usrAvs pure (usrSuper, usrAvs)
) )
let toUpdate = Set.fromList (userAvsPersonId . entityVal <$> mcons avsUnderling avsSupers) let (superVs, avsIds) = unzip avsSupers
toUpdate = Set.fromList . fmap (userAvsPersonId . entityVal) $ catMaybes (avsUnderling : avsIds)
forM_ toUpdate (void . maybeCatchAll . upsertAvsUserById) -- attempt to update postaddress from AVS receiverIDs :: [UserId] = userSupervisorSupervisor . entityVal <$> superVs
let receiverIDs :: [UserId] = userAvsUser . entityVal <$> avsSupers directResult = return (underling, pure underling, True)
receivers <- runDB (catMaybes <$> mapM getEntity receiverIDs) forM_ toUpdate (void . maybeCatchAll . upsertAvsUserById) -- attempt to update postaddress from AVS
return $ if null receivers if null receiverIDs
then (underling, pure underling, True) then directResult
else (underling, receivers, underling `elem` receivers) else do
receivers <- runDB $ selectList [UserId <-. receiverIDs] [] -- due to possible address updates, we must runDB once more and cannot join above
if null receivers
then directResult
else return (underling, receivers, uid `elem` (entityKey <$> receivers))

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

@ -97,13 +97,14 @@ getReceivers uid = do
underling <- getJustEntity uid underling <- getJustEntity uid
superVs <- selectList [UserSupervisorUser ==. uid, UserSupervisorRerouteNotifications ==. True] [] superVs <- selectList [UserSupervisorUser ==. uid, UserSupervisorRerouteNotifications ==. True] []
let superIds = userSupervisorSupervisor . entityVal <$> superVs let superIds = userSupervisorSupervisor . entityVal <$> superVs
directResult = return (underling, [underling], True)
if null superIds if null superIds
then return (underling, [underling], True) then directResult
else do else do
supers <- selectList [UserId <-. superIds] [] receivers <- selectList [UserId <-. superIds] []
if null supers then return (underling, [underling], True) if null receivers
else then directResult
return (underling, supers, uid `elem` (entityKey <$> supers)) else return (underling, receivers, uid `elem` (entityKey <$> receivers))
computeUserAuthenticationDigest :: AuthenticationMode -> Digest SHA3_256 computeUserAuthenticationDigest :: AuthenticationMode -> Digest SHA3_256