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