diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs
index 821b705..d2d3a10 100644
--- a/src/Vervis/API.hs
+++ b/src/Vervis/API.hs
@@ -1032,7 +1032,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc]
return (obiid, doc, luAct)
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) <-
traverseCollect (uncurry $ deliverLocalProject shr) projects
pids' <- do
diff --git a/src/Vervis/ActivityPub.hs b/src/Vervis/ActivityPub.hs
index f27a10d..93f63df 100644
--- a/src/Vervis/ActivityPub.hs
+++ b/src/Vervis/ActivityPub.hs
@@ -808,7 +808,7 @@ deliverLocal
]
deliverLocal shrAuthor ibidAuthor _fsidAuthor obiid = deliverLocal' True (LocalActorSharer shrAuthor) ibidAuthor obiid . localRecipSieve sieve True
where
- sieve = [(shrAuthor, LocalSharerRelatedSet (LocalSharerDirectSet False True) [] [] [])]
+ sieve = [(shrAuthor, LocalSharerRelatedSet (LocalSharerDirectSet False True) [] [] [] [])]
data RemoteRecipient = RemoteRecipient
{ remoteRecipientActor :: RemoteActorId
@@ -879,7 +879,7 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
map (personInbox . entityVal) <$> selectList [PersonIdent <-. sids] [Asc PersonInbox]
getOtherInboxes :: (ShrIdent, LocalSharerRelatedSet) -> AppDB [InboxId]
- getOtherInboxes (shr, LocalSharerRelatedSet _ _ projects repos) = do
+ getOtherInboxes (shr, LocalSharerRelatedSet _ _ _ projects repos) = do
msid <- getKeyBy $ UniqueSharer shr
case msid of
Nothing -> return []
@@ -915,24 +915,28 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
map (personFollowers . entityVal) <$> selectList [PersonIdent <-. sids] []
getOtherFollowerSets :: (ShrIdent, LocalSharerRelatedSet) -> AppDB [FollowerSetId]
- getOtherFollowerSets (shr, LocalSharerRelatedSet _ tickets projects repos) = do
+ getOtherFollowerSets (shr, LocalSharerRelatedSet _ tickets patches projects repos) = do
msid <- getKeyBy $ UniqueSharer shr
case msid of
Nothing -> return []
Just sid -> do
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
Nothing -> pure []
- Just pid -> getSharerTicketFollowerSets pid tickets
+ Just pid -> getSharerTicketFollowerSets pid tickets patches
<*> getProjectFollowerSets sid projects
<*> getRepoFollowerSets sid repos
where
- getSharerTicketFollowerSets pid tickets = do
+ getSharerTicketFollowerSets pid tickets patches = do
let talkhids =
[talkhid | (talkhid, t) <- tickets
, localRecipTicketFollowers t
]
+ ++
+ [talkhid | (talkhid, p) <- patches
+ , localRecipPatchFollowers p
+ ]
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
@@ -986,15 +990,51 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
E.isNothing (tar E.?. TicketAuthorRemoteId)
)
return $ lt E.^. LocalTicketFollowers
- getRepoFollowerSets sid repos =
- let rps =
+ getRepoFollowerSets sid repos = do
+ let rpsR =
[rp | (rp, r) <- repos
, let d = localRecipRepoDirect r
in localRecipRepoFollowers d &&
(localRecipRepo d || not requireOwner || isAuthor (LocalActorRepo shr rp))
]
- in map (repoFollowers . entityVal) <$>
- selectList [RepoSharer ==. sid, RepoIdent <-. rps] []
+ fsidsR <-
+ 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 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)
getTeams :: (ShrIdent, LocalSharerRelatedSet) -> AppDB [InboxId]
- getTeams (shr, LocalSharerRelatedSet _ tickets projects repos) = do
+ getTeams (shr, LocalSharerRelatedSet _ tickets _ projects repos) = do
msid <- getKeyBy $ UniqueSharer shr
case msid of
Nothing -> return []
diff --git a/src/Vervis/ActivityPub/Recipient.hs b/src/Vervis/ActivityPub/Recipient.hs
index 35f8251..0ed7f91 100644
--- a/src/Vervis/ActivityPub/Recipient.hs
+++ b/src/Vervis/ActivityPub/Recipient.hs
@@ -17,6 +17,7 @@ module Vervis.ActivityPub.Recipient
( LocalActor (..)
, LocalPersonCollection (..)
, LocalTicketDirectSet (..)
+ , LocalPatchDirectSet (..)
, LocalProjectDirectSet (..)
, LocalProjectRelatedSet (..)
, LocalRepoDirectSet (..)
@@ -100,14 +101,16 @@ data LocalPersonCollection
= LocalPersonCollectionSharerFollowers ShrIdent
| LocalPersonCollectionSharerTicketTeam ShrIdent (KeyHashid TicketAuthorLocal)
| LocalPersonCollectionSharerTicketFollowers ShrIdent (KeyHashid TicketAuthorLocal)
+ | LocalPersonCollectionSharerPatchFollowers ShrIdent (KeyHashid TicketAuthorLocal)
| LocalPersonCollectionProjectTeam ShrIdent PrjIdent
| LocalPersonCollectionProjectFollowers ShrIdent PrjIdent
| LocalPersonCollectionProjectTicketTeam ShrIdent PrjIdent (KeyHashid LocalTicket)
| LocalPersonCollectionProjectTicketFollowers ShrIdent PrjIdent (KeyHashid LocalTicket)
- | LocalPersonCollectionRepoTeam ShrIdent RpIdent
- | LocalPersonCollectionRepoFollowers ShrIdent RpIdent
+ | LocalPersonCollectionRepoTeam ShrIdent RpIdent
+ | LocalPersonCollectionRepoFollowers ShrIdent RpIdent
+ | LocalPersonCollectionRepoPatchFollowers ShrIdent RpIdent (KeyHashid LocalTicket)
deriving Eq
parseLocalPersonCollection
@@ -118,6 +121,8 @@ parseLocalPersonCollection (SharerTicketTeamR shr talkhid) =
Just $ LocalPersonCollectionSharerTicketTeam shr talkhid
parseLocalPersonCollection (SharerTicketFollowersR shr talkhid) =
Just $ LocalPersonCollectionSharerTicketFollowers shr talkhid
+parseLocalPersonCollection (SharerPatchFollowersR shr talkhid) =
+ Just $ LocalPersonCollectionSharerPatchFollowers shr talkhid
parseLocalPersonCollection (ProjectTeamR shr prj) =
Just $ LocalPersonCollectionProjectTeam shr prj
parseLocalPersonCollection (ProjectFollowersR shr prj) =
@@ -130,18 +135,22 @@ parseLocalPersonCollection (RepoTeamR shr rp) =
Just $ LocalPersonCollectionRepoTeam shr rp
parseLocalPersonCollection (RepoFollowersR shr rp) =
Just $ LocalPersonCollectionRepoFollowers shr rp
+parseLocalPersonCollection (RepoPatchFollowersR shr rp ltkhid) =
+ Just $ LocalPersonCollectionRepoPatchFollowers shr rp ltkhid
parseLocalPersonCollection _ = Nothing
renderLocalPersonCollection :: LocalPersonCollection -> Route App
renderLocalPersonCollection (LocalPersonCollectionSharerFollowers shr) = SharerFollowersR shr
renderLocalPersonCollection (LocalPersonCollectionSharerTicketTeam shr talkhid) = SharerTicketTeamR shr talkhid
renderLocalPersonCollection (LocalPersonCollectionSharerTicketFollowers shr talkhid) = SharerTicketFollowersR shr talkhid
+renderLocalPersonCollection (LocalPersonCollectionSharerPatchFollowers shr talkhid) = SharerPatchFollowersR shr talkhid
renderLocalPersonCollection (LocalPersonCollectionProjectTeam shr prj) = ProjectTeamR shr prj
renderLocalPersonCollection (LocalPersonCollectionProjectFollowers shr prj) = ProjectFollowersR shr prj
renderLocalPersonCollection (LocalPersonCollectionProjectTicketTeam shr prj ltkhid) = ProjectTicketTeamR shr prj ltkhid
renderLocalPersonCollection (LocalPersonCollectionProjectTicketFollowers shr prj ltkhid) = ProjectTicketParticipantsR shr prj ltkhid
renderLocalPersonCollection (LocalPersonCollectionRepoTeam shr rp) = RepoTeamR shr rp
renderLocalPersonCollection (LocalPersonCollectionRepoFollowers shr rp) = RepoFollowersR shr rp
+renderLocalPersonCollection (LocalPersonCollectionRepoPatchFollowers shr rp ltkhid) = RepoPatchFollowersR shr rp ltkhid
parseLocalRecipient
:: Route App -> Maybe (Either LocalActor LocalPersonCollection)
@@ -159,6 +168,8 @@ parseLocalRecipient r =
data LocalTicketRecipientDirect = LocalTicketTeam | LocalTicketFollowerz
deriving (Eq, Ord)
+data LocalPatchRecipientDirect = LocalPatchFollowers deriving (Eq, Ord)
+
data LocalProjectRecipientDirect
= LocalProject
| LocalProjectTeam
@@ -176,7 +187,9 @@ data LocalRepoRecipientDirect
| LocalRepoFollowers
deriving (Eq, Ord)
-data LocalRepoRecipient = LocalRepoDirect LocalRepoRecipientDirect
+data LocalRepoRecipient
+ = LocalRepoDirect LocalRepoRecipientDirect
+ | LocalRepoPatchRelated (KeyHashid LocalTicket) LocalPatchRecipientDirect
deriving (Eq, Ord)
data LocalSharerRecipientDirect
@@ -187,6 +200,7 @@ data LocalSharerRecipientDirect
data LocalSharerRecipient
= LocalSharerDirect LocalSharerRecipientDirect
| LocalSharerTicketRelated (KeyHashid TicketAuthorLocal) LocalTicketRecipientDirect
+ | LocalSharerPatchRelated (KeyHashid TicketAuthorLocal) LocalPatchRecipientDirect
| LocalProjectRelated PrjIdent LocalProjectRecipient
| LocalRepoRelated RpIdent LocalRepoRecipient
deriving (Eq, Ord)
@@ -216,6 +230,10 @@ groupedRecipientFromCollection
(LocalPersonCollectionSharerTicketFollowers shr talkhid) =
LocalSharerRelated shr $
LocalSharerTicketRelated talkhid LocalTicketFollowerz
+groupedRecipientFromCollection
+ (LocalPersonCollectionSharerPatchFollowers shr talkhid) =
+ LocalSharerRelated shr $
+ LocalSharerPatchRelated talkhid LocalPatchFollowers
groupedRecipientFromCollection
(LocalPersonCollectionProjectTeam shr prj) =
LocalSharerRelated shr $ LocalProjectRelated prj $
@@ -240,6 +258,10 @@ groupedRecipientFromCollection
(LocalPersonCollectionRepoFollowers shr rp) =
LocalSharerRelated shr $ LocalRepoRelated rp $
LocalRepoDirect LocalRepoFollowers
+groupedRecipientFromCollection
+ (LocalPersonCollectionRepoPatchFollowers shr rp ltkhid) =
+ LocalSharerRelated shr $ LocalRepoRelated rp $
+ LocalRepoPatchRelated ltkhid LocalPatchFollowers
-------------------------------------------------------------------------------
-- Recipient set types
@@ -256,6 +278,11 @@ data LocalTicketDirectSet = LocalTicketDirectSet
}
deriving Eq
+newtype LocalPatchDirectSet = LocalPatchDirectSet
+ { localRecipPatchFollowers :: Bool
+ }
+ deriving Eq
+
data LocalProjectDirectSet = LocalProjectDirectSet
{ localRecipProject :: Bool
, localRecipProjectTeam :: Bool
@@ -279,7 +306,10 @@ data LocalRepoDirectSet = LocalRepoDirectSet
deriving Eq
data LocalRepoRelatedSet = LocalRepoRelatedSet
- { localRecipRepoDirect :: LocalRepoDirectSet
+ { localRecipRepoDirect
+ :: LocalRepoDirectSet
+ , localRecipRepoPatchRelated
+ :: [(KeyHashid LocalTicket, LocalPatchDirectSet)]
}
deriving Eq
@@ -294,6 +324,8 @@ data LocalSharerRelatedSet = LocalSharerRelatedSet
:: LocalSharerDirectSet
, localRecipSharerTicketRelated
:: [(KeyHashid TicketAuthorLocal, LocalTicketDirectSet)]
+ , localRecipSharerPatchRelated
+ :: [(KeyHashid TicketAuthorLocal, LocalPatchDirectSet)]
, localRecipProjectRelated
:: [(PrjIdent, LocalProjectRelatedSet)]
, localRecipRepoRelated
@@ -310,17 +342,28 @@ groupLocalRecipients
(\ (LocalSharerRelated shr _) -> shr)
(\ (LocalSharerRelated _ lsr) -> lsr)
where
- lsr2set = mk . partitionEithers4 . map lsr2e . NE.toList
+ lsr2set = mk . partitionLSR . NE.toList
where
- lsr2e (LocalSharerDirect d) = Left $ Left d
- lsr2e (LocalSharerTicketRelated talkhid ltr) = Left $ Right (talkhid, ltr)
- lsr2e (LocalProjectRelated prj lpr) = Right $ Left (prj, lpr)
- lsr2e (LocalRepoRelated rp lrr) = Right $ Right (rp, lrr)
- mk (ds, ts, ps, rs) =
+ partitionLSR = foldr f ([], [], [], [], [])
+ where
+ f i (ds, ts, ps, js, rs) =
+ case i of
+ 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
(lsrs2set ds)
(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)
where
lsrs2set = foldl' f initial
@@ -337,16 +380,20 @@ groupLocalRecipients
s { localRecipTicketTeam = True }
f s LocalTicketFollowerz =
s { localRecipTicketFollowers = True }
- lpr2set = uncurry mk . partitionEithers . map lpr2e . NE.toList
+ lprs2set = foldl' f initial
where
- lpr2e (LocalProjectDirect d) = Left d
- lpr2e (LocalProjectTicketRelated num ltrs) = Right (num, ltrs)
+ initial = LocalPatchDirectSet False
+ 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 =
LocalProjectRelatedSet
- (lprs2set ds)
+ (ljrs2set ds)
(map (second ltrs2set) $ groupWithExtract fst snd ts)
where
- lprs2set = foldl' f initial
+ ljrs2set = foldl' f initial
where
initial = LocalProjectDirectSet False False False
f s LocalProject =
@@ -355,16 +402,21 @@ groupLocalRecipients
s { localRecipProjectTeam = True }
f s LocalProjectFollowers =
s { localRecipProjectFollowers = True }
- lrr2set = LocalRepoRelatedSet . foldl' f initial . NE.map unwrap
+ lrr2set = uncurry mk . partitionEithers . map lrr2e . NE.toList
where
- unwrap (LocalRepoDirect d) = d
- initial = LocalRepoDirectSet False False False
- f s LocalRepo = s { localRecipRepo = True }
- f s LocalRepoTeam = s { localRecipRepoTeam = True }
- f s LocalRepoFollowers = s { localRecipRepoFollowers = True }
- partitionEithers4 = adapt . bimap partitionEithers partitionEithers . partitionEithers
- where
- adapt ((l1, l2), (l3, l4)) = (l1, l2, l3, l4)
+ 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
+ initial = LocalRepoDirectSet False False False
+ f s LocalRepo = s { localRecipRepo = True }
+ f s LocalRepoTeam = s { localRecipRepoTeam = True }
+ f s LocalRepoFollowers = s { localRecipRepoFollowers = True }
-------------------------------------------------------------------------------
-- Parse URIs into a grouped recipient set
@@ -468,12 +520,13 @@ localRecipSieve' sieve allowSharers allowOthers =
where
onlyActorsJ (LocalProjectRelatedSet (LocalProjectDirectSet j _t _f) _ts) =
LocalProjectRelatedSet (LocalProjectDirectSet (j && allowOthers) False False) []
- onlyActorsR (LocalRepoRelatedSet (LocalRepoDirectSet r _t _f)) =
- LocalRepoRelatedSet $ LocalRepoDirectSet (r && allowOthers) False False
- onlyActorsS (LocalSharerRelatedSet (LocalSharerDirectSet s _f) _ts js rs) =
+ onlyActorsR (LocalRepoRelatedSet (LocalRepoDirectSet r _t _f) _ps) =
+ LocalRepoRelatedSet (LocalRepoDirectSet (r && allowOthers) False False) []
+ onlyActorsS (LocalSharerRelatedSet (LocalSharerDirectSet s _f) _ts _ps js rs) =
LocalSharerRelatedSet
(LocalSharerDirectSet (s && allowSharers) False)
[]
+ []
(map (second onlyActorsJ) js)
(map (second onlyActorsR) rs)
@@ -482,12 +535,13 @@ localRecipSieve' sieve allowSharers allowOthers =
if allowSharers || allowOthers
then Just (shr, onlyActorsS s)
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
( shr
, LocalSharerRelatedSet
(applySharer s' s)
(mapMaybe (uncurry applyTicketRelated) $ sortAlign t' t)
+ (mapMaybe (uncurry applyPatchRelated) $ sortAlign p' p)
(mapMaybe (uncurry applyProjectRelated) $ sortAlign j' j)
(mapMaybe (uncurry applyRepoRelated) $ sortAlign r' r)
)
@@ -501,6 +555,12 @@ localRecipSieve' sieve allowSharers allowOthers =
LocalTicketDirectSet (t && t') (f && f')
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 prj (That j) =
if allowOthers
@@ -522,8 +582,13 @@ localRecipSieve' sieve allowSharers allowOthers =
if allowOthers
then Just (rp, onlyActorsR r)
else Nothing
- applyRepoRelated rp (These (LocalRepoRelatedSet r') (LocalRepoRelatedSet r)) =
- Just (rp, LocalRepoRelatedSet $ applyRepo r' r)
+ applyRepoRelated rp (These (LocalRepoRelatedSet r' p') (LocalRepoRelatedSet r p)) =
+ Just
+ ( rp
+ , LocalRepoRelatedSet
+ (applyRepo r' r)
+ (mapMaybe (uncurry applyPatchRelated) $ sortAlign p' p)
+ )
where
applyRepo (LocalRepoDirectSet r' t' f') (LocalRepoDirectSet r t f) =
LocalRepoDirectSet (r && (r' || allowOthers)) (t && t') (f && f')