S2S: Deck: Resolve: Use the full OCAP-authorization algorithm

deckResolve now supports Resolve requests that use extension-Grants. It
iterates the verifies the Grant-chain using the process described in the
ForgeFed specification.

src/Vervis/Actor/Deck.hs

@@ -74,6 +74,7 @@ import Vervis.Persist.Collab
 import Vervis.Persist.Discussion
 import Vervis.RemoteActorStore
 import Vervis.Ticket
+import Vervis.Web.Collab
 
 -- Meaning: An actor is adding some object to some target
 -- Behavior:
@@ -518,6 +519,19 @@ deckResolve now deckID (Verse authorIdMsig body) (AP.Resolve uObject) = do
             _ -> throwE "Local route but not a ticket of mine"
     taskID <- decodeKeyHashidE taskHash "Invalid TicketDeck keyhashid"
 
+    -- Verify that a capability is provided
+    uCap <- do
+        let muCap = AP.activityCapability $ actbActivity body
+        fromMaybeE muCap "No capability provided"
+
+    -- Verify the sender is authorized by the tracker to resolve a ticket
+    verifyCapability''
+        uCap
+        authorIdMsig
+        (GrantResourceDeck deckID)
+        AP.RoleTriage
+
+    {-
     -- Check capability
     capability <- do
 
@@ -536,6 +550,7 @@ deckResolve now deckID (Verse authorIdMsig body) (AP.Resolve uObject) = do
             Left (actorByKey, _, outboxItemID) ->
                 return (actorByKey, outboxItemID)
             _ -> throwE "Capability is remote i.e. definitely not by me"
+    -}
 
     maybeNew <- withDBExcept $ do
 
@@ -557,12 +572,14 @@ deckResolve now deckID (Verse authorIdMsig body) (AP.Resolve uObject) = do
         mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
         for mractid $ \ resolveDB -> do
 
+            {-
             -- Verify the sender is authorized by the tracker to resolve a ticket
             verifyCapability'
                 capability
                 authorIdMsig
                 (GrantResourceDeck deckID)
                 AP.RoleTriage
+            -}
 
             -- Prepare forwarding the Resolve to my followers & ticket
             -- followers

src/Vervis/Web/Collab.hs

@@ -198,27 +198,53 @@ verifyCapability'' uCap recipientActor resource requiredRole = do
                             Left (actor, _, itemID) -> return (actor, itemID)
                             Right _ -> throwE "Remote, so definitely not by me"
                     -- We already checked that the activity exists in DB
-                    -- So proceed to find the Collab record
+                    -- So proceed to find the Collab or Stem record
-                    collabID <- do
+                    if null l
-                        maybeEnable <- lift $ getValBy $ UniqueCollabEnableGrant capItem
+
-                        collabEnableCollab <$>
+                        -- This is thr only Grant in the chain, so we're
-                            fromMaybeE maybeEnable "No CollabEnable for this activity"
+                        -- looking for a Collab record
-                    -- Find the recipient of that Collab
+                        then nameExceptT "Collab" $ do
-                    recipID <-
+                            -- Find the Collab record
-                        lift $ bimap collabRecipLocalPerson collabRecipRemoteActor <$>
+                            collabID <- do
-                            requireEitherAlt
+                                maybeEnable <- lift $ getValBy $ UniqueCollabEnableGrant capItem
-                                (getValBy $ UniqueCollabRecipLocal collabID)
+                                collabEnableCollab <$>
-                                (getValBy $ UniqueCollabRecipRemote collabID)
+                                    fromMaybeE maybeEnable "No CollabEnable for this activity"
-                                "No collab recip"
+                            -- Find the recipient of that Collab
-                                "Both local and remote recips for collab"
+                            recipID <-
-                    -- Find the local topic, on which this Collab gives access
+                                lift $ bimap collabRecipLocalPerson collabRecipRemoteActor <$>
-                    topic <- lift $ getCollabTopic collabID
+                                    requireEitherAlt
-                    -- Verify that topic is indeed the sender of the Grant
+                                        (getValBy $ UniqueCollabRecipLocal collabID)
-                    unless (grantResourceLocalActor topic == capActor) $
+                                        (getValBy $ UniqueCollabRecipRemote collabID)
-                        error "Grant sender isn't the topic"
+                                        "No collab recip"
-                    -- Verify the topic matches the resource specified
+                                        "Both local and remote recips for collab"
-                    unless (topic == resource) $
+                            -- Find the local topic, on which this Collab gives access
-                        throwE "Capability topic is some other local resource"
+                            topic <- lift $ getCollabTopic collabID
+                            -- Verify that topic is indeed the sender of the Grant
+                            unless (grantResourceLocalActor topic == capActor) $
+                                error "Grant sender isn't the topic"
+                            -- Verify the topic matches the resource specified
+                            unless (topic == resource) $
+                                throwE "Capability topic is some other local resource"
+
+                        -- There are more Grants in the chain, so we're
+                        -- looking for a Stem record
+                        else nameExceptT "Stem" $ do
+                            -- Find the Stem record
+                            stemID <- do
+                                scaID <- do
+                                    maybeSCA <- lift $ getValBy $ UniqueStemDelegateLocalGrant capItem
+                                    stemDelegateLocalStem <$>
+                                        fromMaybeE maybeSCA "No StemDelegateLocal for this activity"
+                                lift $ stemComponentAcceptStem <$> getJust scaID
+                            -- Find the local topic, on which this Stem gives access
+                            topic <- lift $ getStemIdent stemID
+                            -- Verify that topic is indeed the sender of the Grant
+                            unless (componentActor topic == capActor) $
+                                error "Grant sender isn't the Stem ident"
+                            -- Verify the topic matches the resource specified
+                            unless (componentActor topic == grantResourceLocalActor resource) $
+                                throwE "Capability topic is some other local resource"
+
                     return $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l
 
                 Just uParent -> nameExceptT "Extension-Grant" $ do