Unclutter XML generation.

- Selectively import from CXML

- Introduce ZS3:WITH-XML-OUTPUT with simpler usage than the CXML
version.

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,30 +140,27 @@
   (: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)))
 
 (defmethod acl-serialize ((grantee acl-email))
   (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))))))
 

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)

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))))))))))
 

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*))
 
 
 

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)))
+

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 <[email protected]>"
@@ -42,6 +42,7 @@
                (:file "utils")
                (:file "crypto")
                (:file "xml-binding")
+               (:file "xml-output")
                (:file "credentials")
                (:file "post")
                (:file "redirects")