R/user.R

In palmargisla/datahub-r: Gets data from Datahub.is

#' Login for DataHub
#'
#' If the login is successful, all API requests will include authentication header.
#'
#' @param email Email address for your account
#' @param password Account password
#'
#' @return Message stating if the login was successful
#'
#' @examples
#' login("datahub@datahub.is", "My3xtra s3cur3P455w0rd")
#'
#' @export
login <- function(email = NULL, password = NULL) {

  if (!is.null(getOption("authentication_key", default = NULL))) {
    if (user_status()) {
      print("Login skipped, already logged in.")
      return()
    }
  }

  if (is.null(email) || is.null(password)) {
    email = rstudioapi::showPrompt(
      title = "Netfang fyrir innskráningu", message = "Netfang", default = ""
    )
    password = rstudioapi::askForPassword("Lykilorð")
  }

  # Create url
  url <- paste0(
    getOption("base_path", default = "https://api.datahub.is"),
    "/user/login")

  # Make API call and parse
  resp <- httr::POST(
    url,
    httr::add_headers("Authorization" = getOption("authentication_key", default = "")),
    httr::accept_json(),
    body = list(email = email, password = password),
    encode = "json")

  parsed <- jsonlite::fromJSON(httr::content(resp, "text", encoding = "UTF-8"))

  #* Stop if errors
  if (httr::http_error(resp)) {
    stop(
      sprintf(
        "DataHub API request failed [%s]\n%s\n<%s>",
        httr::status_code(resp),
        parsed$status,
        parsed$message
      ),
      call. = FALSE
    )
  }

  options(
    authentication_key=parsed$token,
    authentication_set=Sys.time())

  print(parsed$message)
}


#' Reauthenticate
#'
#' This function should not be for others to use
#'
#' @return
#'
#' @examples
reauthenticate <- function() {
}


#' Reauthenticate
#'
#' This function should not be for others to use
#'
#' @return
#'
#' @examples
user_status <- function() {
  # Create url
  url <- paste0(
    getOption("base_path", default = "https://api.datahub.is"),
    "/user/status")

  # Make API call and parse
  resp <- httr::GET(
    url,
    httr::add_headers("Authorization" = getOption("authentication_key", default = "")),
    httr::accept_json(),
    encode = "json")

  parsed <- jsonlite::fromJSON(httr::content(resp, "text", encoding = "UTF-8"))

  #* Stop if errors
  if (httr::http_error(resp)) {
    return(FALSE)
  }
  return(TRUE)

}


#' Title
#'
#' @return
#' @export
#'
#' @examples
fetch_twitter_signature <- function() {

  # Create url
  url <- paste0(
    getOption("base_path", default = "https://api.datahub.is"),
    "/user/signature/twitter")

  # Make API call and parse
  resp <- httr::GET(
    url,
    httr::add_headers(
      "Authorization" = getOption("authentication_key", default = "")),
    httr::accept("image/png"))

  if (httr::status_code(resp) == 401) {
    stop(
      sprintf(
        "DataHub API request failed, unauthorized. Use login(email, password) to update credentials."
      ),
      call. = FALSE
    )
  }

  png::readPNG(httr::content(resp, "raw"))
}


#' Title
#'
#' @return
#' @export
#'
#' @examples
fetch_linkedin_signature <- function() {

  # Create url
  url <- paste0(
    getOption("base_path", default = "https://api.datahub.is"),
    "/user/signature/linkedin")

  # Make API call and parse
  resp <- httr::GET(
    url,
    httr::add_headers(
      "Authorization" = getOption("authentication_key", default = "")),
    httr::accept("image/png"))

  if (httr::status_code(resp) == 401) {
    stop(
      sprintf(
        "DataHub API request failed, unauthorized. Use login(email, password) to update credentials."
      ),
      call. = FALSE
    )
  }

  png::readPNG(httr::content(resp, "raw"))
}

#' Title
#'
#' @param gg
#' @param footer_fill
#' @param hjust
#' @param footer_hight_pct
#'
#' @return
#' @export
#'
#' @examples
sign_chart <- function(gg, signature_side = 'right', signature = 'twitter', color = "#ffffff", height = 0.025, inherits_color = TRUE) {

  collection <- checkmate::makeAssertCollection()
  checkmate::matchArg(signature_side, c('left', 'right'))
  checkmate::matchArg(signature, c('twitter', 'linkedin'))
  checkmate::assert_number(height, lower = 0, upper = 1)
  checkmate::assert_string(color, pattern = "^#[a-fA-F0-9]{6}$")
  checkmate::reportAssertions(collection)

  if (signature == 'twitter')
    signature_png <- fetch_twitter_signature()
  else
    signature_png <- fetch_linkedin_signature()

  if (inherits_color) {
    if (!is.null(gg$theme$rect$fill))
      color = gg$theme$rect$fill
    if (!is.null(gg$theme$plot.background$fill))
      color = gg$theme$plot.background$fill
  }

  hjust = 1
  if (signature_side == 'left')
    hjust = 0

  footer = grid::grobTree(
    grid::rectGrob(gp=grid::gpar(fill=color, col=color, lwd=0)),
    grid::rasterGrob(signature_png, hjust=hjust, x=grid::unit(hjust, 'npc')))

  gridExtra::grid.arrange(
    gg, footer,
    heights=grid::unit(c(1-height, height),
    c('npc', 'npc')))
}