1
2# return a list of functions that can be used to interact with lucid
3lucidClient <- function(service, authInfo) {
4  service <- parseHttpUrl(service)
5
6  list(
7
8    status = function() {
9      handleResponse(GET(service, authInfo,  "/internal/status"))
10    },
11
12    currentUser = function() {
13      handleResponse(GET(service, authInfo, "/users/current/"))
14    },
15
16    accountsForUser = function(userId) {
17      path <- "/accounts/"
18      query <- ""
19      listRequest(service, authInfo, path, query, "accounts")
20    },
21
22    getAccountUsage = function(accountId, usageType='hours', applicationId=NULL,
23                               from=NULL, until=NULL, interval=NULL) {
24      path <- paste("/accounts/", accountId, "/usage/", usageType, "/", sep="")
25      query <- list()
26      if (!is.null(applicationId))
27        query$application=applicationId
28      if (!is.null(from))
29        query$from = from
30      if (is.null(until))
31        query$until = until
32      if (is.null(interval))
33        query$interval = interval
34      handleResponse(GET(service, authInfo, path, queryString(query)))
35    },
36
37    getBundle = function(bundleId){
38      path <- paste("/bundles/", bundleId, sep="")
39      handleResponse(GET(service, authInfo, path))
40    },
41
42    updateBundleStatus = function(bundleId, status) {
43      path <- paste("/bundles/", bundleId, "/status", sep="")
44      json <- list()
45      json$status = status
46      handleResponse(POST_JSON(service, authInfo, path, json))
47    },
48
49    createBundle = function(application, content_type, content_length, checksum) {
50      json <- list()
51      json$application = application
52      json$content_type = content_type
53      json$content_length = content_length
54      json$checksum = checksum
55      handleResponse(POST_JSON(service, authInfo, "/bundles", json))
56    },
57
58   listApplications = function(accountId, filters = list()) {
59      path <- "/applications/"
60      query <- paste(filterQuery(
61        c("account_id", names(filters)),
62        c(accountId, unname(filters))
63      ), collapse = "&")
64      listRequest(service, authInfo, path, query, "applications")
65    },
66
67    getApplication = function(applicationId) {
68      path <- paste("/applications/", applicationId, sep="")
69      handleResponse(GET(service, authInfo, path))
70    },
71
72    getApplicationMetrics = function(applicationId, series, metrics, from=NULL, until=NULL, interval=NULL) {
73      path <- paste("/applications/", applicationId, "/metrics/", series, "/", sep="")
74      query <- list()
75      m <- paste(lapply(metrics, function(x){paste("metric", urlEncode(x), sep="=")}), collapse = "&")
76      if (!is.null(from))
77        query$from = from
78      if (is.null(until))
79        query$until = until
80      if (is.null(interval))
81        query$interval = interval
82      handleResponse(GET(service, authInfo, path, paste(m, queryString(query), sep="&")))
83    },
84
85    getLogs = function(applicationId, entries = 50, streaming = FALSE,
86                       writer = NULL) {
87      path <- paste("/applications/", applicationId, "/logs", sep="")
88      query <- paste("count=", entries,
89                     "&tail=", if (streaming) "1" else "0", sep="")
90      handleResponse(GET(service, authInfo, path, query, writer = writer))
91    },
92
93    createApplication = function(name, title, template, accountId) {
94      json <- list()
95      json$name <- name
96      # the title field is only used on connect
97      json$template <- template
98      json$account <- as.numeric(accountId)
99      handleResponse(POST_JSON(service, authInfo, "/applications/", json))
100    },
101
102    listApplicationProperties = function(applicationId) {
103      path <- paste("/applications/", applicationId, "/properties/", sep="")
104      handleResponse(GET(service, authInfo, path))
105    },
106
107    setApplicationProperty = function(applicationId, propertyName,
108                                      propertyValue, force=FALSE) {
109      path <- paste("/applications/", applicationId, "/properties/",
110                    propertyName, sep="")
111      v <- list()
112      v$value <- propertyValue
113      query <- paste("force=", if (force) "1" else "0", sep="")
114      handleResponse(PUT_JSON(service, authInfo, path, v, query))
115    },
116
117    unsetApplicationProperty = function(applicationId, propertyName,
118                                        force=FALSE) {
119      path <- paste("/applications/", applicationId, "/properties/",
120                    propertyName, sep="")
121      query <- paste("force=", if (force) "1" else "0", sep="")
122      handleResponse(DELETE(service, authInfo, path, query))
123    },
124
125    uploadApplication = function(applicationId, bundlePath) {
126      path <- paste("/applications/", applicationId, "/upload", sep="")
127      handleResponse(POST(service,
128                          authInfo,
129                          path,
130                          contentType="application/x-gzip",
131                          file=bundlePath))
132    },
133
134    deployApplication = function(applicationId, bundleId=NULL) {
135      path <- paste("/applications/", applicationId, "/deploy", sep="")
136      json <- list()
137      json$bundle <- as.numeric(bundleId)
138      handleResponse(POST_JSON(service, authInfo, path, json))
139    },
140
141    terminateApplication = function(applicationId) {
142      path <- paste("/applications/", applicationId, "/terminate", sep="")
143      handleResponse(POST_JSON(service, authInfo, path, list()))
144    },
145
146    inviteApplicationUser = function(applicationId, email,
147                                     invite_email=NULL, invite_email_message=NULL) {
148      path <- paste("/applications/", applicationId, "/authorization/users",
149                    sep="")
150      json <- list()
151      json$email <- email
152      if (!is.null(invite_email))
153        json$invite_email=invite_email
154      if (!is.null(invite_email_message))
155        json$invite_email_message=invite_email_message
156      handleResponse(POST_JSON(service, authInfo, path, json))
157    },
158
159    addApplicationUser = function(applicationId, userId) {
160      path <- paste("/applications/", applicationId, "/authorization/users/",
161                    userId, sep="")
162      handleResponse(PUT(service, authInfo, path, NULL))
163    },
164
165    removeApplicationUser = function(applicationId, userId) {
166      path <- paste("/applications/", applicationId, "/authorization/users/",
167                    userId, sep="")
168      handleResponse(DELETE(service, authInfo, path, NULL))
169    },
170
171    listApplicationAuthoization = function(applicationId) {
172      path <- paste("/applications/", applicationId, "/authorization",
173                    sep="")
174      listRequest(service, authInfo, path, NULL, "authorization")
175    },
176
177    listApplicationUsers = function(applicationId) {
178      path <- paste("/applications/", applicationId, "/authorization/users",
179                    sep="")
180      listRequest(service, authInfo, path, NULL, "users")
181    },
182
183    listApplicationGroups = function(applicationId) {
184      path <- paste("/applications/", applicationId, "/authorization/groups",
185                    sep="")
186      listRequest(service, authInfo, path, NULL, "groups")
187    },
188
189    listApplicationInvitations = function(applicationId) {
190      path <- "/invitations/"
191      query <- paste(filterQuery("app_id", applicationId), collapse="&")
192      listRequest(service, authInfo, path, query, "invitations")
193    },
194
195    listTasks = function(accountId, filters = NULL) {
196      if (is.null(filters)) {
197        filters <- vector()
198      }
199      path <- "/tasks/"
200      filters <- c(filterQuery("account_id", accountId), filters)
201      query <- paste(filters, collapse="&")
202      listRequest(service, authInfo, path, query, "tasks", max=100)
203    },
204
205    getTaskInfo = function(taskId) {
206      path <- paste("/tasks/", taskId, sep="")
207      handleResponse(GET(service, authInfo, path))
208    },
209
210    getTaskLogs = function(taskId) {
211      path <- paste("/tasks/", taskId, "/logs/", sep="")
212      handleResponse(GET(service, authInfo, path))
213    },
214
215    waitForTask = function(taskId, quiet = FALSE) {
216
217      if (!quiet) {
218        cat("Waiting for task: ", taskId, "\n", sep="")
219      }
220
221      path <- paste("/tasks/", taskId, sep="")
222
223      lastStatus <- NULL
224      while(TRUE) {
225
226        # check status
227        status <- handleResponse(GET(service, authInfo, path))
228
229        # display status to the user if it changed
230        if (!identical(lastStatus, status$description)) {
231          if (!quiet)
232            cat("  ", status$status, ": ", status$description, "\n", sep="")
233          lastStatus <- status$description
234        }
235
236        # are we finished? (note: this codepath is the only way to exit this function)
237        if (status$finished) {
238          if (identical(status$status, "success")) {
239            return (NULL)
240          } else {
241            # always show task log on error
242            hr("Begin Task Log")
243            taskLog(taskId, authInfo$name, authInfo$server, output="stderr")
244            hr("End Task Log")
245            stop(status$error, call. = FALSE)
246          }
247        }
248
249        # wait for 1 second before polling again
250        Sys.sleep(1)
251      }
252    }
253  )
254}
255
256listRequest = function(service, authInfo, path, query, listName, page = 100,
257                       max=NULL) {
258
259  # accumulate multiple pages of results
260  offset <- 0
261  results <- list()
262
263  while(TRUE) {
264
265    # add query params
266    queryWithList <- paste(query, "&count=", page, "&offset=", offset, sep="")
267
268    # make request and append the results
269    response <- handleResponse(GET(service, authInfo, path, queryWithList))
270    results <- append(results, response[[listName]])
271
272    # update the offset
273    offset <- offset + response$count
274
275    # get all results if no max was specified
276    if (is.null(max)) {
277      max = response$total
278    }
279
280    # exit if we've got them all
281    if (length(results) >= response$total || length(results) >= max)
282      break
283  }
284
285  return(results)
286}
287
288filterQuery <- function(param, value, operator = NULL) {
289  if (is.null(operator)) {
290    op <- ":"
291  } else {
292    op <- paste(":", operator, ":", sep="")
293  }
294  q <- paste("filter=", param, op, value, sep="")
295  return(q)
296}
297
298isContentType <- function(response, contentType) {
299  grepl(contentType, response$contentType, fixed = TRUE)
300}
301
302uploadBundle <- function(bundle, bundleSize, bundlePath){
303
304  presigned_service <- parseHttpUrl(bundle$presigned_url)
305
306  headers <- list()
307  headers$`Content-Type` <-  'application/x-tar'
308  headers$`Content-Length` <-  bundleSize
309
310  # AWS requires a base64 encoded hash
311  headers$`Content-MD5` <-  bundle$presigned_checksum
312
313  # AWS seems very sensitive to additional headers (likely becauseit was not included and signed
314  # for when the presigned link was created). So the lower level library is used here.
315  http <- httpFunction()
316  response <- http(
317    presigned_service$protocol,
318    presigned_service$host,
319    presigned_service$port,
320    "PUT",
321    presigned_service$path,
322    headers,
323    headers$`Content-Type`,
324    bundlePath
325  )
326
327  response$status == 200
328}
329