[ >post-data ] change-post-data ;
: write-post-data ( request -- request )
- dup method>> "POST" = [ dup post-data>> raw>> write ] when ;
+ dup method>> [ "POST" = ] [ "PUT" = ] bi or
+ [ dup post-data>> [ raw>> write ] when* ] when ;
: write-request ( request -- )
unparse-post-data
<PRIVATE
-DEFER: (with-http-request)
+DEFER: with-http-request
SYMBOL: redirects
redirects get max-redirects < [
request get clone
swap "location" header redirect-url
- "GET" >>method swap (with-http-request)
+ "GET" >>method swap with-http-request
] [ too-many-redirects ] if ; inline recursive
: read-chunk-size ( -- n )
request get url>> url-addr ascii <client> drop
1 minutes over set-timeout ;
-: (with-http-request) ( request quot: ( chunk -- ) -- response )
+: with-http-request ( request quot: ( chunk -- ) -- response )
swap
request [
<request-socket> [
: success? ( code -- ? ) 200 299 between? ;
-ERROR: download-failed response ;
+ERROR: download-failed response data ;
M: download-failed error.
"HTTP request failed:" print nl
- response>> . ;
+ [ response>> . ] [ data>> . ] bi ;
-: check-response ( response -- response )
- dup code>> success? [ download-failed ] unless ;
+: check-response* ( response data -- response data )
+ over code>> success? [ download-failed ] unless ;
-: with-http-request ( request quot -- response )
- (with-http-request) check-response ; inline
+: check-response ( response -- response )
+ f check-response* drop ;
: http-request ( request -- response data )
[ [ % ] with-http-request ] B{ } make
- over content-charset>> decode ;
+ over content-charset>> decode check-response* ;
: <client-request> ( url -- request )
<request> swap >url ensure-port >>url ;
<get-request> http-request ;
: with-http-get ( url quot -- response )
- [ <get-request> ] dip with-http-request ; inline
+ [ <get-request> ] dip with-http-request check-response ; inline
: <delete-request> ( url -- request )
<client-request> "DELETE" >>method ;