diff --git a/src/Vervis/Actor/Group.hs b/src/Vervis/Actor/Group.hs index e94f54b..3813361 100644 --- a/src/Vervis/Actor/Group.hs +++ b/src/Vervis/Actor/Group.hs @@ -117,10 +117,161 @@ groupCreate now groupID verse (AP.Create obj _muTarget) = _ -> throwE "Unsupported Create object for Group" +-- Meaning: An actor is following someone/something +-- Behavior: +-- * Verify the target is me +-- * Record the follow in DB +-- * Publish and send an Accept to the sender and its followers +groupFollow + :: UTCTime + -> GroupId + -> Verse + -> AP.Follow URIMode + -> ActE (Text, Act (), Next) +groupFollow now recipGroupID verse follow = do + recipGroupHash <- encodeKeyHashid recipGroupID + actorFollow + (\case + GroupR d | d == recipGroupHash -> pure () + _ -> throwE "Asking to follow someone else" + ) + groupActor + False + (\ recipGroupActor () -> pure $ actorFollowers recipGroupActor) + (\ _ -> pure $ makeRecipientSet [] []) + LocalActorGroup + (\ _ -> pure []) + now recipGroupID verse follow + +-- Meaning: An actor is undoing some previous action +-- Behavior: +-- * If they're undoing their Following of me: +-- * Record it in my DB +-- * Publish and send an Accept only to the sender +-- * Otherwise respond with an error +groupUndo + :: UTCTime + -> GroupId + -> Verse + -> AP.Undo URIMode + -> ActE (Text, Act (), Next) +groupUndo now recipGroupID (Verse authorIdMsig body) (AP.Undo uObject) = do + + -- Check input + undone <- + first (\ (actor, _, item) -> (actor, item)) <$> + parseActivityURI' uObject + + -- Verify the capability URI, if provided, is one of: + -- * Outbox item URI of a local actor, i.e. a local activity + -- * A remote URI + maybeCapability <- + for (AP.activityCapability $ actbActivity body) $ \ uCap -> + nameExceptT "Undo capability" $ + first (\ (actor, _, item) -> (actor, item)) <$> + parseActivityURI' uCap + + maybeNew <- withDBExcept $ do + + -- Grab me from DB + (groupRecip, actorRecip) <- lift $ do + p <- getJust recipGroupID + (p,) <$> getJust (groupActor p) + + -- Insert the Undo to my inbox + mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False + for mractid $ \ _undoDB -> do + + maybeUndo <- runMaybeT $ do + + -- Find the undone activity in our DB + undoneDB <- MaybeT $ getActivity undone + + let followers = actorFollowers actorRecip + asum + [ tryUnfollow followers undoneDB authorIdMsig + ] + + (sieve, audience) <- + fromMaybeE + maybeUndo + "Undone activity isn't a Follow related to me" + + -- Prepare an Accept activity and insert to group's outbox + acceptID <- lift $ insertEmptyOutboxItem' (actorOutbox actorRecip) now + accept@(actionAccept, _, _, _) <- lift $ lift $ prepareAccept audience + _luAccept <- lift $ updateOutboxItem' (LocalActorGroup recipGroupID) acceptID actionAccept + + return (groupActor groupRecip, sieve, acceptID, accept) + + case maybeNew of + Nothing -> done "I already have this activity in my inbox" + Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + forwardActivity + authorIdMsig body (LocalActorGroup recipGroupID) actorID sieve + lift $ sendActivity + (LocalActorGroup recipGroupID) actorID localRecipsAccept + remoteRecipsAccept fwdHostsAccept acceptID actionAccept + done + "Undid the Follow, forwarded the Undo and published Accept" + + where + + tryUnfollow groupFollowersID (Left (_actorByKey, _actorE, outboxItemID)) (Left (_, actorID, _)) = do + Entity followID follow <- + MaybeT $ lift $ getBy $ UniqueFollowFollow outboxItemID + let followerID = followActor follow + followerSetID = followTarget follow + verifyTargetMe followerSetID + unless (followerID == actorID) $ + lift $ throwE "You're trying to Undo someone else's Follow" + lift $ lift $ delete followID + audSenderOnly <- lift $ lift $ lift $ makeAudSenderOnly authorIdMsig + return (makeRecipientSet [] [], [audSenderOnly]) + where + verifyTargetMe followerSetID = guard $ followerSetID == groupFollowersID + tryUnfollow groupFollowersID (Right remoteActivityID) (Right (author, _, _)) = do + Entity remoteFollowID remoteFollow <- + MaybeT $ lift $ getBy $ UniqueRemoteFollowFollow remoteActivityID + let followerID = remoteFollowActor remoteFollow + followerSetID = remoteFollowTarget remoteFollow + verifyTargetMe followerSetID + unless (followerID == remoteAuthorId author) $ + lift $ throwE "You're trying to Undo someone else's Follow" + lift $ lift $ delete remoteFollowID + audSenderOnly <- lift $ lift $ lift $ makeAudSenderOnly authorIdMsig + return (makeRecipientSet [] [], [audSenderOnly]) + where + verifyTargetMe followerSetID = guard $ followerSetID == groupFollowersID + tryUnfollow _ _ _ = mzero + + prepareAccept audience = do + encodeRouteHome <- getEncodeRouteHome + + uUndo <- getActivityURI authorIdMsig + let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = + collectAudience audience + + recips = map encodeRouteHome audLocal ++ audRemote + action = AP.Action + { AP.actionCapability = Nothing + , AP.actionSummary = Nothing + , AP.actionAudience = AP.Audience recips [] [] [] [] [] + , AP.actionFulfills = [] + , AP.actionSpecific = AP.AcceptActivity AP.Accept + { AP.acceptObject = uUndo + , AP.acceptResult = Nothing + } + } + + return (action, recipientSet, remoteActors, fwdHosts) + groupBehavior :: UTCTime -> GroupId -> VerseExt -> ActE (Text, Act (), Next) groupBehavior now groupID (Left verse@(Verse _authorIdMsig body)) = case AP.activitySpecific $ actbActivity body of AP.CreateActivity create -> groupCreate now groupID verse create + AP.FollowActivity follow -> groupFollow now groupID verse follow + AP.UndoActivity undo -> groupUndo now groupID verse undo _ -> throwE "Unsupported activity type for Group" groupBehavior _ _ (Right _) = throwE "ClientMsgs aren't supported for Group"