Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Unclutter XML generation.

- Selectively import from CXML

- Introduce ZS3:WITH-XML-OUTPUT with simpler usage than the CXML
version.
  • Loading branch information...
commit ae9653e9e3eecc3c4387e4cb7a2294fd1c89ea72 1 parent f44f9c5
@xach authored
View
25 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))))))
View
54 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)
View
8 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))))))))))
View
10 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*))
View
38 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)))
+
View
3  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 <xach@xach.com>"
@@ -42,6 +42,7 @@
(:file "utils")
(:file "crypto")
(:file "xml-binding")
+ (:file "xml-output")
(:file "credentials")
(:file "post")
(:file "redirects")
Please sign in to comment.
Something went wrong with that request. Please try again.