Merge branch 's3' of git://double.co.nz/git/factor

extra/s3/s3-docs.factor

@@ -0,0 +1,120 @@
+! Copyright (C) 2009 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: s3
+
+HELP: buckets
+{ $values 
+  { "seq" "a sequence of " { $link bucket } " objects" } 
+}
+{ $description 
+    "Returns a list of " { $link bucket } " objects containing data on the buckets available on S3."}
+{ $examples
+  { $unchecked-example "USING: s3 ;" "buckets ." "{ }" }
+}
+;
+
+HELP: create-bucket
+{ $values 
+  { "bucket" "a string" } 
+}
+{ $description 
+    "Creates a bucket with the given name."
+} 
+{ $examples
+  { $unchecked-example "USING: s3 ;" "\"testbucket\" create-bucket" "" }
+}
+;
+
+HELP: delete-bucket
+{ $values 
+  { "bucket" "a string" } 
+}
+{ $description 
+    "Deletes the bucket with the given name."
+} 
+{ $examples
+  { $unchecked-example "USING: s3 ;" "\"testbucket\" delete-bucket" "" }
+}
+;
+
+HELP: keys
+{ $values 
+  { "bucket" "a string" } 
+  { "seq" "a sequence of " { $link key } " objects"} 
+}
+{ $description 
+    "Returns a sequence of " { $link key } " objects. Each object in the sequence has information about the keys contained within the bucket."
+} 
+{ $examples
+  { $unchecked-example "USING: s3 ;" "\"testbucket\" keys . " "{ }" }
+}
+;
+
+HELP: get-object
+{ $values 
+  { "bucket" "a string" } 
+  { "key" "a string" } 
+  { "response" "The HTTP response object"} 
+  { "data" "The data returned from the http request"} 
+}
+{ $description 
+    "Does an HTTP request to retrieve the object in the bucket with the given key."
+} 
+{ $examples
+  { $unchecked-example "USING: s3 ;" "\"testbucket\" \"mykey\" http-get " "" }
+}
+;
+
+HELP: put-object
+{ $values 
+  { "data" "an object" } 
+  { "mime-type" "a string" } 
+  { "bucket" "a string"} 
+  { "key" "a string"} 
+  { "headers" "an assoc"} 
+}
+{ $description 
+    "Stores the object under the key in the given bucket. The object has "
+"the given mimetype. 'headers' should contain key/values for any headers to "
+"be associated with the object. 'data' is any Factor object that can be "
+"used as the 'data' slot in <post-data>. If it's a <pathname> it stores "
+"the contents of the file. If it's a stream, it's the contents of the "
+"stream, etc."
+} 
+{ $examples
+  { $unchecked-example "USING: s3 ;" "\"hello\" binary encode \"text/plain\" \"testbucket\" \"hello.txt\" H{ { \"x-amz-acl\" \"public-read\" } } put-object" "" }
+  { $unchecked-example "USING: s3 ;" "\"hello.txt\" <pathname> \"text/plain\" \"testbucket\" \"hello.txt\" H{ { \"x-amz-acl\" \"public-read\" } } put-object" "" }
+}
+;
+
+HELP: delete-object
+{ $values 
+  { "bucket" "a string"} 
+  { "key" "a string"} 
+}
+{ $description 
+    "Deletes the object in the bucket with the given key."
+} 
+{ $examples
+  { $unchecked-example "USING: s3 ;" "\"testbucket\" \"mykey\" delete-object" "" }
+}
+;
+
+ARTICLE: "s3" "Amazon S3"
+"The " { $vocab-link "s3" } " vocabulary provides a wrapper to the Amazon "
+"Simple Storage Service API."
+$nl
+"To use the api you must set the variables " { $link key-id } " and " 
+{ $link secret-key } " to your Amazon S3 key and secret key respectively. Once "
+"this is done you can call any of the words below."
+{ $subsection buckets }
+{ $subsection create-bucket }
+{ $subsection delete-bucket }
+{ $subsection keys }
+{ $subsection get-object }
+{ $subsection put-object }
+{ $subsection delete-object }
+;
+
+ABOUT: "s3"

extra/s3/s3.factor

@@ -26,6 +26,8 @@ IN: s3
 SYMBOL: key-id
 SYMBOL: secret-key
 
+<PRIVATE
+
 TUPLE: s3-request path mime-type date method headers  bucket data ;
 
 : hashtable>headers ( hashtable -- seq )
@@ -81,23 +83,31 @@ TUPLE: s3-request path mime-type date method headers  bucket data ;
     "PUT" <s3-request> dup s3-url swapd <put-request> 
     sign-http-request http-request ;
 
+PRIVATE>
+
 TUPLE: bucket name date ;
 
+<PRIVATE
+
 : (buckets) ( xml -- seq )
     "Buckets" tag-named 
     "Bucket" tags-named [
         [ "Name" tag-named children>string ] 
         [ "CreationDate" tag-named children>string ] bi bucket boa
     ] map ;
+PRIVATE>
  
 : buckets ( -- seq )
     f "/" H{ } clone s3-get nip >string string>xml (buckets) ;
 
+<PRIVATE
 : bucket-url ( bucket -- string )
     [ "http://" % % ".s3.amazonaws.com/" % ] "" make ;
+PRIVATE>
 
 TUPLE: key name last-modified size ;
 
+<PRIVATE
 : (keys) ( xml -- seq )
     "Contents" tags-named [
       [ "Key" tag-named children>string ]
@@ -105,12 +115,13 @@ TUPLE: key name last-modified size ;
       [ "Size" tag-named children>string ]
       tri key boa
   ] map ;
+PRIVATE>
  
 : keys ( bucket -- seq )
     "/" H{ } clone s3-get
     nip >string string>xml (keys) ;
 
-: object-get ( bucket key -- response data )
+: get-object ( bucket key -- response data )
     s3-request new
         swap "/" prepend >>path
         swap >>bucket
@@ -128,7 +139,7 @@ TUPLE: key name last-modified size ;
     "/" H{ } clone "DELETE" <s3-request>
     dup s3-url <delete-request> sign-http-request http-request 2drop ;
  
-: put-object ( object type bucket key headers -- )
+: put-object ( data mime-type bucket key headers -- )
     [ "/" prepend ] dip "PUT" <s3-request> 
     over >>mime-type
     [ <post-data> swap >>data ] dip
@@ -137,13 +148,6 @@ TUPLE: key name last-modified size ;
     sign-http-request 
     http-request 2drop ;
 
-! "testbucket" create-bucket
+: delete-object ( bucket key -- )
-! "testbucket" delete-bucket
+    "/" prepend H{ } clone "DELETE" <s3-request>
-! buckets
+    dup s3-url <delete-request> sign-http-request http-request 2drop ;
-! "testbucket" keys 
-! "hello world" binary encode "text/plain" "testbucket" "hello.txt" 
-! H{ { "x-amz-acl" "public-read" } } put-object
-! "hello.txt" <pathname> "text/plain" "testbucket" "hello.txt" 
-! H{ { "x-amz-acl" "public-read" } } put-object
-! "testbucket" "hello.txt" object-get
-! Need to write docs...