diff --git a/src/terrain/auth/user_attributes.clj b/src/terrain/auth/user_attributes.clj index 674b567e..a8a49138 100644 --- a/src/terrain/auth/user_attributes.clj +++ b/src/terrain/auth/user_attributes.clj @@ -4,7 +4,7 @@ [clojure-commons.response :as resp] [clojure-commons.exception-util :as cxu] [slingshot.slingshot :refer [try+]] - [terrain.clients.iplant-groups.subjects :as subjects] + [terrain.clients.grouping.subjects :as subjects] [terrain.util.config :as cfg] [terrain.util.jwt :as jwt] [terrain.util.keycloak-oidc :as keycloak-oidc-util])) @@ -59,14 +59,15 @@ "Looks up the user with the given username." [username] (try+ - (let [subject (subjects/lookup-subject (cfg/grouper-user) username)] + (if-let [subject (subjects/lookup-subject username)] {:username (str (:id subject) "@" (cfg/uid-domain)) :password nil :email (:email subject) :shortUsername (:id subject) :firstName (:first_name subject) :lastName (:last_name subject) - :commonName (:description subject)}) + :commonName (:description subject)} + (cxu/internal-system-error (str "fake user " username " not found"))) (catch [:status 404] _ (cxu/internal-system-error (str "fake user " username " not found"))) (catch Object _ diff --git a/src/terrain/clients/apps/raw.clj b/src/terrain/clients/apps/raw.clj index fcd26052..6059154e 100644 --- a/src/terrain/clients/apps/raw.clj +++ b/src/terrain/clients/apps/raw.clj @@ -422,6 +422,14 @@ :content-type :json :as :json})))) +(defn remove-app-from-community + [app-id community-id] + (:body + (client/delete (apps-url "apps" app-id "communities" community-id) + (disable-redirects + {:query-params (secured-params) + :as :json})))) + (defn update-app-communities [app-id body] (:body diff --git a/src/terrain/clients/grouping.clj b/src/terrain/clients/grouping.clj new file mode 100644 index 00000000..a2e0d9d9 --- /dev/null +++ b/src/terrain/clients/grouping.clj @@ -0,0 +1,181 @@ +(ns terrain.clients.grouping + "Facade over the two group backends. Dispatches each operation to either the legacy + iplant-groups client or the new Groups service client based on the configured backend. + This namespace exists to support a config-gated cutover and is intended to be removed + once the migration to the Groups service is complete, at which point callers can depend + on terrain.clients.groups directly." + (:require [terrain.clients.groups :as groups] + [terrain.clients.grouping.subjects :refer [new-backend?]] + [terrain.clients.iplant-groups :as ipg])) + +;; Subjects. + +(defn find-subjects [user search] + (if (new-backend?) + (groups/find-subjects user search) + (ipg/find-subjects user search))) + +(defn lookup-subject [user short-username] + (if (new-backend?) + (groups/lookup-subject user short-username) + (ipg/lookup-subject user short-username))) + +(defn lookup-subject-add-empty [user short-username] + (if (new-backend?) + (groups/lookup-subject-add-empty user short-username) + (ipg/lookup-subject-add-empty user short-username))) + +(defn list-groups-for-user [subject-id details] + (if (new-backend?) + (groups/list-groups-for-user subject-id details) + (ipg/list-groups-for-user subject-id details))) + +(defn remove-de-user [subject-id] + (if (new-backend?) + (groups/remove-de-user subject-id) + (ipg/remove-de-user subject-id))) + +;; Collaborator lists. + +(defn get-collaborator-lists + ([user details] + (if (new-backend?) + (groups/get-collaborator-lists user details) + (ipg/get-collaborator-lists user details))) + ([user details search] + (if (new-backend?) + (groups/get-collaborator-lists user details search) + (ipg/get-collaborator-lists user details search)))) + +(defn add-collaborator-list [user body] + (if (new-backend?) + (groups/add-collaborator-list user body) + (ipg/add-collaborator-list user body))) + +(defn get-collaborator-list [user name] + (if (new-backend?) + (groups/get-collaborator-list user name) + (ipg/get-collaborator-list user name))) + +(defn update-collaborator-list [user name body] + (if (new-backend?) + (groups/update-collaborator-list user name body) + (ipg/update-collaborator-list user name body))) + +(defn delete-collaborator-list [user name] + (if (new-backend?) + (groups/delete-collaborator-list user name) + (ipg/delete-collaborator-list user name))) + +(defn get-collaborator-list-members [user name] + (if (new-backend?) + (groups/get-collaborator-list-members user name) + (ipg/get-collaborator-list-members user name))) + +(defn add-collaborator-list-members [user name members] + (if (new-backend?) + (groups/add-collaborator-list-members user name members) + (ipg/add-collaborator-list-members user name members))) + +(defn remove-collaborator-list-members [user name members] + (if (new-backend?) + (groups/remove-collaborator-list-members user name members) + (ipg/remove-collaborator-list-members user name members))) + +;; Teams. + +(defn get-teams [user params] + (if (new-backend?) (groups/get-teams user params) (ipg/get-teams user params))) + +(defn add-team [user body] + (if (new-backend?) (groups/add-team user body) (ipg/add-team user body))) + +(defn get-team [user name] + (if (new-backend?) (groups/get-team user name) (ipg/get-team user name))) + +(defn update-team [user name body] + (if (new-backend?) (groups/update-team user name body) (ipg/update-team user name body))) + +(defn delete-team [user name] + (if (new-backend?) (groups/delete-team user name) (ipg/delete-team user name))) + +(defn verify-team-exists [user name] + (if (new-backend?) (groups/verify-team-exists user name) (ipg/verify-team-exists user name))) + +(defn get-team-members [user name] + (if (new-backend?) (groups/get-team-members user name) (ipg/get-team-members user name))) + +(defn add-team-members [user name members] + (if (new-backend?) (groups/add-team-members user name members) (ipg/add-team-members user name members))) + +(defn remove-team-members [user name members] + (if (new-backend?) + (groups/remove-team-members user name members) + (ipg/remove-team-members user name members))) + +(defn list-team-privileges [user name] + (if (new-backend?) (groups/list-team-privileges user name) (ipg/list-team-privileges user name))) + +(defn update-team-privileges [user name updates] + (if (new-backend?) + (groups/update-team-privileges user name updates) + (ipg/update-team-privileges user name updates))) + +(defn get-team-admins [user name] + (if (new-backend?) (groups/get-team-admins user name) (ipg/get-team-admins user name))) + +(defn join-team [user name] + (if (new-backend?) (groups/join-team user name) (ipg/join-team user name))) + +(defn leave-team [user name] + (if (new-backend?) (groups/leave-team user name) (ipg/leave-team user name))) + +;; Communities. + +(defn get-communities [user params] + (if (new-backend?) (groups/get-communities user params) (ipg/get-communities user params))) + +(defn admin-get-communities [user params] + (if (new-backend?) (groups/admin-get-communities user params) (ipg/admin-get-communities user params))) + +(defn add-community [user body] + (if (new-backend?) (groups/add-community user body) (ipg/add-community user body))) + +(defn get-community [user name] + (if (new-backend?) (groups/get-community user name) (ipg/get-community user name))) + +;; The retag-apps and force-rename flags apply only to the legacy backend. Community app tags +;; there are AVUs whose value is the community's name, so a rename had to rewrite them or be +;; blocked. The paired apps image tags a community by ID instead, leaving a rename with nothing +;; to rewrite and nothing to block, so the flags are accepted and ignored here. That is a +;; property of the deployed apps image rather than of terrain: against an older apps image a +;; rename silently orphans every tag, which is why terrain.groups.backend documents the pairing. +(defn update-community [user name retag-apps? force-rename? body] + (if (new-backend?) + (groups/update-community user name body) + (ipg/update-community user name retag-apps? force-rename? body))) + +(defn delete-community [user name] + (if (new-backend?) (groups/delete-community user name) (ipg/delete-community user name))) + +(defn get-community-members [user name] + (if (new-backend?) (groups/get-community-members user name) (ipg/get-community-members user name))) + +(defn get-community-admins [user name] + (if (new-backend?) (groups/get-community-admins user name) (ipg/get-community-admins user name))) + +(defn add-community-admins [user name members] + (if (new-backend?) + (groups/add-community-admins user name members) + (ipg/add-community-admins user name members))) + +(defn remove-community-admins [user name members] + (if (new-backend?) + (groups/remove-community-admins user name members) + (ipg/remove-community-admins user name members))) + +(defn join-community [user name] + (if (new-backend?) (groups/join-community user name) (ipg/join-community user name))) + +(defn leave-community [user name] + (if (new-backend?) (groups/leave-community user name) (ipg/leave-community user name))) diff --git a/src/terrain/clients/grouping/subjects.clj b/src/terrain/clients/grouping/subjects.clj new file mode 100644 index 00000000..208f464e --- /dev/null +++ b/src/terrain/clients/grouping/subjects.clj @@ -0,0 +1,39 @@ +(ns terrain.clients.grouping.subjects + "Lightweight facade for subject lookups. Kept separate from terrain.clients.grouping so + that terrain.auth.user-attributes can depend on it without pulling in the legacy + iplant-groups client, which transitively requires user-attributes and would create a + circular dependency. Both backends reached from here (terrain.clients.groups and + terrain.clients.iplant-groups.subjects) are dependency-cycle safe." + (:require [terrain.clients.groups :as groups] + [terrain.clients.iplant-groups.subjects :as ipg-subjects] + [terrain.util.config :as config])) + +(defn new-backend? + "True when group operations should be routed to the Groups service. Defined here rather than + in terrain.clients.grouping so that both facades test the backend the same way." + [] + (= (config/groups-backend) config/groups-backend-groups)) + +(defn admin-user + "The administrative account for the active group backend. Callers acting as the group + administrator must use this rather than a specific backend's configured account." + [] + (if (new-backend?) + (config/groups-admin-user) + (config/grouper-user))) + +(defn lookup-subject + ([short-username] + (lookup-subject (admin-user) short-username)) + ([user short-username] + (if (new-backend?) + (groups/lookup-subject user short-username) + (ipg-subjects/lookup-subject user short-username)))) + +(defn lookup-subjects + ([subject-ids] + (lookup-subjects (admin-user) subject-ids)) + ([user subject-ids] + (if (new-backend?) + (groups/lookup-subjects user subject-ids) + (ipg-subjects/lookup-subjects user subject-ids)))) diff --git a/src/terrain/clients/groups.clj b/src/terrain/clients/groups.clj new file mode 100644 index 00000000..59ff4488 --- /dev/null +++ b/src/terrain/clients/groups.clj @@ -0,0 +1,747 @@ +(ns terrain.clients.groups + "HTTP client for the Groups service, the intended replacement for iplant-groups. + + Groups are addressed by their structured identity -- type, owner, and short name -- so + nothing here packs hierarchy into a group name. The one place terrain's external group + contract is composed is `format-group`, including the `:` name the DE uses + for teams. Every request forwards the acting user as the `user` query parameter." + (:require [cemerick.url :as curl] + [clj-http.client :as http] + [clojure.string :as string] + [clojure-commons.exception-util :as cxu] + [medley.core :refer [remove-vals]] + [slingshot.slingshot :refer [try+]] + [terrain.clients.subject-info :as subject-info] + [terrain.util.config :as config])) + +;; The group types the Groups service recognizes. +(def ^:private type-collaborator-list "collaborator_list") +(def ^:private type-team "team") +(def ^:private type-community "community") +(def ^:private type-system "system") + +;; The well-known subject representing all DE users. It matches the value the legacy Grouper +;; backend used for its public subject (and Sonora's configurable grouper.allUsers), so no +;; Sonora configuration change is required. +(def ^:private public-subject "GrouperAll") + +;; The connection pool in terrain.core sets an idle-connection TTL, not a request deadline, so +;; these keep a stalled Groups service from pinning request threads indefinitely. Subject lookups +;; run on the bootstrap and user-info paths, so a hang here reaches well beyond group management. +(def ^:private request-timeouts + {:socket-timeout 10000 + :conn-timeout 10000}) + +(defn- groups-url + [& components] + (str (apply curl/url (config/groups-base) components))) + +(defn- query + "Builds the query parameters for a request: the acting user plus whichever filters were + actually given." + ([user] {:user user}) + ([user params] (assoc (remove-vals nil? params) :user user))) + +(defn- admin-user? + "True if the given subject is the Groups administrative user, which should never be + surfaced to callers." + [{id :id}] + (= id (config/groups-admin-user))) + +;; Subject search and lookup functions. + +(defn- format-subject + "The Groups service returns user subjects directly, so the display name is simply the subject + name, falling back to the subject id when the name is blank. The listing schemas require a + non-blank display name, so one nameless member would otherwise fail the whole response." + [{:keys [id name] :as subject}] + (assoc subject :display_name (or (not-empty name) id))) + +(defn- format-subjects + [subjects] + (mapv format-subject (remove admin-user? subjects))) + +(defn find-subjects + "Searches for subjects matching the given search string." + [user search] + (-> (http/get (groups-url "subjects") + (merge request-timeouts + {:query-params (query user {:search search}) + :as :json})) + :body + (update :subjects format-subjects))) + +(defn lookup-subject + "Looks up a single subject by ID, returning nil if the subject is not found." + [user short-username] + (subject-info/lookup-or-nil + short-username + #(:body (http/get (groups-url "subjects" short-username) + (merge request-timeouts + {:query-params (query user) + :as :json}))))) + +(defn lookup-subjects + "Looks up multiple subjects by ID. Unresolvable IDs are silently omitted by the service." + [user subject-ids] + (:body (http/post (groups-url "subjects" "lookup") + (merge request-timeouts + {:query-params (query user) + :form-params {:subject_ids subject-ids} + :content-type :json + :as :json})))) + +(defn- subjects-by-id + "Bulk-resolves subject IDs into a map keyed by ID. An empty list of IDs resolves to an empty + map without a request; the service has nothing to look up." + [user subject-ids] + (if (seq subject-ids) + (into {} (map (juxt :id identity)) (:subjects (lookup-subjects user (vec subject-ids)))) + {})) + +(defn lookup-subject-add-empty + "Looks up a single subject by ID, returning an empty user-info block if nothing is found." + [user short-username] + (or (lookup-subject user short-username) + (subject-info/empty-user-info short-username))) + +;; The external group contract. + +(defn- subject-group-levels + "Maps group ID to the permission level the user holds on it, in one request. The service + folds in permissions inherited through group membership, so this agrees with what an + authorization check on any single group would decide." + [user] + (->> (http/get (groups-url "subjects" user "permissions") + (merge request-timeouts + {:query-params (query user) + :as :json})) + :body + :permissions + (reduce (fn [acc {:keys [group_id level]}] (assoc acc group_id level)) {}))) + +(defn- external-name + "The name terrain exposes for a group. Teams carry their owner as a prefix because two + users may own teams with the same short name; no other group type is qualified." + [{:keys [group_type owner name]}] + (if (= group_type type-team) + (str owner ":" name) + name)) + +(defn- format-group + "Reshapes a group from the Groups service into terrain's external group contract. This is + the only place that contract is composed, and the only place that knows a team's external + name embeds its owner." + [group] + {:id (:id group) + :name (external-name group) + :type "group" + :id_index "" + :description (or (:description group) "") + :display_extension (:name group) + :display_name (or (:display_name group) (:name group))}) + +(defn- epoch-millis + [timestamp] + (if timestamp + (.toEpochMilli (.toInstant (java.time.OffsetDateTime/parse timestamp))) + 0)) + +(defn- creator-subject + "The subject block for a group's creator, falling back to the bare owner id when the + lookup resolved nothing or the subject has no name." + [subjects-by-id owner] + (let [subject (get subjects-by-id owner {:id owner :source_id ""})] + (update subject :name #(or (not-empty %) owner)))) + +(defn- attach-details + "Adds the :detail block the DE's listings read -- creation time plus creator id and display + name -- to each formatted group, resolving all distinct owners' names with one bulk subject + lookup. A group with no owner (e.g. a community) gets no :detail: there is no creator to + report." + [user groups formatted-groups] + (let [owners (distinct (keep :owner groups)) + by-id (subjects-by-id user owners)] + (mapv (fn [{:keys [owner created_at]} formatted] + (cond-> formatted + owner (assoc :detail {:created_at (epoch-millis created_at) + :created_by owner + :created_by_detail (creator-subject by-id owner) + :has_composite false + :is_composite_factor false}))) + groups + formatted-groups))) + +(defn- format-groups + "Formats a listing into the external contract, attaching :detail when it was requested." + [user details groups] + (let [formatted (mapv format-group groups)] + (if details (attach-details user groups formatted) formatted))) + +;; Group identity and requests. A `ref` is a group's structured identity: its type, its owner +;; where it has one, and its short name. + +(defn- ref-label + [{:keys [group-type owner name]}] + (str group-type " " (if owner (str owner ":" name) name))) + +(defn- find-group + "Resolves a group by its structured identity, returning nil if it does not exist." + [user {:keys [group-type owner name]}] + (try+ + (:body (http/get (groups-url "groups" "lookup") + (merge request-timeouts + {:query-params (query user {:group_type group-type :owner owner :name name}) + :as :json}))) + (catch [:status 404] _ nil))) + +(defn- get-group + "Resolves a group by its structured identity, throwing a 404 if it does not exist." + [user ref] + (or (find-group user ref) + (cxu/not-found (str "group not found: " (ref-label ref))))) + +(defn- group-id + [user ref] + (:id (get-group user ref))) + +;; The Groups service caps one listing response at this many groups. +(def ^:private list-page-size 1000) + +(defn- list-groups + "Lists groups page by page. The service silently caps a single response at + `list-page-size` groups, so an unpaged request would truncate large listings." + [user filters] + (loop [offset 0 groups []] + (let [page (:groups (:body (http/get (groups-url "groups") + (merge request-timeouts + {:query-params (query user (assoc filters + :limit list-page-size + :offset offset)) + :as :json})))) + groups (into groups page)] + (if (< (count page) list-page-size) + groups + (recur (+ offset (count page)) groups))))) + +(defn- create-group + [user spec] + (:body (http/post (groups-url "groups") + (merge request-timeouts + {:query-params (query user) + :form-params (remove-vals nil? spec) + :content-type :json + :as :json})))) + +(defn- update-group + [user id updates] + (:body (http/put (groups-url "groups" id) + (merge request-timeouts + {:query-params (query user) + :form-params (remove-vals nil? updates) + :content-type :json + :as :json})))) + +(defn- delete-group + "Deletes a group by ID. The service returns no body, so callers report the group they + resolved beforehand rather than a deletion response." + [user id] + (http/delete (groups-url "groups" id) (merge request-timeouts {:query-params (query user)})) + nil) + +(defn- delete-group-by-ref + "Deletes a group by identity, returning it in the external contract shape." + [user ref] + (let [group (get-group user ref)] + (delete-group user (:id group)) + (format-group group))) + +;; Membership. + +(defn- format-member-results + "Defaults a blank source_id (e.g. a non-federated user or a failed operation) and subject + name so the response satisfies the group membership schema." + [results] + (mapv (fn [{:keys [subject_id] :as result}] + (-> result + (update :source_id (fn [s] (if (string/blank? s) "unknown" s))) + (update :subject_name (fn [n] (or (not-empty n) subject_id))))) + results)) + +(defn- list-members + [user group-id] + {:members (format-subjects + (:members (:body (http/get (groups-url "groups" group-id "members") + (merge request-timeouts + {:query-params (query user) :as :json})))))}) + +(defn- change-members + [user group-id components members] + (->> (http/post (apply groups-url "groups" group-id components) + (merge request-timeouts + {:query-params (query user) + :form-params {:members members} + :content-type :json + :as :json})) + :body + :results + format-member-results + (hash-map :results))) + +(defn- add-members + [user group-id members] + (change-members user group-id ["members"] members)) + +(defn- remove-members + [user group-id members] + (change-members user group-id ["members" "deleter"] members)) + +;; Group permissions. The Groups service records group-management rights in the permissions +;; service (own/write/admin/read). Terrain translates those to the privilege vocabulary used +;; by the DE UI: `admin` (own/admin), `read` (write/read), and `view` for the public subject. + +(defn- grant-permission + [user group-id subject-type subject-id level] + (http/put (groups-url "groups" group-id "permissions" subject-type subject-id) + (merge request-timeouts + {:query-params (query user) + :form-params {:level level} + :content-type :json + :as :json}))) + +(defn- revoke-permission + [user group-id subject-type subject-id] + (try+ + (http/delete (groups-url "groups" group-id "permissions" subject-type subject-id) + (merge request-timeouts {:query-params (query user) :as :json})) + (catch [:status 404] _ nil))) + +(defn- group-permissions + [user group-id] + (:permissions (:body (http/get (groups-url "groups" group-id "permissions") + (merge request-timeouts + {:query-params (query user) :as :json}))))) + +(defn- level->privilege-name + [subject-id level] + (cond + (= subject-id public-subject) "view" + (#{"own" "admin"} level) "admin" + :else "read")) + +(defn- privileges->level + "Collapses the UI privilege names assigned to a subject into a single permission level, + or nil when the subject's privileges should be revoked." + [names] + (let [names (set names)] + (cond + (names "admin") "admin" + (or (names "read") (names "view")) "read" + :else nil))) + +(defn- permission-subject + [subjects-by-id {:keys [subject_id subject_type]}] + (if (= subject_type "group") + {:id subject_id :source_id "g:gsa"} + (get subjects-by-id subject_id {:id subject_id :source_id ""}))) + +(defn- list-privileges + [user group-id] + (let [perms (group-permissions user group-id) + user-ids (->> perms (map :subject) (filter (comp #{"user"} :subject_type)) (map :subject_id)) + by-id (subjects-by-id user user-ids)] + {:privileges (mapv (fn [{:keys [subject level]}] + {:type "access" + :name (level->privilege-name (:subject_id subject) level) + :subject (permission-subject by-id subject)}) + perms)})) + +(defn- admins-of + "Lists the administrators of a group by id: the user subjects holding own/admin, excluding + the administrative service user and the public subject." + [user group-id] + (let [admin-ids (->> (group-permissions user group-id) + (filter (comp #{"user"} :subject_type :subject)) + (filter (comp #{"own" "admin"} :level)) + (map (comp :subject_id :subject)) + (remove #{(config/groups-admin-user)}) + vec) + by-id (subjects-by-id user admin-ids)] + {:members (mapv #(get by-id % {:id % :source_id ""}) admin-ids)})) + +;; Collaborator lists, which are owned by the user who created them. + +(defn- collaborator-list-ref + [user name] + {:group-type type-collaborator-list :owner user :name name}) + +(defn get-collaborator-lists + "Lists (or searches) the calling user's collaborator lists. The search is performed by the + service, which matches on name and description." + ([user details] + (get-collaborator-lists user details nil)) + ([user details search] + {:groups (format-groups user details (list-groups user {:group_type type-collaborator-list + :owner user + :search search}))})) + +(defn add-collaborator-list + "Creates a collaborator list owned by the calling user." + [user {:keys [name description]}] + (format-group (create-group user {:group_type type-collaborator-list + :owner user + :name name + :display_name name + :description description}))) + +(defn get-collaborator-list + "Retrieves a single collaborator list by its short name." + [user name] + (format-group (get-group user (collaborator-list-ref user name)))) + +(defn update-collaborator-list + "Updates the name and/or description of a collaborator list." + [user old-name {:keys [name description]}] + (let [id (group-id user (collaborator-list-ref user old-name))] + (format-group (update-group user id {:name name + :display_name name + :description description})))) + +(defn delete-collaborator-list + "Deletes a collaborator list, returning the removed group (including its id)." + [user name] + (delete-group-by-ref user (collaborator-list-ref user name))) + +(defn get-collaborator-list-members + "Lists the members of a collaborator list." + [user name] + (list-members user (group-id user (collaborator-list-ref user name)))) + +(defn add-collaborator-list-members + "Adds members to a collaborator list, creating the list if it does not yet exist." + [user name members] + ;; find-group turns only a 404 into nil; the service 403s for a group that exists but is + ;; unreadable, which propagates as an error here rather than triggering a create. + (let [id (or (:id (find-group user (collaborator-list-ref user name))) + (:id (add-collaborator-list user {:name name :description ""})))] + (add-members user id members))) + +(defn remove-collaborator-list-members + "Removes members from a collaborator list." + [user name members] + (remove-members user (group-id user (collaborator-list-ref user name)) members)) + +;; Teams, whose external name is `:`. + +(defn- team-ref + "Parses the external team name into a group identity. Only the first colon separates the + owner from the short name, which may itself contain colons." + [external-name] + (let [[owner name] (string/split external-name #":" 2)] + (when (string/blank? name) + (cxu/bad-request (str "team names must be qualified by their owner: " external-name))) + {:group-type type-team :owner owner :name name})) + +(defn get-teams + "Lists (or searches) teams, optionally scoped to a creator or to teams a member belongs to. + Filtering and searching are performed by the service." + [user {:keys [search creator member details]}] + {:groups (format-groups user details (list-groups user {:group_type type-team + :owner creator + :member member + :search search}))}) + +;; Grouper separated `view` -- the group is discoverable and joinable -- from `read`, which +;; also exposes the member list, and both arrive here in public_privileges. The permissions +;; service has no level weaker than read, so the public marker is one grant either way and +;; the member-list half is carried by the group's own members_public flag. +(defn- members-public? + [public-privileges] + (boolean (some #{"read"} public-privileges))) + +;; `optin` is what let a user add themselves without approval. The DE sends it for +;; communities and withholds it from public teams, which go through the join-request +;; flow instead -- so this is not derivable from members-public?, even though the two +;; happen to coincide in the privileges the DE currently sends. +(defn- joinable? + [public-privileges] + (boolean (some #{"optin"} public-privileges))) + +(defn add-team + "Creates a team owned by the caller, optionally granting all DE users read access when the + team is public." + [user {:keys [name description public_privileges] :or {public_privileges []}}] + (let [group (create-group user {:group_type type-team + :owner user + :name name + :display_name name + :description description + :members_public (members-public? public_privileges) + :joinable (joinable? public_privileges)})] + (when (seq public_privileges) + (grant-permission user (:id group) "group" public-subject "read")) + (format-group group))) + +(defn get-team + "Retrieves a single team by its `:` name." + [user name] + (format-group (get-group user (team-ref name)))) + +(defn verify-team-exists + "Throws a 404 if the named team does not exist." + [user name] + (get-group user (team-ref name)) + nil) + +(defn update-team + "Updates the name and/or description of a team. The owner is part of the team's identity + and cannot change, so only the short name is sent." + [user name {new-name :name description :description}] + (let [id (group-id user (team-ref name))] + (format-group (update-group user id {:name new-name + :display_name new-name + :description description})))) + +(defn delete-team + "Deletes a team, returning the removed group (including its id)." + [user name] + (delete-group-by-ref user (team-ref name))) + +(defn get-team-members + "Lists the members of a team." + [user name] + (list-members user (group-id user (team-ref name)))) + +(defn- reject-admin-user + "The administrative account may not be a member of anything. It is filtered out of every + listing, so admitting it creates a member the UI cannot show or remove." + [members] + (when (some #{(config/groups-admin-user)} members) + (cxu/bad-request "the administrative user may not be added to or removed from any group"))) + +(defn add-team-members + "Adds members to a team. Membership implies read access, so no privilege grant is needed." + [user name members] + (reject-admin-user members) + (add-members user (group-id user (team-ref name)) members)) + +(defn remove-team-members + "Removes members from a team." + [user name members] + (reject-admin-user members) + (remove-members user (group-id user (team-ref name)) members)) + +(defn join-team + "Adds the caller to a team that is open to join. The membership change is performed as the + administrative user because a non-member has no write access to the group. + + Being public is not enough: Grouper granted the all-users subject `optin` on groups that + could be joined directly and only `view` on public teams, refusing a self-join against + those. Teams use the join-request flow, where an administrator approves." + [user name] + (reject-admin-user [user]) + (let [group (get-group user (team-ref name))] + (when-not (:joinable group) + (cxu/forbidden (str "team is not open to join: " name))) + (add-members (config/groups-admin-user) (:id group) [user]))) + +(defn- revoke-membership-read + "Revokes a subject's read permission on a group, and only read. + + The DE granted every member `optout` and `read` together, so leaving revoked both and an + ex-member kept nothing. The importer turns that `read` into an explicit grant, which + removing membership does not touch -- so without this an ex-member keeps read access to the + group and its member list. + + Deliberately narrow: Grouper's leave revoked only the member privileges, so someone holding + `admin` who left a group kept administering it. Revoking whatever level is present would + strip owners and admins." + [group-id subject-id] + (let [admin (config/groups-admin-user) + level (->> (group-permissions admin group-id) + (filter #(= subject-id (:subject_id (:subject %)))) + first + :level)] + (when (= "read" level) + (revoke-permission admin group-id "user" subject-id)))) + +(defn leave-team + "Removes the caller from a team, performed as the administrative user, then drops the read + grant that membership carried. Membership goes first: if the removal fails, the caller is + still an ordinary member rather than a member whose read grant was already revoked." + [user name] + (reject-admin-user [user]) + (let [id (group-id user (team-ref name)) + results (remove-members (config/groups-admin-user) id [user])] + (revoke-membership-read id user) + results)) + +(defn list-team-privileges + "Lists the privileges granted on a team, translated to the DE privilege vocabulary." + [user name] + (list-privileges user (group-id user (team-ref name)))) + +(defn update-team-privileges + "Applies privilege updates to a team, translating DE privilege names to permission levels. + A subject with no privileges has its permission revoked. + + The public subject also carries the halves of `view`/`read`/`optin` that the permissions + service has no level for, so its privileges rewrite the group's own flags as well; otherwise + a team's member-list visibility and joinability would be frozen at whatever it was created + with. The flags are written first so they are never broader than the grants backing them." + [user name {:keys [updates]}] + (let [id (group-id user (team-ref name))] + (doseq [{:keys [subject_id privileges]} updates] + (let [subject-type (if (= subject_id public-subject) "group" "user")] + (when (= subject_id public-subject) + (update-group user id {:members_public (members-public? privileges) + :joinable (joinable? privileges)})) + (if-let [level (privileges->level privileges)] + (grant-permission user id subject-type subject_id level) + (revoke-permission user id subject-type subject_id)))) + (list-privileges user id))) + +(defn get-team-admins + "Lists the administrators of a team." + [user name] + (admins-of user (group-id user (team-ref name)))) + +;; Communities, which belong to no user namespace. Public communities grant the all-users +;; subject read (joinable), surfaced as the `view` privilege. Community admins hold the admin +;; privilege and are also members. + +(defn- community-ref + [name] + {:group-type type-community :name name}) + +(defn get-communities + "Lists (or searches) communities, reporting whether the caller is a member of each and + which privileges it holds. The details flag is deliberately ignored: communities have no + owner, so there is no creator to build a :detail block from." + [user {:keys [search member]}] + (let [groups (list-groups user {:group_type type-community :member member :search search}) + ;; When listing a user's own communities every result is a membership; otherwise the + ;; caller's memberships are fetched once rather than once per listed community. + member-of (if (= user member) + (set (map external-name groups)) + (set (map external-name (list-groups user {:group_type type-community + :member user})))) + ;; Also once for the whole listing rather than once per community. + levels (subject-group-levels user)] + {:groups (mapv (fn [group] + (let [level (get levels (:id group))] + (assoc (format-group group) + :member (contains? member-of (external-name group)) + ;; One level collapses to one privilege name, where Grouper + ;; could hold several at once. That is the same collapse + ;; privileges->level performs when a privilege is granted. + :privileges (if level + [(level->privilege-name user level)] + [])))) + groups)})) + +(defn admin-get-communities + "Lists (or searches) all communities without per-user membership details." + [user {:keys [search]}] + {:groups (mapv format-group (list-groups user {:group_type type-community :search search}))}) + +(defn add-community + "Creates a community, granting all DE users read when it is public." + [user {:keys [name description public_privileges] :or {public_privileges []}}] + (let [group (create-group user {:group_type type-community + :name name + :display_name name + :description description + :members_public (members-public? public_privileges) + :joinable (joinable? public_privileges)})] + (when (seq public_privileges) + (grant-permission user (:id group) "group" public-subject "read")) + (format-group group))) + +(defn get-community + "Retrieves a single community by its short name." + [user name] + (format-group (get-group user (community-ref name)))) + +(defn update-community + "Updates the name and/or description of a community." + [user name {new-name :name description :description}] + (let [id (group-id user (community-ref name))] + (format-group (update-group user id {:name new-name + :display_name new-name + :description description})))) + +(defn delete-community + "Deletes a community, returning the removed group (including its id)." + [user name] + (delete-group-by-ref user (community-ref name))) + +(defn get-community-members + "Lists the members of a community." + [user name] + (list-members user (group-id user (community-ref name)))) + +(defn get-community-admins + "Lists the administrators of a community." + [user name] + (admins-of user (group-id user (community-ref name)))) + +(defn add-community-admins + "Grants the given subjects the admin privilege on a community and adds them as members." + [user name members] + (reject-admin-user members) + (let [id (group-id user (community-ref name))] + (doseq [member members] + (grant-permission user id "user" member "admin")) + (add-members user id members))) + +(defn remove-community-admins + "Revokes the admin privilege from the given subjects and removes them as members." + [user name members] + (reject-admin-user members) + (let [id (group-id user (community-ref name))] + (doseq [member members] + (revoke-permission user id "user" member)) + (remove-members user id members))) + +(defn join-community + "Adds the caller to a community that is open to join, performed as the administrative user. + Communities carried `optin` in Grouper, so in practice this admits the same set as before. + See join-team." + [user name] + (reject-admin-user [user]) + (let [group (get-group user (community-ref name))] + (when-not (:joinable group) + (cxu/forbidden (str "community is not open to join: " name))) + (add-members (config/groups-admin-user) (:id group) [user]))) + +(defn leave-community + "Removes the caller from a community, performed as the administrative user, then drops the + read grant that membership carried. See leave-team for the ordering." + [user name] + (reject-admin-user [user]) + (let [id (group-id user (community-ref name)) + results (remove-members (config/groups-admin-user) id [user])] + (revoke-membership-read id user) + results)) + +;; DE user group administration. + +(defn list-groups-for-user + "Lists the groups to which the given subject belongs, including through nesting." + [subject-id details] + (let [admin (config/groups-admin-user) + groups (:groups (:body (http/get (groups-url "subjects" subject-id "groups") + (merge request-timeouts + {:query-params (query admin) + :as :json}))))] + {:groups (format-groups admin details groups)})) + +(defn remove-de-user + "Removes a user from the well-known DE users group." + [subject-id] + (let [admin (config/groups-admin-user) + id (group-id admin {:group-type type-system :name (config/de-users-group)})] + (http/delete (groups-url "groups" id "members" subject-id) + (merge request-timeouts {:query-params (query admin) :as :json})) + nil)) diff --git a/src/terrain/clients/iplant_groups.clj b/src/terrain/clients/iplant_groups.clj index f9fc5641..548da551 100644 --- a/src/terrain/clients/iplant_groups.clj +++ b/src/terrain/clients/iplant_groups.clj @@ -1,6 +1,5 @@ (ns terrain.clients.iplant-groups (:require [clojure.string :as string] - [clojure.tools.logging :as log] [clojure-commons.exception-util :as cxu] [cyverse-groups-client.core :as c] [medley.core :refer [remove-vals]] @@ -8,6 +7,7 @@ [terrain.clients.apps.raw :as apps-client] [terrain.clients.iplant-groups.subjects :as subjects] [terrain.clients.metadata.raw :as metadata-client] + [terrain.clients.subject-info :as subject-info] [terrain.util.config :as config])) (def ^:private team-group-type "group") @@ -35,46 +35,17 @@ (defn grouper-admin-user? [{username :id}] (= username (config/grouper-user))) -(defn format-like-trellis - "Reformat an iplant-groups response to look like a trellis response." - [response] - {:username (:id response) - :firstname (:first_name response) - :lastname (:last_name response) - :name (:name response) - :email (:email response) - :institution (:institution response)}) - -(defn- empty-user-info - "Returns an empty user-info record for the given username." - [username] - {:id username - :name "" - :first_name "" - :last_name "" - :email "" - :institution "" - :source_id ""}) - (defn lookup-subject "Uses iplant-groups's subject lookup by ID endpoint to retrieve user details." [user short-username] - (try+ - (subjects/lookup-subject user short-username) - (catch [:status 404] _ - (log/warn (str "no user info found for username '" short-username "'")) - nil) - (catch Object _ - (log/error (:throwable &throw-context) "user lookup for '" short-username "' failed") - nil))) + (subject-info/lookup-or-nil short-username #(subjects/lookup-subject user short-username))) (defn lookup-subject-add-empty "Uses iplant-groups's subject lookup by ID endpoint to retrieve user details, returning an empty user info block if nothing is found." [user short-username] - (if-let [user-info (lookup-subject user short-username)] - user-info - (empty-user-info short-username))) + (or (lookup-subject user short-username) + (subject-info/empty-user-info short-username))) (defn- get-client [] (c/new-cyverse-groups-client (config/ipg-base) (config/environment-name))) diff --git a/src/terrain/clients/subject_info.clj b/src/terrain/clients/subject_info.clj new file mode 100644 index 00000000..eea59f17 --- /dev/null +++ b/src/terrain/clients/subject_info.clj @@ -0,0 +1,41 @@ +(ns terrain.clients.subject-info + "Backend-neutral helpers for subject lookups. Both group clients reshape subject information + and recover from failed lookups in exactly the same way, so the shared pieces live here + rather than in either client." + (:require [clojure.tools.logging :as log] + [slingshot.slingshot :refer [try+]])) + +(defn format-like-trellis + "Reformats a subject lookup response to look like a trellis response." + [response] + {:username (:id response) + :firstname (:first_name response) + :lastname (:last_name response) + :name (:name response) + :email (:email response) + :institution (:institution response)}) + +(defn empty-user-info + "Returns an empty user-info record for the given username." + [username] + {:id username + :name "" + :first_name "" + :last_name "" + :email "" + :institution "" + :source_id ""}) + +(defn lookup-or-nil + "Performs a subject lookup, logging and returning nil when the subject is missing or the + lookup fails. Subject details decorate responses that are otherwise complete, so a lookup + failure must not fail the request that triggered it." + [short-username lookup-fn] + (try+ + (lookup-fn) + (catch [:status 404] _ + (log/warn (str "no user info found for username '" short-username "'")) + nil) + (catch Object _ + (log/error (:throwable &throw-context) "user lookup for '" short-username "' failed") + nil))) diff --git a/src/terrain/routes/apps/communities.clj b/src/terrain/routes/apps/communities.clj index ffdf2265..09ae2fc2 100644 --- a/src/terrain/routes/apps/communities.clj +++ b/src/terrain/routes/apps/communities.clj @@ -1,9 +1,6 @@ (ns terrain.routes.apps.communities (:require [common-swagger-api.schema :refer [context DELETE POST]] - [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]] [ring.util.http-response :refer [ok]] @@ -13,7 +10,7 @@ [terrain.util.config :as config])) ;; Declarations to get rid of lint warnings for path and query parameter bindings. -(declare body app-id) +(declare body app-id community-id) (defn app-community-tag-routes [] @@ -25,17 +22,24 @@ :tags ["app-community-tags"] :path-params [app-id :- AppIdParam] + (DELETE "/:community-id" [] + :middleware [require-authentication] + :path-params [community-id :- schema/CommunityIdPathParam] + :summary schema/AppCommunityDeleteSummary + :description schema/AppCommunityDeleteDocs + (ok (apps/remove-app-from-community app-id community-id))) + (DELETE "/" [] :middleware [require-authentication] - :body [body AppCategoryMetadataDeleteRequest] + :body [body schema/AppCommunityListRequest] :summary schema/AppCommunityMetadataDeleteSummary :description schema/AppCommunityMetadataDeleteDocs (ok (apps/remove-app-from-communities app-id body))) (POST "/" [] :middleware [require-authentication] - :body [body AppCategoryMetadataAddRequest] + :body [body schema/AppCommunityListRequest] :return AvuList - :summary schema/AppCommunityMetadataAddSummary - :description schema/AppCommunityMetadataAddDocs + :summary schema/AppCommunityAddSummary + :description schema/AppCommunityAddDocs (ok (apps/update-app-communities app-id body)))))) diff --git a/src/terrain/routes/groups.clj b/src/terrain/routes/groups.clj index ea3a6d08..02ef8b0d 100644 --- a/src/terrain/routes/groups.clj +++ b/src/terrain/routes/groups.clj @@ -1,7 +1,7 @@ (ns terrain.routes.groups (:require [common-swagger-api.schema :refer [routes DELETE GET PUT]] [terrain.clients.apps.raw :as apps] - [terrain.clients.iplant-groups :as ipg] + [terrain.clients.grouping :as ipg] [terrain.util.service :as service])) ;; Declarations to eliminate lint warnings for path and query parameter bindings. diff --git a/src/terrain/routes/user_info.clj b/src/terrain/routes/user_info.clj index 1daa1a1f..f0122194 100644 --- a/src/terrain/routes/user_info.clj +++ b/src/terrain/routes/user_info.clj @@ -4,7 +4,7 @@ [ring.util.http-response :refer [ok]] [schema-tools.core :as st] [terrain.auth.user-attributes :refer [require-service-account]] - [terrain.clients.iplant-groups :as ipg] + [terrain.clients.grouping :as ipg] [terrain.clients.portal-conductor :as pc] [terrain.routes.schemas.user-info :as user-info-schema] [terrain.services.user-info :refer [user-info]] diff --git a/src/terrain/services/collaborator_lists.clj b/src/terrain/services/collaborator_lists.clj index d9f62352..6d58942b 100644 --- a/src/terrain/services/collaborator_lists.clj +++ b/src/terrain/services/collaborator_lists.clj @@ -1,5 +1,5 @@ (ns terrain.services.collaborator-lists - (:require [terrain.clients.iplant-groups :as ipg] + (:require [terrain.clients.grouping :as ipg] [terrain.clients.permissions :as perms-client])) (defn get-collaborator-lists [{user :shortUsername} {:keys [search details]}] diff --git a/src/terrain/services/communities.clj b/src/terrain/services/communities.clj index 67879d97..db065d59 100644 --- a/src/terrain/services/communities.clj +++ b/src/terrain/services/communities.clj @@ -1,8 +1,8 @@ (ns terrain.services.communities - (:require [terrain.clients.iplant-groups :as ipg] + (:require [terrain.clients.grouping :as ipg] + [terrain.clients.grouping.subjects :as subjects] [terrain.clients.permissions :as perms-client] - [terrain.clients.notifications :as cn] - [terrain.util.config :as config])) + [terrain.clients.notifications :as cn])) (defn get-communities [{user :shortUsername} params] (ipg/get-communities user (select-keys params [:search :member :details]))) @@ -44,22 +44,22 @@ (ipg/leave-community user name)) (defn admin-get-communities [params] - (ipg/admin-get-communities (config/grouper-user) params)) + (ipg/admin-get-communities (subjects/admin-user) params)) (defn admin-get-community [name] - (get-community {:shortUsername (config/grouper-user)} name)) + (get-community {:shortUsername (subjects/admin-user)} name)) (defn admin-update-community [name params body] - (update-community {:shortUsername (config/grouper-user)} name params body)) + (update-community {:shortUsername (subjects/admin-user)} name params body)) (defn admin-delete-community [name] - (delete-community {:shortUsername (config/grouper-user)} name)) + (delete-community {:shortUsername (subjects/admin-user)} name)) (defn admin-get-community-admins [name] - (get-community-admins {:shortUsername (config/grouper-user)} name)) + (get-community-admins {:shortUsername (subjects/admin-user)} name)) (defn admin-add-community-admins [name params] - (add-community-admins {:shortUsername (config/grouper-user)} name params)) + (add-community-admins {:shortUsername (subjects/admin-user)} name params)) (defn admin-remove-community-admins [name params] - (remove-community-admins {:shortUsername (config/grouper-user)} name params)) + (remove-community-admins {:shortUsername (subjects/admin-user)} name params)) diff --git a/src/terrain/services/metadata/apps.clj b/src/terrain/services/metadata/apps.clj index 6b021884..90f97bf8 100644 --- a/src/terrain/services/metadata/apps.clj +++ b/src/terrain/services/metadata/apps.clj @@ -1,8 +1,9 @@ (ns terrain.services.metadata.apps (:require [clojure.string :as string] - [terrain.clients.iplant-groups :as ipg] + [terrain.clients.grouping :as ipg] [terrain.clients.apps.raw :as apps-client] [terrain.clients.notifications :as dn] + [terrain.clients.subject-info :as subject-info] [terrain.util.email :as email])) (defn import-tools @@ -19,7 +20,7 @@ [body] (let [tool-req (apps-client/submit-tool-request body) username (string/replace (:submitted_by tool-req) #"@.*" "") - user-details (ipg/format-like-trellis (ipg/lookup-subject-add-empty username username))] + user-details (subject-info/format-like-trellis (ipg/lookup-subject-add-empty username username))] (email/send-tool-request-email tool-req user-details) tool-req)) diff --git a/src/terrain/services/permanent_id_requests.clj b/src/terrain/services/permanent_id_requests.clj index cae9e06a..139b165f 100644 --- a/src/terrain/services/permanent_id_requests.clj +++ b/src/terrain/services/permanent_id_requests.clj @@ -15,9 +15,10 @@ [terrain.clients.data-info :as data-info] [terrain.clients.data-info.raw :as data-info-client] [terrain.clients.datacite :as datacite-client] - [terrain.clients.iplant-groups :as groups] + [terrain.clients.grouping :as groups] [terrain.clients.metadata.raw :as metadata] [terrain.clients.notifications :as notifications] + [terrain.clients.subject-info :as subject-info] [terrain.util.config :as config] [terrain.util.email :as email]) (:import [java.util Locale])) @@ -407,7 +408,7 @@ If this dataset accompanies a paper, please contact us with the DOI for that pap (defn- format-requested-by [user {:keys [requested_by _target_id] :as permanent-id-request}] (if-let [user-info (groups/lookup-subject user requested_by)] - (assoc permanent-id-request :requested_by (groups/format-like-trellis user-info)) + (assoc permanent-id-request :requested_by (subject-info/format-like-trellis user-info)) permanent-id-request)) (defn- format-permanent-id-request-details diff --git a/src/terrain/services/qms.clj b/src/terrain/services/qms.clj index 9aebc13a..57deb500 100644 --- a/src/terrain/services/qms.clj +++ b/src/terrain/services/qms.clj @@ -1,7 +1,7 @@ (ns terrain.services.qms (:require [clojure-commons.core :refer [remove-nil-values]] [clojure-commons.exception-util :as cxu] - [terrain.clients.iplant-groups.subjects :as subjects] + [terrain.clients.grouping.subjects :as subjects] [terrain.clients.qms :as qms])) (defn- validate-username diff --git a/src/terrain/services/subjects.clj b/src/terrain/services/subjects.clj index e74f6d62..3061adcc 100644 --- a/src/terrain/services/subjects.clj +++ b/src/terrain/services/subjects.clj @@ -1,5 +1,5 @@ (ns terrain.services.subjects - (:require [terrain.clients.iplant-groups :as ipg])) + (:require [terrain.clients.grouping :as ipg])) (defn find-subjects [{user :shortUsername} {:keys [search]}] (ipg/find-subjects user search)) diff --git a/src/terrain/services/teams.clj b/src/terrain/services/teams.clj index 700d63e2..5b106ba5 100644 --- a/src/terrain/services/teams.clj +++ b/src/terrain/services/teams.clj @@ -1,6 +1,6 @@ (ns terrain.services.teams (:require [clojure-commons.assertions :as assertions] - [terrain.clients.iplant-groups :as ipg] + [terrain.clients.grouping :as ipg] [terrain.clients.permissions :as perms-client] [terrain.clients.notifications :as cn])) diff --git a/src/terrain/services/user_info.clj b/src/terrain/services/user_info.clj index c40d09d0..a4b6bffd 100644 --- a/src/terrain/services/user_info.clj +++ b/src/terrain/services/user_info.clj @@ -1,5 +1,5 @@ (ns terrain.services.user-info - (:require [terrain.clients.iplant-groups :as ipg] + (:require [terrain.clients.grouping :as ipg] [terrain.auth.user-attributes :as user])) (defn- add-user-info diff --git a/src/terrain/util/config.clj b/src/terrain/util/config.clj index 7475c3dd..2b222d1e 100644 --- a/src/terrain/util/config.clj +++ b/src/terrain/util/config.clj @@ -275,6 +275,43 @@ [props config-valid configs] "terrain.iplant-groups.de-users-group" "de-users") +(declare groups-base) +(cc/defprop-optstr groups-base + "The base URL for the Groups service." + [props config-valid configs] + "terrain.groups.base-url" "http://groups") + +(declare groups-admin-user) +(cc/defprop-optstr groups-admin-user + "The administrative user to use for the Groups service." + [props config-valid configs] + "terrain.groups.admin-user" "de_grouper") + +(def groups-backend-groups + "The value of `terrain.groups.backend` that selects the Groups service." + "groups") + +(def groups-backend-iplant-groups + "The value of `terrain.groups.backend` that selects the legacy iplant-groups service." + "iplant-groups") + +(def ^:private known-groups-backends + #{groups-backend-groups groups-backend-iplant-groups}) + +(defn valid-groups-backend? + "True if the given value names a group backend that terrain knows how to dispatch to." + [backend] + (contains? known-groups-backends backend)) + +(declare groups-backend) +(cc/defprop-optstr groups-backend + "Selects the backend used for group operations: `iplant-groups` (legacy) or `groups` (new). + The `groups` backend is only safe in an environment whose paired apps and Sonora images are + also deployed: community app tags name the community by ID there, and an older apps image + still tags by name, so a community rename against it silently orphans every app tag." + [props config-valid configs] + "terrain.groups.backend" groups-backend-iplant-groups) + (declare permissions-base) (cc/defprop-optstr permissions-base "The base URL for the permissions service." @@ -722,9 +759,24 @@ (def metadata-client (memoize #(metadata-client/new-metadata-client (metadata-base-url)))) +(defn- validate-groups-backend + "Marks the configuration invalid when the group backend selector names a backend that does not + exist. Every dispatch site tests for one specific backend, so an unrecognized or empty value + would otherwise select the legacy backend without any indication that it had done so." + [] + (let [backend (groups-backend)] + (when-not (valid-groups-backend? backend) + (cc/record-invalid-prop + "terrain.groups.backend" + (IllegalArgumentException. + (str "must be one of " (string/join ", " (sort known-groups-backends)) + ", but was '" backend "'")) + config-valid)))) + (defn- validate-config "Validates the configuration settings after they've been loaded." [] + (validate-groups-backend) (when-not (cc/validate-config configs config-valid) (throw+ {:error_code ce/ERR_CONFIG_INVALID}))) diff --git a/test/terrain/clients/groups_test.clj b/test/terrain/clients/groups_test.clj new file mode 100644 index 00000000..9af1ee82 --- /dev/null +++ b/test/terrain/clients/groups_test.clj @@ -0,0 +1,802 @@ +(ns terrain.clients.groups-test + (:require [cemerick.url :as curl] + [cheshire.core :as json] + [clj-http.fake :refer [with-fake-routes-in-isolation]] + [clojure.test :refer :all] + [clojure-commons.exception :as cx] + [slingshot.slingshot :refer [try+]] + [terrain.clients.groups :as groups] + [terrain.test-fixtures :as test-fixtures] + [terrain.util.config :as config])) + +(defmacro ^:private error-type + "Returns the error type thrown by `body`, or nil if it threw nothing." + [& body] + `(try+ ~@body nil (catch map? e# (:type e#)))) + +(use-fixtures :once test-fixtures/with-test-config test-fixtures/with-test-user) + +(defn- groups-url [& components] + (str (apply curl/url (config/groups-base) components))) + +(defn- json-response [body] + (fn [_] {:status 200 :headers {"Content-Type" "application/json"} :body (json/encode body)})) + +(defn- not-found [] + (fn [_] {:status 404 :headers {"Content-Type" "application/json"} :body "{}"})) + +(defn- captured-body + "Fake route that records the decoded request body in `capture` and responds with `body`." + [capture body] + (fn [req] + (reset! capture (json/decode (slurp (:body req)) true)) + {:status 200 :headers {"Content-Type" "application/json"} :body (json/encode body)})) + +(def ^:private alice + {:id "alice" :name "alice" :first_name "Alice" :last_name "Anderson" + :email "alice@example.org" :institution "CyVerse" :source_id "ldap"}) + +;; Groups as the service returns them: structured, with no hierarchy packed into the name. + +(def ^:private cl-group + {:id "g1" :group_type "collaborator_list" :owner "alice" :name "friends" + :display_name "friends" :description "buddies"}) + +(def ^:private team-group + {:id "t1" :group_type "team" :owner "alice" :name "t1" :display_name "t1" :description "d"}) + +(def ^:private community-group + {:id "c1" :group_type "community" :name "biology" :display_name "biology" :description "d"}) + +;; Subject search and lookup. + +(deftest find-subjects-test + (with-fake-routes-in-isolation + {{:address (groups-url "subjects") :query-params {:user "ipcdev" :search "ali"}} + (json-response {:subjects [alice {:id "de_grouper" :name "de_grouper"}]})} + (let [{:keys [subjects]} (groups/find-subjects "ipcdev" "ali")] + (testing "the administrative user is filtered out of the results" + (is (= 1 (count subjects))) + (is (= "alice" (:id (first subjects))))) + (testing "each subject gets a display_name equal to its name" + (is (= "alice" (:display_name (first subjects)))))))) + +(deftest lookup-subject-test + (with-fake-routes-in-isolation + {{:address (groups-url "subjects" "alice") :query-params {:user "de_grouper"}} + (json-response alice)} + (testing "a found subject is returned as-is" + (is (= alice (groups/lookup-subject "de_grouper" "alice"))))) + (with-fake-routes-in-isolation + {{:address (groups-url "subjects" "nobody") :query-params {:user "de_grouper"}} + (not-found)} + (testing "a missing subject yields nil rather than an error" + (is (nil? (groups/lookup-subject "de_grouper" "nobody")))))) + +(deftest lookup-subjects-test + (let [captured (atom nil)] + (with-fake-routes-in-isolation + {{:address (groups-url "subjects" "lookup") :query-params {:user "de_grouper"}} + (captured-body captured {:subjects [alice]})} + (testing "bulk lookup posts the subject ids and returns the subjects list" + (is (= [alice] (:subjects (groups/lookup-subjects "de_grouper" ["alice" "ghost"])))) + (is (= {:subject_ids ["alice" "ghost"]} @captured)))))) + +(deftest lookup-subject-add-empty-test + (with-fake-routes-in-isolation + {{:address (groups-url "subjects" "ghost") :query-params {:user "de_grouper"}} + (not-found)} + (testing "a missing subject yields an empty user-info block keyed by the username" + (is (= {:id "ghost" :name "" :first_name "" :last_name "" :email "" :institution "" :source_id ""} + (groups/lookup-subject-add-empty "de_grouper" "ghost")))))) + +;; The external group contract. Every response passes through one formatter, so this is the +;; single place the shape terrain promises its callers is asserted. + +(deftest format-group-contract-test + (with-fake-routes-in-isolation + {{:address (groups-url "subjects" "bob" "groups") :query-params {:user "de_grouper"}} + (json-response {:groups [team-group community-group]})} + (let [{:keys [groups]} (groups/list-groups-for-user "bob" nil) + [team community] groups] + (testing "a team's external name carries its owner prefix" + (is (= "alice:t1" (:name team)))) + (testing "other group types are named by their short name alone" + (is (= "biology" (:name community)))) + (testing "the contract fields are exactly those the group schema defines" + (is (= #{:id :name :type :id_index :description :display_extension :display_name} + (set (keys team))))) + (testing "the service's structured fields are not leaked to callers" + (is (not-any? #(contains? team %) [:group_type :owner :created_at :updated_at]))) + (testing "type and id_index are synthesized, and display_extension is the short name" + (is (= "group" (:type team))) + (is (= "" (:id_index team))) + (is (= "t1" (:display_extension team))))))) + +;; Collaborator lists. + +(defn- cl-lookup-route [] + {{:address (groups-url "groups" "lookup") + :query-params {:user "alice" :group_type "collaborator_list" :owner "alice" :name "friends"}} + (json-response cl-group)}) + +(deftest get-collaborator-lists-test + (testing "listing asks the service for the caller's own lists" + (with-fake-routes-in-isolation + {{:address (groups-url "groups") + :query-params {:user "alice" :group_type "collaborator_list" :owner "alice" :limit 1000 :offset 0}} + (json-response {:groups [cl-group]})} + (let [{:keys [groups]} (groups/get-collaborator-lists "alice" nil)] + (is (= ["friends"] (mapv :name groups))) + (is (= "g1" (:id (first groups))))))) + (testing "a search is delegated to the service rather than filtered in terrain" + (with-fake-routes-in-isolation + {{:address (groups-url "groups") + :query-params {:user "alice" :group_type "collaborator_list" :owner "alice" :search "fri" + :limit 1000 :offset 0}} + (json-response {:groups [cl-group]})} + (is (= ["friends"] (mapv :name (:groups (groups/get-collaborator-lists "alice" nil "fri")))))))) + +(deftest add-collaborator-list-test + (let [captured (atom nil)] + (with-fake-routes-in-isolation + {{:address (groups-url "groups") :query-params {:user "alice"}} + (captured-body captured cl-group)} + (let [result (groups/add-collaborator-list "alice" {:name "friends" :description "buddies"})] + (testing "the group is created by structured identity, with no name packing" + (is (= {:group_type "collaborator_list" :owner "alice" :name "friends" + :display_name "friends" :description "buddies"} + @captured))) + (testing "the created list is returned in the external contract shape" + (is (= "friends" (:name result))) + (is (= "g1" (:id result)))))))) + +(deftest get-collaborator-list-test + (with-fake-routes-in-isolation + (cl-lookup-route) + (testing "get resolves the list by identity in a single round trip" + (let [result (groups/get-collaborator-list "alice" "friends")] + (is (= "friends" (:name result))) + (is (= "g1" (:id result))))))) + +(deftest get-collaborator-list-not-found-test + (with-fake-routes-in-isolation + {{:address (groups-url "groups" "lookup") + :query-params {:user "alice" :group_type "collaborator_list" :owner "alice" :name "ghost"}} + (not-found)} + (testing "a missing list is reported as a 404 rather than an upstream error" + (is (= ::cx/not-found (error-type (groups/get-collaborator-list "alice" "ghost"))))))) + +(deftest update-collaborator-list-test + (let [captured (atom nil)] + (with-fake-routes-in-isolation + (merge (cl-lookup-route) + {{:address (groups-url "groups" "g1") :query-params {:user "alice"}} + (captured-body captured (assoc cl-group :name "pals" :display_name "pals"))}) + (let [result (groups/update-collaborator-list "alice" "friends" {:name "pals"})] + (testing "only the fields being changed are sent" + (is (= {:name "pals" :display_name "pals"} @captured))) + (is (= "pals" (:name result))))))) + +(deftest delete-collaborator-list-test + (with-fake-routes-in-isolation + (merge (cl-lookup-route) + {{:address (groups-url "groups" "g1") :query-params {:user "alice"}} + {:delete (json-response cl-group)}}) + (testing "delete returns the removed group including its id" + (let [result (groups/delete-collaborator-list "alice" "friends")] + (is (= "g1" (:id result))) + (is (= "friends" (:name result))))))) + +(deftest get-collaborator-list-members-test + (with-fake-routes-in-isolation + (merge (cl-lookup-route) + {{:address (groups-url "groups" "g1" "members") :query-params {:user "alice"}} + (json-response {:members [alice + {:id "carol" :name "" :source_id "ldap"} + {:id "de_grouper" :name "de_grouper"}]})}) + (let [{:keys [members]} (groups/get-collaborator-list-members "alice" "friends") + by-id (into {} (map (juxt :id identity)) members)] + (testing "members exclude the admin user and get a display_name" + (is (= 2 (count members))) + (is (= "alice" (:display_name (get by-id "alice"))))) + (testing "a member with a blank name falls back to its id rather than failing the listing" + (is (= "carol" (:display_name (get by-id "carol")))))))) + +(deftest add-collaborator-list-members-test + (with-fake-routes-in-isolation + (merge (cl-lookup-route) + {{:address (groups-url "groups" "g1" "members") :query-params {:user "alice"}} + (json-response {:results [{:subject_id "bob" :success true :source_id "ldap" :subject_name "Bob"} + {:subject_id "carol" :success true :source_id "" :subject_name ""}]})}) + (let [{:keys [results]} (groups/add-collaborator-list-members "alice" "friends" ["bob" "carol"]) + by-id (into {} (map (juxt :subject_id identity)) results)] + (testing "membership results pass through source_id and subject_name from the service" + (is (= {:subject_id "bob" :success true :source_id "ldap" :subject_name "Bob"} + (get by-id "bob")))) + (testing "a blank source_id or subject_name is defaulted to satisfy the schema" + (is (= {:subject_id "carol" :success true :source_id "unknown" :subject_name "carol"} + (get by-id "carol"))))))) + +(deftest add-collaborator-list-members-creates-missing-list-test + (let [created (atom nil)] + (with-fake-routes-in-isolation + {{:address (groups-url "groups" "lookup") + :query-params {:user "alice" :group_type "collaborator_list" :owner "alice" :name "friends"}} + (not-found) + {:address (groups-url "groups") :query-params {:user "alice"}} + (captured-body created cl-group) + {:address (groups-url "groups" "g1" "members") :query-params {:user "alice"}} + (json-response {:results [{:subject_id "bob" :success true :source_id "ldap" :subject_name "Bob"}]})} + (let [{:keys [results]} (groups/add-collaborator-list-members "alice" "friends" ["bob"])] + (testing "a list that does not exist yet is created rather than 404ing" + (is (= "friends" (:name @created))) + (is (= "bob" (:subject_id (first results))))))))) + +(deftest remove-collaborator-list-members-test + (with-fake-routes-in-isolation + (merge (cl-lookup-route) + {{:address (groups-url "groups" "g1" "members" "deleter") :query-params {:user "alice"}} + (json-response {:results [{:subject_id "bob" :success true :source_id "ldap" :subject_name "Bob"}]})}) + (is (= "bob" (:subject_id (first (:results (groups/remove-collaborator-list-members + "alice" "friends" ["bob"])))))))) + +;; Teams. The external name is `:`; nothing else knows that format. + +(defn- team-lookup-route [& {:keys [owner name group] :or {owner "alice" name "t1" group team-group}}] + {{:address (groups-url "groups" "lookup") + :query-params {:user "alice" :group_type "team" :owner owner :name name}} + (json-response group)}) + +(deftest get-teams-test + (testing "listing asks for teams by type" + (with-fake-routes-in-isolation + {{:address (groups-url "groups") :query-params {:user "alice" :group_type "team" :limit 1000 :offset 0}} + (json-response {:groups [team-group]})} + (let [{:keys [groups]} (groups/get-teams "alice" {})] + (is (= ["alice:t1"] (mapv :name groups))) + (is (= "group" (:type (first groups))))))) + (testing "a creator filter becomes an exact owner match, so `bob` cannot match `bobby`" + ;; The old client filtered on the `:` string prefix, which matched any creator + ;; whose name started with the requested one. + (with-fake-routes-in-isolation + {{:address (groups-url "groups") + :query-params {:user "alice" :group_type "team" :owner "bob" :limit 1000 :offset 0}} + (json-response {:groups []})} + (is (= [] (:groups (groups/get-teams "alice" {:creator "bob"})))))) + (testing "a member filter is delegated to the service" + (with-fake-routes-in-isolation + {{:address (groups-url "groups") + :query-params {:user "alice" :group_type "team" :member "bob" :limit 1000 :offset 0}} + (json-response {:groups [team-group]})} + (is (= ["alice:t1"] (mapv :name (:groups (groups/get-teams "alice" {:member "bob"}))))))) + (testing "a search is delegated to the service" + (with-fake-routes-in-isolation + {{:address (groups-url "groups") + :query-params {:user "alice" :group_type "team" :search "t" :limit 1000 :offset 0}} + (json-response {:groups [team-group]})} + (is (= ["alice:t1"] (mapv :name (:groups (groups/get-teams "alice" {:search "t"})))))))) + +(deftest get-teams-details-test + (testing "details=true attaches creator info resolved by one bulk subject lookup" + (let [lookups (atom []) + team2 {:id "t2" :group_type "team" :owner "bob" :name "t2"}] + (with-fake-routes-in-isolation + {{:address (groups-url "groups") :query-params {:user "alice" :group_type "team" :limit 1000 :offset 0}} + (json-response {:groups [(assoc team-group :created_at "2026-01-15T10:20:30Z") team2]}) + {:address (groups-url "subjects" "lookup") :query-params {:user "alice"}} + (fn [req] + (swap! lookups conj (json/decode (slurp (:body req)) true)) + ((json-response {:subjects [{:id "alice" :name "Alice Anderson" :source_id "ldap"}]}) nil))} + (let [{:keys [groups]} (groups/get-teams "alice" {:details true}) + [detail1 detail2] (mapv :detail groups)] + (testing "the distinct owners are resolved with a single lookup request" + (is (= [{:subject_ids ["alice" "bob"]}] @lookups))) + (testing "the creator's id and resolved display name land in :detail" + (is (= "alice" (:created_by detail1))) + (is (= "Alice Anderson" (get-in detail1 [:created_by_detail :name]))) + (is (= "ldap" (get-in detail1 [:created_by_detail :source_id])))) + (testing "the creation time is reported in ms since the epoch" + (is (= (.toEpochMilli (java.time.Instant/parse "2026-01-15T10:20:30Z")) + (:created_at detail1)))) + (testing "detail carries only schema-legal keys" + (is (= #{:created_at :created_by :created_by_detail :has_composite :is_composite_factor} + (set (keys detail1)))) + (is (false? (:has_composite detail1))) + (is (false? (:is_composite_factor detail1)))) + (testing "an owner the lookup cannot resolve falls back to the bare id" + (is (= "bob" (:created_by detail2))) + (is (= {:id "bob" :source_id "" :name "bob"} (:created_by_detail detail2)))))))) + (testing "details=false makes no subject lookup and attaches no detail" + ;; Only the listing route is registered: a stray subject lookup fails loudly. + (with-fake-routes-in-isolation + {{:address (groups-url "groups") :query-params {:user "alice" :group_type "team" :limit 1000 :offset 0}} + (json-response {:groups [team-group]})} + (is (not (contains? (first (:groups (groups/get-teams "alice" {:details false}))) :detail)))))) + +(deftest list-groups-pagination-test + (testing "listings page past the service's 1000-group response cap" + ;; The service caps one listing response at 1000 groups, so a single unpaged + ;; request would silently truncate anything past that bound. + (let [page1 (mapv #(assoc team-group :id (str "t" %) :name (str "team" %)) (range 1000))] + (with-fake-routes-in-isolation + {{:address (groups-url "groups") + :query-params {:user "alice" :group_type "team" :limit 1000 :offset 0}} + (json-response {:groups page1}) + {:address (groups-url "groups") + :query-params {:user "alice" :group_type "team" :limit 1000 :offset 1000}} + (json-response {:groups [(assoc team-group :id "t1000" :name "team1000")]})} + (let [{:keys [groups]} (groups/get-teams "alice" {})] + (is (= 1001 (count groups))) + (is (= "alice:team1000" (:name (last groups))))))))) + +(deftest add-team-test + (testing "a public team grants the all-users subject read and returns the owner-scoped name" + (let [captured (atom nil)] + (with-fake-routes-in-isolation + {{:address (groups-url "groups") :query-params {:user "alice"}} + (captured-body captured team-group) + {:address (groups-url "groups" "t1" "permissions" "group" "GrouperAll") :query-params {:user "alice"}} + (json-response {:subject {:subject_id "GrouperAll" :subject_type "group"} :level "read"})} + (let [result (groups/add-team "alice" {:name "t1" :description "d" :public_privileges ["view"]})] + (is (= {:group_type "team" :owner "alice" :name "t1" :display_name "t1" :description "d" + :members_public false :joinable false} + @captured)) + (testing "`view` neither exposes members nor admits anyone" + ;; Grouper refused a self-join on a view-only team; those go through + ;; the join-request flow for an administrator to approve. + (is (false? (:joinable @captured)))) + (testing "`view` makes the team discoverable without exposing its members" + ;; This is the case the DE actually uses for public teams. Marking it + ;; members_public would publish the membership of all 183 of them. + (is (false? (:members_public @captured)))) + (is (= "alice:t1" (:name result))) + (is (= "t1" (:id result))))))) + (testing "a non-public team makes no permission grant" + ;; Only the create route is registered; a permission PUT would fail the isolated routes. + (with-fake-routes-in-isolation + {{:address (groups-url "groups") :query-params {:user "alice"}} + (json-response team-group)} + (is (= "alice:t1" (:name (groups/add-team "alice" {:name "t1" :description "d"}))))))) + +(deftest get-team-test + (with-fake-routes-in-isolation + (team-lookup-route) + (let [result (groups/get-team "alice" "alice:t1")] + (testing "get resolves the team by owner and short name" + (is (= "alice:t1" (:name result))) + (is (= "t1" (:id result))))))) + +(deftest team-name-parsing-test + (testing "a short name containing colons round-trips instead of being mangled" + ;; The old client rebuilt the packed name as `de:teams::` and then split + ;; the result on the first colon, so a colon in the short name moved the boundary. + (let [captured (atom nil) + weird (assoc team-group :name "my:team" :display_name "my:team")] + (with-fake-routes-in-isolation + (merge (team-lookup-route :name "my:team" :group weird) + {{:address (groups-url "groups" "t1") :query-params {:user "alice"}} + (captured-body captured (assoc weird :name "other:name" :display_name "other:name"))}) + (let [result (groups/update-team "alice" "alice:my:team" {:name "other:name"})] + (is (= {:name "other:name" :display_name "other:name"} @captured)) + (is (= "alice:other:name" (:name result))))))) + (testing "a team name with no owner prefix is rejected rather than silently mis-resolved" + (with-fake-routes-in-isolation {} + (is (= ::cx/bad-request (error-type (groups/get-team "alice" "t1"))))))) + +(deftest update-team-test + (let [captured (atom nil)] + (with-fake-routes-in-isolation + (merge (team-lookup-route) + {{:address (groups-url "groups" "t1") :query-params {:user "alice"}} + (captured-body captured (assoc team-group :description "new"))}) + (testing "an update that changes only the description leaves the name alone" + (let [result (groups/update-team "alice" "alice:t1" {:description "new"})] + (is (= {:description "new"} @captured)) + (is (= "alice:t1" (:name result)))))))) + +(deftest verify-team-exists-test + (with-fake-routes-in-isolation + (team-lookup-route) + (is (nil? (groups/verify-team-exists "alice" "alice:t1"))))) + +(deftest delete-team-test + (with-fake-routes-in-isolation + (merge (team-lookup-route) + {{:address (groups-url "groups" "t1") :query-params {:user "alice"}} + {:delete (json-response team-group)}}) + (is (= "t1" (:id (groups/delete-team "alice" "alice:t1")))))) + +(deftest get-team-members-test + (with-fake-routes-in-isolation + (merge (team-lookup-route) + {{:address (groups-url "groups" "t1" "members") :query-params {:user "alice"}} + (json-response {:members [alice]})}) + (is (= ["alice"] (mapv :id (:members (groups/get-team-members "alice" "alice:t1"))))))) + +(deftest add-team-members-test + (let [captured (atom nil)] + (with-fake-routes-in-isolation + (merge (team-lookup-route) + {{:address (groups-url "groups" "t1" "members") :query-params {:user "alice"}} + (captured-body captured {:results [{:subject_id "bob" :success true :source_id "ldap" :subject_name "Bob"}]})}) + (let [{:keys [results]} (groups/add-team-members "alice" "alice:t1" ["bob"])] + (testing "the members are posted under the :members key the service expects" + (is (= {:members ["bob"]} @captured))) + (testing "members are added and results pass through source_id/subject_name" + (is (= {:subject_id "bob" :success true :source_id "ldap" :subject_name "Bob"} (first results)))))))) + +(deftest remove-team-members-test + (with-fake-routes-in-isolation + (merge (team-lookup-route) + {{:address (groups-url "groups" "t1" "members" "deleter") :query-params {:user "alice"}} + (json-response {:results [{:subject_id "bob" :success true :source_id "ldap" :subject_name "Bob"}]})}) + (is (= "bob" (:subject_id (first (:results (groups/remove-team-members "alice" "alice:t1" ["bob"])))))))) + +(deftest join-team-test + (testing "a team that carries optin can be joined directly" + (with-fake-routes-in-isolation + (merge (team-lookup-route :group (assoc team-group :joinable true)) + {{:address (groups-url "groups" "t1" "members") :query-params {:user "de_grouper"}} + (json-response {:results [{:subject_id "alice" :success true :source_id "ldap" :subject_name "Alice"}]})}) + (let [{:keys [results]} (groups/join-team "alice" "alice:t1")] + (testing "the caller is added as a member" + (is (= "alice" (:subject_id (first results)))) + (is (true? (:success (first results)))))))) + + (testing "a public team without optin is refused, as Grouper refused it" + ;; Public teams carry `view` alone. Admitting anyone who can see one would + ;; bypass the join-request flow, where an administrator approves. + (with-fake-routes-in-isolation + (team-lookup-route :group (assoc team-group :joinable false)) + (is (= :clojure-commons.exception/forbidden + (try+ (groups/join-team "alice" "alice:t1") nil + (catch [:type :clojure-commons.exception/forbidden] {:keys [type]} type))))))) + +(deftest leave-team-test + (testing "leaving drops the read grant that membership carried" + ;; The DE granted every member optout+read, so Grouper's leave revoked both. + ;; The importer turns that read into an explicit grant, which removing + ;; membership does not touch -- an ex-member would keep read on the group + ;; and its member list. + (let [calls (atom [])] + (with-fake-routes-in-isolation + (merge (team-lookup-route) + {{:address (groups-url "groups" "t1" "permissions") :query-params {:user "de_grouper"}} + (json-response {:permissions [{:subject {:subject_id "alice" :subject_type "user"} :level "read"}]}) + {:address (groups-url "groups" "t1" "permissions" "user" "alice") + :query-params {:user "de_grouper"}} + (fn [_] (swap! calls conj :revoke) {:status 200 :headers {} :body "{}"}) + {:address (groups-url "groups" "t1" "members" "deleter") :query-params {:user "de_grouper"}} + (fn [_] (swap! calls conj :remove) + ((json-response {:results [{:subject_id "alice" :success true :source_id "ldap" :subject_name "Alice"}]}) nil))}) + (groups/leave-team "alice" "alice:t1") + (is (= [:remove :revoke] @calls) + "membership must go before the read grant, so a failed removal cannot leave a read-revoked member")))) + + (testing "leaving does not strip an admin" + ;; Grouper revoked only the member privileges, so an admin who left kept + ;; administering the group. Revoking whatever level is present would + ;; silently demote owners and admins. + (with-fake-routes-in-isolation + (merge (team-lookup-route) + {{:address (groups-url "groups" "t1" "permissions") :query-params {:user "de_grouper"}} + (json-response {:permissions [{:subject {:subject_id "alice" :subject_type "user"} :level "admin"}]}) + {:address (groups-url "groups" "t1" "members" "deleter") :query-params {:user "de_grouper"}} + (json-response {:results [{:subject_id "alice" :success true :source_id "ldap" :subject_name "Alice"}]})}) + ;; The revoke route is deliberately unregistered: under isolation, calling + ;; it would fail the test. + (is (some? (groups/leave-team "alice" "alice:t1")))))) + +(deftest list-team-privileges-test + (with-fake-routes-in-isolation + (merge (team-lookup-route) + {{:address (groups-url "groups" "t1" "permissions") :query-params {:user "alice"}} + (json-response {:permissions [{:subject {:subject_id "alice" :subject_type "user"} :level "own"} + {:subject {:subject_id "GrouperAll" :subject_type "group"} :level "read"} + {:subject {:subject_id "bob" :subject_type "user"} :level "read"}]}) + {:address (groups-url "subjects" "lookup") :query-params {:user "alice"}} + (json-response {:subjects [{:id "alice" :name "Alice" :source_id "ldap"} + {:id "bob" :name "Bob" :source_id "ldap"}]})}) + (let [privs (:privileges (groups/list-team-privileges "alice" "alice:t1")) + by-subject (into {} (map (juxt (comp :id :subject) identity)) privs)] + (testing "own/admin levels map to admin, write/read to read, and the public subject to view" + (is (= "admin" (:name (get by-subject "alice")))) + (is (= "read" (:name (get by-subject "bob")))) + (is (= "view" (:name (get by-subject "GrouperAll"))))) + (testing "the public subject is surfaced as a group subject" + (is (= "g:gsa" (:source_id (:subject (get by-subject "GrouperAll"))))))))) + +(deftest update-team-privileges-test + (let [granted (atom nil) + revoked (atom nil)] + (with-fake-routes-in-isolation + (merge (team-lookup-route) + {{:address (groups-url "groups" "t1") :query-params {:user "alice"}} + {:put (json-response team-group)} + {:address (groups-url "groups" "t1" "permissions" "user" "bob") :query-params {:user "alice"}} + {:put (fn [req] + (reset! granted (:level (json/decode (slurp (:body req)) true))) + {:status 200 :headers {"Content-Type" "application/json"} :body "{}"})} + {:address (groups-url "groups" "t1" "permissions" "group" "GrouperAll") :query-params {:user "alice"}} + {:delete (fn [_] + (reset! revoked "GrouperAll") + {:status 200 :headers {"Content-Type" "application/json"} :body "{}"})} + {:address (groups-url "groups" "t1" "permissions") :query-params {:user "alice"}} + (json-response {:permissions [{:subject {:subject_id "bob" :subject_type "user"} :level "admin"}]}) + {:address (groups-url "subjects" "lookup") :query-params {:user "alice"}} + (json-response {:subjects [{:id "bob" :name "Bob" :source_id "ldap"}]})}) + (let [result (groups/update-team-privileges + "alice" "alice:t1" + {:updates [{:subject_id "bob" :privileges ["admin"]} + {:subject_id "GrouperAll" :privileges []}]})] + (testing "privilege names are translated to a permission level and granted" + (is (= "admin" @granted))) + (testing "a subject left with no privileges has its permission revoked" + (is (= "GrouperAll" @revoked))) + (is (= "admin" (:name (first (:privileges result))))))))) + +(deftest update-team-public-privileges-test + (doseq [[privileges expected-flags expected-level] + [[[] {:members_public false :joinable false} nil] + [["view"] {:members_public false :joinable false} "read"] + [["read" "optin"] {:members_public true :joinable true} "read"]]] + (let [updated (atom nil) + granted (atom nil)] + (with-fake-routes-in-isolation + (merge (team-lookup-route) + {{:address (groups-url "groups" "t1") :query-params {:user "alice"}} + {:put (captured-body updated team-group)} + {:address (groups-url "groups" "t1" "permissions" "group" "GrouperAll") + :query-params {:user "alice"}} + {:put (fn [req] + (reset! granted (:level (json/decode (slurp (:body req)) true))) + {:status 200 :headers {"Content-Type" "application/json"} :body "{}"}) + :delete (fn [_] {:status 200 :headers {"Content-Type" "application/json"} :body "{}"})} + {:address (groups-url "groups" "t1" "permissions") :query-params {:user "alice"}} + (json-response {:permissions []})}) + (groups/update-team-privileges "alice" "alice:t1" + {:updates [{:subject_id "GrouperAll" :privileges privileges}]}) + (testing (str "public privileges " privileges " rewrite the group's own public flags") + (is (= expected-flags (select-keys @updated [:members_public :joinable])))) + (testing (str "public privileges " privileges " still drive the permission grant") + (is (= expected-level @granted))))))) + +(deftest get-team-admins-test + (with-fake-routes-in-isolation + (merge (team-lookup-route) + {{:address (groups-url "groups" "t1" "permissions") :query-params {:user "alice"}} + (json-response {:permissions [{:subject {:subject_id "alice" :subject_type "user"} :level "own"} + {:subject {:subject_id "GrouperAll" :subject_type "group"} :level "read"} + {:subject {:subject_id "de_grouper" :subject_type "user"} :level "admin"}]}) + {:address (groups-url "subjects" "lookup") :query-params {:user "alice"}} + (json-response {:subjects [{:id "alice" :name "Alice" :email "a@x" :source_id "ldap"}]})}) + (let [{:keys [members]} (groups/get-team-admins "alice" "alice:t1")] + (testing "admins are the own/admin user subjects, excluding the service user and public subject" + (is (= 1 (count members))) + (is (= "alice" (:id (first members)))) + (is (= "a@x" (:email (first members)))))))) + +;; Communities. + +(defn- community-lookup-route [& {:keys [group] :or {group community-group}}] + {{:address (groups-url "groups" "lookup") + :query-params {:user "alice" :group_type "community" :name "biology"}} + (json-response group)}) + +(deftest get-communities-test + (with-fake-routes-in-isolation + {{:address (groups-url "groups") :query-params {:user "alice" :group_type "community" :limit 1000 :offset 0}} + (json-response {:groups [community-group {:id "c2" :group_type "community" :name "physics"}]}) + {:address (groups-url "groups") + :query-params {:user "alice" :group_type "community" :member "alice" :limit 1000 :offset 0}} + (json-response {:groups [community-group]}) + {:address (groups-url "subjects" "alice" "permissions") :query-params {:user "alice"}} + (json-response {:permissions [{:group_id "c1" :level "own"}]})} + (let [{:keys [groups]} (groups/get-communities "alice" {}) + by-name (into {} (map (juxt :name identity)) groups)] + (testing "listing reports per-user membership from one membership query" + (is (= #{"biology" "physics"} (set (keys by-name)))) + (is (true? (:member (get by-name "biology")))) + (is (false? (:member (get by-name "physics"))))) + (testing "privileges come from one permissions query for the whole listing" + (is (= ["admin"] (:privileges (get by-name "biology")))) + (is (= [] (:privileges (get by-name "physics"))))) + (testing "contract group fields are synthesized" + (is (= "group" (:type (get by-name "biology")))))))) + +(deftest get-communities-privilege-levels-test + (doseq [[level expected] {"own" ["admin"] + "admin" ["admin"] + "write" ["read"] + "read" ["read"]}] + (testing (str "a " level " grant is reported as " (first expected)) + (with-fake-routes-in-isolation + {{:address (groups-url "groups") + :query-params {:user "alice" :group_type "community" :limit 1000 :offset 0}} + (json-response {:groups [community-group]}) + {:address (groups-url "groups") + :query-params {:user "alice" :group_type "community" :member "alice" :limit 1000 :offset 0}} + (json-response {:groups []}) + {:address (groups-url "subjects" "alice" "permissions") :query-params {:user "alice"}} + (json-response {:permissions [{:group_id "c1" :level level}]})} + (let [{:keys [groups]} (groups/get-communities "alice" {})] + (is (= expected (:privileges (first groups))))))))) + +(deftest get-communities-for-member-test + (with-fake-routes-in-isolation + {{:address (groups-url "groups") + :query-params {:user "alice" :group_type "community" :member "alice" :limit 1000 :offset 0}} + (json-response {:groups [community-group]}) + {:address (groups-url "subjects" "alice" "permissions") :query-params {:user "alice"}} + (json-response {:permissions []})} + (testing "listing a user's own communities needs no second membership query" + (let [{:keys [groups]} (groups/get-communities "alice" {:member "alice"})] + (is (= ["biology"] (mapv :name groups))) + (is (true? (:member (first groups)))))))) + +(deftest admin-get-communities-test + (with-fake-routes-in-isolation + {{:address (groups-url "groups") + :query-params {:user "de_grouper" :group_type "community" :limit 1000 :offset 0}} + (json-response {:groups [community-group]})} + (let [{:keys [groups]} (groups/admin-get-communities "de_grouper" {})] + (testing "admin listing omits member/privileges" + (is (= ["biology"] (mapv :name groups))) + (is (not (contains? (first groups) :member))))))) + +(deftest add-community-test + (let [captured (atom nil)] + (with-fake-routes-in-isolation + {{:address (groups-url "groups") :query-params {:user "alice"}} + (captured-body captured community-group) + {:address (groups-url "groups" "c1" "permissions" "group" "GrouperAll") :query-params {:user "alice"}} + (json-response {:subject {:subject_id "GrouperAll" :subject_type "group"} :level "read"})} + (let [result (groups/add-community "alice" {:name "biology" :description "d" + :public_privileges ["read" "optin"]})] + (testing "a community is created with no owner, since it belongs to no user namespace" + (is (= {:group_type "community" :name "biology" :display_name "biology" :description "d" + :members_public true :joinable true} + @captured))) + (testing "read among the public privileges makes the member list public" + ;; Grouper gave public communities `read` and public teams `view`; the + ;; permissions service cannot express the difference, so it rides on the + ;; group. Dropping it would expose every public team's membership. + (is (true? (:members_public @captured)))) + (is (= "biology" (:name result))) + (is (= "c1" (:id result))))))) + +(deftest get-community-test + (with-fake-routes-in-isolation + (community-lookup-route) + (is (= "biology" (:name (groups/get-community "alice" "biology")))))) + +(deftest update-community-test + (let [captured (atom nil)] + (with-fake-routes-in-isolation + (merge (community-lookup-route) + {{:address (groups-url "groups" "c1") :query-params {:user "alice"}} + (captured-body captured (assoc community-group :name "bio" :display_name "bio"))}) + (testing "a rename is a single update with no app retagging" + (let [result (groups/update-community "alice" "biology" {:name "bio"})] + (is (= {:name "bio" :display_name "bio"} @captured)) + (is (= "bio" (:name result)))))))) + +(deftest delete-community-test + (with-fake-routes-in-isolation + (merge (community-lookup-route) + {{:address (groups-url "groups" "c1") :query-params {:user "alice"}} + {:delete (json-response community-group)}}) + (is (= "c1" (:id (groups/delete-community "alice" "biology")))))) + +(deftest get-community-members-test + (with-fake-routes-in-isolation + (merge (community-lookup-route) + {{:address (groups-url "groups" "c1" "members") :query-params {:user "alice"}} + (json-response {:members [alice]})}) + (is (= ["alice"] (mapv :id (:members (groups/get-community-members "alice" "biology"))))))) + +(deftest add-community-admins-test + (with-fake-routes-in-isolation + (merge (community-lookup-route) + {{:address (groups-url "groups" "c1" "permissions" "user" "bob") :query-params {:user "alice"}} + (fn [req] + (is (= "admin" (:level (json/decode (slurp (:body req)) true)))) + {:status 200 :headers {"Content-Type" "application/json"} :body "{}"}) + {:address (groups-url "groups" "c1" "members") :query-params {:user "alice"}} + (json-response {:results [{:subject_id "bob" :success true :source_id "ldap" :subject_name "Bob"}]})}) + (let [{:keys [results]} (groups/add-community-admins "alice" "biology" ["bob"])] + (testing "an admin is granted the admin level and added as a member" + (is (= "bob" (:subject_id (first results)))) + (is (true? (:success (first results)))))))) + +(deftest remove-community-admins-test + (with-fake-routes-in-isolation + (merge (community-lookup-route) + {{:address (groups-url "groups" "c1" "permissions" "user" "bob") :query-params {:user "alice"}} + (fn [_] {:status 200 :headers {"Content-Type" "application/json"} :body "{}"}) + {:address (groups-url "groups" "c1" "members" "deleter") :query-params {:user "alice"}} + (json-response {:results [{:subject_id "bob" :success true :source_id "ldap" :subject_name "Bob"}]})}) + (is (= "bob" (:subject_id (first (:results (groups/remove-community-admins "alice" "biology" ["bob"])))))))) + +(deftest get-community-admins-test + (with-fake-routes-in-isolation + (merge (community-lookup-route) + {{:address (groups-url "groups" "c1" "permissions") :query-params {:user "alice"}} + (json-response {:permissions [{:subject {:subject_id "alice" :subject_type "user"} :level "admin"}]}) + {:address (groups-url "subjects" "lookup") :query-params {:user "alice"}} + (json-response {:subjects [{:id "alice" :name "Alice" :source_id "ldap"}]})}) + (is (= ["alice"] (mapv :id (:members (groups/get-community-admins "alice" "biology"))))))) + +(deftest join-community-test + (testing "a community that carries optin can be joined directly" + ;; Communities carried read+optin in Grouper, so this matches the old behavior. + (with-fake-routes-in-isolation + (merge (community-lookup-route :group (assoc community-group :joinable true)) + {{:address (groups-url "groups" "c1" "members") :query-params {:user "de_grouper"}} + (json-response {:results [{:subject_id "alice" :success true :source_id "ldap" :subject_name "Alice"}]})}) + (let [{:keys [results]} (groups/join-community "alice" "biology")] + (testing "the caller is added as a member" + (is (= "alice" (:subject_id (first results)))))))) + + (testing "a community without optin is refused" + (with-fake-routes-in-isolation + (community-lookup-route :group (assoc community-group :joinable false)) + (is (= :clojure-commons.exception/forbidden + (try+ (groups/join-community "alice" "biology") nil + (catch [:type :clojure-commons.exception/forbidden] {:keys [type]} type))))))) + +(deftest leave-community-test + (let [calls (atom [])] + (with-fake-routes-in-isolation + (merge (community-lookup-route) + {{:address (groups-url "groups" "c1" "permissions") :query-params {:user "de_grouper"}} + (json-response {:permissions [{:subject {:subject_id "alice" :subject_type "user"} :level "read"}]}) + {:address (groups-url "groups" "c1" "permissions" "user" "alice") :query-params {:user "de_grouper"}} + (fn [_] (swap! calls conj :revoke) {:status 200 :headers {} :body "{}"}) + {:address (groups-url "groups" "c1" "members" "deleter") :query-params {:user "de_grouper"}} + (fn [_] (swap! calls conj :remove) + ((json-response {:results [{:subject_id "alice" :success true :source_id "ldap" :subject_name "Alice"}]}) nil))}) + (is (= "alice" (:subject_id (first (:results (groups/leave-community "alice" "biology")))))) + (testing "membership is removed before the read grant is revoked" + (is (= [:remove :revoke] @calls)))))) + +;; DE user group administration. + +(deftest remove-de-user-test + (with-fake-routes-in-isolation + {{:address (groups-url "groups" "lookup") + :query-params {:user "de_grouper" :group_type "system" :name "de-users"}} + (json-response {:id "du1" :group_type "system" :name "de-users"}) + {:address (groups-url "groups" "du1" "members" "bob") :query-params {:user "de_grouper"}} + (fn [_] {:status 200 :headers {"Content-Type" "application/json"} :body "{}"})} + (testing "removing a DE user deletes their membership in the de-users system group" + (is (nil? (groups/remove-de-user "bob")))))) + +(deftest admin-user-guard-test + (testing "the administrative account may not be added to or removed from a group" + ;; It is filtered out of every listing, so admitting it creates a member the + ;; UI can neither show nor remove. The legacy client rejected this with a 400. + (with-fake-routes-in-isolation + (team-lookup-route) + (doseq [[label f] [["add-team-members" #(groups/add-team-members "alice" "alice:t1" ["de_grouper"])] + ["remove-team-members" #(groups/remove-team-members "alice" "alice:t1" ["de_grouper"])] + ["add-community-admins" #(groups/add-community-admins "alice" "biology" ["bob" "de_grouper"])] + ["remove-community-admins" #(groups/remove-community-admins "alice" "biology" ["de_grouper"])]]] + (is (= :clojure-commons.exception/bad-request + (try+ (f) nil (catch [:type :clojure-commons.exception/bad-request] {:keys [type]} type))) + (str label " must reject the administrative account")))))) + +(deftest join-leave-admin-guard-test + (testing "the administrative account may not join or leave anything" + ;; Join and leave act as the administrative account, whose service-side permission + ;; bypass means nothing downstream stops it. The guard must fire before any HTTP + ;; call: no routes are registered, so a stray request fails loudly under isolation. + (with-fake-routes-in-isolation {} + (let [admin (config/groups-admin-user)] + (doseq [[label f] [["join-team" #(groups/join-team admin "alice:t1")] + ["leave-team" #(groups/leave-team admin "alice:t1")] + ["join-community" #(groups/join-community admin "biology")] + ["leave-community" #(groups/leave-community admin "biology")]]] + (is (= :clojure-commons.exception/bad-request (error-type (f))) + (str label " must reject the administrative account"))))))) diff --git a/test/terrain/util/config_test.clj b/test/terrain/util/config_test.clj new file mode 100644 index 00000000..eb5056c4 --- /dev/null +++ b/test/terrain/util/config_test.clj @@ -0,0 +1,13 @@ +(ns terrain.util.config-test + (:require [clojure.test :refer [deftest is testing]] + [terrain.util.config :as config])) + +(deftest valid-groups-backend-test + (doseq [[backend expected] [["iplant-groups" true] + ["groups" true] + ["Groups" false] + ["groups " false] + ["" false] + [nil false]]] + (testing (str "the backend selector " (pr-str backend) " is recognized: " expected) + (is (= expected (config/valid-groups-backend? backend))))))