naskya/vervis
1
0
Fork 0
mirror of https://code.naskya.net/repos/ndqEd synced 2025-01-10 21:56:46 +09:00
Code Activity

In getSharerTicket, support remote project

Browse source
This commit is contained in:
fr33domlover 2020-05-14 08:59:34 +00:00
parent 003adcbf7b
commit 036c60171b
3 changed files with 31 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/Vervis/API.hs
View file

@ -344,7 +344,7 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note = runEx
mproj <- mproj <-
case project of case project of
Left (Entity _ tpl) -> lift $ Just <$> getProject tpl Left (Entity _ tpl) -> lift $ Just <$> getProject tpl
Right () -> return Nothing Right _ -> return Nothing
return (mproj, localTicketDiscuss lt) return (mproj, localTicketDiscuss lt)
NoteContextProjectTicket shr prj ltid -> do NoteContextProjectTicket shr prj ltid -> do
(_, _, _, Entity _ lt, _, _) <- do (_, _, _, Entity _ lt, _, _) <- do

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

@ -1175,7 +1175,17 @@ getSharerTicketR shr talkhid = do
s <- getJust $ projectSharer j s <- getJust $ projectSharer j
return (s, 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 tp
<*> (for (ticketAssignee t) $ \ pidAssignee -> do <*> (for (ticketAssignee t) $ \ pidAssignee -> do
p <- getJust pidAssignee p <- getJust pidAssignee
@ -1207,12 +1217,14 @@ getSharerTicketR shr talkhid = do
, AP.ticketAttributedTo = encodeRouteLocal $ SharerR shr , AP.ticketAttributedTo = encodeRouteLocal $ SharerR shr
, AP.ticketPublished = Just $ ticketCreated ticket , AP.ticketPublished = Just $ ticketCreated ticket
, AP.ticketUpdated = Nothing , AP.ticketUpdated = Nothing
, AP.ticketContext = , AP.ticketContext =
Just $ encodeRouteHome $ Just $
case project of case project of
Left (s, j) -> Left (s, j) ->
ProjectR (sharerIdent s) (projectIdent j) encodeRouteHome $
Right () -> error "No TPR yet!" ProjectR (sharerIdent s) (projectIdent j)
Right (i, ro) ->
ObjURI (instanceHost i) (remoteObjectIdent ro)
, AP.ticketSummary = TextHtml $ ticketTitle ticket , AP.ticketSummary = TextHtml $ ticketTitle ticket
, AP.ticketContent = TextHtml $ ticketDescription ticket , AP.ticketContent = TextHtml $ ticketDescription ticket
, AP.ticketSource = TextPandocMarkdown $ ticketSource ticket , AP.ticketSource = TextPandocMarkdown $ ticketSource ticket

16
src/Vervis/Ticket.hs
View file

@ -430,7 +430,11 @@ getSharerTicket
( Entity TicketAuthorLocal ( Entity TicketAuthorLocal
, Entity LocalTicket , Entity LocalTicket
, Entity Ticket , Entity Ticket
, Either (Entity TicketProjectLocal) () , Either
(Entity TicketProjectLocal)
( Entity TicketProjectRemote
, Maybe (Entity TicketProjectRemoteAccept)
)
) )
) )
getSharerTicket shr talid = runMaybeT $ do getSharerTicket shr talid = runMaybeT $ do
@ -454,7 +458,9 @@ getSharerTicket shr talid = runMaybeT $ do
guard $ not $ isJust mtup1 guard $ not $ isJust mtup1
return etpl 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 doesn't have project"
"Ticket has both local and remote project" "Ticket has both local and remote project"
@ -467,7 +473,11 @@ getSharerTicket404
( Entity TicketAuthorLocal ( Entity TicketAuthorLocal
, Entity LocalTicket , Entity LocalTicket
, Entity Ticket , Entity Ticket
, Either (Entity TicketProjectLocal) () , Either
(Entity TicketProjectLocal)
( Entity TicketProjectRemote
, Maybe (Entity TicketProjectRemoteAccept)
)
) )
getSharerTicket404 shr talkhid = do getSharerTicket404 shr talkhid = do
talid <- decodeKeyHashid404 talkhid talid <- decodeKeyHashid404 talkhid