S2S: Person: Revoke: Delete Permit records
This commit is contained in:
Pere Lev
parent
11a79b00fb
commit
6dceaa1cff
1 changed files with 143 additions and 7 deletions
|
|
@ -28,6 +28,7 @@ import Control.Monad.Trans.Except
|
|||
import Control.Monad.Trans.Maybe
|
||||
import Control.Monad.Trans.Reader
|
||||
import Data.Barbie
|
||||
import Data.Bifoldable
|
||||
import Data.Bifunctor
|
||||
import Data.Bitraversable
|
||||
import Data.ByteString (ByteString)
|
||||
|
|
@ -1105,27 +1106,162 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do
|
|||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
-- Meaning: An actor has revoked some previously published Grants
|
||||
-- Behavior: Insert to my inbox
|
||||
-- Behavior:
|
||||
-- * Insert to my inbox
|
||||
-- * For each revoked activity:
|
||||
-- * If it's a direct-Grant given to me:
|
||||
-- * Verify the sender is the Permit topic
|
||||
-- * Delete the Permit record
|
||||
-- * If it's an extension-Grant given to me:
|
||||
-- * Verify the sender is the Permit topic
|
||||
-- * Delete the PermitTopicExtend* record
|
||||
personRevoke
|
||||
:: UTCTime
|
||||
-> PersonId
|
||||
-> Verse
|
||||
-> AP.Revoke URIMode
|
||||
-> ActE (Text, Act (), Next)
|
||||
personRevoke now recipPersonID (Verse authorIdMsig body) (AP.Revoke _lus) = do
|
||||
personRevoke now recipPersonID (Verse authorIdMsig body) (AP.Revoke lus) = do
|
||||
|
||||
maybeRevoke <- lift $ withDB $ do
|
||||
-- Check input
|
||||
grants <- nameExceptT "Revoke.object" $ do
|
||||
ObjURI h _ <- lift $ getActorURI authorIdMsig
|
||||
hl <- hostIsLocal h
|
||||
if hl
|
||||
then
|
||||
for lus $ \ lu ->
|
||||
(\ (actor, _, item) -> Left (actor, item)) <$>
|
||||
parseLocalActivityURI' lu
|
||||
else
|
||||
pure $ Right . ObjURI h <$> lus
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
(_personRecip, actorRecip) <- do
|
||||
(personRecip, actorRecip) <- lift $ do
|
||||
p <- getJust recipPersonID
|
||||
(p,) <$> getJust (personActor p)
|
||||
|
||||
insertToInbox now authorIdMsig body (actorInbox actorRecip) True
|
||||
-- Look for the revoked Grants in my Permit records
|
||||
grantsDB <- for grants $ \ grant -> runMaybeT $ do
|
||||
grantDB <- MaybeT $ getActivity grant
|
||||
found <-
|
||||
Left <$> tryDirect grantDB <|>
|
||||
Right <$> tryExtension grantDB
|
||||
bitraverse
|
||||
(\ (gestureID, topicAndEnable) -> do
|
||||
|
||||
case maybeRevoke of
|
||||
-- Verify the Permit is mine
|
||||
PermitPersonGesture permitID _ <- lift . lift $ getJust gestureID
|
||||
Permit p _ <- lift . lift $ getJust permitID
|
||||
guard $ p == recipPersonID
|
||||
|
||||
-- Verify the Revoke sender is the Permit topic
|
||||
lift $ do
|
||||
topic <- lift $ getPermitTopic permitID
|
||||
case (bimap snd snd topic, bimap (view _1) (view _1) authorIdMsig) of
|
||||
(Left la, Left la') | la == la' -> pure ()
|
||||
(Right raID, Right ra) | raID == remoteAuthorId ra -> pure ()
|
||||
_ -> throwE "Revoke sender isn't the Permit topic"
|
||||
|
||||
-- Return data for Permit deletion
|
||||
return (permitID, gestureID, topicAndEnable)
|
||||
)
|
||||
(\ extend -> do
|
||||
|
||||
-- Verify the Permit is mine
|
||||
sendID <-
|
||||
lift . lift $ case extend of
|
||||
Left k -> permitTopicExtendLocalPermit <$> getJust k
|
||||
Right k -> permitTopicExtendRemotePermit <$> getJust k
|
||||
PermitPersonSendDelegator gestureID _ <- lift . lift $ getJust sendID
|
||||
PermitPersonGesture permitID _ <- lift . lift $ getJust gestureID
|
||||
Permit p _ <- lift . lift $ getJust permitID
|
||||
guard $ p == recipPersonID
|
||||
|
||||
-- Verify the Revoke sender is the Permit topic
|
||||
lift $ do
|
||||
topic <- lift $ getPermitTopic permitID
|
||||
case (bimap snd snd topic, bimap (view _1) (view _1) authorIdMsig) of
|
||||
(Left la, Left la') | la == la' -> pure ()
|
||||
(Right raID, Right ra) | raID == remoteAuthorId ra -> pure ()
|
||||
_ -> throwE "Revoke sender isn't the Permit topic"
|
||||
|
||||
-- Return data for PermitTopicExtend* deletion
|
||||
return extend
|
||||
)
|
||||
found
|
||||
|
||||
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
|
||||
lift $ for mractid $ \ _revokeDB ->
|
||||
-- Delete revoked records from DB
|
||||
for grantsDB $ traverse_ $
|
||||
bitraverse_
|
||||
(\ (permitID, gestureID, topicAndEnable) -> do
|
||||
case topicAndEnable of
|
||||
Left (_, enableID) ->
|
||||
deleteWhere [PermitTopicExtendLocalTopic ==. enableID]
|
||||
Right (_, enableID) ->
|
||||
deleteWhere [PermitTopicExtendRemoteTopic ==. enableID]
|
||||
deleteBy $ UniquePermitPersonSendDelegator gestureID
|
||||
case topicAndEnable of
|
||||
Left (topicID, enableID) -> do
|
||||
delete enableID
|
||||
deleteBy $ UniquePermitTopicAcceptLocalTopic topicID
|
||||
Right (topicID, enableID) -> do
|
||||
delete enableID
|
||||
deleteBy $ UniquePermitTopicAcceptRemoteTopic topicID
|
||||
maybeInvite <- getKeyBy $ UniquePermitFulfillsInvite permitID
|
||||
for_ maybeInvite $ \ inviteID -> do
|
||||
deleteBy $ UniquePermitTopicGestureLocal inviteID
|
||||
deleteBy $ UniquePermitTopicGestureRemote inviteID
|
||||
delete gestureID
|
||||
deleteBy $ UniquePermitFulfillsTopicCreation permitID
|
||||
deleteBy $ UniquePermitFulfillsInvite permitID
|
||||
deleteBy $ UniquePermitFulfillsJoin permitID
|
||||
case topicAndEnable of
|
||||
Left (topicID, _) -> do
|
||||
deleteBy $ UniquePermitTopicRepo topicID
|
||||
deleteBy $ UniquePermitTopicDeck topicID
|
||||
deleteBy $ UniquePermitTopicLoom topicID
|
||||
deleteBy $ UniquePermitTopicProject topicID
|
||||
deleteBy $ UniquePermitTopicGroup topicID
|
||||
delete topicID
|
||||
Right (topicID, _) -> delete topicID
|
||||
delete permitID
|
||||
)
|
||||
(\case
|
||||
Left k -> delete k
|
||||
Right k -> delete k
|
||||
)
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just _revokeDB -> done "Inserted to my inbox"
|
||||
Just _ -> done "Deleted any relevant Permit/Extend records"
|
||||
|
||||
where
|
||||
|
||||
tryDirect objectDB =
|
||||
case objectDB of
|
||||
Left (_actorByKey, _actorEntity, itemID) -> do
|
||||
Entity enableID (PermitTopicEnableLocal gestureID topicID _) <-
|
||||
MaybeT $ lift $ getBy $ UniquePermitTopicEnableLocalGrant itemID
|
||||
return (gestureID, Left (topicID, enableID))
|
||||
Right remoteActivityID -> do
|
||||
Entity enableID (PermitTopicEnableRemote gestureID topicID _) <-
|
||||
MaybeT $ lift $ getBy $ UniquePermitTopicEnableRemoteGrant remoteActivityID
|
||||
return (gestureID, Right (topicID, enableID))
|
||||
|
||||
tryExtension objectDB =
|
||||
case objectDB of
|
||||
Left (_actorByKey, _actorEntity, itemID) -> do
|
||||
Entity extendID (PermitTopicExtendLocal _ _ _) <-
|
||||
MaybeT $ lift $ getBy $ UniquePermitTopicExtendLocalGrant itemID
|
||||
return $ Left extendID
|
||||
Right remoteActivityID -> do
|
||||
Entity extendID (PermitTopicExtendRemote _ _ _) <-
|
||||
MaybeT $ lift $ getBy $ UniquePermitTopicExtendRemoteGrant remoteActivityID
|
||||
return $ Right extendID
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Main behavior function
|
||||
|
|
|
|||
Loading…
Reference in a new issue