C2S Remove handler

src/Vervis/Actor/Person/Client.hs

@@ -230,9 +230,110 @@ clientInvite now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost
         fwdHosts inviteID action
     return inviteID
 
+-- Meaning: The human wants to remove someone A from a resource R
+-- Behavior:
+--      * Some basic sanity checks
+--          * Parse the Remove
+--          * Make sure not removing myself
+--          * Verify that a capability is specified
+--          * If resource is local, verify it exists in DB
+--      * Verify the target A and resource R are addressed in the Remove
+--      * Insert the Remove to my inbox
+--      * Asynchrnously deliver to:
+--          * Resource+followers
+--          * Member+followers
+--          * My followers
+clientRemove
+    :: UTCTime
+    -> PersonId
+    -> ClientMsg
+    -> AP.Remove URIMode
+    -> ActE OutboxItemId
+clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) remove = do
+
+    -- Check input
+    (resource, member) <- parseRemove (Left $ LocalActorPerson personMeID) remove
+    _capID <- fromMaybeE maybeCap "No capability provided"
+
+    -- Verify that resource is addressed by the Remove
+    bitraverse_
+        (verifyResourceAddressed localRecips)
+        (verifyRemoteAddressed remoteRecips)
+        resource
+
+    -- Verify that member is addressed by the Remove
+    bitraverse_
+        (verifyRecipientAddressed localRecips)
+        (verifyRemoteAddressed remoteRecips)
+        member
+
+    (actorMeID, localRecipsFinal, removeID) <- withDBExcept $ do
+
+        -- If resource is local, find it in our DB
+        _resourceDB <-
+            bitraverse
+                (flip getGrantResource "Resource not found in DB")
+                pure
+                resource
+
+        -- If member is local, find it in our DB
+        _memberDB <-
+            bitraverse
+                (flip getGrantRecip "Member not found in DB")
+                pure
+                member
+
+        -- Grab me from DB
+        (personMe, actorMe) <- lift $ do
+            p <- getJust personMeID
+            (p,) <$> getJust (personActor p)
+
+        -- Insert the Remove activity to my outbox
+        removeID <- lift $ insertEmptyOutboxItem' (actorOutbox actorMe) now
+        _luRemove <- lift $ updateOutboxItem' (LocalActorPerson personMeID) removeID action
+
+        -- Prepare local recipients for Remove delivery
+        sieve <- lift $ do
+            resourceHash <- bitraverse hashGrantResource' pure resource
+            recipientHash <- bitraverse hashGrantRecip pure member
+            senderHash <- encodeKeyHashid personMeID
+            let sieveActors = catMaybes
+                    [ case resourceHash of
+                        Left (GrantResourceRepo r) -> Just $ LocalActorRepo r
+                        Left (GrantResourceDeck d) -> Just $ LocalActorDeck d
+                        Left (GrantResourceLoom l) -> Just $ LocalActorLoom l
+                        Right _                    -> Nothing
+                    , case recipientHash of
+                        Left (GrantRecipPerson p) -> Just $ LocalActorPerson p
+                        Right _                   -> Nothing
+                    ]
+                sieveStages = catMaybes
+                    [ Just $ LocalStagePersonFollowers senderHash
+                    , case resourceHash of
+                        Left (GrantResourceRepo r) -> Just $ LocalStageRepoFollowers r
+                        Left (GrantResourceDeck d) -> Just $ LocalStageDeckFollowers d
+                        Left (GrantResourceLoom l) -> Just $ LocalStageLoomFollowers l
+                        Right _                    -> Nothing
+                    , case recipientHash of
+                        Left (GrantRecipPerson p) -> Just $ LocalStagePersonFollowers p
+                        Right _                   -> Nothing
+                    ]
+            return $ makeRecipientSet sieveActors sieveStages
+        return
+            ( personActor personMe
+            , localRecipSieve sieve False localRecips
+            , removeID
+            )
+
+    lift $ sendActivity
+        (LocalActorPerson personMeID) actorMeID localRecipsFinal remoteRecips
+        fwdHosts removeID action
+    return removeID
+
 clientBehavior :: UTCTime -> PersonId -> ClientMsg -> ActE (Text, Act (), Next)
 clientBehavior now personID msg =
     done . T.pack . show =<<
     case AP.actionSpecific $ cmAction msg of
         AP.InviteActivity invite -> clientInvite now personID msg invite
+        AP.RemoveActivity remove -> clientRemove now personID msg remove
         _ -> throwE "Unsupported activity type for C2S"