From adc107bb4cf2d299946b43c787cabfebeefc2730 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Tue, 18 Feb 2020 13:26:28 +0000
Subject: [PATCH] Web.ActivityPub: Add createTarget field

I'll use this for C2S to allow client to state who the tracker actor is. It's
still possible to do without it, by HTTP GETing the ticket's context and
checking whether we got an actor, or a non-actor with ticketsTrackedBy. Tbh I'm
adding createTarget simply because it's easier for coding, no need for a custom
variant of actor fetching :P
---
 src/Vervis/API.hs        | 1 +
 src/Vervis/Federation.hs | 4 ++--
 src/Vervis/Migration.hs  | 1 +
 src/Web/ActivityPub.hs   | 8 +++++---
 4 files changed, 9 insertions(+), 5 deletions(-)

diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs
index 6c85240..17bcdb7 100644
--- a/src/Vervis/API.hs
+++ b/src/Vervis/API.hs
@@ -362,6 +362,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
                         , noteSource    = source
                         , noteContent   = content
                         }
+                    , createTarget = Nothing
                     }
                 }
             tempUri = topLocalURI
diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs
index d9629c7..edab3c8 100644
--- a/src/Vervis/Federation.hs
+++ b/src/Vervis/Federation.hs
@@ -266,7 +266,7 @@ handleSharerInbox now shrRecip (ActivityAuthRemote author) body =
     case activitySpecific $ actbActivity body of
         AcceptActivity accept ->
             sharerAcceptF shrRecip now author body accept
-        CreateActivity (Create obj) ->
+        CreateActivity (Create obj _target) ->
             case obj of
                 CreateNote note ->
                     sharerCreateNoteF now shrRecip author body note
@@ -296,7 +296,7 @@ handleProjectInbox now shrRecip prjRecip auth body = do
             ActivityAuthLocal local -> throwE $ errorLocalForwarded local
             ActivityAuthRemote ra -> return ra
     case activitySpecific $ actbActivity body of
-        CreateActivity (Create obj) ->
+        CreateActivity (Create obj _target) ->
             case obj of
                 CreateNote note ->
                     projectCreateNoteF now shrRecip prjRecip remoteAuthor body note
diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs
index bb9782b..0e1e0ec 100644
--- a/src/Vervis/Migration.hs
+++ b/src/Vervis/Migration.hs
@@ -477,6 +477,7 @@ changes hLocal ctx =
                                             , noteSource    = msg
                                             , noteContent   = contentHtml
                                             }
+                                        , createTarget = Nothing
                                         }
                                     }
                                 tempUri = topLocalURI
diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs
index 1354e3b..42b9659 100644
--- a/src/Web/ActivityPub.hs
+++ b/src/Web/ActivityPub.hs
@@ -1086,20 +1086,22 @@ instance ActivityPub CreateObject where
 
 data Create u = Create
     { createObject :: CreateObject u
+    , createTarget :: Maybe (ObjURI u)
     }
 
 parseCreate :: UriMode u => Object -> Authority u -> LocalURI -> Parser (Create u)
 parseCreate o a luActor = do
     obj <- withAuthorityT a $ parseObject =<< o .: "object"
     unless (luActor == attrib obj) $ fail "Create actor != object attrib"
-    return $ Create obj
+    Create obj <$> o .:? "target"
     where
     attrib (CreateNote note)     = noteAttrib note
     attrib (CreateTicket ticket) = ticketAttributedTo ticket
 
 encodeCreate :: UriMode u => Authority u -> LocalURI -> Create u -> Series
-encodeCreate authority actor (Create obj) =
-    "object" `pair` pairs (toSeries authority obj)
+encodeCreate authority actor (Create obj target)
+    =  "object" `pair` pairs (toSeries authority obj)
+    <> "target" .=?    target
 
 data Follow u = Follow
     { followObject  :: ObjURI u