Fix :public t support, and test it.

xach · Jun 22, 2016 · 6ea7341 · 6ea7341
1 parent 17fdbe8
commit 6ea7341
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 19 deletions.
diff --git a/interface.lisp b/interface.lisp
@@ -332,17 +332,17 @@ constraint."
 
 
 (defun put-object (object bucket key &key
-                   access-policy
-                   public
-                   metadata
-                   (string-external-format :utf-8)
-                   cache-control
-                   content-encoding
-                   content-disposition
-                   expires
-                   content-type
-                   (storage-class "STANDARD")
-                   ((:credentials *credentials*) *credentials*))
+                                       access-policy
+                                       public
+                                       metadata
+                                       (string-external-format :utf-8)
+                                       cache-control
+                                       content-encoding
+                                       content-disposition
+                                       expires
+                                       content-type
+                                       (storage-class "STANDARD")
+                                       ((:credentials *credentials*) *credentials*))
   (let ((content
          (etypecase object
            (string
@@ -353,16 +353,16 @@ constraint."
         (content-length t)
         (policy-header (access-policy-header access-policy public))
         (security-token (security-token *credentials*)))
-    (declare (ignore policy-header))
     (setf storage-class (or storage-class "STANDARD"))
     (submit-request (make-instance 'request
                                    :method :put
                                    :bucket bucket
                                    :key key
                                    :metadata metadata
                                    :amz-headers
-                                   (when security-token
-                                     (list (cons "security-token" security-token)))
+                                   (append policy-header
+                                           (when security-token
+                                             (list (cons "security-token" security-token))))
                                    :extra-http-headers
                                    (parameters-alist
                                     :cache-control cache-control

diff --git a/tests.lisp b/tests.lisp
@@ -39,20 +39,17 @@
          ";;; ")
 
 (defparameter *jenny* (octet-vector 8 6 7 5 3 0 9))
-(put-vector *jenny* *test-bucket* "jenny" :start 1 :end 6)
+(put-vector *jenny* *test-bucket* "jenny" :start 1 :end 6 :public t)
 
 (equalp (get-vector *test-bucket* "jenny")
         (subseq *jenny* 1 6))
 
+(drakma:http-request (resource-url :bucket *test-bucket* :key "jenny"))
 
 (delete-object *test-bucket* "hello")
 (delete-object *test-bucket* "self")
 (delete-object *test-bucket* "jenny")
 
-
-;;; Testing signing issues
-
-(put-string "Slashdot" *test-bucket* "slash/dot")
 (put-string "Tildedot" *test-bucket* "slash~dot")
 (put-string "Spacedot" *test-bucket* "slash dot")