: signature ( s3-request -- string )
[
- {
+ {
[ method>> % "\n" % "\n" % ]
[ mime-type>> % "\n" % ]
[ date>> timestamp>rfc822 % "\n" % ]
: s3-url ( s3-request -- string )
[
- "http://" %
- dup bucket>> [ % "." % ] when*
+ "http://" %
+ dup bucket>> [ % "." % ] when*
"s3.amazonaws.com" %
path>> %
] "" make ;
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>
<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) ;
"" 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 ;
dup s3-url <delete-request> sign-http-request http-request 2drop ;
: put-object ( data mime-type bucket key headers -- )
- [ "/" prepend ] dip "PUT" <s3-request>
+ [ "/" 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 -- )