diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index 538eddf..1e5998e 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -168,7 +168,8 @@ acceptC -> AP.Accept URIMode -> ExceptT Text Handler OutboxItemId acceptC (Entity senderPersonID senderPerson) senderActor maybeCap localRecips remoteRecips fwdHosts action accept = do - + error "acceptC temporarily disabled due to actor refactoring" +{- -- Check input verifyNothingE maybeCap "Capability not needed" acceptee <- parseAccept accept @@ -374,6 +375,7 @@ acceptC (Entity senderPersonID senderPerson) senderActor maybeCap localRecips re } return (action, recipientSet, remoteActors, fwdHosts) +-} addBundleC :: Entity Person diff --git a/src/Vervis/Actor/Person.hs b/src/Vervis/Actor/Person.hs index 08bb037..56196db 100644 --- a/src/Vervis/Actor/Person.hs +++ b/src/Vervis/Actor/Person.hs @@ -217,6 +217,69 @@ personFollow now recipPersonID author body mfwd luFollow follow = do (\ () -> pure []) now recipPersonID author body mfwd luFollow follow +-- Meaning: A remote actor accepted something +-- Behavior: +-- * Insert to my inbox +-- * If it's a Follow I sent to them, add to my following list in DB +personAccept + :: UTCTime + -> PersonId + -> RemoteAuthor + -> ActivityBody + -> Maybe (RecipientRoutes, ByteString) + -> LocalURI + -> AP.Accept URIMode + -> ActE (Text, Act (), Next) +personAccept now recipPersonID author body mfwd luAccept accept = do + + -- Check input + acceptee <- parseAccept accept + + maybeAccept <- withDBExcept $ do + + -- Grab recipient person from DB + (personRecip, actorRecip) <- lift $ do + p <- getJust recipPersonID + (p,) <$> getJust (personActor p) + + mractid <- lift $ insertToInbox now author body (actorInbox actorRecip) luAccept True + for mractid $ \ acceptID -> runMaybeT $ do + + -- Find the accepted activity in our DB + accepteeDB <- MaybeT $ getActivity acceptee + + tryFollow (personActor personRecip) accepteeDB acceptID + + case maybeAccept of + Nothing -> done "I already have this activity in my inbox" + Just Nothing -> done "Not my Follow; Just inserted to my inbox" + Just (Just ()) -> + done "Recorded this Accept on the Follow request I sent" + + where + + tryFollow actorID (Left (_, _, outboxItemID)) acceptID = do + Entity key val <- + MaybeT $ lift $ + getBy $ UniqueFollowRemoteRequestActivity outboxItemID + guard $ followRemoteRequestPerson val == recipPersonID + let uRecip = + fromMaybe + (followRemoteRequestTarget val) + (followRemoteRequestRecip val) + unless (remoteAuthorURI author == uRecip) $ + lift $ throwE "You're Accepting a Follow I sent to someone else" + lift $ lift $ delete key + lift $ lift $ insert_ FollowRemote + { followRemoteActor = actorID + , followRemoteRecip = remoteAuthorId author + , followRemoteTarget = followRemoteRequestTarget val + , followRemotePublic = followRemoteRequestPublic val + , followRemoteFollow = outboxItemID + , followRemoteAccept = acceptID + } + tryFollow _ (Right _) _ = mzero + ------------------------------------------------------------------------------ -- Commenting ------------------------------------------------------------------------------ @@ -487,6 +550,8 @@ personBehavior now personID (Left event) = _ -> throwE $ "Unsupported event for Person: " <> T.pack (show event) personBehavior now personID (Right (VerseRemote author body mfwd luActivity)) = case AP.activitySpecific $ actbActivity body of + AP.AcceptActivity accept -> + personAccept now personID author body mfwd luActivity accept AP.CreateActivity (AP.Create obj mtarget) -> case obj of AP.CreateNote _ note -> diff --git a/src/Vervis/Data/Actor.hs b/src/Vervis/Data/Actor.hs index 75a2f24..9bd298e 100644 --- a/src/Vervis/Data/Actor.hs +++ b/src/Vervis/Data/Actor.hs @@ -15,7 +15,9 @@ module Vervis.Data.Actor ( parseLocalActivityURI + , parseLocalActivityURI' , parseActivityURI + , parseActivityURI' , activityRoute , stampRoute , parseStampRoute @@ -47,6 +49,9 @@ import Yesod.FedURI import Yesod.Hashids import Yesod.MonadSite +import qualified Web.Actor as WA +import qualified Web.Actor.Persist as WAP + import Control.Monad.Trans.Except.Local import Vervis.FedURI @@ -54,6 +59,8 @@ import Vervis.Foundation import Vervis.Model import Vervis.Recipient +import qualified Vervis.Actor as VA + parseLocalActivityURI :: (MonadSite m, YesodHashids (SiteEnv m)) => LocalURI @@ -75,6 +82,26 @@ parseLocalActivityURI luAct = do parseOutboxItemRoute (LoomOutboxItemR l i) = Just (LocalActorLoom l, i) parseOutboxItemRoute _ = Nothing +parseLocalActivityURI' + :: LocalURI + -> VA.ActE (LocalActorBy Key, LocalActorBy KeyHashid, OutboxItemId) +parseLocalActivityURI' luAct = do + route <- fromMaybeE (WA.decodeRouteLocal luAct) "Not a valid route" + (actorHash, outboxItemHash) <- + fromMaybeE + (parseOutboxItemRoute route) + "Valid local route, but not an outbox item route" + outboxItemID <- WAP.decodeKeyHashidE outboxItemHash "Invalid outbox item hash" + actorKey <- VA.unhashLocalActorE actorHash "Invalid actor hash" + return (actorKey, actorHash, outboxItemID) + where + parseOutboxItemRoute (PersonOutboxItemR p i) = Just (LocalActorPerson p, i) + parseOutboxItemRoute (GroupOutboxItemR g i) = Just (LocalActorGroup g, i) + parseOutboxItemRoute (RepoOutboxItemR r i) = Just (LocalActorRepo r, i) + parseOutboxItemRoute (DeckOutboxItemR d i) = Just (LocalActorDeck d, i) + parseOutboxItemRoute (LoomOutboxItemR l i) = Just (LocalActorLoom l, i) + parseOutboxItemRoute _ = Nothing + -- | If the given URI is remote, return as is. If the URI is local, verify that -- it parses as an activity URI, i.e. an outbox item route, and return the -- parsed route. @@ -92,6 +119,22 @@ parseActivityURI u@(ObjURI h lu) = do then Left <$> parseLocalActivityURI lu else pure $ Right u +-- | If the given URI is remote, return as is. If the URI is local, verify that +-- it parses as an activity URI, i.e. an outbox item route, and return the +-- parsed route. +parseActivityURI' + :: FedURI + -> VA.ActE + (Either + (LocalActorBy Key, LocalActorBy KeyHashid, OutboxItemId) + FedURI + ) +parseActivityURI' u@(ObjURI h lu) = do + hl <- WA.hostIsLocal h + if hl + then Left <$> parseLocalActivityURI' lu + else pure $ Right u + activityRoute :: LocalActorBy KeyHashid -> KeyHashid OutboxItem -> Route App activityRoute (LocalActorPerson p) = PersonOutboxItemR p activityRoute (LocalActorGroup g) = GroupOutboxItemR g diff --git a/src/Vervis/Data/Collab.hs b/src/Vervis/Data/Collab.hs index 3fc157a..c5cf07f 100644 --- a/src/Vervis/Data/Collab.hs +++ b/src/Vervis/Data/Collab.hs @@ -232,9 +232,9 @@ parseGrant h (AP.Grant object context target mresult mstart mend allows deleg) = else pure $ Right u parseAccept (AP.Accept object mresult) = do - verifyNothingE mresult "Accept must not contain 'result'" + --verifyNothingE mresult "Accept must not contain 'result'" first (\ (actor, _, item) -> (actor, item)) <$> - nameExceptT "Accept object" (parseActivityURI object) + nameExceptT "Accept object" (parseActivityURI' object) grantResourceActorID :: GrantResourceBy Identity -> ActorId grantResourceActorID (GrantResourceRepo (Identity r)) = repoActor r diff --git a/src/Vervis/Federation/Collab.hs b/src/Vervis/Federation/Collab.hs index b5057a0..70c9f9f 100644 --- a/src/Vervis/Federation/Collab.hs +++ b/src/Vervis/Federation/Collab.hs @@ -357,7 +357,8 @@ topicAcceptF -> AP.Accept URIMode -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text)) topicAcceptF topicActor topicResource now recipHash author body mfwd luAccept accept = (,Nothing) <$> do - + error "topicAcceptF temporarily disabled due to actor refactoring" +{- -- Check input acceptee <- parseAccept accept @@ -564,6 +565,7 @@ topicAcceptF topicActor topicResource now recipHash author body mfwd luAccept ac } return (action, recipientSet, remoteActors, fwdHosts) +-} repoAcceptF :: UTCTime