Web.ActivityPub: Allow to specify 'resolved' and 'resolvedBy' for 'Ticket'
This commit is contained in:
fr33domlover
parent
9317e514b2
commit
7a74dcc55e
8 changed files with 57 additions and 21 deletions
|
|
@ -659,7 +659,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
|
|||
, TextPandocMarkdown
|
||||
)
|
||||
checkTicket (AP.Ticket mlocal attrib mpublished mupdated muContext summary
|
||||
content source muAssigned resolved mmr) = do
|
||||
content source muAssigned mresolved mmr) = do
|
||||
verifyNothingE mlocal "Ticket with 'id'"
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
unless (encodeRouteLocal (SharerR shr) == attrib) $
|
||||
|
|
@ -669,7 +669,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
|
|||
uContext <- fromMaybeE muContext "Ticket without 'context'"
|
||||
context <- checkTracker "Ticket context" uContext
|
||||
verifyNothingE muAssigned "Ticket with 'assignedTo'"
|
||||
when resolved $ throwE "Ticket resolved"
|
||||
when (isJust mresolved) $ throwE "Ticket resolved"
|
||||
mmr' <- traverse (uncurry checkMR) mmr
|
||||
context' <- matchContextAndMR context mmr'
|
||||
return (context', summary, content, source)
|
||||
|
|
@ -1005,7 +1005,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
|
|||
, AP.ticketContent = desc
|
||||
, AP.ticketSource = source
|
||||
, AP.ticketAssignedTo = Nothing
|
||||
, AP.ticketIsResolved = False
|
||||
, AP.ticketResolved = Nothing
|
||||
, AP.ticketAttachment = mmr
|
||||
}
|
||||
, createTarget = Just uTarget
|
||||
|
|
@ -1399,7 +1399,7 @@ offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTar
|
|||
checkTicket
|
||||
shrUser
|
||||
(AP.Ticket mlocal attrib mpublished mupdated muContext summary
|
||||
content source muAssigned resolved mmr) = do
|
||||
content source muAssigned mresolved mmr) = do
|
||||
verifyNothingE mlocal "Ticket with 'id'"
|
||||
shrAttrib <- do
|
||||
route <- fromMaybeE (decodeRouteLocal attrib) "Ticket attrib not a valid route"
|
||||
|
|
@ -1412,7 +1412,7 @@ offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTar
|
|||
verifyNothingE mpublished "Ticket with 'published'"
|
||||
verifyNothingE mupdated "Ticket with 'updated'"
|
||||
verifyNothingE muAssigned "Ticket has 'assignedTo'"
|
||||
when resolved $ throwE "Ticket is resolved"
|
||||
when (isJust mresolved) $ throwE "Ticket is resolved"
|
||||
|
||||
mmr' <- traverse (uncurry checkMR) mmr
|
||||
|
||||
|
|
|
|||
|
|
@ -246,7 +246,7 @@ offerTicket shrAuthor (TextHtml title) (TextPandocMarkdown desc) shr prj = runEx
|
|||
, AP.ticketContent = TextHtml descHtml
|
||||
, AP.ticketSource = TextPandocMarkdown desc
|
||||
, AP.ticketAssignedTo = Nothing
|
||||
, AP.ticketIsResolved = False
|
||||
, AP.ticketResolved = Nothing
|
||||
, AP.ticketAttachment = Nothing
|
||||
}
|
||||
target = encodeRouteHome $ ProjectR shr prj
|
||||
|
|
@ -311,7 +311,7 @@ createTicket shrAuthor (TextHtml title) (TextPandocMarkdown desc) target context
|
|||
, AP.ticketContent = TextHtml descHtml
|
||||
, AP.ticketSource = TextPandocMarkdown desc
|
||||
, AP.ticketAssignedTo = Nothing
|
||||
, AP.ticketIsResolved = False
|
||||
, AP.ticketResolved = Nothing
|
||||
, AP.ticketAttachment = Nothing
|
||||
}
|
||||
create = Create
|
||||
|
|
|
|||
|
|
@ -133,7 +133,7 @@ checkOfferTicket author ticket uTarget = do
|
|||
else return $ Right u
|
||||
|
||||
checkTicket (AP.Ticket mlocal attrib mpublished mupdated muContext summary
|
||||
content source muAssigned resolved mmr) = do
|
||||
content source muAssigned mresolved mmr) = do
|
||||
verifyNothingE mlocal "Ticket with 'id'"
|
||||
unless (attrib == objUriLocal (remoteAuthorURI author)) $
|
||||
throwE "Author created ticket attibuted to someone else"
|
||||
|
|
@ -141,7 +141,7 @@ checkOfferTicket author ticket uTarget = do
|
|||
verifyNothingE mpublished "Ticket has 'published'"
|
||||
verifyNothingE mupdated "Ticket has 'updated'"
|
||||
verifyNothingE muAssigned "Ticket has 'assignedTo'"
|
||||
when resolved $ throwE "Ticket is resolved"
|
||||
when (isJust mresolved) $ throwE "Ticket is resolved"
|
||||
|
||||
mmr' <- traverse (uncurry checkMR) mmr
|
||||
|
||||
|
|
@ -567,7 +567,7 @@ checkCreateTicket author ticket muTarget = do
|
|||
, TextPandocMarkdown
|
||||
)
|
||||
checkTicket (AP.Ticket mlocal attrib mpublished mupdated muContext summary
|
||||
content source muAssigned resolved mmr) = do
|
||||
content source muAssigned mresolved mmr) = do
|
||||
(hTicket, tlocal) <- fromMaybeE mlocal "Ticket without 'id'"
|
||||
hl <- hostIsLocal hTicket
|
||||
when hl $ throwE "Remote author claims to create local ticket"
|
||||
|
|
@ -581,7 +581,7 @@ checkCreateTicket author ticket muTarget = do
|
|||
pub <- fromMaybeE mpublished "Ticket without 'published'"
|
||||
verifyNothingE mupdated "Ticket has 'updated'"
|
||||
verifyNothingE muAssigned "Ticket has 'assignedTo'"
|
||||
when resolved $ throwE "Ticket is resolved"
|
||||
when (isJust mresolved) $ throwE "Ticket is resolved"
|
||||
|
||||
mmr' <- traverse (uncurry checkMR) mmr
|
||||
context' <- matchTicketAndMR (AP.ticketId tlocal) pub context mmr'
|
||||
|
|
|
|||
|
|
@ -460,7 +460,7 @@ postPublishR = do
|
|||
, ticketContent = TextHtml descHtml
|
||||
, ticketSource = TextPandocMarkdown desc
|
||||
, ticketAssignedTo = Nothing
|
||||
, ticketIsResolved = False
|
||||
, ticketResolved = Nothing
|
||||
, ticketAttachment = Nothing
|
||||
}
|
||||
target = encodeRouteFed h $ ProjectR shr prj
|
||||
|
|
|
|||
|
|
@ -176,7 +176,10 @@ getSharerPatchR shr talkhid = do
|
|||
, AP.ticketSource = TextPandocMarkdown $ ticketSource ticket
|
||||
, AP.ticketAssignedTo =
|
||||
encodeRouteHome . SharerR . sharerIdent <$> massignee
|
||||
, AP.ticketIsResolved = ticketStatus ticket == TSClosed
|
||||
, AP.ticketResolved =
|
||||
if ticketStatus ticket == TSClosed
|
||||
then Just (Nothing, Nothing)
|
||||
else Nothing
|
||||
, AP.ticketAttachment = Just
|
||||
( case repo of
|
||||
Left _ -> hLocal
|
||||
|
|
@ -461,7 +464,10 @@ getRepoPatchR shr rp ltkhid = do
|
|||
, AP.ticketSource = TextPandocMarkdown $ ticketSource ticket
|
||||
, AP.ticketAssignedTo =
|
||||
encodeRouteHome . SharerR . sharerIdent <$> massignee
|
||||
, AP.ticketIsResolved = ticketStatus ticket == TSClosed
|
||||
, AP.ticketResolved =
|
||||
if ticketStatus ticket == TSClosed
|
||||
then Just (Nothing, Nothing)
|
||||
else Nothing
|
||||
, AP.ticketAttachment = Just
|
||||
( hLocal
|
||||
, MergeRequest
|
||||
|
|
|
|||
|
|
@ -393,7 +393,10 @@ getProjectTicketR shar proj ltkhid = do
|
|||
, AP.ticketSource = TextPandocMarkdown $ ticketSource ticket
|
||||
, AP.ticketAssignedTo =
|
||||
encodeRouteHome . SharerR . sharerIdent . fst <$> massignee
|
||||
, AP.ticketIsResolved = ticketStatus ticket == TSClosed
|
||||
, AP.ticketResolved =
|
||||
if ticketStatus ticket == TSClosed
|
||||
then Just (Nothing, Nothing)
|
||||
else Nothing
|
||||
, AP.ticketAttachment = Nothing
|
||||
}
|
||||
provideHtmlAndAP' host ticketAP $
|
||||
|
|
@ -1112,7 +1115,10 @@ getSharerTicketR shr talkhid = do
|
|||
, AP.ticketSource = TextPandocMarkdown $ ticketSource ticket
|
||||
, AP.ticketAssignedTo =
|
||||
encodeRouteHome . SharerR . sharerIdent <$> massignee
|
||||
, AP.ticketIsResolved = ticketStatus ticket == TSClosed
|
||||
, AP.ticketResolved =
|
||||
if ticketStatus ticket == TSClosed
|
||||
then Just (Nothing, Nothing)
|
||||
else Nothing
|
||||
, AP.ticketAttachment = Nothing
|
||||
}
|
||||
provideHtmlAndAP ticketAP $ redirectToPrettyJSON here
|
||||
|
|
|
|||
|
|
@ -765,7 +765,7 @@ changes hLocal ctx =
|
|||
, ticketSource =
|
||||
TextPandocMarkdown $ ticket20190612Source ticket
|
||||
, ticketAssignedTo = Nothing
|
||||
, ticketIsResolved = False
|
||||
, ticketResolved = Nothing
|
||||
, ticketAttachment = Nothing
|
||||
}
|
||||
summary =
|
||||
|
|
|
|||
|
|
@ -1002,7 +1002,7 @@ data Ticket u = Ticket
|
|||
, ticketContent :: TextHtml
|
||||
, ticketSource :: TextPandocMarkdown
|
||||
, ticketAssignedTo :: Maybe (ObjURI u)
|
||||
, ticketIsResolved :: Bool
|
||||
, ticketResolved :: Maybe (Maybe (ObjURI u), Maybe UTCTime)
|
||||
, ticketAttachment :: Maybe (Authority u, MergeRequest u)
|
||||
}
|
||||
|
||||
|
|
@ -1024,6 +1024,18 @@ instance ActivityPub Ticket where
|
|||
|
||||
ObjURI a attributedTo <- o .: "attributedTo"
|
||||
|
||||
mresolved <- do
|
||||
is <- o .:? "isResolved" .!= False
|
||||
if is
|
||||
then do
|
||||
at <- o .:? "resolved"
|
||||
by <- o .:? "resolvedBy"
|
||||
return $ Just (by, at)
|
||||
else do
|
||||
verifyNothing "resolved"
|
||||
verifyNothing "resolvedBy"
|
||||
return Nothing
|
||||
|
||||
fmap (a,) $
|
||||
Ticket
|
||||
<$> parseTicketLocal o
|
||||
|
|
@ -1036,12 +1048,17 @@ instance ActivityPub Ticket where
|
|||
<*> (TextHtml . sanitizeBalance <$> o .: "content")
|
||||
<*> source .: "content"
|
||||
<*> o .:? "assignedTo"
|
||||
<*> o .: "isResolved"
|
||||
<*> pure mresolved
|
||||
<*> (traverse parseObject =<< o .:? "attachment")
|
||||
where
|
||||
verifyNothing t =
|
||||
if t `M.member` o
|
||||
then fail $ T.unpack t ++ " field found, expected none"
|
||||
else return ()
|
||||
|
||||
toSeries authority
|
||||
(Ticket local attributedTo published updated context {-name-}
|
||||
summary content source assignedTo isResolved mmr)
|
||||
summary content source assignedTo mresolved mmr)
|
||||
|
||||
= maybe mempty (uncurry encodeTicketLocal) local
|
||||
<> "type" .= ("Ticket" :: Text)
|
||||
|
|
@ -1058,7 +1075,14 @@ instance ActivityPub Ticket where
|
|||
, "mediaType" .= ("text/markdown; variant=Pandoc" :: Text)
|
||||
]
|
||||
<> "assignedTo" .=? assignedTo
|
||||
<> "isResolved" .= isResolved
|
||||
<> maybe
|
||||
("isResolved" .= False)
|
||||
(\ (mby, mat)
|
||||
-> "isResolved" .= True
|
||||
<> "resolvedBy" .=? mby
|
||||
<> "resolved" .=? mat
|
||||
)
|
||||
mresolved
|
||||
<> maybe
|
||||
mempty
|
||||
(\ (h, mr) -> "attachment" `pair` pairs (toSeries h mr))
|
||||
|
|
|
|||
Loading…
Reference in a new issue