forge/Vervis
1
0
Fork 0
Code Pull requests Activity

GET ticket handlers: Provide 'resolvedBy', set to the Resolve activity's ID URI

Browse source
This commit is contained in:
fr33domlover 2020-08-05 12:43:04 +00:00
parent de5d24edca
commit 5a0c46ad5c
4 changed files with 119 additions and 45 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
src/Vervis/ActivityPub.hs
View file

@ -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

26
src/Vervis/Client.hs
View file

@ -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

35
src/Vervis/Handler/Patch.hs
View file

@ -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

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

@ -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