From 6ea73410e975cfeb401dd780a65ff166f76da347 Mon Sep 17 00:00:00 2001
From: Zach Beane <xach@xach.com>
Date: Wed, 22 Jun 2016 10:47:05 -0400
Subject: [PATCH] Fix :public t support, and test it.

---
 interface.lisp | 28 ++++++++++++++--------------
 tests.lisp     |  7 ++-----
 2 files changed, 16 insertions(+), 19 deletions(-)

diff --git a/interface.lisp b/interface.lisp
index 8b137e9..a04131d 100644
--- 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,7 +353,6 @@ 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
@@ -361,8 +360,9 @@ constraint."
                                    :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
index 981401f..42b9ba2 100644
--- 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")