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