diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index ad47f7cdc..64abd304d 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -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 updateReceivers :: UserId -> Handler (Entity User, [Entity User], Bool) 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 <*> getBy (UniqueUserAvsUser uid) <*> (E.select $ do (usrSuper :& usrAvs) <- - E.from $ E.table @UserSupervisor - `E.innerJoin` E.table @UserAvs - `E.on` (\(usrSuper :& userAvs) ->usrSuper E.^. UserSupervisorSupervisor E.==. userAvs E.^. UserAvsUser) + E.from $ E.table @UserSupervisor + `E.leftJoin` E.table @UserAvs + `E.on` (\(usrSuper :& userAvs) -> usrSuper E.^. UserSupervisorSupervisor E.=?. userAvs E.?. UserAvsUser) E.where_ $ (usrSuper E.^. UserSupervisorUser E.==. E.val uid) E.&&. (usrSuper E.^. UserSupervisorRerouteNotifications) - pure usrAvs + pure (usrSuper, usrAvs) ) - let toUpdate = Set.fromList (userAvsPersonId . entityVal <$> mcons avsUnderling avsSupers) - - forM_ toUpdate (void . maybeCatchAll . upsertAvsUserById) -- attempt to update postaddress from AVS - let receiverIDs :: [UserId] = userAvsUser . entityVal <$> avsSupers - receivers <- runDB (catMaybes <$> mapM getEntity receiverIDs) - return $ if null receivers - then (underling, pure underling, True) - else (underling, receivers, underling `elem` receivers) + let (superVs, avsIds) = unzip avsSupers + toUpdate = Set.fromList . fmap (userAvsPersonId . entityVal) $ catMaybes (avsUnderling : avsIds) + receiverIDs :: [UserId] = userSupervisorSupervisor . entityVal <$> superVs + directResult = return (underling, pure underling, True) + forM_ toUpdate (void . maybeCatchAll . upsertAvsUserById) -- attempt to update postaddress from AVS + if null receiverIDs + then directResult + 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)) diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index 9db8c737d..9c89b992b 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -97,13 +97,14 @@ getReceivers uid = do underling <- getJustEntity uid superVs <- selectList [UserSupervisorUser ==. uid, UserSupervisorRerouteNotifications ==. True] [] let superIds = userSupervisorSupervisor . entityVal <$> superVs + directResult = return (underling, [underling], True) if null superIds - then return (underling, [underling], True) + then directResult else do - supers <- selectList [UserId <-. superIds] [] - if null supers then return (underling, [underling], True) - else - return (underling, supers, uid `elem` (entityKey <$> supers)) + receivers <- selectList [UserId <-. superIds] [] + if null receivers + then directResult + else return (underling, receivers, uid `elem` (entityKey <$> receivers)) computeUserAuthenticationDigest :: AuthenticationMode -> Digest SHA3_256