initial commit (no docs)

.Rbuildignore

@@ -0,0 +1 @@
+.travis.yml

.travis.yml

@@ -0,0 +1,14 @@
+language: c
+script: ./travis-tool.sh run_tests
+before_install:
+  - curl -OL http://raw.github.com/craigcitro/r-travis/master/scripts/travis-tool.sh
+  - chmod 755 ./travis-tool.sh
+  - ./travis-tool.sh bootstrap
+install:
+  - ./travis-tool.sh install_deps
+notifications:
+  email:
+    on_success: change
+    on_failure: change
+after_script:
+  - ./travis-tool.sh dump_logs

DESCRIPTION

@@ -0,0 +1,12 @@
+Package: aws.sns
+Type: Package
+Title: AWS SNS Client Package
+Version: 0.1
+Date: 2015-01-11
+Author: Thomas J. Leeper
+Maintainer: Thomas J. Leeper <thosjleeper@gmail.com>
+Description: A simple client package for the Amazon Web Services (AWS) Simple Notification Service (SNS) REST API.
+License: GPL (>= 2)
+Imports: httr, XML, jsonlite, aws.signature
+URL: https://github.com/cloudyr/aws.sns
+BugReports: https://github.com/cloudyr/aws.sns/issues

NAMESPACE

@@ -0,0 +1,5 @@
+exportPattern("^[[:alpha:]]+")
+import(aws.signature)
+import(httr)
+importFrom(XML, xmlParse, xmlToList)
+importFrom(XML, fromJSON, toJSON)

NEWS

@@ -0,0 +1,3 @@
+# CHANGES TO aws.sns 0.1 #
+
+* Initial release.

R/apps.r

@@ -0,0 +1,144 @@
+create_app <- function(name, platform, attribute, ...) {
+    query_list <- list(Action = "CreatePlatformApplication", PlatformApplicationArn = app)
+    if(nchar(name[1]) > 256 | nchar(name[1]) == 0) {
+        stop("name must be between 1 and 256 ASCII characters")
+    } else {
+        query_list$Name <- name[1]
+    }
+    plist <- c("ADM", "APNS", "APNS_SANDBOX", "GCM")
+    if(!platform[1] %in% plist)) {
+        stop(paste0("Platform must be one of ", paste0("'",plist,"'",collapse=", ")))
+    } else {
+        query_list$Platform <- platform[1]
+    }
+    plist <- c("PlatformCredential", "PlatformPrincipal", "EventEndpointCreated", 
+               "EventEndpointDeleted", "EventEndpointUpdated", "EventDeliveryFailure")
+    if(any(!names(attribute) %in% plist)) {
+        stop(paste0("Attribute names must be one of ", paste0("'",plist,"'",collapse=", ")))
+    } else {
+        len <- sapply(attribute, length)
+        n <- as.list(rep(names(attribute), len))
+        names(n) <- paste0("Attributes.entry.", 1:sum(len), ".key")
+        p <- as.list(unlist(attribute))
+        names(p) <- paste0("Attributes.entry.", 1:sum(len), ".value")
+        query_list <- c(query_list, n, p)
+    }
+    out <- snsHTTP(query = query_list, ...)
+    if(inherits(out), "aws-error")
+        return(out)
+    structure(out$CreatePlatformApplicationResponse$CreatePlatformApplicationResult,
+              RequestId = out$CreatePlatformApplicationResponse$ResponseMetadata$RequestId)
+}
+
+delete_app <- function(app, ...) {
+    query_list <- list(Action = "DeletePlatformApplication", PlatformApplicationArn = app)
+    out <- snsHTTP(query = query_list, ...)
+    if(inherits(out), "aws-error")
+        return(out)
+    structure(out$DeletePlatformApplicationResponse$DeletePlatformApplicationResult,
+              RequestId = out$DeletePlatformApplicationResponse$ResponseMetadata$RequestId)
+}
+
+get_app_attrs <- function(app, ...) {
+    query_list <- list(Action = "GetPlatformApplicationAttributes", PlatformApplicationArn = app)
+    out <- snsHTTP(query = query_list, ...)
+    if(inherits(out), "aws-error")
+        return(out)
+    structure(out$GetPlatformApplicationAttributesResponse$GetPlatformApplicationAttributesResult,
+              RequestId = out$GetPlatformApplicationAttributesResponse$ResponseMetadata$RequestId)
+}
+
+set_app_attrs <- function(app, attribute, ...) {
+    query_list <- list(Action = "SetPlatformApplicationAttributes", PlatformApplicationArn = app)
+    plist <- c("PlatformCredential", "PlatformPrincipal", "EventEndpointCreated", "EventEndpointDeleted",
+               "EventEndpointUpdated", "EventDeliveryFailure")
+    if(any(!names(attribute) %in% plist)) {
+        stop(paste0("Attribute names must be one of ", paste0("'",plist,"'",collapse=", ")))
+    } else {
+        len <- sapply(attribute, length)
+        n <- as.list(rep(names(attribute), len))
+        names(n) <- paste0("Attributes.entry.", 1:sum(len), ".key")
+        p <- as.list(unlist(attribute))
+        names(p) <- paste0("Attributes.entry.", 1:sum(len), ".value")
+        query_list <- c(query_list, n, p)
+    }
+    out <- snsHTTP(query = query_list, ...)
+    if(inherits(out), "aws-error")
+        return(out)
+    structure(out$SetPlatformApplicationAttributesResponse$SetPlatformApplicationAttributesResult,
+              RequestId = out$SetPlatformApplicationAttributesResponse$ResponseMetadata$RequestId)
+}
+
+create_app_endpoint <- function(app, attribute, token, custom_data, ...) {
+    query_list <- list(Action = "CreatePlatformEndpoint", PlatformApplicationArn = app)
+    if(any(!names(attribute) %in% c("CustomUserData", "Enabled", "Token"))) {
+        warnings("Unrecognized attribute names. Should be 'CustomUserData', 'Enabled', or 'Token'")
+    } else {
+        len <- sapply(attribute, length)
+        n <- as.list(rep(names(attribute), len))
+        names(n) <- paste0("Attributes.entry.", 1:sum(len), ".key")
+        p <- as.list(unlist(attribute))
+        names(p) <- paste0("Attributes.entry.", 1:sum(len), ".value")
+        query_list <- c(query_list, n, p)
+    }
+    query_list$Token <- token
+    if(!missing(custom_data))
+        query_list$CustomUserData <- custom_data
+    out <- snsHTTP(query = query_list, ...)
+    if(inherits(out), "aws-error")
+        return(out)
+    structure(out$CreatePlatformEndpointResponse$CreatePlatformEndpointResult,
+              RequestId = out$CreatePlatformEndpointResponse$ResponseMetadata$RequestId)
+}
+
+get_endpoint_attrs <- function(endpoint, ...) {
+    query_list <- list(Action = "GetEndpointAttributes", EndpointArn = endpoint)
+    out <- snsHTTP(query = query_list, ...)
+    if(inherits(out), "aws-error")
+        return(out)
+    structure(out$GetEndpointAttributesResponse$GetEndpointAttributesResult,
+              RequestId = out$GetEndpointAttributesResponse$ResponseMetadata$RequestId)
+}
+
+set_endpoint_attrs <- function(endpoint, attribute, ...) {
+    query_list <- list(Action = "SetEndpointAttributes", EndpointArn = endpoint)
+    if(any(!names(attribute) %in% c("CustomUserData", "Enabled", "Token"))) {
+        warning("Unrecognized attribute names. Should be 'CustomUserData', 'Enabled', or 'Token'")
+    } else {
+        len <- sapply(attribute, length)
+        n <- as.list(rep(names(attribute), len))
+        names(n) <- paste0("Attributes.entry.", 1:sum(len), ".key")
+        p <- as.list(unlist(attribute))
+        names(p) <- paste0("Attributes.entry.", 1:sum(len), ".value")
+        query_list <- c(query_list, n, p)
+    }
+    out <- snsHTTP(query = query_list, ...)
+    if(inherits(out), "aws-error")
+        return(out)
+    structure(out$SetEndpointAttributesResponse$SetEndpointAttributesResult,
+              RequestId = out$SetEndpointAttributesResponse$ResponseMetadata$RequestId)
+}
+
+list_apps <- function(token, ...) {
+    query_list <- list(Action = "ListPlatformApplications")
+    if(!missing(token)) {
+        query_list$NextToken <- token
+    }
+    out <- snsHTTP(query = query_list, ...)
+    if(inherits(out), "aws-error")
+        return(out)
+    structure(out$ListPlatformApplicationsResponse$ListPlatformApplicationsResult,
+              RequestId = out$ListPlatformApplicationsResponse$ResponseMetadata$RequestId)
+}
+
+list_app_endpoints <- function(app, token, ...) {
+    if(missing(token)) {
+        out <- snsHTTP(query = list(Action = "ListEndpointsByPlatformApplication"), ...)
+    } else {
+        out <- snsHTTP(query = list(Action = "ListEndpointsByPlatformApplication", NextToken = token), ...)
+    }
+    if(inherits(out), "aws-error")
+        return(out)
+    structure(out$ListEndpointsByPlatformApplicationResponse$ListEndpointsByPlatformApplicationResult, 
+              RequestId = out$ListEndpointsByPlatformApplicationResponse$ResponseMetadata$RequestId)
+}

R/http.r

@@ -0,0 +1,45 @@
+snsHTTP <- function(query, region, key, secret, ...) {
+    if(missing(region))
+        region <- "us-east-1"
+    if(missing(key))
+        key <- Sys.getenv("AWS_ACCESS_KEY_ID")
+    if(missing(secret))
+        secret <- Sys.getenv("AWS_SECRET_ACCESS_KEY")
+    current <- Sys.time()
+    d_timestamp <- format(current, "%Y%m%dT%H%M%SZ", tz = "UTC")
+    if(key == "") {
+        H <- add_headers(`x-amz-date` = d_timestamp)
+    } else {
+        S <- signature_v4_auth(
+               datetime = d_timestamp,
+               region = region,
+               service = "sns",
+               verb = "GET",
+               action = "/",
+               query_args = query,
+               canonical_headers = list(host = paste0("sns.",region,".amazonaws.com"),
+                                        `x-amz-date` = d_timestamp),
+               request_body = "",
+               key = key, secret = secret)
+        H <- add_headers(`x-amz-date` = d_timestamp, 
+                         `x-amz-content-sha256` = S$BodyHash,
+                         Authorization = S$SignatureHeader)
+    }
+    r <- GET(paste0("https://sns.",region,".amazonaws.com"), H, query = query, ...)
+    if(http_status(r)$category == "client error") {
+        x <- try(xmlToList(xmlParse(content(r, "text"))), silent = TRUE)
+        if(inherits(x, "try-error"))
+            x <- try(fromJSON(content(r, "text"))$Error, silent = TRUE)
+        warn_for_status(r)
+        h <- headers(r)
+        out <- structure(x, headers = h, class = "aws_error")
+        attr(out, "request_canonical") <- S$CanonicalRequest
+        attr(out, "request_string_to_sign") <- S$StringToSign
+        attr(out, "request_signature") <- S$SignatureHeader
+    } else {
+        out <- try(fromJSON(content(r, "text")), silent = TRUE)
+        if(inherits(out, "try-error"))
+            out <- structure(content(r, "text"), "unknown")
+    }
+    return(out)
+}

R/publish.r

@@ -0,0 +1,28 @@
+publish <- function(topic, target, message, subject, ...) {
+    if(!missing(topic))
+        query_list <- list(TopicArn = topic, Action = "Publish")
+    else if(!missing(target))
+        query_list <- list(TargetArn = target, Action = "Publish")
+    else
+        stop("Must supply either 'topic' or 'target'")
+    if(is.character(message)){
+        query_list$Message <- message
+    } else {
+        query_list$Message <- toJSON(message)
+        query_list$MessageStructure <- "json"
+    }
+    if(!missing(subject)) {
+        if(nchar(subject[1]) > 100)
+            stop("subject must be <= 100 characters")
+        if(grepl("[[:cntrl:]]", subject[1]))
+            stop("subject must not contain control characters")
+        if(!grepl("^[[:alnum:]!]", subject[1]))
+            stop("subject must start with letter, number, or exclamation point (!)")
+        query_list$Subject <- subject
+    }
+    out <- snsHTTP(query = query_list, ...)
+    if(inherits(out), "aws-error")
+        return(out)
+    structure(out$PublishResponse, 
+              RequestId = out$PublishResponse$ResponseMetadata$RequestId)
+}

R/subscriptions.r

@@ -0,0 +1,71 @@
+subscribe <- function(topic, endpoint, protocol, ...) {
+    query_list <- list(TopicArn = topic, Action = "Subscribe")
+    query_list$Endpoint <- endpoint
+    protocol_list <- c("http","https","email","email-json","sms","sqs","application")
+    if(!protocol %in% protocol_list)
+        stop("'name' must be one of: ", paste0('"',protocol_list,'"', collapse = ", "))
+    else
+        query_list$Protocol <- protocol
+    out <- snsHTTP(query = query_list, ...)
+    if(inherits(out), "aws-error")
+        return(out)
+    structure(out$SubscribeResponse, 
+              RequestId = out$SubscribeResponse$ResponseMetadata$RequestId)
+}
+
+unsubscribe < function(subscription, ...) {
+    query_list <- list(SubscriptionArn = subscription, Action = "Unsubscribe")
+    out <- snsHTTP(query = query_list, ...)
+    if(inherits(out), "aws-error")
+        return(out)
+    structure(out$UnsubscribeResponse, 
+              RequestId = out$UnsubscribeResponse$ResponseMetadata$RequestId)
+}
+
+get_subscription_attrs <- function(subscription, ...) {
+    query_list <- list(SubscriptionArn = subscription, Action = "GetSubscriptionAttributes")
+    out <- snsHTTP(query = query_list, ...)
+    if(inherits(out), "aws-error")
+        return(out)
+    structure(out$GetSubscriptionAttributesResponse, 
+              RequestId = out$GetSubscriptionAttributesResponse$ResponseMetadata$RequestId)
+}
+
+set_subscription_attrs <- function(subscription, attribute, ...) {
+    query_list <- list(SubscriptionArn = subscription, Action = "SetSubscriptionAttributes")
+    if(any(!names(attribute) %in% c("DeliveryPolicy","RawMessageDelivery")))
+        stop("Attribute name must be 'DeliveryPolicy' or 'RawMessageDelivery'")
+    else {
+        query_list$AttributeName <- names(attribute)
+        query_list$AttributeValue <- attribute[[1]]
+    }
+    out <- snsHTTP(query = query_list, ...)
+    if(inherits(out), "aws-error")
+        return(out)
+    structure(out$SetSubscriptionAttributesResponse, 
+              RequestId = out$SetSubscriptionAttributesResponse$ResponseMetadata$RequestId)
+}
+
+list_subscriptions <- function(topic, token, ...) {
+    if(missing(topic)) {
+        query_list <- list(Action = "ListSubscriptions")
+        if(!missing(token)) {
+            query_list$NextToken <- token
+        }
+        out <- snsHTTP(query = query_list, ...)
+        if(inherits(out), "aws-error")
+            return(out)
+        structure(out$ListSubscriptionsByTopicResponse$ListSubscriptionsByTopicResult,
+                  RequestId = out$ListSubscriptionsByTopicResponse$ResponseMetadata$RequestId)
+    } else {
+        query_list <- list(Action = "ListSubscriptionsByTopic", TopicArn = topic)
+        if(!missing(token)) {
+            query_list$NextToken <- token
+        }
+        out <- snsHTTP(query = query_list, ...)
+        if(inherits(out), "aws-error")
+            return(out)
+        structure(out$ListSubscriptionsResponse$ListSubscriptionsResult,
+                  RequestId = out$ListSubscriptionsResponse$ResponseMetadata$RequestId)
+    }
+}