From 9646b72ded93f02aa7a30d26f1ce13ef2882f36d Mon Sep 17 00:00:00 2001
From: Pere Lev <pere@towards.vision>
Date: Mon, 29 Apr 2024 11:32:11 +0300
Subject: [PATCH] UI: Project: Components: Button for removal

---
 src/Vervis/Foundation.hs            |  1 +
 src/Vervis/Handler/Project.hs       | 50 ++++++++++++++++++++++++++++-
 templates/project/components.hamlet |  7 ++--
 th/routes                           |  1 +
 4 files changed, 56 insertions(+), 3 deletions(-)

diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs
index 3d5dcf5..123c181 100644
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@@ -1038,6 +1038,7 @@ instance YesodBreadcrumbs App where
         ProjectParentsR j -> ("Parent projects", Just $ ProjectR j)
         ProjectParentLiveR j d -> (keyHashidText d, Just $ ProjectParentsR j)
 
+        ProjectRemoveComponentR _ _ -> ("", Nothing)
         ProjectRemoveChildR _ _ -> ("", Nothing)
         ProjectRemoveParentR _ _ -> ("", Nothing)
 
diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs
index ccdcc94..c7ad104 100644
--- a/src/Vervis/Handler/Project.hs
+++ b/src/Vervis/Handler/Project.hs
@@ -44,6 +44,7 @@ module Vervis.Handler.Project
     , getProjectParentsR
     , getProjectParentLiveR
 
+    , postProjectRemoveComponentR
     , postProjectRemoveChildR
     , postProjectRemoveParentR
 
@@ -519,7 +520,7 @@ getProjectComponentsR projectHash = do
                             return (inztance, remoteObject, remoteActor)
                         )
                         byKeyOrRaid
-                return (identView, componentRole c, outboxItemPublished i)
+                return (identView, componentRole c, outboxItemPublished i, cid)
             ds <-
                 E.select $ E.from $ \ (comp `E.LeftOuterJoin` enable) -> do
                     E.on $ E.just (comp E.^. ComponentId) E.==. enable E.?. ComponentEnableComponent
@@ -968,6 +969,53 @@ getProjectParentLiveR projectHash startHash = do
             getBy404 $ UniqueDestHolderProject destID
         unless (j == projectID) notFound
 
+postProjectRemoveComponentR :: KeyHashid Project -> ComponentId -> Handler Html
+postProjectRemoveComponentR projectHash componentID = do
+    projectID <- decodeKeyHashid404 projectHash
+
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    encodeRouteHome <- getEncodeRouteHome
+
+    result <- runExceptT $ do
+        mpidOrU <- lift $ runDB $ runMaybeT $ do
+            project <- MaybeT $ get projectID
+            Component j _ <- MaybeT $ get componentID
+            guard $ projectID == j
+            _ <- MaybeT $ getBy $ UniqueComponentEnable componentID
+
+            topic <- lift $ bimap snd snd <$> getComponentIdent componentID
+            lift $
+                (projectResource project,) <$>
+                bitraverse
+                    pure
+                    (getRemoteActorURI <=< getJust)
+                    topic
+        (resourceID, pidOrU) <- maybe notFound pure mpidOrU
+        (maybeSummary, audience, remove) <- do
+            uComponent <-
+                case pidOrU of
+                    Left c -> encodeRouteHome . renderLocalResource <$> hashLocalResource (componentResource c)
+                    Right u -> pure u
+            let uCollection = encodeRouteHome $ ProjectComponentsR projectHash
+            C.remove personID uComponent uCollection
+        cap <- do
+            maybeItem <- lift $ runDB $ getCapability personID (Left resourceID) AP.RoleAdmin
+            fromMaybeE maybeItem "You need to be have Admin access to the Project to remove components"
+        uCap <- lift $ renderActivityURI cap
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.RemoveActivity remove
+        let cap' = first (\ (la, i) -> (la, error "lah", i)) cap
+        handleViaActor
+            personID (Just cap') localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> do
+            setMessage $ toHtml e
+        Right removeID ->
+            setMessage "Remove sent"
+    redirect $ ProjectComponentsR projectHash
+
 postProjectRemoveChildR :: KeyHashid Project -> SourceId -> Handler Html
 postProjectRemoveChildR projectHash sourceID = do
     projectID <- decodeKeyHashid404 projectHash
diff --git a/templates/project/components.hamlet b/templates/project/components.hamlet
index 15c8689..7598ce2 100644
--- a/templates/project/components.hamlet
+++ b/templates/project/components.hamlet
@@ -22,12 +22,15 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
     <th>Role
     <th>Component
     <th>Since
-  $forall (comp, role, since) <- comps
+    $if haveAdmin
+      <th>Remove
+  $forall (comp, role, since, compID) <- comps
     <tr>
       <td>#{show role}
       <td>^{componentLinkFedW comp}
       <td>#{showDate since}
-$#    <td>^{buttonW POST "Remove" (ProjectRemoveR projectHash ctID)}
+      $if haveAdmin
+        <td>^{buttonW POST "Remove" (ProjectRemoveComponentR projectHash compID)}
 
 $if haveAdmin
   <p>Invite a component:
diff --git a/th/routes b/th/routes
index 659deb0..ce53035 100644
--- a/th/routes
+++ b/th/routes
@@ -367,6 +367,7 @@
 /projects/#ProjectKeyHashid/parents  ProjectParentsR  GET
 /projects/#ProjectKeyHashid/parents/#DestUsStartKeyHashid/live ProjectParentLiveR GET
 
+/projects/#ProjectKeyHashid/component/remove/#ComponentId ProjectRemoveComponentR POST
 /projects/#ProjectKeyHashid/child/remove/#SourceId ProjectRemoveChildR POST
 /projects/#ProjectKeyHashid/parent/remove/#DestId ProjectRemoveParentR POST