Merge pull request #35 from coderaanalytics/frg

Switch from session to token access to backend

DESCRIPTION

@@ -1,12 +1,12 @@
 Package: econdatar
 Title: Automation of Data Tasks to and from Codera Analytics' Econometric Data Services
-Version: 3.0.2
+Version: 3.1.0
 Date: 2024-04-24
 Authors@R: c(person("Byron", "Botha", role = c("aut", "cre"), email = "[email protected]"),
              person("Sebastian", "Krantz", role = "ctb"))
 Description: Automation of data tasks to and from <https://codera.co.za> econometric data services. Using this package users can download data from <https://www.econdata.co.za> directly into R (in tidy format) after signing up for a free account. <https://www.econdata.co.za> hosts a comprehensive database of South African macroeconomic data.
 Depends: R (>= 4.2.0)
-Imports: httr, jsonlite, readODS, collapse, data.table
+Imports: httr, jose, jsonlite, readODS, collapse, data.table
 Suggests: tcltk
 URL: https://www.econdata.co.za/
 BugReports: https://github.com/coderaanalytics/econdatar/issues

NAMESPACE

@@ -2,8 +2,9 @@ importFrom("collapse", "add_vars<-", "ckmatch", "dapply", "fmutate", "fnobs",
            "frename", "get_vars<-", "qDT", "qF", "ss", "unlist2d", "vlabels",
            "vlabels<-")
 importFrom("data.table", "dcast", "rbindlist", "setcolorder")
-importFrom("httr", "POST", "GET", "PUT", "accept", "accept_json", "authenticate",
-           "content", "content_type", "cookies", "set_cookies", "upload_file")
+importFrom("httr", "POST", "GET", "PUT", "accept", "add_headers", "accept_json",
+           "authenticate", "content", "content_type", "upload_file")
+importFrom("jose", "jwt_split")
 importFrom("jsonlite", "fromJSON", "toJSON", "unbox")
 importFrom("readODS", "write_ods", "read_ods")
 importFrom("stats", "na.omit")

R/econdata_credentials.R

@@ -3,39 +3,30 @@ econdata_credentials <- function() {
     stop("Package \"tcltk\" needed for this function to work.",
          call. = FALSE)
   }
-  user <- pswd <- NULL # Need to add global bindings for variables
-  username   <- tcltk::tclVar(Sys.info()["user"])
-  password   <- tcltk::tclVar("")
+  tkn <- NULL # Need to add global bindings for variables
+  token   <- tcltk::tclVar("")
 
   tt <- tcltk::tktoplevel()
-  tcltk::tkwm.title(tt, "www.econdata.co.za credentials")
-  user.entry <- tcltk::tkentry(tt, textvariable = username)
-  pswd.entry <- tcltk::tkentry(tt, textvariable = password, show = "*")
+  tcltk::tkwm.title(tt, "econdata.co.za credentials")
+  tkn.entry <- tcltk::tkentry(tt, textvariable = token)
 
-  reset <- function() {
-    tcltk::tclvalue(username)   <- Sys.info()["user"]
-    tcltk::tclvalue(password)   <- ""
-  }
+  reset <- function() tcltk::tclvalue(token) <- ""
   reset.but <- tcltk::tkbutton(tt, text = "Reset", command = reset)
 
   submit <- function() {
-    user <- tcltk::tclvalue(username)
-    pswd <- tcltk::tclvalue(password)
+    tkn <- tcltk::tclvalue(token)
     e <- parent.env(environment())
-    e$user <- user
-    e$pswd <- pswd
+    e$tkn <- tkn
     tcltk::tkdestroy(tt)
   }
-  submit.but <- tcltk::tkbutton(tt, text = "submit", command = submit)
+  submit.but <- tcltk::tkbutton(tt, text = "Submit", command = submit)
 
-  tcltk::tkgrid(tcltk::tklabel(tt, text = "Enter User Details"),
+  tcltk::tkgrid(tcltk::tklabel(tt, text = "Enter Token Details"),
                 columnspan = 2)
-  tcltk::tkgrid(tcltk::tklabel(tt, text = "Username"),
-                user.entry, pady = 10, padx = 10)
-  tcltk::tkgrid(tcltk::tklabel(tt, text = "Password"),
-                pswd.entry, pady = 10, padx = 10)
+  tcltk::tkgrid(tcltk::tklabel(tt, text = "API Token"),
+                tkn.entry, pady = 10, padx = 10)
   tcltk::tkgrid(submit.but, reset.but, pady = 10, padx = 50)
 
   tcltk::tkwait.window(tt)
-  return(c(user, pswd))
+  return(tkn)
 }

R/get_metadata.R

@@ -1,11 +1,5 @@
-get_metadata <- function(x, ...) {
-  params <- list(...)
-  if (!is.null(params$portal)) {
-    portal <- params$portal
-  } else {
-    portal <- "econdata"
-  }
-  env <- fromJSON(system.file("settings.json", package = "econdatar"))[[portal]]
+get_metadata <- function(x) {
+  env <- fromJSON(system.file("settings.json", package = "econdatar"))
 
 
   # Fetch data structure definition (metadata) ----
@@ -19,8 +13,8 @@ get_metadata <- function(x, ...) {
                   path = paste(c(env$registry$path,
                                  "provisionagreements",
                                  provision_agreement_ref), collapse = "/"),
-                  set_cookies(.cookies =
-                                get("econdata_session", envir = .pkgenv)),
+                  add_headers(authorization = get("econdata_token",
+                                                  envir = .pkgenv)),
                   accept("application/vnd.sdmx-codera.data+json"))
   if (response$status_code != 200) {
     stop(content(response, type = "application/json", encoding = "UTF-8"))
@@ -38,8 +32,8 @@ get_metadata <- function(x, ...) {
                   path = paste(c(env$registry$path,
                                  "dataflows",
                                  dataflow_ref), collapse = "/"),
-                  set_cookies(.cookies =
-                                get("econdata_session", envir = .pkgenv)),
+                  add_headers(authorization = get("econdata_token",
+                                                  envir = .pkgenv)),
                   accept("application/vnd.sdmx-codera.data+json"))
   if (response$status_code != 200) {
     stop(content(response, type = "application/json", encoding = "UTF-8"))
@@ -57,8 +51,8 @@ get_metadata <- function(x, ...) {
                                  "datastructures",
                                  data_structure_ref), collapse = "/"),
                   query = list(relations = "references"),
-                  set_cookies(.cookies =
-                                get("econdata_session", envir = .pkgenv)),
+                  add_headers(authorization = get("econdata_token",
+                                                  envir = .pkgenv)),
                   accept("application/vnd.sdmx-codera.data+json"))
   if (response$status_code != 200) {
     stop(content(response, type = "application/json", encoding = "UTF-8"))

R/login_helper.R

@@ -1,27 +1,20 @@
 .pkgenv <- new.env(parent = emptyenv())
 
-login_helper <- function(credentials, login_url) {
-  if (!is.null(credentials)) {
-    creds <- unlist(strsplit(credentials, ";"))
-  } else if (Sys.getenv("ECONDATA_CREDENTIALS") != "") {
+login_helper <- function(auth) {
+  if (Sys.getenv("ECONDATA_CREDENTIALS") != "") {
     creds <- unlist(strsplit(Sys.getenv("ECONDATA_CREDENTIALS"), ";"))
+    response <- POST(auth$url,
+                     path = auth$path,
+                     body = list(grant_type = "client_credentials",
+                                 client_id = creds[1],
+                                 client_secret = creds[2]),
+                     encode = "form",
+                     accept_json())
+    if (response$status_code != 200)
+      stop(content(response))
+    token <- content(response)$access_token
   } else {
-    creds <- econdata_credentials()
+    token <- econdata_credentials()
   }
-
-  response <- POST(login_url,
-                   path = "/signin",
-                   body = list(username = creds[1],
-                               password = creds[2]),
-                   encode = "form")
-
-  if (response$status_code != 200)
-    stop(content(response, encoding = "UTF-8"))
-
-  cookie_jar <- cookies(response)
-  domain <- substr(login_url, 9, nchar(login_url))
-  session <- cookie_jar[which(cookie_jar[, 1] == paste0("#HttpOnly_", domain) &
-                                cookie_jar[, 6] == "ring-session"), ]
-  assign("econdata_session", as.character(session), envir = .pkgenv)
-  lockBinding("econdata_session", .pkgenv)
+  assign("econdata_token", paste("Bearer", token), envir = .pkgenv)
 }

R/read_database.R

@@ -4,11 +4,6 @@ read_database <- function(id, include_series = FALSE, tidy = FALSE, ...) {
   # Parameters ----
 
   params <- list(...)
-  if (!is.null(params$username) && !is.null(params$password)) {
-    credentials <- paste(params$username, params$password, sep = ";")
-  } else {
-    credentials <- NULL
-  }
   if (!is.null(params$agencyid)) {
     agencyid  <- params$agencyid
   } else {
@@ -19,12 +14,7 @@ read_database <- function(id, include_series = FALSE, tidy = FALSE, ...) {
   } else {
     version <- "latest"
   }
-  if (!is.null(params$portal)) {
-    portal <- params$portal
-  } else {
-    portal <- "econdata"
-  }
-  env <- fromJSON(system.file("settings.json", package = "econdatar"))[[portal]]
+  env <- fromJSON(system.file("settings.json", package = "econdatar"))
 
 
   # Fetch data set(s) ----
@@ -34,8 +24,16 @@ read_database <- function(id, include_series = FALSE, tidy = FALSE, ...) {
     data_message <- fromJSON(params$file, simplifyVector = FALSE)
     message("Data set(s) successfully retrieved from local storage.\n")
   } else {
-    if (!exists("econdata_session", envir = .pkgenv)) {
-      login_helper(credentials, env$repository$url)
+    if (is.null(params$file)) {
+      if (exists("econdata_token", envir = .pkgenv)) {
+        token <- unlist(strsplit(get("econdata_token", envir = .pkgenv), " "))[2]
+        payload <- jwt_split(token)$payload
+        if (Sys.time() > as.POSIXct(payload$exp, origin="1970-01-01")) {
+          login_helper(env$auth)
+        }
+      } else {
+        login_helper(env$auth)
+      }
     }
     query_params <- list()
     query_params$agencyids <- paste(agencyid, collapse = ",")
@@ -44,15 +42,13 @@ read_database <- function(id, include_series = FALSE, tidy = FALSE, ...) {
     response <- GET(env$repository$url,
                     path = c(env$repository$path, "/datasets"),
                     query = query_params,
-                    set_cookies(.cookies = get("econdata_session",
-                                               envir = .pkgenv)),
+                    add_headers(authorization = get("econdata_token",
+                                                    envir = .pkgenv)),
                     accept("application/vnd.sdmx-codera.data+json"))
     if (response$status_code != 200) {
-      stop(content(response, encoding = "UTF-8"))
+      stop(content(response, type = "application/json"))
     }
-    data_message <- content(response,
-                            type = "application/json",
-                            encoding = "UTF-8")
+    data_message <- content(response, type = "application/json")
   }
 
 
@@ -77,17 +73,15 @@ read_database <- function(id, include_series = FALSE, tidy = FALSE, ...) {
                                      data_set_ref,
                                      "series", sep = "/"),
                         query = query_params,
-                        set_cookies(.cookies =
-                                      get("econdata_session", envir = .pkgenv)),
+                        add_headers(authorization = get("econdata_token",
+                                                        envir = .pkgenv)),
                         accept("application/vnd.sdmx-codera.data+json"))
         if (response$status_code == 200) {
           message("Processing data set: ", data_set_ref, "\n")
         } else {
-          stop(content(response, type = "application/json", encoding = "UTF-8"))
+          stop(content(response, type = "application/json"))
         }
-        data_message <- content(response,
-                                type = "application/json",
-                                encoding = "UTF-8")
+        data_message <- content(response, type = "application/json")
         tmp_data_set <- data_message[[2]][["data-sets"]][[1]][[2]]
       } else {
         tmp_data_set <- raw_data_set[[2]]