From d467626049c814b9b90c77e45ba444177e0b61b5 Mon Sep 17 00:00:00 2001
From: Pere Lev <pere@towards.vision>
Date: Mon, 5 Jun 2023 12:38:08 +0300
Subject: [PATCH] Person: Implement (trivial) Revoke handler

---
 src/Vervis/Actor/Person.hs | 28 ++++++++++++++++++++++++++++
 src/Web/ActivityPub.hs     | 17 +++++++++++++++++
 2 files changed, 45 insertions(+)

diff --git a/src/Vervis/Actor/Person.hs b/src/Vervis/Actor/Person.hs
index 03dc16a..84e3ddd 100644
--- a/src/Vervis/Actor/Person.hs
+++ b/src/Vervis/Actor/Person.hs
@@ -653,6 +653,32 @@ personGrant now recipPersonID author body mfwd luGrant grant = do
                 then done "I'm not the target; Inserted to inbox"
                 else done "I'm the target; Inserted to inbox"
 
+-- Meaning: A remote actor has revoked some previously published Grants
+-- Behavior: Insert to my inbox
+personRevoke
+    :: UTCTime
+    -> PersonId
+    -> RemoteAuthor
+    -> ActivityBody
+    -> Maybe (RecipientRoutes, ByteString)
+    -> LocalURI
+    -> AP.Revoke URIMode
+    -> ActE (Text, Act (), Next)
+personRevoke now recipPersonID author body _mfwd luRevoke (AP.Revoke _lus) = do
+
+    maybeRevoke <- lift $ withDB $ do
+
+        -- Grab recipient person from DB
+        (_personRecip, actorRecip) <- do
+            p <- getJust recipPersonID
+            (p,) <$> getJust (personActor p)
+
+        insertToInbox now author body (actorInbox actorRecip) luRevoke True
+
+    case maybeRevoke of
+        Nothing -> done "I already have this activity in my inbox"
+        Just _revokeID -> done "Inserted to my inbox"
+
 ------------------------------------------------------------------------------
 -- Main behavior function
 ------------------------------------------------------------------------------
@@ -718,6 +744,8 @@ personBehavior now personID (Right (VerseRemote author body mfwd luActivity)) =
             personJoin now personID author body mfwd luActivity join
         AP.RejectActivity reject ->
             personReject now personID author body mfwd luActivity reject
+        AP.RevokeActivity revoke ->
+            personRevoke now personID author body mfwd luActivity revoke
         AP.UndoActivity undo ->
             personUndo now personID author body mfwd luActivity undo
         _ -> throwE "Unsupported activity type for Person"
diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs
index f6abd0c..47f5634 100644
--- a/src/Web/ActivityPub.hs
+++ b/src/Web/ActivityPub.hs
@@ -81,6 +81,7 @@ module Web.ActivityPub
     , Push (..)
     , Reject (..)
     , Resolve (..)
+    , Revoke (..)
     , Undo (..)
     , Audience (..)
     , ProofConfig (..)
@@ -1905,6 +1906,18 @@ parseResolve o = Resolve <$> o .: "object"
 encodeResolve :: UriMode u => Resolve u -> Series
 encodeResolve (Resolve obj) = "object" .= obj
 
+data Revoke u = Revoke
+    { revokeObject :: NonEmpty LocalURI
+    }
+
+parseRevoke :: UriMode u => Authority u -> Object -> Parser (Revoke u)
+parseRevoke h o = do
+    us <- o .:*+ "object"
+    Revoke <$> for us (withAuthorityO h . pure)
+
+encodeRevoke :: UriMode u => Authority u -> Revoke u -> Series
+encodeRevoke h (Revoke obj) = "object" .=*+ (NE.map (ObjURI h) obj)
+
 data Undo u = Undo
     { undoObject :: ObjURI u
     }
@@ -1979,6 +1992,7 @@ data SpecificActivity u
     | PushActivity    (Push u)
     | RejectActivity  (Reject u)
     | ResolveActivity (Resolve u)
+    | RevokeActivity  (Revoke u)
     | UndoActivity    (Undo u)
 
 activityType :: SpecificActivity u -> Text
@@ -1994,6 +2008,7 @@ activityType (OfferActivity _)   = "Offer"
 activityType (PushActivity _)    = "Push"
 activityType (RejectActivity _)  = "Reject"
 activityType (ResolveActivity _) = "Resolve"
+activityType (RevokeActivity _)  = "Revoke"
 activityType (UndoActivity _)    = "Undo"
 
 data Action u = Action
@@ -2057,6 +2072,7 @@ instance ActivityPub Activity where
                         "Push"    -> PushActivity    <$> parsePush a o
                         "Reject"  -> RejectActivity  <$> parseReject o
                         "Resolve" -> ResolveActivity <$> parseResolve o
+                        "Revoke"  -> RevokeActivity  <$> parseRevoke a o
                         "Undo"    -> UndoActivity    <$> parseUndo a o
                         _ ->
                             fail $
@@ -2084,6 +2100,7 @@ instance ActivityPub Activity where
         encodeSpecific h _ (PushActivity a)    = encodePush h a
         encodeSpecific _ _ (RejectActivity a)  = encodeReject a
         encodeSpecific _ _ (ResolveActivity a) = encodeResolve a
+        encodeSpecific h _ (RevokeActivity a)  = encodeRevoke h a
         encodeSpecific h _ (UndoActivity a)    = encodeUndo h a
 
 emptyAudience :: Audience u