From 036c60171bfa0c2241625a1e2bc247bb73f32855 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Thu, 14 May 2020 08:59:34 +0000
Subject: [PATCH] In getSharerTicket, support remote project
---
src/Vervis/API.hs | 2 +-
src/Vervis/Handler/Ticket.hs | 22 +++++++++++++++++-----
src/Vervis/Ticket.hs | 16 +++++++++++++---
3 files changed, 31 insertions(+), 9 deletions(-)
diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs
index 797e469..81e56f7 100644
--- a/src/Vervis/API.hs
+++ b/src/Vervis/API.hs
@@ -344,7 +344,7 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note = runEx
mproj <-
case project of
Left (Entity _ tpl) -> lift $ Just <$> getProject tpl
- Right () -> return Nothing
+ Right _ -> return Nothing
return (mproj, localTicketDiscuss lt)
NoteContextProjectTicket shr prj ltid -> do
(_, _, _, Entity _ lt, _, _) <- do
diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs
index b19286c..1045a13 100644
--- a/src/Vervis/Handler/Ticket.hs
+++ b/src/Vervis/Handler/Ticket.hs
@@ -1175,7 +1175,17 @@ getSharerTicketR shr talkhid = do
s <- getJust $ projectSharer j
return (s, j)
)
- return
+ (\ (Entity _ tpr, _) -> do
+ roid <-
+ case ticketProjectRemoteProject tpr of
+ Nothing ->
+ remoteActorIdent <$>
+ getJust (ticketProjectRemoteTracker tpr)
+ Just roid -> return roid
+ ro <- getJust roid
+ i <- getJust $ remoteObjectInstance ro
+ return (i, ro)
+ )
tp
<*> (for (ticketAssignee t) $ \ pidAssignee -> do
p <- getJust pidAssignee
@@ -1207,12 +1217,14 @@ getSharerTicketR shr talkhid = do
, AP.ticketAttributedTo = encodeRouteLocal $ SharerR shr
, AP.ticketPublished = Just $ ticketCreated ticket
, AP.ticketUpdated = Nothing
- , AP.ticketContext =
- Just $ encodeRouteHome $
+ , AP.ticketContext =
+ Just $
case project of
Left (s, j) ->
- ProjectR (sharerIdent s) (projectIdent j)
- Right () -> error "No TPR yet!"
+ encodeRouteHome $
+ ProjectR (sharerIdent s) (projectIdent j)
+ Right (i, ro) ->
+ ObjURI (instanceHost i) (remoteObjectIdent ro)
, AP.ticketSummary = TextHtml $ ticketTitle ticket
, AP.ticketContent = TextHtml $ ticketDescription ticket
, AP.ticketSource = TextPandocMarkdown $ ticketSource ticket
diff --git a/src/Vervis/Ticket.hs b/src/Vervis/Ticket.hs
index e1f2d26..6b30d7f 100644
--- a/src/Vervis/Ticket.hs
+++ b/src/Vervis/Ticket.hs
@@ -430,7 +430,11 @@ getSharerTicket
( Entity TicketAuthorLocal
, Entity LocalTicket
, Entity Ticket
- , Either (Entity TicketProjectLocal) ()
+ , Either
+ (Entity TicketProjectLocal)
+ ( Entity TicketProjectRemote
+ , Maybe (Entity TicketProjectRemoteAccept)
+ )
)
)
getSharerTicket shr talid = runMaybeT $ do
@@ -454,7 +458,9 @@ getSharerTicket shr talid = runMaybeT $ do
guard $ not $ isJust mtup1
return etpl
)
- (return Nothing
+ (do mtpr <- lift $ getBy $ UniqueTicketProjectRemote talid
+ lift $ for mtpr $ \ etpr@(Entity tprid _) ->
+ (etpr,) <$> getBy (UniqueTicketProjectRemoteAccept tprid)
)
"Ticket doesn't have project"
"Ticket has both local and remote project"
@@ -467,7 +473,11 @@ getSharerTicket404
( Entity TicketAuthorLocal
, Entity LocalTicket
, Entity Ticket
- , Either (Entity TicketProjectLocal) ()
+ , Either
+ (Entity TicketProjectLocal)
+ ( Entity TicketProjectRemote
+ , Maybe (Entity TicketProjectRemoteAccept)
+ )
)
getSharerTicket404 shr talkhid = do
talid <- decodeKeyHashid404 talkhid