Specify deps and rdeps in Ticket as URIs of Collections

This commit is contained in:
fr33domlover 2019-07-11 15:53:55 +00:00
parent 81a05a950f
commit 65edc77747
6 changed files with 22 additions and 35 deletions

View file

@ -489,11 +489,6 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
verifyNothingE (AP.ticketName ticket) "Ticket with 'name'" verifyNothingE (AP.ticketName ticket) "Ticket with 'name'"
verifyNothingE (AP.ticketAssignedTo ticket) "Ticket with 'assignedTo'" verifyNothingE (AP.ticketAssignedTo ticket) "Ticket with 'assignedTo'"
when (AP.ticketIsResolved ticket) $ throwE "Ticket resolved" when (AP.ticketIsResolved ticket) $ throwE "Ticket resolved"
unless (null $ AP.ticketDependsOn ticket) $ throwE "Ticket has deps"
unless (null $ AP.ticketDependedBy ticket) $ throwE "Ticket has rdeps"
--traverse checkDep' $ AP.ticketDependsOn ticket
--where
--checkDep' = checkDep hProject shrProject prjProject
checkRecips hProject shrProject prjProject localRecips = do checkRecips hProject shrProject prjProject localRecips = do
local <- hostIsLocal hProject local <- hostIsLocal hProject
if local if local

View file

@ -80,11 +80,6 @@ checkOffer ticket hProject shrProject prjProject = do
verifyNothingE (AP.ticketName ticket) "Ticket with 'name'" verifyNothingE (AP.ticketName ticket) "Ticket with 'name'"
verifyNothingE (AP.ticketAssignedTo ticket) "Ticket with 'assignedTo'" verifyNothingE (AP.ticketAssignedTo ticket) "Ticket with 'assignedTo'"
when (AP.ticketIsResolved ticket) $ throwE "Ticket resolved" when (AP.ticketIsResolved ticket) $ throwE "Ticket resolved"
unless (null $ AP.ticketDependsOn ticket) $ throwE "Ticket has deps"
unless (null $ AP.ticketDependedBy ticket) $ throwE "Ticket has rdeps"
--traverse checkDep' $ AP.ticketDependsOn ticket
--where
--checkDep' = checkDep hProject shrProject prjProject
sharerOfferTicketF sharerOfferTicketF
:: UTCTime :: UTCTime

View file

@ -614,8 +614,6 @@ postSharerOutboxR shrAuthor = do
, ticketSource = TextPandocMarkdown desc , ticketSource = TextPandocMarkdown desc
, ticketAssignedTo = Nothing , ticketAssignedTo = Nothing
, ticketIsResolved = False , ticketIsResolved = False
, ticketDependsOn = []
, ticketDependedBy = []
} }
offer = Offer offer = Offer
{ offerObject = ticket { offerObject = ticket

View file

@ -205,8 +205,6 @@ postTicketsR shr prj = do
, AP.ticketSource = TextPandocMarkdown desc , AP.ticketSource = TextPandocMarkdown desc
, AP.ticketAssignedTo = Nothing , AP.ticketAssignedTo = Nothing
, AP.ticketIsResolved = False , AP.ticketIsResolved = False
, AP.ticketDependsOn = []
, AP.ticketDependedBy = []
} }
offer = Offer offer = Offer
{ offerObject = ticket { offerObject = ticket
@ -345,9 +343,7 @@ getTicketR shar proj num = do
hLocal <- getsYesod siteInstanceHost hLocal <- getsYesod siteInstanceHost
encodeRouteLocal <- getEncodeRouteLocal encodeRouteLocal <- getEncodeRouteLocal
encodeRouteHome <- getEncodeRouteHome encodeRouteHome <- getEncodeRouteHome
let siblingUri = let host =
encodeRouteHome . TicketR shar proj . ticketNumber . entityVal
host =
case author of case author of
Left _ -> hLocal Left _ -> hLocal
Right (i, _) -> instanceHost i Right (i, _) -> instanceHost i
@ -367,6 +363,10 @@ getTicketR shar proj num = do
encodeRouteLocal $ TicketTeamR shar proj num encodeRouteLocal $ TicketTeamR shar proj num
, AP.ticketEvents = , AP.ticketEvents =
encodeRouteLocal $ TicketEventsR shar proj num encodeRouteLocal $ TicketEventsR shar proj num
, AP.ticketDeps =
encodeRouteLocal $ TicketDepsR shar proj num
, AP.ticketReverseDeps =
encodeRouteLocal $ TicketReverseDepsR shar proj num
} }
) )
@ -385,8 +385,6 @@ getTicketR shar proj num = do
, AP.ticketAssignedTo = , AP.ticketAssignedTo =
encodeRouteHome . SharerR . sharerIdent . fst <$> massignee encodeRouteHome . SharerR . sharerIdent . fst <$> massignee
, AP.ticketIsResolved = ticketStatus ticket == TSClosed , AP.ticketIsResolved = ticketStatus ticket == TSClosed
, AP.ticketDependsOn = map siblingUri deps
, AP.ticketDependedBy = map siblingUri rdeps
} }
provideHtmlAndAP' host ticketAP $(widgetFile "ticket/one") provideHtmlAndAP' host ticketAP $(widgetFile "ticket/one")

View file

@ -759,8 +759,6 @@ changes hLocal ctx =
TextPandocMarkdown $ ticket20190612Source ticket TextPandocMarkdown $ ticket20190612Source ticket
, ticketAssignedTo = Nothing , ticketAssignedTo = Nothing
, ticketIsResolved = False , ticketIsResolved = False
, ticketDependsOn = []
, ticketDependedBy = []
} }
summary = summary =
[hamlet| [hamlet|

View file

@ -632,6 +632,8 @@ data TicketLocal = TicketLocal
, ticketParticipants :: LocalURI , ticketParticipants :: LocalURI
, ticketTeam :: LocalURI , ticketTeam :: LocalURI
, ticketEvents :: LocalURI , ticketEvents :: LocalURI
, ticketDeps :: LocalURI
, ticketReverseDeps :: LocalURI
} }
parseTicketLocal :: Object -> Parser (Maybe (Text, TicketLocal)) parseTicketLocal :: Object -> Parser (Maybe (Text, TicketLocal))
@ -644,6 +646,8 @@ parseTicketLocal o = do
verifyNothing "participants" verifyNothing "participants"
verifyNothing "team" verifyNothing "team"
verifyNothing "history" verifyNothing "history"
verifyNothing "dependencies"
verifyNothing "dependants"
return Nothing return Nothing
Just (h, id_) -> Just (h, id_) ->
fmap (Just . (h,)) $ fmap (Just . (h,)) $
@ -654,6 +658,8 @@ parseTicketLocal o = do
<*> withHost h (f2l <$> o .: "participants") <*> withHost h (f2l <$> o .: "participants")
<*> withHost h (f2l <$> o .: "team") <*> withHost h (f2l <$> o .: "team")
<*> withHost h (f2l <$> o .: "history") <*> withHost h (f2l <$> o .: "history")
<*> withHost h (f2l <$> o .: "dependencies")
<*> withHost h (f2l <$> o .: "dependants")
where where
verifyNothing t = verifyNothing t =
if t `M.member` o if t `M.member` o
@ -661,13 +667,16 @@ parseTicketLocal o = do
else return () else return ()
encodeTicketLocal :: Text -> TicketLocal -> Series encodeTicketLocal :: Text -> TicketLocal -> Series
encodeTicketLocal h (TicketLocal id_ context replies participants team events) encodeTicketLocal
h (TicketLocal id_ context replies participants team events deps rdeps)
= "id" .= l2f h id_ = "id" .= l2f h id_
<> "context" .= l2f h context <> "context" .= l2f h context
<> "replies" .= l2f h replies <> "replies" .= l2f h replies
<> "participants" .= l2f h participants <> "participants" .= l2f h participants
<> "team" .= l2f h team <> "team" .= l2f h team
<> "history" .= l2f h events <> "history" .= l2f h events
<> "dependencies" .= l2f h deps
<> "dependants" .= l2f h rdeps
data Ticket = Ticket data Ticket = Ticket
{ ticketLocal :: Maybe (Text, TicketLocal) { ticketLocal :: Maybe (Text, TicketLocal)
@ -680,8 +689,6 @@ data Ticket = Ticket
, ticketSource :: TextPandocMarkdown , ticketSource :: TextPandocMarkdown
, ticketAssignedTo :: Maybe FedURI , ticketAssignedTo :: Maybe FedURI
, ticketIsResolved :: Bool , ticketIsResolved :: Bool
, ticketDependsOn :: [FedURI]
, ticketDependedBy :: [FedURI]
} }
instance ActivityPub Ticket where instance ActivityPub Ticket where
@ -714,12 +721,10 @@ instance ActivityPub Ticket where
<*> source .: "content" <*> source .: "content"
<*> o .:? "assignedTo" <*> o .:? "assignedTo"
<*> o .: "isResolved" <*> o .: "isResolved"
<*> o .:? "dependsOn" .!= []
<*> o .:? "dependedBy" .!= []
toSeries host toSeries host
(Ticket local attributedTo published updated name summary content (Ticket local attributedTo published updated name summary content
source assignedTo isResolved dependsOn dependedBy) source assignedTo isResolved)
= maybe mempty (uncurry encodeTicketLocal) local = maybe mempty (uncurry encodeTicketLocal) local
<> "type" .= ("Ticket" :: Text) <> "type" .= ("Ticket" :: Text)
@ -736,8 +741,6 @@ instance ActivityPub Ticket where
] ]
<> "assignedTo" .=? assignedTo <> "assignedTo" .=? assignedTo
<> "isResolved" .= isResolved <> "isResolved" .= isResolved
<> "dependsOn" .=% dependsOn
<> "dependedBy" .=% dependedBy
data Accept = Accept data Accept = Accept
{ acceptObject :: FedURI { acceptObject :: FedURI