From 60919f2f14bdca5b9a6367a8bcf647cb81178eb1 Mon Sep 17 00:00:00 2001 From: John Wregglesworth Date: Tue, 4 Aug 2026 12:13:37 -0700 Subject: [PATCH 01/13] Read groups from the groups service instead of iplant-groups Replaces apps.clients.iplant-groups with apps.clients.groups, keeping every function's name, arity, and response shape so the 22 call sites across 11 files are unchanged apart from the three noted below. Groups are addressed by structured identity (group_type plus name) rather than by colon-delimited Grouper paths, so the name-packing helpers are gone along with the cyverse-groups-client dependency. Three call sites do change: - grouper-user-group-id becomes de-users-group-id, which resolves the group through /groups/lookup rather than by building its Grouper path. - The job submission's user_groups is now the plain group names. remove-environment-from-group existed to strip the environment prefix from a Grouper path, and the new names carry no prefix. The field is inert either way: apps computes it and model carries it, but nothing reads it -- FormatUserGroups has no callers outside its own tests. - The workshop group response drops Grouper's type, extension, display_extension, and id_index in favour of group_type, and its schema moves with it. terrain proxies these admin endpoints but no browser code consumes them. Community admins are now the subjects holding admin or own rather than Grouper's admins privilege. Own matters going forward: the importer only ever produces admin for a community, but a community created natively grants own to whoever created it, and that person administers it too. Filtering on admin alone would lock a community's own creator out of tagging apps into it. Co-Authored-By: Claude Opus 5 --- project.clj | 1 - src/apps/clients/groups.clj | 123 ++++++++++++++ src/apps/clients/iplant_groups.clj | 153 ------------------ src/apps/clients/notifications.clj | 2 +- .../clients/notifications/common_sharing.clj | 2 +- src/apps/clients/permissions.clj | 8 +- src/apps/routes/schemas/groups.clj | 25 +-- src/apps/service/apps/communities.clj | 2 +- src/apps/service/apps/de/jobs/common.clj | 4 +- src/apps/service/apps/job_listings.clj | 2 +- src/apps/service/apps/tapis/listings.clj | 2 +- src/apps/service/apps/tapis/sharing.clj | 2 +- src/apps/service/groups.clj | 4 +- src/apps/service/workspace.clj | 2 +- src/apps/user.clj | 2 +- src/apps/util/config.clj | 14 +- 16 files changed, 154 insertions(+), 194 deletions(-) create mode 100644 src/apps/clients/groups.clj delete mode 100644 src/apps/clients/iplant_groups.clj diff --git a/project.clj b/project.clj index 9e6da758..c85f50d1 100644 --- a/project.clj +++ b/project.clj @@ -32,7 +32,6 @@ [org.cyverse/common-cli "2.8.2"] [org.cyverse/common-cfg "2.8.3"] [org.cyverse/common-swagger-api "3.4.20"] - [org.cyverse/cyverse-groups-client "0.1.9"] [org.cyverse/permissions-client "2.8.5"] [org.cyverse/service-logging "2.8.4"] [org.flatland/ordered "1.15.12"] diff --git a/src/apps/clients/groups.clj b/src/apps/clients/groups.clj new file mode 100644 index 00000000..ccb07ae1 --- /dev/null +++ b/src/apps/clients/groups.clj @@ -0,0 +1,123 @@ +(ns apps.clients.groups + (:require [apps.util.config :as config] + [cemerick.url :as curl] + [clj-http.client :as http] + [clojure-commons.exception-util :as exception-util] + [slingshot.slingshot :refer [try+]])) + +(def ^:private de-users-group "de-users") +(def ^:private workshop-users-group "workshop-users") + +(defn- groups-url + [& components] + (str (apply curl/url (config/groups-base) components))) + +(defn- as-de-grouper + ([] (as-de-grouper {})) + ([query-params] + {:query-params (assoc query-params :user (config/de-grouper-user)) + :as :json})) + +(defn user-source? [subject-source-id] + (= subject-source-id (config/grouper-user-source))) + +(defn get-subject-type [subject-source-id] + (if (user-source? subject-source-id) "user" "group")) + +(defn lookup-subject + "Retrieves user details for a single subject." + [user short-username] + (:body (http/get (groups-url "subjects" short-username) + {:query-params {:user user} :as :json}))) + +(defn lookup-subjects + "Looks up multiple subjects by subject ID, returning a map of ID to subject." + [subjects] + (->> (http/post (groups-url "subjects" "lookup") + (assoc (as-de-grouper) + :form-params {:subject_ids (vec (set subjects))} + :content-type :json)) + :body + :subjects + (map (juxt :id identity)) + (into {}))) + +(defn lookup-subject-groups + "Retrieves the groups that a subject belongs to." + [short-username] + (:body (http/get (groups-url "subjects" short-username "groups") (as-de-grouper)))) + +(defn- lookup-group + "Resolves a group's structured identity to the group itself, or nil if there is + no such group." + [group-type name] + (try+ + (:body (http/get (groups-url "groups" "lookup") + (as-de-grouper {:group_type group-type :name name}))) + (catch [:status 404] _ nil))) + +(defn- create-group + [group-type name] + (:body (http/post (groups-url "groups") + (assoc (as-de-grouper) + :form-params {:group_type group-type :name name} + :content-type :json)))) + +(defn- get-or-create-group + [group-type name] + (or (lookup-group group-type name) + (create-group group-type name))) + +;; The de-users group is created by the deployment rather than by apps, so a +;; missing one is a misconfiguration worth failing on rather than papering over. +(def de-users-group-id + (memoize (fn [] (:id (:body (http/get (groups-url "groups" "lookup") + (as-de-grouper {:group_type "system" :name de-users-group}))))))) + +(defn add-de-user + "Adds a user to the de-users group." + [subject-id] + (http/put (groups-url "groups" (de-users-group-id) "members" subject-id) + (as-de-grouper))) + +(defn list-group-members-by-id + "Lists the members of the group with the given ID." + [user group-id] + (:body (http/get (groups-url "groups" group-id "members") + {:query-params {:user user} :as :json}))) + +(defn get-workshop-group + "Retrieves information about the workshop users group, creating it if necessary." + [] + (get-or-create-group "system" workshop-users-group)) + +(defn get-workshop-group-members + "Retrieves the list of workshop group members, creating the group if necessary." + [] + (list-group-members-by-id (config/de-grouper-user) (:id (get-workshop-group)))) + +(defn update-workshop-group-members + "Updates the list of workshop group members, creating the group if necessary." + [subject-ids] + (:body (http/put (groups-url "groups" (:id (get-workshop-group)) "members") + (assoc (as-de-grouper) + :form-params {:members subject-ids} + :content-type :json)))) + +;; Both `admin` and `own` count: the importer maps Grouper's `admins` to +;; `admin`, but a community created natively grants `own` to whoever created it, +;; and that person administers it too. +(def ^:private community-admin-levels #{"admin" "own"}) + +(defn get-community-admins + "Lists the administrators of a community. Throws if the community does not exist." + [_user community-name] + (let [{group-id :id} (or (lookup-group "community" community-name) + (exception-util/not-found "No such community" :community community-name))] + (->> (:permissions (:body (http/get (groups-url "groups" group-id "permissions") (as-de-grouper)))) + (filter (comp community-admin-levels :level)) + (map :subject) + (filter (comp (partial = "user") :subject_type)) + (mapv (fn [{:keys [subject_id]}] {:id subject_id})) + (remove (comp (partial = (config/de-grouper-user)) :id)) + (hash-map :members)))) diff --git a/src/apps/clients/iplant_groups.clj b/src/apps/clients/iplant_groups.clj deleted file mode 100644 index f17cb129..00000000 --- a/src/apps/clients/iplant_groups.clj +++ /dev/null @@ -1,153 +0,0 @@ -(ns apps.clients.iplant-groups - (:require [apps.util.config :as config] - [cemerick.url :as curl] - [clj-http.client :as http] - [clojure.string :as string] - [cyverse-groups-client.core :as c] - [slingshot.slingshot :refer [try+]])) - -(def ^:private grouper-environment-base-fmt "iplant:de:%s") - -(defn- grouper-environment-base - [] - (format grouper-environment-base-fmt (config/env-name))) - -(defn remove-environment-from-group - [group-name] - (string/replace-first group-name (str (grouper-environment-base) ":") "")) - -(def ^:private grouper-standard-group-fmt "%s:users:%s") - -(defn- grouper-standard-group - [group-name] - (format grouper-standard-group-fmt (grouper-environment-base) group-name)) - -(def ^:private grouper-user-group (partial grouper-standard-group "de-users")) -(def ^:private grouper-workshop-group (partial grouper-standard-group "workshop-users")) - -(defn- grouper-url - [& components] - (str (apply curl/url (config/ipg-base) components))) - -(defn lookup-group-id - "Looks up a group identifier in Grouper." - [group-name] - ((comp :id :body) - (http/get (grouper-url "groups" group-name) - {:query-params {:user (config/de-grouper-user)} - :as :json}))) - -(def grouper-user-group-id (memoize (fn [] (lookup-group-id (grouper-user-group))))) - -(defn user-source? [subject-source-id] - (= subject-source-id (config/grouper-user-source))) - -(defn get-subject-type [subject-source-id] - (if (user-source? subject-source-id) "user" "group")) - -(defn lookup-subject - "Uses iplant-groups's subject lookup by ID endpoint to retrieve user details." - [user short-username] - (-> (http/get (grouper-url "subjects" short-username) {:query-params {:user user} :as :json}) - (:body))) - -(defn lookup-subject-groups - "Uses iplant-groups groups-for-subject lookup by ID endpoint to retrieve a user's groups" - [short-username] - (-> (http/get (grouper-url "subjects" short-username "groups") {:query-params {:user (config/de-grouper-user) :folder (grouper-environment-base)} :as :json}) - :body)) - -(defn add-de-user - "Adds a user to the de-users group." - [subject-id] - (http/put (grouper-url "groups" (grouper-user-group) "members" subject-id) - {:query-params {:user (config/de-grouper-user)}})) - -(defn- get-group - "Retrieves information about a DE group." - [group-name] - (try+ - (:body (http/get (grouper-url "groups" group-name) - {:query-params {:user (config/de-grouper-user)} - :as :json})) - (catch [:status 404] _ nil))) - -(defn- create-group - "Creates a group." - [group-name group-type] - (:body (http/post (grouper-url "groups") - {:query-params {:user (config/de-grouper-user)} - :form-params {:name group-name - :type group-type} - :content-type :json - :as :json}))) - -(defn- get-group-members - "Retrieves a list of members belonging to a group." - [group-name] - (:body (http/get (grouper-url "groups" group-name "members") - {:query-params {:user (config/de-grouper-user)} - :as :json}))) - -(defn- update-group-members - "Updates the membership list of a group." - [group-name subject-ids] - (:body (http/put (grouper-url "groups" group-name "members") - {:query-params {:user (config/de-grouper-user)} - :form-params {:members subject-ids} - :content-type :json - :as :json}))) - -(defn- verify-group-exists [client user name] - ;; get-group will return a 404 if the group doesn't exist. - (c/get-group client user name) - nil) - -(defn get-or-create-group - "Ensures that a group with the given name exists." - [group-name group-type] - (or (get-group group-name) - (create-group group-name group-type))) - -(defn get-workshop-group - "Retrieves information about the workshop users group, creating the group if necessary." - [] - (get-or-create-group (grouper-workshop-group) "role")) - -(defn get-workshop-group-members - "Retrieves the list of workshop group members, creating the group if necessary." - [] - (get-workshop-group) - (get-group-members (grouper-workshop-group))) - -(defn update-workshop-group-members - "Updates the list of workshop group members, creating the group if necessary." - [subject-ids] - (get-workshop-group) - (update-group-members (grouper-workshop-group) subject-ids)) - -(defn- get-client [] - (c/new-cyverse-groups-client (config/ipg-base) (config/env-name))) - -(defn list-group-members-by-id - "Lists the members of the group with the given ID." - [user group-id] - (c/list-group-members-by-id (get-client) user group-id)) - -(defn lookup-subjects - "Looks up multiple subjects by subject ID." - [subjects] - (->> (c/lookup-subjects (get-client) (config/de-grouper-user) (set subjects)) - :subjects - (map (juxt :id identity)) - (into {}))) - -(defn get-community-admins - [user group] - (let [client (get-client)] - (verify-group-exists client user group) - (->> (c/list-group-privileges client (config/de-grouper-user) group {:subject-source-id "ldap" :privilege "admin"}) - :privileges - (mapv :subject) - (remove (comp (partial = (config/de-grouper-user)) :id)) - (hash-map :members)))) diff --git a/src/apps/clients/notifications.clj b/src/apps/clients/notifications.clj index b53a59fc..765ab947 100644 --- a/src/apps/clients/notifications.clj +++ b/src/apps/clients/notifications.clj @@ -1,5 +1,5 @@ (ns apps.clients.notifications - (:require [apps.clients.iplant-groups :as groups-client] + (:require [apps.clients.groups :as groups-client] [apps.clients.notifications.app-sharing :as asn] [apps.clients.notifications.job-sharing :as jsn] [apps.clients.notifications.tool-sharing :as tool-notifications] diff --git a/src/apps/clients/notifications/common_sharing.clj b/src/apps/clients/notifications/common_sharing.clj index bb150272..bec1105b 100644 --- a/src/apps/clients/notifications/common_sharing.clj +++ b/src/apps/clients/notifications/common_sharing.clj @@ -1,5 +1,5 @@ (ns apps.clients.notifications.common-sharing - (:require [apps.clients.iplant-groups :as ipg] + (:require [apps.clients.groups :as ipg] [clojure-commons.template :refer [render]])) (def grouping-threshold 10) diff --git a/src/apps/clients/permissions.clj b/src/apps/clients/permissions.clj index 4a9fddd1..0befa1a2 100644 --- a/src/apps/clients/permissions.clj +++ b/src/apps/clients/permissions.clj @@ -1,5 +1,5 @@ (ns apps.clients.permissions - (:require [apps.clients.iplant-groups :as ipg] + (:require [apps.clients.groups :as ipg] [apps.util.cache :as cache] [apps.util.config :as config] [apps.util.service :as service] @@ -119,7 +119,7 @@ (defn- get-public-resource-ids [resource-type] (->> (pc/get-abbreviated-subject-permissions-for-resource-type - (client) "group" (ipg/grouper-user-group-id) resource-type false) + (client) "group" (ipg/de-users-group-id) resource-type false) :permissions (map (comp uuidify :resource_name)) set)) @@ -145,12 +145,12 @@ (defn make-app-public [user app-id] (revoke-app-user-permission user app-id) - (pc/grant-permission (client) (rt-app) app-id "group" (ipg/grouper-user-group-id) "read") + (pc/grant-permission (client) (rt-app) app-id "group" (ipg/de-users-group-id) "read") ((:invalidate public-app-ids-cache))) (defn register-public-tool [tool-id] - (pc/grant-permission (client) (rt-tool) tool-id "group" (ipg/grouper-user-group-id) "read") + (pc/grant-permission (client) (rt-tool) tool-id "group" (ipg/de-users-group-id) "read") ((:invalidate public-tool-ids-cache))) (defn make-tool-public diff --git a/src/apps/routes/schemas/groups.clj b/src/apps/routes/schemas/groups.clj index 2289f807..fa4d3783 100644 --- a/src/apps/routes/schemas/groups.clj +++ b/src/apps/routes/schemas/groups.clj @@ -4,29 +4,20 @@ [schema.core :as s])) (s/defschema Group - {:name - (describe String "The internal group name.") - - :type - (describe String "The group type name.") + {:id + (describe String "The group ID.") - (s/optional-key :description) - (describe String "A brief description of the group.") + :name + (describe String "The group's short name.") - (s/optional-key :display_extension) - (describe String "The displayable group name extension.") + :group_type + (describe String "The kind of group.") (s/optional-key :display_name) (describe String "The displayable group name.") - (s/optional-key :extension) - (describe String "The internal group name extension.") - - :id_index - (describe String "The sequential ID index number.") - - :id - (describe String "The group ID.")}) + (s/optional-key :description) + (describe String "A brief description of the group.")}) (s/defschema Subject {:id diff --git a/src/apps/service/apps/communities.clj b/src/apps/service/apps/communities.clj index 17500a9e..1cae127c 100644 --- a/src/apps/service/apps/communities.clj +++ b/src/apps/service/apps/communities.clj @@ -1,5 +1,5 @@ (ns apps.service.apps.communities - (:require [apps.clients.iplant-groups :as groups] + (:require [apps.clients.groups :as groups] [apps.clients.metadata :as metadata-client] [apps.util.config :as config] [cheshire.core :as json] diff --git a/src/apps/service/apps/de/jobs/common.clj b/src/apps/service/apps/de/jobs/common.clj index 24b9eae8..206daa4b 100644 --- a/src/apps/service/apps/de/jobs/common.clj +++ b/src/apps/service/apps/de/jobs/common.clj @@ -1,6 +1,6 @@ (ns apps.service.apps.de.jobs.common (:require - [apps.clients.iplant-groups :as ipg] + [apps.clients.groups :as ipg] [apps.containers :as c] [apps.persistence.users :refer [get-user-id]] [apps.service.apps.de.jobs.params :as params] @@ -198,7 +198,7 @@ :extra @extra :username (:shortUsername user) :user_id (get-user-id (:username user)) - :user_groups (map (comp ipg/remove-environment-from-group :name) @groups) + :user_groups (map :name @groups) :user_home (:user_home submission) :uuid (or (:uuid submission) (uuid)) :wiki_url (:wiki_url app) diff --git a/src/apps/service/apps/job_listings.clj b/src/apps/service/apps/job_listings.clj index dd94923f..aba7cc00 100644 --- a/src/apps/service/apps/job_listings.clj +++ b/src/apps/service/apps/job_listings.clj @@ -1,6 +1,6 @@ (ns apps.service.apps.job-listings (:require - [apps.clients.iplant-groups :as ipg] + [apps.clients.groups :as ipg] [apps.clients.notifications :refer [interapps-url]] [apps.clients.permissions :as perms-client] [apps.persistence.jobs :as jp] diff --git a/src/apps/service/apps/tapis/listings.clj b/src/apps/service/apps/tapis/listings.clj index 838d6499..726dc48e 100644 --- a/src/apps/service/apps/tapis/listings.clj +++ b/src/apps/service/apps/tapis/listings.clj @@ -1,6 +1,6 @@ (ns apps.service.apps.tapis.listings (:require - [apps.clients.iplant-groups :as ipg] + [apps.clients.groups :as ipg] [apps.persistence.app-metadata :as ap] [apps.service.apps.util :refer [to-qualified-app-id]] [apps.service.util :refer [apply-limit apply-offset format-job-stats sort-apps valid-uuid?]] diff --git a/src/apps/service/apps/tapis/sharing.clj b/src/apps/service/apps/tapis/sharing.clj index 3ea263e5..96e981f1 100644 --- a/src/apps/service/apps/tapis/sharing.clj +++ b/src/apps/service/apps/tapis/sharing.clj @@ -1,6 +1,6 @@ (ns apps.service.apps.tapis.sharing (:require - [apps.clients.iplant-groups :as ipg] + [apps.clients.groups :as ipg] [apps.persistence.jobs :as jp] [apps.service.apps.permissions :as app-permissions] [clojure-commons.error-codes :as ce :refer [clj-http-error?]] diff --git a/src/apps/service/groups.clj b/src/apps/service/groups.clj index a8e47dec..a0cfc63c 100644 --- a/src/apps/service/groups.clj +++ b/src/apps/service/groups.clj @@ -1,9 +1,9 @@ (ns apps.service.groups - (:require [apps.clients.iplant-groups :as ipg])) + (:require [apps.clients.groups :as ipg])) (defn get-workshop-group [] (select-keys (ipg/get-workshop-group) - [:name :type :description :display_extension :display-name :extension :id_index :id])) + [:id :name :group_type :display_name :description])) (defn get-workshop-group-members [] (ipg/get-workshop-group-members)) diff --git a/src/apps/service/workspace.clj b/src/apps/service/workspace.clj index b88be588..4552edc8 100644 --- a/src/apps/service/workspace.clj +++ b/src/apps/service/workspace.clj @@ -1,6 +1,6 @@ (ns apps.service.workspace (:require - [apps.clients.iplant-groups :as ipg] + [apps.clients.groups :as ipg] [apps.persistence.workspace :as wp] [apps.user :refer [append-username-suffix]])) diff --git a/src/apps/user.clj b/src/apps/user.clj index 065cc301..e2adc4f5 100644 --- a/src/apps/user.clj +++ b/src/apps/user.clj @@ -1,6 +1,6 @@ (ns apps.user (:require - [apps.clients.iplant-groups :as ipg] + [apps.clients.groups :as ipg] [apps.util.config :refer [uid-domain]] [clojure.string :as string] [clojure.tools.logging :as log] diff --git a/src/apps/util/config.clj b/src/apps/util/config.clj index b025e9b1..2279d962 100644 --- a/src/apps/util/config.clj +++ b/src/apps/util/config.clj @@ -340,20 +340,20 @@ [props config-valid configs] "apps.notificationagent.base-url" "http://notification-agent:60000") -(cc/defprop-optstr ipg-base - "The base URL for the iplant-groups service." +(cc/defprop-optstr groups-base + "The base URL for the groups service." [props config-valid configs] - "apps.iplant-groups.base-url" "http://iplant-groups:60000") + "apps.groups.base-url" "http://groups") (cc/defprop-optstr de-grouper-user - "The username that the DE uses to authenticate to Grouper." + "The username that the DE uses to authenticate to the groups service." [props config-valid configs] - "apps.iplant-groups.grouper-user" "de_grouper") + "apps.groups.user" "de_grouper") (cc/defprop-optstr grouper-user-source - "The subject ID that Grouper uses for DE users." + "The subject source ID used for DE users." [props config-valid configs] - "apps.iplant-groups.grouper-user-source" "ldap") + "apps.groups.user-source" "ldap") (cc/defprop-optstr metadata-base "The base URL for the metadata service." From f92464d9942875f2ba6f263bf1fbe3a5a01e3e93 Mon Sep 17 00:00:00 2001 From: John Wregglesworth Date: Tue, 4 Aug 2026 14:57:38 -0700 Subject: [PATCH 02/13] Tag apps with community IDs rather than community names The community tag on an app was the community's name -- in Grouper, its full colon-delimited path -- composed by the browser and stored verbatim. A name is not a stable identifier: renaming a community dropped every app tagged with the old name out of its own listing, silently. Production holds 17 such orphaned tag values across 48 apps. The stored value is now the community's ID, and callers name a community by ID instead of composing the value themselves. Identifiers are resolved on both sides, so an ID, a plain name, and a legacy colon path all select the same community; that is what lets a browser holding a pre-cutover bundle keep working. The read path resolves too, so a listing finds the same apps however the community was named in the URL. The important fix is that administrators now resolve communities as well. community-admin-update-avus skipped validation entirely when admin? was true, so an administrator's request stored whatever value it carried without anything looking at it -- writing a tag no listing could ever match. Administrators still bypass the community-admin check; they no longer bypass resolution. DELETE /apps/:app-id/communities/:community-id is added alongside the body-based form, which remains for the transition. Co-Authored-By: Claude Opus 5 --- project.clj | 2 +- src/apps/clients/groups.clj | 52 +++++++--- src/apps/routes/apps/communities.clj | 39 +++++--- src/apps/service/apps/communities.clj | 104 +++++++++++--------- src/apps/service/apps/de/listings.clj | 14 ++- src/apps/service/apps/de/metadata.clj | 4 +- test/apps/service/apps/communities_test.clj | 61 ++++++++++++ 7 files changed, 199 insertions(+), 77 deletions(-) create mode 100644 test/apps/service/apps/communities_test.clj diff --git a/project.clj b/project.clj index c85f50d1..7b4dc77f 100644 --- a/project.clj +++ b/project.clj @@ -31,7 +31,7 @@ [org.cyverse/metadata-client "3.2.1"] [org.cyverse/common-cli "2.8.2"] [org.cyverse/common-cfg "2.8.3"] - [org.cyverse/common-swagger-api "3.4.20"] + [org.cyverse/common-swagger-api "3.4.21-SNAPSHOT"] [org.cyverse/permissions-client "2.8.5"] [org.cyverse/service-logging "2.8.4"] [org.flatland/ordered "1.15.12"] diff --git a/src/apps/clients/groups.clj b/src/apps/clients/groups.clj index ccb07ae1..e395f396 100644 --- a/src/apps/clients/groups.clj +++ b/src/apps/clients/groups.clj @@ -2,7 +2,7 @@ (:require [apps.util.config :as config] [cemerick.url :as curl] [clj-http.client :as http] - [clojure-commons.exception-util :as exception-util] + [clojure.string :as string] [slingshot.slingshot :refer [try+]])) (def ^:private de-users-group "de-users") @@ -56,6 +56,34 @@ (as-de-grouper {:group_type group-type :name name}))) (catch [:status 404] _ nil))) +(defn- get-group-by-id + [group-id] + (try+ + (:body (http/get (groups-url "groups" group-id) (as-de-grouper))) + (catch [:status 404] _ nil))) + +;; Group IDs are 32 hex digits: Grouper's own format for imported groups, and +;; what `subjects.subject_id` defaults to for ones created since. +(def ^:private group-id-pattern #"^[0-9a-f]{32}$") + +(defn- community-short-name + "The short name in a community identifier. Tags written before the migration + hold the full Grouper path, and community names contain no colons, so the + segment after the last one is the name." + [identifier] + (last (string/split identifier #":"))) + +(defn lookup-community + "Resolves a community identifier to the community itself, or nil. Accepts a + group ID, a plain name, or a legacy colon-delimited Grouper path, so that a + browser holding a stale bundle still names something real." + [identifier] + (let [group (if (re-matches group-id-pattern identifier) + (get-group-by-id identifier) + (lookup-group "community" (community-short-name identifier)))] + (when (= "community" (:group_type group)) + group))) + (defn- create-group [group-type name] (:body (http/post (groups-url "groups") @@ -109,15 +137,13 @@ ;; and that person administers it too. (def ^:private community-admin-levels #{"admin" "own"}) -(defn get-community-admins - "Lists the administrators of a community. Throws if the community does not exist." - [_user community-name] - (let [{group-id :id} (or (lookup-group "community" community-name) - (exception-util/not-found "No such community" :community community-name))] - (->> (:permissions (:body (http/get (groups-url "groups" group-id "permissions") (as-de-grouper)))) - (filter (comp community-admin-levels :level)) - (map :subject) - (filter (comp (partial = "user") :subject_type)) - (mapv (fn [{:keys [subject_id]}] {:id subject_id})) - (remove (comp (partial = (config/de-grouper-user)) :id)) - (hash-map :members)))) +(defn list-community-admins + "Lists the administrators of the community with the given ID." + [community-id] + (->> (:permissions (:body (http/get (groups-url "groups" community-id "permissions") (as-de-grouper)))) + (filter (comp community-admin-levels :level)) + (map :subject) + (filter (comp (partial = "user") :subject_type)) + (mapv (fn [{:keys [subject_id]}] {:id subject_id})) + (remove (comp (partial = (config/de-grouper-user)) :id)) + (hash-map :members))) diff --git a/src/apps/routes/apps/communities.clj b/src/apps/routes/apps/communities.clj index ebb1ed3d..bf3b71e6 100644 --- a/src/apps/routes/apps/communities.clj +++ b/src/apps/routes/apps/communities.clj @@ -6,7 +6,7 @@ [apps.util.service :as service] [common-swagger-api.routes :refer [get-endpoint-delegate-block]] [common-swagger-api.schema :refer [defroutes DELETE POST undocumented]] - [common-swagger-api.schema.apps :refer [AppCategoryMetadataAddRequest AppCategoryMetadataDeleteRequest AppIdParam]] + [common-swagger-api.schema.apps :refer [AppIdParam]] [common-swagger-api.schema.apps.communities :as schema] [common-swagger-api.schema.metadata :refer [AvuList]] [compojure.route :as route] @@ -17,16 +17,23 @@ (POST "/" [] :path-params [app-id :- AppIdParam] :query [params SecuredQueryParams] - :body [body AppCategoryMetadataAddRequest] + :body [body schema/AppCommunityListRequest] :return AvuList - :summary schema/AppCommunityMetadataAddSummary - :description schema/AppCommunityMetadataAddDocs + :summary schema/AppCommunityAddSummary + :description schema/AppCommunityAddDocs (ok (communities/add-app-to-communities current-user app-id body false))) + (DELETE "/:community-id" [] + :path-params [app-id :- AppIdParam community-id :- schema/CommunityIdPathParam] + :query [params SecuredQueryParams] + :summary schema/AppCommunityDeleteSummary + :description schema/AppCommunityDeleteDocs + (ok (communities/remove-app-from-community current-user app-id community-id false))) + (DELETE "/" [] :path-params [app-id :- AppIdParam] :query [params SecuredQueryParams] - :body [body AppCategoryMetadataDeleteRequest] + :body [body schema/AppCommunityListRequest] :summary schema/AppCommunityMetadataDeleteSummary :description schema/AppCommunityMetadataDeleteDocs (ok (communities/remove-app-from-communities current-user app-id body false))) @@ -38,23 +45,31 @@ (POST "/" [] :path-params [app-id :- AppIdParam] :query [params SecuredQueryParams] - :body [body AppCategoryMetadataAddRequest] + :body [body schema/AppCommunityListRequest] :return AvuList - :summary "Add/Update Community Metadata AVUs" + :summary schema/AppCommunityAddSummary :description (str - "Adds or updates Community Metadata AVUs on the app." + schema/AppCommunityAddDocs + " An administrator does not have to be a community admin, but the" + " communities must exist." (get-endpoint-delegate-block "metadata" "POST /avus/{target-type}/{target-id}") - "Where `{target-type}` is `app`." - " Please see the metadata service documentation for request information.") + "Where `{target-type}` is `app`.") (ok (communities/add-app-to-communities current-user app-id body true))) + (DELETE "/:community-id" [] + :path-params [app-id :- AppIdParam community-id :- schema/CommunityIdPathParam] + :query [params SecuredQueryParams] + :summary schema/AppCommunityDeleteSummary + :description schema/AppCommunityDeleteDocs + (ok (communities/remove-app-from-community current-user app-id community-id true))) + (DELETE "/" [] :path-params [app-id :- AppIdParam] :query [params SecuredQueryParams] - :body [body AppCategoryMetadataDeleteRequest] - :summary "Remove Community Metadata AVUs" + :body [body schema/AppCommunityListRequest] + :summary schema/AppCommunityMetadataDeleteSummary :description (str "Removes the given Community AVUs associated with an app." (get-endpoint-delegate-block diff --git a/src/apps/service/apps/communities.clj b/src/apps/service/apps/communities.clj index 1cae127c..46b6176b 100644 --- a/src/apps/service/apps/communities.clj +++ b/src/apps/service/apps/communities.clj @@ -5,66 +5,80 @@ [cheshire.core :as json] [clojure-commons.exception-util :as exception-util])) +(defn- resolve-community + "Resolves a community identifier, failing with a 404 if it names nothing. + Every request goes through this, an administrator's included: the stored tag + is what a community listing matches on, so accepting one that resolves to no + community writes a tag no app will ever be found by." + [identifier] + (or (groups/lookup-community identifier) + (exception-util/not-found "No such community" :community identifier))) + +(defn- community-admin-ids + [community-id] + (set (mapv :id (:members (groups/list-community-admins community-id))))) + (defn get-community-admin-set - [username community-name] - (->> (groups/get-community-admins username community-name) - :members - (mapv :id) - set)) + [identifier] + (community-admin-ids (:id (resolve-community identifier)))) (defn- validate-community-admin - [username name] - (when-not (contains? (get-community-admin-set username name) username) + [username {community-id :id community-name :name}] + (when-not (contains? (community-admin-ids community-id) username) (exception-util/forbidden "User is not an admin of that community" :user username - :community name))) - -(defn- validate-avu-community-admins - [username community-avus] - (doseq [community-name (->> community-avus - (group-by :value) - keys)] - (validate-community-admin username community-name))) - -(defn- community-admin-update-avus - "add/update only community AVUs as an admin" - [username app-id {:keys [avus] :as request} admin?] - (when-not admin? - (validate-avu-community-admins username avus)) - (metadata-client/update-avus username app-id (json/encode request))) - -(defn- community-admin-remove-avus - "remove only community AVUs as an admin" - [username app-id {:keys [avus]} admin?] - (when-not admin? - (validate-avu-community-admins username avus)) - - (let [community-avu-set (->> avus - (map #(select-keys % [:attr :value :unit])) - set - seq)] - (metadata-client/delete-avus username [app-id] community-avu-set))) + :community community-name))) (defn filter-community-avus [avus] (get (group-by :attr avus) (config/workspace-metadata-communities-attr))) -(defn extract-full-community-names +(defn extract-community-identifiers [avus] (->> avus filter-community-avus - (group-by :value) - keys)) + (map :value) + distinct)) + +(defn- request-community-identifiers + "The communities a request names. `community_ids` is the current form; the AVU + list is what a browser holding a stale bundle still sends, and is accepted + until those bundles are gone." + [{:keys [community_ids avus]}] + (seq (or (seq community_ids) + (extract-community-identifiers avus)))) + +(defn- resolve-request-communities + [username request admin?] + (let [identifiers (or (request-community-identifiers request) + (exception-util/bad-request "No communities found in request")) + communities (mapv resolve-community identifiers)] + (when-not admin? + (dorun (map (partial validate-community-admin username) communities))) + communities)) + +(defn- community-avus + "The AVUs for a set of communities. The value is the community's ID: a name can + change, and every app tagged with the old one would drop out of its listing." + [communities] + (mapv (fn [{community-id :id}] + {:attr (config/workspace-metadata-communities-attr) + :value community-id + :unit ""}) + communities)) (defn add-app-to-communities - [{username :shortUsername} app-id {:keys [avus]} admin?] - (if-let [community-avus (filter-community-avus avus)] - (community-admin-update-avus username app-id {:avus community-avus} admin?) - (exception-util/bad-request "No community metadata found in request"))) + [{username :shortUsername} app-id request admin?] + (let [communities (resolve-request-communities username request admin?)] + (metadata-client/update-avus username app-id + (json/encode {:avus (community-avus communities)})))) (defn remove-app-from-communities - [{username :shortUsername} app-id {:keys [avus]} admin?] - (if-let [community-avus (filter-community-avus avus)] - (community-admin-remove-avus username app-id {:avus community-avus} admin?) - (exception-util/bad-request "No community metadata found in request"))) + [{username :shortUsername} app-id request admin?] + (let [communities (resolve-request-communities username request admin?)] + (metadata-client/delete-avus username [app-id] (seq (community-avus communities))))) + +(defn remove-app-from-community + [user app-id community-id admin?] + (remove-app-from-communities user app-id {:community_ids [community-id]} admin?)) diff --git a/src/apps/service/apps/de/listings.clj b/src/apps/service/apps/de/listings.clj index e4f97df6..6a6368ad 100644 --- a/src/apps/service/apps/de/listings.clj +++ b/src/apps/service/apps/de/listings.clj @@ -1,5 +1,6 @@ (ns apps.service.apps.de.listings (:require + [apps.clients.groups :as groups] [apps.clients.metadata :as metadata-client] [apps.clients.permissions :as perms-client] [apps.constants :refer [de-system-id executable-tool-type]] @@ -386,11 +387,16 @@ (remove-nil-vals))))) (defn- filter-app-ids-by-community - "Filters the given list of app-ids into a set containing the ids of apps tagged with the given community-id" + "Filters the given list of app-ids into a set containing the ids of apps tagged with the given community" [username community-id app-ids] - (let [community-avu {:attr (workspace-metadata-communities-attr) - :value community-id}] - (set (metadata-client/filter-by-avus username app-ids [community-avu])))) + ;; The identifier is resolved rather than matched verbatim, so a community ID, + ;; a plain name, and a legacy colon-delimited path all select the same apps. + ;; The stored tag is the community's ID, which is what the write path records. + (if-let [community (groups/lookup-community community-id)] + (let [community-avu {:attr (workspace-metadata-communities-attr) + :value (:id community)}] + (set (metadata-client/filter-by-avus username app-ids [community-avu]))) + #{})) (defn- app-listing-by-id [{:keys [username] :as user} params perms app-ids admin?] diff --git a/src/apps/service/apps/de/metadata.clj b/src/apps/service/apps/de/metadata.clj index 27afb4f3..925742d2 100644 --- a/src/apps/service/apps/de/metadata.clj +++ b/src/apps/service/apps/de/metadata.clj @@ -176,7 +176,7 @@ (defn- notify-community-admins [username integrator-name app-name community-names] (->> community-names - (map #(admin->communities-map % (communities/get-community-admin-set username %))) + (map #(admin->communities-map % (communities/get-community-admin-set %))) (apply merge-with into) ;; if community1 has admin1 and 2, community2 has admin2 and 3, and community3 has admin3, ;; then by this point there should be a map like the following: @@ -196,7 +196,7 @@ (cheshire/encode {:avus m}))] (metadata-client/update-avus username app-id body)) - (when-let [community-names (communities/extract-full-community-names avus)] + (when-let [community-names (seq (communities/extract-community-identifiers avus))] (notify-community-admins username (:integrator_name (amp/get-integration-data-by-app-id app-id)) app-name diff --git a/test/apps/service/apps/communities_test.clj b/test/apps/service/apps/communities_test.clj new file mode 100644 index 00000000..749ca38a --- /dev/null +++ b/test/apps/service/apps/communities_test.clj @@ -0,0 +1,61 @@ +(ns apps.service.apps.communities-test + (:require [apps.clients.groups :as groups] + [apps.service.apps.communities :as communities] + [apps.util.config :as config] + [clojure.test :refer [deftest is testing]])) + +(def ^:private community-attr "cyverse-community") +(def ^:private imaging-id "78f26e8c49654deb83e710aab64a25fa") + +(defn- avu [value] + {:attr community-attr :value value :unit ""}) + +(defmacro with-community-attr [& body] + `(with-redefs [config/workspace-metadata-communities-attr (constantly community-attr)] + ~@body)) + +(deftest request-community-identifiers-test + (testing "the identifiers a request names" + (let [identifiers #'communities/request-community-identifiers] + (with-community-attr + (doseq [[description request expected] + [["the current form" {:community_ids [imaging-id]} [imaging-id]] + ["several communities" {:community_ids ["a" "b"]} ["a" "b"]] + ;; What a browser holding a bundle from before the cutover sends. + ["the legacy AVU form" {:avus [(avu "iplant:de:de:communities:Imaging")]} + ["iplant:de:de:communities:Imaging"]] + ["duplicate AVUs collapse" {:avus [(avu "Imaging") (avu "Imaging")]} ["Imaging"]] + ;; community_ids wins so a client sending both is not ambiguous. + ["both forms present" {:community_ids [imaging-id] :avus [(avu "Imaging")]} [imaging-id]] + ["AVUs for another attribute" {:avus [{:attr "other" :value "x" :unit ""}]} nil] + ["an empty community list" {:community_ids []} nil] + ["nothing at all" {} nil]]] + (is (= expected (identifiers request)) description)))))) + +(deftest community-avus-test + (testing "the stored tag is the community ID, never its name" + (let [community-avus #'communities/community-avus] + (with-community-attr + (is (= [{:attr community-attr :value imaging-id :unit ""}] + (community-avus [{:id imaging-id :name "Imaging" :group_type "community"}]))))))) + +(deftest resolve-community-test + (let [resolve-community #'communities/resolve-community + imaging {:id imaging-id :name "Imaging" :group_type "community"}] + (testing "an identifier that names a community resolves to it" + (with-redefs [groups/lookup-community (constantly imaging)] + (is (= imaging (resolve-community "Imaging"))))) + + (testing "an identifier that names nothing is a 404, not a silently stored tag" + (with-redefs [groups/lookup-community (constantly nil)] + (is (thrown? Exception (resolve-community "iplant:de:de:communities:Gone"))))))) + +(deftest admin-still-resolves-communities-test + (testing "an administrator skips the community-admin check but not resolution" + ;; Skipping resolution for administrators is what allowed an unresolvable + ;; value to be written verbatim, producing a tag no listing can match. + (let [resolve-request #'communities/resolve-request-communities] + (with-community-attr + (with-redefs [groups/lookup-community (constantly nil)] + (is (thrown? Exception + (resolve-request "someadmin" {:community_ids ["nope"]} true)))))))) From 5f346355a0e65245b46516498ade32e24e9ea6f2 Mon Sep 17 00:00:00 2001 From: John Wregglesworth Date: Tue, 4 Aug 2026 15:08:14 -0700 Subject: [PATCH 03/13] Pin community listing resolution with tests Covers the two properties the listing depends on: that a community ID, a short name, and a legacy Grouper path all filter on the same community ID, so a browser holding a pre-cutover bundle sees the same apps; and that an identifier naming no community selects nothing without asking the metadata service, since filtering on an unresolvable value would match orphaned tag rows literally and keep listing apps under a community that no longer exists. Both fail if the resolution is reverted to matching the identifier verbatim. Co-Authored-By: Claude Opus 5 --- .../apps/de/community_listings_test.clj | 41 +++++++++++++++++++ 1 file changed, 41 insertions(+) create mode 100644 test/apps/service/apps/de/community_listings_test.clj diff --git a/test/apps/service/apps/de/community_listings_test.clj b/test/apps/service/apps/de/community_listings_test.clj new file mode 100644 index 00000000..2042a4f8 --- /dev/null +++ b/test/apps/service/apps/de/community_listings_test.clj @@ -0,0 +1,41 @@ +(ns apps.service.apps.de.community-listings-test + (:require [apps.clients.groups :as groups] + [apps.clients.metadata :as metadata-client] + [apps.service.apps.de.listings :as listings] + [apps.util.config :as config] + [clojure.test :refer [deftest is testing]])) + +(def ^:private community-attr "cyverse-community") +(def ^:private imaging-id "78f26e8c49654deb83e710aab64a25fa") +(def ^:private imaging {:id imaging-id :name "Imaging" :group_type "community"}) + +(deftest filter-app-ids-by-community-test + (let [filter-by-community #'listings/filter-app-ids-by-community + app-ids ["app-1" "app-2"]] + + (testing "every way of naming a community filters on the community's ID" + ;; The URL carries whatever the browser had: a community ID after the + ;; cutover, and a full Grouper path from a bundle loaded before it. Both + ;; have to select the same apps, or a stale tab shows an empty collection. + (doseq [identifier [imaging-id "Imaging" "iplant:de:prod:communities:Imaging"]] + (let [sent (atom nil)] + (with-redefs [config/workspace-metadata-communities-attr (constantly community-attr) + groups/lookup-community (constantly imaging) + metadata-client/filter-by-avus (fn [_ ids avus] + (reset! sent avus) + ids)] + (is (= #{"app-1" "app-2"} (filter-by-community "someuser" identifier app-ids)) + (str "apps selected for " identifier)) + (is (= [{:attr community-attr :value imaging-id}] @sent) + (str "filtered on the community ID for " identifier)))))) + + (testing "an identifier naming no community selects nothing, and asks metadata nothing" + ;; Filtering on an unresolvable value would match the tag rows literally, + ;; so an orphaned tag would keep listing apps under a community that no + ;; longer exists. + (let [called (atom false)] + (with-redefs [config/workspace-metadata-communities-attr (constantly community-attr) + groups/lookup-community (constantly nil) + metadata-client/filter-by-avus (fn [& _] (reset! called true) app-ids)] + (is (= #{} (filter-by-community "someuser" "iplant:de:prod:communities:Vanished" app-ids))) + (is (false? @called))))))) From bbc5d0f17ac23fbd929a7a806f5c43ef95173c46 Mon Sep 17 00:00:00 2001 From: John Wregglesworth Date: Wed, 5 Aug 2026 14:33:15 -0700 Subject: [PATCH 04/13] Bump the common-swagger-api to 3.4.22-SNAPSHOT --- project.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.clj b/project.clj index 7b4dc77f..918ff372 100644 --- a/project.clj +++ b/project.clj @@ -31,7 +31,7 @@ [org.cyverse/metadata-client "3.2.1"] [org.cyverse/common-cli "2.8.2"] [org.cyverse/common-cfg "2.8.3"] - [org.cyverse/common-swagger-api "3.4.21-SNAPSHOT"] + [org.cyverse/common-swagger-api "3.4.22-SNAPSHOT"] [org.cyverse/permissions-client "2.8.5"] [org.cyverse/service-logging "2.8.4"] [org.flatland/ordered "1.15.12"] From 0a9b54a2177518342ce0ca72ea3fdc1fd4d0d570 Mon Sep 17 00:00:00 2001 From: John Wregglesworth Date: Wed, 5 Aug 2026 15:37:41 -0700 Subject: [PATCH 05/13] Shape the workshop membership update response from the update results The groups service answers a membership replacement with per-subject results, and the previous code passed the raw member listing through after re-fetching it. The listing's subjects can omit source_id, which GroupMembersUpdateResponse requires, so response coercion failed the route with ERR_SCHEMA_VALIDATION. Build the response directly from the results instead: successful entries become the members (the update is a full replacement, so they are the new membership), failed entries' subject IDs become the failures. This also drops an extra round trip. The integration test still asserted the pre-migration Grouper shape (:type "role"); the group is now group_type "system". Co-Authored-By: Claude Fable 5 --- src/apps/service/groups.clj | 14 ++++++++++++-- test/apps/service/apps/groups_test.clj | 4 +++- test/apps/service/groups_test.clj | 25 +++++++++++++++++++++++++ 3 files changed, 40 insertions(+), 3 deletions(-) create mode 100644 test/apps/service/groups_test.clj diff --git a/src/apps/service/groups.clj b/src/apps/service/groups.clj index a0cfc63c..6b172bdc 100644 --- a/src/apps/service/groups.clj +++ b/src/apps/service/groups.clj @@ -8,6 +8,16 @@ (defn get-workshop-group-members [] (ipg/get-workshop-group-members)) -(defn update-workshop-group-members [subject-ids] +(defn- member-subject + "Shapes a successful membership result as a subject." + [{:keys [subject_id source_id subject_name]}] + (cond-> {:id subject_id :source_id source_id} + subject_name (assoc :name subject_name))) + +(defn update-workshop-group-members + "Replaces the workshop group membership. The update is a full replacement, so + the successful results are the group's new membership." + [subject-ids] (let [results (:results (ipg/update-workshop-group-members subject-ids))] - (assoc (ipg/get-workshop-group-members) :failures (mapv :subject_id (remove :success results))))) + {:members (mapv member-subject (filter :success results)) + :failures (mapv :subject_id (remove :success results))})) diff --git a/test/apps/service/apps/groups_test.clj b/test/apps/service/apps/groups_test.clj index 1a62cdb7..cc9e7f02 100644 --- a/test/apps/service/apps/groups_test.clj +++ b/test/apps/service/apps/groups_test.clj @@ -15,7 +15,7 @@ (deftest test-workshop-group (let [group (groups/get-workshop-group)] (is (re-find #"workshop-users$" (:name group))) - (is (= "role" (:type group))))) + (is (= "system" (:group_type group))))) ;; We should be able to list the workshop group members. (deftest test-workshop-group-member-listing @@ -25,6 +25,8 @@ (deftest test-workshop-group-member-update (let [{:keys [members failures]} (groups/update-workshop-group-members ["testde1", "testde2", "testde3"])] (is (= (count members) 3)) + (is (contains-member? members "testde1")) + (is (every? :source_id members)) (is (= (count failures) 0))) (let [members (:members (groups/get-workshop-group-members))] (is (= (count members) 3)) diff --git a/test/apps/service/groups_test.clj b/test/apps/service/groups_test.clj new file mode 100644 index 00000000..88161fb4 --- /dev/null +++ b/test/apps/service/groups_test.clj @@ -0,0 +1,25 @@ +(ns apps.service.groups-test + (:require [apps.clients.groups :as ipg] + [apps.routes.schemas.groups :as schema] + [apps.service.groups :as groups] + [clojure.test :refer [deftest is testing]] + [schema.core :as s])) + +;; The groups service answers a membership replacement with per-subject results. +(def ^:private update-response + {:results [{:subject_id "testde1" + :success true + :source_id "ldap" + :subject_name "Test DE User 1"} + {:subject_id "imaginary-user" + :success false + :error "user not found"}]}) + +(deftest update-workshop-group-members-test + (testing "the per-subject results map onto the documented response shape" + (with-redefs [ipg/update-workshop-group-members (constantly update-response)] + (let [response (groups/update-workshop-group-members ["testde1" "imaginary-user"])] + (is (= {:members [{:id "testde1" :name "Test DE User 1" :source_id "ldap"}] + :failures ["imaginary-user"]} + response)) + (is (= response (s/validate schema/GroupMembersUpdateResponse response))))))) From 8db695d44a4d4ab99f3b0bdb2aa08b31d59f8372 Mon Sep 17 00:00:00 2001 From: John Wregglesworth Date: Wed, 5 Aug 2026 15:38:55 -0700 Subject: [PATCH 06/13] Accept a legacy path as a community only under a communities folder community-short-name took the last colon segment of any path, so a legacy tag like iplant:de:prod:teams:Imaging resolved to the Imaging community even though it names a team, and any group name reused across folders could capture the wrong community. Only treat an identifier as a legacy path when its second-to-last segment is `communities`; anything else is looked up as a plain name and simply fails to resolve if it contains colons. Co-Authored-By: Claude Fable 5 --- src/apps/clients/groups.clj | 18 ++++++---- test/apps/service/apps/communities_test.clj | 38 ++++++++++++++++++++- 2 files changed, 48 insertions(+), 8 deletions(-) diff --git a/src/apps/clients/groups.clj b/src/apps/clients/groups.clj index e395f396..70265ca7 100644 --- a/src/apps/clients/groups.clj +++ b/src/apps/clients/groups.clj @@ -67,20 +67,24 @@ (def ^:private group-id-pattern #"^[0-9a-f]{32}$") (defn- community-short-name - "The short name in a community identifier. Tags written before the migration - hold the full Grouper path, and community names contain no colons, so the - segment after the last one is the name." + "The short name from a legacy Grouper community path, or nil for anything + else. Tags written before the migration hold the full path; only a path + whose second-to-last segment is `communities` names a community, so taking + the last segment of any other path could capture an unrelated group's name." [identifier] - (last (string/split identifier #":"))) + (let [segments (string/split identifier #":")] + (when (and (<= 2 (count segments)) + (= "communities" (nth segments (- (count segments) 2)))) + (last segments)))) (defn lookup-community "Resolves a community identifier to the community itself, or nil. Accepts a - group ID, a plain name, or a legacy colon-delimited Grouper path, so that a - browser holding a stale bundle still names something real." + group ID, a plain name, or a legacy colon-delimited Grouper community path, + so that a browser holding a stale bundle still names something real." [identifier] (let [group (if (re-matches group-id-pattern identifier) (get-group-by-id identifier) - (lookup-group "community" (community-short-name identifier)))] + (lookup-group "community" (or (community-short-name identifier) identifier)))] (when (= "community" (:group_type group)) group))) diff --git a/test/apps/service/apps/communities_test.clj b/test/apps/service/apps/communities_test.clj index 749ca38a..d249e3e8 100644 --- a/test/apps/service/apps/communities_test.clj +++ b/test/apps/service/apps/communities_test.clj @@ -2,7 +2,8 @@ (:require [apps.clients.groups :as groups] [apps.service.apps.communities :as communities] [apps.util.config :as config] - [clojure.test :refer [deftest is testing]])) + [clojure.test :refer [deftest is testing]] + [slingshot.slingshot :refer [try+]])) (def ^:private community-attr "cyverse-community") (def ^:private imaging-id "78f26e8c49654deb83e710aab64a25fa") @@ -39,6 +40,41 @@ (is (= [{:attr community-attr :value imaging-id :unit ""}] (community-avus [{:id imaging-id :name "Imaging" :group_type "community"}]))))))) +(defmacro ^:private caught-type + "Evaluates `body`, returning the slingshot `:type` it throws, or ::none." + [& body] + `(try+ + ~@body + ::none + (catch map? e# (:type e#)))) + +(deftest lookup-community-identifier-forms-test + (let [resolve-community #'communities/resolve-community + imaging {:id imaging-id :name "Imaging" :group_type "community"}] + (with-redefs-fn {#'groups/lookup-group (fn [_group-type name] (when (= "Imaging" name) imaging)) + #'groups/get-group-by-id (constantly nil)} + (fn [] + (testing "a legacy Grouper communities path resolves by its short name" + (is (= imaging (resolve-community "iplant:de:de:communities:Imaging")))) + (testing "a plain name resolves" + (is (= imaging (resolve-community "Imaging")))) + (testing "a colon path outside communities must not capture a community by its last segment" + (is (= :clojure-commons.exception/not-found + (caught-type (resolve-community "iplant:de:prod:teams:Imaging"))))))))) + +(deftest lookup-community-branch-precedence-test + (testing "which lookup each identifier form goes through" + (let [imaging (fn [via] {:id imaging-id :name "Imaging" :group_type "community" :via via})] + (with-redefs-fn {#'groups/get-group-by-id (fn [group-id] (imaging [:id group-id])) + #'groups/lookup-group (fn [_group-type name] (imaging [:name name]))} + (fn [] + (is (= [:id imaging-id] (:via (groups/lookup-community imaging-id))) + "a 32-hex identifier is looked up as a group ID") + (is (= [:name "Imaging"] (:via (groups/lookup-community "Imaging"))) + "a plain name is looked up as a community name") + (is (= [:name "Imaging"] (:via (groups/lookup-community "iplant:de:de:communities:Imaging"))) + "a communities path is looked up by its short name")))))) + (deftest resolve-community-test (let [resolve-community #'communities/resolve-community imaging {:id imaging-id :name "Imaging" :group_type "community"}] From d840f305d272c44507e4b9e28cefc95ef9abd858 Mon Sep 17 00:00:00 2001 From: John Wregglesworth Date: Wed, 5 Aug 2026 15:39:37 -0700 Subject: [PATCH 07/13] Warn when a request uses a pre-migration community shape The legacy AVU request shape and the legacy Grouper-path identifiers are accepted silently for compatibility, so there was no way to tell from the logs whether stale browser bundles are still out there. Log a warning naming the probable cause on each fallback so operators can tell when the compatibility paths stop being exercised and can be removed. Co-Authored-By: Claude Fable 5 --- src/apps/clients/groups.clj | 7 ++++++- src/apps/service/apps/communities.clj | 10 +++++++--- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/src/apps/clients/groups.clj b/src/apps/clients/groups.clj index 70265ca7..f8f8eaf1 100644 --- a/src/apps/clients/groups.clj +++ b/src/apps/clients/groups.clj @@ -3,6 +3,7 @@ [cemerick.url :as curl] [clj-http.client :as http] [clojure.string :as string] + [clojure.tools.logging :as log] [slingshot.slingshot :refer [try+]])) (def ^:private de-users-group "de-users") @@ -84,7 +85,11 @@ [identifier] (let [group (if (re-matches group-id-pattern identifier) (get-group-by-id identifier) - (lookup-group "community" (or (community-short-name identifier) identifier)))] + (if-let [short-name (community-short-name identifier)] + (do (log/warn "resolving community identifier" identifier "as legacy Grouper path;" + "the requesting browser is probably running a stale bundle") + (lookup-group "community" short-name)) + (lookup-group "community" identifier)))] (when (= "community" (:group_type group)) group))) diff --git a/src/apps/service/apps/communities.clj b/src/apps/service/apps/communities.clj index 46b6176b..bc4240a4 100644 --- a/src/apps/service/apps/communities.clj +++ b/src/apps/service/apps/communities.clj @@ -3,7 +3,8 @@ [apps.clients.metadata :as metadata-client] [apps.util.config :as config] [cheshire.core :as json] - [clojure-commons.exception-util :as exception-util])) + [clojure-commons.exception-util :as exception-util] + [clojure.tools.logging :as log])) (defn- resolve-community "Resolves a community identifier, failing with a 404 if it names nothing. @@ -46,8 +47,11 @@ list is what a browser holding a stale bundle still sends, and is accepted until those bundles are gone." [{:keys [community_ids avus]}] - (seq (or (seq community_ids) - (extract-community-identifiers avus)))) + (or (seq community_ids) + (when-let [identifiers (seq (extract-community-identifiers avus))] + (log/warn "request names communities with the legacy AVU shape instead of community_ids;" + "the requesting browser is probably running a stale bundle") + identifiers))) (defn- resolve-request-communities [username request admin?] From 14cfa3edee1d158d6916ab03f697f56bec94d5ec Mon Sep 17 00:00:00 2001 From: John Wregglesworth Date: Wed, 5 Aug 2026 15:40:22 -0700 Subject: [PATCH 08/13] Pin the community guard errors by slingshot type The thrown? Exception assertions passed for any failure, including wiring mistakes in the tests themselves, so they proved nothing about which refusal fired. Catch the slingshot map and assert its :type (not-found vs forbidden) instead, and pin both directions of the admin guard: a caller outside the community's admin set is refused while an administrator resolves the same request. Co-Authored-By: Claude Fable 5 --- test/apps/service/apps/communities_test.clj | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/test/apps/service/apps/communities_test.clj b/test/apps/service/apps/communities_test.clj index d249e3e8..94daadc5 100644 --- a/test/apps/service/apps/communities_test.clj +++ b/test/apps/service/apps/communities_test.clj @@ -84,7 +84,20 @@ (testing "an identifier that names nothing is a 404, not a silently stored tag" (with-redefs [groups/lookup-community (constantly nil)] - (is (thrown? Exception (resolve-community "iplant:de:de:communities:Gone"))))))) + (is (= :clojure-commons.exception/not-found + (caught-type (resolve-community "iplant:de:de:communities:Gone")))))))) + +(deftest admin-guard-test + (testing "the community's admin set gates callers who are not administrators" + (let [resolve-request #'communities/resolve-request-communities + imaging {:id imaging-id :name "Imaging" :group_type "community"}] + (with-redefs [groups/lookup-community (constantly imaging) + groups/list-community-admins (constantly {:members [{:id "someadmin"}]})] + (testing "a caller outside the admin set is refused" + (is (= :clojure-commons.exception/forbidden + (caught-type (resolve-request "outsider" {:community_ids [imaging-id]} false))))) + (testing "an administrator resolves the same request the guard refused" + (is (= [imaging] (resolve-request "outsider" {:community_ids [imaging-id]} true)))))))) (deftest admin-still-resolves-communities-test (testing "an administrator skips the community-admin check but not resolution" @@ -93,5 +106,5 @@ (let [resolve-request #'communities/resolve-request-communities] (with-community-attr (with-redefs [groups/lookup-community (constantly nil)] - (is (thrown? Exception - (resolve-request "someadmin" {:community_ids ["nope"]} true)))))))) + (is (= :clojure-commons.exception/not-found + (caught-type (resolve-request "someadmin" {:community_ids ["nope"]} true))))))))) From ad9de43f8d0ec7c2f3e42573cc1c33608f6386a0 Mon Sep 17 00:00:00 2001 From: John Wregglesworth Date: Wed, 5 Aug 2026 15:41:15 -0700 Subject: [PATCH 09/13] Name communities by their resolved name in publication notifications The community-admin notification passed the raw identifiers from the publish request into community_list, so admins got 32-hex group IDs in their emails when a client posted IDs. get-community-admin-set already resolved the community internally but only surfaced the admin IDs; surface the resolved name alongside them and notify with that. Co-Authored-By: Claude Fable 5 --- src/apps/service/apps/communities.clj | 6 ++++-- src/apps/service/apps/de/metadata.clj | 20 +++++++++++--------- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/src/apps/service/apps/communities.clj b/src/apps/service/apps/communities.clj index bc4240a4..6c1d5878 100644 --- a/src/apps/service/apps/communities.clj +++ b/src/apps/service/apps/communities.clj @@ -19,9 +19,11 @@ [community-id] (set (mapv :id (:members (groups/list-community-admins community-id))))) -(defn get-community-admin-set +(defn get-community-name-and-admins + "Resolves a community identifier to the community's name and its admin set." [identifier] - (community-admin-ids (:id (resolve-community identifier)))) + (let [{community-id :id community-name :name} (resolve-community identifier)] + {:name community-name :admins (community-admin-ids community-id)})) (defn- validate-community-admin [username {community-id :id community-name :name}] diff --git a/src/apps/service/apps/de/metadata.clj b/src/apps/service/apps/de/metadata.clj index 925742d2..86e2bfbe 100644 --- a/src/apps/service/apps/de/metadata.clj +++ b/src/apps/service/apps/de/metadata.clj @@ -166,17 +166,19 @@ :unit "attr"}]}) (defn- admin->communities-map - "Takes a `community-name` and its corresponding `admin-set` and returns a map like the following: - {admin1 [community-name], - admin2 [community-name], - admin3 [community-name]}" + "Maps each admin in `admin-set` to a vector holding `community-name`, ready to + be merged into a single map from each admin to all of their communities' names." [community-name admin-set] (zipmap admin-set (repeat [community-name]))) (defn- notify-community-admins - [username integrator-name app-name community-names] - (->> community-names - (map #(admin->communities-map % (communities/get-community-admin-set %))) + "Notifies each community's admins, naming the community by its resolved name: + the identifiers may be group IDs, which mean nothing in an email." + [username integrator-name app-name community-identifiers] + (->> community-identifiers + (map (fn [identifier] + (let [{community-name :name admins :admins} (communities/get-community-name-and-admins identifier)] + (admin->communities-map community-name admins)))) (apply merge-with into) ;; if community1 has admin1 and 2, community2 has admin2 and 3, and community3 has admin3, ;; then by this point there should be a map like the following: @@ -196,11 +198,11 @@ (cheshire/encode {:avus m}))] (metadata-client/update-avus username app-id body)) - (when-let [community-names (seq (communities/extract-community-identifiers avus))] + (when-let [community-identifiers (seq (communities/extract-community-identifiers avus))] (notify-community-admins username (:integrator_name (amp/get-integration-data-by-app-id app-id)) app-name - community-names))) + community-identifiers))) (defn- publish-app [{:keys [shortUsername username] :as user} {app-id :id :keys [name version references avus] :as app}] From ed0b2c8cdf5662b7a8355b9a2d6e5990544a4a40 Mon Sep 17 00:00:00 2001 From: John Wregglesworth Date: Wed, 5 Aug 2026 15:58:08 -0700 Subject: [PATCH 10/13] Report the workshop membership by re-reading it, not from the results A replacement's results list only the changes performed: a member that was already present and stays appears in neither list, and a removal reports success, so mapping successful results to members both dropped kept members and resurfaced removed ones. Verified live: replacing the membership with an empty list returned the removed member as a member. The failures still come from the results; the membership comes from the same listing call the GET route serves. Co-Authored-By: Claude Fable 5 --- src/apps/service/groups.clj | 14 +++++--------- test/apps/service/groups_test.clj | 28 +++++++++++++++++++++------- 2 files changed, 26 insertions(+), 16 deletions(-) diff --git a/src/apps/service/groups.clj b/src/apps/service/groups.clj index 6b172bdc..2b4eaf60 100644 --- a/src/apps/service/groups.clj +++ b/src/apps/service/groups.clj @@ -8,16 +8,12 @@ (defn get-workshop-group-members [] (ipg/get-workshop-group-members)) -(defn- member-subject - "Shapes a successful membership result as a subject." - [{:keys [subject_id source_id subject_name]}] - (cond-> {:id subject_id :source_id source_id} - subject_name (assoc :name subject_name))) - (defn update-workshop-group-members - "Replaces the workshop group membership. The update is a full replacement, so - the successful results are the group's new membership." + "Replaces the workshop group membership. The replacement results list only + the changes performed -- kept members appear in neither list and removals + report success -- so the new membership comes from re-reading the group; + only the failures come from the results." [subject-ids] (let [results (:results (ipg/update-workshop-group-members subject-ids))] - {:members (mapv member-subject (filter :success results)) + {:members (:members (get-workshop-group-members)) :failures (mapv :subject_id (remove :success results))})) diff --git a/test/apps/service/groups_test.clj b/test/apps/service/groups_test.clj index 88161fb4..60b3f863 100644 --- a/test/apps/service/groups_test.clj +++ b/test/apps/service/groups_test.clj @@ -5,21 +5,35 @@ [clojure.test :refer [deftest is testing]] [schema.core :as s])) -;; The groups service answers a membership replacement with per-subject results. +;; The groups service answers a membership replacement with per-subject results +;; for the changes it performed. A member that was already present and stays +;; present appears in neither list, and a removal reports success=true, so the +;; results cannot be read as the new membership. (def ^:private update-response - {:results [{:subject_id "testde1" + {:results [{:subject_id "added-user" :success true :source_id "ldap" - :subject_name "Test DE User 1"} + :subject_name "Added User"} + {:subject_id "removed-user" + :success true + :source_id "ldap"} {:subject_id "imaginary-user" :success false :error "user not found"}]}) +;; What the member listing reports after the replacement: the kept member never +;; appeared in the results above, and the removed member must not resurface. +(def ^:private membership-after + {:members [{:id "kept-user" :name "Kept User" :source_id "ldap"} + {:id "added-user" :name "Added User" :source_id "ldap"}]}) + (deftest update-workshop-group-members-test - (testing "the per-subject results map onto the documented response shape" - (with-redefs [ipg/update-workshop-group-members (constantly update-response)] - (let [response (groups/update-workshop-group-members ["testde1" "imaginary-user"])] - (is (= {:members [{:id "testde1" :name "Test DE User 1" :source_id "ldap"}] + (testing "members come from re-reading the group, failures from the results" + (with-redefs [ipg/update-workshop-group-members (constantly update-response) + ipg/get-workshop-group-members (constantly membership-after)] + (let [response (groups/update-workshop-group-members ["kept-user" "added-user" "imaginary-user"])] + (is (= {:members [{:id "kept-user" :name "Kept User" :source_id "ldap"} + {:id "added-user" :name "Added User" :source_id "ldap"}] :failures ["imaginary-user"]} response)) (is (= response (s/validate schema/GroupMembersUpdateResponse response))))))) From 056dec87d4f496e9c3cd603c43ff3016798eea3d Mon Sep 17 00:00:00 2001 From: John Wregglesworth Date: Thu, 6 Aug 2026 10:08:08 -0700 Subject: [PATCH 11/13] Pin common-swagger-api to the released 3.4.22 The branch built against 3.4.22-SNAPSHOT while the release was pending; the real release is now on Clojars, so nothing mutable is left in the dependency tree. Co-Authored-By: Claude Fable 5 --- project.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.clj b/project.clj index 918ff372..5a6103e2 100644 --- a/project.clj +++ b/project.clj @@ -31,7 +31,7 @@ [org.cyverse/metadata-client "3.2.1"] [org.cyverse/common-cli "2.8.2"] [org.cyverse/common-cfg "2.8.3"] - [org.cyverse/common-swagger-api "3.4.22-SNAPSHOT"] + [org.cyverse/common-swagger-api "3.4.22"] [org.cyverse/permissions-client "2.8.5"] [org.cyverse/service-logging "2.8.4"] [org.flatland/ordered "1.15.12"] From aa04458d75e4ea19b9a555bb832d1785f4062543 Mon Sep 17 00:00:00 2001 From: John Wregglesworth Date: Thu, 3 Sep 2026 14:16:32 -0700 Subject: [PATCH 12/13] fix: repair the test suite and harden the groups client The test suite did not load: `apps.clients.iplant-groups` was deleted, but `apps.service.apps.test-fixtures` and `apps.service.apps.permissions-test` still required it and called `grouper-user-group-id`. Every namespace failed to load, so the three test namespaces added alongside the groups client never ran. They require `apps.clients.groups` and call `de-users-group-id` now. Give the groups client connection and socket timeouts. clj-http applies none of its own, and the client is on job submission, both job listings, and user loading, so an unresponsive groups service would tie up every request thread. `lookup-subject` and `list-group-members-by-id` share the new `as-user` helper rather than building a bare option map. Settle on `groups-client` as the alias for `apps.clients.groups` everywhere. It was `ipg` in nine namespaces -- naming a service that no longer exists -- and `groups` in four more, which collides with the alias `apps.service.groups` already uses. Point the test config at the groups service: the `apps.iplant-groups.base-url` key it still set is read by nothing, so integration tests would have fallen back to the `http://groups` default. Document the community-listing routes' contract: an identifier naming no community lists no apps, where the tagging routes reject it with a 404. Separately, `load-user-as-user` read `:first-name`/`:last-name` from the subject lookup, which returns `first_name`/`last_name`. Both were always nil, so every integration-data record built from a loaded user had a blank implementor name. This is a pre-existing bug, not something this branch introduced. Co-Authored-By: Claude Opus 5 (1M context) Claude-Session: https://claude.ai/code/session_01Wjd21NTp4Ead7JYhx5sQUT --- CLAUDE.md | 2 +- src/apps/clients/groups.clj | 23 +++++++++++---- .../clients/notifications/common_sharing.clj | 8 +++--- src/apps/clients/permissions.clj | 12 ++++---- src/apps/routes/admin.clj | 2 ++ src/apps/routes/apps/categories.clj | 4 ++- src/apps/service/apps/communities.clj | 6 ++-- src/apps/service/apps/de/jobs/common.clj | 4 +-- src/apps/service/apps/de/listings.clj | 4 +-- src/apps/service/apps/job_listings.clj | 6 ++-- src/apps/service/apps/tapis/listings.clj | 6 ++-- src/apps/service/apps/tapis/sharing.clj | 4 +-- src/apps/service/groups.clj | 8 +++--- src/apps/service/workspace.clj | 4 +-- src/apps/user.clj | 8 +++--- test.properties | 4 +-- test/apps/service/apps/communities_test.clj | 28 +++++++++---------- .../apps/de/community_listings_test.clj | 6 ++-- test/apps/service/apps/permissions_test.clj | 14 +++++----- test/apps/service/apps/test_fixtures.clj | 4 +-- test/apps/service/groups_test.clj | 6 ++-- 21 files changed, 88 insertions(+), 75 deletions(-) diff --git a/CLAUDE.md b/CLAUDE.md index 4db10d97..672f45de 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -53,7 +53,7 @@ The application follows a layered Clojure web service architecture: - Transactions via `apps.util.db/transaction` 5. **Client Layer** (`src/apps/clients/`) - - HTTP clients for external microservices (jex, data-info, metadata, permissions, notifications, iplant-groups) + - HTTP clients for external microservices (jex, data-info, metadata, permissions, notifications, groups) ### Multi-System App Client Pattern - **Protocol-based abstraction** (`apps.protocols/Apps`): Defines all app operations as protocol methods. diff --git a/src/apps/clients/groups.clj b/src/apps/clients/groups.clj index f8f8eaf1..71427014 100644 --- a/src/apps/clients/groups.clj +++ b/src/apps/clients/groups.clj @@ -13,11 +13,24 @@ [& components] (str (apply curl/url (config/groups-base) components))) +;; clj-http applies no timeout of its own. This client sits on job submission +;; and both job listings, so a groups service that accepts connections without +;; answering would tie up every request thread until apps stops responding too. +(def ^:private timeouts + {:connection-timeout 5000 + :socket-timeout 30000}) + +(defn- as-user + ([user] (as-user user {})) + ([user query-params] + (merge timeouts + {:query-params (assoc query-params :user user) + :as :json}))) + (defn- as-de-grouper ([] (as-de-grouper {})) ([query-params] - {:query-params (assoc query-params :user (config/de-grouper-user)) - :as :json})) + (as-user (config/de-grouper-user) query-params))) (defn user-source? [subject-source-id] (= subject-source-id (config/grouper-user-source))) @@ -28,8 +41,7 @@ (defn lookup-subject "Retrieves user details for a single subject." [user short-username] - (:body (http/get (groups-url "subjects" short-username) - {:query-params {:user user} :as :json}))) + (:body (http/get (groups-url "subjects" short-username) (as-user user)))) (defn lookup-subjects "Looks up multiple subjects by subject ID, returning a map of ID to subject." @@ -120,8 +132,7 @@ (defn list-group-members-by-id "Lists the members of the group with the given ID." [user group-id] - (:body (http/get (groups-url "groups" group-id "members") - {:query-params {:user user} :as :json}))) + (:body (http/get (groups-url "groups" group-id "members") (as-user user)))) (defn get-workshop-group "Retrieves information about the workshop users group, creating it if necessary." diff --git a/src/apps/clients/notifications/common_sharing.clj b/src/apps/clients/notifications/common_sharing.clj index bec1105b..204afb80 100644 --- a/src/apps/clients/notifications/common_sharing.clj +++ b/src/apps/clients/notifications/common_sharing.clj @@ -1,5 +1,5 @@ (ns apps.clients.notifications.common-sharing - (:require [apps.clients.groups :as ipg] + (:require [apps.clients.groups :as groups-client] [clojure-commons.template :refer [render]])) (def grouping-threshold 10) @@ -53,8 +53,8 @@ (defn notifications-for-sharee [notifications-fn sharer {sharee :id subject-source-id :source_id} responses] - (if (ipg/user-source? subject-source-id) + (if (groups-client/user-source? subject-source-id) (notifications-fn sharer sharee responses) - (->> (:members (ipg/list-group-members-by-id sharer sharee)) - (filter (comp ipg/user-source? :source_id)) + (->> (:members (groups-client/list-group-members-by-id sharer sharee)) + (filter (comp groups-client/user-source? :source_id)) (mapcat (fn [{sharee :id}] (notifications-fn sharer sharee responses)))))) diff --git a/src/apps/clients/permissions.clj b/src/apps/clients/permissions.clj index 0befa1a2..e55d5dc0 100644 --- a/src/apps/clients/permissions.clj +++ b/src/apps/clients/permissions.clj @@ -1,5 +1,5 @@ (ns apps.clients.permissions - (:require [apps.clients.groups :as ipg] + (:require [apps.clients.groups :as groups-client] [apps.util.cache :as cache] [apps.util.config :as config] [apps.util.service :as service] @@ -119,7 +119,7 @@ (defn- get-public-resource-ids [resource-type] (->> (pc/get-abbreviated-subject-permissions-for-resource-type - (client) "group" (ipg/de-users-group-id) resource-type false) + (client) "group" (groups-client/de-users-group-id) resource-type false) :permissions (map (comp uuidify :resource_name)) set)) @@ -145,12 +145,12 @@ (defn make-app-public [user app-id] (revoke-app-user-permission user app-id) - (pc/grant-permission (client) (rt-app) app-id "group" (ipg/de-users-group-id) "read") + (pc/grant-permission (client) (rt-app) app-id "group" (groups-client/de-users-group-id) "read") ((:invalidate public-app-ids-cache))) (defn register-public-tool [tool-id] - (pc/grant-permission (client) (rt-tool) tool-id "group" (ipg/de-users-group-id) "read") + (pc/grant-permission (client) (rt-tool) tool-id "group" (groups-client/de-users-group-id) "read") ((:invalidate public-tool-ids-cache))) (defn make-tool-public @@ -172,7 +172,7 @@ (defn- share-resource ([resource-type resource-name {subject-source-id :source_id subject-id :id} level] - (share-resource resource-type resource-name (ipg/get-subject-type subject-source-id) subject-id level)) + (share-resource resource-type resource-name (groups-client/get-subject-type subject-source-id) subject-id level)) ([resource-type resource-name subject-type subject-id level] (try+ (pc/grant-permission (client) resource-type resource-name subject-type subject-id level) @@ -184,7 +184,7 @@ (defn- unshare-resource ([resource-type resource-name {subject-source-id :source_id subject-id :id}] - (unshare-resource resource-type resource-name (ipg/get-subject-type subject-source-id) subject-id)) + (unshare-resource resource-type resource-name (groups-client/get-subject-type subject-source-id) subject-id)) ([resource-type resource-name subject-type subject-id] (try+ (pc/revoke-permission (client) resource-type resource-name subject-type subject-id) diff --git a/src/apps/routes/admin.clj b/src/apps/routes/admin.clj index 0d9dc023..21c67f87 100644 --- a/src/apps/routes/admin.clj +++ b/src/apps/routes/admin.clj @@ -120,6 +120,8 @@ :return schema/AdminAppListing :summary "List Apps in a Community" :description (str "Lists all of the apps under an App Community that are visible to an admin." + " An identifier that names no community lists no apps rather than failing," + " unlike the endpoints that tag an app, which reject it with a 404." (routes/get-endpoint-delegate-block "metadata" "POST /avus/filter-targets")) diff --git a/src/apps/routes/apps/categories.clj b/src/apps/routes/apps/categories.clj index 388d1cab..d1a6c2ed 100644 --- a/src/apps/routes/apps/categories.clj +++ b/src/apps/routes/apps/categories.clj @@ -95,7 +95,9 @@ :query [params AppListingPagingParams] :return AppListing :summary schema/AppCommunityAppListingSummary - :description schema/AppCommunityAppListingDocs + :description (str schema/AppCommunityAppListingDocs + " An identifier that names no community lists no apps rather than failing," + " unlike the endpoints that tag an app, which reject it with a 404.") (ok (coerce! AppListing (apps/list-apps-in-community current-user community-id params)))) (undocumented (route/not-found (service/unrecognized-path-response)))) diff --git a/src/apps/service/apps/communities.clj b/src/apps/service/apps/communities.clj index 6c1d5878..2c1dc2ed 100644 --- a/src/apps/service/apps/communities.clj +++ b/src/apps/service/apps/communities.clj @@ -1,5 +1,5 @@ (ns apps.service.apps.communities - (:require [apps.clients.groups :as groups] + (:require [apps.clients.groups :as groups-client] [apps.clients.metadata :as metadata-client] [apps.util.config :as config] [cheshire.core :as json] @@ -12,12 +12,12 @@ is what a community listing matches on, so accepting one that resolves to no community writes a tag no app will ever be found by." [identifier] - (or (groups/lookup-community identifier) + (or (groups-client/lookup-community identifier) (exception-util/not-found "No such community" :community identifier))) (defn- community-admin-ids [community-id] - (set (mapv :id (:members (groups/list-community-admins community-id))))) + (set (mapv :id (:members (groups-client/list-community-admins community-id))))) (defn get-community-name-and-admins "Resolves a community identifier to the community's name and its admin set." diff --git a/src/apps/service/apps/de/jobs/common.clj b/src/apps/service/apps/de/jobs/common.clj index 206daa4b..da4669c1 100644 --- a/src/apps/service/apps/de/jobs/common.clj +++ b/src/apps/service/apps/de/jobs/common.clj @@ -1,6 +1,6 @@ (ns apps.service.apps.de.jobs.common (:require - [apps.clients.groups :as ipg] + [apps.clients.groups :as groups-client] [apps.containers :as c] [apps.persistence.users :refer [get-user-id]] [apps.service.apps.de.jobs.params :as params] @@ -177,7 +177,7 @@ (defn build-submission [request-builder user email submission app] - (let [groups (future (:groups (ipg/lookup-subject-groups (:shortUsername user)))) + (let [groups (future (:groups (groups-client/lookup-subject-groups (:shortUsername user)))) steps (future (.buildSteps request-builder)) extra (future (.buildExtra request-builder))] (-> {:app_description (:description app) diff --git a/src/apps/service/apps/de/listings.clj b/src/apps/service/apps/de/listings.clj index 6a6368ad..aa1579c8 100644 --- a/src/apps/service/apps/de/listings.clj +++ b/src/apps/service/apps/de/listings.clj @@ -1,6 +1,6 @@ (ns apps.service.apps.de.listings (:require - [apps.clients.groups :as groups] + [apps.clients.groups :as groups-client] [apps.clients.metadata :as metadata-client] [apps.clients.permissions :as perms-client] [apps.constants :refer [de-system-id executable-tool-type]] @@ -392,7 +392,7 @@ ;; The identifier is resolved rather than matched verbatim, so a community ID, ;; a plain name, and a legacy colon-delimited path all select the same apps. ;; The stored tag is the community's ID, which is what the write path records. - (if-let [community (groups/lookup-community community-id)] + (if-let [community (groups-client/lookup-community community-id)] (let [community-avu {:attr (workspace-metadata-communities-attr) :value (:id community)}] (set (metadata-client/filter-by-avus username app-ids [community-avu]))) diff --git a/src/apps/service/apps/job_listings.clj b/src/apps/service/apps/job_listings.clj index aba7cc00..f1924850 100644 --- a/src/apps/service/apps/job_listings.clj +++ b/src/apps/service/apps/job_listings.clj @@ -1,6 +1,6 @@ (ns apps.service.apps.job-listings (:require - [apps.clients.groups :as ipg] + [apps.clients.groups :as groups-client] [apps.clients.notifications :refer [interapps-url]] [apps.clients.permissions :as perms-client] [apps.persistence.jobs :as jp] @@ -104,7 +104,7 @@ (defn list-jobs [apps-client {:keys [username] :as user} {:keys [sort-field] :as params}] (let [perms (future (perms-client/load-analysis-permissions (:shortUsername user))) - group-ids (future (->> (ipg/lookup-subject-groups (:shortUsername user)) :groups (mapv :id))) + group-ids (future (->> (groups-client/lookup-subject-groups (:shortUsername user)) :groups (mapv :id))) subject-ids (future (conj @group-ids (:shortUsername user))) default-sort-dir (if (nil? sort-field) :desc :asc) search-params (util/default-search-params params :startdate default-sort-dir) @@ -119,7 +119,7 @@ (defn list-job-stats [apps-client user params] - (let [group-ids (future (->> (ipg/lookup-subject-groups (:shortUsername user)) :groups (mapv :id))) + (let [group-ids (future (->> (groups-client/lookup-subject-groups (:shortUsername user)) :groups (mapv :id))) subject-ids (future (conj @group-ids (:shortUsername user))) types (.getJobTypes apps-client)] {:status-count (count-job-statuses user params types @subject-ids)})) diff --git a/src/apps/service/apps/tapis/listings.clj b/src/apps/service/apps/tapis/listings.clj index 726dc48e..17115bbd 100644 --- a/src/apps/service/apps/tapis/listings.clj +++ b/src/apps/service/apps/tapis/listings.clj @@ -1,6 +1,6 @@ (ns apps.service.apps.tapis.listings (:require - [apps.clients.groups :as ipg] + [apps.clients.groups :as groups-client] [apps.persistence.app-metadata :as ap] [apps.service.apps.util :refer [to-qualified-app-id]] [apps.service.util :refer [apply-limit apply-offset format-job-stats sort-apps valid-uuid?]] @@ -33,7 +33,7 @@ (defn- add-app-integrator-info ([app-listing] - (let [subject-info-for (ipg/lookup-subjects (map :owner (:apps app-listing))) + (let [subject-info-for (groups-client/lookup-subjects (map :owner (:apps app-listing))) add-integrator (partial add-app-integrator-info subject-info-for)] (update app-listing :apps (partial mapv add-integrator)))) ([subject-info-for {:keys [owner] :as app-listing}] @@ -45,7 +45,7 @@ (defn- add-app-details-integrator-info [{:keys [owner] :as app-details}] - (let [subject-info-for (ipg/lookup-subjects [owner])] + (let [subject-info-for (groups-client/lookup-subjects [owner])] (add-app-integrator-info subject-info-for app-details))) (defn get-app-details diff --git a/src/apps/service/apps/tapis/sharing.clj b/src/apps/service/apps/tapis/sharing.clj index 96e981f1..6a4a92c4 100644 --- a/src/apps/service/apps/tapis/sharing.clj +++ b/src/apps/service/apps/tapis/sharing.clj @@ -1,6 +1,6 @@ (ns apps.service.apps.tapis.sharing (:require - [apps.clients.groups :as ipg] + [apps.clients.groups :as groups-client] [apps.persistence.jobs :as jp] [apps.service.apps.permissions :as app-permissions] [clojure-commons.error-codes :as ce :refer [clj-http-error?]] @@ -9,7 +9,7 @@ (defn- try-share-app-with-subject [tapis sharee app-id level success-fn failure-fn] - (if-not (ipg/user-source? (:source_id sharee)) + (if-not (groups-client/user-source? (:source_id sharee)) (failure-fn "Sharing HPC apps with a group is not supported") (try+ (if level diff --git a/src/apps/service/groups.clj b/src/apps/service/groups.clj index 2b4eaf60..adff65ff 100644 --- a/src/apps/service/groups.clj +++ b/src/apps/service/groups.clj @@ -1,12 +1,12 @@ (ns apps.service.groups - (:require [apps.clients.groups :as ipg])) + (:require [apps.clients.groups :as groups-client])) (defn get-workshop-group [] - (select-keys (ipg/get-workshop-group) + (select-keys (groups-client/get-workshop-group) [:id :name :group_type :display_name :description])) (defn get-workshop-group-members [] - (ipg/get-workshop-group-members)) + (groups-client/get-workshop-group-members)) (defn update-workshop-group-members "Replaces the workshop group membership. The replacement results list only @@ -14,6 +14,6 @@ report success -- so the new membership comes from re-reading the group; only the failures come from the results." [subject-ids] - (let [results (:results (ipg/update-workshop-group-members subject-ids))] + (let [results (:results (groups-client/update-workshop-group-members subject-ids))] {:members (:members (get-workshop-group-members)) :failures (mapv :subject_id (remove :success results))})) diff --git a/src/apps/service/workspace.clj b/src/apps/service/workspace.clj index 4552edc8..2bfca26e 100644 --- a/src/apps/service/workspace.clj +++ b/src/apps/service/workspace.clj @@ -1,6 +1,6 @@ (ns apps.service.workspace (:require - [apps.clients.groups :as ipg] + [apps.clients.groups :as groups-client] [apps.persistence.workspace :as wp] [apps.user :refer [append-username-suffix]])) @@ -12,7 +12,7 @@ (defn get-workspace [{short-username :shortUsername :keys [username]}] - (ipg/add-de-user short-username) + (groups-client/add-de-user short-username) (if-let [workspace (wp/get-workspace username)] (format-workspace workspace false) (format-workspace (wp/create-workspace username) true))) diff --git a/src/apps/user.clj b/src/apps/user.clj index e2adc4f5..046efbc6 100644 --- a/src/apps/user.clj +++ b/src/apps/user.clj @@ -1,6 +1,6 @@ (ns apps.user (:require - [apps.clients.groups :as ipg] + [apps.clients.groups :as groups-client] [apps.util.config :refer [uid-domain]] [clojure.string :as string] [clojure.tools.logging :as log] @@ -47,13 +47,13 @@ [username act-as-username] (let [short-username (string/replace username #"@.*" "") short-act-as-username (string/replace act-as-username #"@.*" "") - user-info (ipg/lookup-subject short-act-as-username short-username)] + user-info (groups-client/lookup-subject short-act-as-username short-username)] {:username (append-username-suffix short-username) :password nil :email (:email user-info) :shortUsername short-username - :first-name (:first-name user-info) - :last-name (:last-name user-info)})) + :first-name (:first_name user-info) + :last-name (:last_name user-info)})) (defn load-user "Loads information for the user with the given username." diff --git a/test.properties b/test.properties index 96f90830..bf1f639c 100644 --- a/test.properties +++ b/test.properties @@ -68,5 +68,5 @@ apps.notificationagent.base-url = http://localhost:31320 # The job status polling interval. apps.jobs.poll-interval = 15 -# The base URL for iplant-groups. -apps.iplant-groups.base-url = http://localhost:31310 +# The base URL for the groups service. +apps.groups.base-url = http://localhost:31310 diff --git a/test/apps/service/apps/communities_test.clj b/test/apps/service/apps/communities_test.clj index 94daadc5..1b8bdf35 100644 --- a/test/apps/service/apps/communities_test.clj +++ b/test/apps/service/apps/communities_test.clj @@ -1,5 +1,5 @@ (ns apps.service.apps.communities-test - (:require [apps.clients.groups :as groups] + (:require [apps.clients.groups :as groups-client] [apps.service.apps.communities :as communities] [apps.util.config :as config] [clojure.test :refer [deftest is testing]] @@ -51,8 +51,8 @@ (deftest lookup-community-identifier-forms-test (let [resolve-community #'communities/resolve-community imaging {:id imaging-id :name "Imaging" :group_type "community"}] - (with-redefs-fn {#'groups/lookup-group (fn [_group-type name] (when (= "Imaging" name) imaging)) - #'groups/get-group-by-id (constantly nil)} + (with-redefs-fn {#'groups-client/lookup-group (fn [_group-type name] (when (= "Imaging" name) imaging)) + #'groups-client/get-group-by-id (constantly nil)} (fn [] (testing "a legacy Grouper communities path resolves by its short name" (is (= imaging (resolve-community "iplant:de:de:communities:Imaging")))) @@ -65,25 +65,25 @@ (deftest lookup-community-branch-precedence-test (testing "which lookup each identifier form goes through" (let [imaging (fn [via] {:id imaging-id :name "Imaging" :group_type "community" :via via})] - (with-redefs-fn {#'groups/get-group-by-id (fn [group-id] (imaging [:id group-id])) - #'groups/lookup-group (fn [_group-type name] (imaging [:name name]))} + (with-redefs-fn {#'groups-client/get-group-by-id (fn [group-id] (imaging [:id group-id])) + #'groups-client/lookup-group (fn [_group-type name] (imaging [:name name]))} (fn [] - (is (= [:id imaging-id] (:via (groups/lookup-community imaging-id))) + (is (= [:id imaging-id] (:via (groups-client/lookup-community imaging-id))) "a 32-hex identifier is looked up as a group ID") - (is (= [:name "Imaging"] (:via (groups/lookup-community "Imaging"))) + (is (= [:name "Imaging"] (:via (groups-client/lookup-community "Imaging"))) "a plain name is looked up as a community name") - (is (= [:name "Imaging"] (:via (groups/lookup-community "iplant:de:de:communities:Imaging"))) + (is (= [:name "Imaging"] (:via (groups-client/lookup-community "iplant:de:de:communities:Imaging"))) "a communities path is looked up by its short name")))))) (deftest resolve-community-test (let [resolve-community #'communities/resolve-community imaging {:id imaging-id :name "Imaging" :group_type "community"}] (testing "an identifier that names a community resolves to it" - (with-redefs [groups/lookup-community (constantly imaging)] + (with-redefs [groups-client/lookup-community (constantly imaging)] (is (= imaging (resolve-community "Imaging"))))) (testing "an identifier that names nothing is a 404, not a silently stored tag" - (with-redefs [groups/lookup-community (constantly nil)] + (with-redefs [groups-client/lookup-community (constantly nil)] (is (= :clojure-commons.exception/not-found (caught-type (resolve-community "iplant:de:de:communities:Gone")))))))) @@ -91,8 +91,8 @@ (testing "the community's admin set gates callers who are not administrators" (let [resolve-request #'communities/resolve-request-communities imaging {:id imaging-id :name "Imaging" :group_type "community"}] - (with-redefs [groups/lookup-community (constantly imaging) - groups/list-community-admins (constantly {:members [{:id "someadmin"}]})] + (with-redefs [groups-client/lookup-community (constantly imaging) + groups-client/list-community-admins (constantly {:members [{:id "someadmin"}]})] (testing "a caller outside the admin set is refused" (is (= :clojure-commons.exception/forbidden (caught-type (resolve-request "outsider" {:community_ids [imaging-id]} false))))) @@ -101,10 +101,8 @@ (deftest admin-still-resolves-communities-test (testing "an administrator skips the community-admin check but not resolution" - ;; Skipping resolution for administrators is what allowed an unresolvable - ;; value to be written verbatim, producing a tag no listing can match. (let [resolve-request #'communities/resolve-request-communities] (with-community-attr - (with-redefs [groups/lookup-community (constantly nil)] + (with-redefs [groups-client/lookup-community (constantly nil)] (is (= :clojure-commons.exception/not-found (caught-type (resolve-request "someadmin" {:community_ids ["nope"]} true))))))))) diff --git a/test/apps/service/apps/de/community_listings_test.clj b/test/apps/service/apps/de/community_listings_test.clj index 2042a4f8..2446d28d 100644 --- a/test/apps/service/apps/de/community_listings_test.clj +++ b/test/apps/service/apps/de/community_listings_test.clj @@ -1,5 +1,5 @@ (ns apps.service.apps.de.community-listings-test - (:require [apps.clients.groups :as groups] + (:require [apps.clients.groups :as groups-client] [apps.clients.metadata :as metadata-client] [apps.service.apps.de.listings :as listings] [apps.util.config :as config] @@ -20,7 +20,7 @@ (doseq [identifier [imaging-id "Imaging" "iplant:de:prod:communities:Imaging"]] (let [sent (atom nil)] (with-redefs [config/workspace-metadata-communities-attr (constantly community-attr) - groups/lookup-community (constantly imaging) + groups-client/lookup-community (constantly imaging) metadata-client/filter-by-avus (fn [_ ids avus] (reset! sent avus) ids)] @@ -35,7 +35,7 @@ ;; longer exists. (let [called (atom false)] (with-redefs [config/workspace-metadata-communities-attr (constantly community-attr) - groups/lookup-community (constantly nil) + groups-client/lookup-community (constantly nil) metadata-client/filter-by-avus (fn [& _] (reset! called true) app-ids)] (is (= #{} (filter-by-community "someuser" "iplant:de:prod:communities:Vanished" app-ids))) (is (false? @called))))))) diff --git a/test/apps/service/apps/permissions_test.clj b/test/apps/service/apps/permissions_test.clj index 95360695..902d51db 100644 --- a/test/apps/service/apps/permissions_test.clj +++ b/test/apps/service/apps/permissions_test.clj @@ -1,6 +1,6 @@ (ns apps.service.apps.permissions-test (:require - [apps.clients.iplant-groups :as ipg] + [apps.clients.groups :as groups-client] [apps.clients.permissions :as perms-client] [apps.constants :refer [de-system-id]] [apps.service.apps :as apps] @@ -37,7 +37,7 @@ (let [{username :shortUsername :as user} (get-user :testde1) dev-category-id (:id (atf/get-dev-category user)) beta-category-id (:id (atf/get-beta-category user)) - group-id (ipg/grouper-user-group-id)] + group-id (groups-client/de-users-group-id)] (is (= 1 (:total (apps/list-apps-in-category user de-system-id dev-category-id {})))) (is (= (count atf/beta-apps) (:total (apps/list-apps-in-category user de-system-id beta-category-id {})))) (perms-client/unshare-app (:id atf/test-app) "user" username) @@ -51,7 +51,7 @@ (deftest test-app-hierarchy-counts (let [{username :shortUsername :as user} (get-user :testde1) - group-id (ipg/grouper-user-group-id)] + group-id (groups-client/de-users-group-id)] (is (= 1 (:total (atf/get-dev-category user)))) (is (= (count atf/beta-apps) (:total (atf/get-beta-category user)))) (perms-client/unshare-app (:id atf/test-app) "user" username) @@ -67,7 +67,7 @@ ;; FIXME the Beta category is obsolete (deftest test-admin-app-hierarchy-counts (let [user (get-user :testde1) - group-id (ipg/grouper-user-group-id)] + group-id (groups-client/de-users-group-id)] (is (= (count atf/beta-apps) (:total (atf/get-admin-beta-category user)))) (pc/revoke-permission (config/permissions-client) "app" (:id (first atf/beta-apps)) "group" group-id) (is (= (dec (count atf/beta-apps)) (:total (atf/get-admin-beta-category user)))))) @@ -79,7 +79,7 @@ (deftest test-app-category-listing (let [user (get-user :testde1) beta-category-id (:id (atf/get-beta-category user)) - group-id (ipg/grouper-user-group-id) + group-id (groups-client/de-users-group-id) app-id (:id (first atf/beta-apps))] (is (find-app (apps/list-apps-in-category user de-system-id beta-category-id {}) app-id)) (pc/revoke-permission (config/permissions-client) "app" (:id (first atf/beta-apps)) "group" group-id) @@ -261,10 +261,10 @@ (let [{username :shortUsername :as user} (get-user :testde1)] (sql/delete :app_documentation (sql/where {:app_id (:id atf/test-app)})) (is (has-permission? "app" (:id atf/test-app) "user" username "own")) - (is (not (has-permission? "app" (:id atf/test-app) "group" (ipg/grouper-user-group-id) "read"))) + (is (not (has-permission? "app" (:id atf/test-app) "group" (groups-client/de-users-group-id) "read"))) (apps/make-app-public user de-system-id atf/test-app) (is (not (has-permission? "app" (:id atf/test-app) "user" username "own"))) - (is (has-permission? "app" (:id atf/test-app) "group" (ipg/grouper-user-group-id) "read")))) + (is (has-permission? "app" (:id atf/test-app) "group" (groups-client/de-users-group-id) "read")))) (defn share-app [sharer sharee app-id level] (apps/share-apps sharer false [{:user (:shortUsername sharee) diff --git a/test/apps/service/apps/test_fixtures.clj b/test/apps/service/apps/test_fixtures.clj index df60cc8e..3e8ad073 100644 --- a/test/apps/service/apps/test_fixtures.clj +++ b/test/apps/service/apps/test_fixtures.clj @@ -1,6 +1,6 @@ (ns apps.service.apps.test-fixtures (:require - [apps.clients.iplant-groups :as ipg] + [apps.clients.groups :as groups-client] [apps.constants :refer [de-system-id]] [apps.persistence.jobs :as jp] [apps.service.apps :as apps] @@ -129,7 +129,7 @@ (defn register-public-apps [] (for [app (list-public-apps)] - (do (pc/grant-permission (config/permissions-client) "app" (:id app) "group" (ipg/grouper-user-group-id) "read") + (do (pc/grant-permission (config/permissions-client) "app" (:id app) "group" (groups-client/de-users-group-id) "read") app))) (defn category-name-subselect [_category-name] diff --git a/test/apps/service/groups_test.clj b/test/apps/service/groups_test.clj index 60b3f863..0851903f 100644 --- a/test/apps/service/groups_test.clj +++ b/test/apps/service/groups_test.clj @@ -1,5 +1,5 @@ (ns apps.service.groups-test - (:require [apps.clients.groups :as ipg] + (:require [apps.clients.groups :as groups-client] [apps.routes.schemas.groups :as schema] [apps.service.groups :as groups] [clojure.test :refer [deftest is testing]] @@ -29,8 +29,8 @@ (deftest update-workshop-group-members-test (testing "members come from re-reading the group, failures from the results" - (with-redefs [ipg/update-workshop-group-members (constantly update-response) - ipg/get-workshop-group-members (constantly membership-after)] + (with-redefs [groups-client/update-workshop-group-members (constantly update-response) + groups-client/get-workshop-group-members (constantly membership-after)] (let [response (groups/update-workshop-group-members ["kept-user" "added-user" "imaginary-user"])] (is (= {:members [{:id "kept-user" :name "Kept User" :source_id "ldap"} {:id "added-user" :name "Added User" :source_id "ldap"}] From beacdec12368aba058b5aab762069a869d72cef8 Mon Sep 17 00:00:00 2001 From: John Wregglesworth Date: Thu, 3 Sep 2026 15:21:49 -0700 Subject: [PATCH 13/13] Select the workshop membership rather than forwarding it GET /groups/workshop/members returned the groups service's response body verbatim, validated against the closed GroupMembers schema. The groups service now reports a total alongside the members so a caller can page a large group, and that extra key fails response coercion here -- a 500 on a route that was working. Select the one key this route declares, the way get-workshop-group already does, so a field added upstream cannot break it again. Co-Authored-By: Claude Opus 5 (1M context) Claude-Session: https://claude.ai/code/session_01Wjd21NTp4Ead7JYhx5sQUT --- src/apps/service/groups.clj | 5 ++++- test/apps/service/groups_test.clj | 10 ++++++++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/src/apps/service/groups.clj b/src/apps/service/groups.clj index adff65ff..57e17146 100644 --- a/src/apps/service/groups.clj +++ b/src/apps/service/groups.clj @@ -6,7 +6,10 @@ [:id :name :group_type :display_name :description])) (defn get-workshop-group-members [] - (groups-client/get-workshop-group-members)) + ;; Selected rather than forwarded: the route validates this against the closed + ;; GroupMembers schema, so any field the groups service adds to its own + ;; response would otherwise fail response coercion here. + (select-keys (groups-client/get-workshop-group-members) [:members])) (defn update-workshop-group-members "Replaces the workshop group membership. The replacement results list only diff --git a/test/apps/service/groups_test.clj b/test/apps/service/groups_test.clj index 0851903f..f74e9ac6 100644 --- a/test/apps/service/groups_test.clj +++ b/test/apps/service/groups_test.clj @@ -37,3 +37,13 @@ :failures ["imaginary-user"]} response)) (is (= response (s/validate schema/GroupMembersUpdateResponse response))))))) + +(deftest get-workshop-group-members-test + (testing "fields the groups service adds do not reach the response schema" + ;; total is reported alongside the members so a caller can page a large + ;; group; GroupMembers is closed, so forwarding it verbatim would 500. + (with-redefs [groups-client/get-workshop-group-members + (constantly (assoc membership-after :total 2))] + (let [response (groups/get-workshop-group-members)] + (is (= membership-after response)) + (is (= response (s/validate schema/GroupMembers response)))))))