diff --git a/src/Vervis/Handler/Patch.hs b/src/Vervis/Handler/Patch.hs index ab895f7..7533642 100644 --- a/src/Vervis/Handler/Patch.hs +++ b/src/Vervis/Handler/Patch.hs @@ -38,6 +38,7 @@ import Control.Monad import Data.Bifunctor import Data.Bitraversable import Data.Function +import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text) import Data.Traversable import Database.Persist @@ -249,20 +250,23 @@ getSharerPatchVersionR -> KeyHashid Patch -> Handler TypedContent getSharerPatchVersionR shr talkhid ptkhid = do - (vcs, patch) <- runDB $ do - (_, _, Entity tid _, repo, _) <- getSharerPatch404 shr talkhid - (,) <$> case repo of + (vcs, patch, versions) <- runDB $ do + (_, _, Entity tid _, repo, v :| vs) <- getSharerPatch404 shr talkhid + ptid <- decodeKeyHashid404 ptkhid + (,,) <$> case repo of Left (_, Entity _ trl) -> repoVcs <$> getJust (ticketRepoLocalRepo trl) Right _ -> error "TODO determine mediaType of patch of remote repo" - <*> do ptid <- decodeKeyHashid404 ptkhid - pt <- get404 ptid + <*> do pt <- get404 ptid unless (patchTicket pt == tid) notFound return pt + <*> pure (if ptid == v then vs else []) encodeRouteLocal <- getEncodeRouteLocal encodeRouteHome <- getEncodeRouteHome - let versionAP = AP.Patch + encodePatchId <- getEncodeKeyHashid + let versionUrl = SharerPatchVersionR shr talkhid . encodePatchId + versionAP = AP.Patch { AP.patchId = encodeRouteLocal here , AP.patchAttributedTo = encodeRouteHome $ SharerR shr , AP.patchPublished = patchCreated patch @@ -272,6 +276,8 @@ getSharerPatchVersionR shr talkhid ptkhid = do VCSDarcs -> PatchTypeDarcs VCSGit -> error "TODO add PatchType for git patches" , AP.patchContent = patchContent patch + , AP.patchPrevVersions = + map (encodeRouteLocal . versionUrl) versions } provideHtmlAndAP versionAP $ redirectToPrettyJSON here where @@ -512,11 +518,11 @@ getRepoPatchVersionR -> KeyHashid Patch -> Handler TypedContent getRepoPatchVersionR shr rp ltkhid ptkhid = do - (vcs, patch, author) <- runDB $ do - (_, Entity _ repo, Entity tid _, _, _, _, ta, _) <- getRepoPatch404 shr rp ltkhid - (repoVcs repo,,) - <$> do ptid <- decodeKeyHashid404 ptkhid - pt <- get404 ptid + (vcs, patch, author, versions) <- runDB $ do + (_, Entity _ repo, Entity tid _, _, _, _, ta, v :| vs) <- getRepoPatch404 shr rp ltkhid + ptid <- decodeKeyHashid404 ptkhid + (repoVcs repo,,,) + <$> do pt <- get404 ptid unless (patchTicket pt == tid) notFound return pt <*> bitraverse @@ -531,9 +537,12 @@ getRepoPatchVersionR shr rp ltkhid ptkhid = do return (i, ro) ) ta + <*> pure (if ptid == v then vs else []) encodeRouteLocal <- getEncodeRouteLocal encodeRouteHome <- getEncodeRouteHome - let versionAP = AP.Patch + encodePatchId <- getEncodeKeyHashid + let versionUrl = RepoPatchVersionR shr rp ltkhid . encodePatchId + versionAP = AP.Patch { AP.patchId = encodeRouteLocal here , AP.patchAttributedTo = case author of @@ -550,6 +559,8 @@ getRepoPatchVersionR shr rp ltkhid ptkhid = do VCSDarcs -> PatchTypeDarcs VCSGit -> error "TODO add PatchType for git patches" , AP.patchContent = patchContent patch + , AP.patchPrevVersions = + map (encodeRouteLocal . versionUrl) versions } provideHtmlAndAP versionAP $ redirectToPrettyJSON here where diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index b7f2644..188cb0f 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -845,6 +845,7 @@ data Patch u = Patch , patchContext :: LocalURI , patchType :: PatchType , patchContent :: Text + , patchPrevVersions :: [LocalURI] } instance ActivityPub Patch where @@ -864,15 +865,17 @@ instance ActivityPub Patch where <*> withAuthorityO a (o .: "context") <*> o .: "mediaType" <*> o .: "content" + <*> (traverse (withAuthorityO a . return) =<< o .:? "previousVersions" .!= []) - toSeries a (Patch id_ attrib published context typ content) - = "id" .= ObjURI a id_ - <> "type" .= ("Patch" :: Text) - <> "attributedTo" .= attrib - <> "context" .= ObjURI a context - <> "published" .= published - <> "mediaType" .= typ - <> "content" .= content + toSeries a (Patch id_ attrib published context typ content vers) + = "id" .= ObjURI a id_ + <> "type" .= ("Patch" :: Text) + <> "attributedTo" .= attrib + <> "context" .= ObjURI a context + <> "published" .= published + <> "mediaType" .= typ + <> "content" .= content + <> "previousVersions" .= map (ObjURI a) vers data TicketLocal = TicketLocal { ticketId :: LocalURI