From b23741f1febb259baa7c199b7f58abe78412d965 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Tue, 22 Oct 2019 10:28:35 +0000 Subject: [PATCH] S2S: Store relevant Push activities in recipient's inbox Before, Push activities were being ignored by all inboxes. I just forgot to add code to handle them. Now, person inboxes accept them if they're about a relevant repo (i.e. a repo of which the user is a remote follower; remote collaboration would be relevant too, but it's not implemented yet). --- src/Vervis/Federation.hs | 3 + src/Vervis/Federation/Push.hs | 111 ++++++++++++++++++++++++++++++++++ src/Vervis/Handler/Repo.hs | 1 + src/Web/ActivityPub.hs | 5 +- vervis.cabal | 1 + 5 files changed, 120 insertions(+), 1 deletion(-) create mode 100644 src/Vervis/Federation/Push.hs diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs index 6e8e8c3..540e0f4 100644 --- a/src/Vervis/Federation.hs +++ b/src/Vervis/Federation.hs @@ -97,6 +97,7 @@ import Vervis.ActorKey import Vervis.Federation.Auth import Vervis.Federation.Discussion import Vervis.Federation.Offer +import Vervis.Federation.Push import Vervis.Federation.Ticket import Vervis.Foundation import Vervis.Model @@ -271,6 +272,8 @@ handleSharerInbox now shrRecip (ActivityAuthRemote author) body = sharerFollowF shrRecip now author body follow OfferActivity offer -> sharerOfferTicketF now shrRecip author body offer + PushActivity push -> + sharerPushF shrRecip now author body push RejectActivity reject -> sharerRejectF shrRecip now author body reject UndoActivity undo -> diff --git a/src/Vervis/Federation/Push.hs b/src/Vervis/Federation/Push.hs new file mode 100644 index 0000000..6058f5b --- /dev/null +++ b/src/Vervis/Federation/Push.hs @@ -0,0 +1,111 @@ +{- This file is part of Vervis. + - + - Written in 2019 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +module Vervis.Federation.Push + ( sharerPushF + ) +where + +--import Control.Exception hiding (Handler) +--import Control.Monad +--import Control.Monad.Logger.CallStack +import Control.Monad.Trans.Class +import Control.Monad.Trans.Except +--import Control.Monad.Trans.Maybe +--import Data.Aeson +--import Data.Bifunctor +--import Data.Foldable +--import Data.Function +--import Data.List (nub, union) +--import Data.List.NonEmpty (NonEmpty (..)) +import Data.Maybe +import Data.Text (Text) +--import Data.Time.Calendar +import Data.Time.Clock +--import Data.Traversable +import Database.Persist +--import Text.Blaze.Html (preEscapedToHtml) +--import Text.Blaze.Html.Renderer.Text +--import Yesod.Core hiding (logError, logWarn, logInfo, logDebug) +--import Yesod.Core.Handler +import Yesod.Persist.Core + +--import qualified Data.List.NonEmpty as NE +--import qualified Data.List.Ordered as LO +--import qualified Data.Text as T +--import qualified Data.Text.Lazy as TL + +import Database.Persist.JSON +import Network.FedURI +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 +import Database.Persist.Local +import Yesod.Persist.Local + +--import Vervis.ActivityPub +import Vervis.FedURI +import Vervis.Federation.Auth +import Vervis.Foundation +import Vervis.Model +import Vervis.Model.Ident + +sharerPushF + :: ShrIdent + -> UTCTime + -> RemoteAuthor + -> ActivityBody + -> Push URIMode + -> ExceptT Text Handler Text +sharerPushF shr now author body push = do + luPush <- fromMaybeE (activityId $ actbActivity body) "Push without 'id'" + lift $ runDB $ do + Entity pidRecip recip <- do + sid <- getKeyBy404 $ UniqueSharer shr + getBy404 $ UniquePersonIdent sid + let hAuthor = objUriAuthority $ remoteAuthorURI author + luRepo = pushContext push + mfr <- getBy $ UniqueFollowRemote pidRecip (ObjURI hAuthor luRepo) + if isNothing mfr + then return "Got a Push to a repo unrelated to me; ignoring" + else do + mractid <- insertToInbox luPush $ personInbox recip + encodeRouteLocal <- getEncodeRouteLocal + let me = localUriPath $ encodeRouteLocal $ SharerR shr + return $ + case mractid of + Nothing -> + "Activity already exists in inbox of " <> me + Just ractid -> + "Activity inserted to inbox of " <> me + where + insertToInbox luPush ibidRecip = do + let iidAuthor = remoteAuthorInstance author + jsonObj = persistJSONFromBL $ actbBL body + ract = RemoteActivity iidAuthor luPush jsonObj now + ractid <- either entityKey id <$> insertBy' ract + ibiid <- insert $ InboxItem True + mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid + encodeRouteLocal <- getEncodeRouteLocal + case mibrid of + Nothing -> do + delete ibiid + return Nothing + Just _ -> return $ Just ractid diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index f6f5667..698e8ef 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -562,6 +562,7 @@ postPostReceiveR = do case mbranch of Nothing -> RepoR shr rp Just b -> RepoBranchR shr rp b + , pushContext = encodeRouteLocal $ RepoR shr rp , pushHashBefore = mbefore , pushHashAfter = after } diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 61e899e..070f468 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -1124,6 +1124,7 @@ data Push u = Push , pushCommitsFirst :: Maybe (NonEmpty (Commit u)) , pushCommitsTotal :: Int , pushTarget :: LocalURI + , pushContext :: LocalURI , pushHashBefore :: Maybe Text , pushHashAfter :: Maybe Text } @@ -1136,11 +1137,12 @@ parsePush a o = do <*> (traverse (traverse $ withAuthorityT a . parseObject) =<< c .:? "earlyItems") <*> c .: "totalItems" <*> withAuthorityO a (o .: "target") + <*> withAuthorityO a (o .: "context") <*> o .:? "hashBefore" <*> o .:? "hashAfter" encodePush :: UriMode u => Authority u -> Push u -> Series -encodePush a (Push lateCommits earlyCommits total target before after) +encodePush a (Push lateCommits earlyCommits total target context before after) = "object" `pair` pairs ( "type" .= ("OrderedCollection" :: Text) <> pair "items" (objectList lateCommits) @@ -1148,6 +1150,7 @@ encodePush a (Push lateCommits earlyCommits total target before after) <> "totalItems" .= total ) <> "target" .= ObjURI a target + <> "context" .= ObjURI a context <> "hashBefore" .=? before <> "hashAfter" .=? after where diff --git a/vervis.cabal b/vervis.cabal index c389a26..ef48160 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -132,6 +132,7 @@ library Vervis.Federation.Auth Vervis.Federation.Discussion Vervis.Federation.Offer + Vervis.Federation.Push Vervis.Federation.Ticket Vervis.FedURI Vervis.Field.Key