-
Notifications
You must be signed in to change notification settings - Fork 2
/
core.clj
362 lines (279 loc) · 14.7 KB
/
core.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
(ns cyverse-groups-client.core
(:use [medley.core :only [remove-vals]])
(:require [cemerick.url :as curl]
[clj-http.client :as http]
[clojure.string :as string]))
(def public-user "GrouperAll")
(defprotocol Client
"A client library for the CyVerse Groups API."
(get-status [_]
"Retrieves information about the status of the CyVerse Groups service.")
(find-folders [_ user search]
"Searches for folders by name.")
(add-folder [_ user name description] [_ user name description display-extension]
"Creates a new folder.")
(delete-folder [_ user name]
"Deletes an existing folder.")
(get-folder [_ user name]
"Retrieves information about a folder.")
(update-folder [_ user name updates]
"Updates an existing folder. To make calls to this function as clean as possible, the updates are passed in as
a map containing three possible elements: `:name`, `:description`, `:display_extension`.")
(list-folder-privileges [_ user name]
"Lists folder privileges.")
(revoke-folder-privilege [_ user name subject privilege]
"Revokes folder privileges from a subject.")
(grant-folder-privilege [_ user name subject privilege]
"Grants folder privileges to a subject.")
(find-groups [_ user search] [_ user search folder]
"Searches for groups by name.")
(add-group [_ user name type description]
"Creates a new group.")
(delete-group [_ user name]
"Deletes an existing group.")
(get-group [_ user name]
"Retrieves information about a group.")
(update-group [_ user name updates]
"Updates an existing group.")
(list-group-privileges [_ user name] [_ user name params]
"Lists group privileges.")
(update-group-privileges [_ user name updates] [_ user name updates params]
"Sets group privileges for multiple subjects. The updates argument is in the same format as the request body
for the endpoint. Please see the README.md file for more details.")
(revoke-group-privileges [_ user name updates]
"Revokes group privileges for multiple subjects. The updates argument is in the same format as the request body
for the endpoint. Please see the README.md file for more details.")
(revoke-group-privilege [_ user name subject privilege]
"Revokes group privileges from a subject.")
(grant-group-privilege [_ user name subject privilege]
"Grants group privileges to a subject.")
(list-group-members-by-id [_ user group-id] [_ user group-id params]
"Lists the members of the group with the given identifier.")
(list-group-members [_ user name] [_ user name params]
"Lists group members.")
(replace-group-members [_ user name subjects]
"Removes all existing members from a group and adds new members.")
(add-group-members [_ user name subjects]
"Adds multiple members to a group.")
(remove-group-members [_ user name subjects]
"Removes multiple members from a group.")
(remove-group-member [_ user name subject]
"Removes a member from a group.")
(add-group-member [_ user name subject]
"Adds a member to a group.")
(find-subjects [_ user search]
"Finds subjects by name.")
(lookup-subjects [_ user subjects]
"Looks up one or more subjects by ID.")
(get-subject [_ user subject]
"Retrieves information about a subject.")
(list-subject-groups [_ user subject] [_ user subject params]
"Lists groups that a subject belongs to.")
(list-subject-privileges [_ user subject] [_ user subject params]
"Lists privileges that have been granted to a subject.")
(get-folder-name-prefix [_]
"Returns the folder name prefix for the environment.")
(build-folder-name [_ partial-name]
"Adds the folder name prefix to the partial folder name given in the argument list."))
(def ^:private valid-folder-privileges
{:stem "Allows users to create subfolders."
:create "Allows users to create a group in a folder."
:stemAttrUpdate "Allows users to assign attributes to a folder."
:stemAttrRead "Allows users to read a folder's attributes."})
(defn- invalid-privilege-msg [type valid-privileges privilege]
(->> (concat [(str "Invalid " type " privilege: " (name privilege) "\n")
(str "Valid " type " privileges:")]
(mapv (fn [[k v]] (str "\t" (name k) " - " v)) valid-privileges))
(string/join "\n")))
(defn- validate-privilege [type valid-privileges privilege]
(when-not (contains? valid-privileges (keyword privilege))
(throw (IllegalArgumentException. (invalid-privilege-msg type valid-privileges privilege)))))
(def ^:private validate-folder-privilege (partial validate-privilege "folder" valid-folder-privileges))
(defn- build-url [base-url & path-elements]
(let [preprocess-path-element (fn [e] (if (keyword? e) (name e) e))]
(str (apply curl/url base-url (mapv (comp curl/url-encode preprocess-path-element) path-elements)))))
(defn- folder-name-prefix [environment-name]
(format "iplant:de:%s" environment-name))
(deftype CyverseGroupsClient [base-url environment-name]
Client
(get-status [_]
(:body (http/get base-url {:as :json})))
(find-folders [_ user search]
(:body (http/get (build-url base-url "folders")
{:query-params {:user user :search search}
:as :json})))
(add-folder [self user name description]
(add-folder self user name description nil))
(add-folder [_ user name description display-extension]
(:body (http/post (build-url base-url "folders")
{:query-params {:user user}
:form-params (remove-vals nil? {:name name
:description description
:display_extension display-extension})
:content-type :json
:as :json})))
(delete-folder [_ user name]
(:body (http/delete (build-url base-url "folders" name)
{:query-params {:user user}
:as :json})))
(get-folder [_ user name]
(:body (http/get (build-url base-url "folders" name)
{:query-params {:user user}
:as :json})))
(update-folder [_ user name updates]
(:body (http/put (build-url base-url "folders" name)
{:query-params {:user user}
:form-params (remove-vals nil? (select-keys updates [:name :description :display_extension]))
:content-type :json
:as :json})))
(list-folder-privileges [_ user name]
(:body (http/get (build-url base-url "folders" name "privileges")
{:query-params {:user user}
:as :json})))
(revoke-folder-privilege [_ user folder-name subject privilege]
(validate-folder-privilege privilege)
(:body (http/delete (build-url base-url "folders" folder-name "privileges" subject privilege)
{:query-params {:user user}
:as :json})))
(grant-folder-privilege [_ user folder-name subject privilege]
(validate-folder-privilege privilege)
(:body (http/put (build-url base-url "folders" folder-name "privileges" subject privilege)
{:query-params {:user user}
:as :json})))
(find-groups [self user search]
(find-groups self user search nil))
(find-groups [_ user search folder]
(:body (http/get (build-url base-url "groups")
{:query-params (remove-vals nil? {:user user
:search search
:folder folder})
:as :json})))
(add-group [_ user name type description]
(:body (http/post (build-url base-url "groups")
{:query-params {:user user}
:form-params (remove-vals nil? {:name name
:type type
:description description})
:content-type :json
:as :json})))
(delete-group [_ user name]
(:body (http/delete (build-url base-url "groups" name)
{:query-params {:user user}
:as :json})))
(get-group [_ user name]
(:body (http/get (build-url base-url "groups" name)
{:query-params {:user user}
:as :json})))
(update-group [_ user name updates]
(:body (http/put (build-url base-url "groups" name)
{:query-params {:user user}
:form-params (remove-vals nil? (select-keys updates [:name :description :display_extension]))
:content-type :json
:as :json})))
(list-group-privileges [self user name]
(list-group-privileges self user name {}))
(list-group-privileges [_ user name params]
(let [accepted-params [:privilege :subject-id :subject-source-id :inheritance-level]]
(:body (http/get (build-url base-url "groups" name "privileges")
{:query-params (merge {:user user} (select-keys params accepted-params))
:as :json}))))
(update-group-privileges [this user name updates]
(update-group-privileges this user name updates {}))
(update-group-privileges [_ user name updates params]
(:body (http/post (build-url base-url "groups" name "privileges")
{:query-params (assoc params :user user)
:form-params updates
:content-type :json
:as :json})))
(revoke-group-privileges [_ user name updates]
(:body (http/post (build-url base-url "groups" name "privileges" "deleter")
{:query-params {:user user}
:form-params updates
:content-type :json
:as :json})))
(revoke-group-privilege [_ user name subject privilege]
(:body (http/delete (build-url base-url "groups" name "privileges" subject privilege)
{:query-params {:user user}
:as :json})))
(grant-group-privilege [_ user name subject privilege]
(:body (http/put (build-url base-url "groups" name "privileges" subject privilege)
{:query-params {:user user}
:as :json})))
(list-group-members-by-id [self user group-id]
(list-group-members-by-id self user group-id {}))
(list-group-members-by-id [_ user group-id params]
(let [accepted-params [:member-filter]]
(:body (http/get (build-url base-url "groups" "id" group-id "members")
{:query-params (merge {:user user}
(remove-vals nil? (select-keys params accepted-params)))
:as :json}))))
(list-group-members [self user name]
(list-group-members self user name {}))
(list-group-members [_ user name params]
(let [accepted-params [:member-filter]]
(:body (http/get (build-url base-url "groups" name "members")
{:query-params (merge {:user user}
(remove-vals nil? (select-keys params accepted-params)))
:as :json}))))
(replace-group-members [_ user name subjects]
(:body (http/put (build-url base-url "groups" name "members")
{:query-params {:user user}
:form-params {:members subjects}
:content-type :json
:as :json})))
(add-group-members [_ user name subjects]
(:body (http/post (build-url base-url "groups" name "members")
{:query-params {:user user}
:form-params {:members subjects}
:content-type :json
:as :json})))
(remove-group-members [_ user name subjects]
(:body (http/post (build-url base-url "groups" name "members" "deleter")
{:query-params {:user user}
:form-params {:members subjects}
:content-type :json
:as :json})))
(remove-group-member [_ user name subject]
(:body (http/delete (build-url base-url "groups" name "members" subject)
{:query-params {:user user}
:as :json})))
(add-group-member [_ user name subject]
(:body (http/put (build-url base-url "groups" name "members" subject)
{:query-params {:user user}
:as :json})))
(find-subjects [_ user search]
(:body (http/get (build-url base-url "subjects")
{:query-params {:user user :search search}
:as :json})))
(lookup-subjects [_ user subjects]
(:body (http/post (build-url base-url "subjects" "lookup")
{:query-params {:user user}
:form-params {:subject_ids subjects}
:content-type :json
:as :json})))
(get-subject [_ user subject]
(:body (http/get (build-url base-url "subjects" subject)
{:query-params {:user user}
:as :json})))
(list-subject-groups [_ user subject]
(:body (http/get (build-url base-url "subjects" subject "groups")
{:query-params {:user user}
:as :json})))
(list-subject-groups [_ user subject folder]
(:body (http/get (build-url base-url "subjects" subject "groups")
{:query-params {:user user :folder folder}
:as :json})))
(list-subject-privileges [self user subject]
(list-subject-privileges self user subject {}))
(list-subject-privileges [self user subject params]
(let [accepted-params [:inheritance-level :entity-type :folder]]
(:body (http/get (build-url base-url "subjects" subject "privileges")
{:query-params (merge {:user user}
(remove-vals nil? (select-keys params accepted-params)))
:as :json}))))
(get-folder-name-prefix [_]
(folder-name-prefix environment-name))
(build-folder-name [_ partial-name]
(format "%s:%s" (folder-name-prefix environment-name) partial-name)))
(defn new-cyverse-groups-client [base-url environment-name]
(CyverseGroupsClient. base-url environment-name))