In getSharerTicket, support remote project

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

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

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