1
0
Fork 0
mirror of https://code.naskya.net/repos/ndqEd synced 2025-01-25 17:07:53 +09:00

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

This commit is contained in:
fr33domlover 2020-07-14 08:50:57 +00:00
parent a06d273107
commit fa3348513a
2 changed files with 34 additions and 20 deletions

View file

@ -38,6 +38,7 @@ import Control.Monad
import Data.Bifunctor import Data.Bifunctor
import Data.Bitraversable import Data.Bitraversable
import Data.Function import Data.Function
import Data.List.NonEmpty (NonEmpty (..))
import Data.Text (Text) import Data.Text (Text)
import Data.Traversable import Data.Traversable
import Database.Persist import Database.Persist
@ -249,20 +250,23 @@ getSharerPatchVersionR
-> KeyHashid Patch -> KeyHashid Patch
-> Handler TypedContent -> Handler TypedContent
getSharerPatchVersionR shr talkhid ptkhid = do getSharerPatchVersionR shr talkhid ptkhid = do
(vcs, patch) <- runDB $ do (vcs, patch, versions) <- runDB $ do
(_, _, Entity tid _, repo, _) <- getSharerPatch404 shr talkhid (_, _, Entity tid _, repo, v :| vs) <- getSharerPatch404 shr talkhid
(,) <$> case repo of ptid <- decodeKeyHashid404 ptkhid
(,,) <$> case repo of
Left (_, Entity _ trl) -> Left (_, Entity _ trl) ->
repoVcs <$> getJust (ticketRepoLocalRepo trl) repoVcs <$> getJust (ticketRepoLocalRepo trl)
Right _ -> Right _ ->
error "TODO determine mediaType of patch of remote repo" error "TODO determine mediaType of patch of remote repo"
<*> do ptid <- decodeKeyHashid404 ptkhid <*> do pt <- get404 ptid
pt <- get404 ptid
unless (patchTicket pt == tid) notFound unless (patchTicket pt == tid) notFound
return pt return pt
<*> pure (if ptid == v then vs else [])
encodeRouteLocal <- getEncodeRouteLocal encodeRouteLocal <- getEncodeRouteLocal
encodeRouteHome <- getEncodeRouteHome encodeRouteHome <- getEncodeRouteHome
let versionAP = AP.Patch encodePatchId <- getEncodeKeyHashid
let versionUrl = SharerPatchVersionR shr talkhid . encodePatchId
versionAP = AP.Patch
{ AP.patchId = encodeRouteLocal here { AP.patchId = encodeRouteLocal here
, AP.patchAttributedTo = encodeRouteHome $ SharerR shr , AP.patchAttributedTo = encodeRouteHome $ SharerR shr
, AP.patchPublished = patchCreated patch , AP.patchPublished = patchCreated patch
@ -272,6 +276,8 @@ getSharerPatchVersionR shr talkhid ptkhid = do
VCSDarcs -> PatchTypeDarcs VCSDarcs -> PatchTypeDarcs
VCSGit -> error "TODO add PatchType for git patches" VCSGit -> error "TODO add PatchType for git patches"
, AP.patchContent = patchContent patch , AP.patchContent = patchContent patch
, AP.patchPrevVersions =
map (encodeRouteLocal . versionUrl) versions
} }
provideHtmlAndAP versionAP $ redirectToPrettyJSON here provideHtmlAndAP versionAP $ redirectToPrettyJSON here
where where
@ -512,11 +518,11 @@ getRepoPatchVersionR
-> KeyHashid Patch -> KeyHashid Patch
-> Handler TypedContent -> Handler TypedContent
getRepoPatchVersionR shr rp ltkhid ptkhid = do getRepoPatchVersionR shr rp ltkhid ptkhid = do
(vcs, patch, author) <- runDB $ do (vcs, patch, author, versions) <- runDB $ do
(_, Entity _ repo, Entity tid _, _, _, _, ta, _) <- getRepoPatch404 shr rp ltkhid (_, Entity _ repo, Entity tid _, _, _, _, ta, v :| vs) <- getRepoPatch404 shr rp ltkhid
(repoVcs repo,,) ptid <- decodeKeyHashid404 ptkhid
<$> do ptid <- decodeKeyHashid404 ptkhid (repoVcs repo,,,)
pt <- get404 ptid <$> do pt <- get404 ptid
unless (patchTicket pt == tid) notFound unless (patchTicket pt == tid) notFound
return pt return pt
<*> bitraverse <*> bitraverse
@ -531,9 +537,12 @@ getRepoPatchVersionR shr rp ltkhid ptkhid = do
return (i, ro) return (i, ro)
) )
ta ta
<*> pure (if ptid == v then vs else [])
encodeRouteLocal <- getEncodeRouteLocal encodeRouteLocal <- getEncodeRouteLocal
encodeRouteHome <- getEncodeRouteHome encodeRouteHome <- getEncodeRouteHome
let versionAP = AP.Patch encodePatchId <- getEncodeKeyHashid
let versionUrl = RepoPatchVersionR shr rp ltkhid . encodePatchId
versionAP = AP.Patch
{ AP.patchId = encodeRouteLocal here { AP.patchId = encodeRouteLocal here
, AP.patchAttributedTo = , AP.patchAttributedTo =
case author of case author of
@ -550,6 +559,8 @@ getRepoPatchVersionR shr rp ltkhid ptkhid = do
VCSDarcs -> PatchTypeDarcs VCSDarcs -> PatchTypeDarcs
VCSGit -> error "TODO add PatchType for git patches" VCSGit -> error "TODO add PatchType for git patches"
, AP.patchContent = patchContent patch , AP.patchContent = patchContent patch
, AP.patchPrevVersions =
map (encodeRouteLocal . versionUrl) versions
} }
provideHtmlAndAP versionAP $ redirectToPrettyJSON here provideHtmlAndAP versionAP $ redirectToPrettyJSON here
where where

View file

@ -845,6 +845,7 @@ data Patch u = Patch
, patchContext :: LocalURI , patchContext :: LocalURI
, patchType :: PatchType , patchType :: PatchType
, patchContent :: Text , patchContent :: Text
, patchPrevVersions :: [LocalURI]
} }
instance ActivityPub Patch where instance ActivityPub Patch where
@ -864,15 +865,17 @@ instance ActivityPub Patch where
<*> withAuthorityO a (o .: "context") <*> withAuthorityO a (o .: "context")
<*> o .: "mediaType" <*> o .: "mediaType"
<*> o .: "content" <*> o .: "content"
<*> (traverse (withAuthorityO a . return) =<< o .:? "previousVersions" .!= [])
toSeries a (Patch id_ attrib published context typ content) toSeries a (Patch id_ attrib published context typ content vers)
= "id" .= ObjURI a id_ = "id" .= ObjURI a id_
<> "type" .= ("Patch" :: Text) <> "type" .= ("Patch" :: Text)
<> "attributedTo" .= attrib <> "attributedTo" .= attrib
<> "context" .= ObjURI a context <> "context" .= ObjURI a context
<> "published" .= published <> "published" .= published
<> "mediaType" .= typ <> "mediaType" .= typ
<> "content" .= content <> "content" .= content
<> "previousVersions" .= map (ObjURI a) vers
data TicketLocal = TicketLocal data TicketLocal = TicketLocal
{ ticketId :: LocalURI { ticketId :: LocalURI