http-post

http-post

[gregory benison]

From the guile reference manual, web section:

"More helper procedures for the other common HTTP verbs would be a
good addition to this module.  Send your code to <guile-user@gnu.org>."

So, I say to guile-user, "here is my code".

This http-post implementation takes the request body as either a
bytevector or as a string, in which case it first converts it to a
bytevector either using a default encoding (currently always utf-8,
but perhaps should be snarfed from the current locale) or using a
caller-requested encoding (currently only utf-8 is accepted, though).

I think the next steps after this patch are to:
- be able to work with a greater variety of encodings;
- since form data of the type "key1=value1&key2=value2..." is so
common in POST bodies, accept post data as key-value pairs represented
by an alist (which would be coerced into a bytevector automatically).

-- 
Greg Benison <gbenison@gmail.com>
[blog] http://gcbenison.wordpress.com
[twitter] @gcbenison

diff --git a/module/web/client.scm b/module/web/client.scm
index b035668..6ecc07c 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -35,11 +35,12 @@
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 receive)
   #:use-module (web request)
   #:use-module (web response)
   #:use-module (web uri)
   #:export (open-socket-for-uri
-            http-get))
+            http-get http-post))

 (define (open-socket-for-uri uri)
   (let* ((ai (car (getaddrinfo (uri-host uri)
@@ -114,3 +115,67 @@
               (if decode-body?
                   (decode-response-body res body)
                   body)))))
+
+;; Add a default 'content-type' header to 'headers',
+;; if none is present.
+(define (with-default-encoding headers)
+  (if (assoc 'content-type headers)
+      headers
+      (cons
+       '(content-type text/plain (charset . "utf-8"))
+       headers)))
+
+;; Query headers for a valid 'content-type entry; encode 'content'
+;; appropriately into a bytevector.  Throws 'invalid-encoding
+;; if no appropriate encoding found.
+(define (encode-for-headers content headers)
+  (let ((content-type (assoc 'content-type headers)))
+    (if (not content-type)
+        (throw 'invalid-encoding))
+    (let ((encoding (assoc 'charset (cddr content-type))))
+      (cond ((not encoding)
+             (throw 'invalid-encoding))
+            ((equal? "utf-8" (cdr encoding))
+             (string->utf8 content))
+            (else (throw 'invalid-encoding (cdr encoding)))))))
+
+;; Encode 'content' as a bytevector, and append needed headers
+;; to 'headers', in particular 'content-length'
+(define (encode-content content headers)
+  (receive (content-bv headers)
+      (cond ((bytevector? content)
+             (values content headers))
+            ((string? content)
+             (let ((headers (with-default-encoding headers)))
+               (values  (encode-for-headers content headers)
+                        headers)))
+            (else (error "invalid content type")))
+    ;; FIXME what if 'headers' already contains a content-length?
+    (values content-bv
+            (cons `(content-length . ,(bytevector-length content-bv))
+                  headers))))
+
+(define* (http-post uri content #:key (port (open-socket-for-uri uri))
+                    (version '(1 . 1))
+                    (keep-alive? #f)
+                    (extra-headers '())
+                    (decode-body? #t))
+  (receive (content headers)
+      (encode-content content extra-headers)
+    (let ((req (build-request uri
+                              #:method "POST"
+                              #:version version
+                              #:headers (if keep-alive?
+                                            headers
+                                            (cons '(connection close)
+                                                  headers)))))
+      (write-request-body
+       (write-request req port)
+       content)
+      (force-output port)
+      (let* ((response (read-response port))
+             (body (read-response-body response)))
+        (values response
+                (if decode-body?
+                    (decode-response-body response body)
+                    body))))))

Re: http-post

[Noah Lavine]

Hello,

Thanks for sending it in! And sorry for the slow response.

If you'd like to have it added to Guile, we'd love to have it in here.
The one other thing we'd like is tests for this code. There are
examples in test-suite/tests/web-http.test.

If you want, you can also write a git log entry to go with this. The
other entries have examples. That isn't as important as tests, though.

Thanks for contributing,
Noah

On Mon, Apr 16, 2012 at 11:34 PM, gregory benison <gbenison@gmail.com> wrote:
> From the guile reference manual, web section:
>
> "More helper procedures for the other common HTTP verbs would be a
> good addition to this module.  Send your code to <guile-user@gnu.org>."
>
> So, I say to guile-user, "here is my code".
>
> This http-post implementation takes the request body as either a
> bytevector or as a string, in which case it first converts it to a
> bytevector either using a default encoding (currently always utf-8,
> but perhaps should be snarfed from the current locale) or using a
> caller-requested encoding (currently only utf-8 is accepted, though).
>
> I think the next steps after this patch are to:
> - be able to work with a greater variety of encodings;
> - since form data of the type "key1=value1&key2=value2..." is so
> common in POST bodies, accept post data as key-value pairs represented
> by an alist (which would be coerced into a bytevector automatically).
>
> --
> Greg Benison <gbenison@gmail.com>
> [blog] http://gcbenison.wordpress.com
> [twitter] @gcbenison
>
> diff --git a/module/web/client.scm b/module/web/client.scm
> index b035668..6ecc07c 100644
> --- a/module/web/client.scm
> +++ b/module/web/client.scm
> @@ -35,11 +35,12 @@
>   #:use-module (rnrs bytevectors)
>   #:use-module (ice-9 binary-ports)
>   #:use-module (ice-9 rdelim)
> +  #:use-module (ice-9 receive)
>   #:use-module (web request)
>   #:use-module (web response)
>   #:use-module (web uri)
>   #:export (open-socket-for-uri
> -            http-get))
> +            http-get http-post))
>
>  (define (open-socket-for-uri uri)
>   (let* ((ai (car (getaddrinfo (uri-host uri)
> @@ -114,3 +115,67 @@
>               (if decode-body?
>                   (decode-response-body res body)
>                   body)))))
> +
> +;; Add a default 'content-type' header to 'headers',
> +;; if none is present.
> +(define (with-default-encoding headers)
> +  (if (assoc 'content-type headers)
> +      headers
> +      (cons
> +       '(content-type text/plain (charset . "utf-8"))
> +       headers)))
> +
> +;; Query headers for a valid 'content-type entry; encode 'content'
> +;; appropriately into a bytevector.  Throws 'invalid-encoding
> +;; if no appropriate encoding found.
> +(define (encode-for-headers content headers)
> +  (let ((content-type (assoc 'content-type headers)))
> +    (if (not content-type)
> +        (throw 'invalid-encoding))
> +    (let ((encoding (assoc 'charset (cddr content-type))))
> +      (cond ((not encoding)
> +             (throw 'invalid-encoding))
> +            ((equal? "utf-8" (cdr encoding))
> +             (string->utf8 content))
> +            (else (throw 'invalid-encoding (cdr encoding)))))))
> +
> +;; Encode 'content' as a bytevector, and append needed headers
> +;; to 'headers', in particular 'content-length'
> +(define (encode-content content headers)
> +  (receive (content-bv headers)
> +      (cond ((bytevector? content)
> +             (values content headers))
> +            ((string? content)
> +             (let ((headers (with-default-encoding headers)))
> +               (values  (encode-for-headers content headers)
> +                        headers)))
> +            (else (error "invalid content type")))
> +    ;; FIXME what if 'headers' already contains a content-length?
> +    (values content-bv
> +            (cons `(content-length . ,(bytevector-length content-bv))
> +                  headers))))
> +
> +(define* (http-post uri content #:key (port (open-socket-for-uri uri))
> +                    (version '(1 . 1))
> +                    (keep-alive? #f)
> +                    (extra-headers '())
> +                    (decode-body? #t))
> +  (receive (content headers)
> +      (encode-content content extra-headers)
> +    (let ((req (build-request uri
> +                              #:method "POST"
> +                              #:version version
> +                              #:headers (if keep-alive?
> +                                            headers
> +                                            (cons '(connection close)
> +                                                  headers)))))
> +      (write-request-body
> +       (write-request req port)
> +       content)
> +      (force-output port)
> +      (let* ((response (read-response port))
> +             (body (read-response-body response)))
> +        (values response
> +                (if decode-body?
> +                    (decode-response-body response body)
> +                    body))))))
>

Re: http-post

[gregory benison]

On Thu, Apr 26, 2012 at 5:58 PM, Noah Lavine <noah.b.lavine@gmail.com> wrote:
> If you'd like to have it added to Guile, we'd love to have it in here.
> The one other thing we'd like is tests for this code. There are
> examples in test-suite/tests/web-http.test.
>

To write a test for http-post, I thought I'd model it on a test for
http-get.  However, there isn't one - 'http-get' doesn't appear
anywhere in test-suite/ (on master branch as of 4105f).  'run-server'
isn't in there either.  So is a test needed for all of these?  Perhaps
something that starts up a simple server like the example in the
documentation, binds it to some port, and sends a few requests with
'http-get' and 'http-post' to see if they come back correctly?

Re: http-post

[Noah Lavine]

Hello,

> To write a test for http-post, I thought I'd model it on a test for
> http-get.  However, there isn't one - 'http-get' doesn't appear
> anywhere in test-suite/ (on master branch as of 4105f).  'run-server'
> isn't in there either.  So is a test needed for all of these?  Perhaps
> something that starts up a simple server like the example in the
> documentation, binds it to some port, and sends a few requests with
> 'http-get' and 'http-post' to see if they come back correctly?

Yes, I like that idea. At least our procedures will be consistent with
themselves. :-)

You shouldn't work too hard writing tests for code that you didn't
write, but it sounds like the best way to test your code is to feed
its results to the web server.

Thanks for working on this,
Noah

Re: http-post

[Andy Wingo]

On Tue 17 Apr 2012 05:34, gregory benison <gbenison@gmail.com> writes:

> "More helper procedures for the other common HTTP verbs would be a
> good addition to this module.  Send your code to <guile-user@gnu.org>."
>
> So, I say to guile-user, "here is my code".

Thanks!  I used it as a base for a patch I just pushed.  Guile now has
client wrappers for all HTTP verbs except CONNECT.  Appending the
documentation.  A websocket implementation would be nice.

> I think the next steps after this patch are to:
> - be able to work with a greater variety of encodings;
> - since form data of the type "key1=value1&key2=value2..." is so
> common in POST bodies, accept post data as key-value pairs represented
> by an alist (which would be coerced into a bytevector automatically).

Yes this would be good.  Want to make a patch?

Regards,

Andy

File: guile.info,  Node: Web Client,  Next: Web Server,  Prev: Responses,  Up: Web

7.3.8 Web Client
----------------

`(web client)' provides a simple, synchronous HTTP client, built on the
lower-level HTTP, request, and response modules.

 -- Scheme Procedure: open-socket-for-uri uri
     Return an open input/output port for a connection to URI.

 -- Scheme Procedure: http-get uri keyword-arg...
 -- Scheme Procedure: http-head uri keyword-arg...
 -- Scheme Procedure: http-post uri keyword-arg...
 -- Scheme Procedure: http-put uri keyword-arg...
 -- Scheme Procedure: http-delete uri keyword-arg...
 -- Scheme Procedure: http-trace uri keyword-arg...
 -- Scheme Procedure: http-options uri keyword-arg...
     Connect to the server corresponding to URI and make a request over
     HTTP, using the appropriate method (`GET', `HEAD', etc.).

     All of these procedures have the same prototype: a URI followed by
     an optional sequence of keyword arguments.  These keyword
     arguments allow you to modify the requests in various ways, for
     example attaching a body to the request, or setting specific
     headers.  The following table lists the keyword arguments and
     their default values.

    `#:body #f'

    `#:port (open-socket-for-uri URI)]'

    `#:version '(1 . 1)'

    `#:keep-alive? #f'

    `#:headers '()'

    `#:decode-body? #t'

    `#:streaming? #f'

     If you already have a port open, pass it as PORT.  Otherwise, a
     connection will be opened to the server corresponding to URI.  Any
     extra headers in the alist HEADERS will be added to the request.

     If BODY is not #f, a message body will also be sent with the HTTP
     request.  If BODY is a string, it is encoded according to the
     content-type in HEADERS, defaulting to UTF-8.  Otherwise BODY
     should be a bytevector, or `#f' for no body.  Although a message
     body may be sent with any request, usually only `POST' and `PUT'
     requests have bodies.

     If DECODE-BODY? is true, as is the default, the body of the
     response will be decoded to string, if it is a textual
     content-type.  Otherwise it will be returned as a bytevector.

     However, if STREAMING? is true, instead of eagerly reading the
     response body from the server, this function only reads off the
     headers.  The response body will be returned as a port on which
     the data may be read.

     Unless KEEP-ALIVE? is true, the port will be closed after the full
     response body has been read.

     Returns two values: the response read from the server, and the
     response body as a string, bytevector, #f value, or as a port (if
     STREAMING? is true).

   `http-get' is useful for making one-off requests to web sites.  If
you are writing a web spider or some other client that needs to handle a
number of requests in parallel, it's better to build an event-driven URL
fetcher, similar in structure to the web server (*note Web Server::).

   Another option, good but not as performant, would be to use threads,
possibly via par-map or futures.


-- 
http://wingolog.org/