(define (url-query-string query)
  (string-join (map (lambda (entry)
                      (string-append (url-encode (car entry))
                                     "="
                                     (url-encode (cdr entry))))
                    query)
               "&"))

(define (url-encode str)
  (string-concatenate
   (let loop ((i 0))
     (cond
      ((= i (string-length str))
       '())
      ((memv (string-ref str i)
             '(#\& #\= #\space))
       (cons (string-append "%"
                            (number->string
                             (char->ascii (string-ref str i))
                             16))
             (loop (+ i 1))))
      (else
       (cons (make-string 1 (string-ref str i))
             (loop (+ i 1))))))))

;; Shameless plug from base64.scm from Chicken
;; See http://www.call-with-current-continuation.org/eggs/base64.scm
;
; Copyright (c) 2000-2003, Felix L. Winkelmann
; All rights reserved.
;
; Redistribution and use in source and binary forms, with or without
; modification, are permitted provided that the following conditions
; are met:
;
;   Redistributions of source code must retain the above copyright
;     notice, this list of conditions and the following disclaimer.
;   Redistributions in binary form must reproduce the above copyright
;     notice, this list of conditions and the following disclaimer in
;     the documentation and/or other materials provided with the
;     distribution.
;   Neither the name of the author nor the names of its contributors
;     may be used to endorse or promote products derived from this
;     software without specific prior written permission.
;
; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
; POSSIBILITY OF SUCH DAMAGE.
(define (base64-encode str)
  (define (enc n)
    (cond ((< n 26) (integer->char (+ (char->integer #\A) n)))
          ((< n 52) (integer->char (+ (char->integer #\a) (- n 26))))
          ((< n 62) (integer->char (+ (char->integer #\0) (- n 52))))
          ((= n 62) #\+)
          (else     #\/)))
  (let* ((len (string-length str))
         (lmax (- len (modulo len 3)))
         (out (open-output-string)))
    (do ((i 0 (+ i 3)))
        ((>= i lmax)
         (case (modulo len 3)
           ((1)
            (let ((b1 (char->ascii (string-ref str i))))
              (write-char (enc (arithmetic-shift (bitwise-and #b11111100 b1) -2)) out)
              (write-char (enc (arithmetic-shift (bitwise-and #b11 b1) 4)) out)
              (display "==" out) ) )
           ((2)
            (let ((b1 (char->ascii (string-ref str i)))
                  (b2 (char->ascii (string-ref str (+ i 1)))) )
              (write-char (enc (arithmetic-shift (bitwise-and #b11111100 b1) -2)) out)
              (write-char
               (enc (bitwise-ior
                     (arithmetic-shift (bitwise-and #b11 b1) 4)
                     (arithmetic-shift (bitwise-and #b11110000 b2) -4) ) )
               out)
              (write-char (enc (arithmetic-shift (bitwise-and #b1111 b2) 2)) out)
              (write-char #\= out) ) ) )
         (get-output-string out) )
      (let ((b1 (char->ascii (string-ref str i)))
            (b2 (char->ascii (string-ref str (+ i 1))))
            (b3 (char->ascii (string-ref str (+ i 2)))))
        (write-char (enc (arithmetic-shift (bitwise-and #b11111100 b1) -2)) out)
        (write-char
         (enc (bitwise-ior
               (arithmetic-shift (bitwise-and #b11 b1) 4)
               (arithmetic-shift (bitwise-and #b11110000 b2) -4) ) )
         out)
        (write-char
         (enc (bitwise-ior
               (arithmetic-shift (bitwise-and #b1111 b2) 2)
               (arithmetic-shift (bitwise-and #b11000000 b3) -6) ) )
         out)
        (write-char (enc (bitwise-and #b111111 b3)) out)))))