Signing of URLs for google queries when using a digital signature.

DESCRIPTION

@@ -25,7 +25,9 @@ Imports:
     digest,
     scales,
     dplyr,
-    bitops
+    bitops,
+    base64enc,
+    urltools
 Suggests:
     MASS,
     stringr,

R/geocode.R

@@ -99,8 +99,6 @@ geocode <- function(location, output = c("latlon", "latlona", "more", "all"),
   nameType <- match.arg(nameType)
   source   <- match.arg(source)
 
-
-
   # vectorize for many locations
   if(length(location) > 1){
     # set limit
@@ -135,13 +133,15 @@ geocode <- function(location, output = c("latlon", "latlona", "more", "all"),
   # start constructing the url
   posturl <- URLencode(location, reserved = TRUE)
 
+  NeedToSign <- FALSE
   if(source == "google"){
 
     # add google account stuff
     if (has_goog_client() && has_goog_signature()) {
+      NeedToSign <- TRUE
       client <- goog_client()
-      signature <- goog_signature()
-      posturl <- paste(posturl, fmteq(client), fmteq(signature), sep = "&")
+      #signature <- goog_signature()
+      posturl <- paste(posturl, fmteq(client), sep = "&")
     } else if (has_goog_key()) {
       key <- goog_key()
       posturl <- paste(posturl, fmteq(key), sep = "&")
@@ -165,8 +165,11 @@ geocode <- function(location, output = c("latlon", "latlona", "more", "all"),
   if(urlonly) return(url_string)
   url_hash   <- digest::digest(url_string)
 
-
-
+  if (NeedToSign) {
+    # Sign if we are using google client and digital signature
+    url_string <- signurl(url_string, secret=goog_signature())
+  }
+
   # lookup info if on file
   if(isGeocodedInformationOnFile(url_hash) && force == FALSE){
 

R/get_googlemap.R

@@ -133,7 +133,6 @@ get_googlemap <- function(
 
   ##### do argument checking
   ############################################################
-
   args <- as.list(match.call(expand.dots = TRUE)[-1])
   argsgiven <- names(args)
 
@@ -309,10 +308,11 @@ get_googlemap <- function(
     sep = "&")
 
   # add google account stuff
+  NeedToSign <- FALSE
   if (has_goog_client() && has_goog_signature()) {
+    NeedToSign <- TRUE
     client <- goog_client()
-    signature <- goog_signature()
-    post_url <- paste(post_url, fmteq(client), fmteq(signature), sep = "&")
+    post_url <- paste(post_url, fmteq(client), sep = "&")
   } else if (has_goog_key()) {
     key <- goog_key()
     post_url <- paste(post_url, fmteq(key), sep = "&")
@@ -331,7 +331,11 @@ get_googlemap <- function(
   if(urlonly) return(url)
   if(nchar(url) > 2048) stop("max url length is 2048 characters.", call. = FALSE)
 
-
+  if (NeedToSign) {
+    # Sign if we are using google client and digital signature
+    url <- signurl(url, secret=goog_signature())
+  }
+
   ##### get map
   ############################################################
 

R/ggplot2.R

@@ -4,7 +4,7 @@
 # Stat        <- get("Stat",        envir = asNamespace("ggplot2"))
 is.constant <- get("is.constant", envir = asNamespace("ggplot2"))
 rename_aes  <- get("rename_aes",  envir = asNamespace("ggplot2"))
-.all_aesthetics <- get(".all_aesthetics", envir = asNamespace("ggplot2"))
+.all_aesthetics <- ggplot2:::ggplot_global$all_aesthetics
 
 list_to_dataframe <- get("list_to_dataframe", envir = asNamespace("plyr"))
 

R/mapdist.R

@@ -17,13 +17,18 @@
 #'   (.GoogleDistQueryCount)
 #' @param ext domain extension (e.g. "com", "co.nz")
 #' @param inject character string to add to the url
+#' @param usingPlaceIDs indicate that from and to fields contain placeIDs.
+#' Turns of URL encoding of addresses.
 #' @param ... ...
 #' @return a data frame (output="simple") or all of the geocoded
 #'   information (output="all")
 #' @author David Kahle \email{david.kahle@@gmail.com}
 #' @details if parameters from and to are specified as geographic
 #'   coordinates, they are reverse geocoded with revgeocode.  note
 #'   that the google maps api limits to 2500 element queries a day.
+#'
+#'   mapdist now makes a single query to the mapdist api. The returned
+#'   data frame will have length(from)*length(to) rows
 #' @seealso
 #' \url{http://code.google.com/apis/maps/documentation/distancematrix/}
 #' @export
@@ -61,36 +66,45 @@
 mapdist <- function(from, to, mode = c("driving","walking","bicycling","transit"),
   output = c("simple","all"), messaging = FALSE,
   language = "en-EN", urlonly = FALSE, override_limit = FALSE,
-  ext = "com", inject = "", ...)
+  ext = "com", inject = "", usingPlaceIDs=FALSE, ...)
 {
 
   # check parameters
   if(is.numeric(from) && length(from) == 2) from <- revgeocode(from)
   stopifnot(is.character(from))
   if(is.numeric(to) && length(to) == 2) to <- revgeocode(to)
   stopifnot(is.character(to))
-  from_to_df <- data.frame(from = from, to = to, stringsAsFactors = FALSE)
+
+  # Don't need to ensure that # from = # to - that happens in google
+  origins <- from
+  destinations <- to # this ensures # from = # to
+
   mode <- match.arg(mode)
   output <- match.arg(output)
   stopifnot(is.logical(messaging))
 
 
-  getdists <- function(df){
-
+  getdists <- function(From, To){
   	# format basic url
-    origins <- URLencode(df$from[1], reserved = TRUE)
-    destinations <- URLencode(df$to, reserved = TRUE)
+    if (usingPlaceIDs) {
+      origins <- From
+      destinations <- To
+    } else {
+      origins <- sapply(From, URLencode, reserved = TRUE)
+      destinations <- sapply(To, URLencode, reserved = TRUE)
+    }
     posturl <- paste(
-      fmteq(origins), fmteq(destinations, paste, collapse = "|"),
+      fmteq(origins, paste, collapse = "|"), fmteq(destinations, paste, collapse = "|"),
       fmteq(mode), fmteq(language),
       sep = "&"
     )
 
     # add google account stuff
+    NeedToSign <- FALSE
     if (has_goog_client() && has_goog_signature()) {
+      NeedToSign <- TRUE
       client <- goog_client()
-      signature <- goog_signature()
-      posturl <- paste(posturl, fmteq(client), fmteq(signature), sep = "&")
+      posturl <- paste(posturl, fmteq(client), sep = "&")
     } else if (has_goog_key()) {
       key <- goog_key()
       posturl <- paste(posturl, fmteq(key), sep = "&")
@@ -104,13 +118,17 @@ mapdist <- function(from, to, mode = c("driving","walking","bicycling","transit"
 
     # inject
     if(inject != "") url_string <- paste(url_string, inject, sep = "&")
-
     # encode
     url_string <- URLencode( enc2utf8(url_string) )
     if(urlonly) return(url_string)
 
-    # check if query is too long
-    if(nchar(url_string) >= 2048){
+    if (NeedToSign) {
+      # Sign if we are using google client and digital signature
+      url_string <- signurl(url_string, secret=goog_signature())
+    }
+    # check if query is too long - not sure if the signature is included
+    # in the maximum length - sign before check to be surTT$e.
+    if(nchar(url_string) >= 8192){
       n <- nrow(df)
       half_df <- floor(n/2)
       return(
@@ -121,61 +139,62 @@ mapdist <- function(from, to, mode = c("driving","walking","bicycling","transit"
       )
     }
 
-    # check/update google query limit
-    check_dist_query_limit(url_string, elems = nrow(df),
+    # check/update google query limit - this is a single query
+    check_dist_query_limit(url_string, elems = 1,
       override = override_limit, messaging = messaging)
 
 
     # distance lookup
     if(messaging) message("trying url ", url_string)
     connect <- url(url_string); on.exit(close(connect), add = TRUE)
-    tree <- fromJSON(paste(readLines(connect), collapse = ""))
+    tree <- rjson::fromJSON(paste(readLines(connect), collapse = ""), simplify=FALSE)
     check_google_for_error(tree)
 
-
     # message user
     message(paste0("Source : ", url_string))
-
     # label destinations - first check if all were found
-    if(length(df$to) != length(tree$destination_addresses)){
+    if(length(To) != length(tree$destination_addresses)){
       message("matching was not perfect, returning what was found.")
-      names( tree$rows[[c(1,1)]] ) <- tree$destination_addresses
       output <<- "all"
-      # stringdist::amatch(df$to, tree$destination_addresses, maxDist = 10)
-    } else {
-      names( tree$rows[[c(1,1)]] ) <- df$to
     }
-
-    # return
-    tree$rows[[c(1,1)]]
+    if(length(From) != length(tree$origin_addresses)){
+      message("matching was not perfect, returning what was found.")
+      output <<- "all"
+    }
+    return(tree)
   }
 
-  out <- dlply(from_to_df, "from", getdists)
+  out <- getdists(origins, destinations)
 
   # return all
   if(output == "all") return(out)
 
-
-
+  # out$rows has length(from)
+  # out$rows[[j]]$elements has length(to)
   # format output
-  out <-
-    ldply(out, function(oneFromList){
-      ldply(oneFromList, function(oneToList){
-        data.frame(
-          m = oneToList$distance$value,
-  	      km = oneToList$distance$value/1000,
-          miles = 0.0006214 * oneToList$distance$value,
-          seconds = oneToList$duration$value,
-          minutes = oneToList$duration$value / 60,
-  	      hours = oneToList$duration$value / 3600
-        )
-      })
+  out_df <-  plyr::ldply(out$rows, function(aToList){
+    res <- plyr::ldply(aToList[[1]], function(oneToList){
+      data.frame(
+        m = oneToList$distance$value,
+        km = oneToList$distance$value/1000,
+        miles = 0.0006214 * oneToList$distance$value,
+        seconds = oneToList$duration$value,
+        minutes = oneToList$duration$value / 60,
+        hours = oneToList$duration$value / 3600
+      )
     })
+    return(res)
+  })
+
+  destadd <- rep(out$destination_addresses, length(out$origin_addresses))
+  originadd <- rep(out$origin_address, rep(length(out$destination_addresses), length(out$origin_addresses)))
 
-  names(out) <- c("from", "to", names(out)[3:ncol(out)])
+  tos <- rep(to, length(from))
+  froms <- rep(from, rep(length(to), length(from)))
 
+  from_to_df <- data.frame(destination.address=destadd, origin.address=originadd, from=froms, to=tos)
   # "simple" return
-  suppressMessages(join(from_to_df, out))
+  suppressMessages(cbind(from_to_df, out_df))
 }
 
 

R/revgeocode.R

@@ -51,10 +51,11 @@ revgeocode <- function(location, output = c("address","more","all"),
   )
 
   # do google credentials
+  NeedToSign <- FALSE
   if (has_goog_client() && has_goog_signature()) {
+    NeedToSign <- TRUE
     client <- goog_client()
-    signature <- goog_signature()
-    url_string <- paste(url_string, fmteq(client), fmteq(signature), sep = "&")
+    url_string <- paste(url_string, fmteq(client), sep = "&")
   } else if (has_goog_key()) {
     key <- goog_key()
     url_string <- paste(url_string, fmteq(key), sep = "&")
@@ -67,7 +68,12 @@ revgeocode <- function(location, output = c("address","more","all"),
   url_string <- URLencode( enc2utf8(url_string) )
   if(urlonly) return(url_string)
 
-  # check/update google query limit
+  if (NeedToSign) {
+    # Sign if we are using google client and digital signature
+    url_string <- signurl(url_string, secret=goog_signature())
+  }
+
+    # check/update google query limit
   check <- checkGeocodeQueryLimit(url_string, elems = 1, override = override_limit, messaging = messaging)
 
   if(check == "stop"){

R/route.R

@@ -87,10 +87,12 @@ route <- function(from, to, mode = c("driving","walking","bicycling", "transit")
   )
 
   # add google account stuff
+  NeedToSign <- FALSE
   if (has_goog_client() && has_goog_signature()) {
+    NeedToSign <- TRUE
     client <- goog_client()
-    signature <- goog_signature()
-    posturl <- paste(posturl, fmteq(client), fmteq(signature), sep = "&")
+    #signature <- goog_signature()
+    posturl <- paste(posturl, fmteq(client), sep = "&")
   } else if (has_goog_key()) {
     key <- goog_key()
     posturl <- paste(posturl, fmteq(key), sep = "&")
@@ -112,7 +114,10 @@ route <- function(from, to, mode = c("driving","walking","bicycling", "transit")
   # check/update google query limit
   check_route_query_limit(url_string, elems = 1, override = override_limit, messaging = messaging)
 
-
+  if (NeedToSign) {
+    # Sign if we are using google client and digital signature
+    url_string <- signurl(url_string, secret=goog_signature())
+  }
   # distance lookup
   if(messaging) message("trying url ", url_string)
   connect <- url(url_string); on.exit(close(connect), add = TRUE)

R/trek.R

@@ -114,10 +114,11 @@ trek <- function(from, to, mode = c("driving","walking","bicycling", "transit"),
   )
 
   # add google account stuff
+  NeedToSign <- FALSE
   if (has_goog_client() && has_goog_signature()) {
+    NeedToSign <- TRUE
     client <- goog_client()
-    signature <- goog_signature()
-    posturl <- paste(posturl, fmteq(client), fmteq(signature), sep = "&")
+    posturl <- paste(posturl, fmteq(client), sep = "&")
   } else if (has_goog_key()) {
     key <- goog_key()
     posturl <- paste(posturl, fmteq(key), sep = "&")
@@ -141,7 +142,11 @@ trek <- function(from, to, mode = c("driving","walking","bicycling", "transit"),
   check_route_query_limit(url_string, elems = 1,
     override = override_limit, messaging = messaging)
 
-
+  if (NeedToSign) {
+    # Sign if we are using google client and digital signature
+    url_string <- signurl(url_string, secret=goog_signature())
+  }
+
   # distance lookup
   if(messaging) message("trying url ", url_string)
   connect <- url(url_string)

R/urlsigning.R

@@ -0,0 +1,22 @@
+#' Sign a url using a google digital signature
+#' @author Richard Beare
+#' @param input_url The url to be signed. Should include a client field.
+#' @param secret The private key
+#' @return The signed url
+#' @details Derived from the python urlsigner: 
+#' https://raw.githubusercontent.com/googlemaps/js-v2-samples/61b3f58eb1286a428843f8401048226b8648a76b/urlsigning/urlsigner.py
+#' 
+signurl <- function(input_url, secret)
+{
+  secret.safe <- chartr("-_", "+/", secret)
+  decoded_key <- base64enc::base64decode(secret.safe)
+  # break up the url
+  urlparsed <- urltools::url_parse(input_url)
+  url_to_sign <- paste0("/", urlparsed$path, "?", urlparsed$parameter)
+  signature <- digest::hmac(decoded_key, url_to_sign, algo="sha1", raw=TRUE)
+  enc1 <- base64enc::base64encode(signature, linewidth=NA)
+  urlsafesig <- chartr("+/", "-_",  enc1)
+  originalurl <- urltools::url_compose(urlparsed)
+  finalurl <- paste0(originalurl, "&signature=", urlsafesig)
+  return(finalurl)
+}