mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-27 18:04:53 +09:00
S2S: Refactor projectOfferTicketF to use the new utils
This commit is contained in:
fr33domlover
parent
58e88d1e1b
commit
1a8ecb5995
1 changed files with 117 additions and 201 deletions
|
|
@ -238,218 +238,134 @@ projectOfferTicketF
|
|||
-> AP.Ticket URIMode
|
||||
-> FedURI
|
||||
-> ExceptT Text Handler Text
|
||||
projectOfferTicketF
|
||||
now shrRecip prjRecip author body mfwd luOffer ticket uTarget = do
|
||||
targetIsUs <- lift $ runExceptT checkTarget
|
||||
case targetIsUs of
|
||||
Left t -> do
|
||||
logWarn $ T.concat
|
||||
[ recip, " got Offer Ticket with target "
|
||||
, renderObjURI uTarget
|
||||
]
|
||||
return t
|
||||
Right () -> do
|
||||
hLocal <- getsYesod siteInstanceHost
|
||||
{-deps <- -}
|
||||
checkOffer ticket hLocal shrRecip prjRecip
|
||||
let colls =
|
||||
findRelevantCollections shrRecip prjRecip hLocal $
|
||||
activityAudience $ actbActivity body
|
||||
mremotesHttp <- runDBExcept $ do
|
||||
(sid, jid, ibid, fsid{-, tids-}) <-
|
||||
getProjectAndDeps shrRecip prjRecip {-deps-}
|
||||
lift $ do
|
||||
mticket <- do
|
||||
ra <- getJust $ remoteAuthorId author
|
||||
insertTicket ra luOffer jid ibid {-tids-}
|
||||
for mticket $ \ (ractid, obiidAccept, docAccept) -> do
|
||||
msr <- for mfwd $ \ (_, sig) -> do
|
||||
remoteRecips <- deliverFwdLocal ractid colls sid fsid
|
||||
(sig,) <$> deliverRemoteDB_J (actbBL body) ractid jid sig remoteRecips
|
||||
return (msr, obiidAccept, docAccept)
|
||||
lift $ for_ mremotesHttp $ \ (msr, obiidAccept, docAccept) -> do
|
||||
let handler e = logError $ "Project Accept sender: delivery failed! " <> T.pack (displayException e)
|
||||
for msr $ \ (sig, remotesHttp) -> do
|
||||
forkHandler handler $
|
||||
deliverRemoteHTTP_J now shrRecip prjRecip (actbBL body) sig remotesHttp
|
||||
forkHandler handler $ publishAccept luOffer obiidAccept docAccept
|
||||
return $ recip <> " inserted new ticket"
|
||||
projectOfferTicketF now shrRecip prjRecip author body mfwd luOffer ticket uTarget = do
|
||||
(target, summary, content, source) <- checkOfferTicket author ticket uTarget
|
||||
mmhttp <- for (targetRelevance target) $ \ () -> lift $ runDB $ do
|
||||
Entity jid j <- do
|
||||
sid <- getKeyBy404 $ UniqueSharer shrRecip
|
||||
getBy404 $ UniqueProject prjRecip sid
|
||||
mractid <- insertToInbox now author body (projectInbox j) luOffer False
|
||||
for mractid $ \ ractid -> do
|
||||
mremotesHttpFwd <- for mfwd $ \ (localRecips, sig) -> do
|
||||
let sieve =
|
||||
makeRecipientSet
|
||||
[]
|
||||
[ LocalPersonCollectionProjectTeam shrRecip prjRecip
|
||||
, LocalPersonCollectionProjectFollowers shrRecip prjRecip
|
||||
]
|
||||
remoteRecips <-
|
||||
insertRemoteActivityToLocalInboxes
|
||||
False ractid $
|
||||
localRecipSieve'
|
||||
sieve False False localRecips
|
||||
(sig,) <$> deliverRemoteDB_J (actbBL body) ractid jid sig remoteRecips
|
||||
(obiidAccept, docAccept, fwdHostsAccept, recipsAccept) <- do
|
||||
obiidAccept <- insertEmptyOutboxItem (projectOutbox j) now
|
||||
ltid <- insertTicket now author jid summary content source ractid obiidAccept
|
||||
(docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
|
||||
insertAccept shrRecip prjRecip author luOffer ltid obiidAccept
|
||||
knownRemoteRecipsAccept <-
|
||||
deliverLocal'
|
||||
False
|
||||
(LocalActorProject shrRecip prjRecip)
|
||||
(projectInbox j)
|
||||
obiidAccept
|
||||
localRecipsAccept
|
||||
(obiidAccept,docAccept,fwdHostsAccept,) <$>
|
||||
deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept
|
||||
return (mremotesHttpFwd, obiidAccept, docAccept, fwdHostsAccept, recipsAccept)
|
||||
case mmhttp of
|
||||
Nothing -> return "Offer target isn't me, not using"
|
||||
Just mhttp ->
|
||||
case mhttp of
|
||||
Nothing -> return "Activity already in my inbox, doing nothing"
|
||||
Just (mremotesHttpFwd, obiid, doc, fwdHosts, remotes) -> do
|
||||
for_ mremotesHttpFwd $ \ (sig, remotes) ->
|
||||
forkWorker "projectOfferTicketF inbox-forwarding" $
|
||||
deliverRemoteHTTP_J now shrRecip prjRecip (actbBL body) sig remotes
|
||||
forkWorker "projectOfferTicketF Accept HTTP delivery" $
|
||||
deliverRemoteHttp' fwdHosts obiid doc remotes
|
||||
return $
|
||||
case mremotesHttpFwd of
|
||||
Nothing -> "Accepted new ticket, no inbox-forwarding to do"
|
||||
Just _ -> "Accepted new ticket and ran inbox-forwarding of the Offer"
|
||||
where
|
||||
recip = T.concat ["/s/", shr2text shrRecip, "/p/", prj2text prjRecip]
|
||||
checkTarget = do
|
||||
let ObjURI h lu = uTarget
|
||||
local <- hostIsLocal h
|
||||
unless local $
|
||||
throwE $ recip <> " not using; target has different host"
|
||||
route <-
|
||||
case decodeRouteLocal lu of
|
||||
Nothing ->
|
||||
throwE $
|
||||
recip <> " not using; local target isn't a valid route"
|
||||
Just r -> return r
|
||||
(shrTarget, prjTarget) <-
|
||||
case route of
|
||||
ProjectR shr prj -> return (shr, prj)
|
||||
_ -> throwE $
|
||||
recip <>
|
||||
" not using; local target isn't a project route"
|
||||
unless (shrTarget == shrRecip && prjTarget == prjRecip) $
|
||||
throwE $ recip <> " not using; local target is a different project"
|
||||
insertTicket ra luOffer jid ibid {-deps-} = do
|
||||
let iidAuthor = remoteAuthorInstance author
|
||||
roid <-
|
||||
either entityKey id <$> insertBy' (RemoteObject iidAuthor luOffer)
|
||||
let raidAuthor = remoteAuthorId author
|
||||
ractid <- either entityKey id <$> insertBy' RemoteActivity
|
||||
{ remoteActivityIdent = roid
|
||||
, remoteActivityContent = persistJSONFromBL $ actbBL body
|
||||
, remoteActivityReceived = now
|
||||
targetRelevance (Left (shr, prj))
|
||||
| shr == shrRecip && prj == prjRecip = Just ()
|
||||
targetRelevance _ = Nothing
|
||||
insertTicket now author jid summary content source ractidOffer obiidAccept = do
|
||||
did <- insert Discussion
|
||||
fsid <- insert FollowerSet
|
||||
tid <- insert Ticket
|
||||
{ ticketNumber = Nothing
|
||||
, ticketCreated = now
|
||||
, ticketTitle = unTextHtml summary
|
||||
, ticketSource = unTextPandocMarkdown source
|
||||
, ticketDescription = unTextHtml content
|
||||
, ticketAssignee = Nothing
|
||||
, ticketStatus = TSNew
|
||||
, ticketClosed = UTCTime (ModifiedJulianDay 0) 0
|
||||
, ticketCloser = Nothing
|
||||
}
|
||||
ibiid <- insert $ InboxItem False
|
||||
mibirid <- insertUnique $ InboxItemRemote ibid ractid ibiid
|
||||
case mibirid of
|
||||
Nothing -> do
|
||||
delete ibiid
|
||||
return Nothing
|
||||
Just _ibirid -> do
|
||||
{-
|
||||
next <-
|
||||
((subtract 1) . projectNextTicket) <$>
|
||||
updateGet jid [ProjectNextTicket +=. 1]
|
||||
-}
|
||||
did <- insert Discussion
|
||||
fsid <- insert FollowerSet
|
||||
|
||||
obiidAccept <- do
|
||||
obidProject <- do
|
||||
sid <- fromJust <$> getKeyBy (UniqueSharer shrRecip)
|
||||
j <- fromJust <$> getValBy (UniqueProject prjRecip sid)
|
||||
return $ projectOutbox j
|
||||
hLocal <- asksSite siteInstanceHost
|
||||
now <- liftIO getCurrentTime
|
||||
insert OutboxItem
|
||||
{ outboxItemOutbox = obidProject
|
||||
, outboxItemActivity = persistJSONObjectFromDoc $ Doc hLocal emptyActivity
|
||||
, outboxItemPublished = now
|
||||
}
|
||||
|
||||
tid <- insert Ticket
|
||||
{ ticketNumber = Nothing
|
||||
, ticketCreated = now
|
||||
, ticketTitle = unTextHtml $ AP.ticketSummary ticket
|
||||
, ticketSource =
|
||||
unTextPandocMarkdown $ AP.ticketSource ticket
|
||||
, ticketDescription = unTextHtml $ AP.ticketContent ticket
|
||||
, ticketAssignee = Nothing
|
||||
, ticketStatus = TSNew
|
||||
, ticketClosed = UTCTime (ModifiedJulianDay 0) 0
|
||||
, ticketCloser = Nothing
|
||||
}
|
||||
ltid <- insert LocalTicket
|
||||
{ localTicketTicket = tid
|
||||
, localTicketDiscuss = did
|
||||
, localTicketFollowers = fsid
|
||||
}
|
||||
tclid <- insert TicketContextLocal
|
||||
{ ticketContextLocalTicket = tid
|
||||
, ticketContextLocalAccept = obiidAccept
|
||||
}
|
||||
insert_ TicketProjectLocal
|
||||
{ ticketProjectLocalContext = tclid
|
||||
, ticketProjectLocalProject = jid
|
||||
}
|
||||
insert_ TicketAuthorRemote
|
||||
{ ticketAuthorRemoteTicket = tclid
|
||||
, ticketAuthorRemoteAuthor = raidAuthor
|
||||
, ticketAuthorRemoteOpen = ractid
|
||||
}
|
||||
docAccept <- insertAccept ra luOffer ltid obiidAccept
|
||||
-- insertMany_ $ map (TicketDependency tid) deps
|
||||
--insert_ $ RemoteFollow raidAuthor fsid False True
|
||||
return $ Just (ractid, obiidAccept, docAccept)
|
||||
|
||||
insertAccept ra luOffer ltid obiid = do
|
||||
let uAuthor@(ObjURI hAuthor luAuthor) = remoteAuthorURI author
|
||||
ltkhid <- encodeKeyHashid ltid
|
||||
summary <-
|
||||
TextHtml . TL.toStrict . renderHtml <$>
|
||||
withUrlRenderer
|
||||
[hamlet|
|
||||
<p>
|
||||
<a href="#{renderObjURI uAuthor}">
|
||||
$maybe name <- remoteActorName ra
|
||||
#{name}
|
||||
$nothing
|
||||
#{renderAuthority hAuthor}#{localUriPath luAuthor}
|
||||
\'s ticket accepted by project #
|
||||
<a href=@{ProjectR shrRecip prjRecip}>
|
||||
./s/#{shr2text shrRecip}/p/#{prj2text prjRecip}
|
||||
\: #
|
||||
<a href=@{ProjectTicketR shrRecip prjRecip ltkhid}>
|
||||
#{preEscapedToHtml $ unTextHtml $ AP.ticketSummary ticket}.
|
||||
|]
|
||||
hLocal <- asksSite siteInstanceHost
|
||||
ltid <- insert LocalTicket
|
||||
{ localTicketTicket = tid
|
||||
, localTicketDiscuss = did
|
||||
, localTicketFollowers = fsid
|
||||
}
|
||||
tclid <- insert TicketContextLocal
|
||||
{ ticketContextLocalTicket = tid
|
||||
, ticketContextLocalAccept = obiidAccept
|
||||
}
|
||||
insert_ TicketProjectLocal
|
||||
{ ticketProjectLocalContext = tclid
|
||||
, ticketProjectLocalProject = jid
|
||||
}
|
||||
insert_ TicketAuthorRemote
|
||||
{ ticketAuthorRemoteTicket = tclid
|
||||
, ticketAuthorRemoteAuthor = remoteAuthorId author
|
||||
, ticketAuthorRemoteOpen = ractidOffer
|
||||
}
|
||||
return ltid
|
||||
insertAccept shr prj author luOffer ltid obiidAccept = do
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
obikhid <- encodeKeyHashid obiid
|
||||
let recips =
|
||||
remoteAuthorURI author :
|
||||
map encodeRouteHome
|
||||
[ ProjectTeamR shrRecip prjRecip
|
||||
, ProjectFollowersR shrRecip prjRecip
|
||||
|
||||
hLocal <- asksSite siteInstanceHost
|
||||
|
||||
obikhidAccept <- encodeKeyHashid obiidAccept
|
||||
ltkhid <- encodeKeyHashid ltid
|
||||
|
||||
ra <- getJust $ remoteAuthorId author
|
||||
|
||||
let ObjURI hAuthor luAuthor = remoteAuthorURI author
|
||||
|
||||
audAuthor =
|
||||
AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra)
|
||||
audProject =
|
||||
AudLocal []
|
||||
[ LocalPersonCollectionProjectTeam shr prj
|
||||
, LocalPersonCollectionProjectFollowers shr prj
|
||||
]
|
||||
|
||||
(recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||
collectAudience [audAuthor, audProject]
|
||||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
doc = Doc hLocal Activity
|
||||
{ activityId =
|
||||
Just $ encodeRouteLocal $
|
||||
ProjectOutboxItemR shrRecip prjRecip obikhid
|
||||
, activityActor =
|
||||
encodeRouteLocal $ ProjectR shrRecip prjRecip
|
||||
, activitySummary = Just summary
|
||||
ProjectOutboxItemR shr prj obikhidAccept
|
||||
, activityActor = encodeRouteLocal $ ProjectR shr prj
|
||||
, activitySummary = Nothing
|
||||
, activityAudience = Audience recips [] [] [] [] []
|
||||
, activitySpecific = AcceptActivity Accept
|
||||
{ acceptObject =
|
||||
ObjURI
|
||||
(objUriAuthority $ remoteAuthorURI author)
|
||||
luOffer
|
||||
{ acceptObject = ObjURI hAuthor luOffer
|
||||
, acceptResult =
|
||||
Just $ encodeRouteLocal $
|
||||
ProjectTicketR shrRecip prjRecip ltkhid
|
||||
Just $ encodeRouteLocal $ ProjectTicketR shr prj ltkhid
|
||||
}
|
||||
}
|
||||
update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc]
|
||||
return doc
|
||||
|
||||
publishAccept luOffer obiid doc = do
|
||||
now <- liftIO getCurrentTime
|
||||
let dont = Authority "dont-do.any-forwarding" Nothing
|
||||
remotesHttp <- runDB $ do
|
||||
(sid, project) <- do
|
||||
sid <- fromJust <$> getKeyBy (UniqueSharer shrRecip)
|
||||
j <- fromJust <$> getValBy (UniqueProject prjRecip sid)
|
||||
return (sid, j)
|
||||
moreRemotes <- deliverLocal now sid (projectFollowers project) obiid
|
||||
let raidAuthor = remoteAuthorId author
|
||||
ra <- getJust raidAuthor
|
||||
ro <- getJust $ remoteActorIdent ra
|
||||
let raInfo = RemoteRecipient raidAuthor (remoteObjectIdent ro) (remoteActorInbox ra) (remoteActorErrorSince ra)
|
||||
iidAuthor = remoteAuthorInstance author
|
||||
hAuthor = objUriAuthority $ remoteAuthorURI author
|
||||
hostSection = ((iidAuthor, hAuthor), raInfo :| [])
|
||||
remotes = unionRemotes [hostSection] moreRemotes
|
||||
deliverRemoteDB' dont obiid [] remotes
|
||||
site <- askSite
|
||||
liftIO $ runWorker (deliverRemoteHttp dont obiid doc remotesHttp) site
|
||||
where
|
||||
deliverLocal now sid fsid obiid = do
|
||||
(pidsTeam, remotesTeam) <- getProjectTeam sid
|
||||
(pidsFollowers, remotesFollowers) <- getFollowers fsid
|
||||
let pids = LO.union pidsTeam pidsFollowers
|
||||
remotes = unionRemotes remotesTeam remotesFollowers
|
||||
for_ pids $ \ pid -> do
|
||||
ibid <- personInbox <$> getJust pid
|
||||
ibiid <- insert $ InboxItem True
|
||||
insert_ $ InboxItemLocal ibid obiid ibiid
|
||||
return remotes
|
||||
update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc]
|
||||
return (doc, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
checkCreateTicket
|
||||
:: RemoteAuthor
|
||||
|
|
@ -1159,7 +1075,7 @@ projectOfferDepF now shrRecip prjRecip author body mfwd luOffer dep uTarget = do
|
|||
doc = Doc hLocal Activity
|
||||
{ activityId =
|
||||
Just $ encodeRouteLocal $
|
||||
SharerOutboxItemR shrRecip obikhidAccept
|
||||
ProjectOutboxItemR shrRecip prjRecip obikhidAccept
|
||||
, activityActor = encodeRouteLocal $ ProjectR shrRecip prjRecip
|
||||
, activitySummary = Nothing
|
||||
, activityAudience = Audience recips [] [] [] [] []
|
||||
|
|
@ -1320,7 +1236,7 @@ repoOfferDepF now shrRecip rpRecip author body mfwd luOffer dep uTarget = do
|
|||
doc = Doc hLocal Activity
|
||||
{ activityId =
|
||||
Just $ encodeRouteLocal $
|
||||
SharerOutboxItemR shrRecip obikhidAccept
|
||||
RepoOutboxItemR shrRecip rpRecip obikhidAccept
|
||||
, activityActor = encodeRouteLocal $ RepoR shrRecip rpRecip
|
||||
, activitySummary = Nothing
|
||||
, activityAudience = Audience recips [] [] [] [] []
|
||||
|
|
|
|||
Loading…
Reference in a new issue