naskya/vervis
1
0
Fork 0
mirror of https://code.naskya.net/repos/ndqEd synced 2025-01-10 21:26:46 +09:00
Code Activity

Support addressing, delivery and forwarding for sharer-patches and repo-patches

Browse source
This commit is contained in:
fr33domlover 2020-05-27 10:38:28 +00:00
parent d9c00cba1f
commit 06a051d2e5
3 changed files with 148 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/Vervis/API.hs
View file

@ -1032,7 +1032,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

62
src/Vervis/ActivityPub.hs
View file

@ -808,7 +808,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
@ -879,7 +879,7 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
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 []
@ -915,24 +915,28 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
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 _ tickets projects repos) = do getOtherFollowerSets (shr, LocalSharerRelatedSet _ tickets patches projects repos) = do
msid <- getKeyBy $ UniqueSharer shr msid <- getKeyBy $ UniqueSharer shr
case msid of case msid of
Nothing -> return [] Nothing -> return []
Just sid -> do Just sid -> do
mpid <- getKeyBy $ UniquePersonIdent sid mpid <- getKeyBy $ UniquePersonIdent sid
(\ t j r -> map E.unValue t ++ j ++ r) (\ tp j r -> map E.unValue tp ++ j ++ r)
<$> case mpid of <$> case mpid of
Nothing -> pure [] Nothing -> pure []
Just pid -> getSharerTicketFollowerSets pid tickets Just pid -> getSharerTicketFollowerSets pid tickets patches
<*> getProjectFollowerSets sid projects <*> getProjectFollowerSets sid projects
<*> getRepoFollowerSets sid repos <*> getRepoFollowerSets sid repos
where where
getSharerTicketFollowerSets pid tickets = do getSharerTicketFollowerSets pid tickets patches = do
let talkhids = let talkhids =
[talkhid | (talkhid, t) <- tickets [talkhid | (talkhid, t) <- tickets
, localRecipTicketFollowers t , localRecipTicketFollowers t
] ]
++
[talkhid | (talkhid, p) <- patches
, localRecipPatchFollowers p
]
talids <- catMaybes <$> traverse decodeKeyHashid talkhids talids <- catMaybes <$> traverse decodeKeyHashid talkhids
E.select $ E.from $ \ (tal `E.InnerJoin` lt `E.LeftOuterJoin` tup) -> do 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 $ E.just (tal E.^. TicketAuthorLocalId) E.==. tup E.?. TicketUnderProjectAuthor
@ -986,15 +990,51 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
E.isNothing (tar E.?. TicketAuthorRemoteId) E.isNothing (tar E.?. TicketAuthorRemoteId)
) )
return $ lt E.^. LocalTicketFollowers return $ lt E.^. LocalTicketFollowers
getRepoFollowerSets sid repos = getRepoFollowerSets sid repos = do
let rps = let rpsR =
[rp | (rp, r) <- repos [rp | (rp, r) <- repos
, let d = localRecipRepoDirect r , let d = localRecipRepoDirect r
in localRecipRepoFollowers d && in localRecipRepoFollowers d &&
(localRecipRepo d || not requireOwner || isAuthor (LocalActorRepo shr rp)) (localRecipRepo d || not requireOwner || isAuthor (LocalActorRepo shr rp))
] ]
in map (repoFollowers . entityVal) <$> fsidsR <-
selectList [RepoSharer ==. sid, RepoIdent <-. rps] [] map (repoFollowers . entityVal) <$>
selectList [RepoSharer ==. sid, RepoIdent <-. rpsR] []
let rpsP =
if requireOwner
then
[ (rp, localRecipRepoPatchRelated r)
| (rp, r) <- repos
, localRecipRepo (localRecipRepoDirect r) || isAuthor (LocalActorRepo shr rp)
]
else
map (second localRecipRepoPatchRelated) repos
fsidssP <- for rpsP $ \ (rp, patches) -> do
mrid <- getKeyBy $ UniqueRepo rp sid
case mrid of
Nothing -> return []
Just rid -> getPatchFollowerSets rid patches
return $ fsidsR ++ map E.unValue (concat fsidssP)
where
getPatchFollowerSets rid patches = do
let ltkhids =
[ltkhid | (ltkhid, p) <- patches
, localRecipPatchFollowers p
]
ltids <- catMaybes <$> traverse decodeKeyHashid ltkhids
E.select $ E.from $ \ (lt `E.InnerJoin` t `E.InnerJoin` tcl `E.InnerJoin` trl `E.LeftOuterJoin` tup `E.LeftOuterJoin` tar) -> do
E.on $ E.just (tcl E.^. TicketContextLocalId) E.==. tar E.?. TicketAuthorRemoteTicket
E.on $ E.just (tcl E.^. TicketContextLocalId) E.==. tup E.?. TicketUnderProjectProject
E.on $ tcl E.^. TicketContextLocalId E.==. trl E.^. TicketRepoLocalContext
E.on $ t E.^. TicketId E.==. tcl E.^. TicketContextLocalTicket
E.on $ lt E.^. LocalTicketTicket E.==. t E.^. TicketId
E.where_ $
trl E.^. TicketRepoLocalRepo E.==. E.val rid E.&&.
E.not_
( E.isNothing (tup E.?. TicketUnderProjectId) E.&&.
E.isNothing (tar E.?. TicketAuthorRemoteId)
)
return $ lt E.^. LocalTicketFollowers
getLocalFollowers :: [FollowerSetId] -> AppDB [InboxId] getLocalFollowers :: [FollowerSetId] -> AppDB [InboxId]
getLocalFollowers fsids = do getLocalFollowers fsids = do
@ -1027,7 +1067,7 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
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 _ tickets 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 []

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

@ -17,6 +17,7 @@ module Vervis.ActivityPub.Recipient
( LocalActor (..) ( LocalActor (..)
, LocalPersonCollection (..) , LocalPersonCollection (..)
, LocalTicketDirectSet (..) , LocalTicketDirectSet (..)
, LocalPatchDirectSet (..)
, LocalProjectDirectSet (..) , LocalProjectDirectSet (..)
, LocalProjectRelatedSet (..) , LocalProjectRelatedSet (..)
, LocalRepoDirectSet (..) , LocalRepoDirectSet (..)
@ -100,6 +101,7 @@ data LocalPersonCollection
= LocalPersonCollectionSharerFollowers ShrIdent = LocalPersonCollectionSharerFollowers ShrIdent
| LocalPersonCollectionSharerTicketTeam ShrIdent (KeyHashid TicketAuthorLocal) | LocalPersonCollectionSharerTicketTeam ShrIdent (KeyHashid TicketAuthorLocal)
| LocalPersonCollectionSharerTicketFollowers ShrIdent (KeyHashid TicketAuthorLocal) | LocalPersonCollectionSharerTicketFollowers ShrIdent (KeyHashid TicketAuthorLocal)
| LocalPersonCollectionSharerPatchFollowers ShrIdent (KeyHashid TicketAuthorLocal)
| LocalPersonCollectionProjectTeam ShrIdent PrjIdent | LocalPersonCollectionProjectTeam ShrIdent PrjIdent
| LocalPersonCollectionProjectFollowers ShrIdent PrjIdent | LocalPersonCollectionProjectFollowers ShrIdent PrjIdent
@ -108,6 +110,7 @@ data LocalPersonCollection
| LocalPersonCollectionRepoTeam ShrIdent RpIdent | LocalPersonCollectionRepoTeam ShrIdent RpIdent
| LocalPersonCollectionRepoFollowers ShrIdent RpIdent | LocalPersonCollectionRepoFollowers ShrIdent RpIdent
| LocalPersonCollectionRepoPatchFollowers ShrIdent RpIdent (KeyHashid LocalTicket)
deriving Eq deriving Eq
parseLocalPersonCollection parseLocalPersonCollection
@ -118,6 +121,8 @@ parseLocalPersonCollection (SharerTicketTeamR shr talkhid) =
Just $ LocalPersonCollectionSharerTicketTeam shr talkhid Just $ LocalPersonCollectionSharerTicketTeam shr talkhid
parseLocalPersonCollection (SharerTicketFollowersR shr talkhid) = parseLocalPersonCollection (SharerTicketFollowersR shr talkhid) =
Just $ LocalPersonCollectionSharerTicketFollowers shr talkhid Just $ LocalPersonCollectionSharerTicketFollowers shr talkhid
parseLocalPersonCollection (SharerPatchFollowersR shr talkhid) =
Just $ LocalPersonCollectionSharerPatchFollowers 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) =
@ -130,18 +135,22 @@ parseLocalPersonCollection (RepoTeamR shr rp) =
Just $ LocalPersonCollectionRepoTeam shr rp Just $ LocalPersonCollectionRepoTeam shr rp
parseLocalPersonCollection (RepoFollowersR shr rp) = parseLocalPersonCollection (RepoFollowersR shr rp) =
Just $ LocalPersonCollectionRepoFollowers shr rp Just $ LocalPersonCollectionRepoFollowers shr rp
parseLocalPersonCollection (RepoPatchFollowersR shr rp ltkhid) =
Just $ LocalPersonCollectionRepoPatchFollowers shr rp ltkhid
parseLocalPersonCollection _ = Nothing 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 (LocalPersonCollectionSharerTicketTeam shr talkhid) = SharerTicketTeamR shr talkhid
renderLocalPersonCollection (LocalPersonCollectionSharerTicketFollowers shr talkhid) = SharerTicketFollowersR shr talkhid renderLocalPersonCollection (LocalPersonCollectionSharerTicketFollowers shr talkhid) = SharerTicketFollowersR shr talkhid
renderLocalPersonCollection (LocalPersonCollectionSharerPatchFollowers shr talkhid) = SharerPatchFollowersR 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 (LocalPersonCollectionProjectTicketTeam shr prj ltkhid) = ProjectTicketTeamR shr prj ltkhid renderLocalPersonCollection (LocalPersonCollectionProjectTicketTeam shr prj ltkhid) = ProjectTicketTeamR shr prj ltkhid
renderLocalPersonCollection (LocalPersonCollectionProjectTicketFollowers 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
renderLocalPersonCollection (LocalPersonCollectionRepoPatchFollowers shr rp ltkhid) = RepoPatchFollowersR shr rp ltkhid
parseLocalRecipient parseLocalRecipient
:: Route App -> Maybe (Either LocalActor LocalPersonCollection) :: Route App -> Maybe (Either LocalActor LocalPersonCollection)
@ -159,6 +168,8 @@ parseLocalRecipient r =
data LocalTicketRecipientDirect = LocalTicketTeam | LocalTicketFollowerz data LocalTicketRecipientDirect = LocalTicketTeam | LocalTicketFollowerz
deriving (Eq, Ord) deriving (Eq, Ord)
data LocalPatchRecipientDirect = LocalPatchFollowers deriving (Eq, Ord)
data LocalProjectRecipientDirect data LocalProjectRecipientDirect
= LocalProject = LocalProject
| LocalProjectTeam | LocalProjectTeam
@ -176,7 +187,9 @@ data LocalRepoRecipientDirect
| LocalRepoFollowers | LocalRepoFollowers
deriving (Eq, Ord) deriving (Eq, Ord)
data LocalRepoRecipient = LocalRepoDirect LocalRepoRecipientDirect data LocalRepoRecipient
= LocalRepoDirect LocalRepoRecipientDirect
| LocalRepoPatchRelated (KeyHashid LocalTicket) LocalPatchRecipientDirect
deriving (Eq, Ord) deriving (Eq, Ord)
data LocalSharerRecipientDirect data LocalSharerRecipientDirect
@ -187,6 +200,7 @@ data LocalSharerRecipientDirect
data LocalSharerRecipient data LocalSharerRecipient
= LocalSharerDirect LocalSharerRecipientDirect = LocalSharerDirect LocalSharerRecipientDirect
| LocalSharerTicketRelated (KeyHashid TicketAuthorLocal) LocalTicketRecipientDirect | LocalSharerTicketRelated (KeyHashid TicketAuthorLocal) LocalTicketRecipientDirect
| LocalSharerPatchRelated (KeyHashid TicketAuthorLocal) LocalPatchRecipientDirect
| LocalProjectRelated PrjIdent LocalProjectRecipient | LocalProjectRelated PrjIdent LocalProjectRecipient
| LocalRepoRelated RpIdent LocalRepoRecipient | LocalRepoRelated RpIdent LocalRepoRecipient
deriving (Eq, Ord) deriving (Eq, Ord)
@ -216,6 +230,10 @@ groupedRecipientFromCollection
(LocalPersonCollectionSharerTicketFollowers shr talkhid) = (LocalPersonCollectionSharerTicketFollowers shr talkhid) =
LocalSharerRelated shr $ LocalSharerRelated shr $
LocalSharerTicketRelated talkhid LocalTicketFollowerz LocalSharerTicketRelated talkhid LocalTicketFollowerz
groupedRecipientFromCollection
(LocalPersonCollectionSharerPatchFollowers shr talkhid) =
LocalSharerRelated shr $
LocalSharerPatchRelated talkhid LocalPatchFollowers
groupedRecipientFromCollection groupedRecipientFromCollection
(LocalPersonCollectionProjectTeam shr prj) = (LocalPersonCollectionProjectTeam shr prj) =
LocalSharerRelated shr $ LocalProjectRelated prj $ LocalSharerRelated shr $ LocalProjectRelated prj $
@ -240,6 +258,10 @@ groupedRecipientFromCollection
(LocalPersonCollectionRepoFollowers shr rp) = (LocalPersonCollectionRepoFollowers shr rp) =
LocalSharerRelated shr $ LocalRepoRelated rp $ LocalSharerRelated shr $ LocalRepoRelated rp $
LocalRepoDirect LocalRepoFollowers LocalRepoDirect LocalRepoFollowers
groupedRecipientFromCollection
(LocalPersonCollectionRepoPatchFollowers shr rp ltkhid) =
LocalSharerRelated shr $ LocalRepoRelated rp $
LocalRepoPatchRelated ltkhid LocalPatchFollowers
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- Recipient set types -- Recipient set types
@ -256,6 +278,11 @@ data LocalTicketDirectSet = LocalTicketDirectSet
} }
deriving Eq deriving Eq
newtype LocalPatchDirectSet = LocalPatchDirectSet
{ localRecipPatchFollowers :: Bool
}
deriving Eq
data LocalProjectDirectSet = LocalProjectDirectSet data LocalProjectDirectSet = LocalProjectDirectSet
{ localRecipProject :: Bool { localRecipProject :: Bool
, localRecipProjectTeam :: Bool , localRecipProjectTeam :: Bool
@ -279,7 +306,10 @@ data LocalRepoDirectSet = LocalRepoDirectSet
deriving Eq deriving Eq
data LocalRepoRelatedSet = LocalRepoRelatedSet data LocalRepoRelatedSet = LocalRepoRelatedSet
{ localRecipRepoDirect :: LocalRepoDirectSet { localRecipRepoDirect
:: LocalRepoDirectSet
, localRecipRepoPatchRelated
:: [(KeyHashid LocalTicket, LocalPatchDirectSet)]
} }
deriving Eq deriving Eq
@ -294,6 +324,8 @@ data LocalSharerRelatedSet = LocalSharerRelatedSet
:: LocalSharerDirectSet :: LocalSharerDirectSet
, localRecipSharerTicketRelated , localRecipSharerTicketRelated
:: [(KeyHashid TicketAuthorLocal, LocalTicketDirectSet)] :: [(KeyHashid TicketAuthorLocal, LocalTicketDirectSet)]
, localRecipSharerPatchRelated
:: [(KeyHashid TicketAuthorLocal, LocalPatchDirectSet)]
, localRecipProjectRelated , localRecipProjectRelated
:: [(PrjIdent, LocalProjectRelatedSet)] :: [(PrjIdent, LocalProjectRelatedSet)]
, localRecipRepoRelated , localRecipRepoRelated
@ -310,17 +342,28 @@ groupLocalRecipients
(\ (LocalSharerRelated shr _) -> shr) (\ (LocalSharerRelated shr _) -> shr)
(\ (LocalSharerRelated _ lsr) -> lsr) (\ (LocalSharerRelated _ lsr) -> lsr)
where where
lsr2set = mk . partitionEithers4 . map lsr2e . NE.toList lsr2set = mk . partitionLSR . NE.toList
where where
lsr2e (LocalSharerDirect d) = Left $ Left d partitionLSR = foldr f ([], [], [], [], [])
lsr2e (LocalSharerTicketRelated talkhid ltr) = Left $ Right (talkhid, ltr) where
lsr2e (LocalProjectRelated prj lpr) = Right $ Left (prj, lpr) f i (ds, ts, ps, js, rs) =
lsr2e (LocalRepoRelated rp lrr) = Right $ Right (rp, lrr) case i of
mk (ds, ts, ps, rs) = LocalSharerDirect d ->
(d:ds, ts, ps, js, rs)
LocalSharerTicketRelated talkhid ltr ->
(ds, (talkhid, ltr):ts, ps, js, rs)
LocalSharerPatchRelated talkhid lpr ->
(ds, ts, (talkhid, lpr):ps, js, rs)
LocalProjectRelated prj ljr ->
(ds, ts, ps, (prj, ljr):js, rs)
LocalRepoRelated rp lrr ->
(ds, ts, ps, js, (rp, lrr):rs)
mk (ds, ts, ps, js, rs) =
LocalSharerRelatedSet LocalSharerRelatedSet
(lsrs2set ds) (lsrs2set ds)
(map (second ltrs2set) $ groupWithExtract fst snd ts) (map (second ltrs2set) $ groupWithExtract fst snd ts)
(map (second lpr2set) $ groupWithExtract fst snd ps) (map (second lprs2set) $ groupWithExtract fst snd ps)
(map (second ljr2set) $ groupWithExtract fst snd js)
(map (second lrr2set) $ groupWithExtract fst snd rs) (map (second lrr2set) $ groupWithExtract fst snd rs)
where where
lsrs2set = foldl' f initial lsrs2set = foldl' f initial
@ -337,16 +380,20 @@ groupLocalRecipients
s { localRecipTicketTeam = True } s { localRecipTicketTeam = True }
f s LocalTicketFollowerz = f s LocalTicketFollowerz =
s { localRecipTicketFollowers = True } s { localRecipTicketFollowers = True }
lpr2set = uncurry mk . partitionEithers . map lpr2e . NE.toList lprs2set = foldl' f initial
where where
lpr2e (LocalProjectDirect d) = Left d initial = LocalPatchDirectSet False
lpr2e (LocalProjectTicketRelated num ltrs) = Right (num, ltrs) f s LocalPatchFollowers = s { localRecipPatchFollowers = True }
ljr2set = uncurry mk . partitionEithers . map ljr2e . NE.toList
where
ljr2e (LocalProjectDirect d) = Left d
ljr2e (LocalProjectTicketRelated num ltrs) = Right (num, ltrs)
mk ds ts = mk ds ts =
LocalProjectRelatedSet LocalProjectRelatedSet
(lprs2set ds) (ljrs2set ds)
(map (second ltrs2set) $ groupWithExtract fst snd ts) (map (second ltrs2set) $ groupWithExtract fst snd ts)
where where
lprs2set = foldl' f initial ljrs2set = foldl' f initial
where where
initial = LocalProjectDirectSet False False False initial = LocalProjectDirectSet False False False
f s LocalProject = f s LocalProject =
@ -355,16 +402,21 @@ groupLocalRecipients
s { localRecipProjectTeam = True } s { localRecipProjectTeam = True }
f s LocalProjectFollowers = f s LocalProjectFollowers =
s { localRecipProjectFollowers = True } s { localRecipProjectFollowers = True }
lrr2set = LocalRepoRelatedSet . foldl' f initial . NE.map unwrap lrr2set = uncurry mk . partitionEithers . map lrr2e . NE.toList
where
lrr2e (LocalRepoDirect d) = Left d
lrr2e (LocalRepoPatchRelated num ltrs) = Right (num, ltrs)
mk ds ps =
LocalRepoRelatedSet
(lrrs2set ds)
(map (second lprs2set) $ groupWithExtract fst snd ps)
where
lrrs2set = foldl' f initial
where where
unwrap (LocalRepoDirect d) = d
initial = LocalRepoDirectSet False False False initial = LocalRepoDirectSet False False False
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 }
partitionEithers4 = adapt . bimap partitionEithers partitionEithers . partitionEithers
where
adapt ((l1, l2), (l3, l4)) = (l1, l2, l3, l4)
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- Parse URIs into a grouped recipient set -- Parse URIs into a grouped recipient set
@ -468,12 +520,13 @@ localRecipSieve' sieve allowSharers allowOthers =
where where
onlyActorsJ (LocalProjectRelatedSet (LocalProjectDirectSet j _t _f) _ts) = onlyActorsJ (LocalProjectRelatedSet (LocalProjectDirectSet j _t _f) _ts) =
LocalProjectRelatedSet (LocalProjectDirectSet (j && allowOthers) False False) [] LocalProjectRelatedSet (LocalProjectDirectSet (j && allowOthers) False False) []
onlyActorsR (LocalRepoRelatedSet (LocalRepoDirectSet r _t _f)) = onlyActorsR (LocalRepoRelatedSet (LocalRepoDirectSet r _t _f) _ps) =
LocalRepoRelatedSet $ LocalRepoDirectSet (r && allowOthers) False False LocalRepoRelatedSet (LocalRepoDirectSet (r && allowOthers) False False) []
onlyActorsS (LocalSharerRelatedSet (LocalSharerDirectSet s _f) _ts js rs) = onlyActorsS (LocalSharerRelatedSet (LocalSharerDirectSet s _f) _ts _ps js rs) =
LocalSharerRelatedSet LocalSharerRelatedSet
(LocalSharerDirectSet (s && allowSharers) False) (LocalSharerDirectSet (s && allowSharers) False)
[] []
[]
(map (second onlyActorsJ) js) (map (second onlyActorsJ) js)
(map (second onlyActorsR) rs) (map (second onlyActorsR) rs)
@ -482,12 +535,13 @@ localRecipSieve' sieve allowSharers allowOthers =
if allowSharers || allowOthers if allowSharers || allowOthers
then Just (shr, onlyActorsS s) then Just (shr, onlyActorsS s)
else Nothing else Nothing
applySharerRelated shr (These (LocalSharerRelatedSet s' t' j' r') (LocalSharerRelatedSet s t j r)) = applySharerRelated shr (These (LocalSharerRelatedSet s' t' p' j' r') (LocalSharerRelatedSet s t p j r)) =
Just Just
( shr ( shr
, LocalSharerRelatedSet , LocalSharerRelatedSet
(applySharer s' s) (applySharer s' s)
(mapMaybe (uncurry applyTicketRelated) $ sortAlign t' t) (mapMaybe (uncurry applyTicketRelated) $ sortAlign t' t)
(mapMaybe (uncurry applyPatchRelated) $ sortAlign p' p)
(mapMaybe (uncurry applyProjectRelated) $ sortAlign j' j) (mapMaybe (uncurry applyProjectRelated) $ sortAlign j' j)
(mapMaybe (uncurry applyRepoRelated) $ sortAlign r' r) (mapMaybe (uncurry applyRepoRelated) $ sortAlign r' r)
) )
@ -501,6 +555,12 @@ localRecipSieve' sieve allowSharers allowOthers =
LocalTicketDirectSet (t && t') (f && f') LocalTicketDirectSet (t && t') (f && f')
applyTicketRelated _ _ = Nothing applyTicketRelated _ _ = Nothing
applyPatchRelated ltkhid (These p' p) = Just (ltkhid, applyPatch p' p)
where
applyPatch (LocalPatchDirectSet f') (LocalPatchDirectSet f) =
LocalPatchDirectSet $ f && f'
applyPatchRelated _ _ = Nothing
applyProjectRelated _ (This _) = Nothing applyProjectRelated _ (This _) = Nothing
applyProjectRelated prj (That j) = applyProjectRelated prj (That j) =
if allowOthers if allowOthers
@ -522,8 +582,13 @@ localRecipSieve' sieve allowSharers allowOthers =
if allowOthers if allowOthers
then Just (rp, onlyActorsR r) then Just (rp, onlyActorsR r)
else Nothing else Nothing
applyRepoRelated rp (These (LocalRepoRelatedSet r') (LocalRepoRelatedSet r)) = applyRepoRelated rp (These (LocalRepoRelatedSet r' p') (LocalRepoRelatedSet r p)) =
Just (rp, LocalRepoRelatedSet $ applyRepo r' r) Just
( rp
, LocalRepoRelatedSet
(applyRepo r' r)
(mapMaybe (uncurry applyPatchRelated) $ sortAlign p' p)
)
where where
applyRepo (LocalRepoDirectSet r' t' f') (LocalRepoDirectSet r t f) = applyRepo (LocalRepoDirectSet r' t' f') (LocalRepoDirectSet r t f) =
LocalRepoDirectSet (r && (r' || allowOthers)) (t && t') (f && f') LocalRepoDirectSet (r && (r' || allowOthers)) (t && t') (f && f')