factor: add newlines to .factor files

[factor.git] / extra / s3 / s3.factor

diff --git a/extra/s3/s3.factor b/extra/s3/s3.factor
index faeb8df2ecb6217b474945c9096a3cca3f62d4ad..8dac6ba26d474307f34623474ccad79a3b75cac5 100644 (file)
--- a/extra/s3/s3.factor
+++ b/extra/s3/s3.factor
@@ -1,32 +1,17 @@
 ! Copyright (C) 2009 Chris Double. All Rights Reserved.
 ! See http://factorcode.org/license.txt for BSD license.
-USING:
-    accessors
-    assocs
-    base64
-    calendar
-    calendar.format
-    checksums.hmac
-    checksums.sha
-    combinators
-    http
-    http.client
-    kernel
-    make
-    math.order
-    namespaces
-    sequences
-    sorting
-    strings
-    xml
-    xml.traversal
-;
+USING: accessors assocs base64 calendar calendar.format
+calendar.parser checksums.hmac checksums.sha combinators http
+http.client kernel make math.order namespaces sequences
+sorting sorting.slots strings xml xml.traversal ;
 IN: s3
 
 SYMBOL: key-id
 SYMBOL: secret-key
 
-TUPLE: s3-request path mime-type date method headers  bucket data ;
+<PRIVATE
+
+TUPLE: s3-request path mime-type date method headers bucket data ;
 
 : hashtable>headers ( hashtable -- seq )
     [
@@ -35,7 +20,7 @@ TUPLE: s3-request path mime-type date method headers  bucket data ;
 
 : signature ( s3-request -- string )
     [
-        { 
+        {
             [ method>> % "\n" % "\n" % ]
             [ mime-type>> % "\n" % ]
             [ date>> timestamp>rfc822 % "\n" % ]
@@ -52,12 +37,12 @@ TUPLE: s3-request path mime-type date method headers  bucket data ;
         ":" %
         signature secret-key get sha1 hmac-bytes >base64 %
     ] "" make ;
-  
+
 : s3-url ( s3-request -- string )
-    [ 
-        "http://" % 
-        dup bucket>> [ % "." % ] when* 
-        "s3.amazonaws.com" %  
+    [
+        "http://" %
+        dup bucket>> [ % "." % ] when*
+        "s3.amazonaws.com" %
         path>> %
     ] "" make ;
 
@@ -74,80 +59,83 @@ TUPLE: s3-request path mime-type date method headers  bucket data ;
     swap sign "Authorization" set-header ;
 
 : s3-get ( bucket path headers -- request data )
-    "GET" <s3-request> dup s3-url <get-request> 
+    "GET" <s3-request> dup s3-url <get-request>
     sign-http-request http-request ;
 
 : s3-put ( data bucket path headers -- request data )
-    "PUT" <s3-request> dup s3-url swapd <put-request> 
+    "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 
+    "Buckets" tag-named
     "Bucket" tags-named [
-        [ "Name" tag-named children>string ] 
+        [ "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) ;
 
+: sorted-buckets ( -- seq )
+    buckets { { date>> rfc3339>timestamp <=> } } sort-by ;
+
+<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 ]
-      [ "LastModified" tag-named children>string ]
-      [ "Size" tag-named children>string ]
-      tri key boa
-  ] map ;
- 
+        [ "Key" tag-named children>string ]
+        [ "LastModified" tag-named children>string ]
+        [ "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 )
-    s3-request new
-        swap "/" prepend >>path
-        swap >>bucket
-    s3-url http-get ;
+: get-object ( bucket key -- response data )
+    "/" prepend H{ } clone s3-get ;
 
 : create-bucket ( bucket -- )
     "" swap "/" H{ } clone "PUT" <s3-request>
     "application/octet-stream" >>mime-type
     dup s3-url swapd <put-request>
-    0 "content-length" set-header 
+    0 "content-length" set-header
     sign-http-request
     http-request 2drop ;
 
 : delete-bucket ( bucket -- )
     "/" H{ } clone "DELETE" <s3-request>
     dup s3-url <delete-request> sign-http-request http-request 2drop ;
- 
-: put-object ( object type bucket key headers -- )
-    [ "/" prepend ] dip "PUT" <s3-request> 
+
+: put-object ( data mime-type bucket key headers -- )
+    [ "/" prepend ] dip "PUT" <s3-request>
     over >>mime-type
     [ <post-data> swap >>data ] dip
-    dup s3-url swapd <put-request> 
+    dup s3-url swapd <put-request>
     dup header>> pick headers>> assoc-union >>header
-    sign-http-request 
+    sign-http-request
     http-request 2drop ;
 
 : delete-object ( bucket key -- )
     "/" prepend H{ } clone "DELETE" <s3-request>
     dup s3-url <delete-request> sign-http-request http-request 2drop ;
 
-! "testbucket" create-bucket
-! "testbucket" delete-bucket
-! buckets
-! "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...
+: bucket>alist ( bucket -- alist )
+    dup keys
+    [ name>> get-object nip ] with zip-with ;
+