R/visitssummary.R

#' Get visits summary from 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 accessToken  API Authentication Token - you can get this in your
#' matomo interface under Settings -> Personal -> Settings -> API Authentication Token
#' @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)
#' and pass it here, or you can make it persistent with \code{\link{persistAccessToken}}.
#' @return data frame
#'
#' @import httr
#' @importFrom jsonlite fromJSON
#' @importFrom dplyr mutate rowwise bind_rows select summarise n
#' @import tibble
#' @importFrom magrittr %>%
#' @importFrom utils head tail
#'
#' @examples
#' \dontrun{
#' df <- getVisitsSummary("https://demo.matomo.org/", siteId=3, period="day", date="last60")
#' plot(df$nb_actions ~ df$date, type="b")
#' }
#'
#' @export
getVisitsSummary <- function(matomoUrl,
                            siteId,
                            period = "month",
                            date = "last16",
                            filter_limit = 100,
                            removeFirst = FALSE,
                            removeLast = FALSE,
                            accessToken = getAccessToken(matomoUrl)

) {
  if (is.null(accessToken) && matomoUrl != "https://demo.matomo.org/") {
    stop(
      paste0(
        "You mast set an access token with persistAccessToken(\"",
        matomoUrl,
        "\", token) first. Get the token in your matomo interface under Settings -> Personal -> Settings -> API Authentication Token."
      ),
      call. = FALSE
    )
  }

  httr::GET(
    url = matomoUrl,
    query = list(
      module = "API",
      method = "API.getBulkRequest",
      format = "json",
      "urls[0]" = "method=VisitsSummary.get",
      idSite = paste0(siteId, collapse = ","),
      date = date,
      period = period,
      filter_limit = filter_limit,
      token_auth = accessToken
    )
  ) -> res

  if (status_code(res) != 200) {
    if (json && !http_type(res) %in% c("application/json", "application/ld+json")) {
      stop("API did not return json", call. = FALSE)
    }
    result <- jsonlite::fromJSON(content(res, "text", encoding = "UTF-8"))
    if (!is.null(result$warnings)) {
      message <- if (nrow(result$warnings) > 1)
        sapply(result$warnings, function(warning) paste(sprintf("%s: %s", warning[1], warning[2]), sep="\n"))
      else
        sprintf("%s: %s", result$warnings[1], result$warnings[2])
      warning(message, call. = FALSE)
    }
  }

  if (!http_type(res) %in% c("application/json", "application/ld+json")) {
    stop("API did not return json", call. = FALSE)
  }

  json <- httr::content(res, "text", encoding = "UTF-8")
  l <- jsonlite::fromJSON(json, simplifyVector = F)

  if (!is.null(l[[1]]$result) && l[[1]]$result == "error") {
    stop(l[[1]]$message, call. = FALSE)
  }

  (if (length(siteId) == 1) {
    bind_rows(l[[1]], .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]][[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[[1]])) {
      df <- bind_rows(df,
                      bind_rows(l[[1]][[i]], .id=period) %>%
                      head(if(removeLast) -1 else filter_limit) %>%
                      tail(if(removeFirst) -1 else filter_limit) %>%
                      mutate(site_id=siteId[i]))
    }
    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)
    ))
}

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
}