s3: Fix get-object to allow signing. Add sorted-bucket to sort by time.
							parent
							
								
									a33128a4b3
								
							
						
					
					
						commit
						042bbccd1a
					
				|  | @ -1,26 +1,9 @@ | ||||||
| ! Copyright (C) 2009 Chris Double. All Rights Reserved. | ! Copyright (C) 2009 Chris Double. All Rights Reserved. | ||||||
| ! See http://factorcode.org/license.txt for BSD license. | ! See http://factorcode.org/license.txt for BSD license. | ||||||
| USING: | USING: accessors assocs base64 calendar calendar.format | ||||||
|     accessors | calendar.parser checksums.hmac checksums.sha combinators http | ||||||
|     assocs | http.client kernel make math.order namespaces sequences | ||||||
|     base64 | sequences.extras sorting sorting.slots strings xml xml.traversal ; | ||||||
|     calendar |  | ||||||
|     calendar.format |  | ||||||
|     checksums.hmac |  | ||||||
|     checksums.sha |  | ||||||
|     combinators |  | ||||||
|     http |  | ||||||
|     http.client |  | ||||||
|     kernel |  | ||||||
|     make |  | ||||||
|     math.order |  | ||||||
|     namespaces |  | ||||||
|     sequences |  | ||||||
|     sorting |  | ||||||
|     strings |  | ||||||
|     xml |  | ||||||
|     xml.traversal |  | ||||||
| ; |  | ||||||
| IN: s3 | IN: s3 | ||||||
| 
 | 
 | ||||||
| SYMBOL: key-id | SYMBOL: key-id | ||||||
|  | @ -100,6 +83,9 @@ PRIVATE> | ||||||
| : buckets ( -- seq ) | : buckets ( -- seq ) | ||||||
|     f "/" H{ } clone s3-get nip >string string>xml (buckets) ; |     f "/" H{ } clone s3-get nip >string string>xml (buckets) ; | ||||||
| 
 | 
 | ||||||
|  | : sorted-buckets ( -- seq ) | ||||||
|  |     buckets { { date>> rfc3339>timestamp <=> } } sort-by ; | ||||||
|  | 
 | ||||||
| <PRIVATE | <PRIVATE | ||||||
| : bucket-url ( bucket -- string ) | : bucket-url ( bucket -- string ) | ||||||
|     [ "http://" % % ".s3.amazonaws.com/" % ] "" make ; |     [ "http://" % % ".s3.amazonaws.com/" % ] "" make ; | ||||||
|  | @ -122,10 +108,7 @@ PRIVATE> | ||||||
|     nip >string string>xml (keys) ; |     nip >string string>xml (keys) ; | ||||||
| 
 | 
 | ||||||
| : get-object ( bucket key -- response data ) | : get-object ( bucket key -- response data ) | ||||||
|     s3-request new |     "/" prepend H{ } clone s3-get ; | ||||||
|         swap "/" prepend >>path |  | ||||||
|         swap >>bucket |  | ||||||
|     s3-url http-get ; |  | ||||||
| 
 | 
 | ||||||
| : create-bucket ( bucket -- ) | : create-bucket ( bucket -- ) | ||||||
|     "" swap "/" H{ } clone "PUT" <s3-request> |     "" swap "/" H{ } clone "PUT" <s3-request> | ||||||
|  | @ -151,3 +134,7 @@ PRIVATE> | ||||||
| : delete-object ( bucket key -- ) | : delete-object ( bucket key -- ) | ||||||
|     "/" prepend H{ } clone "DELETE" <s3-request> |     "/" prepend H{ } clone "DELETE" <s3-request> | ||||||
|     dup s3-url <delete-request> sign-http-request http-request 2drop ; |     dup s3-url <delete-request> sign-http-request http-request 2drop ; | ||||||
|  | 
 | ||||||
|  | : bucket>alist ( bucket -- alist ) | ||||||
|  |     dup keys | ||||||
|  |     [ name>> get-object nip ] with map-zip ; | ||||||
		Loading…
	
		Reference in New Issue