http.client: adding variants of http-methods that check the response code.

basis/http/client/client-docs.factor

@@ -55,41 +55,81 @@ HELP: http-get
 { $description "Downloads the contents of a URL." }
 { $errors "Throws an error if the HTTP request fails." } ;
 
+HELP: http-get*
+{ $values { "url" "a " { $link url } " or " { $link string } } { "data" sequence } }
+{ $description "A variant of " { $link http-get } " that checks that the response was successful." }
+{ $errors "Throws an error if the HTTP request fails or is not successful." } ;
+
 HELP: http-post
 { $values { "post-data" object } { "url" "a " { $link url } " or " { $link string } } { "response" response } { "data" sequence } }
 { $description "Submits an HTTP POST request." }
 { $errors "Throws an error if the HTTP request fails." } ;
 
+HELP: http-post*
+{ $values { "post-data" object } { "url" "a " { $link url } " or " { $link string } } { "data" sequence } }
+{ $description "A variant of " { $link http-post } " that checks that the response was successful." }
+{ $errors "Throws an error if the HTTP request fails or is not successful." } ;
+
 HELP: http-put
 { $values { "post-data" object } { "url" "a " { $link url } " or " { $link string } } { "response" response } { "data" sequence } }
 { $description "Submits an HTTP PUT request." }
 { $errors "Throws an error if the HTTP request fails." } ;
 
+HELP: http-put*
+{ $values { "post-data" object } { "url" "a " { $link url } " or " { $link string } } { "data" sequence } }
+{ $description "A variant of " { $link http-put } " that checks that the response was successful." }
+{ $errors "Throws an error if the HTTP request fails or is not successful." } ;
+
 HELP: http-head
 { $values { "url" "a " { $link url } " or " { $link string } } { "response" response } { "data" sequence } }
 { $description "Same as " { $link http-get } " except that the server is not supposed to return a message-body in the response, as per RFC2616. However in practise, most web servers respond to GET and HEAD method calls with identical responses." }
 { $errors "Throws an error if the HTTP request fails." } ;
- 
+
+HELP: http-head*
+{ $values { "url" "a " { $link url } " or " { $link string } } { "data" sequence } }
+{ $description "A variant of " { $link http-head } " that checks that the response was successful." }
+{ $errors "Throws an error if the HTTP request fails or is not successful." } ;
+
 HELP: http-delete
 { $values { "url" "a " { $link url } " or " { $link string } } { "response" response } { "data" sequence } }
 { $description "Requests that the origin server delete the resource identified by the URL." }
 { $errors "Throws an error if the HTTP request fails." } ;
 
+HELP: http-delete*
+{ $values { "url" "a " { $link url } " or " { $link string } } { "data" sequence } }
+{ $description "A variant of " { $link http-delete } " that checks that the response was successful." }
+{ $errors "Throws an error if the HTTP request fails or is not successful." } ;
+
 HELP: http-options
 { $values { "url" "a " { $link url } " or " { $link string } } { "response" response } { "data" sequence } }
 { $description "Submits an HTTP OPTIONS request." }
 { $errors "Throws an error if the HTTP request fails." } ;
 
+HELP: http-options*
+{ $values { "url" "a " { $link url } " or " { $link string } } { "data" sequence } }
+{ $description "A variant of " { $link http-options } " that checks that the response was successful." }
+{ $errors "Throws an error if the HTTP request fails or is not successful." } ;
+
 HELP: http-trace
 { $values { "url" "a " { $link url } " or " { $link string } } { "response" response } { "data" sequence } }
 { $description "Submits an HTTP TRACE request." }
 { $errors "Throws an error if the HTTP request fails." } ;
 
+HELP: http-trace*
+{ $values { "url" "a " { $link url } " or " { $link string } } { "data" sequence } }
+{ $description "A variant of " { $link http-trace } " that checks that the response was successful." }
+{ $errors "Throws an error if the HTTP request fails or is not successful." } ;
+
 HELP: with-http-get
 { $values { "url" "a " { $link url } " or " { $link string } } { "quot" { $quotation "( chunk -- )" } } { "response" response } }
 { $description "Downloads the contents of a URL. Chunks of data are passed to the quotation as they are read." }
 { $errors "Throws an error if the HTTP request fails." } ;
 
+HELP: with-http-get*
+{ $values { "url" "a " { $link url } " or " { $link string } } { "quot" { $quotation "( chunk -- )" } } }
+{ $description "A variant of " { $link with-http-get } " that checks that the response was successful." }
+{ $errors "Throws an error if the HTTP request fails or is not successful." } ;
+
 HELP: http-request
 { $values { "request" request } { "response" response } { "data" sequence } }
 { $description "Sends an HTTP request to an HTTP server, and reads the response." }

basis/http/client/client.factor

@@ -176,14 +176,20 @@ ERROR: download-failed response ;
 : http-get ( url -- response data )
     <get-request> http-request ;
 
+: http-get* ( url -- data )
+    http-get swap check-response drop ;
+
 : with-http-get ( url quot: ( chunk -- ) -- response )
     [ <get-request> ] dip with-http-request ; inline
 
+: with-http-get* ( url quot: ( chunk -- ) -- )
+    with-http-get check-response drop ; inline
+
 : download-name ( url -- name )
     present file-name "?" split1 drop "/" ?tail drop ;
 
 : download-to ( url file -- )
-    binary [ [ write ] with-http-get check-response drop ] with-file-writer ;
+    binary [ [ write ] with-http-get* ] with-file-writer ;
 
 : download ( url -- )
     dup download-name download-to ;
@@ -195,6 +201,9 @@ ERROR: download-failed response ;
 : http-post ( post-data url -- response data )
     <post-request> http-request ;
 
+: http-post* ( post-data url -- data )
+    http-post swap check-response drop ;
+
 : <put-request> ( post-data url -- request )
     "PUT" <client-request>
         swap >>post-data ;
@@ -202,30 +211,45 @@ ERROR: download-failed response ;
 : http-put ( post-data url -- response data )
     <put-request> http-request ;
 
+: http-put* ( post-data url -- data )
+    http-put swap check-response drop ;
+
 : <delete-request> ( url -- request )
     "DELETE" <client-request> ;
 
 : http-delete ( url -- response data )
     <delete-request> http-request ;
 
+: http-delete* ( url -- data )
+    http-delete swap check-response drop ;
+
 : <head-request> ( url -- request )
     "HEAD" <client-request> ;
 
 : http-head ( url -- response data )
     <head-request> http-request ;
 
+: http-head* ( url -- data )
+    http-head swap check-response drop ;
+
 : <options-request> ( url -- request )
     "OPTIONS" <client-request> ;
 
 : http-options ( url -- response data )
     <options-request> http-request ;
 
+: http-options* ( url -- data )
+    http-options swap check-response drop ;
+
 : <trace-request> ( url -- request )
     "TRACE" <client-request> ;
 
 : http-trace ( url -- response data )
     <trace-request> http-request ;
 
+: http-trace* ( url -- data )
+    http-trace swap check-response drop ;
+
 USE: vocabs.loader
 
 { "http.client" "debugger" } "http.client.debugger" require-when