Web.ActivityPub: Add 'currentVersion' property to 'Patch' type

src/Vervis/API.hs

@@ -935,6 +935,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
                                                                 SharerPatchVersionR shrUser talkhid ptkhid
                                                 , patchContext = luTicket
                                                 , patchPrevVersions = []
+                                                , patchCurrentVersion = Nothing
                                                 }
                                             )
                                         , AP.patchAttributedTo = luAttrib
@@ -966,6 +967,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
                                                                 SharerPatchVersionR shrUser talkhid ptkhid
                                                 , patchContext = luTicket
                                                 , patchPrevVersions = []
+                                                , patchCurrentVersion = Nothing
                                                 }
                                             )
                                         , AP.patchAttributedTo = luAttrib

src/Vervis/Federation/Ticket.hs

@@ -638,11 +638,13 @@ checkCreateTicket author ticket muTarget = do
             checkPatch h (AP.Patch mlocal attrib mpub typ content) = do
                 mlocal' <-
                     for mlocal $
-                        \ (h', PatchLocal luId luContext versions) -> do
+                        \ (h', PatchLocal luId luContext versions mcurr) -> do
                             unless (h == h') $
                                 throwE "Patch & its author on different hosts"
                             unless (null versions) $
                                 throwE "Patch has versions"
+                            unless (isNothing mcurr) $
+                                throwE "Patch has 'currentVersion'"
                             return (luId, luContext)
                 unless (ObjURI h attrib == remoteAuthorURI author) $
                     throwE "Ticket & Patch attrib mismatch"

src/Vervis/Handler/Patch.hs

@@ -254,7 +254,7 @@ getSharerPatchVersionR
     -> KeyHashid Patch
     -> Handler TypedContent
 getSharerPatchVersionR shr talkhid ptkhid = do
-    (vcs, patch, versions) <- runDB $ do
+    (vcs, patch, (versions, mcurr)) <- runDB $ do
         (_, _, Entity tid _, repo, v :| vs) <- getSharerPatch404 shr talkhid
         ptid <- decodeKeyHashid404 ptkhid
         (,,) <$> case repo of
@@ -265,7 +265,7 @@ getSharerPatchVersionR shr talkhid ptkhid = do
              <*> do pt <- get404 ptid
                     unless (patchTicket pt == tid) notFound
                     return pt
-             <*> pure (if ptid == v then vs else [])
+             <*> pure (if ptid == v then (vs, Nothing) else ([], Just v))
     encodeRouteLocal <- getEncodeRouteLocal
     encodeRouteHome <- getEncodeRouteHome
     encodePatchId <- getEncodeKeyHashid
@@ -280,6 +280,8 @@ getSharerPatchVersionR shr talkhid ptkhid = do
                         encodeRouteLocal $ SharerPatchR shr talkhid
                     , AP.patchPrevVersions   =
                         map (encodeRouteLocal . versionUrl) versions
+                    , AP.patchCurrentVersion =
+                        encodeRouteLocal . versionUrl <$> mcurr
                     }
                 )
             , AP.patchAttributedTo = encodeRouteLocal $ SharerR shr
@@ -531,7 +533,7 @@ getRepoPatchVersionR
     -> KeyHashid Patch
     -> Handler TypedContent
 getRepoPatchVersionR shr rp ltkhid ptkhid = do
-    (vcs, patch, author, versions) <- runDB $ do
+    (vcs, patch, author, (versions, mcurr)) <- runDB $ do
         (_, Entity _ repo, Entity tid _, _, _, _, ta, v :| vs) <- getRepoPatch404 shr rp ltkhid
         ptid <- decodeKeyHashid404 ptkhid
         (repoVcs repo,,,)
@@ -550,7 +552,7 @@ getRepoPatchVersionR shr rp ltkhid ptkhid = do
                         return (i, ro)
                     )
                     ta
-            <*> pure (if ptid == v then vs else [])
+            <*> pure (if ptid == v then (vs, Nothing) else ([], Just v))
     encodeRouteLocal <- getEncodeRouteLocal
     encodeRouteHome <- getEncodeRouteHome
     encodePatchId <- getEncodeKeyHashid
@@ -569,6 +571,8 @@ getRepoPatchVersionR shr rp ltkhid ptkhid = do
                         encodeRouteLocal $ RepoPatchR shr rp ltkhid
                     , AP.patchPrevVersions =
                         map (encodeRouteLocal . versionUrl) versions
+                    , AP.patchCurrentVersion =
+                        encodeRouteLocal . versionUrl <$> mcurr
                     }
                 )
             , AP.patchAttributedTo =

src/Web/ActivityPub.hs

@@ -843,6 +843,7 @@ data PatchLocal = PatchLocal
     { patchId              :: LocalURI
     , patchContext         :: LocalURI
     , patchPrevVersions    :: [LocalURI]
+    , patchCurrentVersion  :: Maybe LocalURI
     }
 
 parsePatchLocal
@@ -853,6 +854,7 @@ parsePatchLocal o = do
         Nothing -> do
             verifyNothing "context"
             verifyNothing "previousVersions"
+            verifyNothing "currentVersion"
             return Nothing
         Just (ObjURI a id_) ->
             fmap (Just . (a,)) $
@@ -860,6 +862,7 @@ parsePatchLocal o = do
                     <$> pure id_
                     <*> withAuthorityO a (o .: "context")
                     <*> (traverse (withAuthorityO a . return) =<< o .:? "previousVersions" .!= [])
+                    <*> withAuthorityMaybeO a (o .:? "currentVersion")
     where
     verifyNothing t =
         if t `M.member` o
@@ -867,10 +870,11 @@ parsePatchLocal o = do
             else return ()
 
 encodePatchLocal :: UriMode u => Authority u -> PatchLocal -> Series
-encodePatchLocal a (PatchLocal id_ context versions)
+encodePatchLocal a (PatchLocal id_ context versions mcurrent)
     =  "id"               .= ObjURI a id_
     <> "context"          .= ObjURI a context
     <> "previousVersions" .= map (ObjURI a) versions
+    <> "currentVersion"   .=? (ObjURI a <$> mcurrent)
 
 data Patch u = Patch
     { patchLocal        :: Maybe (Authority u, PatchLocal)