Continuing of HTTP Call & Proxy Integration (3)

To satisfy the requirement of proxy, the following serves as the basic skeletion:

(define (proxy! (url ($pathinfo)) (headers ($headers)))
  (case ($method)
    (("post") (http-post (url-helper url) (request-post-data/raw ($request)) headers))
    (("get") (http-get (url-helper url) headers))
    (else (error 'proxy "proxy method ~a not supported" ($method)))))

As we can see, we already have most of the HTTP connection code defined, except we need to ensure all of the custom headers, as well as the user/password credentials are properly retrieved. For that we need to massage the url and the headers.

Filter Out Non-Custom Headers

The first step is to filter out the non-custom headers:

(define (custom-header? header)
  (string-ci=? "bzl-" (substring (car header) 0 (max (string-length (car header)) 4))))

(define (convert-header header)
    (cons (regexp-replace #px"^bzl-(.+)$" (car header) "\\1")
          (cdr header)))

(define (headers->custom-headers headers) 
  (map convert-header (filter custom-header? header)))

We also want to keep some regular headers such as Content-Type and Content-Length:

(define (headers->custom-headers headers) 
  (append (filter (lambda (header)
                    (or (string-ci=? (car header) "content-type")
                        (string-ci=? (car header) "content-length")))
                  headers)
          (map convert-header (filter custom-header? headers))))

Extract User Credential from URL

In case the user credentials is supplied in user:password form in the path, we want to extract it and push it onto the headers:

(define (url-helper url)
  (cond ((url? url) url)
        ((string? url) (string->url url))
        (else ;; this is based on pathinfo... 
         (let ((url (string-join url "/")))
           ;; keep the url query 
           (set-url-query! url (url-query ($uri)))
           url))))

(define (url->auth-header url) 
  ;; helper removes the additional \r\n appended by base64-encode
  (define (remove-extra-crlf auth) 
    (substring auth 0 (- (string-length auth) 2)))
  (if (not (url-user url))
      #f 
      (cons "Authorization"
            (string-append "Basic "
                           (remove-extra-crlf 
                            (bytes->string/utf-8
                             (base64-encode
                              (string->bytes/utf-8 (url-user url)))))))))

And finally we modify proxy! to use the newly generated url & headers:

(define (normalize-url+headers url headers) 
  (let ((url (url-helper url))
        (headers (headers->custom-headers headers)))
    (let ((auth (url->auth-header url))) ;; in case the auth info is passed in via url. 
      (let ((headers (if (not auth) headers
                         (cons auth headers))))
        (values url headers)))))

(define (proxy! (url ($pathinfo)) (headers ($headers)))
  (define (helper url headers)
    (case ($method)
      (("post") (http-post url (request-post-data/raw ($request)) headers))
      (("get") (http-get url headers))
      (else (error 'proxy "proxy method ~a not supported" ($method)))))
  (call-with-values 
   (lambda () 
     (normalize-url+headers url headers))
   helper))

Convert the Responses

Since the http-get and http-post returns http-client-response instead of response/basic, we'll have to have an adapter to convert from one type to another, and once it's converted, we can handle it the same way as redirect! to raise the response/basic.

(define (http-client-response->response r)
  (define (get-content-type r)
    (define (helper header)
      (if (not header) 
          #"text/html; charset=utf-8"
          (string->bytes/utf-8 (cdr header))))
    (helper (assf (lambda (key)
                    (string-ci=? key "content-type"))
                  (http-client-response-headers r))))
  (define (normalize-headers r)
    (map (lambda (kv)
           (make-header (string->bytes/utf-8 (car kv))
                        (string->bytes/utf-8 (cdr kv))))
         (http-client-response-headers r)))
  (define (make-generator)
    (lambda (output) 
      (let loop ((b (read-bytes 4096 r)))
        (cond ((eof-object? b)
               (void))
              (else
               (output b)
               (loop (read-bytes 4095 r)))))))
  (make-response/incremental (http-client-response-code r)
                             (string->bytes/utf-8 (http-client-response-reason r))
                             (current-seconds)
                             (get-content-type r)
                             (normalize-headers r)
                             (make-generator)))
 
(define (proxy! (url ($pathinfo)) (headers ($headers)))
  (define (helper url headers)
    (raise 
     (http-client-response->response
      (case ($method)
        ((post) (http-post url (request-post-data/raw ($request)) headers))
        ((get) (http-get url headers))
        (else (error 'proxy "proxy method ~a not supported" ($method)))))))
  (call-with-values 
   (lambda () 
     (normalize-url+headers url headers))
   helper))

Fixing the URL

The code so far almost works, except that since empty strings are stripped from pathinfo, we'll get http:/www.google.com instead of http://www.google.com when we reconstruct the pathinfo into url, so we'll fix that by ensuring an additional empty path is reintroduced:

(define (join-url segments) 
  (define (helper segments)
    (string-join segments "/"))
  (cond ((null? segments) (error 'join-url "invalid segments: ~a" segments))
        ((string-ci=? (car segments) "http:")
         (helper (list* (car segments) "" (cdr segments))))
        ((string-ci=? (car segments) "https:")
         (helper (list* (car segments) "" (cdr segments))))
        (else 
         (helper (list* "http:" "" (cdr segments))))))
(define (url-helper url)
  (cond ((url? url) url)
        ((string? url) (string->url url))
        (else ;; this is based on pathinfo... 
         (let ((url (string->url (join-url url))))
           ;; keep the url query 
           (set-url-query! url (url-query ($uri)))
           (display (format "~a\n" (url->string url)) (current-error-port))
           url))))

With these it is now easy to add proxy capability into SHP:

;; proxy
(proxy!) 

Voila - how you can use proxy to wrap around internal or 3rd party web services!