Add a ProjectCollabLiveR route for use as Grant revocation URI

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)

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

th/routes

@@ -328,3 +328,4 @@
 /projects/#ProjectKeyHashid/remove/#CollabTopicProjectId ProjectRemoveR     POST
 
 /projects/#ProjectKeyHashid/components                   ProjectComponentsR GET
+/projects/#ProjectKeyHashid/collabs/#CollabEnableKeyHashid/live ProjectCollabLiveR    GET