Welcome to the CHICKEN Scheme pasting service
authorization bearer support for intarweb added by wasamasa on Sun May 24 12:51:03 2020
(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))