diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index f689858..6a8b47f 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2019, 2020 by fr33domlover . + - Written in 2019, 2020, 2022 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -15,6 +15,7 @@ module Vervis.API ( addBundleC + , applyC , noteC , createNoteC , createTicketC @@ -108,15 +109,18 @@ import Yesod.Persist.Local import Vervis.ActivityPub import Vervis.ActivityPub.Recipient import Vervis.ActorKey +import Vervis.Darcs import Vervis.FedURI import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident +import Vervis.Model.Role import Development.PatchMediaType import Vervis.Model.Ticket import Vervis.RemoteActorStore import Vervis.Settings import Vervis.Patch +import Vervis.Query import Vervis.Ticket import Vervis.WorkItem @@ -323,6 +327,416 @@ addBundleC (Entity pidUser personUser) sharerUser summary audience patches uTarg Right (shr, rp, ltid) -> RepoProposalBundleR shr rp $ hashLTID ltid +applyC + :: Entity Person + -> Sharer + -> Maybe TextHtml + -> Audience URIMode + -> Maybe (ObjURI URIMode) + -> Apply URIMode + -> ExceptT Text Handler OutboxItemId +applyC (Entity pidUser personUser) sharerUser summary audience muCap (Apply uObject uTarget) = do + -- Verify the patch bundle URI is one of: + -- * A local sharer-hosted bundle + -- * A local repo-hosted bundle + -- * A remote URI + bundle <- parseProposalBundle "Apply object" uObject + + -- Identify local & remote recipients + -- Produce recipient list for public use, i.e. with BTO and BCC hidden + -- Produce list of hosts whom to authorize to inbox-forward our activity + ParsedAudience localRecips remoteRecips blinded fwdHosts <- do + mrecips <- parseAudience audience + fromMaybeE mrecips "Apply with no recipients" + + -- If remote recipients are specified, make sure federation is enabled + federation <- asksSite $ appFederation . appSettings + unless (federation || null remoteRecips) $ + throwE "Federation disabled, but remote recipients specified" + + -- Verify the apply's target is one of: + -- * A local repo + -- * A local repo's branch + -- * A remote URI + target <- checkBranch uTarget + + -- Verify the capability URI is one of: + -- * Outbox item URI of a local actor, i.e. a local activity + -- * A remote URI + capID <- do + uCap <- fromMaybeE muCap "Asking to apply patch but no capability provided" + parseActivityURI "Apply capability" uCap + + -- If target is remote, just proceed to send out the Apply activity + -- If target is a local repo/branch, consider to apply the patch(es) + mapplied <- case target of + Right _u -> return Nothing + + Left (shrTarget, rpTarget, mb) -> Just <$> do + + -- Find the target repo in DB + mrepo <- lift $ runDB $ runMaybeT $ do + sid <- MaybeT $ getKeyBy $ UniqueSharer shrTarget + MaybeT $ getBy $ UniqueRepo rpTarget sid + Entity ridTarget repoTarget <- fromMaybeE mrepo "Apply target: No such local repo in DB" + + -- Verify the repo is among the activity recipients + let repoRecipFound = do + sharerSet <- lookup shrTarget localRecips + repoSet <- lookup rpTarget $ localRecipRepoRelated sharerSet + guard $ localRecipRepo $ localRecipRepoDirect repoSet + fromMaybeE repoRecipFound "Target local repo isn't listed as a recipient" + + -- Check in DB whether the provided capability matches a DB + -- record we have, and that it gives the Apply author permission to + -- apply patches to the target repo + runDBExcept $ verifyCapability ridTarget capID + + -- Grab the bundle and its patches from DB or HTTP + -- Make sure the ticket it's attached to is listed under the repo + -- Make sure ticket isn't marked as resolved + -- Make sure the bundle is the latest version + (patches, mltid, ticketFollowers) <- + case bundle of + Left (Left (shr, talid, bnid)) -> do + + mticket <- lift $ runDB $ getSharerProposal shr talid + (_, Entity ltid _, _, context, mresolved, bnid' :| _) <- fromMaybeE mticket "Apply object: No such local ticket" + + case context of + Left (_, Entity _ trl) -> + unless (ticketRepoLocalRepo trl == ridTarget) $ + throwE "Apply object: Ticket under some other local repo" + Right _ -> throwE "Apply object: Ticket not under a local repo" + + _ <- fromMaybeE mresolved "Apply object: Proposal already applied" + + unless (bnid == bnid') $ + throwE "Apply object: Bundle isn't the latest version" + + let grabContent (Entity _ (Patch _ _ typ content)) = + (typ, content) + ps <- lift $ runDB $ selectList [PatchBundle ==. bnid] [Asc PatchId] + case ps of + [] -> error "Local sharer-bundle without any patches found" + p : l -> return (NE.map grabContent $ p :| l, Just ltid, Left $ Left (shr, talid)) + + Left (Right (shr, rp, ltid, bnid)) -> do + + unless (shr == shrTarget && rp == rpTarget) $ + throwE "Bundle's repo mismatches Apply target" + + mticket <- lift $ runDB $ getRepoProposal shrTarget rpTarget ltid + (_, _, _, _, _, _, _, mresolved, bnid' :| _) <- fromMaybeE mticket "Apply object: No such local ticket" + + _ <- fromMaybeE mresolved "Apply object: Proposal already applied" + + unless (bnid == bnid') $ + throwE "Apply object: Bundle isn't the latest version" + + let grabContent (Entity _ (Patch _ _ typ content)) = + (typ, content) + ps <- lift $ runDB $ selectList [PatchBundle ==. bnid] [Asc PatchId] + case ps of + [] -> error "Local repo-bundle without any patches found" + p : l -> return (NE.map grabContent $ p :| l, Just ltid, Left $ Right ltid) + + Right uBundle@(ObjURI hBundle luBundle) -> do + + manager <- asksSite appHttpManager + Doc h b <- withExceptT T.pack $ AP.fetchAP manager $ Left uBundle + (BundleLocal bid ctx _prevs mcurr, lus) <- + case b of + BundleHosted Nothing _ -> throwE "No bundle @id" + BundleHosted (Just l) ps -> return (l, ps) + BundleOffer _ _ -> throwE "Why does bundle contain patch objects" + unless (h == hBundle && bid == luBundle) $ + throwE "Bundle 'id' differs from the URI we fetched" + + for_ mcurr $ \ curr -> + throwE $ + if curr == bid + then "Bundle currentVersion points to itself" + else "Bundle isn't the latest version" + + let uTicket = ObjURI h ctx + Doc _ ticket <- withExceptT T.pack $ AP.fetchAP manager $ Left uTicket + (_, tlocal) <- fromMaybeE (AP.ticketLocal ticket) "Ticket has no @id" + (h', mr) <- fromMaybeE (AP.ticketAttachment ticket) "Ticket has no 'attachment'" + unless (ObjURI h' (mrTarget mr) == uTarget) $ + throwE "Ticket MR target isn't me / branch" + case mrBundle mr of + Left u -> + if u == uBundle + then pure () + else throwE "Bundle isn't the one pointed by ticket" + Right _ -> throwE "Ticket has bundle object instead of just URI" + + verifyNothingE (AP.ticketResolved ticket) "Apply object: Ticket already marked as resolved" + + e <- runDBExcept $ getRemoteTicketByURI uTicket + case e of + Right (_, _, _, _, _, Right (Entity _ trl)) + | ticketRepoLocalRepo trl == ridTarget -> pure () + _ -> throwE "Target repo doesn't have the ticket listed under it" + + let followers = + ObjURI hBundle $ AP.ticketParticipants tlocal + fmap (,Nothing,Right followers) $ for lus $ \ luPatch -> do + Doc _ (AP.Patch mlocal _luAttrib _mpub typ content) <- + withExceptT T.pack $ AP.fetchAP manager $ Left $ ObjURI hBundle luPatch + (h, PatchLocal luP luC) <- fromMaybeE mlocal "No patch @id" + unless (ObjURI h luP == ObjURI hBundle luPatch) $ + throwE "Patch @id doesn't match the URI we fetched" + unless (luC == luBundle) $ + throwE "Patch doesn't point back to the bundle" + unless (patchMediaTypeVCS typ == repoVcs repoTarget) $ + throwE "Patch type and repo VCS mismatch" + return (typ, content) + + -- Apply patches + case repoVcs repoTarget of + VCSGit -> error "Patching a Git repo unsupported yet" + VCSDarcs -> do + patch <- + case patches of + _ :| (_ : _) -> throwE "Darcs repo given multiple patch bundles" + (PatchMediaTypeDarcs, t) :| [] -> return t + applyDarcsPatch shrTarget rpTarget patch + + return (shrTarget, rpTarget, repoTarget, mltid, ticketFollowers) + + -- Insert Apply to outbox and deliver to local recipients via DB + -- If we applied patches to a local repo, produce Accept and deliver via DB + (obiid, doc, remotesHttp, maybeAccept) <- runDBExcept $ do + (obiidApply, docApply, luApply) <- lift $ insertApplyToOutbox (personOutbox personUser) blinded + remotesHttpApply <- do + encodeLTID <- getEncodeKeyHashid + encodeTALID <- getEncodeKeyHashid + let shrUser = sharerIdent sharerUser + sieve = + let ticketC = + case bundle of + Left (Left (shr, talid, _)) -> + [LocalPersonCollectionSharerProposalFollowers shr $ encodeTALID talid] + Left (Right (shr, rp, ltid, _)) -> + [LocalPersonCollectionRepoProposalFollowers shr rp $ encodeLTID ltid] + Right _u -> + [] + (repoA, repoC) = + case target of + Left (shr, rp, _) -> + ( [LocalActorRepo shr rp] + , [ LocalPersonCollectionRepoTeam shr rp + , LocalPersonCollectionRepoFollowers shr rp + ] + ) + Right _u -> + ([], []) + actors = repoA + collections = ticketC ++ repoC + in makeRecipientSet + actors + (LocalPersonCollectionSharerFollowers shrUser : + collections + ) + moreRemoteRecips <- + lift $ + deliverLocal' + True + (LocalActorSharer shrUser) + (personInbox personUser) + obiidApply + (localRecipSieve sieve False localRecips) + unless (federation || null moreRemoteRecips) $ + throwE "Federation disabled, but recipient collection remote members found" + lift $ deliverRemoteDB'' fwdHosts obiidApply remoteRecips moreRemoteRecips + + maccept <- lift $ for mapplied $ \ (shr, rp, repo, mltid, ticketFollowers) -> do + now <- liftIO getCurrentTime + obiidAccept <- insertEmptyOutboxItem (repoOutbox repo) now + for_ mltid $ \ ltid -> insertResolve ltid obiidApply obiidAccept + (docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <- + insertAccept shr rp ticketFollowers obiidApply obiidAccept + knownRemoteRecipsAccept <- + deliverLocal' + False + (LocalActorRepo shr rp) + (repoInbox repo) + obiidAccept + localRecipsAccept + (obiidAccept,docAccept,fwdHostsAccept,) <$> + deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept + + return (obiidApply, docApply, remotesHttpApply, maccept) + + -- Deliver Apply and Accept to remote recipients via HTTP + lift $ do + forkWorker "applyC: async HTTP Apply delivery" $ deliverRemoteHttp' fwdHosts obiid doc remotesHttp + for_ maybeAccept $ \ (obiidAccept, docAccept, fwdHostsAccept, remotesHttpAccept) -> + forkWorker "applyC: async HTTP Accept delivery" $ deliverRemoteHttp' fwdHostsAccept obiidAccept docAccept remotesHttpAccept + return obiid + where + checkBranch u@(ObjURI h lu) = do + hl <- hostIsLocal h + if hl + then Left <$> do + route <- + fromMaybeE + (decodeRouteLocal lu) + "Apply target is local but isn't a valid route" + case route of + RepoR shr rp -> return (shr, rp, Nothing) + RepoBranchR shr rp b -> return (shr, rp, Just b) + _ -> + throwE + "Apply target is a valid local route, but isn't a \ + \repo or branch route" + else return $ Right u + + verifyCapability ridTarget capID = do + -- Find the activity itself by URI in the DB + act <- do + mact <- getActivity capID + fromMaybeE mact "Capability activity not known to me" + -- Find the Collab record for that activity + cid <- + case act of + Left (_actor, obiid) -> do + mcsl <- lift $ getValBy $ UniqueCollabSenderLocalActivity obiid + collabSenderLocalCollab <$> + fromMaybeE mcsl "Capability is a local activity but no matching capability" + Right ractid -> do + mcsr <- lift $ getValBy $ UniqueCollabSenderRemoteActivity ractid + collabSenderRemoteCollab <$> + fromMaybeE mcsr "Capability is a known remote activity but no matching capability" + -- Find the recipient of that Collab + pidCollab <- do + mcrl <- lift $ getValBy $ UniqueCollabRecipLocal cid + crl <- fromMaybeE mcrl "No local recip for capability" + mcrr <- lift $ getBy $ UniqueCollabRecipRemote cid + verifyNothingE mcrr "Both local & remote recip for capability!" + return $ collabRecipLocalPerson crl + -- Verify the recipient is the author of the Apply activity + unless (pidCollab == pidUser) $ + throwE "Collab recipient isn't the Apply author" + -- Find the repo to which this Collab gives access + ridCap <- do + mctlr <- lift $ getValBy $ UniqueCollabTopicLocalRepo cid + rid <- + collabTopicLocalRepoRepo <$> + fromMaybeE mctlr "Collab isn't for a repo" + mctlj <- lift $ getBy $ UniqueCollabTopicLocalProject cid + verifyNothingE mctlj "Collab topic duplicate, found project" + mctr <- lift $ getBy $ UniqueCollabTopicRemote cid + verifyNothingE mctr "Collab topic duplicate, found remote" + return rid + -- Verify that repo is us + unless (ridCap == ridTarget) $ + throwE "Capability topic is some other local repo" + -- Find the collaborator's role in the repo + mrlid <- + lift $ fmap collabRoleLocalRole <$> + getValBy (UniqueCollabRoleLocal cid) + -- If no role specified, that means Developer role with + -- access to apply changes to repo source code, otherwise + -- make sure the specified role (or an ancestor of it) has + -- access to the relevant operation + for_ mrlid $ \ rlid -> do + let roleHas role op = getBy $ UniqueRoleAccess role op + ancestorHas = flip getProjectRoleAncestorWithOpQ + roleHasAccess role op = + fmap isJust . runMaybeT $ + MaybeT (roleHas role op) <|> + MaybeT (ancestorHas role op) + has <- lift $ roleHasAccess rlid ProjOpApplyPatch + unless has $ + throwE + "Apply author's role in repo doesn't have \ + \ApplyPatch access" + + insertApplyToOutbox obid blinded = do + let shrUser = sharerIdent sharerUser + now <- liftIO getCurrentTime + hLocal <- asksSite siteInstanceHost + obiid <- insertEmptyOutboxItem obid now + encodeRouteLocal <- getEncodeRouteLocal + obikhid <- encodeKeyHashid obiid + let luAct = encodeRouteLocal $ SharerOutboxItemR shrUser obikhid + doc = Doc hLocal Activity + { activityId = Just luAct + , activityActor = encodeRouteLocal $ SharerR shrUser + , activityCapability = muCap + , activitySummary = summary + , activityAudience = blinded + , activitySpecific = ApplyActivity $ Apply uObject uTarget + } + update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc] + return (obiid, doc, luAct) + + insertResolve ltid obiidApply obiidAccept = do + trid <- insert TicketResolve + { ticketResolveTicket = ltid + , ticketResolveAccept = obiidAccept + } + insert_ TicketResolveLocal + { ticketResolveLocalTicket = trid + , ticketResolveLocalActivity = obiidApply + } + tid <- localTicketTicket <$> getJust ltid + update tid [TicketStatus =. TSClosed] + + insertAccept shrTarget rpTarget ticketFollowers obiidApply obiidAccept = do + encodeRouteLocal <- getEncodeRouteLocal + encodeRouteHome <- getEncodeRouteHome + encodeTALID <- getEncodeKeyHashid + encodeLTID <- getEncodeKeyHashid + hLocal <- asksSite siteInstanceHost + + obikhidApply <- encodeKeyHashid obiidApply + obikhidAccept <- encodeKeyHashid obiidAccept + + let shrUser = sharerIdent sharerUser + audAuthor = + AudLocal + [LocalActorSharer shrUser] + [LocalPersonCollectionSharerFollowers shrUser] + audTicket = + case ticketFollowers of + Left (Left (shr, talid)) -> AudLocal [] [LocalPersonCollectionSharerProposalFollowers shr $ encodeTALID talid] + Left (Right ltid) -> AudLocal [] [LocalPersonCollectionRepoProposalFollowers shrTarget rpTarget $ encodeLTID ltid] + Right (ObjURI h lu) -> AudRemote h [] [lu] + audRepo = + AudLocal + [] + [ LocalPersonCollectionRepoTeam shrTarget rpTarget + , LocalPersonCollectionRepoFollowers shrTarget rpTarget + ] + + (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = + collectAudience [audAuthor, audTicket, audRepo] + + recips = map encodeRouteHome audLocal ++ audRemote + doc = Doc hLocal Activity + { activityId = + Just $ encodeRouteLocal $ + RepoOutboxItemR shrTarget rpTarget obikhidAccept + , activityActor = + encodeRouteLocal $ RepoR shrTarget rpTarget + , activityCapability = Nothing + , activitySummary = Nothing + , activityAudience = Audience recips [] [] [] [] [] + , activitySpecific = AcceptActivity Accept + { acceptObject = + encodeRouteHome $ + SharerOutboxItemR shrUser obikhidApply + , acceptResult = Nothing + } + } + + update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc] + return (doc, recipientSet, remoteActors, fwdHosts) + parseComment :: LocalURI -> ExceptT Text Handler (ShrIdent, LocalMessageId) parseComment luParent = do route <- case decodeRouteLocal luParent of diff --git a/src/Vervis/Darcs.hs b/src/Vervis/Darcs.hs index c79a2ef..190c5af 100644 --- a/src/Vervis/Darcs.hs +++ b/src/Vervis/Darcs.hs @@ -1,6 +1,7 @@ {- This file is part of Vervis. - - - Written in 2016, 2018, 2019, 2020 by fr33domlover . + - Written in 2016, 2018, 2019, 2020, 2022 + - by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -20,6 +21,7 @@ module Vervis.Darcs , lastChange , readPatch , writePostApplyHooks + , applyDarcsPatch ) where @@ -28,7 +30,7 @@ import Prelude hiding (lookup) import Control.Applicative ((<|>)) import Control.Monad.IO.Class import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Except (ExceptT (ExceptT), runExceptT) +import Control.Monad.Trans.Except import Darcs.Util.Path import Darcs.Util.Tree import Darcs.Util.Tree.Hashed @@ -49,16 +51,19 @@ import Development.Darcs.Internal.Inventory.Parser import Development.Darcs.Internal.Inventory.Read import Development.Darcs.Internal.Inventory.Types import Development.Darcs.Internal.Patch.Types +import System.Exit import System.FilePath (()) +import System.Process.Typed import Text.Email.Validate (emailAddress) import qualified Data.Attoparsec.Text as A import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL (ByteString) +import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Base16 as B16 (encode, decode) import qualified Data.Foldable as F (find) import qualified Data.List.NonEmpty as NE import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import qualified Data.Vector as V (empty) import qualified Database.Esqueleto as E @@ -78,6 +83,7 @@ import Data.Text.UTF8.Local (decodeStrict) import Data.Time.Clock.Local () import qualified Data.Patch.Local as DP +import qualified Data.Text.UTF8.Local as TU import Vervis.Changes import Vervis.Foundation @@ -390,3 +396,21 @@ writePostApplyHooks = do path <- askRepoDir shr rp liftIO $ writeDefaultsFile path hook authority (shr2text shr) (rp2text rp) + +applyDarcsPatch shr rp patch = do + path <- askRepoDir shr rp + let input = BL.fromStrict $ TE.encodeUtf8 patch + (exitCode, out, err) <- + readProcess $ setStdin (byteStringInput input) $ + proc "darcs" ["apply", "--all", "--no-allow-conflicts", "--repodir='" ++ path ++ "'"] + let out2text = TU.decodeLenient . BL.toStrict + case exitCode of + ExitFailure n -> + throwE $ + T.concat + [ "`darcs apply` failed with exit code " + , T.pack (show n) + , "\nstdout: ", out2text out + , "\nstderr: ", out2text err + ] + ExitSuccess -> return () diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs index 36e29c4..21a8b00 100644 --- a/src/Vervis/Federation/Ticket.hs +++ b/src/Vervis/Federation/Ticket.hs @@ -97,6 +97,7 @@ import Development.PatchMediaType import Vervis.ActivityPub import Vervis.ActivityPub.Recipient +import Vervis.Darcs import Vervis.FedURI import Vervis.Federation.Auth import Vervis.Federation.Util @@ -1567,7 +1568,7 @@ repoApplyF now shrRecip rpRecip author body mfwd luApply uObject uTarget = do [] -> error "Local repo-bundle without any patches found" _ : (_ : _) -> throwE "Darcs repo given multiple patch bundles" (Entity _ (Patch _ _ PatchMediaTypeDarcs t)) : [] -> return t - applyDarcsPatch patch + applyDarcsPatch shrRecip rpRecip patch -- Insert Apply activity to repo's inbox -- Produce an Accept activity and deliver locally @@ -1641,7 +1642,7 @@ repoApplyF now shrRecip rpRecip author body mfwd luApply uObject uTarget = do [] -> error "Local repo-bundle without any patches found" _ : (_ : _) -> throwE "Darcs repo given multiple patch bundles" (Entity _ (Patch _ _ PatchMediaTypeDarcs t)) : [] -> return t - applyDarcsPatch patch + applyDarcsPatch shrRecip rpRecip patch -- Insert Apply activity to repo's inbox -- Produce an Accept activity and deliver locally @@ -1751,7 +1752,7 @@ repoApplyF now shrRecip rpRecip author body mfwd luApply uObject uTarget = do case patches of _ :| (_ : _) -> throwE "Darcs repo given multiple patch bundles" (PatchMediaTypeDarcs, t) :| [] -> return t - applyDarcsPatch patch + applyDarcsPatch shrRecip rpRecip patch -- Insert Apply activity to repo's inbox -- Produce an Accept activity and deliver locally @@ -1817,24 +1818,6 @@ repoApplyF now shrRecip rpRecip author body mfwd luApply uObject uTarget = do -} where - applyDarcsPatch patch = do - path <- askRepoDir shrRecip rpRecip - let input = BL.fromStrict $ TE.encodeUtf8 patch - (exitCode, out, err) <- - readProcess $ setStdin (byteStringInput input) $ - proc "darcs" ["apply", "--all", "--no-allow-conflicts", "--repodir='" ++ path ++ "'"] - let out2text = TU.decodeLenient . BL.toStrict - case exitCode of - ExitFailure n -> - throwE $ - T.concat - [ "`darcs apply` failed with exit code " - , T.pack (show n) - , "\nstdout: ", out2text out - , "\nstderr: ", out2text err - ] - ExitSuccess -> return () - insertAcceptRemote luApply hTicket tlocal obiidAccept = do encodeRouteLocal <- getEncodeRouteLocal encodeRouteHome <- getEncodeRouteHome diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs index 31accf2..765b5d7 100644 --- a/src/Vervis/Handler/Client.hs +++ b/src/Vervis/Handler/Client.hs @@ -1,6 +1,7 @@ {- This file is part of Vervis. - - - Written in 2016, 2018, 2019, 2020 by fr33domlover . + - Written in 2016, 2018, 2019, 2020, 2022 + - by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -370,7 +371,7 @@ postSharerOutboxR shr = do obikhid <- encodeKeyHashid obiid sendResponseCreated $ SharerOutboxItemR shr obikhid where - handle eperson sharer (Activity _mid actor _mcap summary audience specific) = do + handle eperson sharer (Activity _mid actor mcap summary audience specific) = do case decodeRouteLocal actor of Just (SharerR shr') | shr' == shr -> return () _ -> throwE "Can't post activity sttributed to someone else" @@ -380,6 +381,8 @@ postSharerOutboxR shr = do Right (AddBundle patches) -> addBundleC eperson sharer summary audience patches target _ -> throwE "Unsupported Add 'object' type" + ApplyActivity apply -> + applyC eperson sharer summary audience mcap apply CreateActivity (Create obj mtarget) -> case obj of CreateNote note ->