From f76e80c0288a9ad462aa142caafbc0ffb217551e Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Tue, 25 Oct 2022 16:12:48 +0000 Subject: [PATCH] S2S: Re-implement and re-enable deckResolveF --- src/Vervis/Federation/Ticket.hs | 243 ++++++++++++++++++-------------- src/Vervis/Handler/Deck.hs | 4 +- 2 files changed, 139 insertions(+), 108 deletions(-) diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs index ff9733c..b1f034a 100644 --- a/src/Vervis/Federation/Ticket.hs +++ b/src/Vervis/Federation/Ticket.hs @@ -25,7 +25,7 @@ module Vervis.Federation.Ticket --, deckOfferDepF --, repoOfferDepF - --, deckResolveF + , deckResolveF --, repoResolveF ) where @@ -91,6 +91,7 @@ import qualified Data.Text.UTF8.Local as TU import Development.PatchMediaType +import Vervis.Access import Vervis.ActivityPub import Vervis.Cloth import Vervis.Data.Actor @@ -1870,135 +1871,165 @@ deckResolveF -> ActivityBody -> Maybe (RecipientRoutes, ByteString) -> LocalURI - -> Resolve URIMode - -> ExceptT Text Handler Text -deckResolveF now recipHash author body mfwd luResolve (Resolve uObject) = do - error "projectResolveF temporarily disabled" + -> AP.Resolve URIMode + -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text)) +deckResolveF now recipDeckHash author body mfwd luResolve (AP.Resolve uObject) = (,Nothing) <$> do + -- Check input + recipDeckID <- decodeKeyHashid404 recipDeckHash + taskID <- nameExceptT "Resolve object" $ do + route <- do + routeOrRemote <- parseFedURI uObject + case routeOrRemote of + Left route -> pure route + Right _ -> throwE "Remote, so definitely not mine" + case route of + TicketR deckHash taskHash | deckHash == recipDeckHash -> + decodeKeyHashidE taskHash "Invalid task keyhashid" + _ -> throwE "Local route but not a ticket of mine" -{- + -- Verify the capability URI is one of: + -- * Outbox item URI of a local actor, i.e. a local activity + -- * A remote URI + capID <- do + uCap <- do + fromMaybeE + (activityCapability $ actbActivity body) + "Asking to resolve ticket but no capability provided" + nameExceptT "Resolve capability" $ parseActivityURI uCap + maybeHttp <- runDBExcept $ do - object <- parseWorkItem "Resolve object" uObject - mmmmhttp <- runDBExcept $ do - (Entity jidRecip projectRecip, actorRecip) <- lift $ do - sid <- getKeyBy404 $ UniqueSharer shrRecip - ej@(Entity _ j) <- getBy404 $ UniqueProject prjRecip sid - (ej,) <$> getJust (projectActor j) - mltid <- - case relevantObject object of - Nothing -> do - case object of - Left wi -> verifyWorkItemExists wi - Right _ -> return () - return Nothing - Just ltid -> Just . (ltid,) <$> getObjectLtid ltid - mractid <- lift $ insertToInbox now author body (actorInbox actorRecip) luResolve False - lift $ for mractid $ \ ractid -> for mltid $ \ (ltid, tid) -> do - mremotesHttpFwd <- for mfwd $ \ (localRecips, sig) -> do - ltkhid <- encodeKeyHashid ltid + -- Find recipient deck in DB, returning 404 if doesn't exist because + -- we're in the deck's inbox post handler + recipDeck <- lift $ get404 recipDeckID + let recipDeckActorID = deckActor recipDeck + recipDeckActor <- lift $ getJust recipDeckActorID + + -- Insert the Resolve to deck's inbox + mractid <- lift $ insertToInbox now author body (actorInbox recipDeckActor) luResolve False + for mractid $ \ resolveID -> do + + -- Find ticket in DB, verify it's not resolved + ticketID <- do + maybeTicket <- lift $ getTicket recipDeckID taskID + (_deck, _task, Entity ticketID _, _author, maybeResolve) <- + fromMaybeE maybeTicket "I don't have such a ticket in DB" + unless (isNothing maybeResolve) $ + throwE "Ticket is already resolved" + return ticketID + + -- Verify the sender is authorized by the deck to resolve a ticket + capability <- + case capID of + Left (capActor, _, capItem) -> return (capActor, capItem) + Right _ -> throwE "Capability is a remote URI, i.e. not authored by the local deck" + verifyCapability + capability + (Right $ remoteAuthorId author) + (GrantResourceDeck recipDeckID) + + -- Forward the Resolve activity to relevant local stages, and + -- schedule delivery for unavailable remote members of them + maybeHttpFwdResolve <- lift $ for mfwd $ \ (localRecips, sig) -> do + taskHash <- encodeKeyHashid taskID let sieve = makeRecipientSet [] - [ LocalPersonCollectionProjectTicketFollowers shrRecip prjRecip ltkhid - , LocalPersonCollectionProjectTeam shrRecip prjRecip - , LocalPersonCollectionProjectFollowers shrRecip prjRecip + [ LocalStageDeckFollowers recipDeckHash + , LocalStageTicketFollowers recipDeckHash taskHash ] - remoteRecips <- - insertRemoteActivityToLocalInboxes - False ractid $ - localRecipSieve' - sieve False False localRecips - (sig,) <$> deliverRemoteDB_J (actbBL body) ractid jidRecip sig remoteRecips - obiidAccept <- insertEmptyOutboxItem (actorOutbox actorRecip) now - mmtrrid <- insertResolve author ltid ractid obiidAccept - case mmtrrid of - Just (Just _) -> update tid [TicketStatus =. TSClosed] - _ -> delete obiidAccept - for mmtrrid $ \ mtrrid -> for mtrrid $ \ trrid -> do - (docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <- - insertAccept luResolve ltid obiidAccept - knownRemoteRecipsAccept <- - deliverLocal' - False - (LocalActorProject shrRecip prjRecip) - (actorInbox actorRecip) - obiidAccept - localRecipsAccept - (mremotesHttpFwd,obiidAccept,docAccept,fwdHostsAccept,) <$> - deliverRemoteDB fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept - case mmmmhttp of - Nothing -> return "I already have this activity in my inbox, doing nothing" - Just mmmhttp -> - case mmmhttp of - Nothing -> return "Object not mine, just stored in inbox" - Just mmhttp -> - case mmhttp of - Nothing -> return "Ticket already resolved" - Just mhttp -> - case mhttp of - Nothing -> return "Activity already resolved a ticket" - Just (mremotesHttpFwd, obiid, doc, fwdHosts, recips) -> do - for_ mremotesHttpFwd $ \ (sig, remotes) -> - forkWorker "projectResolveF inbox-forwarding" $ - deliverRemoteHTTP_J now shrRecip prjRecip (actbBL body) sig remotes - forkWorker "projectResolveF Accept HTTP delivery" $ - deliverRemoteHttp' fwdHosts obiid doc recips - return $ - if isJust mremotesHttpFwd - then "Ticket is mine, now resolved, did inbox-forwarding" - else "Ticket is mine, now resolved, no inbox-forwarding to do" + forwardActivityDB + (actbBL body) localRecips sig recipDeckActorID + (LocalActorDeck recipDeckHash) sieve resolveID + + -- Mark ticket in DB as resolved by the Resolve + acceptID <- + lift $ insertEmptyOutboxItem (actorOutbox recipDeckActor) now + lift $ insertResolve ticketID resolveID acceptID + + -- Prepare an Accept activity and insert to deck's outbox + (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <- + lift $ prepareAccept taskID + _luAccept <- lift $ updateOutboxItem (LocalActorDeck recipDeckID) acceptID actionAccept + + -- Deliver the Accept to local recipients, and schedule delivery + -- for unavailable remote recipients + deliverHttpAccept <- + deliverActivityDB + (LocalActorDeck recipDeckHash) recipDeckActorID + localRecipsAccept remoteRecipsAccept fwdHostsAccept + acceptID actionAccept + + -- Return instructions for HTTP inbox-forwarding of the Resolve + -- activity, and for HTTP delivery of the Accept activity to + -- remote recipients + return (maybeHttpFwdResolve, deliverHttpAccept) + + -- Launch asynchronous HTTP forwarding of the Resolve activity and HTTP + -- delivery of the Accept activity + case maybeHttp of + Nothing -> + return "I already have this activity in my inbox, doing nothing" + Just (maybeHttpFwdResolve, deliverHttpAccept) -> do + for_ maybeHttpFwdResolve $ + forkWorker "deckResolveF inbox-forwarding" + forkWorker "deckResolveF Accept HTTP delivery" deliverHttpAccept + return $ + case maybeHttpFwdResolve of + Nothing -> "Resolved ticket, no inbox-forwarding to do" + Just _ -> + "Resolved ticket and ran inbox-forwarding of the Resolve" + where - relevantObject (Left (WorkItemProjectTicket shr prj ltid)) - | shr == shrRecip && prj == prjRecip = Just ltid - relevantObject _ = Nothing - getObjectLtid ltid = do - (_, _, Entity tid _, _, _, _, _, _) <- do - mticket <- lift $ getProjectTicket shrRecip prjRecip ltid - fromMaybeE mticket $ "Object" <> ": No such project-ticket" - return tid + insertResolve ticketID resolveID acceptID = do + trid <- insert TicketResolve + { ticketResolveTicket = ticketID + , ticketResolveAccept = acceptID + } + insert_ TicketResolveRemote + { ticketResolveRemoteTicket = trid + , ticketResolveRemoteActivity = resolveID + , ticketResolveRemoteActor = remoteAuthorId author + } - insertAccept luResolve ltid obiidAccept = do - encodeRouteLocal <- getEncodeRouteLocal + prepareAccept taskID = do encodeRouteHome <- getEncodeRouteHome - hLocal <- asksSite siteInstanceHost - obikhidAccept <- encodeKeyHashid obiidAccept - ltkhid <- encodeKeyHashid ltid + + taskHash <- encodeKeyHashid taskID + ra <- getJust $ remoteAuthorId author + let ObjURI hAuthor luAuthor = remoteAuthorURI author - audAuthor = - AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra) - - audTicket = + audSender = + AudRemote hAuthor + [luAuthor] + (maybeToList $ remoteActorFollowers ra) + audTracker = AudLocal [] - [ LocalPersonCollectionProjectTicketFollowers shrRecip prjRecip ltkhid - , LocalPersonCollectionProjectTeam shrRecip prjRecip - , LocalPersonCollectionProjectFollowers shrRecip prjRecip + [ LocalStageDeckFollowers recipDeckHash + , LocalStageTicketFollowers recipDeckHash taskHash ] (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = - collectAudience [audAuthor, audTicket] + collectAudience [audSender, audTracker] recips = map encodeRouteHome audLocal ++ audRemote - doc = Doc hLocal Activity - { activityId = - Just $ encodeRouteLocal $ - ProjectOutboxItemR shrRecip prjRecip obikhidAccept - , activityActor = encodeRouteLocal $ ProjectR shrRecip prjRecip - , activityCapability = Nothing - , activitySummary = Nothing - , activityAudience = Audience recips [] [] [] [] [] - , activitySpecific = AcceptActivity Accept - { acceptObject = ObjURI hAuthor luResolve - , acceptResult = Nothing + action = AP.Action + { AP.actionCapability = Nothing + , AP.actionSummary = Nothing + , AP.actionAudience = AP.Audience recips [] [] [] [] [] + , AP.actionFulfills = [] + , AP.actionSpecific = AP.AcceptActivity AP.Accept + { AP.acceptObject = ObjURI hAuthor luResolve + , AP.acceptResult = Nothing } } - update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc] - return (doc, recipientSet, remoteActors, fwdHosts) --} + + return (action, recipientSet, remoteActors, fwdHosts) repoResolveF :: UTCTime diff --git a/src/Vervis/Handler/Deck.hs b/src/Vervis/Handler/Deck.hs index d01e133..fbf949f 100644 --- a/src/Vervis/Handler/Deck.hs +++ b/src/Vervis/Handler/Deck.hs @@ -211,9 +211,9 @@ postDeckInboxR recipDeckHash = projectOfferDepF now shrRecip prjRecip remoteAuthor body mfwd luActivity dep target -} _ -> return ("Unsupported offer object type for decks", Nothing) + AP.ResolveActivity resolve -> + deckResolveF now recipDeckHash author body mfwd luActivity resolve {- - ResolveActivity resolve -> - (,Nothing) <$> projectResolveF now shrRecip prjRecip remoteAuthor body mfwd luActivity resolve UndoActivity undo -> (,Nothing) <$> projectUndoF shrRecip prjRecip now remoteAuthor body mfwd luActivity undo -}