cyverse-de#71 Add /communities endpoints for App Community management.

Mainly modifies existing teams functions for creating groups as either
iplant:de:<env>:teams:<user>:<name> or
iplant:de:<env>:communities:<user>:<name>

New Communities will be publicly viewable by default,
with the creator as the initial admin.

Also added a `payload.action` to each Team notification,
since the UI seems to be looking for an `added_to_team` action,
but is currently checking the `email_template` instead.

src/terrain/clients/iplant_groups.clj

@@ -9,6 +9,10 @@
             [cyverse-groups-client.core :as c]
             [terrain.util.config :as config]))
 
+(def ^:private team-group-type "group")
+(def group-type-teams "teams")
+(def group-type-communities "communities")
+
 ;; General group name functions.
 
 (defn- get-de-users-folder-name [client]
@@ -20,10 +24,10 @@
 (defn- get-collaborator-list-folder-name [client user]
   (c/build-folder-name client (format "users:%s:collaborator-lists" user)))
 
-(defn- get-team-folder-name [client & [user]]
+(defn- get-team-folder-name [client team-type & [user]]
   (if-not user
-    (c/build-folder-name client "teams")
-    (c/build-folder-name client (format "teams:%s" user))))
+    (c/build-folder-name client team-type)
+    (c/build-folder-name client (format "%s:%s" team-type user))))
 
 ;; Subject search functions.
 
@@ -79,7 +83,9 @@
   (c/new-cyverse-groups-client (config/ipg-base) (config/environment-name)))
 
 (defn- build-group-name-prefix-regex [client user]
-  (->> [(get-collaborator-list-folder-name client user) (get-team-folder-name client)]
+  (->> [(get-collaborator-list-folder-name client user)
+        (get-team-folder-name client group-type-teams)
+        (get-team-folder-name client group-type-communities)]
        (mapv (partial format "\\Q%s\\E"))
        (string/join "|")
        (format "^(?:%s):")
@@ -219,14 +225,12 @@
 
 ;; Team Functions
 
-(def ^:private team-group-type "group")
+(defn- ensure-team-folder-exists [client team-type user]
+  (ensure-folder-exists client (config/grouper-user) (get-team-folder-name client team-type))
+  (ensure-folder-exists client user (get-team-folder-name client team-type user)))
 
-(defn- ensure-team-folder-exists [client user]
-  (ensure-folder-exists client (config/grouper-user) (get-team-folder-name client))
-  (ensure-folder-exists client user (get-team-folder-name client user)))
-
-(defn- get-teams* [client user search-folder lookup-fn]
-  (let [folder (get-team-folder-name client)]
+(defn- find-teams* [client team-type user search-folder lookup-fn]
+  (let [folder (get-team-folder-name client team-type)]
     (get-groups* search-folder (partial format-group folder) client user lookup-fn)))
 
 (defn- filter-teams [search result]
@@ -241,75 +245,112 @@
 ;; This function kind of uses a hack. A search string is required, but if we make it the
 ;; same as the folder name then that approximates listing all groups in the folder. An
 ;; update to iplant-groups will be required to eliminate this hack.
-(defn get-teams [user {:keys [search creator member]}]
+(defn- get-teams* [team-type user {:keys [search creator member]}]
   (let [client (get-client)
-        folder (get-team-folder-name client creator)]
+        folder (get-team-folder-name client team-type creator)]
     (->> (cond member (fn [_] (find-groups-with-member client user member folder search))
                search (partial c/find-groups client user search)
-               :else  (partial c/find-groups client user))
-         (get-teams* client user folder))))
+               :else (partial c/find-groups client user))
+         (find-teams* client team-type user folder))))
+
+(defn get-teams [user params]
+  (get-teams* group-type-teams user params))
+
+(defn get-communities [user params]
+  (get-teams* group-type-communities user params))
 
 (defn- grant-initial-team-privileges [client user group public-privileges]
   (c/update-group-privileges client user group
                              {:updates [{:subject_id (config/grouper-user) :privileges ["admin"]}
                                         {:subject_id c/public-user :privileges public-privileges}]}))
 
-(defn add-team [user {:keys [name description public_privileges] :or {public_privileges []}}]
+(defn- add-team* [team-type user {:keys [name description public_privileges] :or {public_privileges []}}]
   (let [client (get-client)
-        folder (get-team-folder-name client user)]
-    (ensure-team-folder-exists client user)
+        folder (get-team-folder-name client team-type user)]
+    (ensure-team-folder-exists client team-type user)
     (let [full-name (str folder ":" name)
           group     (c/add-group client user full-name team-group-type description)]
       (grant-initial-team-privileges client user full-name public_privileges)
-      (format-group (get-team-folder-name client) group))))
+      (format-group (get-team-folder-name client team-type) group))))
 
-(defn get-team [user name]
+(defn add-team [user request]
+  (add-team* group-type-teams user request))
+
+(defn add-community [user request]
+  (add-team* group-type-communities user request))
+
+(defn- get-team* [team-type user name]
   (let [client (get-client)
-        folder (get-team-folder-name client)]
+        folder (get-team-folder-name client team-type)]
     (->> (c/get-group client user (full-group-name name folder))
          (format-group folder))))
 
+(defn get-team [user name]
+  (get-team* group-type-teams user name))
+
+(defn get-community [user name]
+  (get-team* group-type-communities user name))
+
 (defn verify-team-exists [user name]
   ;; get-team will return a 404 if the team doesn't exist.
   (get-team user name)
   nil)
 
-(defn update-team [user name updates]
+(defn- update-team* [team-type user name updates]
   (let [client  (get-client)
-        folder  (get-team-folder-name client)
+        folder  (get-team-folder-name client team-type)
         creator (first (string/split name #":" 2))
         group   (full-group-name name folder)]
     (verify-group-exists client user group)
     (->> (update (select-keys updates [:name :description]) :name
-                 full-group-name (get-team-folder-name client creator))
+                 full-group-name (get-team-folder-name client team-type creator))
          (remove-vals nil?)
          (c/update-group client user group)
          (format-group folder))))
 
-(defn delete-team [user name]
+(defn update-team [user name updates]
+  (update-team* group-type-teams user name updates))
+
+(defn update-community [user name updates]
+  (update-team* group-type-communities user name updates))
+
+(defn- delete-team* [team-type user name]
   (let [client (get-client)
-        folder (get-team-folder-name client)
+        folder (get-team-folder-name client team-type)
         group  (full-group-name name folder)]
     (verify-group-exists client user group)
     (->> (c/delete-group client user group)
          (format-group folder))))
 
+(defn delete-team [user name]
+  (delete-team* group-type-teams user name))
+
+(defn delete-community [user name]
+  (delete-team* group-type-communities user name))
+
 (defn get-team-members [user name]
   (let [client (get-client)
-        folder (get-team-folder-name client)
+        folder (get-team-folder-name client group-type-teams)
         group  (full-group-name name folder)]
     (verify-group-exists client user group)
     (update (c/list-group-members client user group) :members format-subjects client user)))
 
-(defn get-team-admins [user name]
+(defn- get-team-admins* [team-type user name]
   (let [client (get-client)
-        folder (get-team-folder-name client)
+        folder (get-team-folder-name client team-type)
         group  (full-group-name name folder)]
     (verify-group-exists client user group)
     (->> (c/list-group-privileges client (config/grouper-user) group {:subject-source-id "ldap" :privilege "admin"})
          :privileges
          (mapv :subject)
-         (remove (comp (partial = (config/grouper-user)) :id)))))
+         (remove (comp (partial = (config/grouper-user)) :id))
+         (hash-map :members))))
+
+(defn get-team-admins [user name]
+  (get-team-admins* group-type-teams user name))
+
+(defn get-community-admins [user name]
+  (get-team-admins* group-type-communities user name))
 
 (defn- format-privilege-updates [user subject-ids privileges]
   {:updates (vec (for [subject-id subject-ids :when (not= user subject-id)]
@@ -324,29 +365,50 @@
 (defn- revoke-member-privileges [client user group members]
   (c/revoke-group-privileges client user group (format-member-privilege-updates user members)))
 
-(defn add-team-members [user name members]
+(defn- format-admin-privilege-updates [user subject-ids]
+  (format-privilege-updates user subject-ids ["admin"]))
+
+(defn- grant-admin-privileges [client user group members]
+  (c/update-group-privileges client user group (format-admin-privilege-updates user members) {:replace false}))
+
+(defn- revoke-admin-privileges [client user group members]
+  (c/revoke-group-privileges client user group (format-admin-privilege-updates user members)))
+
+(defn- add-team-members* [team-type grant-privileges-fn user name members]
   (let [client (get-client)
-        folder (get-team-folder-name client)
+        folder (get-team-folder-name client team-type)
         group  (full-group-name name folder)]
     (verify-group-exists client user group)
     (when (some (partial = (config/grouper-user)) members)
       (cxu/bad-request "the administrative Grouper user may not be added to any teams"))
-    (grant-member-privileges client user group members)
+    (grant-privileges-fn client user group members)
     (c/add-group-members client user group members)))
 
-(defn remove-team-members [user name members]
+(defn add-team-members [user name members]
+  (add-team-members* group-type-teams grant-member-privileges user name members))
+
+(defn add-community-admins [user name members]
+  (add-team-members* group-type-communities grant-admin-privileges user name members))
+
+(defn- remove-team-members* [team-type revoke-privileges-fn user name members]
   (let [client (get-client)
-        folder (get-team-folder-name client)
+        folder (get-team-folder-name client team-type)
         group  (full-group-name name folder)]
     (verify-group-exists client user group)
     (when (some (partial = (config/grouper-user)) members)
       (cxu/bad-request "the administrative Grouper user may not be removed from any teams"))
-    (revoke-member-privileges client user group members)
+    (revoke-privileges-fn client user group members)
     (c/remove-group-members client user group members)))
 
+(defn remove-team-members [user name members]
+  (remove-team-members* group-type-teams revoke-member-privileges user name members))
+
+(defn remove-community-admins [user name members]
+  (remove-team-members* group-type-communities revoke-admin-privileges user name members))
+
 (defn join-team [user name]
   (let [client (get-client)
-        folder (get-team-folder-name client)
+        folder (get-team-folder-name client group-type-teams)
         group  (full-group-name name folder)]
     (verify-group-exists client user group)
     (when (= user (config/grouper-user))
@@ -357,7 +419,7 @@
 
 (defn leave-team [user name]
   (let [client (get-client)
-        folder (get-team-folder-name client)
+        folder (get-team-folder-name client group-type-teams)
         group  (full-group-name name folder)]
     (verify-group-exists client user group)
     (when (= user (config/grouper-user))
@@ -373,14 +435,14 @@
 
 (defn list-team-privileges [user name]
   (let [client (get-client)
-        folder (get-team-folder-name client)
+        folder (get-team-folder-name client group-type-teams)
         group  (full-group-name name folder)]
     (verify-group-exists client user group)
     (format-group-privileges (c/list-group-privileges client user group {:inheritance-level "immediate"}))))
 
 (defn update-team-privileges [user name updates]
   (let [client (get-client)
-        folder (get-team-folder-name client)
+        folder (get-team-folder-name client group-type-teams)
         group  (full-group-name name folder)]
     (verify-group-exists client user group)
     (format-group-privileges (c/update-group-privileges client user group updates))))

src/terrain/clients/notifications.clj

@@ -35,7 +35,8 @@
                             :subject (str (:name m) " has been deployed")
                             :email true
                             :email_template "tool_deployment"
-                            :payload {:email_address email
+                            :payload {:action "tool_deployment"
+                                      :email_address email
                                       :toolname (:name m)
                                       :tooldirectory (:location m)
                                       :tooldescription (:description m)
@@ -52,7 +53,8 @@
                       :subject (str user-name " has requested to join team \"" team-name "\"")
                       :email true
                       :email_template "team_join_request"
-                      :payload {:email_address (:email admin)
+                      :payload {:action "team_join_request"
+                                :email_address (:email admin)
                                 :requester_id user
                                 :requester_name user-name
                                 :requester_email user-email
@@ -67,7 +69,8 @@
                       :subject "Team join request denied"
                       :email true
                       :email_template "team_join_denial"
-                      :payload {:email_address user-email
+                      :payload {:action "team_join_denial"
+                                :email_address user-email
                                 :team_name team-name
                                 :admin_message message}}))
 
@@ -79,9 +82,22 @@
                       :subject "Added to team"
                       :email true
                       :email_template "added_to_team"
-                      :payload {:email_address (:email user)
+                      :payload {:action "added_to_team"
+                                :email_address (:email user)
                                 :team_name team-name}}))
 
+(defn send-community-admin-add-notification
+  [user team-name]
+  (send-notification {:type           "team"
+                      :user           (:id user)
+                      :subject        (format "Added as community admin to %s" team-name)
+                      :email          true
+                      :email_template "blank"
+                      :payload        {:action        "added_to_community"
+                                       :email_address (:email user)
+                                       :contents      nil
+                                       :team_name     team-name}}))
+
 (defn mark-all-notifications-seen
   []
   (raw/mark-all-notifications-seen (cheshire/encode (add-current-user-to-map {}))))

src/terrain/core.clj

@@ -139,6 +139,7 @@
     (analysis-routes)
     (coge-routes)
     (collaborator-list-routes)
+    (community-routes)
     (team-routes)
     (subject-routes)
     (reference-genomes-routes)

src/terrain/routes/collaborator.clj

@@ -6,6 +6,7 @@
             [clojure.string :as string]
             [terrain.clients.apps.raw :as apps]
             [terrain.services.collaborator-lists :as cl]
+            [terrain.services.communities :as communities]
             [terrain.services.subjects :as subjects]
             [terrain.services.teams :as teams]
             [terrain.util.config :as config]
@@ -92,6 +93,35 @@
    (POST "/teams/:name/leave" [name]
      (service/success-response (teams/leave current-user name)))))
 
+(defn community-routes
+  []
+  (optional-routes
+   [config/collaborator-routes-enabled]
+
+   (GET "/communities" [:as {:keys [params]}]
+     (service/success-response (communities/get-communities current-user params)))
+
+   (POST "/communities" [:as {:keys [body]}]
+     (service/success-response (communities/add-community current-user (service/decode-json body))))
+
+   (GET "/communities/:name" [name]
+     (service/success-response (communities/get-community current-user name)))
+
+   (PATCH "/communities/:name" [name :as {:keys [body]}]
+     (service/success-response (communities/update-community current-user name (service/decode-json body))))
+
+   (DELETE "/communities/:name" [name]
+     (service/success-response (communities/delete-community current-user name)))
+
+   (GET "/communities/:name/admins" [name]
+     (service/success-response (communities/get-community-admins current-user name)))
+
+   (POST "/communities/:name/admins" [name :as {:keys [body]}]
+     (service/success-response (communities/add-community-admins current-user name (service/decode-json body))))
+
+   (POST "/communities/:name/admins/deleter" [name :as {:keys [body]}]
+     (service/success-response (communities/remove-community-admins current-user name (service/decode-json body))))))
+
 (defn subject-routes
   []
   (optional-routes