For latest-version patches, provide a 'previousVersions' list

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

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