S2S: Project: Grant: Fix capability check, do it in MaybeT, not ExceptT

This commit is contained in:
Pere Lev 2024-04-10 22:37:12 +03:00
parent f326b276c2
commit 719999242a
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
2 changed files with 13 additions and 8 deletions

View file

@ -18,10 +18,12 @@ module Control.Monad.Trans.Except.Local
, verifyNothingE
, nameExceptT
, verifySingleE
, hoistMaybe
)
where
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Data.Text (Text)
fromMaybeE :: Monad m => Maybe a -> e -> ExceptT e m a
@ -40,3 +42,6 @@ verifySingleE list none several =
[] -> throwE none
[x] -> pure x
_ -> throwE several
hoistMaybe :: Applicative m => Maybe b -> MaybeT m b
hoistMaybe = MaybeT . pure

View file

@ -2276,20 +2276,20 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
checkCapability = do
-- Verify that a capability is provided
uCap <- do
let muCap = AP.activityCapability $ actbActivity body
fromMaybeE muCap "No capability provided"
uCap <- lift $ hoistMaybe $ AP.activityCapability $ actbActivity body
-- Verify the capability URI is one of:
-- * Outbox item URI of a local actor, i.e. a local activity
-- * A remote URI
cap <- nameExceptT "Grant capability" $ parseActivityURI' uCap
cap <-
ExceptT . lift . lift . runExceptT $
nameExceptT "Grant 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"
_ -> lift mzero
checkGrant g = do
(role, resource, recipient, _mresult, mstart, mend, usage, mdeleg) <-
@ -2320,7 +2320,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
tryComp (GKDelegationExtend _ _) = lift mzero
tryComp GKDelegator = lift mzero
tryComp (GKDelegationStart role) = do
capability <- ExceptT $ lift $ lift $ runExceptT checkCapability
capability <- checkCapability
-- Find the Component record from the capability
Entity enableID (ComponentEnable componentID _) <- lift $ do
-- Capability isn't mine
@ -2622,7 +2622,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
tryCollab (GKDelegationStart _) = lift mzero
tryCollab (GKDelegationExtend _ _) = lift mzero
tryCollab GKDelegator = do
capability <- ExceptT $ lift $ lift $ runExceptT checkCapability
capability <- checkCapability
-- Find the Collab record from the capability
Entity enableID (CollabEnable collabID _) <- lift $ do
-- Capability isn't mine
@ -2904,7 +2904,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
return (action, recipientSet, remoteActors, fwdHosts)
tryChild gk = do
capability <- ExceptT $ lift $ lift $ runExceptT checkCapability
capability <- checkCapability
role <-
case gk of
GKDelegationStart role -> pure role