From fa3348513a9c5fba71910cec2ff0e03d4be6bb4a Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Tue, 14 Jul 2020 08:50:57 +0000
Subject: [PATCH] For latest-version patches, provide a 'previousVersions' list
---
src/Vervis/Handler/Patch.hs | 35 +++++++++++++++++++++++------------
src/Web/ActivityPub.hs | 19 +++++++++++--------
2 files changed, 34 insertions(+), 20 deletions(-)
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