From 65edc777476d3a6c5b79a33e0674f81f29c8834a Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Thu, 11 Jul 2019 15:53:55 +0000 Subject: [PATCH] Specify deps and rdeps in Ticket as URIs of Collections --- src/Vervis/API.hs | 5 ----- src/Vervis/Federation/Ticket.hs | 5 ----- src/Vervis/Handler/Inbox.hs | 2 -- src/Vervis/Handler/Ticket.hs | 12 +++++------- src/Vervis/Migration.hs | 2 -- src/Web/ActivityPub.hs | 31 +++++++++++++++++-------------- 6 files changed, 22 insertions(+), 35 deletions(-) diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index 80ec23a..e179b3d 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -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 diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs index 31e7ada..ab62885 100644 --- a/src/Vervis/Federation/Ticket.hs +++ b/src/Vervis/Federation/Ticket.hs @@ -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 diff --git a/src/Vervis/Handler/Inbox.hs b/src/Vervis/Handler/Inbox.hs index f7b7465..6703138 100644 --- a/src/Vervis/Handler/Inbox.hs +++ b/src/Vervis/Handler/Inbox.hs @@ -614,8 +614,6 @@ postSharerOutboxR shrAuthor = do , ticketSource = TextPandocMarkdown desc , ticketAssignedTo = Nothing , ticketIsResolved = False - , ticketDependsOn = [] - , ticketDependedBy = [] } offer = Offer { offerObject = ticket diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index bf65476..18fb3c2 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -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") diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index fbd59f4..8cc4ad2 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -759,8 +759,6 @@ changes hLocal ctx = TextPandocMarkdown $ ticket20190612Source ticket , ticketAssignedTo = Nothing , ticketIsResolved = False - , ticketDependsOn = [] - , ticketDependedBy = [] } summary = [hamlet| diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 2d65662..d7e78cd 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -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) - = "id" .= l2f h id_ - <> "context" .= l2f h context - <> "replies" .= l2f h replies - <> "participants" .= l2f h participants - <> "team" .= l2f h team - <> "history" .= l2f h 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