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
, 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

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
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"

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

@ -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 =

12
src/Web/ActivityPub.hs
View file

@ -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)