diff --git a/acl.lisp b/acl.lisp index 3dfad3a..57524a6 100644 --- a/acl.lisp +++ b/acl.lisp @@ -127,8 +127,8 @@ (defgeneric acl-serialize (object)) (defmethod acl-serialize ((person person)) - (cxml:with-element "ID" (cxml:text (id person))) - (cxml:with-element "DisplayName" (cxml:text (display-name person)))) + (with-element "ID" (text (id person))) + (with-element "DisplayName" (text (display-name person)))) (defvar *xsi* "http://www.w3.org/2001/XMLSchema-instance") @@ -140,9 +140,6 @@ (:method ((grantee acl-email)) "AmazonCustomerByEmail")) -(defun simple-element (name value) - (cxml:with-element name (cxml:text value))) - (defmethod acl-serialize ((grantee acl-group)) (simple-element "URI" (uri grantee))) @@ -150,20 +147,20 @@ (simple-element "EmailAddress" (email grantee))) (defmethod acl-serialize ((grant grant)) - (cxml:with-element "Grant" - (cxml:with-element "Grantee" - (cxml:attribute* "xmlns" "xsi" *xsi*) - (cxml:attribute* "xsi" "type" (xsi-type (grantee grant))) + (with-element "Grant" + (with-element "Grantee" + (attribute* "xmlns" "xsi" *xsi*) + (attribute* "xsi" "type" (xsi-type (grantee grant))) (acl-serialize (grantee grant))) (simple-element "Permission" (permission-name (permission grant))))) (defmethod acl-serialize ((acl access-control-list)) - (cxml:with-xml-output (cxml:make-octet-vector-sink) - (cxml:with-element "AccessControlPolicy" - (cxml:attribute "xmlns" "http://s3.amazonaws.com/doc/2006-03-01/") - (cxml:with-element "Owner" + (with-xml-output + (with-element "AccessControlPolicy" + (attribute "xmlns" "http://s3.amazonaws.com/doc/2006-03-01/") + (with-element "Owner" (acl-serialize (owner acl))) - (cxml:with-element "AccessControlList" + (with-element "AccessControlList" (dolist (grant (remove-duplicates (grants acl) :test #'acl-eqv)) (acl-serialize grant)))))) diff --git a/cloudfront.lisp b/cloudfront.lisp index e7d676b..0671c39 100644 --- a/cloudfront.lisp +++ b/cloudfront.lisp @@ -206,32 +206,32 @@ distribution request error responses.") ;;; Distribution-related requests (defun distribution-document (distribution) - (cxml:with-xml-output (cxml:make-string-sink) - (cxml:with-element "DistributionConfig" - (cxml:attribute "xmlns" "http://cloudfront.amazonaws.com/doc/2010-08-01/") - (cxml:with-element "Origin" - (cxml:text (origin-bucket distribution))) - (cxml:with-element "CallerReference" - (cxml:text (caller-reference distribution))) + (with-xml-output + (with-element "DistributionConfig" + (attribute "xmlns" "http://cloudfront.amazonaws.com/doc/2010-08-01/") + (with-element "Origin" + (text (origin-bucket distribution))) + (with-element "CallerReference" + (text (caller-reference distribution))) (dolist (cname (cnames distribution)) - (cxml:with-element "CNAME" - (cxml:text cname))) + (with-element "CNAME" + (text cname))) (when (comment distribution) - (cxml:with-element "Comment" - (cxml:text (comment distribution)))) - (cxml:with-element "Enabled" - (cxml:text (if (enabledp distribution) - "true" - "false"))) + (with-element "Comment" + (text (comment distribution)))) + (with-element "Enabled" + (text (if (enabledp distribution) + "true" + "false"))) (when (default-root-object distribution) - (cxml:with-element "DefaultRootObject" - (cxml:text (default-root-object distribution)))) + (with-element "DefaultRootObject" + (text (default-root-object distribution)))) (let ((logging-bucket (logging-bucket distribution)) (logging-prefix (logging-prefix distribution))) (when (and logging-bucket logging-prefix) - (cxml:with-element "Logging" - (cxml:with-element "Bucket" (cxml:text logging-bucket)) - (cxml:with-element "Prefix" (cxml:text logging-prefix)))))))) + (with-element "Logging" + (with-element "Bucket" (text logging-bucket)) + (with-element "Prefix" (text logging-prefix)))))))) (defun distribution-request-headers (distribution) (let* ((date (http-date-string)) @@ -561,14 +561,14 @@ DISTRIBUTION itself, as it may be re-tried multiple times." :content content)) (defun invalidation-batch-document (invalidation) - (cxml:with-xml-output (cxml:make-string-sink) - (cxml:with-element "InvalidationBatch" - (cxml:attribute "xmlns" "http://cloudfront.amazonaws.com/doc/2010-08-01/") + (with-xml-output + (with-element "InvalidationBatch" + (attribute "xmlns" "http://cloudfront.amazonaws.com/doc/2010-08-01/") (dolist (path (paths invalidation)) - (cxml:with-element "Path" - (cxml:text path))) - (cxml:with-element "CallerReference" - (cxml:text (caller-reference invalidation)))))) + (with-element "Path" + (text path))) + (with-element "CallerReference" + (text (caller-reference invalidation)))))) (defun invalidate-paths (distribution paths) diff --git a/logging.lisp b/logging.lisp index 0bfa3c1..b1a8d78 100644 --- a/logging.lisp +++ b/logging.lisp @@ -74,14 +74,14 @@ (defgeneric log-serialize (object) (:method ((logging-setup logging-setup)) - (cxml:with-xml-output (cxml:make-octet-vector-sink) - (cxml:with-element "BucketLoggingStatus" + (with-xml-output + (with-element "BucketLoggingStatus" (when (target-bucket logging-setup) - (cxml:with-element "LoggingEnabled" + (with-element "LoggingEnabled" (simple-element "TargetBucket" (target-bucket logging-setup)) (simple-element "TargetPrefix" (target-prefix logging-setup)) (when (target-grants logging-setup) - (cxml:with-element "TargetGrants" + (with-element "TargetGrants" (dolist (grant (target-grants logging-setup)) (acl-serialize grant)))))))))) diff --git a/package.lisp b/package.lisp index 7d4b593..56ca9e6 100644 --- a/package.lisp +++ b/package.lisp @@ -45,7 +45,8 @@ #:delete-bucket #:bucket-location #:bucket-lifecycle - #:lifecycle-rule) + #:lifecycle-rule + #:restore-object) ;; Bucket queries (:export #:query-bucket #:continue-bucket-query @@ -158,7 +159,12 @@ #:distribution-not-disabled #:cname-already-exists #:too-many-distributions) - (:shadow #:method)) + (:shadow #:method) + (:shadowing-import-from #:cxml + #:with-element + #:text + #:attribute + #:attribute*)) diff --git a/xml-output.lisp b/xml-output.lisp new file mode 100644 index 0000000..f45283f --- /dev/null +++ b/xml-output.lisp @@ -0,0 +1,38 @@ +;;;; +;;;; Copyright (c) 2012 Zachary Beane, All Rights Reserved +;;;; +;;;; Redistribution and use in source and binary forms, with or without +;;;; modification, are permitted provided that the following conditions +;;;; are met: +;;;; +;;;; * Redistributions of source code must retain the above copyright +;;;; notice, this list of conditions and the following disclaimer. +;;;; +;;;; * Redistributions in binary form must reproduce the above +;;;; copyright notice, this list of conditions and the following +;;;; disclaimer in the documentation and/or other materials +;;;; provided with the distribution. +;;;; +;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +;;;; +;;;; xml-output.lisp + +(in-package #:zs3) + +(defmacro with-xml-output (&body body) + `(cxml:with-xml-output (cxml:make-octet-vector-sink) + ,@body)) + +(defun simple-element (name value) + (with-element name (cxml:text value))) + diff --git a/zs3.asd b/zs3.asd index a008392..b2ea41a 100644 --- a/zs3.asd +++ b/zs3.asd @@ -33,7 +33,7 @@ #:ironclad #:puri #:cl-base64) - :version "1.1.13" + :version "1.1.13" :description "A Common Lisp library for working with Amazon's Simple Storage Service (S3) and CloudFront content delivery service." :author "Zach Beane " @@ -42,6 +42,7 @@ (:file "utils") (:file "crypto") (:file "xml-binding") + (:file "xml-output") (:file "credentials") (:file "post") (:file "redirects")