forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Support sharer-hosted tickets in AP local dispatch and delivery

Browse source
This commit is contained in:
fr33domlover 2020-04-09 17:39:36 +00:00
parent ef4a8f4015
commit 90bac5c34e
3 changed files with 122 additions and 66 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
src/Vervis/API.hs
View file

@ -293,8 +293,8 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
_ -> throwE "Local context isn't a ticket route" _ -> throwE "Local context isn't a ticket route"
atMostSharer :: e -> (ShrIdent, LocalSharerRelatedSet) -> ExceptT e Handler (Maybe ShrIdent) atMostSharer :: e -> (ShrIdent, LocalSharerRelatedSet) -> ExceptT e Handler (Maybe ShrIdent)
atMostSharer _ (shr, LocalSharerRelatedSet s [] []) = return $ if localRecipSharer s then Just shr else Nothing atMostSharer _ (shr, LocalSharerRelatedSet s [] [] []) = return $ if localRecipSharer s then Just shr else Nothing
atMostSharer e (_ , LocalSharerRelatedSet _ _ _ ) = throwE e atMostSharer e (_ , LocalSharerRelatedSet _ _ _ _ ) = throwE e
verifyTicketRecipients :: (ShrIdent, PrjIdent, KeyHashid LocalTicket) -> LocalRecipientSet -> ExceptT Text Handler [ShrIdent] verifyTicketRecipients :: (ShrIdent, PrjIdent, KeyHashid LocalTicket) -> LocalRecipientSet -> ExceptT Text Handler [ShrIdent]
verifyTicketRecipients (shr, prj, num) recips = do verifyTicketRecipients (shr, prj, num) recips = do
@ -303,7 +303,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
unless (prj == prj') $ throwE "Note project recipients mismatch context's project" unless (prj == prj') $ throwE "Note project recipients mismatch context's project"
unless (localRecipProject $ localRecipProjectDirect lprSet) $ throwE "Note context's project not addressed" unless (localRecipProject $ localRecipProjectDirect lprSet) $ throwE "Note context's project not addressed"
unless (localRecipProjectFollowers $ localRecipProjectDirect lprSet) $ throwE "Note context's project followers not addressed" unless (localRecipProjectFollowers $ localRecipProjectDirect lprSet) $ throwE "Note context's project followers not addressed"
(num', ltrSet) <- verifySingleton (localRecipTicketRelated lprSet) "Note ticket-related recipient sets" (num', ltrSet) <- verifySingleton (localRecipProjectTicketRelated lprSet) "Note ticket-related recipient sets"
unless (num == num') $ throwE "Note project recipients mismatch context's ticket number" unless (num == num') $ throwE "Note project recipients mismatch context's ticket number"
unless (localRecipTicketTeam ltrSet) $ unless (localRecipTicketTeam ltrSet) $
throwE "Note ticket team not addressed" throwE "Note ticket team not addressed"
@ -973,7 +973,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
, LocalProjectRelatedSet , LocalProjectRelatedSet
{ localRecipProjectDirect = { localRecipProjectDirect =
LocalProjectDirectSet True True True LocalProjectDirectSet True True True
, localRecipTicketRelated = [] , localRecipProjectTicketRelated = []
} }
) )
] ]
@ -1006,7 +1006,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc] update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc]
return (obiid, doc, luAct) return (obiid, doc, luAct)
deliverLocal pidAuthor shrProject prjProject now mprojAndDeps obiid luOffer recips = do deliverLocal pidAuthor shrProject prjProject now mprojAndDeps obiid luOffer recips = do
(pids, remotes) <- forCollect recips $ \ (shr, LocalSharerRelatedSet sharer projects _) -> do (pids, remotes) <- forCollect recips $ \ (shr, LocalSharerRelatedSet sharer _ projects _) -> do
(pids, remotes) <- (pids, remotes) <-
traverseCollect (uncurry $ deliverLocalProject shr) projects traverseCollect (uncurry $ deliverLocalProject shr) projects
pids' <- do pids' <- do

46
src/Vervis/ActivityPub.hs
View file

@ -719,7 +719,7 @@ deliverLocal
] ]
deliverLocal shrAuthor ibidAuthor _fsidAuthor obiid = deliverLocal' True (LocalActorSharer shrAuthor) ibidAuthor obiid . localRecipSieve sieve True deliverLocal shrAuthor ibidAuthor _fsidAuthor obiid = deliverLocal' True (LocalActorSharer shrAuthor) ibidAuthor obiid . localRecipSieve sieve True
where where
sieve = [(shrAuthor, LocalSharerRelatedSet (LocalSharerDirectSet False True) [] [])] sieve = [(shrAuthor, LocalSharerRelatedSet (LocalSharerDirectSet False True) [] [] [])]
data RemoteRecipient = RemoteRecipient data RemoteRecipient = RemoteRecipient
{ remoteRecipientActor :: RemoteActorId { remoteRecipientActor :: RemoteActorId
@ -770,7 +770,7 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
map (personInbox . entityVal) <$> selectList [PersonIdent <-. sids] [Asc PersonInbox] map (personInbox . entityVal) <$> selectList [PersonIdent <-. sids] [Asc PersonInbox]
getOtherInboxes :: (ShrIdent, LocalSharerRelatedSet) -> AppDB [InboxId] getOtherInboxes :: (ShrIdent, LocalSharerRelatedSet) -> AppDB [InboxId]
getOtherInboxes (shr, LocalSharerRelatedSet _ projects repos) = do getOtherInboxes (shr, LocalSharerRelatedSet _ _ projects repos) = do
msid <- getKeyBy $ UniqueSharer shr msid <- getKeyBy $ UniqueSharer shr
case msid of case msid of
Nothing -> return [] Nothing -> return []
@ -806,15 +806,32 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
map (personFollowers . entityVal) <$> selectList [PersonIdent <-. sids] [] map (personFollowers . entityVal) <$> selectList [PersonIdent <-. sids] []
getOtherFollowerSets :: (ShrIdent, LocalSharerRelatedSet) -> AppDB [FollowerSetId] getOtherFollowerSets :: (ShrIdent, LocalSharerRelatedSet) -> AppDB [FollowerSetId]
getOtherFollowerSets (shr, LocalSharerRelatedSet _ projects repos) = do getOtherFollowerSets (shr, LocalSharerRelatedSet _ tickets projects repos) = do
msid <- getKeyBy $ UniqueSharer shr msid <- getKeyBy $ UniqueSharer shr
case msid of case msid of
Nothing -> return [] Nothing -> return []
Just sid -> Just sid -> do
(++) mpid <- getKeyBy $ UniquePersonIdent sid
<$> getProjectFollowerSets sid projects (\ t j r -> map E.unValue t ++ j ++ r)
<$> case mpid of
Nothing -> pure []
Just pid -> getSharerTicketFollowerSets pid tickets
<*> getProjectFollowerSets sid projects
<*> getRepoFollowerSets sid repos <*> getRepoFollowerSets sid repos
where where
getSharerTicketFollowerSets pid tickets = do
let talkhids =
[talkhid | (talkhid, t) <- tickets
, localRecipTicketFollowers t
]
talids <- catMaybes <$> traverse decodeKeyHashid talkhids
E.select $ E.from $ \ (tal `E.InnerJoin` lt `E.LeftOuterJoin` tup) -> do
E.on $ E.just (tal E.^. TicketAuthorLocalId) E.==. tup E.?. TicketUnderProjectAuthor
E.on $ tal E.^. TicketAuthorLocalTicket E.==. lt E.^. LocalTicketId
E.where_ $
tal E.^. TicketAuthorLocalAuthor E.==. E.val pid E.&&.
E.isNothing (tup E.?. TicketUnderProjectId)
return $ lt E.^. LocalTicketFollowers
getProjectFollowerSets sid projects = do getProjectFollowerSets sid projects = do
let prjsJ = let prjsJ =
[prj | (prj, j) <- projects [prj | (prj, j) <- projects
@ -828,12 +845,12 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
let prjsT = let prjsT =
if requireOwner if requireOwner
then then
[ (prj, localRecipTicketRelated j) [ (prj, localRecipProjectTicketRelated j)
| (prj, j) <- projects | (prj, j) <- projects
, localRecipProject (localRecipProjectDirect j) || LocalActorProject shr prj == author , localRecipProject (localRecipProjectDirect j) || LocalActorProject shr prj == author
] ]
else else
map (second localRecipTicketRelated) projects map (second localRecipProjectTicketRelated) projects
fsidssT <- for prjsT $ \ (prj, tickets) -> do fsidssT <- for prjsT $ \ (prj, tickets) -> do
mjid <- getKeyBy $ UniqueProject prj sid mjid <- getKeyBy $ UniqueProject prj sid
case mjid of case mjid of
@ -900,15 +917,20 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
toTuples (E.Value iid, E.Value h, E.Value raid, E.Value luA, E.Value luI, E.Value ms) = ((iid, h), RemoteRecipient raid luA luI ms) toTuples (E.Value iid, E.Value h, E.Value raid, E.Value luA, E.Value luI, E.Value ms) = ((iid, h), RemoteRecipient raid luA luI ms)
getTeams :: (ShrIdent, LocalSharerRelatedSet) -> AppDB [InboxId] getTeams :: (ShrIdent, LocalSharerRelatedSet) -> AppDB [InboxId]
getTeams (shr, LocalSharerRelatedSet _ projects repos) = do getTeams (shr, LocalSharerRelatedSet _ tickets projects repos) = do
msid <- getKeyBy $ UniqueSharer shr msid <- getKeyBy $ UniqueSharer shr
case msid of case msid of
Nothing -> return [] Nothing -> return []
Just sid -> Just sid -> do
LO.union mpid <- getKeyBy $ UniquePersonIdent sid
<$> getProjectTeams sid projects (\ t j r -> t `LO.union` j `LO.union` r)
<$> case mpid of
Nothing -> pure []
Just pid -> getSharerTicketTeams pid tickets
<*> getProjectTeams sid projects
<*> getRepoTeams sid repos <*> getRepoTeams sid repos
where where
getSharerTicketTeams _pid _tickets = pure []
getProjectTeams sid projects = do getProjectTeams sid projects = do
let prjs = let prjs =
[prj | (prj, LocalProjectRelatedSet d ts) <- projects [prj | (prj, LocalProjectRelatedSet d ts) <- projects

108
src/Vervis/ActivityPub/Recipient.hs
View file

@ -97,10 +97,14 @@ renderLocalActor (LocalActorRepo shr rp) = RepoR shr rp
data LocalPersonCollection data LocalPersonCollection
= LocalPersonCollectionSharerFollowers ShrIdent = LocalPersonCollectionSharerFollowers ShrIdent
| LocalPersonCollectionSharerTicketTeam ShrIdent (KeyHashid TicketAuthorLocal)
| LocalPersonCollectionSharerTicketFollowers ShrIdent (KeyHashid TicketAuthorLocal)
| LocalPersonCollectionProjectTeam ShrIdent PrjIdent | LocalPersonCollectionProjectTeam ShrIdent PrjIdent
| LocalPersonCollectionProjectFollowers ShrIdent PrjIdent | LocalPersonCollectionProjectFollowers ShrIdent PrjIdent
| LocalPersonCollectionTicketTeam ShrIdent PrjIdent (KeyHashid LocalTicket) | LocalPersonCollectionProjectTicketTeam ShrIdent PrjIdent (KeyHashid LocalTicket)
| LocalPersonCollectionTicketFollowers ShrIdent PrjIdent (KeyHashid LocalTicket) | LocalPersonCollectionProjectTicketFollowers ShrIdent PrjIdent (KeyHashid LocalTicket)
| LocalPersonCollectionRepoTeam ShrIdent RpIdent | LocalPersonCollectionRepoTeam ShrIdent RpIdent
| LocalPersonCollectionRepoFollowers ShrIdent RpIdent | LocalPersonCollectionRepoFollowers ShrIdent RpIdent
deriving Eq deriving Eq
@ -109,14 +113,18 @@ parseLocalPersonCollection
:: Route App -> Maybe LocalPersonCollection :: Route App -> Maybe LocalPersonCollection
parseLocalPersonCollection (SharerFollowersR shr) = parseLocalPersonCollection (SharerFollowersR shr) =
Just $ LocalPersonCollectionSharerFollowers shr Just $ LocalPersonCollectionSharerFollowers shr
parseLocalPersonCollection (SharerTicketTeamR shr talkhid) =
Just $ LocalPersonCollectionSharerTicketTeam shr talkhid
parseLocalPersonCollection (SharerTicketFollowersR shr talkhid) =
Just $ LocalPersonCollectionSharerTicketFollowers shr talkhid
parseLocalPersonCollection (ProjectTeamR shr prj) = parseLocalPersonCollection (ProjectTeamR shr prj) =
Just $ LocalPersonCollectionProjectTeam shr prj Just $ LocalPersonCollectionProjectTeam shr prj
parseLocalPersonCollection (ProjectFollowersR shr prj) = parseLocalPersonCollection (ProjectFollowersR shr prj) =
Just $ LocalPersonCollectionProjectFollowers shr prj Just $ LocalPersonCollectionProjectFollowers shr prj
parseLocalPersonCollection (ProjectTicketTeamR shr prj num) = parseLocalPersonCollection (ProjectTicketTeamR shr prj num) =
Just $ LocalPersonCollectionTicketTeam shr prj num Just $ LocalPersonCollectionProjectTicketTeam shr prj num
parseLocalPersonCollection (ProjectTicketParticipantsR shr prj num) = parseLocalPersonCollection (ProjectTicketParticipantsR shr prj num) =
Just $ LocalPersonCollectionTicketFollowers shr prj num Just $ LocalPersonCollectionProjectTicketFollowers shr prj num
parseLocalPersonCollection (RepoTeamR shr rp) = parseLocalPersonCollection (RepoTeamR shr rp) =
Just $ LocalPersonCollectionRepoTeam shr rp Just $ LocalPersonCollectionRepoTeam shr rp
parseLocalPersonCollection (RepoFollowersR shr rp) = parseLocalPersonCollection (RepoFollowersR shr rp) =
@ -125,10 +133,12 @@ parseLocalPersonCollection _ = Nothing
renderLocalPersonCollection :: LocalPersonCollection -> Route App renderLocalPersonCollection :: LocalPersonCollection -> Route App
renderLocalPersonCollection (LocalPersonCollectionSharerFollowers shr) = SharerFollowersR shr renderLocalPersonCollection (LocalPersonCollectionSharerFollowers shr) = SharerFollowersR shr
renderLocalPersonCollection (LocalPersonCollectionSharerTicketTeam shr talkhid) = SharerTicketTeamR shr talkhid
renderLocalPersonCollection (LocalPersonCollectionSharerTicketFollowers shr talkhid) = SharerTicketFollowersR shr talkhid
renderLocalPersonCollection (LocalPersonCollectionProjectTeam shr prj) = ProjectTeamR shr prj renderLocalPersonCollection (LocalPersonCollectionProjectTeam shr prj) = ProjectTeamR shr prj
renderLocalPersonCollection (LocalPersonCollectionProjectFollowers shr prj) = ProjectFollowersR shr prj renderLocalPersonCollection (LocalPersonCollectionProjectFollowers shr prj) = ProjectFollowersR shr prj
renderLocalPersonCollection (LocalPersonCollectionTicketTeam shr prj ltkhid) = ProjectTicketTeamR shr prj ltkhid renderLocalPersonCollection (LocalPersonCollectionProjectTicketTeam shr prj ltkhid) = ProjectTicketTeamR shr prj ltkhid
renderLocalPersonCollection (LocalPersonCollectionTicketFollowers shr prj ltkhid) = ProjectTicketParticipantsR shr prj ltkhid renderLocalPersonCollection (LocalPersonCollectionProjectTicketFollowers shr prj ltkhid) = ProjectTicketParticipantsR shr prj ltkhid
renderLocalPersonCollection (LocalPersonCollectionRepoTeam shr rp) = RepoTeamR shr rp renderLocalPersonCollection (LocalPersonCollectionRepoTeam shr rp) = RepoTeamR shr rp
renderLocalPersonCollection (LocalPersonCollectionRepoFollowers shr rp) = RepoFollowersR shr rp renderLocalPersonCollection (LocalPersonCollectionRepoFollowers shr rp) = RepoFollowersR shr rp
@ -156,7 +166,7 @@ data LocalProjectRecipientDirect
data LocalProjectRecipient data LocalProjectRecipient
= LocalProjectDirect LocalProjectRecipientDirect = LocalProjectDirect LocalProjectRecipientDirect
| LocalTicketRelated (KeyHashid LocalTicket) LocalTicketRecipientDirect | LocalProjectTicketRelated (KeyHashid LocalTicket) LocalTicketRecipientDirect
deriving (Eq, Ord) deriving (Eq, Ord)
data LocalRepoRecipientDirect data LocalRepoRecipientDirect
@ -175,6 +185,7 @@ data LocalSharerRecipientDirect
data LocalSharerRecipient data LocalSharerRecipient
= LocalSharerDirect LocalSharerRecipientDirect = LocalSharerDirect LocalSharerRecipientDirect
| LocalSharerTicketRelated (KeyHashid TicketAuthorLocal) LocalTicketRecipientDirect
| LocalProjectRelated PrjIdent LocalProjectRecipient | LocalProjectRelated PrjIdent LocalProjectRecipient
| LocalRepoRelated RpIdent LocalRepoRecipient | LocalRepoRelated RpIdent LocalRepoRecipient
deriving (Eq, Ord) deriving (Eq, Ord)
@ -196,6 +207,14 @@ groupedRecipientFromCollection
groupedRecipientFromCollection groupedRecipientFromCollection
(LocalPersonCollectionSharerFollowers shr) = (LocalPersonCollectionSharerFollowers shr) =
LocalSharerRelated shr $ LocalSharerDirect LocalSharerFollowers LocalSharerRelated shr $ LocalSharerDirect LocalSharerFollowers
groupedRecipientFromCollection
(LocalPersonCollectionSharerTicketTeam shr talkhid) =
LocalSharerRelated shr $
LocalSharerTicketRelated talkhid LocalTicketTeam
groupedRecipientFromCollection
(LocalPersonCollectionSharerTicketFollowers shr talkhid) =
LocalSharerRelated shr $
LocalSharerTicketRelated talkhid LocalTicketFollowerz
groupedRecipientFromCollection groupedRecipientFromCollection
(LocalPersonCollectionProjectTeam shr prj) = (LocalPersonCollectionProjectTeam shr prj) =
LocalSharerRelated shr $ LocalProjectRelated prj $ LocalSharerRelated shr $ LocalProjectRelated prj $
@ -205,13 +224,13 @@ groupedRecipientFromCollection
LocalSharerRelated shr $ LocalProjectRelated prj $ LocalSharerRelated shr $ LocalProjectRelated prj $
LocalProjectDirect LocalProjectFollowers LocalProjectDirect LocalProjectFollowers
groupedRecipientFromCollection groupedRecipientFromCollection
(LocalPersonCollectionTicketTeam shr prj num) = (LocalPersonCollectionProjectTicketTeam shr prj num) =
LocalSharerRelated shr $ LocalProjectRelated prj $ LocalSharerRelated shr $ LocalProjectRelated prj $
LocalTicketRelated num LocalTicketTeam LocalProjectTicketRelated num LocalTicketTeam
groupedRecipientFromCollection groupedRecipientFromCollection
(LocalPersonCollectionTicketFollowers shr prj num) = (LocalPersonCollectionProjectTicketFollowers shr prj num) =
LocalSharerRelated shr $ LocalProjectRelated prj $ LocalSharerRelated shr $ LocalProjectRelated prj $
LocalTicketRelated num LocalTicketFollowerz LocalProjectTicketRelated num LocalTicketFollowerz
groupedRecipientFromCollection groupedRecipientFromCollection
(LocalPersonCollectionRepoTeam shr rp) = (LocalPersonCollectionRepoTeam shr rp) =
LocalSharerRelated shr $ LocalRepoRelated rp $ LocalSharerRelated shr $ LocalRepoRelated rp $
@ -244,8 +263,10 @@ data LocalProjectDirectSet = LocalProjectDirectSet
deriving Eq deriving Eq
data LocalProjectRelatedSet = LocalProjectRelatedSet data LocalProjectRelatedSet = LocalProjectRelatedSet
{ localRecipProjectDirect :: LocalProjectDirectSet { localRecipProjectDirect
, localRecipTicketRelated :: [(KeyHashid LocalTicket, LocalTicketDirectSet)] :: LocalProjectDirectSet
, localRecipProjectTicketRelated
:: [(KeyHashid LocalTicket, LocalTicketDirectSet)]
} }
deriving Eq deriving Eq
@ -268,9 +289,14 @@ data LocalSharerDirectSet = LocalSharerDirectSet
deriving Eq deriving Eq
data LocalSharerRelatedSet = LocalSharerRelatedSet data LocalSharerRelatedSet = LocalSharerRelatedSet
{ localRecipSharerDirect :: LocalSharerDirectSet { localRecipSharerDirect
, localRecipProjectRelated :: [(PrjIdent, LocalProjectRelatedSet)] :: LocalSharerDirectSet
, localRecipRepoRelated :: [(RpIdent, LocalRepoRelatedSet)] , localRecipSharerTicketRelated
:: [(KeyHashid TicketAuthorLocal, LocalTicketDirectSet)]
, localRecipProjectRelated
:: [(PrjIdent, LocalProjectRelatedSet)]
, localRecipRepoRelated
:: [(RpIdent, LocalRepoRelatedSet)]
} }
deriving Eq deriving Eq
@ -283,14 +309,16 @@ groupLocalRecipients
(\ (LocalSharerRelated shr _) -> shr) (\ (LocalSharerRelated shr _) -> shr)
(\ (LocalSharerRelated _ lsr) -> lsr) (\ (LocalSharerRelated _ lsr) -> lsr)
where where
lsr2set = mk . partitionEithers3 . map lsr2e . NE.toList lsr2set = mk . partitionEithers4 . map lsr2e . NE.toList
where where
lsr2e (LocalSharerDirect d) = Left d lsr2e (LocalSharerDirect d) = Left $ Left d
lsr2e (LocalSharerTicketRelated talkhid ltr) = Left $ Right (talkhid, ltr)
lsr2e (LocalProjectRelated prj lpr) = Right $ Left (prj, lpr) lsr2e (LocalProjectRelated prj lpr) = Right $ Left (prj, lpr)
lsr2e (LocalRepoRelated rp lrr) = Right $ Right (rp, lrr) lsr2e (LocalRepoRelated rp lrr) = Right $ Right (rp, lrr)
mk (ds, ps, rs) = mk (ds, ts, ps, rs) =
LocalSharerRelatedSet LocalSharerRelatedSet
(lsrs2set ds) (lsrs2set ds)
(map (second ltrs2set) $ groupWithExtract fst snd ts)
(map (second lpr2set) $ groupWithExtract fst snd ps) (map (second lpr2set) $ groupWithExtract fst snd ps)
(map (second lrr2set) $ groupWithExtract fst snd rs) (map (second lrr2set) $ groupWithExtract fst snd rs)
where where
@ -301,10 +329,17 @@ groupLocalRecipients
s { localRecipSharer = True } s { localRecipSharer = True }
f s LocalSharerFollowers = f s LocalSharerFollowers =
s { localRecipSharerFollowers = True } s { localRecipSharerFollowers = True }
ltrs2set = foldl' f initial
where
initial = LocalTicketDirectSet False False
f s LocalTicketTeam =
s { localRecipTicketTeam = True }
f s LocalTicketFollowerz =
s { localRecipTicketFollowers = True }
lpr2set = uncurry mk . partitionEithers . map lpr2e . NE.toList lpr2set = uncurry mk . partitionEithers . map lpr2e . NE.toList
where where
lpr2e (LocalProjectDirect d) = Left d lpr2e (LocalProjectDirect d) = Left d
lpr2e (LocalTicketRelated num ltrs) = Right (num, ltrs) lpr2e (LocalProjectTicketRelated num ltrs) = Right (num, ltrs)
mk ds ts = mk ds ts =
LocalProjectRelatedSet LocalProjectRelatedSet
(lprs2set ds) (lprs2set ds)
@ -319,13 +354,6 @@ groupLocalRecipients
s { localRecipProjectTeam = True } s { localRecipProjectTeam = True }
f s LocalProjectFollowers = f s LocalProjectFollowers =
s { localRecipProjectFollowers = True } s { localRecipProjectFollowers = True }
ltrs2set = foldl' f initial
where
initial = LocalTicketDirectSet False False
f s LocalTicketTeam =
s { localRecipTicketTeam = True }
f s LocalTicketFollowerz =
s { localRecipTicketFollowers = True }
lrr2set = LocalRepoRelatedSet . foldl' f initial . NE.map unwrap lrr2set = LocalRepoRelatedSet . foldl' f initial . NE.map unwrap
where where
unwrap (LocalRepoDirect d) = d unwrap (LocalRepoDirect d) = d
@ -333,15 +361,16 @@ groupLocalRecipients
f s LocalRepo = s { localRecipRepo = True } f s LocalRepo = s { localRecipRepo = True }
f s LocalRepoTeam = s { localRecipRepoTeam = True } f s LocalRepoTeam = s { localRecipRepoTeam = True }
f s LocalRepoFollowers = s { localRecipRepoFollowers = True } f s LocalRepoFollowers = s { localRecipRepoFollowers = True }
partitionEithers3 = adapt . second partitionEithers . partitionEithers partitionEithers4 = adapt . bimap partitionEithers partitionEithers . partitionEithers
where where
adapt (l1, (l2, l3)) = (l1, l2, l3) adapt ((l1, l2), (l3, l4)) = (l1, l2, l3, l4)
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- Parse URIs into a grouped recipient set -- Parse URIs into a grouped recipient set
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
makeRecipientSet :: [LocalActor] -> [LocalPersonCollection] -> LocalRecipientSet makeRecipientSet
:: [LocalActor] -> [LocalPersonCollection] -> LocalRecipientSet
makeRecipientSet actors collections = makeRecipientSet actors collections =
groupLocalRecipients $ groupLocalRecipients $
map groupedRecipientFromActor actors ++ map groupedRecipientFromActor actors ++
@ -431,9 +460,10 @@ localRecipSieve sieve allowActors =
LocalProjectRelatedSet (LocalProjectDirectSet j False False) [] LocalProjectRelatedSet (LocalProjectDirectSet j False False) []
onlyActorsR (LocalRepoRelatedSet (LocalRepoDirectSet r _t _f)) = onlyActorsR (LocalRepoRelatedSet (LocalRepoDirectSet r _t _f)) =
LocalRepoRelatedSet $ LocalRepoDirectSet r False False LocalRepoRelatedSet $ LocalRepoDirectSet r False False
onlyActorsS (LocalSharerRelatedSet (LocalSharerDirectSet s _f) js rs) = onlyActorsS (LocalSharerRelatedSet (LocalSharerDirectSet s _f) _ts js rs) =
LocalSharerRelatedSet LocalSharerRelatedSet
(LocalSharerDirectSet s False) (LocalSharerDirectSet s False)
[]
(map (second onlyActorsJ) js) (map (second onlyActorsJ) js)
(map (second onlyActorsR) rs) (map (second onlyActorsR) rs)
@ -442,17 +472,25 @@ localRecipSieve sieve allowActors =
if allowActors if allowActors
then Just (shr, onlyActorsS s) then Just (shr, onlyActorsS s)
else Nothing else Nothing
applySharerRelated shr (These (LocalSharerRelatedSet s' j' r') (LocalSharerRelatedSet s j r)) = applySharerRelated shr (These (LocalSharerRelatedSet s' t' j' r') (LocalSharerRelatedSet s t j r)) =
Just Just
( shr ( shr
, LocalSharerRelatedSet , LocalSharerRelatedSet
(applySharer s' s) (applySharer s' s)
(mapMaybe (uncurry applyTicketRelated) $ sortAlign t' t)
(mapMaybe (uncurry applyProjectRelated) $ sortAlign j' j) (mapMaybe (uncurry applyProjectRelated) $ sortAlign j' j)
(mapMaybe (uncurry applyRepoRelated) $ sortAlign r' r) (mapMaybe (uncurry applyRepoRelated) $ sortAlign r' r)
) )
where where
applySharer (LocalSharerDirectSet s' f') (LocalSharerDirectSet s f) = applySharer (LocalSharerDirectSet s' f') (LocalSharerDirectSet s f) =
LocalSharerDirectSet (s && (s' || allowActors)) (f && f') LocalSharerDirectSet (s && (s' || allowActors)) (f && f')
applyTicketRelated ltkhid (These t' t) = Just (ltkhid, applyTicket t' t)
where
applyTicket (LocalTicketDirectSet t' f') (LocalTicketDirectSet t f) =
LocalTicketDirectSet (t && t') (f && f')
applyTicketRelated _ _ = Nothing
applyProjectRelated _ (This _) = Nothing applyProjectRelated _ (This _) = Nothing
applyProjectRelated prj (That j) = applyProjectRelated prj (That j) =
if allowActors if allowActors
@ -468,11 +506,7 @@ localRecipSieve sieve allowActors =
where where
applyProject (LocalProjectDirectSet j' t' f') (LocalProjectDirectSet j t f) = applyProject (LocalProjectDirectSet j' t' f') (LocalProjectDirectSet j t f) =
LocalProjectDirectSet (j && (j' || allowActors)) (t && t') (f && f') LocalProjectDirectSet (j && (j' || allowActors)) (t && t') (f && f')
applyTicketRelated ltkhid (These t' t) = Just (ltkhid, applyTicket t' t)
where
applyTicket (LocalTicketDirectSet t' f') (LocalTicketDirectSet t f) =
LocalTicketDirectSet (t && t') (f && f')
applyTicketRelated _ _ = Nothing
applyRepoRelated _ (This _) = Nothing applyRepoRelated _ (This _) = Nothing
applyRepoRelated rp (That r) = applyRepoRelated rp (That r) =
if allowActors if allowActors