Merge branch 'master' into experimental

[factor.git] / basis / http / client / client.factor

diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor
index e7305ed372b96d00023eb40536f948326a338c19..d4d09789121241135a07db213c626402286db432 100644 (file)
--- a/basis/http/client/client.factor
+++ b/basis/http/client/client.factor
@@ -82,7 +82,7 @@ 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 )
@@ -105,7 +105,9 @@ SYMBOL: redirects
     request get url>> url-addr ascii <client> drop
     1 minutes over set-timeout ;
 
-: (with-http-request) ( request quot: ( chunk -- ) -- response )
+PRIVATE>
+
+: with-http-request ( request quot: ( chunk -- ) -- response )
     swap
     request [
         <request-socket> [
@@ -136,17 +138,27 @@ PRIVATE>
 
 : success? ( code -- ? ) 200 299 between? ;
 
-ERROR: download-failed response ;
+ERROR: download-failed response data ;
+
+M: download-failed error.
+    "HTTP request failed:" print nl
+    [ 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 ] with-destructors ; inline
 
 : 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 ;
+
+: <client-data-request> ( data url -- request )
+    <client-request> swap >>post-data ;
 
 : <get-request> ( url -- request )
     "GET" <client-request> ;
@@ -155,7 +167,19 @@ ERROR: download-failed response ;
     <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 ;
+
+: http-delete ( url -- response data )
+    <delete-request> http-request ;
+
+: <trace-request> ( url -- request )
+    <client-request> "TRACE" >>method ;
+
+: http-trace ( url -- response data )
+    <trace-request> http-request ;
 
 : download-name ( url -- name )
     present file-name "?" split1 drop "/" ?tail drop ;