diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index 5aac2cc..668013f 100644 --- a/src/Vervis/API.hs +++ b/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 diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs index e1a0755..16684c0 100644 --- a/src/Vervis/Federation/Ticket.hs +++ b/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" diff --git a/src/Vervis/Handler/Patch.hs b/src/Vervis/Handler/Patch.hs index 7d00c20..226a014 100644 --- a/src/Vervis/Handler/Patch.hs +++ b/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 @@ -275,11 +275,13 @@ getSharerPatchVersionR shr talkhid ptkhid = do { AP.patchLocal = Just ( hLocal , AP.PatchLocal - { AP.patchId = encodeRouteLocal here - , AP.patchContext = + { AP.patchId = encodeRouteLocal here + , AP.patchContext = encodeRouteLocal $ SharerPatchR shr talkhid - , AP.patchPrevVersions = + , 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 = diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 826e265..f6fcdea 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -840,9 +840,10 @@ instance ToJSON PatchType where render PatchTypeDarcs = "application/x-darcs-patch" :: Text data PatchLocal = PatchLocal - { patchId :: LocalURI - , patchContext :: LocalURI - , patchPrevVersions :: [LocalURI] + { 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)