diff --git a/src/Vervis/Federation/Discussion.hs b/src/Vervis/Federation/Discussion.hs index 52ee746..91b0b41 100644 --- a/src/Vervis/Federation/Discussion.hs +++ b/src/Vervis/Federation/Discussion.hs @@ -16,7 +16,7 @@ module Vervis.Federation.Discussion ( personCreateNoteF , deckCreateNoteF - --, loomCreateNoteF + , loomCreateNoteF ) where @@ -309,65 +309,71 @@ deckCreateNoteF now recipDeckHash author body mfwd luCreate note = do forkWorker "projectCreateNoteF inbox-forwarding" forwardHttp return "Stored to inbox, cached comment, and did inbox forwarding" -{- -repoCreateNoteF +loomCreateNoteF :: UTCTime - -> KeyHashid Repo + -> KeyHashid Loom -> RemoteAuthor -> ActivityBody - -> Maybe (LocalRecipientSet, ByteString) + -> Maybe (RecipientRoutes, ByteString) -> LocalURI - -> Note URIMode + -> AP.Note URIMode -> ExceptT Text Handler Text -repoCreateNoteF now repoRecip author body mfwd luCreate note = do - (luNote, published, context, mparent, source, content) <- checkNote note - case context of - Right _ -> return "Not using; context isn't local" - Left (NoteContextProjectTicket _ _ _) -> - return "Context is a project-ticket, ignoring activity" - Left (NoteContextRepoProposal shr rp ltid) -> do - mremotesHttp <- runDBExcept $ do - (rid, ibid) <- lift getRepoRecip404 - (_, _, _, Entity _ lt, _, Entity _ trl, _, _, _) <- do - mticket <- lift $ getRepoProposal shr rp ltid - fromMaybeE mticket "Context: No such repo-patch" - if ticketRepoLocalRepo trl == rid - then do - mractid <- lift $ insertToInbox now author body ibid luCreate False - 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 author luNote published source content did meparent ractid - case mmid of - Nothing -> return $ Left "I already have this comment, just storing in inbox" - Just mid -> lift $ do - updateOrphans author luNote did mid - case mfwd of - Nothing -> - return $ Left "Storing in inbox, caching comment, no inbox forwarding header" - Just (localRecips, sig) -> Right <$> do - ltkhid <- encodeKeyHashid ltid - let sieve = - makeRecipientSet - [] - [ LocalPersonCollectionRepoFollowers shrRecip rpRecip - , LocalPersonCollectionRepoTeam shrRecip rpRecip - , LocalPersonCollectionRepoProposalFollowers shrRecip rpRecip ltkhid - --, LocalPersonCollectionProjectTicketTeam shrRecip prjRecip ltkhid - ] - remoteRecips <- insertRemoteActivityToLocalInboxes False ractid $ localRecipSieve' sieve False False localRecips - (sig,) <$> deliverRemoteDB_R (actbBL body) ractid rid sig remoteRecips - else return $ Left "Context is a repo-patch of another repo" - case mremotesHttp of - Left msg -> return msg - Right (sig, remotesHttp) -> do - forkWorker "repoCreateNoteF inbox forwarding by http" $ deliverRemoteHTTP_R now shrRecip rpRecip (actbBL body) sig remotesHttp - return "Stored to inbox, cached comment, and did inbox forwarding" - where - getRepoRecip404 = do - sid <- getKeyBy404 $ UniqueSharer shrRecip - Entity rid r <- getBy404 $ UniqueRepo rpRecip sid - return (rid, repoInbox r) --} +loomCreateNoteF now recipLoomHash author body mfwd luCreate note = do + + recipLoomID <- decodeKeyHashid404 recipLoomHash + (luNote, published, Comment maybeParent topic source content) <- do + (luId, luAuthor, published, comment) <- parseRemoteComment note + unless (luAuthor == objUriLocal (remoteAuthorURI author)) $ + throwE "Create author != note author" + return (luId, published, comment) + + case topic of + Right _ -> + pure "Topic is remote, i.e. not mine, so ignoring activity" + Left (CommentTopicTicket _ _) -> + pure "Topic is a local issue, i.e. not mine, so ignoring activity" + Left (CommentTopicCloth loomID clothID) + | loomID /= recipLoomID -> + pure "Topic is some other loom's MR, so ignoring activity" + | otherwise -> do + msgOrForward <- runDBExcept $ do + + Entity recipActorID recipActor <- lift $ do + loom <- get404 recipLoomID + let actorID = loomActor loom + Entity actorID <$> getJust actorID + + (_l, _tl, Entity _ ticket, _a, _r, _) <- do + mcloth <- lift $ getCloth recipLoomID clothID + fromMaybeE mcloth "Topic: No such cloth in DB" + + mractid <- lift $ insertToInbox now author body (actorInbox recipActor) luCreate False + case mractid of + Nothing -> return $ Left "Activity already in my inbox" + Just createID -> do + let did = ticketDiscuss ticket + meparent <- traverse (getMessageParent did) maybeParent + mmid <- lift $ insertToDiscussion author luNote published source content did meparent createID + case mmid of + Nothing -> return $ Left "I already have this comment, just storing in inbox" + Just mid -> lift $ do + updateOrphans author luNote did mid + case mfwd of + Nothing -> + return $ Left "Storing in inbox, caching comment, no inbox forwarding header" + Just (localRecips, sig) -> Right <$> do + clothHash <- encodeKeyHashid clothID + let sieve = + makeRecipientSet + [] + [ LocalStageLoomFollowers recipLoomHash + , LocalStageClothFollowers recipLoomHash clothHash + ] + forwardActivityDB + (actbBL body) localRecips sig recipActorID + (LocalActorLoom recipLoomHash) sieve createID + case msgOrForward of + Left msg -> return msg + Right forwardHttp -> do + forkWorker "projectCreateNoteF inbox-forwarding" forwardHttp + return "Stored to inbox, cached comment, and did inbox forwarding" diff --git a/src/Vervis/Handler/Deck.hs b/src/Vervis/Handler/Deck.hs index 680ca9a..59ace3e 100644 --- a/src/Vervis/Handler/Deck.hs +++ b/src/Vervis/Handler/Deck.hs @@ -189,7 +189,7 @@ postDeckInboxR recipDeckHash = case obj of AP.CreateNote _ note -> (,Nothing) <$> deckCreateNoteF now recipDeckHash author body mfwd luActivity note - _ -> error "Unsupported create object type for decks" + _ -> return ("Unsupported create object type for decks", Nothing) {- FollowActivity follow -> (,Nothing) <$> projectFollowF shrRecip prjRecip now remoteAuthor body mfwd luActivity follow diff --git a/src/Vervis/Handler/Loom.hs b/src/Vervis/Handler/Loom.hs index aace0ad..ec54906 100644 --- a/src/Vervis/Handler/Loom.hs +++ b/src/Vervis/Handler/Loom.hs @@ -77,6 +77,7 @@ import Vervis.Access import Vervis.API import Vervis.Federation.Auth import Vervis.Federation.Collab +import Vervis.Federation.Discussion import Vervis.Federation.Ticket import Vervis.FedURI import Vervis.Form.Project @@ -152,6 +153,11 @@ postLoomInboxR recipLoomHash = loomAcceptF now recipLoomHash author body mfwd luActivity accept AP.ApplyActivity apply-> loomApplyF now recipLoomHash author body mfwd luActivity apply + AP.CreateActivity (AP.Create obj _mtarget) -> + case obj of + AP.CreateNote _ note -> + (,Nothing) <$> loomCreateNoteF now recipLoomHash author body mfwd luActivity note + _ -> return ("Unsupported create object type for looms", Nothing) AP.InviteActivity invite -> topicInviteF now (GrantResourceLoom recipLoomHash) author body mfwd luActivity invite AP.OfferActivity (AP.Offer obj target) ->