s3: Fix get-object to allow signing. Add sorted-bucket to sort by time.

paths
Doug Coleman 2018-06-14 19:43:18 -05:00
parent a33128a4b3
commit 042bbccd1a
1 changed files with 13 additions and 26 deletions

View File

@ -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 ;