even more clean up - fixed all tests and added new endpoints

Author: dmpe

CONTRIBUTE.md

@@ -1,12 +1,13 @@
 ## How ?
 
 - Fork the repository
-- Create and switch to a new branch `git checkout -b [name_of_your_new_branch]`
+- Create and switch to a new branch `git switch -c [name_of_your_new_branch]`
 - Do the changes (i.e. edit files)
 - Push remote branch to your github `git remote add -t [name_of_your_remote]` & `git push -u [name_of_your_remote] [name_of_your_new_branch]`
-- Create a new pull request (to my `master` branch)
+- Create a new pull request to my `master` branch
 
 Want a direct push access? No problem, just let me know and become a :family:.
 
 **Also**:
- - Please note that this project is released with a [Contributor Code of Conduct](CONDUCT.md). By participating in this project you agree to abide by its terms.
+
+Please note that this project is released with a [Contributor Code of Conduct](CONDUCT.md). By participating in this project you agree to abide by its terms.

DESCRIPTION

@@ -5,7 +5,7 @@ Title: R Wrapper for the 'Bit.ly' and 'Is.gd'/'v.gd' URL Shortening
 Description: Allows using two URL shortening services, which also provide
     expanding and analytic functions. Specifically developed for 'Bit.ly' (which requires OAuth 2.0) and 'is.gd' (no API key).
 Version: 2.0.0
-Date: 2025-04-10
+Date: 2025-04-13
 Authors@R: 
    c(
     person("John", "Malc", email = "cincenko@outlook.com", role = c("aut", "cre"),  comment = "@dmpe"),
@@ -19,7 +19,7 @@ Imports: httr2 (>= 1.1.2), jsonlite (>= 2.0.0), stringr (>= 1.5.1),
         clipr (>= 0.8.0), miniUI (>= 0.1.1.1), cli (>= 3.6.4)
 Suggests: roxygen2 (>= 7.3.2), knitr (>= 1.50), testthat (>= 3.2.3),
         rmarkdown (>= 2.29), httpuv (>= 1.6.15), stringi (>= 1.8.7),
-        covr (>= 3.6.4), lintr (>= 3.2.0)
+        covr (>= 3.6.4), lintr (>= 3.2.0), dotenv (>= 1.0.3)
 VignetteBuilder: knitr
 License: Apache License 2.0
 URL: https://github.com/dmpe/urlshorteneR

NAMESPACE

@@ -27,6 +27,7 @@ export(bitly_retrieve_group_click_metrics_by_cities)
 export(bitly_retrieve_group_click_metrics_by_countries)
 export(bitly_retrieve_group_click_metrics_by_devices)
 export(bitly_retrieve_group_click_metrics_by_ref_networks)
+export(bitly_retrieve_group_feature_usage)
 export(bitly_retrieve_group_pref)
 export(bitly_retrieve_group_shorten_counts)
 export(bitly_retrieve_groups)
@@ -51,8 +52,6 @@ export(bitly_update_group_pref)
 export(bitly_update_user)
 export(bitly_user_info)
 export(bitly_user_metrics_referring_domains)
-export(clipExpanderAddin)
-export(clipShortenerAddin)
 export(is_bitly_user_premium_holder)
 export(isgd_LinksExpand)
 export(isgd_LinksShorten)

NEWS

@@ -3,7 +3,9 @@ see: https://github.com/dmpe/urlshorteneR
 
 ###
 April 2025     - Major rewrite of the package, using `httr2` as REST backend.
-               - Add Bearer token authentication
+               - Remove oAUTH authentication and replaced it with Bearer token authentication.
+               - Removed RStudio Addins functionality to shorten and expand bit.ly links.
+               - Add few additional endpoints.
 
 February 2025  - Upgrade package dependancies 
 

R/ApiKey.R

@@ -1,17 +1,16 @@
 # Bitly_api_version <- "v4"
 # Isgd_api_version <- "v2019"
-.urlshorteneREnv <- new.env(parent = emptyenv())
 
 #' @noRd
 #' @keywords internal
 processResponse <- function(resp) {
   if (resp_is_error(resp) == TRUE) {
-    cat("you are not a premium account holder, or internet connection does not work properly")
+    cat("Either you are not a premium account holder and thus cannot execute the request, or internet connection does not work properly.")
+    cat("The requested URL has been this: ", resp$request$url, "\n")
+    message(sprintf("Code: %s - %s", json_response$message, json_response$description))
   } else {
     text_response <- resp |> resp_body_string()
     json_response <- jsonlite::fromJSON(text_response)
-    message(sprintf("Code: %s - %s", json_response$message, json_response$description))
-    cat("The requested URL has been this: ", resp$request$url, "\n")
   }
   return(json_response)
 }
@@ -34,16 +33,6 @@ processResponse <- function(resp) {
 doNoAuthRequest <- function(verb = "", url = NULL, queryParameters = NULL, patch_body = NULL, showURL = NULL) {
   req <- httr2::request(url)
   switch(verb,
-    "PATCH" = {
-      resp <- req |>
-        req_url_query(!!!queryParameters) |>
-        req_method("PATCH") |>
-        req_body_json(list(patch_body)) |>
-        req_headers(
-          Accept = "application/json"
-        ) |>
-        req_perform()
-    },
     "GET" = {
       resp <- req |>
         req_url_query(!!!queryParameters) |>
@@ -61,9 +50,7 @@ doNoAuthRequest <- function(verb = "", url = NULL, queryParameters = NULL, patch
     }
   )
 
-  json_response <- processResponse(resp)
-
-  return(json_response)
+  return(processResponse(resp))
 }
 
 
@@ -85,33 +72,36 @@ doNoAuthRequest <- function(verb = "", url = NULL, queryParameters = NULL, patch
 doBearerTokenRequest <- function(verb = "", url = NULL, access_token = NULL, queryParameters = NULL, patch_body = NULL, showURL = NULL) {
   req <- httr2::request(url)
   resp <- NULL
-  if (verb == "PATCH") {
-    resp <- req |>
-      req_url_query(!!!queryParameters) |>
-      req_method("PATCH") |>
-      req_body_json(list(patch_body)) |>
-      req_auth_bearer_token(access_token) |>
-      req_headers(
-        Accept = "application/json"
-      ) |>
-      req_perform()
-  } else if (verb == "GET") {
-    resp <- req |>
-      req_url_query(!!!queryParameters) |>
-      req_method("GET") |>
-      req_auth_bearer_token(access_token) |>
-      req_perform()
-  } else if (verb == "POST") {
-    resp <- req |>
-      req_method("POST") |>
-      req_body_json(queryParameters) |>
-      req_auth_bearer_token(access_token) |>
-      req_verbose() |>
-      req_headers(
-        Accept = "application/json",
-        "Content-Type" = "application/json"
-      ) |>
-      req_perform()
-  }
+  switch(verb,
+    "PATCH" = {
+      resp <- req |>
+        req_method("PATCH") |>
+        req_body_json(patch_body) |>
+        req_auth_bearer_token(access_token) |>
+        req_headers(
+          Accept = "application/json",
+          "Content-Type" = "application/json"
+        ) |>
+        req_perform()
+    },
+    "GET" = {
+      resp <- req |>
+        req_url_query(!!!queryParameters) |>
+        req_method("GET") |>
+        req_auth_bearer_token(access_token) |>
+        req_perform()
+    },
+    "POST" = {
+      resp <- req |>
+        req_method("POST") |>
+        req_body_json(queryParameters) |>
+        req_auth_bearer_token(access_token) |>
+        req_headers(
+          Accept = "application/json",
+          "Content-Type" = "application/json"
+        ) |>
+        req_perform()
+      }
+  )
   return(processResponse(resp))
 }

R/addins.R

@@ -18,6 +18,7 @@ shortenerAddin <- function() {
         width = "100%"
       ),
       shiny::uiOutput("bitly_domain"),
+      shiny::uiOutput("bitly_token"),
       shiny::actionButton("shorten", label = "Shorten"),
       shiny::actionButton("expand", label = "Expand")
     )
@@ -43,6 +44,20 @@ shortenerAddin <- function() {
       }
     })
 
+    # bit.ly however also requires bearer tokens
+    output$bitly_token <- shiny::renderUI({
+      if (shortener_provider() == "bit.ly") {
+        shiny::tagList(
+          shiny::textInput("token",
+                           label = "Bearer Token", value = "",
+                           width = "100%"
+          )
+        )
+      } else {
+        return(NULL)
+      }
+    })
+    
     # Shorten links
     shiny::observeEvent(input$shorten, {
       shiny::req(input$url)
@@ -51,7 +66,7 @@ shortenerAddin <- function() {
 
       # Conditionally pass custom bit.ly custom domain
       if (input$provider == "bit.ly") {
-        res <- shortener(longUrl = input$url, domain = input$domain)
+        res <- shortener(longUrl = input$url, domain = input$domain, accessToken = input$token)
       } else {
         res <- shortener(longUrl = input$url)
       }
@@ -88,7 +103,7 @@ shortenerAddin <- function() {
 
       tryCatch(
         {
-          expander(shorturl = short_url) %>%
+          expander(shorturl = short_url, accessToken = input$token) %>%
             parse_response(expand = TRUE) %>%
             copy_and_notify()
         },
@@ -113,46 +128,6 @@ shortenerAddin <- function() {
   shiny::runGadget(ui, server, viewer = viewer)
 }
 
-#' Shorten an URL from clipboard
-#'
-#' @export
-clipShortenerAddin <- function() {
-  long_url <- clipr::read_clip()
-
-  tryCatch(
-    {
-      short_url <- bitly_shorten_link(long_url = long_url) %>%
-        parse_response()
-      clipr::write_clip(short_url)
-      cli::cli_alert_success(paste(short_url, "copied to clipboard", sep = " "))
-    },
-    error = function(err) {
-      cli::cli_alert_danger(err)
-    }
-  )
-}
-
-#' Expand an URL from clipboard
-#'
-#' @export
-clipExpanderAddin <- function() {
-  bitly_id <- clipr::read_clip() %>%
-    gsub(pattern = "https://", replacement = "")
-
-  tryCatch(
-    {
-      long_url <- bitly_expand_link(bitlink_id = bitly_id) %>%
-        parse_response(expand = TRUE)
-      clipr::write_clip(long_url)
-      cli::cli_alert_success(paste(long_url, "copied to clipboard", sep = " "))
-    },
-    error = function(e) {
-      cli::cli_alert_danger(e)
-    }
-  )
-}
-
-
 #' Select shortener function
 #'
 #' @param provider_name (str) url shortener provider

R/bitly_bsd.R

@@ -17,7 +17,7 @@ bitly_bsds <- function(access_token, showRequestURL = F) {
   if (length(df_bsds$bsds) == 0) {
     warning("There are no branded domains. First create some in Bitly.com")
   } else {
-    df_bsds <- data.frame(df_bsds, stringsAsFactors = FALSE)
+    df_bsds <- data.frame(df_bsds)
     return(df_bsds)
   }
 }

R/bitly_camp.R

@@ -10,6 +10,7 @@
 #' @param channel_guids - a list of strings
 #' @param description - description of campaign
 #' @param name - its name
+#' @param access_token - bearer token for authentication
 #'
 #' @inheritParams bitly_user_info
 #' @inheritParams bitly_retrieve_group
@@ -42,7 +43,7 @@ bitly_create_campaigns <- function(access_token, group_guid = NULL, channel_guid
     showURL = showRequestURL
   )
 
-  df_create_camps <- data.frame(df_create_camps, stringsAsFactors = FALSE)
+  df_create_camps <- data.frame(df_create_camps)
   df_create_camps$created <- ymd_hms(df_create_camps$created, tz = "UTC")
   df_create_camps$modified <- ymd_hms(df_create_camps$modified, tz = "UTC")
 
@@ -75,7 +76,7 @@ bitly_retrieve_campaigns <- function(access_token, group_guid = NULL, showReques
 
   df_get_camps <- doBearerTokenRequest("GET", get_camp, access_token = access_token, queryParameters = query, showURL = showRequestURL)
 
-  df_get_camps <- data.frame(df_get_camps$campaigns, stringsAsFactors = FALSE)
+  df_get_camps <- data.frame(df_get_camps$campaigns)
   df_get_camps$created <- ymd_hms(df_get_camps$created, tz = "UTC")
   df_get_camps$modified <- ymd_hms(df_get_camps$modified, tz = "UTC")
 
@@ -125,7 +126,7 @@ bitly_create_channel <- function(access_token, group_guid = NULL, guid = NULL, n
     showURL = showRequestURL
   )
 
-  df_create_channel <- data.frame(df_create_channel, stringsAsFactors = FALSE)
+  df_create_channel <- data.frame(df_create_channel)
   df_create_channel$created <- ymd_hms(df_create_channel$created, tz = "UTC")
   df_create_channel$modified <- ymd_hms(df_create_channel$modified, tz = "UTC")
 
@@ -160,7 +161,7 @@ bitly_retrieve_channels <- function(access_token, group_guid = NULL, campaign_gu
 
   df_get_channels <- doBearerTokenRequest("GET", get_channels, access_token = access_token, queryParameters = query, showURL = showRequestURL)
 
-  df_get_channels <- data.frame(df_get_channels$channels, stringsAsFactors = FALSE)
+  df_get_channels <- data.frame(df_get_channels$channels)
   df_get_channels$created <- ymd_hms(df_get_channels$created, tz = "UTC")
   df_get_channels$modified <- ymd_hms(df_get_channels$modified, tz = "UTC")
 
@@ -194,7 +195,7 @@ bitly_retrieve_campaign <- function(access_token, campaign_guid = NULL, showRequ
 
   df_get_camp <- doBearerTokenRequest("GET", get_camp, access_token = access_token, queryParameters = query, showURL = showRequestURL)
 
-  df_get_camp <- data.frame(df_get_camp, stringsAsFactors = FALSE)
+  df_get_camp <- data.frame(df_get_camp)
   df_get_camp$created <- ymd_hms(df_get_camp$created, tz = "UTC")
   df_get_camp$modified <- ymd_hms(df_get_camp$modified, tz = "UTC")
 
@@ -229,7 +230,7 @@ bitly_retrieve_channel <- function(access_token, channel_guid = NULL, showReques
 
   df_get_channel <- doBearerTokenRequest("GET", get_channel, access_token = access_token, queryParameters = query, showURL = showRequestURL)
 
-  df_get_channel <- data.frame(df_get_channel, stringsAsFactors = FALSE)
+  df_get_channel <- data.frame(df_get_channel)
   df_get_channel$created <- ymd_hms(df_get_channel$created, tz = "UTC")
   df_get_channel$modified <- ymd_hms(df_get_channel$modified, tz = "UTC")
 
@@ -277,7 +278,7 @@ bitly_update_campaign <- function(access_token, campaign_guid = NULL, group_guid
     showURL = showRequestURL
   )
 
-  df_update_camps <- data.frame(df_update_camps, stringsAsFactors = FALSE)
+  df_update_camps <- data.frame(df_update_camps)
   df_update_camps$created <- ymd_hms(df_update_camps$created, tz = "UTC")
   df_update_camps$modified <- ymd_hms(df_update_camps$modified, tz = "UTC")
 
@@ -322,7 +323,7 @@ bitly_update_channel <- function(access_token, channel_guid = NULL, group_guid =
     showURL = showRequestURL
   )
 
-  df_update_camp <- data.frame(df_update_camp, stringsAsFactors = FALSE)
+  df_update_camp <- data.frame(df_update_camp)
   df_update_camp$created <- ymd_hms(df_update_camp$created, tz = "UTC")
   df_update_camp$modified <- ymd_hms(df_update_camp$modified, tz = "UTC")
 

R/bitly_custom_links.R

@@ -68,7 +68,7 @@ bitly_retrieve_destination_metrics <- function(access_token, custom_bitlink = NU
   query <- list(access_token = access_token, custom_bitlink = custom_bitlink)
 
   df_cust_metrics <- doBearerTokenRequest("GET", url = metrics_url, queryParameters = query, showURL = showRequestURL)
-  df_cust_metrics <- data.frame(df_cust_metrics, stringsAsFactors = FALSE)
+  df_cust_metrics <- data.frame(df_cust_metrics)
 
   return(df_cust_metrics)
 }