From afb83b7761f39c0384b6defcbcd2bfb366d244db Mon Sep 17 00:00:00 2001
From: Pere Lev <pere@towards.vision>
Date: Wed, 28 Jun 2023 22:24:01 +0300
Subject: [PATCH] Add a ProjectCollabLiveR route for use as Grant revocation
 URI

---
 src/Vervis/Foundation.hs      |  2 ++
 src/Vervis/Handler/Project.hs | 12 ++++++++++++
 th/routes                     |  1 +
 3 files changed, 15 insertions(+)

diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs
index 4bfd5be..7814577 100644
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@@ -158,6 +158,7 @@ type TicketDeckKeyHashid        = KeyHashid TicketDeck
 type TicketLoomKeyHashid        = KeyHashid TicketLoom
 type SigKeyKeyHashid            = KeyHashid SigKey
 type ProjectKeyHashid           = KeyHashid Project
+type CollabEnableKeyHashid      = KeyHashid CollabEnable
 
 -- This is where we define all of the routes in our application. For a full
 -- explanation of the syntax, please see:
@@ -1006,3 +1007,4 @@ instance YesodBreadcrumbs App where
         ProjectRemoveR _ _ -> ("", Nothing)
 
         ProjectComponentsR j -> ("Components", Just $ ProjectR j)
+        ProjectCollabLiveR j c -> (keyHashidText c, Just $ ProjectCollabsR j)
diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs
index baecb90..a9d1db4 100644
--- a/src/Vervis/Handler/Project.hs
+++ b/src/Vervis/Handler/Project.hs
@@ -34,6 +34,7 @@ module Vervis.Handler.Project
     , postProjectRemoveR
 
     , getProjectComponentsR
+    , getProjectCollabLiveR
     )
 where
 
@@ -413,3 +414,14 @@ getProjectComponentsR projectHash = do
             E.on $ comp E.^. ComponentId E.==. enable E.^. ComponentEnableComponent
             E.where_ $ comp E.^. ComponentProject E.==. E.val projectID
             return (i E.^. InstanceHost, ro E.^. RemoteObjectIdent)
+
+getProjectCollabLiveR
+    :: KeyHashid Project -> KeyHashid CollabEnable -> Handler ()
+getProjectCollabLiveR projectHash enableHash = do
+    projectID <- decodeKeyHashid404 projectHash
+    enableID <- decodeKeyHashid404 enableHash
+    runDB $ do
+        CollabEnable collabID _ <- get404 enableID
+        CollabTopicProject _ j <-
+            getValBy404 $ UniqueCollabTopicProject collabID
+        unless (j == projectID) notFound
diff --git a/th/routes b/th/routes
index 51735a2..b5c81e7 100644
--- a/th/routes
+++ b/th/routes
@@ -328,3 +328,4 @@
 /projects/#ProjectKeyHashid/remove/#CollabTopicProjectId ProjectRemoveR     POST
 
 /projects/#ProjectKeyHashid/components                   ProjectComponentsR GET
+/projects/#ProjectKeyHashid/collabs/#CollabEnableKeyHashid/live ProjectCollabLiveR    GET