Web.ActivityPub: Add PatchLocal type similar to TicketLocal
This commit is contained in:
parent
fa3348513a
commit
216aaa72ee
2 changed files with 73 additions and 29 deletions
|
@ -265,19 +265,26 @@ getSharerPatchVersionR shr talkhid ptkhid = do
|
||||||
encodeRouteLocal <- getEncodeRouteLocal
|
encodeRouteLocal <- getEncodeRouteLocal
|
||||||
encodeRouteHome <- getEncodeRouteHome
|
encodeRouteHome <- getEncodeRouteHome
|
||||||
encodePatchId <- getEncodeKeyHashid
|
encodePatchId <- getEncodeKeyHashid
|
||||||
|
hLocal <- getsYesod siteInstanceHost
|
||||||
let versionUrl = SharerPatchVersionR shr talkhid . encodePatchId
|
let versionUrl = SharerPatchVersionR shr talkhid . encodePatchId
|
||||||
versionAP = AP.Patch
|
versionAP = AP.Patch
|
||||||
|
{ AP.patchLocal = Just
|
||||||
|
( hLocal
|
||||||
|
, AP.PatchLocal
|
||||||
{ AP.patchId = encodeRouteLocal here
|
{ AP.patchId = encodeRouteLocal here
|
||||||
, AP.patchAttributedTo = encodeRouteHome $ SharerR shr
|
, AP.patchContext =
|
||||||
|
encodeRouteLocal $ SharerPatchR shr talkhid
|
||||||
|
, AP.patchPrevVersions =
|
||||||
|
map (encodeRouteLocal . versionUrl) versions
|
||||||
|
}
|
||||||
|
)
|
||||||
|
, AP.patchAttributedTo = encodeRouteLocal $ SharerR shr
|
||||||
, AP.patchPublished = patchCreated patch
|
, AP.patchPublished = patchCreated patch
|
||||||
, AP.patchContext = encodeRouteLocal $ SharerPatchR shr talkhid
|
|
||||||
, AP.patchType =
|
, AP.patchType =
|
||||||
case vcs of
|
case vcs of
|
||||||
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
|
||||||
|
@ -541,27 +548,35 @@ getRepoPatchVersionR shr rp ltkhid ptkhid = do
|
||||||
encodeRouteLocal <- getEncodeRouteLocal
|
encodeRouteLocal <- getEncodeRouteLocal
|
||||||
encodeRouteHome <- getEncodeRouteHome
|
encodeRouteHome <- getEncodeRouteHome
|
||||||
encodePatchId <- getEncodeKeyHashid
|
encodePatchId <- getEncodeKeyHashid
|
||||||
|
hLocal <- getsYesod siteInstanceHost
|
||||||
let versionUrl = RepoPatchVersionR shr rp ltkhid . encodePatchId
|
let versionUrl = RepoPatchVersionR shr rp ltkhid . encodePatchId
|
||||||
|
host =
|
||||||
|
case author of
|
||||||
|
Left _ -> hLocal
|
||||||
|
Right (i, _) -> instanceHost i
|
||||||
versionAP = AP.Patch
|
versionAP = AP.Patch
|
||||||
|
{ AP.patchLocal = Just
|
||||||
|
( hLocal
|
||||||
|
, AP.PatchLocal
|
||||||
{ AP.patchId = encodeRouteLocal here
|
{ AP.patchId = encodeRouteLocal here
|
||||||
|
, AP.patchContext =
|
||||||
|
encodeRouteLocal $ RepoPatchR shr rp ltkhid
|
||||||
|
, AP.patchPrevVersions =
|
||||||
|
map (encodeRouteLocal . versionUrl) versions
|
||||||
|
}
|
||||||
|
)
|
||||||
, AP.patchAttributedTo =
|
, AP.patchAttributedTo =
|
||||||
case author of
|
case author of
|
||||||
Left sharer ->
|
Left sharer ->
|
||||||
encodeRouteHome $ SharerR $ sharerIdent sharer
|
encodeRouteLocal $ SharerR $ sharerIdent sharer
|
||||||
Right (inztance, object) ->
|
Right (_, object) -> remoteObjectIdent object
|
||||||
ObjURI
|
|
||||||
(instanceHost inztance)
|
|
||||||
(remoteObjectIdent object)
|
|
||||||
, AP.patchPublished = patchCreated patch
|
, AP.patchPublished = patchCreated patch
|
||||||
, AP.patchContext = encodeRouteLocal $ RepoPatchR shr rp ltkhid
|
|
||||||
, AP.patchType =
|
, AP.patchType =
|
||||||
case vcs of
|
case vcs of
|
||||||
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' host versionAP $ redirectToPrettyJSON here
|
||||||
where
|
where
|
||||||
here = RepoPatchVersionR shr rp ltkhid ptkhid
|
here = RepoPatchVersionR shr rp ltkhid ptkhid
|
||||||
|
|
|
@ -47,6 +47,7 @@ module Web.ActivityPub
|
||||||
, TextHtml (..)
|
, TextHtml (..)
|
||||||
, TextPandocMarkdown (..)
|
, TextPandocMarkdown (..)
|
||||||
, PatchType (..)
|
, PatchType (..)
|
||||||
|
, PatchLocal (..)
|
||||||
, Patch (..)
|
, Patch (..)
|
||||||
, TicketLocal (..)
|
, TicketLocal (..)
|
||||||
, MergeRequest (..)
|
, MergeRequest (..)
|
||||||
|
@ -838,14 +839,45 @@ instance ToJSON PatchType where
|
||||||
where
|
where
|
||||||
render PatchTypeDarcs = "application/x-darcs-patch" :: Text
|
render PatchTypeDarcs = "application/x-darcs-patch" :: Text
|
||||||
|
|
||||||
data Patch u = Patch
|
data PatchLocal = PatchLocal
|
||||||
{ patchId :: LocalURI
|
{ patchId :: LocalURI
|
||||||
, patchAttributedTo :: ObjURI u
|
|
||||||
, patchPublished :: UTCTime
|
|
||||||
, patchContext :: LocalURI
|
, patchContext :: LocalURI
|
||||||
|
, patchPrevVersions :: [LocalURI]
|
||||||
|
}
|
||||||
|
|
||||||
|
parsePatchLocal
|
||||||
|
:: UriMode u => Object -> Parser (Maybe (Authority u, PatchLocal))
|
||||||
|
parsePatchLocal o = do
|
||||||
|
mid <- o .:? "id"
|
||||||
|
case mid of
|
||||||
|
Nothing -> do
|
||||||
|
verifyNothing "context"
|
||||||
|
verifyNothing "previousVersions"
|
||||||
|
return Nothing
|
||||||
|
Just (ObjURI a id_) ->
|
||||||
|
fmap (Just . (a,)) $
|
||||||
|
PatchLocal
|
||||||
|
<$> pure id_
|
||||||
|
<*> withAuthorityO a (o .: "context")
|
||||||
|
<*> (traverse (withAuthorityO a . return) =<< o .:? "previousVersions" .!= [])
|
||||||
|
where
|
||||||
|
verifyNothing t =
|
||||||
|
if t `M.member` o
|
||||||
|
then fail $ T.unpack t ++ " field found, expected none"
|
||||||
|
else return ()
|
||||||
|
|
||||||
|
encodePatchLocal :: UriMode u => Authority u -> PatchLocal -> Series
|
||||||
|
encodePatchLocal a (PatchLocal id_ context versions)
|
||||||
|
= "id" .= ObjURI a id_
|
||||||
|
<> "context" .= ObjURI a context
|
||||||
|
<> "previousVersions" .= map (ObjURI a) versions
|
||||||
|
|
||||||
|
data Patch u = Patch
|
||||||
|
{ patchLocal :: Maybe (Authority u, PatchLocal)
|
||||||
|
, patchAttributedTo :: LocalURI
|
||||||
|
, patchPublished :: UTCTime
|
||||||
, patchType :: PatchType
|
, patchType :: PatchType
|
||||||
, patchContent :: Text
|
, patchContent :: Text
|
||||||
, patchPrevVersions :: [LocalURI]
|
|
||||||
}
|
}
|
||||||
|
|
||||||
instance ActivityPub Patch where
|
instance ActivityPub Patch where
|
||||||
|
@ -856,26 +888,23 @@ instance ActivityPub Patch where
|
||||||
unless (typ == ("Patch" :: Text)) $
|
unless (typ == ("Patch" :: Text)) $
|
||||||
fail "type isn't Patch"
|
fail "type isn't Patch"
|
||||||
|
|
||||||
ObjURI a id_ <- o .: "id"
|
ObjURI a attrib <- o .: "attributedTo"
|
||||||
|
|
||||||
fmap (a,) $
|
fmap (a,) $
|
||||||
Patch id_
|
Patch
|
||||||
<$> o .: "attributedTo"
|
<$> parsePatchLocal o
|
||||||
|
<*> pure attrib
|
||||||
<*> o .: "published"
|
<*> o .: "published"
|
||||||
<*> 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 vers)
|
toSeries a (Patch local attrib published typ content)
|
||||||
= "id" .= ObjURI a id_
|
= maybe mempty (uncurry encodePatchLocal) local
|
||||||
<> "type" .= ("Patch" :: Text)
|
<> "type" .= ("Patch" :: Text)
|
||||||
<> "attributedTo" .= attrib
|
<> "attributedTo" .= ObjURI a attrib
|
||||||
<> "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
|
||||||
|
|
Loading…
Reference in a new issue