C2S: Implement trivial Undo handler, remove old undoC code
This commit is contained in:
Pere Lev
parent
cbd81d1d0b
commit
3a95e6d302
4 changed files with 38 additions and 179 deletions
|
|
@ -27,7 +27,6 @@ module Vervis.API
|
|||
, createRepositoryC
|
||||
, followC
|
||||
--, offerDepC
|
||||
, undoC
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -1973,176 +1972,3 @@ insertAcceptOnTicketStatus shrUser wi (WorkItemDetail _ ctx author) obiidResolve
|
|||
update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc]
|
||||
return (doc, recipientSet, remoteActors, fwdHosts)
|
||||
-}
|
||||
|
||||
undoC
|
||||
:: Entity Person
|
||||
-> Actor
|
||||
-> Maybe
|
||||
(Either
|
||||
(LocalActorBy Key, LocalActorBy KeyHashid, OutboxItemId)
|
||||
FedURI
|
||||
)
|
||||
-> RecipientRoutes
|
||||
-> [(Host, NonEmpty LocalURI)]
|
||||
-> [Host]
|
||||
-> AP.Action URIMode
|
||||
-> AP.Undo URIMode
|
||||
-> ExceptT Text Handler OutboxItemId
|
||||
undoC (Entity senderPersonID senderPerson) senderActor maybeCap localRecips remoteRecips fwdHosts action (AP.Undo uObject) = do
|
||||
|
||||
-- Check input
|
||||
undone <-
|
||||
first (\ (actor, _, item) -> (actor, item)) <$>
|
||||
parseActivityURI uObject
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
senderHash <- encodeKeyHashid senderPersonID
|
||||
|
||||
(undoID, deliverHttpUndo, maybeDeliverHttpAccept) <- runDBExcept $ do
|
||||
|
||||
-- Find the undone activity in our DB
|
||||
undoneDB <- do
|
||||
a <- getActivity undone
|
||||
fromMaybeE a "Can't find undone in DB"
|
||||
|
||||
-- See if the undone activity is a Follow/Resolve on a local target
|
||||
-- If it is, verify the relevant actor is addressed, verify
|
||||
-- permissions, and perform the actual undoing in the DB
|
||||
maybeUndoLocal <- do
|
||||
maybeUndo <-
|
||||
lift $ runMaybeT $
|
||||
Left <$> MaybeT (tryUnfollow undoneDB) <|>
|
||||
Right <$> MaybeT (tryUnresolve undoneDB)
|
||||
case maybeUndo of
|
||||
Nothing -> pure Nothing
|
||||
Just (Left (updateDB, actorID, Left followerSetID)) -> do
|
||||
actorByKey <- lift $ getLocalActor actorID
|
||||
unless (actorByKey == LocalActorPerson senderPersonID) $
|
||||
throwE "Tryin to undo a Follow of someone else"
|
||||
(fByKey, fActorID, _) <- do
|
||||
followee <- lift $ getFollowee' followerSetID
|
||||
getFollowee followee
|
||||
fByHash <- hashLocalActor fByKey
|
||||
unless (actorIsAddressed localRecips fByHash) $
|
||||
throwE "Followee's actor not addressed by the Undo"
|
||||
lift updateDB
|
||||
fActor <- lift $ getJust fActorID
|
||||
return $ Just
|
||||
( fByKey
|
||||
, Entity fActorID fActor
|
||||
, makeRecipientSet
|
||||
[fByHash]
|
||||
[LocalStagePersonFollowers senderHash]
|
||||
, [LocalActorPerson senderHash]
|
||||
, []
|
||||
)
|
||||
Just (Left (updateDB, actorID, Right uTarget)) -> do
|
||||
actorByKey <- lift $ getLocalActor actorID
|
||||
unless (actorByKey == LocalActorPerson senderPersonID) $
|
||||
throwE "Trying to undo a Follow of someone else"
|
||||
verifyRemoteAddressed remoteRecips uTarget
|
||||
lift updateDB
|
||||
return Nothing
|
||||
Just (Right (updateDB, ticketID)) -> do
|
||||
wiByKey <- lift $ getWorkItem ticketID
|
||||
wiByHash <- lift $ lift $ VA2.runAct $ hashWorkItem wiByKey
|
||||
let resource = workItemResource wiByKey
|
||||
actorByKey = workItemActor wiByKey
|
||||
actorByHash = workItemActor wiByHash
|
||||
unless (actorIsAddressed localRecips actorByHash) $
|
||||
throwE "Work item's actor not addressed by the Undo"
|
||||
capID <- fromMaybeE maybeCap "No capability provided"
|
||||
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 (Left senderPersonID) resource RoleTriage
|
||||
lift updateDB
|
||||
actorID <- do
|
||||
maybeActor <- lift $ getLocalActorEntity actorByKey
|
||||
case localActorID <$> maybeActor of
|
||||
Nothing -> error "Actor entity not in DB"
|
||||
Just aid -> pure aid
|
||||
actor <- lift $ getJust actorID
|
||||
return $ Just
|
||||
( actorByKey
|
||||
, Entity actorID actor
|
||||
, makeRecipientSet
|
||||
[actorByHash]
|
||||
[ localActorFollowers actorByHash
|
||||
, workItemFollowers wiByHash
|
||||
, LocalStagePersonFollowers senderHash
|
||||
]
|
||||
, [LocalActorPerson senderHash]
|
||||
, [ localActorFollowers actorByHash
|
||||
, workItemFollowers wiByHash
|
||||
, LocalStagePersonFollowers senderHash
|
||||
]
|
||||
)
|
||||
|
||||
-- Insert the Undo activity to author's outbox
|
||||
undoID <- lift $ insertEmptyOutboxItem (actorOutbox senderActor) now
|
||||
luUndo <- lift $ updateOutboxItem (LocalActorPerson senderPersonID) undoID action
|
||||
|
||||
-- Deliver the Undo activity to local recipients, and schedule delivery
|
||||
-- for unavailable remote recipients
|
||||
deliverHttpUndo <- do
|
||||
let sieve =
|
||||
case maybeUndoLocal of
|
||||
Nothing ->
|
||||
makeRecipientSet
|
||||
[] [LocalStagePersonFollowers senderHash]
|
||||
Just (_, _, s, _, _) -> s
|
||||
localRecipsFinal = localRecipSieve sieve False localRecips
|
||||
deliverActivityDB
|
||||
(LocalActorPerson senderHash) (personActor senderPerson)
|
||||
localRecipsFinal remoteRecips fwdHosts undoID action
|
||||
|
||||
maybeDeliverHttpAccept <- for maybeUndoLocal $ \ (actorByKey, Entity actorID actor, _, acceptActors, acceptStages) -> do
|
||||
|
||||
-- Verify the relevant actor has received the Undp
|
||||
verifyActorHasItem actorID undoID "Actor didn't receive the Undo"
|
||||
|
||||
-- Insert an Accept activity to actor's outbox
|
||||
acceptID <- lift $ insertEmptyOutboxItem (actorOutbox actor) now
|
||||
actionAccept <- prepareAccept luUndo acceptActors acceptStages
|
||||
_luAccept <- lift $ updateOutboxItem actorByKey acceptID actionAccept
|
||||
|
||||
-- Deliver the Accept activity to local recipients, and schedule
|
||||
-- delivery for unavailable remote recipients
|
||||
let localRecipsAccept = makeRecipientSet acceptActors acceptStages
|
||||
actorByHash <- hashLocalActor actorByKey
|
||||
deliverActivityDB
|
||||
actorByHash actorID localRecipsAccept [] []
|
||||
acceptID actionAccept
|
||||
|
||||
-- Return instructions for HTTP delivery to remote recipients
|
||||
return (undoID, deliverHttpUndo, maybeDeliverHttpAccept)
|
||||
|
||||
-- Launch asynchronous HTTP delivery of Undo and Accept
|
||||
lift $ do
|
||||
forkWorker "undoC: async HTTP Undo delivery" deliverHttpUndo
|
||||
for_ maybeDeliverHttpAccept $
|
||||
forkWorker "undoC: async HTTP Accept delivery"
|
||||
|
||||
return undoID
|
||||
|
||||
where
|
||||
|
||||
prepareAccept luUndo actors stages = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
hLocal <- asksSite siteInstanceHost
|
||||
let recips =
|
||||
map encodeRouteHome $
|
||||
map renderLocalActor actors ++
|
||||
map renderLocalStage stages
|
||||
return AP.Action
|
||||
{ AP.actionCapability = Nothing
|
||||
, AP.actionSummary = Nothing
|
||||
, AP.actionAudience = Audience recips [] [] [] [] []
|
||||
, AP.actionFulfills = []
|
||||
, AP.actionSpecific = AP.AcceptActivity AP.Accept
|
||||
{ AP.acceptObject = ObjURI hLocal luUndo
|
||||
, AP.acceptResult = Nothing
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1009,7 +1009,7 @@ clientResolve
|
|||
-> ActE OutboxItemId
|
||||
clientResolve now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) (AP.Resolve uObject) = do
|
||||
|
||||
(actorMeID, localRecipsFinal, acceptID) <- withDBExcept $ do
|
||||
(actorMeID, localRecipsFinal, resolveID) <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
(personMe, actorMe) <- lift $ do
|
||||
|
|
@ -1028,8 +1028,42 @@ clientResolve now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHos
|
|||
|
||||
lift $ sendActivity
|
||||
(LocalActorPerson personMeID) actorMeID localRecipsFinal remoteRecips
|
||||
fwdHosts acceptID action
|
||||
return acceptID
|
||||
fwdHosts resolveID action
|
||||
return resolveID
|
||||
|
||||
-- Meaning: The human wants to unfollow or unresolve
|
||||
-- Behavior:
|
||||
-- * Insert the Undo to my inbox
|
||||
-- * Asynchrnously deliver without filter
|
||||
clientUndo
|
||||
:: UTCTime
|
||||
-> PersonId
|
||||
-> ClientMsg
|
||||
-> AP.Undo URIMode
|
||||
-> ActE OutboxItemId
|
||||
clientUndo now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) (AP.Undo uObject) = do
|
||||
|
||||
(actorMeID, localRecipsFinal, undoID) <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
(personMe, actorMe) <- lift $ do
|
||||
p <- getJust personMeID
|
||||
(p,) <$> getJust (personActor p)
|
||||
|
||||
-- Insert the Undo activity to my outbox
|
||||
acceptID <- lift $ insertEmptyOutboxItem' (actorOutbox actorMe) now
|
||||
_luAccept <- lift $ updateOutboxItem' (LocalActorPerson personMeID) acceptID action
|
||||
|
||||
return
|
||||
( personActor personMe
|
||||
, localRecips
|
||||
, acceptID
|
||||
)
|
||||
|
||||
lift $ sendActivity
|
||||
(LocalActorPerson personMeID) actorMeID localRecipsFinal remoteRecips
|
||||
fwdHosts undoID action
|
||||
return undoID
|
||||
|
||||
clientBehavior :: UTCTime -> PersonId -> ClientMsg -> ActE (Text, Act (), Next)
|
||||
clientBehavior now personID msg =
|
||||
|
|
@ -1042,4 +1076,5 @@ clientBehavior now personID msg =
|
|||
AP.OfferActivity offer -> clientOffer now personID msg offer
|
||||
AP.RemoveActivity remove -> clientRemove now personID msg remove
|
||||
AP.ResolveActivity resolve -> clientResolve now personID msg resolve
|
||||
AP.UndoActivity undo -> clientUndo now personID msg undo
|
||||
_ -> throwE "Unsupported activity type for C2S"
|
||||
|
|
|
|||
|
|
@ -26,7 +26,6 @@ module Vervis.Federation.Offer
|
|||
--, repoFollowF
|
||||
|
||||
--personUndoF
|
||||
--deckUndoF
|
||||
loomUndoF
|
||||
, repoUndoF
|
||||
)
|
||||
|
|
|
|||
|
|
@ -254,7 +254,6 @@ postPersonOutboxR personHash = do
|
|||
offerDepC eperson sharer summary audience dep target
|
||||
-}
|
||||
_ -> throwE "Unsupported Offer 'object' type"
|
||||
AP.UndoActivity undo -> run undoC undo
|
||||
_ ->
|
||||
handleViaActor
|
||||
(entityKey eperson) maybeCap localRecips remoteRecips
|
||||
|
|
|
|||
Loading…
Reference in a new issue