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