S2S: Project: Grant: Fix capability check, do it in MaybeT, not ExceptT
This commit is contained in:
parent
f326b276c2
commit
719999242a
2 changed files with 13 additions and 8 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue