R/matomoquery.R

#' Get reports from a matomo API server
#'
#' See matomo Reporting API Reference (\url{https://developer.matomo.org/api-reference/reporting-api}) for details.
#'
#' @references \url{https://developer.matomo.org/api-reference/reporting-api}
#'
#' @param matomoUrl    base URL of your matomo instance
#' @param siteId       matomo site id or vector of site ids
#' @param period       \code{day}, \code{week}, \code{month} or \code{year}
#' @param date         date range (see \url{https://developer.matomo.org/api-reference/reporting-api})
#' @param filter_limit defines the maximum number of rows to be returned
#' @param removeFirst  logical that determines whether the first row of each site should be removed (to account for incomplete periods)
#' @param removeLast   logical that determines whether the last row of each site should be removed (to account for incomplete periods)
#' @param accessToken  API Authentication Token - you can get this in your
#' matomo interface under Settings -> Personal -> Settings -> API Authentication Token
#' and pass it here, or you can make it persistent with \code{\link{persistAccessToken}}.
#' @param getMethod    API method to call – default: VisitsSummary.get
#' @return Data frame with visits summary as returned by matomo. Note that the \code{date} column in the returned data frame refers to the first day of the respective period.
#'
#' @importFrom httr2 request req_url_query req_perform resp_body_json resp_body_raw req_error
#' @importFrom jsonlite fromJSON
#' @importFrom dplyr mutate rowwise bind_rows select summarise n
#' @import tibble
#' @importFrom magrittr %>%
#' @importFrom stringr str_replace str_replace_all
#' @importFrom utils head tail
#'
#' @examples
#' \dontrun{
#' df <- matomoQuery("https://demo.matomo.org/", getMethod = "UserCountry.getCountry")
#' }
#'
#' @export
matomoQuery <- function(matomoUrl,
                             siteId,
                             period = "month",
                             date = "last16",
                             filter_limit = 500,
                             removeFirst = FALSE,
                             removeLast = FALSE,
                             accessToken = getAccessToken(matomoUrl),
                             getMethod = "VisitsSummary.get"
) {
  if ((is.null(accessToken) || accessToken == '' ) && matomoUrl != "https://demo.matomo.org/") {
    stop(
      paste0(
        "You must first set an access token with:\n\npersistAccessToken(\"",
        matomoUrl,
        "\", <token>)\n\nYou can get the token in your matomo interface under Settings -> Personal -> Security -> Auth token\nprobably at:\n\n", matomoUrl, "index.php?module=UsersManager&action=userSecurity\n\n"
      ),
      call. = FALSE
    )
  }
  res <- httr2::request(matomoUrl) %>%
    httr2::req_url_query(
      module = "API",
      method = getMethod,
      format = "json",
      idSite = paste0(siteId, collapse = ","),
      date = str_replace_all(date, " *UTC", ""),
      period = period,
      filter_limit = filter_limit,
      language = "de",
      token_auth = accessToken
    ) %>%
    httr2::req_error(body = error_body) %>%
    httr2::req_perform()

  l <-res %>% httr2::resp_body_json()

  if("result" %in% names(l) && l[["result"]] == 'error') {
    stop(paste("In api call", res$url, ":", l[["message"]], "\n"), call. = FALSE)
  }

  if (period=="range") {
    df <- if (is.list(l) && length(l) == 0) {
      stop(paste0("API call ",  res$url, " returned the empty list [].\n"), call. = FALSE)
    } else if (is.list(l)) {
      df <- bind_rows(l)
    } else if (length(siteId) == 1) {
      l %>%  mutate(site_id=siteId)
    } else {
      bind_rows(l, .id = "site_id")
    }
  } else {
    df <- (if (length(siteId) == 1) {
      bind_rows(l, .id=period) %>%
        head(if(removeLast) -1 else filter_limit) %>%
        tail(if(removeFirst) -1 else filter_limit) %>%
        mutate(site_id=siteId)
    } else {
      df <- bind_rows(l[[1]], .id=period) %>%
        head(if(removeLast) -1 else filter_limit) %>%
        tail(if(removeFirst) -1 else filter_limit) %>%
        mutate(site_id=siteId[1])
      for (i in 2:length(l)) {
        df <- bind_rows(df,
                        bind_rows(l[[i]], .id=period) %>%
                          head(if(removeLast) -1 else filter_limit) %>%
                          tail(if(removeFirst) -1 else filter_limit) %>%
                          mutate(site_id=siteId[i]))
      }
      df
    })
  }

  if("day" %in% colnames(df) | "month" %in% colnames(df) | "ye" %in% colnames(df)) {
    df <- df %>%
      mutate(date = as.Date(
        if (period == "month")
          paste0(month, "-01")
        else if (period == "year")
          paste0(year, "-01-01")
        else if (period == "week")
          sub(",.*", "", week)
        else if (period == "day")
          day
        else
          stop(paste0("unsupported period parameter: '", period, "'"), call. = FALSE)
      , optional = TRUE))
  }
  return(df)
}


error_body <- function(resp) {
  return(paste0("getting ", resp$url))
}

utils::globalVariables(c("year", "month", "day", "week"))

#' Save access token persistently to your keyring
#'
#' @param matomoUrl   base URL of your matomo instance
#' @param accessToken your oauth token
#' @param id          supply if you have multiple IDs, i.e. logins to your matomo instance
#'
#' @import keyring
#'
#' @export
#'
#' @examples
#' persistAccessToken("https://demo.matomo.org/", "ad7609a669179c4ebca7c995342f7e09")
#'
persistAccessToken <- function(matomoUrl, accessToken, id="default") {
  if (is.null(accessToken))
    stop("It seems that you have not supplied any access token that could be persisted.", call. = FALSE)

  keyring::key_set_with_value(matomoUrl, username=id, password=accessToken, keyring = NULL)
}

clearAccessToken <- function(matomoUrl, id="default") {
  key_delete(matomoUrl, id)
}


#' get access token for matomo from keyring
#'
#' @param matomoUrl   base URL of your matomo instance
#' @param id          supply if you have multiple IDs, i.e. logins to your matomo instance
#'
#' @return access token
#' @export
#'
#' @import keyring
#'
getAccessToken <- function(matomoUrl, id="default") {
  keyList <- tryCatch(withCallingHandlers(key_list(service = matomoUrl),
                                          warning = function(w) invokeRestart("muffleWarning"),
                                          error = function(e) return(NULL)),
                      error = function(e) { })
  if (id %in% keyList)
    key_get(matomoUrl, id)
  else
    NULL
}