forge/Vervis
1
0
Fork 0
Code Pull requests Activity

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

Browse source
This commit is contained in:
fr33domlover 2020-07-23 10:47:35 +00:00
parent c1f0722c21
commit b050c9225d
4 changed files with 24 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/Vervis/API.hs
View file

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

4
src/Vervis/Federation/Ticket.hs
View file

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

18
src/Vervis/Handler/Patch.hs
View file

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

12
src/Web/ActivityPub.hs
View file

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