S2S: Port Deck's & Loom's Resolve handlers from the old system
This commit is contained in:
Pere Lev
parent
cb693184f8
commit
35eb4917a1
3 changed files with 323 additions and 252 deletions
|
|
@ -485,6 +485,166 @@ deckOffer now deckID (Verse authorIdMsig body) (AP.Offer object uTarget) = do
|
|||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
-- Meaning: An actor is asking to close a ticket
|
||||
-- Behavior:
|
||||
-- * Verify it's my ticket
|
||||
-- * Verify the Resolve is authorized
|
||||
-- * Insert the Resolve to my inbox
|
||||
-- * Close the ticket in my DB
|
||||
-- * Forward the Resolve to my followers & ticket followers
|
||||
-- * Publish an Accept to:
|
||||
-- - My followers
|
||||
-- - Ticket's followers
|
||||
-- - Resolve sender+followers
|
||||
deckResolve
|
||||
:: UTCTime
|
||||
-> DeckId
|
||||
-> Verse
|
||||
-> AP.Resolve URIMode
|
||||
-> ActE (Text, Act (), Next)
|
||||
deckResolve now deckID (Verse authorIdMsig body) (AP.Resolve uObject) = do
|
||||
|
||||
-- Check input
|
||||
deckHash <- encodeKeyHashid deckID
|
||||
taskHash <- 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' == deckHash ->
|
||||
return taskHash
|
||||
_ -> throwE "Local route but not a ticket of mine"
|
||||
taskID <- decodeKeyHashidE taskHash "Invalid TicketDeck keyhashid"
|
||||
|
||||
-- Check capability
|
||||
capability <- do
|
||||
|
||||
-- Verify that a capability is provided
|
||||
uCap <- do
|
||||
let muCap = AP.activityCapability $ actbActivity body
|
||||
fromMaybeE muCap "No capability provided"
|
||||
|
||||
-- Verify the capability URI is one of:
|
||||
-- * Outbox item URI of a local actor, i.e. a local activity
|
||||
-- * A remote URI
|
||||
cap <- nameExceptT "Resolve.capability" $ parseActivityURI' uCap
|
||||
|
||||
-- Verify the capability is local
|
||||
case cap of
|
||||
Left (actorByKey, _, outboxItemID) ->
|
||||
return (actorByKey, outboxItemID)
|
||||
_ -> throwE "Capability is remote i.e. definitely not by me"
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
(deckRecip, actorRecip) <- lift $ do
|
||||
d <- getJust deckID
|
||||
(d,) <$> getJust (deckActor d)
|
||||
|
||||
-- Find ticket in DB, verify it's not resolved
|
||||
ticketID <- do
|
||||
maybeTicket <- lift $ getTicket deckID 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
|
||||
|
||||
-- Insert the Resolve to my inbox
|
||||
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
|
||||
for mractid $ \ resolveDB -> do
|
||||
|
||||
-- Verify the sender is authorized by the tracker to resolve a ticket
|
||||
verifyCapability'
|
||||
capability
|
||||
authorIdMsig
|
||||
(GrantResourceDeck deckID)
|
||||
AP.RoleTriage
|
||||
|
||||
-- Prepare forwarding the Resolve to my followers & ticket
|
||||
-- followers
|
||||
let sieve =
|
||||
makeRecipientSet []
|
||||
[ LocalStageDeckFollowers deckHash
|
||||
, LocalStageTicketFollowers deckHash taskHash
|
||||
]
|
||||
|
||||
-- Mark ticket in DB as resolved by the Resolve
|
||||
acceptID <- lift $ insertEmptyOutboxItem' (actorOutbox actorRecip) now
|
||||
lift $ insertResolve ticketID resolveDB acceptID
|
||||
|
||||
-- Prepare an Accept activity and insert to my outbox
|
||||
accept@(actionAccept, _, _, _) <- lift $ prepareAccept taskID
|
||||
let recipByKey = LocalActorDeck deckID
|
||||
_luAccept <- lift $ updateOutboxItem' recipByKey acceptID actionAccept
|
||||
|
||||
return (deckActor deckRecip, sieve, acceptID, accept)
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just (deckActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
|
||||
forwardActivity
|
||||
authorIdMsig body (LocalActorDeck deckID) deckActorID sieve
|
||||
lift $ sendActivity
|
||||
(LocalActorDeck deckID) deckActorID localRecipsAccept
|
||||
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
|
||||
done "Resolved ticket and forwarded the Resolve"
|
||||
|
||||
where
|
||||
|
||||
insertResolve ticketID resolveDB acceptID = do
|
||||
trid <- insert TicketResolve
|
||||
{ ticketResolveTicket = ticketID
|
||||
, ticketResolveAccept = acceptID
|
||||
}
|
||||
case resolveDB of
|
||||
Left (_actorByKey, _, resolveID) ->
|
||||
insert_ TicketResolveLocal
|
||||
{ ticketResolveLocalTicket = trid
|
||||
, ticketResolveLocalActivity = resolveID
|
||||
}
|
||||
Right (author, _, resolveID) ->
|
||||
insert_ TicketResolveRemote
|
||||
{ ticketResolveRemoteTicket = trid
|
||||
, ticketResolveRemoteActivity = resolveID
|
||||
, ticketResolveRemoteActor = remoteAuthorId author
|
||||
}
|
||||
|
||||
prepareAccept taskID = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
|
||||
audSender <- makeAudSenderWithFollowers authorIdMsig
|
||||
deckHash <- encodeKeyHashid deckID
|
||||
taskHash <- encodeKeyHashid taskID
|
||||
let audDeck =
|
||||
AudLocal
|
||||
[]
|
||||
[ LocalStageDeckFollowers deckHash
|
||||
, LocalStageTicketFollowers deckHash taskHash
|
||||
]
|
||||
uResolve <- lift $ getActivityURI authorIdMsig
|
||||
|
||||
let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||
collectAudience [audSender, audDeck]
|
||||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
action = AP.Action
|
||||
{ AP.actionCapability = Nothing
|
||||
, AP.actionSummary = Nothing
|
||||
, AP.actionAudience = AP.Audience recips [] [] [] [] []
|
||||
, AP.actionFulfills = [uResolve]
|
||||
, AP.actionSpecific = AP.AcceptActivity AP.Accept
|
||||
{ AP.acceptObject = uResolve
|
||||
, AP.acceptResult = Nothing
|
||||
}
|
||||
}
|
||||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Following
|
||||
------------------------------------------------------------------------------
|
||||
|
|
@ -920,6 +1080,7 @@ deckBehavior now deckID (Left verse@(Verse _authorIdMsig body)) =
|
|||
AP.OfferActivity offer -> deckOffer now deckID verse offer
|
||||
AP.RejectActivity reject -> deckReject now deckID verse reject
|
||||
AP.RemoveActivity remove -> deckRemove now deckID verse remove
|
||||
AP.ResolveActivity resolve -> deckResolve now deckID verse resolve
|
||||
AP.UndoActivity undo -> deckUndo now deckID verse undo
|
||||
_ -> throwE "Unsupported activity type for Deck"
|
||||
deckBehavior _ _ (Right _) = throwE "ClientMsgs aren't supported for Deck"
|
||||
|
|
|
|||
|
|
@ -409,10 +409,171 @@ loomOffer now loomID (Verse authorIdMsig body) (AP.Offer object uTarget) = do
|
|||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
-- Meaning: An actor is asking to close a MR
|
||||
-- Behavior:
|
||||
-- * Verify it's my MR
|
||||
-- * Verify the Resolve is authorized
|
||||
-- * Insert the Resolve to my inbox
|
||||
-- * Close the MR in my DB
|
||||
-- * Forward the Resolve to my followers & MR followers
|
||||
-- * Publish an Accept to:
|
||||
-- - My followers
|
||||
-- - MR's followers
|
||||
-- - Resolve sender+followers
|
||||
loomResolve
|
||||
:: UTCTime
|
||||
-> LoomId
|
||||
-> Verse
|
||||
-> AP.Resolve URIMode
|
||||
-> ActE (Text, Act (), Next)
|
||||
loomResolve now loomID (Verse authorIdMsig body) (AP.Resolve uObject) = do
|
||||
|
||||
-- Check input
|
||||
loomHash <- encodeKeyHashid loomID
|
||||
clothHash <- 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
|
||||
ClothR loomHash' clothHash | loomHash' == loomHash ->
|
||||
return clothHash
|
||||
_ -> throwE "Local route but not a MR of mine"
|
||||
clothID <- decodeKeyHashidE clothHash "Invalid TicketLoom keyhashid"
|
||||
|
||||
-- Check capability
|
||||
capability <- do
|
||||
|
||||
-- Verify that a capability is provided
|
||||
uCap <- do
|
||||
let muCap = AP.activityCapability $ actbActivity body
|
||||
fromMaybeE muCap "No capability provided"
|
||||
|
||||
-- Verify the capability URI is one of:
|
||||
-- * Outbox item URI of a local actor, i.e. a local activity
|
||||
-- * A remote URI
|
||||
cap <- nameExceptT "Resolve.capability" $ parseActivityURI' uCap
|
||||
|
||||
-- Verify the capability is local
|
||||
case cap of
|
||||
Left (actorByKey, _, outboxItemID) ->
|
||||
return (actorByKey, outboxItemID)
|
||||
_ -> throwE "Capability is remote i.e. definitely not by me"
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
(loomRecip, actorRecip) <- lift $ do
|
||||
d <- getJust loomID
|
||||
(d,) <$> getJust (loomActor d)
|
||||
|
||||
-- Find ticket in DB, verify it's not resolved
|
||||
ticketID <- do
|
||||
maybeCloth <- lift $ getCloth loomID clothID
|
||||
(_loom, _cloth, Entity ticketID _, _author, maybeResolve, _merge) <-
|
||||
fromMaybeE maybeCloth "I don't have such a MR in DB"
|
||||
unless (isNothing maybeResolve) $
|
||||
throwE "MR is already resolved"
|
||||
return ticketID
|
||||
|
||||
-- Insert the Resolve to my inbox
|
||||
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
|
||||
for mractid $ \ resolveDB -> do
|
||||
|
||||
-- Verify the sender is authorized by the tracker to resolve a ticket
|
||||
verifyCapability'
|
||||
capability
|
||||
authorIdMsig
|
||||
(GrantResourceLoom loomID)
|
||||
AP.RoleTriage
|
||||
|
||||
-- Prepare forwarding the Resolve to my followers & ticket
|
||||
-- followers
|
||||
let sieve =
|
||||
makeRecipientSet []
|
||||
[ LocalStageLoomFollowers loomHash
|
||||
, LocalStageClothFollowers loomHash clothHash
|
||||
]
|
||||
|
||||
-- Mark ticket in DB as resolved by the Resolve
|
||||
acceptID <- lift $ insertEmptyOutboxItem' (actorOutbox actorRecip) now
|
||||
lift $ insertResolve ticketID resolveDB acceptID
|
||||
|
||||
-- Prepare an Accept activity and insert to my outbox
|
||||
accept@(actionAccept, _, _, _) <- lift $ prepareAccept clothID
|
||||
let recipByKey = LocalActorLoom loomID
|
||||
_luAccept <- lift $ updateOutboxItem' recipByKey acceptID actionAccept
|
||||
|
||||
return (loomActor loomRecip, sieve, acceptID, accept)
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just (loomActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
|
||||
forwardActivity
|
||||
authorIdMsig body (LocalActorLoom loomID) loomActorID sieve
|
||||
lift $ sendActivity
|
||||
(LocalActorLoom loomID) loomActorID localRecipsAccept
|
||||
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
|
||||
done "Resolved ticket and forwarded the Resolve"
|
||||
|
||||
where
|
||||
|
||||
insertResolve ticketID resolveDB acceptID = do
|
||||
trid <- insert TicketResolve
|
||||
{ ticketResolveTicket = ticketID
|
||||
, ticketResolveAccept = acceptID
|
||||
}
|
||||
case resolveDB of
|
||||
Left (_actorByKey, _, resolveID) ->
|
||||
insert_ TicketResolveLocal
|
||||
{ ticketResolveLocalTicket = trid
|
||||
, ticketResolveLocalActivity = resolveID
|
||||
}
|
||||
Right (author, _, resolveID) ->
|
||||
insert_ TicketResolveRemote
|
||||
{ ticketResolveRemoteTicket = trid
|
||||
, ticketResolveRemoteActivity = resolveID
|
||||
, ticketResolveRemoteActor = remoteAuthorId author
|
||||
}
|
||||
|
||||
prepareAccept clothID = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
|
||||
audSender <- makeAudSenderWithFollowers authorIdMsig
|
||||
loomHash <- encodeKeyHashid loomID
|
||||
clothHash <- encodeKeyHashid clothID
|
||||
let audLoom =
|
||||
AudLocal
|
||||
[]
|
||||
[ LocalStageLoomFollowers loomHash
|
||||
, LocalStageClothFollowers loomHash clothHash
|
||||
]
|
||||
uResolve <- lift $ getActivityURI authorIdMsig
|
||||
|
||||
let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||
collectAudience [audSender, audLoom]
|
||||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
action = AP.Action
|
||||
{ AP.actionCapability = Nothing
|
||||
, AP.actionSummary = Nothing
|
||||
, AP.actionAudience = AP.Audience recips [] [] [] [] []
|
||||
, AP.actionFulfills = [uResolve]
|
||||
, AP.actionSpecific = AP.AcceptActivity AP.Accept
|
||||
{ AP.acceptObject = uResolve
|
||||
, AP.acceptResult = Nothing
|
||||
}
|
||||
}
|
||||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
loomBehavior :: UTCTime -> LoomId -> VerseExt -> ActE (Text, Act (), Next)
|
||||
loomBehavior now loomID (Left verse@(Verse _authorIdMsig body)) =
|
||||
case AP.activitySpecific $ actbActivity body of
|
||||
AP.OfferActivity offer -> loomOffer now loomID verse offer
|
||||
AP.OfferActivity offer -> loomOffer now loomID verse offer
|
||||
AP.ResolveActivity resolve -> loomResolve now loomID verse resolve
|
||||
_ -> throwE "Unsupported activity type for Loom"
|
||||
loomBehavior _ _ (Right _) = throwE "ClientMsgs aren't supported for Loom"
|
||||
|
||||
|
|
|
|||
|
|
@ -25,9 +25,6 @@ module Vervis.Federation.Ticket
|
|||
|
||||
--, deckOfferDepF
|
||||
--, repoOfferDepF
|
||||
|
||||
, deckResolveF
|
||||
, loomResolveF
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -1387,251 +1384,3 @@ insertResolve author ltid ractid obiidAccept = do
|
|||
, ticketResolveRemoteActor = remoteAuthorId author
|
||||
}
|
||||
-}
|
||||
|
||||
trackerResolveF
|
||||
:: ( PersistRecordBackend r SqlBackend, ToBackendKey SqlBackend r
|
||||
, ToBackendKey SqlBackend wi
|
||||
)
|
||||
=> (Route App -> Maybe (KeyHashid wi))
|
||||
-> (r -> ActorId)
|
||||
-> ( Key r
|
||||
-> Key wi
|
||||
-> ExceptT Text AppDB
|
||||
( TicketId
|
||||
, Maybe
|
||||
( Entity TicketResolve
|
||||
, Either
|
||||
(Entity TicketResolveLocal)
|
||||
(Entity TicketResolveRemote)
|
||||
)
|
||||
)
|
||||
)
|
||||
-> (Key r -> GrantResourceBy Key)
|
||||
-> (KeyHashid r -> LocalStageBy KeyHashid)
|
||||
-> (KeyHashid r -> KeyHashid wi -> LocalStageBy KeyHashid)
|
||||
-> (forall f. f r -> LocalActorBy f)
|
||||
-> UTCTime
|
||||
-> KeyHashid r
|
||||
-> RemoteAuthor
|
||||
-> ActivityBody
|
||||
-> Maybe (RecipientRoutes, ByteString)
|
||||
-> LocalURI
|
||||
-> AP.Resolve URIMode
|
||||
-> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
|
||||
trackerResolveF maybeWorkItem grabActor getWorkItem makeResource trackerFollowers itemFollowers makeLocalActor now recipHash author body mfwd luResolve (AP.Resolve uObject) = (,Nothing) <$> do
|
||||
error "trackerResolveF disabled for refactoring"
|
||||
{-
|
||||
-- Check input
|
||||
recipID <- decodeKeyHashid404 recipHash
|
||||
wiID <- nameExceptT "Resolve object" $ do
|
||||
route <- do
|
||||
routeOrRemote <- parseFedURIOld uObject
|
||||
case routeOrRemote of
|
||||
Left route -> pure route
|
||||
Right _ -> throwE "Remote, so definitely not mine"
|
||||
case maybeWorkItem route of
|
||||
Nothing -> throwE "Local route but not a work item of mine"
|
||||
Just wiHash ->
|
||||
decodeKeyHashidE wiHash "Invalid work item keyhashid"
|
||||
|
||||
-- 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
|
||||
|
||||
-- Find recipient tracker in DB, returning 404 if doesn't exist because
|
||||
-- we're in the tracker's inbox post handler
|
||||
recip <- lift $ get404 recipID
|
||||
let recipActorID = grabActor recip
|
||||
recipActor <- lift $ getJust recipActorID
|
||||
|
||||
-- Insert the Resolve to tracker's inbox
|
||||
mractid <- lift $ insertToInbox now author body (actorInbox recipActor) luResolve False
|
||||
for mractid $ \ resolveID -> do
|
||||
|
||||
-- Find ticket in DB, verify it's not resolved
|
||||
ticketID <- do
|
||||
(ticketID, maybeResolve) <- getWorkItem recipID wiID
|
||||
unless (isNothing maybeResolve) $
|
||||
throwE "Work item is already resolved"
|
||||
return ticketID
|
||||
|
||||
-- Verify the sender is authorized by the tracker 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 tracker"
|
||||
verifyCapability
|
||||
capability
|
||||
(Right $ remoteAuthorId author)
|
||||
(makeResource recipID)
|
||||
|
||||
-- Forward the Resolve activity to relevant local stages, and
|
||||
-- schedule delivery for unavailable remote members of them
|
||||
maybeHttpFwdResolve <- lift $ for mfwd $ \ (localRecips, sig) -> do
|
||||
wiHash <- encodeKeyHashid wiID
|
||||
let sieve =
|
||||
makeRecipientSet
|
||||
[]
|
||||
[ trackerFollowers recipHash
|
||||
, itemFollowers recipHash wiHash
|
||||
]
|
||||
forwardActivityDB
|
||||
(actbBL body) localRecips sig recipActorID
|
||||
(makeLocalActor recipHash) sieve resolveID
|
||||
|
||||
-- Mark ticket in DB as resolved by the Resolve
|
||||
acceptID <-
|
||||
lift $ insertEmptyOutboxItem (actorOutbox recipActor) now
|
||||
lift $ insertResolve ticketID resolveID acceptID
|
||||
|
||||
-- Prepare an Accept activity and insert to tracker's outbox
|
||||
(actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
|
||||
lift $ prepareAccept wiID
|
||||
_luAccept <- lift $ updateOutboxItem (makeLocalActor recipID) acceptID actionAccept
|
||||
|
||||
-- Deliver the Accept to local recipients, and schedule delivery
|
||||
-- for unavailable remote recipients
|
||||
deliverHttpAccept <-
|
||||
deliverActivityDB
|
||||
(makeLocalActor recipHash) recipActorID
|
||||
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 "trackerResolveF inbox-forwarding"
|
||||
forkWorker "trackerResolveF 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
|
||||
|
||||
insertResolve ticketID resolveID acceptID = do
|
||||
trid <- insert TicketResolve
|
||||
{ ticketResolveTicket = ticketID
|
||||
, ticketResolveAccept = acceptID
|
||||
}
|
||||
insert_ TicketResolveRemote
|
||||
{ ticketResolveRemoteTicket = trid
|
||||
, ticketResolveRemoteActivity = resolveID
|
||||
, ticketResolveRemoteActor = remoteAuthorId author
|
||||
}
|
||||
|
||||
prepareAccept wiID = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
|
||||
wiHash <- encodeKeyHashid wiID
|
||||
|
||||
ra <- getJust $ remoteAuthorId author
|
||||
|
||||
let ObjURI hAuthor luAuthor = remoteAuthorURI author
|
||||
|
||||
audSender =
|
||||
AudRemote hAuthor
|
||||
[luAuthor]
|
||||
(maybeToList $ remoteActorFollowers ra)
|
||||
audTracker =
|
||||
AudLocal
|
||||
[]
|
||||
[ trackerFollowers recipHash
|
||||
, itemFollowers recipHash wiHash
|
||||
]
|
||||
|
||||
(recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||
collectAudience [audSender, audTracker]
|
||||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
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
|
||||
}
|
||||
}
|
||||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
-}
|
||||
|
||||
deckResolveF
|
||||
:: UTCTime
|
||||
-> KeyHashid Deck
|
||||
-> RemoteAuthor
|
||||
-> ActivityBody
|
||||
-> Maybe (RecipientRoutes, ByteString)
|
||||
-> LocalURI
|
||||
-> AP.Resolve URIMode
|
||||
-> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
|
||||
deckResolveF now deckHash =
|
||||
trackerResolveF
|
||||
(\case
|
||||
TicketR trackerHash taskHash | trackerHash == deckHash ->
|
||||
Just taskHash
|
||||
_ -> Nothing
|
||||
)
|
||||
deckActor
|
||||
(\ deckID taskID -> do
|
||||
maybeTicket <- lift $ getTicket deckID taskID
|
||||
(_deck, _task, Entity ticketID _, _author, maybeResolve) <-
|
||||
fromMaybeE maybeTicket "I don't have such a ticket in DB"
|
||||
return (ticketID, maybeResolve)
|
||||
)
|
||||
GrantResourceDeck
|
||||
LocalStageDeckFollowers
|
||||
LocalStageTicketFollowers
|
||||
LocalActorDeck
|
||||
now
|
||||
deckHash
|
||||
|
||||
loomResolveF
|
||||
:: UTCTime
|
||||
-> KeyHashid Loom
|
||||
-> RemoteAuthor
|
||||
-> ActivityBody
|
||||
-> Maybe (RecipientRoutes, ByteString)
|
||||
-> LocalURI
|
||||
-> AP.Resolve URIMode
|
||||
-> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
|
||||
loomResolveF now loomHash =
|
||||
trackerResolveF
|
||||
(\case
|
||||
ClothR trackerHash clothHash | trackerHash == loomHash ->
|
||||
Just clothHash
|
||||
_ -> Nothing
|
||||
)
|
||||
loomActor
|
||||
(\ loomID clothID -> do
|
||||
maybeCloth <- lift $ getCloth loomID clothID
|
||||
(_loom, _cloth, Entity ticketID _, _author, maybeResolve, _merge) <-
|
||||
fromMaybeE maybeCloth "I don't have such a MR in DB"
|
||||
return (ticketID, maybeResolve)
|
||||
)
|
||||
GrantResourceLoom
|
||||
LocalStageLoomFollowers
|
||||
LocalStageClothFollowers
|
||||
LocalActorLoom
|
||||
now
|
||||
loomHash
|
||||
|
|
|
|||
Loading…
Reference in a new issue