From f54caef7ca2c8d9dd298bbc8f2c9a0bb4f384147 Mon Sep 17 00:00:00 2001
From: Pere Lev <pere@towards.vision>
Date: Wed, 10 Apr 2024 20:09:23 +0300
Subject: [PATCH] S2S: Project: Fix search of activities in DB

---
 src/Vervis/Actor/Project.hs | 46 +++++++++++++++----------------------
 1 file changed, 19 insertions(+), 27 deletions(-)

diff --git a/src/Vervis/Actor/Project.hs b/src/Vervis/Actor/Project.hs
index 86b631a..15b8894 100644
--- a/src/Vervis/Actor/Project.hs
+++ b/src/Vervis/Actor/Project.hs
@@ -351,16 +351,14 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
         ident <- lift $ lift $ getComponentIdent componentID
         return (componentID, ident, Right ())
 
-    verifySourceHolder :: SourceId -> ActDBE ()
+    verifySourceHolder :: SourceId -> MaybeT ActDB ()
     verifySourceHolder sourceID = do
-        mh <- lift $ getValBy $ UniqueSourceHolderProject sourceID
-        case mh of
-            Just (SourceHolderProject _ j) | j == projectID -> pure ()
-            _ -> throwE "Accept object is an Add for some other project/team"
+        SourceHolderProject _ j <- MaybeT $ getValBy $ UniqueSourceHolderProject sourceID
+        guard $ j == projectID
 
     tryAddChildActive' usID = do
         SourceOriginUs sourceID <- lift . lift $ getJust usID
-        ExceptT $ lift $ runExceptT $ verifySourceHolder sourceID
+        lift $ verifySourceHolder sourceID
         topic <- do
             t <- lift . lift $ getSourceTopic sourceID
             bitraverse
@@ -384,7 +382,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
 
     tryAddChildPassive' themID = do
         SourceOriginThem sourceID <- lift . lift $ getJust themID
-        ExceptT $ lift $ runExceptT $ verifySourceHolder sourceID
+        lift $ verifySourceHolder sourceID
         topic <- do
             t <- lift . lift $ getSourceTopic sourceID
             bitraverse
@@ -406,16 +404,14 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
             lift $ MaybeT $ getValBy $ UniqueSourceThemGestureRemoteAdd remoteActivityID
         tryAddChildPassive' themID
 
-    verifyDestHolder :: DestId -> ActDBE ()
+    verifyDestHolder :: DestId -> MaybeT ActDB ()
     verifyDestHolder destID = do
-        mh <- lift $ getValBy $ UniqueDestHolderProject destID
-        case mh of
-            Just (DestHolderProject _ j) | j == projectID -> pure ()
-            _ -> throwE "Accept object is an Add for some other project/team"
+        DestHolderProject _ j <- MaybeT $ getValBy $ UniqueDestHolderProject destID
+        guard $ j == projectID
 
     tryAddParentActive' destID = do
         usID <- lift $ MaybeT $ getKeyBy $ UniqueDestOriginUs destID
-        ExceptT $ lift $ runExceptT $ verifyDestHolder destID
+        lift $ verifyDestHolder destID
         topic <- do
             t <- lift . lift $ getDestTopic destID
             bitraverse
@@ -439,7 +435,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
 
     tryAddParentPassive' themID = do
         DestOriginThem destID <- lift . lift $ getJust themID
-        ExceptT $ lift $ runExceptT $ verifyDestHolder destID
+        lift $ verifyDestHolder destID
         topic <- do
             t <- lift . lift $ getDestTopic destID
             bitraverse
@@ -465,7 +461,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
         SourceRemove sendID _ <-
             lift $ MaybeT $ getValBy $ UniqueSourceRemove itemID
         SourceUsSendDelegator sourceID grantID <- lift $ lift $ getJust sendID
-        ExceptT $ lift $ runExceptT $ verifySourceHolder sourceID
+        lift $ verifySourceHolder sourceID
         topic <- do
             t <- lift . lift $ getSourceTopic sourceID
             bitraverse
@@ -4902,16 +4898,14 @@ projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lus
 
     where
 
-    verifyDestHolder :: DestId -> ActDBE ()
+    verifyDestHolder :: DestId -> MaybeT ActDB ()
     verifyDestHolder destID = do
-        mh <- lift $ getValBy $ UniqueDestHolderProject destID
-        case mh of
-            Just (DestHolderProject _ j) | j == projectID -> pure ()
-            _ -> throwE "Revoke object is a Grant for some other project/team"
+        DestHolderProject _ j <- MaybeT $ getValBy $ UniqueDestHolderProject destID
+        guard $ j == projectID
 
     tryParent' usAcceptID send = do
         DestUsAccept destID _ <- lift $ lift $ getJust usAcceptID
-        ExceptT $ lift $ runExceptT $ verifyDestHolder destID
+        lift $ verifyDestHolder destID
         topic <- do
             t <- lift . lift $ getDestTopic destID
             bitraverse
@@ -4933,15 +4927,13 @@ projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lus
             lift $ MaybeT $ getBy $ UniqueDestThemSendDelegatorRemoteGrant remoteActivityID
         tryParent' usAcceptID (Right sendID) --(Right remoteID)
 
-    verifySourceHolder :: SourceId -> ActDBE ()
+    verifySourceHolder :: SourceId -> MaybeT ActDB ()
     verifySourceHolder sourceID = do
-        mh <- lift $ getValBy $ UniqueSourceHolderProject sourceID
-        case mh of
-            Just (SourceHolderProject _ j) | j == projectID -> pure ()
-            _ -> throwE "Revoked object is a Grant for some other project/team"
+        SourceHolderProject _ j <- MaybeT $ getValBy $ UniqueSourceHolderProject sourceID
+        guard $ j == projectID
 
     tryChild' sourceID child = do
-        ExceptT $ lift $ runExceptT $ verifySourceHolder sourceID
+        lift $ verifySourceHolder sourceID
         sendID <- lift $ MaybeT $ getKeyBy $ UniqueSourceUsSendDelegator sourceID
         return (sendID, child)