From 719999242a3d5e728eacf15bbbceb9fee163e5c1 Mon Sep 17 00:00:00 2001
From: Pere Lev <pere@towards.vision>
Date: Wed, 10 Apr 2024 22:37:12 +0300
Subject: [PATCH] S2S: Project: Grant: Fix capability check, do it in MaybeT,
 not ExceptT

---
 src/Control/Monad/Trans/Except/Local.hs |  5 +++++
 src/Vervis/Actor/Project.hs             | 16 ++++++++--------
 2 files changed, 13 insertions(+), 8 deletions(-)

diff --git a/src/Control/Monad/Trans/Except/Local.hs b/src/Control/Monad/Trans/Except/Local.hs
index 0fda22c..3d75406 100644
--- a/src/Control/Monad/Trans/Except/Local.hs
+++ b/src/Control/Monad/Trans/Except/Local.hs
@@ -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
diff --git a/src/Vervis/Actor/Project.hs b/src/Vervis/Actor/Project.hs
index 15b8894..ee9e36c 100644
--- a/src/Vervis/Actor/Project.hs
+++ b/src/Vervis/Actor/Project.hs
@@ -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