S2S: sharerCreateNoteF & projectCreateNoteF can handle sharer-hosted tickets

src/Vervis/API.hs

@@ -149,11 +149,6 @@ parseComment luParent = do
         MessageR shr hid -> (shr,) <$> decodeKeyHashidE hid "Non-existent local message hashid"
         _                -> throwE "Not a local message route"
 
-data NoteContext
-    = NoteContextSharerTicket ShrIdent TicketAuthorLocalId
-    | NoteContextProjectTicket ShrIdent PrjIdent LocalTicketId
-    deriving Eq
-
 noteC
     :: Entity Person
     -> Sharer

src/Vervis/ActivityPub.hs

@@ -14,7 +14,8 @@
  -}
 
 module Vervis.ActivityPub
-    ( hostIsLocal
+    ( NoteContext (..)
+    , hostIsLocal
     , verifyHostLocal
     , parseContext
     , parseParent
@@ -43,6 +44,7 @@ module Vervis.ActivityPub
     , deliverLocal
     , RemoteRecipient (..)
     , deliverLocal'
+    , insertRemoteActivityToLocalInboxes
     )
 where
 
@@ -119,6 +121,11 @@ import Vervis.Time
 import Vervis.Widget.Repo
 import Vervis.Widget.Sharer
 
+data NoteContext
+    = NoteContextSharerTicket ShrIdent TicketAuthorLocalId
+    | NoteContextProjectTicket ShrIdent PrjIdent LocalTicketId
+    deriving Eq
+
 hostIsLocal :: (MonadSite m, SiteEnv m ~ App) => Host -> m Bool
 hostIsLocal h = asksSite $ (== h) . appInstanceHost . appSettings
 
@@ -132,7 +139,7 @@ verifyHostLocal h t = do
 parseContext
     :: (MonadSite m, SiteEnv m ~ App)
     => FedURI
-    -> ExceptT Text m (Either (ShrIdent, PrjIdent, KeyHashid LocalTicket) FedURI)
+    -> ExceptT Text m (Either NoteContext FedURI)
 parseContext uContext = do
     let ObjURI hContext luContext = uContext
     local <- hostIsLocal hContext
@@ -142,7 +149,12 @@ parseContext uContext = do
                 Nothing -> throwE "Local context isn't a valid route"
                 Just r -> return r
             case route of
-                ProjectTicketR shr prj num -> return (shr, prj, num)
+                SharerTicketR shr talkhid ->
+                    NoteContextSharerTicket shr <$>
+                        decodeKeyHashidE talkhid "Note context invalid talkhid"
+                ProjectTicketR shr prj ltkhid ->
+                    NoteContextProjectTicket shr prj <$>
+                        decodeKeyHashidE ltkhid "Note context invalid ltkhid"
                 _ -> throwE "Local context isn't a ticket route"
         else return $ Right uContext
 
@@ -735,15 +747,25 @@ data RemoteRecipient = RemoteRecipient
 -- * Insert activity to inboxes of actors
 -- * If collections are listed, insert activity to the local members and return
 --   the remote members
-deliverLocal'
-    :: Bool -- ^ Whether to deliver to collection only if owner actor is addressed
-    -> LocalActor
-    -> InboxId
-    -> OutboxItemId
+insertActivityToLocalInboxes
+    :: PersistRecordBackend record SqlBackend
+    => (InboxId -> InboxItemId -> record)
+    -- ^ Database record to insert as an new inbox item to each inbox
+    -> Bool
+    -- ^ Whether to deliver to collection only if owner actor is addressed
+    -> Maybe LocalActor
+    -- ^ An actor whose collections are excluded from requiring an owner, i.e.
+    --   even if owner is required, this actor's collections will be delivered
+    --   to, even if this actor isn't addressed. This is meant to be the
+    --   activity's author.
+    -> Maybe InboxId
+    -- ^ A user person's inbox to exclude from delivery, even if this person is
+    --   listed in the recipient set. This is meant to be the activity's
+    --   author.
     -> LocalRecipientSet
     -> AppDB [((InstanceId, Host), NonEmpty RemoteRecipient)]
-deliverLocal' requireOwner author ibidAuthor obiid recips = do
-    ibidsSharer <- L.delete ibidAuthor <$> getSharerInboxes recips
+insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor recips = do
+    ibidsSharer <- deleteAuthor <$> getSharerInboxes recips
     ibidsOther <- concat <$> traverse getOtherInboxes recips
 
     (ibidsFollowers, remotesFollowers) <- do
@@ -754,13 +776,23 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
 
     ibidsTeams <- foldl' LO.union [] <$> traverse getTeams recips
 
-    let ibids = L.delete ibidAuthor (ibidsFollowers `LO.union` ibidsTeams `LO.union` ibidsSharer) ++ ibidsOther
+    let ibids = deleteAuthor (ibidsFollowers `LO.union` ibidsTeams `LO.union` ibidsSharer) ++ ibidsOther
     ibiids <- insertMany $ replicate (length ibids) $ InboxItem True
-    insertMany_ $
-        map (\ (ibid, ibiid) -> InboxItemLocal ibid obiid ibiid)
-            (zip ibids ibiids)
+    insertMany_ $ zipWith makeInboxItem ibids ibiids
     return remotesFollowers
     where
+    isAuthor :: LocalActor -> Bool
+    isAuthor =
+        case mauthor of
+            Nothing -> const False
+            Just author -> (== author)
+
+    deleteAuthor :: [InboxId] -> [InboxId]
+    deleteAuthor =
+        case mibidAuthor of
+            Nothing -> id
+            Just ibidAuthor -> L.delete ibidAuthor
+
     getSharerInboxes :: LocalRecipientSet -> AppDB [InboxId]
     getSharerInboxes sharers = do
         let shrs =
@@ -801,7 +833,7 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
                 [shr | (shr, s) <- sharers
                      , let d = localRecipSharerDirect s
                        in  localRecipSharerFollowers d &&
-                           (localRecipSharer d || not requireOwner || LocalActorSharer shr == author)
+                           (localRecipSharer d || not requireOwner || isAuthor (LocalActorSharer shr))
                 ]
         sids <- selectKeysList [SharerIdent <-. shrs] []
         map (personFollowers . entityVal) <$> selectList [PersonIdent <-. sids] []
@@ -838,7 +870,7 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
                     [prj | (prj, j) <- projects
                          , let d = localRecipProjectDirect j
                            in  localRecipProjectFollowers d &&
-                               (localRecipProject d || not requireOwner || LocalActorProject shr prj == author)
+                               (localRecipProject d || not requireOwner || isAuthor (LocalActorProject shr prj))
                     ]
             fsidsJ <-
                 map (projectFollowers . entityVal) <$>
@@ -848,7 +880,7 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
                         then
                             [ (prj, localRecipProjectTicketRelated j)
                                 | (prj, j) <- projects
-                                , localRecipProject (localRecipProjectDirect j) || LocalActorProject shr prj == author
+                                , localRecipProject (localRecipProjectDirect j) || isAuthor (LocalActorProject shr prj)
                             ]
                         else
                             map (second localRecipProjectTicketRelated) projects
@@ -882,7 +914,7 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
                     [rp | (rp, r) <- repos
                         , let d = localRecipRepoDirect r
                           in  localRecipRepoFollowers d &&
-                              (localRecipRepo d || not requireOwner || LocalActorRepo shr rp == author)
+                              (localRecipRepo d || not requireOwner || isAuthor (LocalActorRepo shr rp))
                     ]
             in  map (repoFollowers . entityVal) <$>
                     selectList [RepoSharer ==. sid, RepoIdent <-. rps] []
@@ -935,7 +967,7 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
         getProjectTeams sid projects = do
             let prjs =
                     [prj | (prj, LocalProjectRelatedSet d ts) <- projects
-                         , (localRecipProject d || not requireOwner || LocalActorProject shr prj == author) &&
+                         , (localRecipProject d || not requireOwner || isAuthor (LocalActorProject shr prj)) &&
                            (localRecipProjectTeam d || any (localRecipTicketTeam . snd) ts)
                     ]
             jids <- selectKeysList [ProjectSharer ==. sid, ProjectIdent <-. prjs] []
@@ -946,8 +978,36 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
                     [rp | (rp, r) <- repos
                         , let d = localRecipRepoDirect r
                           in  localRecipRepoTeam d &&
-                              (localRecipRepo d || not requireOwner || LocalActorRepo shr rp == author)
+                              (localRecipRepo d || not requireOwner || isAuthor (LocalActorRepo shr rp))
                     ]
             rids <- selectKeysList [RepoSharer ==. sid, RepoIdent <-. rps] []
             pids <- map (repoCollabPerson . entityVal) <$> selectList [RepoCollabRepo <-. rids] []
             map (personInbox . entityVal) <$> selectList [PersonId <-. pids] [Asc PersonInbox]
+
+-- | Given a list of local recipients, which may include actors and
+-- collections,
+--
+-- * Insert activity to inboxes of actors
+-- * If collections are listed, insert activity to the local members and return
+--   the remote members
+deliverLocal'
+    :: Bool -- ^ Whether to deliver to collection only if owner actor is addressed
+    -> LocalActor
+    -> InboxId
+    -> OutboxItemId
+    -> LocalRecipientSet
+    -> AppDB [((InstanceId, Host), NonEmpty RemoteRecipient)]
+deliverLocal' requireOwner author ibidAuthor obiid =
+    insertActivityToLocalInboxes makeItem requireOwner (Just author) (Just ibidAuthor)
+    where
+    makeItem ibid ibiid = InboxItemLocal ibid obiid ibiid
+
+insertRemoteActivityToLocalInboxes
+    :: Bool
+    -> RemoteActivityId
+    -> LocalRecipientSet
+    -> AppDB [((InstanceId, Host), NonEmpty RemoteRecipient)]
+insertRemoteActivityToLocalInboxes requireOwner ractid =
+    insertActivityToLocalInboxes makeItem requireOwner Nothing Nothing
+    where
+    makeItem ibid ibiid = InboxItemRemote ibid ractid ibiid

src/Vervis/Federation/Discussion.hs

@@ -27,6 +27,7 @@ import Control.Monad.Trans.Except
 import Control.Monad.Trans.Maybe
 import Data.Bifunctor
 import Data.ByteString (ByteString)
+import Data.Either
 import Data.Foldable
 import Data.Function
 import Data.List (sort, deleteBy, nub, union, unionBy, partition)
@@ -55,6 +56,7 @@ import Web.ActivityPub
 import Yesod.ActivityPub
 import Yesod.FedURI
 import Yesod.Hashids
+import Yesod.MonadSite
 
 import Control.Monad.Trans.Except.Local
 import Data.Tuple.Local
@@ -69,6 +71,7 @@ import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Settings
+import Vervis.Ticket
 
 sharerCreateNoteF
     :: UTCTime
@@ -101,56 +104,55 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext
             Right _ ->
                 Right <$> insertToInbox luCreate (personInbox personRecip)
     where
-    checkContextParent context mparent = runExceptT $ do
-        case context of
-            Left (shr, prj, ltkhid) -> do
-                mdid <- lift $ runMaybeT $ do
-                    sid <- MaybeT $ getKeyBy $ UniqueSharer shr
-                    jid <- MaybeT $ getKeyBy $ UniqueProject prj sid
-                    ltid <- decodeKeyHashidM ltkhid
-                    lt <- MaybeT $ get ltid
-                    tpl <-
-                        MaybeT $ getValBy $
-                            UniqueTicketProjectLocal $ localTicketTicket lt
-                    guard $ ticketProjectLocalProject tpl == jid
+    checkContextParent (Left context) mparent = runExceptT $ do
+        did <-
+            case context of
+                NoteContextSharerTicket shr talid -> do
+                    (_, Entity _ lt, _, project) <- do
+                        mticket <- lift $ getSharerTicket shr talid
+                        fromMaybeE mticket "Note context no such local sharer-hosted ticket"
                     return $ localTicketDiscuss lt
-                did <- fromMaybeE mdid "Context: No such local ticket"
-                for_ mparent $ \ parent ->
-                    case parent of
-                        Left (shrP, lmidP) ->
-                            void $ getLocalParentMessageId did shrP lmidP
-                        Right (ObjURI hParent luParent) -> do
-                            mrm <- lift $ runMaybeT $ do
-                                iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
-                                roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent
-                                MaybeT $ getValBy $ UniqueRemoteMessageIdent roid
-                            for_ mrm $ \ rm -> do
-                                let mid = remoteMessageRest rm
-                                m <- lift $ getJust mid
-                                unless (messageRoot m == did) $
-                                    throwE "Remote parent belongs to a different discussion"
-            Right (ObjURI hContext luContext) -> do
-                mdid <- lift $ runMaybeT $ do
-                    iid <- MaybeT $ getKeyBy $ UniqueInstance hContext
-                    roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luContext
-                    rd <- MaybeT $ getValBy $ UniqueRemoteDiscussionIdent roid
-                    return $ remoteDiscussionDiscuss rd
-                for_ mparent $ \ parent ->
-                    case parent of
-                        Left (shrP, lmidP) -> do
-                            did <- fromMaybeE mdid "Local parent inexistent, no RemoteDiscussion"
-                            void $ getLocalParentMessageId did shrP lmidP
-                        Right (ObjURI hParent luParent) -> do
-                            mrm <- lift $ runMaybeT $ do
-                                iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
-                                roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent
-                                MaybeT $ getValBy $ UniqueRemoteMessageIdent roid
-                            for_ mrm $ \ rm -> do
-                                let mid = remoteMessageRest rm
-                                m <- lift $ getJust mid
-                                did <- fromMaybeE mdid "Remote parent known, but no context RemoteDiscussion"
-                                unless (messageRoot m == did) $
-                                    throwE "Remote parent belongs to a different discussion"
+                NoteContextProjectTicket shr prj ltid -> do
+                    (_, _, _, Entity _ lt, _, _) <- do
+                        mticket <- lift $ getProjectTicket shr prj ltid
+                        fromMaybeE mticket "Note context no such local project-hosted ticket"
+                    return $ localTicketDiscuss lt
+        for_ mparent $ \ parent ->
+            case parent of
+                Left (shrP, lmidP) ->
+                    void $ getLocalParentMessageId did shrP lmidP
+                Right (ObjURI hParent luParent) -> do
+                    mrm <- lift $ runMaybeT $ do
+                        iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
+                        roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent
+                        MaybeT $ getValBy $ UniqueRemoteMessageIdent roid
+                    for_ mrm $ \ rm -> do
+                        let mid = remoteMessageRest rm
+                        m <- lift $ getJust mid
+                        unless (messageRoot m == did) $
+                            throwE "Remote parent belongs to a different discussion"
+    checkContextParent (Right (ObjURI hContext luContext)) mparent = runExceptT $ do
+        mdid <- lift $ runMaybeT $ do
+            iid <- MaybeT $ getKeyBy $ UniqueInstance hContext
+            roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luContext
+            rd <- MaybeT $ getValBy $ UniqueRemoteDiscussionIdent roid
+            return $ remoteDiscussionDiscuss rd
+        for_ mparent $ \ parent ->
+            case parent of
+                Left (shrP, lmidP) -> do
+                    did <- fromMaybeE mdid "Local parent inexistent, no RemoteDiscussion"
+                    void $ getLocalParentMessageId did shrP lmidP
+                Right (ObjURI hParent luParent) -> do
+                    mrm <- lift $ runMaybeT $ do
+                        iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
+                        roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent
+                        MaybeT $ getValBy $ UniqueRemoteMessageIdent roid
+                    for_ mrm $ \ rm -> do
+                        let mid = remoteMessageRest rm
+                        m <- lift $ getJust mid
+                        did <- fromMaybeE mdid "Remote parent known, but no context RemoteDiscussion"
+                        unless (messageRoot m == did) $
+                            throwE "Remote parent belongs to a different discussion"
     insertToInbox luCreate ibidRecip = do
         let iidAuthor = remoteAuthorInstance author
         roid <-
@@ -167,12 +169,6 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext
                 return $ "Activity already exists in inbox of /s/" <> recip
             Just _ -> return $ "Activity inserted to inbox of /s/" <> recip
 
-data CreateNoteRecipColl
-    = CreateNoteRecipProjectFollowers
-    | CreateNoteRecipTicketParticipants
-    | CreateNoteRecipTicketTeam
-    deriving Eq
-
 projectCreateNoteF
     :: UTCTime
     -> ShrIdent
@@ -195,84 +191,94 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
                 if uParent == uContext
                     then return Nothing
                     else Just <$> parseParent uParent
+    (localRecips, _remoteRecips) <- do
+        mrecips <- parseAudience $ activityAudience $ actbActivity body
+        fromMaybeE mrecips "Create Note with no recipients"
+    msig <- checkForward shrRecip prjRecip
     case context of
-        Right _ -> return $ recip <> " not using; context isn't local"
-        Left (shr, prj, ltkhid) ->
-            if shr /= shrRecip || prj /= prjRecip
-                then return $ recip <> " not using; context is a different project"
-                else do
-                    msig <- checkForward shrRecip prjRecip
-                    hLocal <- getsYesod $ appInstanceHost . appSettings
-                    let colls =
-                            findRelevantCollections hLocal ltkhid $
-                                activityAudience $ actbActivity body
-                    mremotesHttp <- runDBExcept $ do
-                        (sid, fsidProject, fsidTicket, jid, ibid, did, meparent) <- getContextAndParent ltkhid mparent
-                        lift $ join <$> do
-                            mmid <- insertToDiscussion luCreate luNote published ibid did meparent fsidTicket
-                            for mmid $ \ (ractid, mid) -> do
-                                updateOrphans luNote did mid
-                                for msig $ \ sig -> do
-                                    remoteRecips <- deliverLocal ractid colls sid fsidProject fsidTicket
-                                    (sig,) <$> deliverRemoteDB (actbBL body) ractid jid sig remoteRecips
-                    lift $ for_ mremotesHttp $ \ (sig, remotesHttp) -> do
-                        let handler e = logError $ "Project inbox handler: delivery failed! " <> T.pack (displayException e)
-                        forkHandler handler $
-                            deliverRemoteHTTP now shrRecip prjRecip (actbBL body) sig remotesHttp
-                    return $ recip <> " inserted new ticket comment"
+        Right _ -> return "Not using; context isn't local"
+        Left (NoteContextSharerTicket shr talid) -> do
+            mremotesHttp <- runDBExcept $ do
+                (jid, ibid) <- lift getProjectRecip404
+                (_, _, _, project) <- do
+                    mticket <- lift $ getSharerTicket shr talid
+                    fromMaybeE mticket "Context: No such sharer-ticket"
+                case project of
+                    Left (Entity _ tpl)
+                        | ticketProjectLocalProject tpl == jid -> do
+                            mractid <- lift $ insertToProjectInbox ibid luCreate
+                            case mractid of
+                                Nothing -> return $ Left "Activity already in my inbox"
+                                Just ractid ->
+                                    case msig of
+                                        Nothing ->
+                                            return $ Left
+                                                "Context is a sharer-ticket, \
+                                                \but no inbox forwarding \
+                                                \header for me, so doing \
+                                                \nothing, just storing in inbox"
+                                        Just sig -> lift $ Right <$> do
+                                            let sieve =
+                                                    makeRecipientSet
+                                                        []
+                                                        [ LocalPersonCollectionProjectFollowers shrRecip prjRecip
+                                                        , LocalPersonCollectionProjectTeam shrRecip prjRecip
+                                                        ]
+                                            remoteRecips <- insertRemoteActivityToLocalInboxes False ractid $ localRecipSieve' sieve False False localRecips
+                                            (sig,) <$> deliverRemoteDB (actbBL body) ractid jid sig remoteRecips
+                    _ -> return $ Left "Context is a sharer-ticket of another project"
+            case mremotesHttp of
+                Left msg -> return msg
+                Right (sig, remotesHttp) -> do
+                    forkWorker "projectCreateNoteF inbox forwarding by http" $ deliverRemoteHTTP now shrRecip prjRecip (actbBL body) sig remotesHttp
+                    return "Stored to inbox and did inbox forwarding"
+        Left (NoteContextProjectTicket shr prj ltid) -> do
+            mremotesHttp <- runDBExcept $ do
+                (jid, ibid) <- lift getProjectRecip404
+                (_, _, _, Entity _ lt, Entity _ tpl, _) <- do
+                    mticket <- lift $ getProjectTicket shr prj ltid
+                    fromMaybeE mticket "Context: No such project-ticket"
+                if ticketProjectLocalProject tpl == jid
+                    then do
+                        mractid <- lift $ insertToProjectInbox ibid luCreate
+                        case mractid of
+                            Nothing -> return $ Left "Activity already in my inbox"
+                            Just ractid -> do
+                                let did = localTicketDiscuss lt
+                                meparent <- traverse (getParent did) mparent
+                                mmid <- lift $ insertToDiscussion luNote published did meparent ractid
+                                case mmid of
+                                    Nothing -> return $ Left "I already have this comment, just storing in inbox"
+                                    Just mid -> lift $ do
+                                        updateOrphans luNote did mid
+                                        case msig of
+                                            Nothing ->
+                                                return $ Left "Storing in inbox, caching comment, no inbox forwarding header"
+                                            Just sig -> Right <$> do
+                                                ltkhid <- encodeKeyHashid ltid
+                                                let sieve =
+                                                        makeRecipientSet
+                                                            []
+                                                            [ LocalPersonCollectionProjectFollowers shrRecip prjRecip
+                                                            , LocalPersonCollectionProjectTeam shrRecip prjRecip
+                                                            , LocalPersonCollectionProjectTicketFollowers shrRecip prjRecip ltkhid
+                                                            , LocalPersonCollectionProjectTicketTeam shrRecip prjRecip ltkhid
+                                                            ]
+                                                remoteRecips <- insertRemoteActivityToLocalInboxes False ractid $ localRecipSieve' sieve False False localRecips
+                                                (sig,) <$> deliverRemoteDB (actbBL body) ractid jid sig remoteRecips
+                    else return $ Left "Context is a project-ticket of another project"
+            case mremotesHttp of
+                Left msg -> return msg
+                Right (sig, remotesHttp) -> do
+                    forkWorker "projectCreateNoteF inbox forwarding by http" $ deliverRemoteHTTP now shrRecip prjRecip (actbBL body) sig remotesHttp
+                    return "Stored to inbox, cached comment, and did inbox forwarding"
     where
-    findRelevantCollections hLocal ctx = nub . mapMaybe decide . concatRecipients
-        where
-        decide u = do
-            let ObjURI h lu = u
-            guard $ h == hLocal
-            route <- decodeRouteLocal lu
-            case route of
-                ProjectFollowersR shr prj
-                    | shr == shrRecip && prj == prjRecip
-                        -> Just CreateNoteRecipProjectFollowers
-                ProjectTicketParticipantsR shr prj tkhid
-                    | shr == shrRecip && prj == prjRecip && tkhid == ctx
-                        -> Just CreateNoteRecipTicketParticipants
-                ProjectTicketTeamR shr prj tkhid
-                    | shr == shrRecip && prj == prjRecip && tkhid == ctx
-                        -> Just CreateNoteRecipTicketTeam
-                _ -> Nothing
-    recip = T.concat ["/s/", shr2text shrRecip, "/p/", prj2text prjRecip]
-    getContextAndParent ltkhid mparent = do
-        mt <- do
-            sid <- lift $ getKeyBy404 $ UniqueSharer shrRecip
-            Entity jid j <- lift $ getBy404 $ UniqueProject prjRecip sid
-            ltid <- decodeKeyHashidE ltkhid "Context: Not a valid ticket khid"
-            mlt <- lift $ get ltid
-            for mlt $ \ lt -> do
-                mtpl <- lift $ getValBy $ UniqueTicketProjectLocal $ localTicketTicket lt
-                tpl <- fromMaybeE mtpl "No TPL"
-                unless (ticketProjectLocalProject tpl == jid) $
-                    throwE "Context: Local ticket khid belongs to different project"
-                return (jid, projectInbox j, projectFollowers j, sid, lt)
-        (jid, ibid, fsidProject, sid, lt) <- fromMaybeE mt "Context: No such local ticket"
-        let did = localTicketDiscuss lt
-        meparent <- for mparent $ \ parent ->
-            case parent of
-                Left (shrParent, lmidParent) -> Left <$> getLocalParentMessageId did shrParent lmidParent
-                Right p@(ObjURI hParent luParent) -> do
-                    mrm <- lift $ runMaybeT $ do
-                        iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
-                        roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent
-                        MaybeT $ getValBy $ UniqueRemoteMessageIdent roid
-                    case mrm of
-                        Just rm -> Left <$> do
-                            let mid = remoteMessageRest rm
-                            m <- lift $ getJust mid
-                            unless (messageRoot m == did) $
-                                throwE "Remote parent belongs to a different discussion"
-                            return mid
-                        Nothing -> return $ Right p
-        return (sid, fsidProject, localTicketFollowers lt, jid, ibid, did, meparent)
-    insertToDiscussion luCreate luNote published ibid did meparent fsid = do
+    getProjectRecip404 = do
+        sid <- getKeyBy404 $ UniqueSharer shrRecip
+        Entity jid j <- getBy404 $ UniqueProject prjRecip sid
+        return (jid, projectInbox j)
+    insertToProjectInbox ibid luCreate = do
         let iidAuthor = remoteAuthorInstance author
-            raidAuthor = remoteAuthorId author
         roid <-
             either entityKey id <$> insertBy' (RemoteObject iidAuthor luCreate)
         ractid <- either entityKey id <$> insertBy' RemoteActivity
@@ -280,6 +286,29 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
             , remoteActivityContent  = persistJSONFromBL $ actbBL body
             , remoteActivityReceived = now
             }
+        ibiid <- insert $ InboxItem False
+        new <- isRight <$> insertBy' (InboxItemRemote ibid ractid ibiid)
+        return $
+            if new
+                then Just ractid
+                else Nothing
+    getParent did (Left (shrParent, lmidParent)) = Left <$> getLocalParentMessageId did shrParent lmidParent
+    getParent did (Right p@(ObjURI hParent luParent)) = do
+        mrm <- lift $ runMaybeT $ do
+            iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
+            roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent
+            MaybeT $ getValBy $ UniqueRemoteMessageIdent roid
+        case mrm of
+            Just rm -> Left <$> do
+                let mid = remoteMessageRest rm
+                m <- lift $ getJust mid
+                unless (messageRoot m == did) $
+                    throwE "Remote parent belongs to a different discussion"
+                return mid
+            Nothing -> return $ Right p
+    insertToDiscussion luNote published did meparent ractid = do
+        let iidAuthor = remoteAuthorInstance author
+            raidAuthor = remoteAuthorId author
         mid <- insert Message
             { messageCreated = published
             , messageSource  = src
@@ -290,11 +319,11 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
                     _                     -> Nothing
             , messageRoot    = did
             }
-        roid2 <-
+        roidNote <-
             either entityKey id <$> insertBy' (RemoteObject iidAuthor luNote)
         mrmid <- insertUnique RemoteMessage
             { remoteMessageAuthor     = raidAuthor
-            , remoteMessageIdent      = roid2
+            , remoteMessageIdent      = roidNote
             , remoteMessageRest       = mid
             , remoteMessageCreate     = ractid
             , remoteMessageLostParent =
@@ -306,11 +335,7 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
             Nothing -> do
                 delete mid
                 return Nothing
-            Just _ -> do
-                -- insertUnique_ $ RemoteFollow raidAuthor fsid False True
-                ibiid <- insert $ InboxItem False
-                insert_ $ InboxItemRemote ibid ractid ibiid
-                return $ Just (ractid, mid)
+            Just _ -> return $ Just mid
     updateOrphans luNote did mid = do
         let hAuthor = objUriAuthority $ remoteAuthorURI author
             uNote = ObjURI hAuthor luNote
@@ -341,32 +366,3 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
                     rm E.^. RemoteMessageLostParent E.==. E.just (E.val uNote) E.&&.
                     m E.^. MessageRoot `op` E.val did
                 return (rm E.^. RemoteMessageId, m E.^. MessageId)
-    deliverLocal
-        :: RemoteActivityId
-        -> [CreateNoteRecipColl]
-        -> SharerId
-        -> FollowerSetId
-        -> FollowerSetId
-        -> AppDB [((InstanceId, Host), NonEmpty RemoteRecipient)]
-    deliverLocal ractid recips sid fsidProject fsidTicket = do
-        (teamPids, teamRemotes) <-
-            if CreateNoteRecipTicketTeam `elem` recips
-                then getTicketTeam sid
-                else return ([], [])
-        (tfsPids, tfsRemotes) <-
-            if CreateNoteRecipTicketParticipants `elem` recips
-                then getFollowers fsidTicket
-                else return ([], [])
-        (jfsPids, jfsRemotes) <-
-            if CreateNoteRecipProjectFollowers `elem` recips
-                then getFollowers fsidProject
-                else return ([], [])
-        let pids = union teamPids tfsPids `union` jfsPids
-            remotes = teamRemotes `unionRemotes` tfsRemotes `unionRemotes` jfsRemotes
-        for_ pids $ \ pid -> do
-            ibid <- personInbox <$> getJust pid
-            ibiid <- insert $ InboxItem True
-            mibrid <- insertUnique $ InboxItemRemote ibid ractid ibiid
-            when (isNothing mibrid) $
-                delete ibiid
-        return remotes