(import (chicken base))
(import (chicken irregex))
(import intarweb)
(import http-client)

(define base64-irx '(: (+ (or alnum ("-._~+/"))) (* "=")))

(define (bearer-auth-param-subparser contents pos)
  (let* ((irx '(: bos ($ ,base64-irx) eol))
         (match (irregex-match irx contents pos)))
    (if match
        (let ((token (irregex-match-substring match 1))
              (pos (irregex-match-end-index match 1)))
          (values `((token . ,token)) pos))
        (error "Invalid bearer token" (substring contents pos)))))

(define (bearer-auth-param-subunparser params)
  (let ((token (alist-ref 'token params)))
    (if (irregex-match base64-irx token)
        token
        (error "Invalid bearer token" token))))

(authorization-param-subparsers
 (cons `(bearer . ,bearer-auth-param-subparser)
       (authorization-param-subparsers)))

(authorization-param-subunparsers
 (cons `(bearer . ,bearer-auth-param-subunparser)
       (authorization-param-subunparsers)))

(define request
  (let ((secret "foo"))
    (make-request uri: (uri-reference url)
                  headers: (headers `((accept application/json)
                                      (authorization #(bearer ((token . ,secret)))))))))
(define url "http://example.com")
(print (with-input-from-request request #f read-string))