Skip to content

Commit

Permalink
Support object storage classes.
Browse files Browse the repository at this point in the history 
- PUT-OBJECT (and derivatives), COPY-OBJECT updated to take an
  additional storage-class keyword parameter defaulting to "STANDARD"

- New function SET-STORAGE-CLASS changes an existing object's storage
  class with COPY-OBJECT

- New key-object attribute function STORAGE-CLASS returns the storage
  class of an object

- Docs updated where needed
  • Loading branch information
@xach
xach committed Jan 19, 2012
1 parent 92af45e commit 17ea3c9
Show file tree
Hide file tree
Showing 5 changed files with 113 additions and 15 deletions.
6 changes: 4 additions & 2 deletions bucket-listing.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -141,7 +141,8 @@
(defun key-binding-key (binding)
(alist-bind (key
last-modified etag size
owner-id owner-display-name)
owner-id owner-display-name
storage-class)
binding
(make-instance 'key
:name key
Expand All @@ -151,7 +152,8 @@
:owner (when owner-id
(make-instance 'person
:id owner-id
:display-name owner-display-name)))))
:display-name owner-display-name))
:storage-class storage-class)))

(defmethod specialized-initialize ((response bucket-listing) source)
(let* ((bindings (xml-bind *list-bucket-binder* source))
Expand Down
73 changes: 71 additions & 2 deletions doc/index.html
View file
Original file line number Diff line number Diff line change
Expand Up @@ -438,7 +438,8 @@ <h2>Contents</h2>
<a href='#size'><tt>SIZE</tt></a>,
<a href='#etag'><tt>ETAG</tt></a>,
<a href='#last-modified'><tt>LAST-MODIFIED</tt></a>,
and <a href='#owner'><tt>OWNER</tt></a>.
<a href='#owner'><tt>OWNER</tt>, and
<a href='#storage-class'><tt>STORAGE-CLASS</tt></a></a>.

<p>This function is built
on <a href='#query-bucket'><tt>QUERY-BUCKET</tt></a> and may
Expand Down Expand Up @@ -875,6 +876,23 @@ <h2>Contents</h2>
</div>


<div class='item'>
<div class='type'><a name='storage-class'>[Function]</a></div>
<div class='signature'>
<code class='name'>storage-class</code>
<span class='args'>
<var>key-object</var>
</span>
<span class='result'>=> <var>storage-class</var></span>
</div>

<blockquote class='description'>
<p>Returns the storage class of <var>key-object</var>.
</blockquote>
</div>





<a name='object-ops'><h3>Operations on Objects</h3></a>
Expand Down Expand Up @@ -1057,6 +1075,7 @@ <h2>Contents</h2>
<var>content-disposition</var>
<var>content-type</var>
<var>expires</var>
<var>storage-class</var>
<var>credentials</var>
</span>
<span class='result'>=> |</span>
Expand Down Expand Up @@ -1113,7 +1132,14 @@ <h2>Contents</h2>
GET or HEAD requests. If <i>content-type</i> is not set, it
defaults to "binary/octet-stream". The others default to
NIL. If <i>expires</i> is provided, it should be a universal time.
</blockquote>

<p>If provided, <var>storage-class</var> should refer to one of
the standard storage classes available for S3; currently the
accepted values are the strings "STANDARD" and
"REDUCED_REDUNDANCY". Using other values may trigger an API error
from S3. For more information about reduced redundancy storage,
see <a href="http://docs.amazonwebservices.com/AmazonS3/latest/dev/Introduction.html#RRS">Reduced
Redundancy Storage</a> in the Developer Guide.
</div>

<div class='item'>
Expand All @@ -1131,6 +1157,7 @@ <h2>Contents</h2>
<var>content-encoding</var>
<var>content-type</var>
<var>expires</var>
<var>storage-class</var>
<var>credentials</var>
</span>
<span class='result'>=> |</span>
Expand Down Expand Up @@ -1166,6 +1193,7 @@ <h2>Contents</h2>
<var>content-encoding</var>
<var>content-type</var>
<var>expires</var>
<var>storage-class</var>
<var>credentials</var>
</span>
<span class='result'>=> |</span>
Expand Down Expand Up @@ -1198,6 +1226,7 @@ <h2>Contents</h2>
<var>public</var> <var>metadata</var>
<var>content-disposition</var> <var>content-encoding</var> <var>content-type</var>
<var>expires</var>
<var>storage-class</var>
<var>credentials</var>
</span>
<span class='result'>=> |</span>
Expand Down Expand Up @@ -1238,6 +1267,7 @@ <h2>Contents</h2>
<var>public</var> <var>metadata</var>
<var>content-disposition</var> <var>content-encoding</var> <var>content-type</var>
<var>expires</var>
<var>storage-class</var>
<var>credentials</var>
</span>
<span class='result'>=> |</span>
Expand Down Expand Up @@ -1285,6 +1315,7 @@ <h2>Contents</h2>
<var>when-modified-since</var>
<var>unless-modified-since</var> <br>
<var>metadata</var> <var>public</var> <var>precondition-errors</var>
<var>storage-class</var>
<var>credentials</var>
</span>
<span class='result'>=> |</span>
Expand Down Expand Up @@ -1315,6 +1346,14 @@ <h2>Contents</h2>
with <a href='#put-object'><tt>PUT-OBJECT</tt></a>. Passing NIL
means that the new object has no metadata. Otherwise, the metadata
is copied from the original object.

<p>If <var>storage-class</var> is provided, it should refer to one
of the standard storage classes available for S3; currently the
accepted values are the strings "STANDARD" and
"REDUCED_REDUNDANCY". Using other values may trigger an API error
from S3. For more information about reduced redundancy storage,
see <a href="http://docs.amazonwebservices.com/AmazonS3/latest/dev/Introduction.html#RRS">Reduced
Redundancy Storage</a> in the Developer Guide.
</blockquote>
</div>

Expand Down Expand Up @@ -1410,6 +1449,36 @@ <h2>Contents</h2>
</blockquote>
</div>

<div class='item'>
<div class='type'><a name='set-storage-class'>[Function]</a></div>
<div class='signature'>
<code class='name'>set-storage-class</code>
<span class='args'>
<var>bucket</var>
<var>key</var>
<var>storage-class</var>
<code class='llkw'>&amp;key</code>
<var>credentials</var>
</span>
<span class='result'>=> |</span>
</div>

<blockquote class='description'>
<p>Sets the storage class of the object identified
by <var>bucket</var> and <var>key</var>
to <var>storage-class</var>. This is a convenience function that
uses <a href='#copy-object'><tt>COPY-OBJECT</tt></a> to make
storage class changes.

<p>The storage class of an object can be determined by querying
the bucket with <a href='#all-keys'><tt>ALL-KEYS</tt></a>
or <a href='#query-bucket'><tt>QUERY-BUCKET</tt></a> and
using <a href='#storage-class'><tt>STORAGE-CLASS</tt></a> on one
of the resulting key objects.
</blockquote>
</div>



<a name='access-control'><h3>Access Control</h3></a>

Expand Down
38 changes: 30 additions & 8 deletions interface.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -322,6 +322,7 @@ constraint."
content-disposition
expires
content-type
(storage-class "STANDARD")
((:credentials *credentials*) *credentials*))
(let ((content
(etypecase object
Expand All @@ -332,12 +333,16 @@ constraint."
((or vector pathname) object)))
(content-length t)
(policy-header (access-policy-header access-policy public)))
(setf storage-class (or storage-class "STANDARD"))
(submit-request (make-instance 'request
:method :put
:bucket bucket
:key key
:metadata metadata
:amz-headers policy-header
:amz-headers
(append policy-header
(list (cons "storage-class"
storage-class)))
:extra-http-headers
(parameters-alist
:cache-control cache-control
Expand All @@ -360,6 +365,7 @@ constraint."
content-disposition
(content-type "binary/octet-stream")
expires
storage-class
((:credentials *credentials*) *credentials*))
(when (or start end)
(setf vector (subseq vector (or start 0) end)))
Expand All @@ -371,7 +377,8 @@ constraint."
:content-encoding content-encoding
:content-disposition content-disposition
:content-type content-type
:expires expires))
:expires expires
:storage-class storage-class))

(defun put-string (string bucket key &key
start end
Expand All @@ -384,6 +391,7 @@ constraint."
content-disposition
(content-type "text/plain")
expires
storage-class
((:credentials *credentials*) *credentials*))
(when (or start end)
(setf string (subseq string (or start 0) end)))
Expand All @@ -396,7 +404,8 @@ constraint."
:content-encoding content-encoding
:content-type content-type
:cache-control cache-control
:string-external-format external-format))
:string-external-format external-format
:storage-class storage-class))


(defun put-file (file bucket key &key
Expand All @@ -409,6 +418,7 @@ constraint."
content-encoding
(content-type "binary/octet-stream")
expires
storage-class
((:credentials *credentials*) *credentials*))
(when (eq key t)
(setf key (file-namestring file)))
Expand All @@ -424,7 +434,8 @@ constraint."
:content-disposition content-disposition
:content-encoding content-encoding
:content-type content-type
:expires expires)))
:expires expires
:storage-class storage-class)))

(defun put-stream (stream bucket key &key
(start 0) end
Expand All @@ -436,6 +447,7 @@ constraint."
content-encoding
(content-type "binary/octet-stream")
expires
storage-class
((:credentials *credentials*) *credentials*))
(let ((content (stream-subset-vector stream start end)))
(put-object content bucket key
Expand All @@ -446,7 +458,8 @@ constraint."
:content-disposition content-disposition
:content-encoding content-encoding
:content-type content-type
:expires expires)))
:expires expires
:storage-class storage-class)))


;;; Delete & copy objects
Expand Down Expand Up @@ -526,6 +539,7 @@ constraint."
access-policy
public
precondition-errors
(storage-class "STANDARD")
((:credentials *credentials*) *credentials*))
"Copy the object identified by FROM-BUCKET/FROM-KEY to
TO-BUCKET/TO-KEY.
Expand All @@ -551,8 +565,6 @@ users. Otherwise, a default ACL is present on the new object.
(error "FROM-BUCKET is required"))
(unless from-key
(error "FROM-KEY is required"))
(unless (or to-bucket to-key)
(error "Can't copy an object to itself."))
(setf to-bucket (or to-bucket from-bucket))
(setf to-key (or to-key from-key))
(handler-bind ((precondition-failed
Expand All @@ -564,6 +576,7 @@ users. Otherwise, a default ACL is present on the new object.
(parameters-alist :copy-source (format nil "~A/~A"
(url-encode (name from-bucket))
(url-encode (name from-key)))
:storage-class storage-class
:metadata-directive
(if metadata-supplied-p "REPLACE" "COPY")
:copy-source-if-match when-etag-matches
Expand Down Expand Up @@ -601,6 +614,16 @@ users. Otherwise, a default ACL is present on the new object.
collect (cons meta value))))))


;;; Convenience bit for storage class

(defun set-storage-class (bucket key storage-class &key
((:credentials *credentials*) *credentials*))
"Set the storage class of the object identified by BUCKET and KEY to
STORAGE-CLASS."
(copy-object :from-bucket bucket :from-key key
:storage-class storage-class))


;;; ACL twiddling

(defparameter *public-read-grant*
Expand Down Expand Up @@ -655,7 +678,6 @@ users. Otherwise, a default ACL is present on the new object.
(put-acl owner grants :bucket bucket :key key)))



;;; Logging

(defparameter *log-delivery-grants*
Expand Down
5 changes: 4 additions & 1 deletion objects.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -71,7 +71,10 @@
:accessor size)
(owner
:initarg :owner
:accessor owner)))
:accessor owner)
(storage-class
:initarg :storage-class
:accessor storage-class)))

(defmethod print-object ((key key) stream)
(print-unreadable-object (key stream :type t)
Expand Down
6 changes: 4 additions & 2 deletions package.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,8 @@
#:last-modified
#:etag
#:size
#:owner)
#:owner
#:storage-class)
;; Objects
(:export #:get-object
#:get-vector
Expand All @@ -72,7 +73,8 @@
#:delete-object
#:delete-objects
#:delete-all-objects
#:object-metadata)
#:object-metadata
#:set-storage-class)
;; Access Control
(:export #:get-acl
#:put-acl
Expand Down

0 comments on commit 17ea3c9

Please sign in to comment.