forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Specify deps and rdeps in Ticket as URIs of Collections

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

5
src/Vervis/API.hs
View file

@ -489,11 +489,6 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
verifyNothingE (AP.ticketName ticket) "Ticket with 'name'"
verifyNothingE (AP.ticketAssignedTo ticket) "Ticket with 'assignedTo'"
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
local <- hostIsLocal hProject
if local

5
src/Vervis/Federation/Ticket.hs
View file

@ -80,11 +80,6 @@ checkOffer ticket hProject shrProject prjProject = do
verifyNothingE (AP.ticketName ticket) "Ticket with 'name'"
verifyNothingE (AP.ticketAssignedTo ticket) "Ticket with 'assignedTo'"
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
:: UTCTime

2
src/Vervis/Handler/Inbox.hs
View file

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

12
src/Vervis/Handler/Ticket.hs
View file

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

2
src/Vervis/Migration.hs
View file

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

19
src/Web/ActivityPub.hs
View file

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