api model interface (unfinished) #3 + get<Class> return changes

EducationShinyAppTeam · Oct 28, 2019 · 5b8fc16 · 5b8fc16
1 parent c1660fe
commit 5b8fc16
Show file tree

Hide file tree

Showing 14 changed files with 172 additions and 99 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -25,6 +25,8 @@ export(getInteractionComponent)
 export(getInteractionComponents)
 export(getInteractionType)
 export(getInteractionTypes)
+export(getInterface)
+export(getInterfaceList)
 export(getModel)
 export(getModelList)
 export(getObjectDefinition)
@@ -41,16 +43,8 @@ export(retrieve)
 export(store)
 export(test)
 export(validateObject)
-import("for")
-import(API)
-import(Learning)
-import(Locker)
-import(Sets)
 import(htmltools)
 import(httr)
-import(needed)
-import(scripts)
 import(shiny)
-import(up)
 importFrom(jsonlite,toJSON)
 importFrom(uuid,UUIDgenerate)
diff --git a/R/activity.R b/R/activity.R
@@ -13,9 +13,9 @@ getActivityType <- function(name, asJSON = FALSE) {
   exists <- exists(name, activityTypes)
 
   if (exists & asJSON) {
-    return(formatJSON(activityTypes[name]))
+    return(formatJSON(activityTypes[[name]]))
   } else if (exists) {
-    return(activityTypes[name])
+    return(activityTypes[[name]])
   } else {
     return(-1)
   }

diff --git a/R/config.R b/R/config.R
@@ -0,0 +1,18 @@
+#'config
+#'
+#' @name config
+NULL
+
+set_locker_config <- function(config){
+  httr::set_config(
+    add_headers(
+      Authorization = config$auth
+    )
+  )
+
+  invisible(options(locker_config = config))
+}
+
+get_locker_config <- function(){
+  return(getOption("locker_config"))
+}
diff --git a/R/connect.R b/R/connect.R
@@ -1,6 +1,9 @@
-#' connect
+#'connect
+#'
+#' @name connect
 #' 
 #' @import htmltools httr
+NULL
 
 #' Sets up scripts needed for Learning Locker API
 #' 
@@ -21,11 +24,7 @@ connect <- function(session, config) {
     session = getDefaultReactiveDomain()
   )
 
-  set_config(
-    add_headers(
-      Authorization = config$auth
-    )
-  )
+  set_locker_config(config)
 
   # Pass locker configuration to begin connection
   session$sendCustomMessage("rlocker-setup", config)
@@ -51,7 +50,7 @@ test <- function(cfg) {
     tryCatch({
 
       response <- with_config(config(), GET(
-        paste0(cfg$base_url, "api/connection/statement"),
+        httr::modify_url(cfg$base_url, "api/connection/statement"),
       ))
 
       status <- status_code(response)
@@ -73,74 +72,3 @@ test <- function(cfg) {
 
   return(status)
 }
-
-#' Makes a simple HTTP GET request to Learning Locker API endpoint
-#' Uses HTTP Connection Interface
-#' @seealso \link{https://docs.learninglocker.net/http-statements/}
-#' 
-#' ### ### ### ### ### ### ### ### ### THESE NEED TO BE UPDATED ### ### ### ### ### ### ### ### ###
-#' Should this be renamed to retrieve as we're only making get requests? api_retrieve rlocker::retrieve
-#' api/connection should be added to the base request automatically, we're not supporting REST at this time
-#' base_url + "api/connection" + request_type + query
-#' create new functions for connection details set_locker_config() / get_locker_config() (there's a collision with set_config in httr)
-#' 
-#' @param session The current R session
-#' @param request API request string
-#' @param asJSON (optional) Return content as json string
-#' 
-#' @return response content
-#' 
-#' @export
-retrieve <- function(model, interface = "connection", query, asJSON = FALSE){
-
-  # @todo if interface == connection, query belongs as html encoded + json encoded ?queryString
-  #       else query belongs after the model
-  # @todo create a method to return available model names
-  request <- paste(get_locker_config()$base_url, "api", interface, model, query, sep = "/")
-
-  response <- with_config(config(), GET(request))
-
-  status <- response$status
-
-  content <- httr::content(response)
-
-  #' @details https://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html
-  if (status != 200) {
-    message(
-      paste(status, 
-        stringr::str_squish(
-          stringr::str_trim(gsub("<.*?>|\n", " ", content(response, as = "text")), side = "both")
-        )
-      )
-    )
-
-    content <- NA
-  } else {
-    if(asJSON){
-      content <- formatJSON(content)
-    }
-  }
-
-  return(content)
-}
-
-#' Stores an xAPI Statement
-#' 
-#' @param statement xAPI Statement
-#' @param warn Show warnings
-#' 
-#' @seealso \code{\link{createStatement}}
-#' 
-#' @return HTTP Status
-#' 
-#' @export
-store <- function(session, statement = NULL, warn = FALSE, ...) {
-  # Pass the statement to the js handler
-  session$sendCustomMessage("rlocker-store", statement)
-
-  # HTTP Status Code
-  status_code <- ifelse(!is.null(session$input$storageStatus), session$input$storageStatus, 502)
-
-  # Return HTTP_STATUS
-  return(status_code)
-}
diff --git a/R/object.R b/R/object.R
@@ -131,9 +131,9 @@ getInteractionType <- function(name, asJSON = FALSE) {
   exists <- exists(name, interactionTypes)
 
   if(exists & asJSON) {
-    return(formatJSON(interactionTypes[name]))
+    return(formatJSON(interactionTypes[[name]]))
   } else if(exists) {
-    return(interactionTypes[name])
+    return(interactionTypes[[name]])
   } else {
     return(-1)
   }
@@ -144,9 +144,14 @@ getInteractionComponent <- function(name, asJSON = FALSE){
   exists <- exists(name, components)
 
   if(exists & asJSON) {
-    return(formatJSON(components[name]))
+    return(formatJSON(components[[name]]))
   } else if(exists) {
-    return(components[name])
+    return(
+      structure(
+        components[[name]],
+        class = "component"
+      )
+    )
   } else {
     return(-1)
   }
@@ -164,7 +169,7 @@ getSupportedComponents <- function(interactionType) {
   if(is.na(exists)){
     return(NA)
   } else {
-    return(getInteractionType(interactionType)[[1]]$components)
+    return(getInteractionType(interactionType)$components)
   }
 }
 

diff --git a/R/request.R b/R/request.R
@@ -0,0 +1,90 @@
+#'request
+#'
+#' @name request
+NULL
+
+#' Makes a simple HTTP GET request to Learning Locker API endpoint
+#' Uses HTTP Connection Interface
+#' @seealso \link{https://docs.learninglocker.net/http-statements/}
+#' 
+#' ### ### ### ### ### ### ### ### ### THESE NEED TO BE UPDATED ### ### ### ### ### ### ### ### ###
+#' Should this be renamed to retrieve as we're only making get requests? api_retrieve rlocker::retrieve
+#' api/connection should be added to the base request automatically, we're not supporting REST at this time
+#' base_url + "api/connection" + request_type + query
+#' create new functions for connection details set_locker_config() / get_locker_config() (there's a collision with set_config in httr)
+#' 
+#' @param session The current R session
+#' @param request API request string
+#' @param asJSON (optional) Return content as json string
+#' 
+#' @return response content
+#' 
+#' @export
+retrieve <- function(model = NULL, interface = "connection", query, asJSON = FALSE){
+
+  # @todo if interface == connection, query belongs as html encoded + json encoded ?queryString
+  #       else query belongs after the model
+
+  tryCatch({
+    if(is.null(model) || getModel(model) == -1){
+      stop("Unable to process request; api model not specified or is invalid.")
+    }
+
+    config <- get_locker_config()
+
+    interface <- getInterface(interface)
+
+    request <- modify_url(
+      config$base_url,
+      path = paste(interface$route, model, sep = "/"),
+      query = query
+    )
+
+    response <- with_config(config(), GET(request))
+
+    status <- response$status
+
+    content <- httr::content(response)
+
+    #' @details https://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html
+    if (status != 200) {
+      message(
+        paste(status, 
+              stringr::str_squish(
+                stringr::str_trim(gsub("<.*?>|\n", " ", content(response, as = "text")), side = "both")
+              )
+        )
+      )
+
+      content <- NA
+    } else {
+      if(asJSON){
+        content <- formatJSON(content)
+      }
+    }
+
+    return(content)
+
+  })
+}
+
+#' Stores an xAPI Statement
+#' 
+#' @param statement xAPI Statement
+#' @param warn Show warnings
+#' 
+#' @seealso \code{\link{createStatement}}
+#' 
+#' @return HTTP Status
+#' 
+#' @export
+store <- function(session, statement = NULL, warn = FALSE, ...) {
+  # Pass the statement to the js handler
+  session$sendCustomMessage("rlocker-store", statement)
+
+  # HTTP Status Code
+  status_code <- ifelse(!is.null(session$input$storageStatus), session$input$storageStatus, 502)
+
+  # Return HTTP_STATUS
+  return(status_code)
+}
diff --git a/R/verb.R b/R/verb.R
@@ -52,9 +52,14 @@ getVerb <- function(name, asJSON = FALSE) {
   exists <- exists(name, verbs)
 
   if (exists & asJSON) {
-    return(formatJSON(verbs[name]))
+    return(formatJSON(verbs[[name]]))
   } else if(exists) {
-    return(verbs[name])
+    return(
+      structure(
+        verbs[[name]],
+        class = "verb"
+      )
+    )
   } else {
     return(-1)
   }

diff --git a/inst/examples/app.R b/inst/examples/app.R
@@ -35,7 +35,7 @@ shinyApp(
     # Initialize Learning Locker connection
     connection <- rlocker::connect(session, config)
 
-    response <- rlocker::api_request(paste0(config$base_url, "api/connection/statement?first=1"), asJSON = TRUE)
+    response <- rlocker::retrieve("api/connection/statement?first=1", asJSON = TRUE)
 
     print(response)
 

diff --git a/man/config.Rd b/man/config.Rd
diff --git a/man/connect.Rd b/man/connect.Rd
diff --git a/man/getInterfaceList.Rd b/man/getInterfaceList.Rd
diff --git a/man/request.Rd b/man/request.Rd
diff --git a/man/retrieve.Rd b/man/retrieve.Rd
diff --git a/man/store.Rd b/man/store.Rd