mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-27 18:04:53 +09:00
GET ticket handlers: Provide 'resolvedBy', set to the Resolve activity's ID URI
This commit is contained in:
parent
de5d24edca
commit
5a0c46ad5c
4 changed files with 119 additions and 45 deletions
|
@ -54,6 +54,10 @@ module Vervis.ActivityPub
|
|||
, verifyContentTypeAP_E
|
||||
, parseActivity
|
||||
, getActivity
|
||||
, ActorEntity (..)
|
||||
, getOutboxActorEntity
|
||||
, actorEntityPath
|
||||
, outboxItemRoute
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -105,7 +109,7 @@ import Yesod.HttpSignature
|
|||
import Database.Persist.JSON
|
||||
import Network.FedURI
|
||||
import Network.HTTP.Digest
|
||||
import Web.ActivityPub hiding (Author (..), Ticket)
|
||||
import Web.ActivityPub hiding (Author (..), Ticket, Project, Repo)
|
||||
import Yesod.ActivityPub
|
||||
import Yesod.MonadSite
|
||||
import Yesod.FedURI
|
||||
|
@ -1265,3 +1269,31 @@ getActivity (Right u@(ObjURI h lu)) = lift $ runMaybeT $ Right <$> do
|
|||
iid <- MaybeT $ getKeyBy $ UniqueInstance h
|
||||
roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid lu
|
||||
MaybeT $ getKeyBy $ UniqueRemoteActivity roid
|
||||
|
||||
data ActorEntity
|
||||
= ActorPerson (Entity Person)
|
||||
| ActorProject (Entity Project)
|
||||
| ActorRepo (Entity Repo)
|
||||
|
||||
getOutboxActorEntity obid = do
|
||||
mp <- getBy $ UniquePersonOutbox obid
|
||||
mj <- getBy $ UniqueProjectOutbox obid
|
||||
mr <- getBy $ UniqueRepoOutbox obid
|
||||
case (mp, mj, mr) of
|
||||
(Nothing, Nothing, Nothing) -> error "obid not in use"
|
||||
(Just p, Nothing, Nothing) -> return $ ActorPerson p
|
||||
(Nothing, Just j, Nothing) -> return $ ActorProject j
|
||||
(Nothing, Nothing, Just r) -> return $ ActorRepo r
|
||||
|
||||
actorEntityPath (ActorPerson (Entity _ p)) =
|
||||
LocalActorSharer . sharerIdent <$> getJust (personIdent p)
|
||||
actorEntityPath (ActorProject (Entity _ j)) =
|
||||
flip LocalActorProject (projectIdent j) . sharerIdent <$>
|
||||
getJust (projectSharer j)
|
||||
actorEntityPath (ActorRepo (Entity _ r)) =
|
||||
flip LocalActorRepo (repoIdent r) . sharerIdent <$>
|
||||
getJust (repoSharer r)
|
||||
|
||||
outboxItemRoute (LocalActorSharer shr) = SharerOutboxItemR shr
|
||||
outboxItemRoute (LocalActorProject shr prj) = ProjectOutboxItemR shr prj
|
||||
outboxItemRoute (LocalActorRepo shr rp) = RepoOutboxItemR shr rp
|
||||
|
|
|
@ -480,11 +480,6 @@ undoFollowRepo shrAuthor pidAuthor shrFollowee rpFollowee =
|
|||
repoFollowers <$>
|
||||
fromMaybeE mr "Unfollow target no such local repo"
|
||||
|
||||
data ActorEntity
|
||||
= ActorPerson (Entity Person)
|
||||
| ActorProject (Entity Project)
|
||||
| ActorRepo (Entity Repo)
|
||||
|
||||
unresolve
|
||||
:: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
|
||||
=> ShrIdent
|
||||
|
@ -540,24 +535,3 @@ unresolve shrUser wi = runExceptT $ do
|
|||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
return (Nothing, Audience recips [] [] [] [] [], Undo uResolve)
|
||||
where
|
||||
getOutboxActorEntity obid = do
|
||||
mp <- getBy $ UniquePersonOutbox obid
|
||||
mj <- getBy $ UniqueProjectOutbox obid
|
||||
mr <- getBy $ UniqueRepoOutbox obid
|
||||
case (mp, mj, mr) of
|
||||
(Nothing, Nothing, Nothing) -> error "obid not in use"
|
||||
(Just p, Nothing, Nothing) -> return $ ActorPerson p
|
||||
(Nothing, Just j, Nothing) -> return $ ActorProject j
|
||||
(Nothing, Nothing, Just r) -> return $ ActorRepo r
|
||||
actorEntityPath (ActorPerson (Entity _ p)) =
|
||||
LocalActorSharer . sharerIdent <$> getJust (personIdent p)
|
||||
actorEntityPath (ActorProject (Entity _ j)) =
|
||||
flip LocalActorProject (projectIdent j) . sharerIdent <$>
|
||||
getJust (projectSharer j)
|
||||
actorEntityPath (ActorRepo (Entity _ r)) =
|
||||
flip LocalActorRepo (repoIdent r) . sharerIdent <$>
|
||||
getJust (repoSharer r)
|
||||
outboxItemRoute (LocalActorSharer shr) = SharerOutboxItemR shr
|
||||
outboxItemRoute (LocalActorProject shr prj) = ProjectOutboxItemR shr prj
|
||||
outboxItemRoute (LocalActorRepo shr rp) = RepoOutboxItemR shr rp
|
||||
|
|
|
@ -404,9 +404,9 @@ getRepoPatchesR shr rp = do
|
|||
getRepoPatchR
|
||||
:: ShrIdent -> RpIdent -> KeyHashid LocalTicket -> Handler TypedContent
|
||||
getRepoPatchR shr rp ltkhid = do
|
||||
(ticket, ptid, trl, author, massignee) <- runDB $ do
|
||||
(_, _, Entity tid t, _, _, Entity _ trl, ta, _, ptid :| _) <- getRepoPatch404 shr rp ltkhid
|
||||
(,,,,) t ptid trl
|
||||
(ticket, ptid, trl, author, massignee, mresolved) <- runDB $ do
|
||||
(_, _, Entity tid t, _, _, Entity _ trl, ta, tr, ptid :| _) <- getRepoPatch404 shr rp ltkhid
|
||||
(,,,,,) t ptid trl
|
||||
<$> bitraverse
|
||||
(\ (Entity _ tal, _) -> do
|
||||
p <- getJust $ ticketAuthorLocalAuthor tal
|
||||
|
@ -423,10 +423,30 @@ getRepoPatchR shr rp ltkhid = do
|
|||
p <- getJust pidAssignee
|
||||
getJust $ personIdent p
|
||||
)
|
||||
<*> (for tr $ \ (_, etrx) ->
|
||||
bitraverse
|
||||
(\ (Entity _ trl) -> do
|
||||
let obiid = ticketResolveLocalActivity trl
|
||||
obid <- outboxItemOutbox <$> getJust obiid
|
||||
ent <- getOutboxActorEntity obid
|
||||
actor <- actorEntityPath ent
|
||||
return (actor, obiid)
|
||||
)
|
||||
(\ (Entity _ trr) -> do
|
||||
roid <-
|
||||
remoteActivityIdent <$>
|
||||
getJust (ticketResolveRemoteActivity trr)
|
||||
ro <- getJust roid
|
||||
i <- getJust $ remoteObjectInstance ro
|
||||
return (i, ro)
|
||||
)
|
||||
etrx
|
||||
)
|
||||
hLocal <- getsYesod siteInstanceHost
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
encodePatchId <- getEncodeKeyHashid
|
||||
encodeObiid <- getEncodeKeyHashid
|
||||
let host =
|
||||
case author of
|
||||
Left _ -> hLocal
|
||||
|
@ -465,9 +485,12 @@ getRepoPatchR shr rp ltkhid = do
|
|||
, AP.ticketAssignedTo =
|
||||
encodeRouteHome . SharerR . sharerIdent <$> massignee
|
||||
, AP.ticketResolved =
|
||||
if ticketStatus ticket == TSClosed
|
||||
then Just (Nothing, Nothing)
|
||||
else Nothing
|
||||
let u (Left (actor, obiid)) =
|
||||
encodeRouteHome $
|
||||
outboxItemRoute actor $ encodeObiid obiid
|
||||
u (Right (i, ro)) =
|
||||
ObjURI (instanceHost i) (remoteObjectIdent ro)
|
||||
in (,Nothing) . Just . u <$> mresolved
|
||||
, AP.ticketAttachment = Just
|
||||
( hLocal
|
||||
, MergeRequest
|
||||
|
|
|
@ -297,9 +297,9 @@ getProjectTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Ty
|
|||
getProjectTicketR shar proj ltkhid = do
|
||||
mpid <- maybeAuthId
|
||||
( wshr, wfl,
|
||||
author, massignee, ticket, lticket, tparams, eparams, cparams) <-
|
||||
author, massignee, mresolved, ticket, lticket, tparams, eparams, cparams) <-
|
||||
runDB $ do
|
||||
(Entity sid sharer, Entity jid project, Entity tid ticket, Entity _ lticket, _etcl, _etpl, author, _) <- getProjectTicket404 shar proj ltkhid
|
||||
(Entity sid sharer, Entity jid project, Entity tid ticket, Entity _ lticket, _etcl, _etpl, author, resolved) <- getProjectTicket404 shar proj ltkhid
|
||||
(wshr, wid, wfl) <- do
|
||||
w <- get404 $ projectWorkflow project
|
||||
wsharer <-
|
||||
|
@ -325,12 +325,30 @@ getProjectTicketR shar proj ltkhid = do
|
|||
person <- get404 apid
|
||||
sharer <- get404 $ personIdent person
|
||||
return (sharer, fromMaybe False $ (== apid) <$> mpid)
|
||||
mresolved <- for resolved $ \ (_, etrx) ->
|
||||
bitraverse
|
||||
(\ (Entity _ trl) -> do
|
||||
let obiid = ticketResolveLocalActivity trl
|
||||
obid <- outboxItemOutbox <$> getJust obiid
|
||||
ent <- getOutboxActorEntity obid
|
||||
actor <- actorEntityPath ent
|
||||
return (actor, obiid)
|
||||
)
|
||||
(\ (Entity _ trr) -> do
|
||||
roid <-
|
||||
remoteActivityIdent <$>
|
||||
getJust (ticketResolveRemoteActivity trr)
|
||||
ro <- getJust roid
|
||||
i <- getJust $ remoteObjectInstance ro
|
||||
return (i, ro)
|
||||
)
|
||||
etrx
|
||||
tparams <- getTicketTextParams tid wid
|
||||
eparams <- getTicketEnumParams tid wid
|
||||
cparams <- getTicketClasses tid wid
|
||||
return
|
||||
( wshr, wfl
|
||||
, author', massignee, ticket, lticket
|
||||
, author', massignee, mresolved, ticket, lticket
|
||||
, tparams, eparams, cparams
|
||||
)
|
||||
encodeHid <- getEncodeKeyHashid
|
||||
|
@ -352,6 +370,7 @@ getProjectTicketR shar proj ltkhid = do
|
|||
hLocal <- getsYesod siteInstanceHost
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
encodeKeyHashid <- getEncodeKeyHashid
|
||||
let host =
|
||||
case author of
|
||||
Left _ -> hLocal
|
||||
|
@ -394,9 +413,12 @@ getProjectTicketR shar proj ltkhid = do
|
|||
, AP.ticketAssignedTo =
|
||||
encodeRouteHome . SharerR . sharerIdent . fst <$> massignee
|
||||
, AP.ticketResolved =
|
||||
if ticketStatus ticket == TSClosed
|
||||
then Just (Nothing, Nothing)
|
||||
else Nothing
|
||||
let u (Left (actor, obiid)) =
|
||||
encodeRouteHome $
|
||||
outboxItemRoute actor $ encodeKeyHashid obiid
|
||||
u (Right (i, ro)) =
|
||||
ObjURI (instanceHost i) (remoteObjectIdent ro)
|
||||
in (,Nothing) . Just . u <$> mresolved
|
||||
, AP.ticketAttachment = Nothing
|
||||
}
|
||||
provideHtmlAndAP' host ticketAP $
|
||||
|
@ -1051,9 +1073,9 @@ getSharerTicketsR =
|
|||
getSharerTicketR
|
||||
:: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
|
||||
getSharerTicketR shr talkhid = do
|
||||
(ticket, project, massignee) <- runDB $ do
|
||||
(_, _, Entity _ t, tp, _) <- getSharerTicket404 shr talkhid
|
||||
(,,) t
|
||||
(ticket, project, massignee, mresolved) <- runDB $ do
|
||||
(_, _, Entity _ t, tp, tr) <- getSharerTicket404 shr talkhid
|
||||
(,,,) t
|
||||
<$> bitraverse
|
||||
(\ (_, Entity _ tpl) -> do
|
||||
j <- getJust $ ticketProjectLocalProject tpl
|
||||
|
@ -1076,9 +1098,29 @@ getSharerTicketR shr talkhid = do
|
|||
p <- getJust pidAssignee
|
||||
getJust $ personIdent p
|
||||
)
|
||||
<*> (for tr $ \ (_, etrx) ->
|
||||
bitraverse
|
||||
(\ (Entity _ trl) -> do
|
||||
let obiid = ticketResolveLocalActivity trl
|
||||
obid <- outboxItemOutbox <$> getJust obiid
|
||||
ent <- getOutboxActorEntity obid
|
||||
actor <- actorEntityPath ent
|
||||
return (actor, obiid)
|
||||
)
|
||||
(\ (Entity _ trr) -> do
|
||||
roid <-
|
||||
remoteActivityIdent <$>
|
||||
getJust (ticketResolveRemoteActivity trr)
|
||||
ro <- getJust roid
|
||||
i <- getJust $ remoteObjectInstance ro
|
||||
return (i, ro)
|
||||
)
|
||||
etrx
|
||||
)
|
||||
hLocal <- getsYesod siteInstanceHost
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
encodeKeyHashid <- getEncodeKeyHashid
|
||||
let ticketAP = AP.Ticket
|
||||
{ AP.ticketLocal = Just
|
||||
( hLocal
|
||||
|
@ -1116,9 +1158,12 @@ getSharerTicketR shr talkhid = do
|
|||
, AP.ticketAssignedTo =
|
||||
encodeRouteHome . SharerR . sharerIdent <$> massignee
|
||||
, AP.ticketResolved =
|
||||
if ticketStatus ticket == TSClosed
|
||||
then Just (Nothing, Nothing)
|
||||
else Nothing
|
||||
let u (Left (actor, obiid)) =
|
||||
encodeRouteHome $
|
||||
outboxItemRoute actor $ encodeKeyHashid obiid
|
||||
u (Right (i, ro)) =
|
||||
ObjURI (instanceHost i) (remoteObjectIdent ro)
|
||||
in (,Nothing) . Just . u <$> mresolved
|
||||
, AP.ticketAttachment = Nothing
|
||||
}
|
||||
provideHtmlAndAP ticketAP $ redirectToPrettyJSON here
|
||||
|
|
Loading…
Reference in a new issue