├── .github ├── FUNDING.yml └── workflows │ └── ci.yml ├── .gitignore ├── README.md ├── http-easy-lib ├── LICENSE ├── http-easy.rkt ├── http-easy │ └── private │ │ ├── auth.rkt │ │ ├── common.rkt │ │ ├── contract.rkt │ │ ├── error.rkt │ │ ├── logger.rkt │ │ ├── payload.rkt │ │ ├── pool.rkt │ │ ├── port.rkt │ │ ├── proxy.rkt │ │ ├── reflect.rkt │ │ ├── response.rkt │ │ ├── session.rkt │ │ ├── timeout.rkt │ │ ├── url.rkt │ │ └── user-agent.rkt └── info.rkt ├── http-easy-test ├── LICENSE ├── info.rkt └── net │ └── http-easy │ ├── http-easy.rkt │ └── private │ ├── common.rkt │ ├── payload.rkt │ ├── pool.rkt │ ├── response.rkt │ └── url.rkt └── http-easy ├── LICENSE ├── guide-log.rktd ├── http-easy.scrbl └── info.rkt /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: Bogdanp 2 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | on: [push] 3 | jobs: 4 | build: 5 | runs-on: ubuntu-latest 6 | strategy: 7 | matrix: 8 | racket-version: ['8.6', '8.7', 'current'] 9 | racket-variant: ['BC', 'CS'] 10 | name: Build & Test on Racket ${{ matrix.racket-version }} (${{ matrix.racket-variant }}) 11 | steps: 12 | - uses: actions/checkout@master 13 | - uses: Bogdanp/setup-racket@v1.9 14 | with: 15 | architecture: x64 16 | variant: ${{ matrix.racket-variant }} 17 | version: ${{ matrix.racket-version }} 18 | - run: raco pkg install --batch --auto http-easy-lib/ http-easy-test/ http-easy/ 19 | - run: raco test http-easy-test/ 20 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | compiled 2 | doc 3 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # http-easy ![CI](https://github.com/bogdanp/racket-http-easy/workflows/CI/badge.svg) 2 | 3 | A high-level HTTP client for Racket. [Documentation][docs] is 4 | available on the package server. 5 | 6 | ## License 7 | 8 | http-easy is licensed under the 3-Clause BSD license. 9 | 10 | [docs]: https://docs.racket-lang.org/http-easy/index.html 11 | -------------------------------------------------------------------------------- /http-easy-lib/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2020-2022 Bogdan Popa 2 | 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions are 5 | met: 6 | 7 | 1. Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | 3. Neither the name of the copyright holder nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 21 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 22 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 23 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 24 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 25 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 26 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (for-syntax racket/base 4 | syntax/parse/pre) 5 | racket/contract/base 6 | "http-easy/private/auth.rkt" 7 | "http-easy/private/contract.rkt" 8 | "http-easy/private/error.rkt" 9 | "http-easy/private/payload.rkt" 10 | "http-easy/private/pool.rkt" 11 | "http-easy/private/proxy.rkt" 12 | "http-easy/private/response.rkt" 13 | "http-easy/private/session.rkt" 14 | "http-easy/private/timeout.rkt" 15 | "http-easy/private/url.rkt" 16 | "http-easy/private/user-agent.rkt") 17 | 18 | (provide 19 | exn:fail:http-easy? 20 | exn:fail:http-easy:timeout? 21 | exn:fail:http-easy:timeout-kind 22 | 23 | limit/c 24 | make-pool-config 25 | pool-config? 26 | 27 | timeout/c 28 | make-timeout-config 29 | timeout-config? 30 | 31 | (all-from-out "http-easy/private/auth.rkt") 32 | (all-from-out "http-easy/private/contract.rkt") 33 | (all-from-out "http-easy/private/payload.rkt") 34 | (all-from-out "http-easy/private/proxy.rkt") 35 | (all-from-out "http-easy/private/response.rkt") 36 | (all-from-out "http-easy/private/session.rkt") 37 | (all-from-out "http-easy/private/user-agent.rkt") 38 | 39 | (struct-out url/literal) 40 | string->url/literal 41 | url/literal->string 42 | 43 | (contract-out 44 | [current-session (parameter/c session?)])) 45 | 46 | (define current-session 47 | (make-parameter (make-session))) 48 | 49 | (define (make-requester method) 50 | (make-keyword-procedure 51 | (lambda (kws kw-args . args) 52 | (when (memq '#:method kws) 53 | (raise-user-error "#:method keyword argument not allowed")) 54 | (keyword-apply session-request kws kw-args (current-session) args #:method method)))) 55 | 56 | (define-syntax (define-requesters stx) 57 | (syntax-parse stx 58 | [(_ method:id ...+) 59 | #'(begin 60 | (define method (make-requester 'method)) ... 61 | (provide method ...))])) 62 | 63 | (define-requesters delete head get options patch post put) 64 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/auth.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract/base 4 | racket/lazy-require 5 | racket/port 6 | "contract.rkt") 7 | 8 | (lazy-require 9 | [net/base64 (base64-encode)]) 10 | 11 | (provide 12 | (contract-out 13 | [basic-auth (-> (or/c bytes? string?) 14 | (or/c bytes? string?) 15 | auth-procedure/c)] 16 | [bearer-auth (-> (or/c bytes? string?) auth-procedure/c)])) 17 | 18 | (define (basic-auth username password) 19 | (define header-value 20 | (call-with-output-bytes 21 | (lambda (out) 22 | (define s 23 | (string->bytes/utf-8 24 | (format "~a:~a" username password))) 25 | 26 | (write-bytes #"Basic " out) 27 | (write-bytes (base64-encode s #"") out)))) 28 | (lambda (_url headers params) 29 | (values (hash-set headers 'authorization header-value) params))) 30 | 31 | (define (bearer-auth token) 32 | (define header-value 33 | (call-with-output-bytes 34 | (lambda (out) 35 | (display "Bearer " out) 36 | (display token out)))) 37 | (lambda (_url headers params) 38 | (values (hash-set headers 'authorization header-value) params))) 39 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/common.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide 4 | bytes->number 5 | symbol->bytes 6 | method->bytes) 7 | 8 | (define-syntax-rule (define/memo (id arg) body0 body ...) 9 | (define id 10 | (let ([h (make-hasheq)]) 11 | (lambda (arg) 12 | (hash-ref! h arg (λ () body0 body ...)))))) 13 | 14 | (define bytes->number 15 | (compose1 string->number bytes->string/utf-8)) 16 | 17 | (define/memo (symbol->bytes s) 18 | (string->bytes/utf-8 (symbol->string s))) 19 | 20 | (define/memo (method->bytes m) 21 | (string->bytes/utf-8 (string-upcase (symbol->string m)))) 22 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/contract.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require net/url 4 | racket/contract/base) 5 | 6 | (provide 7 | method/c 8 | headers/c 9 | form-data/c 10 | query-params/c 11 | auth-procedure/c 12 | payload-procedure/c) 13 | 14 | (define method/c 15 | (or/c 'delete 'head 'get 'options 'patch 'post 'put symbol?)) 16 | 17 | (define headers/c 18 | (hash/c symbol? (or/c bytes? string?))) 19 | 20 | (define form-data/c 21 | (listof (cons/c symbol? (or/c #f string?)))) 22 | 23 | (define query-params/c 24 | (listof (cons/c symbol? (or/c #f string?)))) 25 | 26 | (define auth-procedure/c 27 | (-> url? headers/c query-params/c (values headers/c query-params/c))) 28 | 29 | (define payload-procedure/c 30 | (-> headers/c (values headers/c (or/c bytes? string? input-port?)))) 31 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/error.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract/base) 4 | 5 | (provide 6 | exn:fail:http-easy? 7 | exn:fail:http-easy:timeout? 8 | exn:fail:http-easy:timeout-kind 9 | 10 | (contract-out 11 | [make-timeout-error (-> (or/c 'lease 'connect 'request) exn:fail:http-easy:timeout?)])) 12 | 13 | (struct exn:fail:http-easy exn:fail ()) 14 | (struct exn:fail:http-easy:timeout exn:fail:http-easy (kind)) 15 | 16 | (define (make-timeout-error kind) 17 | (exn:fail:http-easy:timeout 18 | (format "~a timed out" kind) 19 | (current-continuation-marks) kind)) 20 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/logger.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide 4 | http-easy-logger 5 | log-http-easy-debug 6 | log-http-easy-info 7 | log-http-easy-warning 8 | log-http-easy-error) 9 | 10 | (define-logger http-easy) 11 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/payload.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require net/uri-codec 4 | racket/contract/base 5 | racket/format 6 | racket/lazy-require 7 | racket/match 8 | racket/port 9 | "contract.rkt") 10 | 11 | (lazy-require 12 | [file/gzip (gzip-through-ports)] 13 | [file/md5 (md5)] 14 | [json (jsexpr? jsexpr->bytes)]) 15 | 16 | (provide 17 | (contract-out 18 | [buffered-payload (-> payload-procedure/c payload-procedure/c)] 19 | [form-payload (-> form-data/c payload-procedure/c)] 20 | [gzip-payload (-> payload-procedure/c payload-procedure/c)] 21 | [json-payload (-> jsexpr? payload-procedure/c)] 22 | [pure-payload (-> (or/c bytes? string? input-port?) payload-procedure/c)])) 23 | 24 | (define ((buffered-payload p) hs) 25 | (let*-values ([(hs data) (p hs)] 26 | [(bs) 27 | (cond 28 | [(input-port? data) 29 | (call-with-output-bytes 30 | (lambda (out) 31 | (copy-port data out)))] 32 | [(string? data) 33 | (string->bytes/utf-8 data)] 34 | [else 35 | data])]) 36 | (define content-length 37 | (number->string (bytes-length bs))) 38 | (values (hash-set hs 'content-length content-length) bs))) 39 | 40 | (define (form-payload v) 41 | (define data (alist->form-urlencoded v)) 42 | (lambda (hs) 43 | (values (hash-set hs 'content-type #"application/x-www-form-urlencoded; charset=utf-8") data))) 44 | 45 | (define ((gzip-payload p) hs) 46 | (define-values (hs* data) 47 | (p hs)) 48 | (values 49 | (hash-set hs* 'content-encoding #"gzip") 50 | (~>> 51 | (cond 52 | [(bytes? data) (open-input-bytes data)] 53 | [(string? data) (open-input-string data)] 54 | [else data]) 55 | (lambda (in out) 56 | (gzip-through-ports in out #f (current-seconds)))))) 57 | 58 | (define ((json-payload v) hs) 59 | (values (hash-set hs 'content-type #"application/json; charset=utf-8") (jsexpr->bytes v))) 60 | 61 | (define ((pure-payload v) hs) 62 | (values hs v)) 63 | 64 | 65 | ;; multipart ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 66 | 67 | (provide 68 | (contract-out 69 | [part? (-> any/c boolean?)] 70 | [field-part (->* [stringy/c (or/c stringy/c input-port?)] [stringy/c] part:field?)] 71 | [file-part (->* [stringy/c input-port?] [stringy/c stringy/c] part:file?)] 72 | [multipart-payload 73 | (->* [] 74 | [#:boundary (or/c bytes? string?)] 75 | #:rest (non-empty-listof part?) 76 | payload-procedure/c)])) 77 | 78 | (struct part (id) #:transparent) 79 | (struct part:field part (content-type value) #:transparent) 80 | (struct part:file part (content-type filename in) #:transparent) 81 | 82 | (define stringy/c 83 | (or/c bytes? string?)) 84 | 85 | (define (field-part id value [content-type #"text/plain"]) 86 | (part:field id content-type value)) 87 | 88 | (define (file-part id inp [filename (~a (object-name inp))] [content-type #"application/octet-stream"]) 89 | (part:file id content-type filename inp)) 90 | 91 | (define ((multipart-payload #:boundary [boundary #f] . fs) hs) 92 | (let ([boundary (or boundary (generate-boundary))]) 93 | (values 94 | (hash-set hs 'content-type (format "multipart/form-data; boundary=~a" boundary)) 95 | (~>> fs (make-parts-writer boundary))))) 96 | 97 | (define ((make-parts-writer boundary) fs out) 98 | (for ([f (in-list fs)]) 99 | (fprintf out "--~a\r\n" boundary) 100 | (match f 101 | [(part:field id content-type value) 102 | (fprintf out "content-disposition: form-data; name=\"~a\"\r\n" (quote-multipart id)) 103 | (when content-type 104 | (fprintf out "content-type: ~a\r\n" content-type)) 105 | (fprintf out "\r\n") 106 | (cond 107 | [(bytes? value) (display value out)] 108 | [(string? value) (display value out)] 109 | [else (copy-port value out)]) 110 | (fprintf out "\r\n")] 111 | 112 | [(part:file id content-type filename in) 113 | (fprintf out "content-disposition: form-data; name=\"~a\"; filename=\"~a\"\r\n" (quote-multipart id) (quote-multipart filename)) 114 | (fprintf out "content-type: ~a\r\n\r\n" content-type) 115 | (copy-port in out) 116 | (fprintf out "\r\n")])) 117 | (fprintf out "--~a--\r\n" boundary)) 118 | 119 | (define (quote-multipart name) 120 | (regexp-replace* #rx"[\"\\]" name "\\\\\\0")) 121 | 122 | (define (generate-boundary) 123 | (with-output-to-bytes 124 | (lambda () 125 | (display "--------http-easy-") 126 | (display (md5 (call-with-output-bytes 127 | (lambda (out) 128 | (display (current-inexact-milliseconds) out)))))))) 129 | 130 | 131 | ;; help ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 132 | 133 | ;; Asynchronously write `data' to a new input port using `f'. 134 | (define (~>> data f) 135 | (define-values (in out) 136 | (make-pipe)) 137 | (begin0 in 138 | (thread 139 | (lambda () 140 | (dynamic-wind 141 | void 142 | (lambda () 143 | (f data out)) 144 | (lambda () 145 | (close-output-port out))))))) 146 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/pool.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (prefix-in d: data/pool) 4 | net/http-client 5 | racket/contract/base 6 | "error.rkt" 7 | "logger.rkt" 8 | "timeout.rkt") 9 | 10 | ;; config ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11 | 12 | (provide 13 | limit/c 14 | pool-config? 15 | (contract-out 16 | [make-pool-config 17 | (->* [] 18 | [#:max-size limit/c 19 | #:idle-timeout timeout/c] 20 | pool-config?)])) 21 | 22 | (struct pool-config (max-size idle-timeout) 23 | #:transparent) 24 | 25 | (define limit/c 26 | (or/c +inf.0 exact-positive-integer?)) 27 | 28 | (define (make-pool-config 29 | #:max-size [max-size 128] 30 | #:idle-timeout [idle-timeout 600]) 31 | (pool-config max-size idle-timeout)) 32 | 33 | 34 | ;; pool ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 35 | 36 | (provide 37 | connector/c 38 | (contract-out 39 | [make-pool (-> pool-config? connector/c pool?)] 40 | [pool? (-> any/c boolean?)] 41 | [pool-lease (->* [pool?] [(or/c #f timeout-config?)] http-conn?)] 42 | [pool-release (-> pool? http-conn? void?)] 43 | [pool-close! (-> pool? void?)])) 44 | 45 | (define connector/c 46 | (-> http-conn? http-conn?)) 47 | 48 | (struct pool (connector impl) 49 | #:transparent) 50 | 51 | (define (make-pool conf connector) 52 | (pool 53 | connector 54 | (d:make-pool 55 | #:max-size (pool-config-max-size conf) 56 | #:idle-ttl (seconds->ms (pool-config-idle-timeout conf)) 57 | http-conn 58 | http-conn-close!))) 59 | 60 | (define (pool-lease p [t #f]) 61 | (define impl (pool-impl p)) 62 | (define maybe-lease-timeout-ms 63 | (and t (seconds->ms (timeout-config-lease t)))) 64 | (cond 65 | [(d:pool-take! impl maybe-lease-timeout-ms) 66 | => (lambda (leased-c) 67 | (define out (make-channel)) 68 | (define thd 69 | (thread 70 | (lambda () 71 | (with-handlers ([exn:break? void] 72 | [exn:fail? (λ (e) (channel-put out e))]) 73 | (channel-put out ((pool-connector p) leased-c)))))) 74 | (define res 75 | (sync/timeout (and t (timeout-config-connect t)) out)) 76 | 77 | (cond 78 | [(exn:fail? res) 79 | (log-http-easy-warning "connection failed: ~a" (exn-message res)) 80 | (http-conn-close! leased-c) 81 | (d:pool-release! impl leased-c) 82 | (raise res)] 83 | 84 | [(not res) 85 | (log-http-easy-warning "connection timed out") 86 | (break-thread thd) 87 | (http-conn-close! leased-c) 88 | (d:pool-release! impl leased-c) 89 | (raise (make-timeout-error 'connect))] 90 | 91 | [else 92 | res]))] 93 | 94 | [else 95 | (raise (make-timeout-error 'lease))])) 96 | 97 | (define (pool-release p c) 98 | (d:pool-release! (pool-impl p) c)) 99 | 100 | (define (pool-close! p) 101 | (d:pool-close! (pool-impl p)) 102 | (log-http-easy-debug "connection pool closed")) 103 | 104 | (define (seconds->ms n) 105 | (inexact->exact (round (* n 1000)))) 106 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/port.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide 4 | make-retaining-input-port) 5 | 6 | (define (make-retaining-input-port p) 7 | (define the-box (box #f)) 8 | (define the-port 9 | (make-input-port 10 | (object-name p) ; name 11 | p ; read-in 12 | p ; peek-in 13 | (lambda () ; close 14 | (set-box! the-box #f) 15 | (close-input-port p)) 16 | (lambda () (port-progress-evt p)) ; get-progress-evt 17 | (lambda (amt progress evt) ; commit 18 | (port-commit-peeked amt progress evt p)) 19 | (lambda () (port-next-location p)) ; get-location 20 | (lambda () (port-count-lines! p)) ; count-lines! 21 | p ; init-position 22 | (case-lambda ; buffer-mode 23 | [() (file-stream-buffer-mode p)] 24 | [(mode) (file-stream-buffer-mode p mode)]))) 25 | (values the-port (λ (v) (set-box! the-box v)) )) 26 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/proxy.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require net/http-client 4 | net/url 5 | racket/contract/base 6 | racket/lazy-require 7 | "url.rkt") 8 | 9 | (lazy-require 10 | [openssl (ssl-client-context?)]) 11 | 12 | (provide 13 | proxy? 14 | proxy-matches? 15 | proxy-connect! 16 | 17 | (contract-out 18 | [make-proxy (-> (-> url? boolean?) (-> http-conn? url? (or/c #f ssl-client-context?) void?) proxy?)] 19 | [make-http-proxy (->* [urlish/c] [(-> url? boolean?)] proxy?)] 20 | [make-https-proxy (->* [urlish/c] [(-> url? boolean?)] proxy?)])) 21 | 22 | (struct proxy (matches? connect!) 23 | #:transparent) 24 | 25 | (define (make-proxy matches? connect!) 26 | (proxy matches? connect!)) 27 | 28 | (define (make-http-proxy urlish [matches? (λ (u) (equal? (url-scheme u) "http"))]) 29 | (proxy matches? (make-proxy-connector urlish 80 (λ (_) #f)))) 30 | 31 | (define (make-https-proxy urlish [matches? (λ (u) (equal? (url-scheme u) "https"))]) 32 | (proxy matches? (make-proxy-connector urlish 443))) 33 | 34 | (define (make-proxy-connector urlish default-port [ssl-ctx-f values]) 35 | (define proxy-url (->url urlish)) 36 | (define proxy-host (url-host proxy-url)) 37 | (define proxy-port (or (url-port proxy-url) default-port)) 38 | (lambda (conn u ssl-ctx) 39 | (define target-host (url-host u)) 40 | (define target-port (or (url-port u) default-port)) 41 | (define-values (ssl-ctx* in out abandon!) 42 | (http-conn-CONNECT-tunnel proxy-host proxy-port target-host target-port #:ssl? (ssl-ctx-f ssl-ctx))) 43 | (http-conn-open! conn target-host 44 | #:port target-port 45 | #:ssl? (list ssl-ctx* in out abandon!)))) 46 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/reflect.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (for-syntax racket/base 4 | racket/path 5 | setup/getinfo)) 6 | 7 | (provide 8 | lib-version) 9 | 10 | (begin-for-syntax 11 | (define this-path (build-path (path-only (syntax-source #'here)) 'up 'up)) 12 | (define info-ref (get-info/full this-path))) 13 | 14 | (define-syntax (get-lib-version stx) 15 | (datum->syntax stx (info-ref 'version))) 16 | 17 | (define (lib-version) 18 | (get-lib-version)) 19 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/response.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (for-syntax racket/base 4 | syntax/parse/pre 5 | "common.rkt") 6 | racket/contract/base 7 | racket/lazy-require 8 | racket/match 9 | racket/port 10 | "common.rkt" 11 | "logger.rkt" 12 | "port.rkt") 13 | 14 | (lazy-require 15 | [json (bytes->jsexpr 16 | jsexpr? 17 | read-json)] 18 | [xml (document? 19 | document-element 20 | read-xml/document 21 | xexpr? 22 | xml->xexpr)]) 23 | 24 | (provide 25 | status-code/c 26 | response? 27 | response-status-line 28 | response-http-version 29 | response-status-code 30 | response-status-message 31 | response-headers 32 | response-output 33 | response-history 34 | (contract-out 35 | [make-response (-> bytes? (listof bytes?) input-port? (listof response?) response-closer/c response?)] 36 | [response-body (-> response? bytes?)] 37 | [response-json (-> response? (or/c eof-object? jsexpr?))] 38 | [response-xexpr (-> response? xexpr?)] 39 | [response-xml (-> response? document?)] 40 | [read-response (-> response? any/c)] 41 | [read-response-json (-> response? (or/c eof-object? jsexpr?))] 42 | [read-response-xexpr (-> response? xexpr?)] 43 | [read-response-xml (-> response? document?)] 44 | [response-drain! (-> response? void?)] 45 | [response-close! (-> response? void?)])) 46 | 47 | (struct response 48 | (sema 49 | status-line 50 | http-version 51 | status-code 52 | status-message 53 | headers 54 | output 55 | [data #:mutable] 56 | history 57 | closer 58 | [closed? #:mutable])) 59 | 60 | (define response-closer/c 61 | (-> response? void?)) 62 | 63 | (define status-code/c 64 | (integer-in 100 999)) 65 | 66 | (define (make-response status headers output history closer) 67 | (match status 68 | [(regexp #rx#"^HTTP/(...) ([1-9][0-9][0-9])(?: (.*))?$" 69 | (list status-line 70 | http-version 71 | (app bytes->number status-code) 72 | status-message)) 73 | (define-values (retaining-output retain) 74 | (make-retaining-input-port output)) 75 | (define the-resp 76 | (response (make-semaphore 1) 77 | status-line 78 | http-version 79 | status-code 80 | (or status-message #"") 81 | headers 82 | retaining-output 83 | #f 84 | history 85 | closer 86 | #f)) 87 | (begin0 the-resp 88 | (retain the-resp))] 89 | 90 | [_ 91 | (raise-argument-error 'status "a valid status line" status)])) 92 | 93 | (define-syntax-rule (define-headers-ref id for-form) 94 | (begin 95 | (provide 96 | (contract-out [id (-> response? symbol? any/c)])) 97 | (define (id r h) 98 | (define h:bs (symbol->bytes h)) 99 | (define re (byte-regexp (bytes-append #"^(?i:" (regexp-quote h:bs) #"): "))) 100 | (for-form ([header (in-list (response-headers r))] 101 | #:when (regexp-match re header)) 102 | (subbytes header (+ 2 (bytes-length h:bs))))))) 103 | 104 | (define-headers-ref response-headers-ref for/first) 105 | (define-headers-ref response-headers-ref* for/list) 106 | 107 | (define (response-body r) 108 | (unless (response-data r) 109 | (response-drain! r)) 110 | (response-data r)) 111 | 112 | (define (response-json r) 113 | (bytes->jsexpr (response-body r))) 114 | 115 | (define (response-xexpr r) 116 | (xml->xexpr 117 | (document-element 118 | (response-xml r)))) 119 | 120 | (define (response-xml r) 121 | (read-xml/document (open-input-bytes (response-body r)))) 122 | 123 | (define (read-response r) 124 | (read (response-output r))) 125 | 126 | (define (read-response-json r) 127 | (read-json (response-output r))) 128 | 129 | (define (read-response-xexpr r) 130 | (xml->xexpr 131 | (document-element 132 | (read-response-xml r)))) 133 | 134 | (define (read-response-xml r) 135 | (read-xml/document (response-output r))) 136 | 137 | (define (response-drain! r) 138 | (call-with-semaphore (response-sema r) 139 | (lambda () 140 | (unless (response-data r) 141 | (define inp (response-output r)) 142 | (unless (port-closed? inp) 143 | (define data (port->bytes inp)) 144 | (set-response-data! r data) 145 | (close-input-port inp)))))) 146 | 147 | (define (response-close! r) 148 | (call-with-semaphore (response-sema r) 149 | (lambda () 150 | (unless (response-closed? r) 151 | (define inp (response-output r)) 152 | (unless (port-closed? inp) 153 | (copy-port inp (open-output-nowhere)) 154 | (close-input-port inp)) 155 | ((response-closer r) r) 156 | (set-response-closed?! r #t) 157 | (log-http-easy-debug "response closed"))))) 158 | 159 | 160 | ;; match expanders ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 161 | 162 | (provide 163 | (rename-out [response:me response])) 164 | 165 | (define-match-expander heads 166 | (syntax-parser 167 | ([_ (name:id value:expr) ... (~optional rst)] 168 | #:with (head-re ...) 169 | (for/list ([name (syntax->datum #'(name ...))]) 170 | (datum->syntax #'name (bytes-append #"^(?i:" (regexp-quote (symbol->bytes name)) #"): (.*)"))) 171 | #'(list-no-order (regexp head-re (list _ value)) ... (~? rst _) (... ...))))) 172 | 173 | (define-match-expander response:me 174 | (syntax-parser 175 | ([_ (~alt (~optional (~seq #:status-line line)) 176 | (~optional (~seq #:status-code code)) 177 | (~optional (~seq #:status-message message)) 178 | (~optional (~seq #:http-version version)) 179 | (~optional (~seq #:history history)) 180 | (~optional (~seq #:headers (headers ...) (~optional rst))) 181 | (~optional (~seq #:body body)) 182 | (~optional (~seq #:json json))) ...] 183 | #'(? response? 184 | (~? (app response-status-line line)) 185 | (~? (app response-status-code code)) 186 | (~? (app response-status-message message)) 187 | (~? (app response-http-version version)) 188 | (~? (app response-history history)) 189 | (~? (app response-headers (heads headers ... (~? rst)))) 190 | (~? (app response-body body)) 191 | (~? (app response-json json)))))) 192 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/session.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require net/cookies/user-agent 4 | net/http-client 5 | net/uri-codec 6 | net/url 7 | racket/class 8 | racket/contract/base 9 | racket/format 10 | racket/lazy-require 11 | racket/match 12 | racket/promise 13 | "common.rkt" 14 | "contract.rkt" 15 | "error.rkt" 16 | "logger.rkt" 17 | "payload.rkt" 18 | "pool.rkt" 19 | "proxy.rkt" 20 | "response.rkt" 21 | "timeout.rkt" 22 | "url.rkt" 23 | "user-agent.rkt") 24 | 25 | (lazy-require 26 | [json (jsexpr?)] 27 | [openssl (ssl-client-context? ssl-secure-client-context)] 28 | [racket/unix-socket (unix-socket-connect)]) 29 | 30 | ;; session ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 31 | 32 | (provide 33 | (contract-out 34 | [make-session (->* [] 35 | [#:pool-config pool-config? 36 | #:ssl-context (or/c #f ssl-client-context? (promise/c ssl-client-context?)) 37 | #:cookie-jar (or/c #f (is-a?/c cookie-jar<%>)) 38 | #:proxies (listof proxy?)] 39 | session?)] 40 | [session? (-> any/c boolean?)] 41 | [session-close! (-> session? void?)] 42 | [session-request (->i ([s session?] 43 | [urlish urlish/c]) 44 | (#:close? [close? boolean?] 45 | #:stream? [stream? boolean?] 46 | #:method [method method/c] 47 | #:headers [headers headers/c] 48 | #:params [params query-params/c] 49 | #:auth [auth (or/c #f auth-procedure/c)] 50 | #:data [data (or/c #f bytes? string? input-port? payload-procedure/c)] 51 | #:form [form form-data/c] 52 | #:json [json jsexpr?] 53 | #:timeouts [timeouts timeout-config?] 54 | #:max-attempts [max-attempts exact-positive-integer?] 55 | #:max-redirects [max-redirects exact-nonnegative-integer?] 56 | #:user-agent [user-agent (or/c bytes? string?)]) 57 | 58 | #:pre/name (data form json) 59 | "at most one of the #:data, #:form or #:json keyword arguments" 60 | (cond 61 | [(supplied? data) (and (unsupplied-arg? form) (unsupplied-arg? json))] 62 | [(supplied? form) (and (unsupplied-arg? data) (unsupplied-arg? json))] 63 | [(supplied? json) (and (unsupplied-arg? data) (unsupplied-arg? form))] 64 | [else #t]) 65 | 66 | [res response?])])) 67 | 68 | (struct session 69 | (cust 70 | sema 71 | conf 72 | pools 73 | ssl-ctx 74 | cookies 75 | proxies 76 | [closed? #:mutable]) 77 | #:transparent) 78 | 79 | (define (make-session #:pool-config [conf (make-pool-config)] 80 | #:ssl-context [ssl-ctx (delay/sync (ssl-secure-client-context))] 81 | #:cookie-jar [cookies #f] 82 | #:proxies [proxies null]) 83 | (define s 84 | (session 85 | (make-custodian) 86 | (make-semaphore 1) 87 | conf 88 | (make-hash) 89 | ssl-ctx 90 | cookies 91 | proxies 92 | #f)) 93 | (begin0 s 94 | (will-register executor s session-close!) 95 | (log-http-easy-debug "session opened"))) 96 | 97 | (define (session-close! s) 98 | (call-with-semaphore (session-sema s) 99 | (lambda () 100 | (unless (session-closed? s) 101 | (for ([p (in-hash-values (session-pools s))]) 102 | (pool-close! p)) 103 | (set-session-closed?! s #t) 104 | (custodian-shutdown-all (session-cust s)) 105 | (log-http-easy-debug "session closed"))))) 106 | 107 | (define (session-lease s url timeouts) 108 | (parameterize ([current-custodian (session-cust s)]) 109 | (define k (pool-key url)) 110 | (define p 111 | (call-with-semaphore (session-sema s) 112 | (lambda () 113 | (hash-ref! 114 | (session-pools s) k 115 | (lambda () 116 | (log-http-easy-debug "creating pool for key ~a" k) 117 | (define ssl-ctx (session-ssl-ctx s)) 118 | (define proxies (session-proxies s)) 119 | (define connector (make-url-connector url ssl-ctx proxies)) 120 | (make-pool (session-conf s) connector)))))) 121 | (pool-lease p timeouts))) 122 | 123 | (define (session-release s url c) 124 | (define k (pool-key url)) 125 | (define p 126 | (call-with-semaphore (session-sema s) 127 | (lambda () 128 | (hash-ref (session-pools s) k #f)))) 129 | 130 | (when p 131 | (log-http-easy-debug "releasing connection to pool ~a" k) 132 | (pool-release p c))) 133 | 134 | (define supplied? 135 | (compose1 not unsupplied-arg?)) 136 | 137 | (define (session-request sess 138 | urlish 139 | #:close? [close? #f] 140 | #:stream? [stream? #f] 141 | #:method [method 'get] 142 | #:headers [headers (hasheq)] 143 | #:params [params null] 144 | #:auth [auth #f] 145 | #:data [data #f] 146 | #:form [form the-unsupplied-arg] 147 | #:json [json the-unsupplied-arg] 148 | #:timeouts [timeouts (make-timeout-config)] 149 | #:max-attempts [max-attempts 3] 150 | #:max-redirects [max-redirects 16] 151 | #:user-agent [user-agent (current-user-agent)]) 152 | (define enable-breaks? 153 | (break-enabled)) 154 | (define the-data 155 | (cond 156 | [(supplied? form) (form-payload form)] 157 | [(supplied? json) (json-payload json)] 158 | [else data])) 159 | 160 | (define (go u 161 | #:method [method method] ;; noqa 162 | #:headers [headers headers] ;; noqa 163 | #:params [params params] ;; noqa 164 | #:auth [auth auth] ;; noqa 165 | #:data [data the-data] ;; noqa 166 | #:history [history null] 167 | #:attempts [attempts-remaining max-attempts] 168 | #:redirects [redirects-remaining max-redirects]) 169 | (let*-values ([(headers) (hash-set headers 'user-agent user-agent)] 170 | [(headers) (maybe-add-cookie-header sess u headers)] 171 | [(headers params) 172 | (if auth 173 | (auth u headers params) 174 | (values headers params))] 175 | [(headers data) 176 | (if (procedure? data) 177 | (data headers) 178 | (values headers data))]) 179 | (parameterize-break #f 180 | (define conn (session-lease sess u timeouts)) 181 | (define resp 182 | (with-handlers ([exn:break? 183 | (lambda (e) 184 | (log-http-easy-warning "received break") 185 | (http-conn-close! conn) 186 | (session-release sess u conn) 187 | (raise e))] 188 | [exn:fail? 189 | (lambda (e) 190 | (log-http-easy-warning "request failed: ~a" (exn-message e)) 191 | (http-conn-close! conn) 192 | (session-release sess u conn) 193 | (cond 194 | [(exn:fail:http-easy? e) 195 | (log-http-easy-warning "error cannot be retried; bubbling up exception") 196 | (raise e)] 197 | [(positive? attempts-remaining) 198 | (log-http-easy-debug "retrying~n attempts remaining: ~a" (sub1 attempts-remaining)) 199 | (parameterize-break enable-breaks? 200 | (go u #:attempts (sub1 attempts-remaining) #:history history))] 201 | [else 202 | (log-http-easy-warning "out of retries; bubbling up exception") 203 | (raise e)]))]) 204 | (define resp-ch 205 | (make-channel)) 206 | (define thd 207 | (thread 208 | (lambda () 209 | (with-handlers ([exn:break? void] 210 | [exn:fail? (λ (e) (channel-put resp-ch e))]) 211 | (define-values (resp-status resp-headers resp-output) 212 | (http-conn-sendrecv! 213 | conn (url-request-uri u params) 214 | #:close? close? 215 | #:method (method->bytes method) 216 | #:headers (headers->list headers) 217 | #:data (if (input-port? data) 218 | (port->data-procedure data) 219 | data))) 220 | (channel-put 221 | resp-ch 222 | (make-response 223 | resp-status 224 | resp-headers 225 | resp-output 226 | history 227 | (lambda (_) 228 | (session-release sess u conn)))))))) 229 | (with-handlers ([exn:break? 230 | (lambda (e) 231 | (break-thread thd) 232 | (raise e))]) 233 | (sync/enable-break 234 | (handle-evt 235 | resp-ch 236 | (lambda (r) 237 | (when (exn:fail? r) 238 | (raise r)) 239 | (begin0 r 240 | (log-http-easy-debug "response: ~.s" (response-status-line r)) 241 | (maybe-save-cookies! sess u (response-headers r))))) 242 | (handle-evt 243 | (make-request-timeout-evt timeouts) 244 | (lambda (_) 245 | (break-thread thd) 246 | (log-http-easy-warning "request timed out~n method: ~s~n url: ~.s" method urlish) 247 | (raise (make-timeout-error 'request)))))))) 248 | 249 | (cond 250 | [(and (positive? redirects-remaining) (redirect? resp)) 251 | (define location (bytes->string/utf-8 (response-headers-ref resp 'location))) 252 | (define dest-url (ensure-absolute-url u location)) 253 | (log-http-easy-debug "following ~s redirect to ~s" (response-status-code resp) location) 254 | (response-drain! resp) 255 | (response-close! resp) 256 | (parameterize-break enable-breaks? 257 | (go dest-url 258 | #:method (case (response-status-code resp) 259 | [(301 302 303) 'get] 260 | [(307) method]) 261 | #:headers (hash-remove headers 'authorization) 262 | #:auth (and (same-origin? dest-url u) auth) 263 | #:history (cons resp history) 264 | #:redirects (sub1 redirects-remaining)))] 265 | 266 | [(or close? (not stream?)) 267 | (begin0 resp 268 | (response-drain! resp) 269 | (response-close! resp))] 270 | 271 | [else 272 | (begin0 resp 273 | (will-register executor resp response-close!))])))) 274 | 275 | (go (->url urlish))) 276 | 277 | ;; https://www.rfc-editor.org/rfc/rfc2616#section-14.30 278 | (define (ensure-absolute-url orig location) 279 | (define location-url 280 | (string->url/literal location)) 281 | (cond 282 | [(url-host location-url) 283 | location-url] 284 | [(not (url-path-absolute? location-url)) 285 | (error 'ensure-absolute-url "Location destination is relative")] 286 | [else 287 | (match-define (url scheme user host port _ _ _ _) orig) 288 | (match-define (url _ _ _ _ _ path query fragment) location-url) 289 | (url/literal scheme user host port #t path query fragment)])) 290 | 291 | (define (same-origin? a b) 292 | (and 293 | (equal? 294 | (url-scheme a) 295 | (url-scheme b)) 296 | (equal? 297 | (url-host a) 298 | (url-host b)) 299 | (equal? 300 | (url-port a) 301 | (url-port b)))) 302 | 303 | (define (redirect? resp) 304 | (and (memv (response-status-code resp) '(301 302 303 307)) 305 | (response-headers-ref resp 'location) 306 | #t)) 307 | 308 | 309 | ;; GC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 310 | 311 | (define executor 312 | (make-will-executor)) 313 | 314 | (void 315 | (parameterize ([current-namespace (make-empty-namespace)]) 316 | (thread/suspend-to-kill 317 | (lambda () 318 | (let loop () 319 | (with-handlers ([exn:fail? (λ (e) (log-http-easy-warning "will execution failed: ~a" (exn-message e)))]) 320 | (will-execute executor)) 321 | (loop)))))) 322 | 323 | 324 | ;; help ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 325 | 326 | (define ((make-url-connector u ssl-ctx proxies) conn) 327 | (let ([ssl-ctx (if (promise? ssl-ctx) 328 | (force ssl-ctx) 329 | ssl-ctx)]) 330 | (begin0 conn 331 | (cond 332 | [(http-conn-live? conn) 333 | (log-http-easy-debug "reusing connection to ~a" (pool-key u))] 334 | 335 | [else 336 | (log-http-easy-debug "connecting to ~a" (pool-key u)) 337 | (match-define (struct* url ([scheme scheme] [host host] [port port])) u) 338 | (case scheme 339 | [("http+unix") 340 | (define path (form-urlencoded-decode host)) 341 | (define-values (in out) 342 | (unix-socket-connect path)) 343 | (http-conn-open! conn "" #:ssl? (list #f in out close-output-port))] 344 | 345 | [else 346 | (or 347 | (for/first ([p (in-list proxies)] #:when ((proxy-matches? p) u)) 348 | ((proxy-connect! p) conn u ssl-ctx)) 349 | (http-conn-open! conn host 350 | #:port (or port (if (equal? scheme "https") 443 80)) 351 | #:ssl? (and (equal? scheme "https") ssl-ctx)))])])))) 352 | 353 | (define (headers->list headers) 354 | (for/list ([(k v) (in-hash headers)]) 355 | (bytes-append (symbol->bytes k) #": " (->bytes v)))) 356 | 357 | (define ((port->data-procedure inp) write-chunk) 358 | (define buf (make-bytes (* 64 1024))) 359 | (let loop () 360 | (define n-read (read-bytes-avail! buf inp)) 361 | (unless (eof-object? n-read) 362 | (write-chunk (subbytes buf 0 n-read)) 363 | (loop)))) 364 | 365 | (define (pool-key u) 366 | (~a (url-scheme* u) "://" (url-host u) ":" (url-port* u))) 367 | 368 | (define (->bytes v) 369 | (cond 370 | [(bytes? v) v] 371 | [else (string->bytes/utf-8 v)])) 372 | 373 | 374 | ;; cookies ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 375 | 376 | (define (maybe-add-cookie-header s u headers) 377 | (cond 378 | [(session-cookies s) 379 | => (lambda (cookie-jar) 380 | (parameterize ([current-cookie-jar cookie-jar]) 381 | (define hdr (cookie-header u)) 382 | (if hdr (hash-set headers 'cookie hdr) headers)))] 383 | 384 | [else headers])) 385 | 386 | (define (maybe-save-cookies! s u headers/raw) 387 | (define cookie-jar (session-cookies s)) 388 | (when cookie-jar 389 | (parameterize ([current-cookie-jar cookie-jar]) 390 | (extract-and-save-cookies! headers/raw u)))) 391 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/timeout.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract/base) 4 | 5 | (provide 6 | timeout/c 7 | timeout-config? 8 | timeout-config-lease 9 | timeout-config-connect 10 | timeout-config-request 11 | (contract-out 12 | [make-timeout-config (->* () 13 | (#:lease timeout/c 14 | #:connect timeout/c 15 | #:request timeout/c) 16 | timeout-config?)] 17 | [make-request-timeout-evt (-> timeout-config? evt?)])) 18 | 19 | (define timeout/c 20 | (or/c #f (and/c real? positive?))) 21 | 22 | (struct timeout-config (lease connect request) 23 | #:transparent) 24 | 25 | (define (make-timeout-config #:lease [lease 5] 26 | #:connect [connect 5] 27 | #:request [request 30]) 28 | (timeout-config lease connect request)) 29 | 30 | (define (make-request-timeout-evt t) 31 | (alarm-evt 32 | (+ (current-inexact-monotonic-milliseconds) 33 | (* (timeout-config-request t) 1000)) 34 | #t)) 35 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/url.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require net/uri-codec 4 | net/url 5 | racket/contract/base 6 | racket/match 7 | racket/serialize 8 | racket/string) 9 | 10 | (provide 11 | (struct-out url/literal) 12 | string->url/literal 13 | url/literal->string 14 | is-percent-encoded? 15 | urlish/c 16 | ->url 17 | url-scheme* 18 | url-port* 19 | url-request-uri) 20 | 21 | ;; A url/literal is like a url from net/url, but the user, path, query 22 | ;; and fragment are not decoded upon conversion from string and any 23 | ;; components that are already percent-encoded within those fields are 24 | ;; skipped upon conversion back to string. A component is considered to 25 | ;; already be percent-encoded if all of its % characters are followed by 26 | ;; two hexadecimal characters. 27 | ;; 28 | ;; xref https://github.com/rmculpepper/racket-http123/issues/6 29 | (serializable-struct url/literal url ()) 30 | 31 | (define (string->url/literal s) 32 | (match-define (list _ scheme user ipv6host host port path query fragment) 33 | (regexp-match url-regexp s)) 34 | (let* ([scheme (and scheme (string-downcase scheme))] 35 | [host (or (and ipv6host (string-downcase ipv6host)) 36 | (and host (string-downcase host)))] 37 | [port (and port (string->number port))] 38 | [abs? (or (equal? "file" scheme) 39 | (regexp-match? #rx"^/" path) 40 | (and (or host user port) #t))] 41 | [path (let ([components (regexp-split #rx"/" path)]) 42 | (for/list ([component (in-list (if (equal? (car components) "") 43 | (cdr components) 44 | components))]) 45 | (match-define (cons path-component params) 46 | (regexp-split #rx";" component)) 47 | (path/param 48 | (case path-component 49 | [(".") 'same] 50 | [("..") 'up] 51 | [else path-component]) 52 | params)))] 53 | [query (if query 54 | (for/list ([component (in-list (regexp-split #rx"&" query))]) 55 | (match (regexp-split #rx"=" component) 56 | [(list name value) 57 | (cons (string->symbol name) value)] 58 | [(list name) 59 | (cons (string->symbol name) #f)] 60 | [(list name value ...) ;; noqa 61 | (cons (string->symbol name) 62 | (string-join value "="))])) 63 | null)]) 64 | (url/literal scheme user host port abs? path query fragment))) 65 | 66 | (define (url/literal->string u) 67 | (define out (open-output-string)) 68 | (match-define (url scheme user host port abs? path query fragment) u) 69 | (when scheme 70 | (write-string scheme out) 71 | (write-char #\: out)) 72 | (cond 73 | [(or user host port) 74 | (write-string "//" out) 75 | (when user 76 | (write-string (maybe-percent-encode user uri-userinfo-encode) out) 77 | (write-char #\@ out)) 78 | (when host 79 | (cond 80 | [(ipv6-host? host) 81 | (write-char #\[ out) 82 | (write-string host out) 83 | (write-char #\] out)] 84 | [else 85 | (write-string host out)])) 86 | (when port 87 | (write-char #\: out) 88 | (display port out))] 89 | [(equal? scheme "file") 90 | (write-string "//" out)] 91 | [else 92 | (void)]) 93 | (unless (null? path) 94 | (when abs? (write-char #\/ out)) 95 | (let loop ([path-components path]) 96 | (match-define (path/param path-component params) 97 | (car path-components)) 98 | (write-string 99 | (maybe-percent-encode 100 | (case path-component 101 | [(same) "."] 102 | [(up) ".."] 103 | [else path-component]) 104 | uri-path-segment-encode) 105 | out) 106 | (for ([param (in-list params)]) 107 | (write-char #\; out) 108 | (write-string (maybe-percent-encode param uri-path-segment-encode) out)) 109 | (unless (null? (cdr path-components)) 110 | (write-char #\/ out) 111 | (loop (cdr path-components))))) 112 | (unless (null? query) 113 | (write-char #\? out) 114 | (for ([(pair idx) (in-indexed (in-list query))]) 115 | (unless (zero? idx) 116 | (write-char #\& out)) 117 | (match-define (cons (app symbol->string name) value) pair) 118 | (write-string (maybe-percent-encode name form-urlencoded-encode) out) 119 | (when value 120 | (write-char #\= out) 121 | (write-string (maybe-percent-encode value form-urlencoded-encode) out)))) 122 | (when fragment 123 | (write-char #\# out) 124 | (write-string (maybe-percent-encode fragment) out)) 125 | (get-output-string out)) 126 | 127 | (define (maybe-percent-encode s [encode uri-encode]) 128 | (if (is-percent-encoded? s encode) s (encode s))) 129 | 130 | (define (is-percent-encoded? s [encode uri-encode]) 131 | (define num-%-matches (length (regexp-match* #rx"%" s))) 132 | (or (and (> num-%-matches 0) 133 | (= num-%-matches (length (regexp-match* #px"%[a-fA-F0-9]{2}" s)))) 134 | (and (eq? encode form-urlencoded-encode) 135 | (regexp-match? #rx"[+=]" s)))) 136 | 137 | (define (ipv6-host? s) 138 | (regexp-match? #rx"^[0-9a-fA-F:]*:[0-9a-fA-F:]*$" s)) 139 | 140 | (define urlish/c 141 | (or/c bytes? string? url?)) 142 | 143 | (define (->url urlish) 144 | (cond 145 | [(url? urlish) urlish] 146 | [(bytes? urlish) (string->url* (bytes->string/utf-8 urlish))] 147 | [else (string->url* urlish)])) 148 | 149 | (define (string->url* s) 150 | (cond 151 | [(regexp-match? #px"^[^:]+://" s) 152 | (define the-url 153 | (parameterize ([current-alist-separator-mode 'amp]) 154 | (string->url s))) 155 | (struct-copy 156 | url the-url 157 | [scheme (string-trim #:repeat? #t (url-scheme the-url))] 158 | [host (string-trim #:repeat? #t (url-host the-url))])] 159 | [(string-prefix? s "://") 160 | (string->url* (string-append "http" s))] 161 | [else 162 | (string->url* (string-append "http://" s))])) 163 | 164 | (module+ internal 165 | (provide string->url*)) 166 | 167 | (define (url-scheme* u) 168 | (or (url-scheme u) 169 | (case (url-port u) 170 | [(443) "https"] 171 | [else "http"]))) 172 | 173 | (define (url-port* u) 174 | (or (url-port u) 175 | (case (url-scheme u) 176 | [("https") 443] 177 | [else 80]))) 178 | 179 | (define (url-request-uri u [params null]) 180 | (define abs-path 181 | (if (null? (url-path u)) 182 | (list (path/param "" null)) 183 | (url-path u))) 184 | (define all-params 185 | (append (url-query u) params)) 186 | ((if (url/literal? u) 187 | url/literal->string 188 | url->string) 189 | (url #f #f #f #f #t abs-path all-params #f))) 190 | -------------------------------------------------------------------------------- /http-easy-lib/http-easy/private/user-agent.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract/base 4 | racket/port 5 | "reflect.rkt") 6 | 7 | (provide 8 | (contract-out 9 | [current-user-agent (parameter/c (or/c bytes? string?))])) 10 | 11 | (define current-user-agent 12 | (make-parameter 13 | (call-with-output-bytes 14 | (lambda (out) 15 | (fprintf out "net/http-easy (~a; racket[~a] ~a; ~a)" 16 | (system-type 'os) 17 | (case (system-type 'vm) 18 | [(chez-scheme) 'CS] 19 | [else 'BC]) 20 | (version) 21 | (lib-version)))))) 22 | -------------------------------------------------------------------------------- /http-easy-lib/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define license 'BSD-3-Clause) 4 | (define version "0.8.5") 5 | (define collection "net") 6 | (define deps 7 | '(["base" #:version "8.1.0.4"] 8 | "net-cookies-lib" 9 | ["resource-pool-lib" #:version "0.2.1"] 10 | "unix-socket-lib")) 11 | -------------------------------------------------------------------------------- /http-easy-test/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2020-2022 Bogdan Popa 2 | 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions are 5 | met: 6 | 7 | 1. Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | 3. Neither the name of the copyright holder nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 21 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 22 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 23 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 24 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 25 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 26 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /http-easy-test/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define license 'BSD-3-Clause) 4 | (define collection "tests") 5 | (define deps '("base")) 6 | (define build-deps '("http-easy" 7 | "net-cookies-lib" 8 | "rackunit-lib" 9 | ("resource-pool-lib" #:version "0.1") 10 | "web-server-lib")) 11 | (define update-implies '("http-easy")) 12 | -------------------------------------------------------------------------------- /http-easy-test/net/http-easy/http-easy.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require json 4 | net/cookies 5 | net/http-easy 6 | net/url 7 | racket/class 8 | racket/match 9 | rackunit 10 | web-server/dispatch 11 | (only-in web-server/http 12 | binding-id 13 | binding:form-value 14 | binding:file-filename 15 | binding:file-content 16 | bindings-assq 17 | bindings-assq-all 18 | header 19 | header-value 20 | headers-assq* 21 | make-header 22 | permanently 23 | redirect-to 24 | request-bindings/raw 25 | request-headers/raw 26 | request-post-data/raw 27 | response/output 28 | see-other 29 | temporarily/same-method) 30 | "private/common.rkt") 31 | 32 | (provide 33 | http-easy-tests) 34 | 35 | (define http-easy-tests 36 | (test-suite 37 | "http-easy" 38 | 39 | (test-suite 40 | "requesters" 41 | 42 | (test-case "can make plain requests" 43 | (call-with-web-server 44 | (lambda (_req) 45 | (response/output 46 | (lambda (out) 47 | (display "hello" out)))) 48 | (lambda (addr) 49 | (check-equal? (response-body (get addr)) #"hello")))) 50 | 51 | (test-case "can make requests with query params" 52 | (call-with-web-server 53 | (lambda (req) 54 | (response/output 55 | (lambda (out) 56 | (write (for/list ([bind (request-bindings/raw req)]) 57 | (cons (bytes->string/utf-8 (binding-id bind)) 58 | (bytes->string/utf-8 (binding:form-value bind)))) 59 | out)))) 60 | (lambda (addr) 61 | (check-equal? 62 | (read-response 63 | (get addr 64 | #:stream? #t 65 | #:params '((a . "1") 66 | (a . "2") 67 | (b . "3")))) 68 | '(("a" . "1") 69 | ("a" . "2") 70 | ("b" . "3"))) 71 | 72 | (check-equal? 73 | (read-response 74 | (get (string->url (format "~a?a=0" addr)) 75 | #:stream? #t 76 | #:params '((a . "1") 77 | (a . "2") 78 | (b . "3")))) 79 | '(("a" . "0") 80 | ("a" . "1") 81 | ("a" . "2") 82 | ("b" . "3")))))) 83 | 84 | (test-case "#:close? sends 'Connection: close' header" 85 | (call-with-web-server 86 | (lambda (req) 87 | (response/output 88 | (lambda (out) 89 | (write (header-value (headers-assq* #"connection" (request-headers/raw req))) out)))) 90 | (lambda (addr) 91 | (check-equal? 92 | (read 93 | (open-input-bytes 94 | (response-body 95 | (get addr #:close? #t)))) 96 | #"close")))) 97 | 98 | (test-suite 99 | "bodies" 100 | 101 | (test-case "can send bodies" 102 | (call-with-web-server 103 | (lambda (req) 104 | (response/output 105 | (lambda (out) 106 | (display (request-post-data/raw req) out)))) 107 | (lambda (addr) 108 | (check-equal? (response-body (post addr #:data #"hello")) #"hello") 109 | (check-equal? (response-body (post addr #:data "hello")) #"hello") 110 | (check-equal? (response-body (post addr #:data (open-input-string "hello"))) #"hello"))))) 111 | 112 | (test-suite 113 | "auth" 114 | 115 | (test-case "can authenticate requests" 116 | (call-with-web-server 117 | (lambda (req) 118 | (response/output 119 | (lambda (out) 120 | (match (headers-assq* #"authorization" (request-headers/raw req)) 121 | [(header #"authorization" #"Basic QWxhZGRpbjpPcGVuU2VzYW1l") 122 | (write 'ok out)] 123 | 124 | [_ 125 | (write 'fail out)])))) 126 | (lambda (addr) 127 | (check-equal? 128 | (read-response 129 | (get addr #:stream? #t)) 'fail) 130 | (check-equal? 131 | (read-response 132 | (get addr 133 | #:stream? #t 134 | #:auth (basic-auth "Aladdin" "OpenSesame"))) 135 | 'ok))))) 136 | 137 | (test-suite 138 | "json" 139 | 140 | (test-case "can send form payloads" 141 | (call-with-web-server 142 | (lambda (req) 143 | (response/output 144 | (lambda (out) 145 | (write (for/list ([bind (in-list (request-bindings/raw req))]) 146 | (cons (binding-id bind) (binding:form-value bind))) 147 | out)))) 148 | (lambda (addr) 149 | (check-equal? 150 | (read-response 151 | (post addr 152 | #:stream? #t 153 | #:form '((hello . "world")))) 154 | '((#"hello" . #"world")))))) 155 | 156 | (test-case "can send json payloads" 157 | (call-with-web-server 158 | (lambda (req) 159 | (response/output 160 | (lambda (out) 161 | (write (bytes->jsexpr (request-post-data/raw req)) out)))) 162 | (lambda (addr) 163 | (check-equal? 164 | (read-response 165 | (post addr 166 | #:stream? #t 167 | #:json (hasheq 'hello "world"))) 168 | (hasheq 'hello "world")))))) 169 | 170 | (test-suite 171 | "redirects" 172 | 173 | (test-case "30[12] redirects" 174 | (define-values (dispatch _) 175 | (dispatch-rules 176 | [("") 177 | (lambda (_) 178 | (redirect-to "/a" permanently))] 179 | 180 | [("a") 181 | (lambda (_) 182 | (redirect-to "/b"))] 183 | 184 | [("b") 185 | (lambda (_) 186 | (response/output 187 | (lambda (out) 188 | (display "hello" out))))])) 189 | 190 | (call-with-web-server 191 | dispatch 192 | (lambda (addr) 193 | (test-case "can follow redirects" 194 | (check-equal? (response-body (get addr)) #"hello")) 195 | 196 | (test-case "redirects can be exhausted" 197 | (check-equal? 198 | (response-status-code (get addr #:max-redirects 1)) 199 | 302))))) 200 | 201 | (test-case "303 redirects change the request method to GET" 202 | (define-values (dispatch _) 203 | (dispatch-rules 204 | [("") 205 | #:method "post" 206 | (lambda (_) 207 | (redirect-to "/a" see-other))] 208 | 209 | [("a") 210 | #:method "get" 211 | (lambda (_) 212 | (response/output 213 | (lambda (out) 214 | (display "hello" out))))])) 215 | 216 | (call-with-web-server 217 | dispatch 218 | (lambda (addr) 219 | (check-equal? (response-body (post addr)) #"hello")))) 220 | 221 | (test-case "307 redirects preserve the request method" 222 | (define-values (dispatch _) 223 | (dispatch-rules 224 | [("") 225 | #:method "post" 226 | (lambda (_) 227 | (redirect-to "/a" temporarily/same-method))] 228 | 229 | [("a") 230 | #:method "post" 231 | (lambda (_) 232 | (response/output 233 | (lambda (out) 234 | (display "hello" out))))])) 235 | 236 | (call-with-web-server 237 | dispatch 238 | (lambda (addr) 239 | (check-equal? (response-body (post addr)) #"hello")))) 240 | 241 | (test-case "redirects to other origins discard auth" 242 | (call-with-web-server 243 | (lambda (req) 244 | (response/output 245 | (lambda (out) 246 | (if (headers-assq* #"authorization" (request-headers/raw req)) 247 | (write 'fail out) 248 | (write 'ok out))))) 249 | (lambda (addr-1) 250 | (define-values (dispatch _) 251 | (dispatch-rules 252 | [("") 253 | (lambda (_) 254 | (redirect-to "/a"))] 255 | 256 | [("a") 257 | (lambda (_) 258 | (redirect-to addr-1))])) 259 | 260 | (call-with-web-server 261 | (lambda (req) 262 | (match (headers-assq* #"authorization" (request-headers/raw req)) 263 | [(header #"authorization" #"Basic QWxhZGRpbjpPcGVuU2VzYW1l") 264 | (dispatch req)] 265 | 266 | [_ 267 | (response/output 268 | (lambda (out) 269 | (write 'fail/auth out)))])) 270 | (lambda (addr-2) 271 | (check-equal? 272 | (read-response 273 | (get addr-2 274 | #:stream? #t 275 | #:auth (basic-auth "Aladdin" "OpenSesame"))) 276 | 'ok))))))) 277 | 278 | (test-suite 279 | "cookies" 280 | 281 | (test-case "cookies are discarded by default" 282 | (call-with-web-server 283 | (lambda (req) 284 | (response/output 285 | #:headers (list (make-header #"set-cookie" (cookie->set-cookie-header 286 | (make-cookie "a-cookie" "hello")))) 287 | (lambda (out) 288 | (write (headers-assq* #"cookie" (request-headers/raw req)) out)))) 289 | (lambda (addr) 290 | (check-false (read-response (get addr #:stream? #t))) 291 | (check-false (read-response (get addr #:stream? #t)))))) 292 | 293 | (test-case "cookie jars preserve cookies" 294 | (call-with-web-server 295 | (lambda (req) 296 | (response/output 297 | #:headers (list (make-header #"set-cookie" (cookie->set-cookie-header 298 | (make-cookie "a-cookie" "hello")))) 299 | (lambda (out) 300 | (cond 301 | [(headers-assq* #"cookie" (request-headers/raw req)) 302 | => (lambda (hdr) 303 | (write (header-value hdr) out))] 304 | 305 | [else (write #f out)])))) 306 | (lambda (addr) 307 | (parameterize ([current-session (make-session #:cookie-jar (new list-cookie-jar%))]) 308 | (check-false (read-response (get addr #:stream? #t))) 309 | (check-equal? (read-response (get addr #:stream? #t)) 310 | #"a-cookie=hello")))))) 311 | 312 | (test-suite 313 | "timeouts" 314 | 315 | (test-case "raises response timeouts when the remote end is too slow" 316 | (define counter 0) 317 | (call-with-web-server 318 | (lambda (_req) 319 | (sleep 3) 320 | (response/output 321 | (lambda (out) 322 | (define id counter) 323 | (set! counter (add1 counter)) 324 | (fprintf out "hello (~a)" id)))) 325 | (lambda (addr) 326 | (check-exn 327 | exn:fail:http-easy:timeout? 328 | (lambda () 329 | (get addr #:timeouts (make-timeout-config #:request 1)))) 330 | ;; Issue #21 331 | (check-equal? 332 | (response-body (get addr)) 333 | #"hello (1)"))))) 334 | 335 | (test-suite 336 | "multipart payloads" 337 | 338 | (test-case "uploads files" 339 | (call-with-web-server 340 | (lambda (req) 341 | (response/output 342 | (lambda (out) 343 | (write 344 | (for/list ([f (in-list (bindings-assq-all #"f" (request-bindings/raw req)))]) 345 | (cons (binding:file-filename f) 346 | (binding:file-content f))) 347 | out)))) 348 | (lambda (addr) 349 | (parameterize ([current-session (make-session)]) 350 | (check-equal? 351 | (read-response 352 | (post 353 | #:stream? #t 354 | #:data (multipart-payload 355 | (field-part "a" (open-input-string "hello")) 356 | (file-part "f" (open-input-string "{}") "a.json") 357 | (file-part "f" (open-input-string "{}") "b.json")) 358 | addr)) 359 | (list 360 | (cons #"a.json" #"{}") 361 | (cons #"b.json" #"{}")))))))) 362 | 363 | (test-suite 364 | "non-compliant servers" 365 | 366 | ;; xref: racket-http-easy#18 367 | (test-case "response without status reason" 368 | (call-with-tcp-server 369 | (lambda (_lines out) 370 | (fprintf out "HTTP/1.1 200\r\n") 371 | (fprintf out "Connection: close\r\n") 372 | (fprintf out "Content-Length: 5\r\n") 373 | (fprintf out "\r\n") 374 | (fprintf out "hello")) 375 | (lambda (port) 376 | (check-equal? 377 | (response-body 378 | (get (format "http://127.0.0.1:~a" port))) 379 | #"hello")))) 380 | 381 | ;; xref: https://chrt.fm/track/E341G/dts.podtrac.com/redirect.mp3/prfx.byspotify.com/e/rss.art19.com/episodes/f441d319-c90a-4632-bed5-5bd3e596018e.mp3?rss_browser=BAhJIg9Qb2RjYXRjaGVyBjoGRVQ%3D--8c940e38b58f38097352f6f4709902a1b7f12844 382 | (test-case "redirect to location with encoded + in path" 383 | (call-with-tcp-server 384 | (lambda (lines out) 385 | (match (car lines) 386 | ["GET / HTTP/1.1" 387 | (fprintf out "HTTP/1.1 302 Found\r\n") 388 | (fprintf out "Location: /a%2Bb.mp3\r\n") 389 | (fprintf out "\r\n")] 390 | ["GET /a%2Bb.mp3 HTTP/1.1" 391 | (fprintf out "HTTP/1.1 200 OK\r\n") 392 | (fprintf out "Content-Length: 2\r\n") 393 | (fprintf out "\r\n") 394 | (fprintf out "ok")] 395 | ["GET /a+b.mp3 HTTP/1.1" 396 | (fprintf out "HTTP/1.1 400 Bad Request\r\n") 397 | (fprintf out "Content-Length: 3\r\n") 398 | (fprintf out "\r\n") 399 | (fprintf out "err")])) 400 | (lambda (port) 401 | (parameterize ([current-session (make-session)]) 402 | (check-equal? (response-body (get (format "http://127.0.0.1:~a" port))) #"ok") 403 | ;; https://github.com/Bogdanp/racket-http-easy/issues/25 404 | (check-equal? (response-body (get (string->url/literal (format "http://127.0.0.1:~a/a%2Bb.mp3" port)))) #"ok")))))) 405 | 406 | (test-suite 407 | "custom port" 408 | 409 | ;; xref: racket-http-easy#26 410 | (test-case "can commit peeked progress" 411 | (call-with-web-server 412 | (lambda (_req) 413 | (response/output 414 | (lambda (out) 415 | (displayln "hello, world!" out)))) 416 | (lambda (addr) 417 | (parameterize ([current-session (make-session)]) 418 | (define r (get #:stream? #t addr)) 419 | (define in (response-output r)) 420 | (check-equal? (peek-bytes 5 0 in) #"hello") 421 | (check-true (port-commit-peeked 5 (port-progress-evt in) always-evt in)) 422 | (check-equal? (read-bytes 8 in) #", world!"))))))) 423 | 424 | (test-suite 425 | "session" 426 | 427 | (test-suite 428 | "create" 429 | 430 | (test-case "cookie jar can be #f" 431 | (check-true (session? (make-session #:cookie-jar #f)))) 432 | 433 | (test-case "cookie jar cannot be a symbol" 434 | (check-exn exn:fail:contract? (lambda () (make-session #:cookie-jar 'oops))))) 435 | 436 | (test-suite 437 | "breaks" 438 | 439 | (test-case "can break a request" 440 | (call-with-web-server 441 | (lambda (_req) 442 | (sleep 30) 443 | (response/output 444 | (lambda (out) 445 | (displayln "hello, world!" out)))) 446 | (lambda (addr) 447 | (define thd 448 | (thread 449 | (lambda () 450 | (with-handlers ([exn:break? void]) 451 | (get addr))))) 452 | (sync (system-idle-evt)) 453 | (break-thread thd) 454 | (sync (system-idle-evt)) 455 | (check-not-false (sync/timeout 0 thd))))) 456 | 457 | (test-case "breaking is safe" 458 | (define sema (make-semaphore)) 459 | (call-with-web-server 460 | (lambda (_req) 461 | (response/output 462 | (lambda (out) 463 | (semaphore-wait sema) 464 | (displayln "hello, world!" out)))) 465 | (lambda (addr) 466 | (parameterize ([current-session 467 | (make-session 468 | #:pool-config 469 | (make-pool-config 470 | #:max-size 1))]) 471 | (define thd 472 | (thread 473 | (lambda () 474 | (with-handlers ([exn:break? void]) 475 | (get addr))))) 476 | (sync (system-idle-evt)) 477 | (break-thread thd) 478 | (semaphore-post sema) 479 | (semaphore-post sema) 480 | (check-not-false (get addr)))))))))) 481 | 482 | (module+ test 483 | (require rackunit/text-ui) 484 | (run-tests http-easy-tests)) 485 | -------------------------------------------------------------------------------- /http-easy-test/net/http-easy/private/common.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/async-channel 4 | racket/match 5 | racket/tcp 6 | web-server/servlet-dispatch 7 | web-server/web-server) 8 | 9 | (provide 10 | call-with-tcp-server 11 | call-with-web-server) 12 | 13 | (define (call-with-tcp-server handle proc) 14 | (define listener 15 | (tcp-listen 0 128 "127.0.0.1")) 16 | (define-values (_host port _remote-host _remote-port) 17 | (tcp-addresses listener #t)) 18 | (define stop-ch (make-channel)) 19 | (thread 20 | (lambda () 21 | (let connection-loop () 22 | (sync 23 | (handle-evt 24 | stop-ch 25 | (lambda (_) 26 | (void))) 27 | (handle-evt 28 | (tcp-accept-evt listener) 29 | (lambda (ports) 30 | (match-define (list in out) ports) 31 | (let loop ([lines null]) 32 | (define line 33 | (read-line in 'return-linefeed)) 34 | (cond 35 | [(or (eof-object? line) 36 | (string=? line "")) 37 | (tcp-abandon-port in) 38 | (with-handlers ([exn:fail? (lambda (e) 39 | (log-error "tcp-server handler failed: ~a" (exn-message e)))]) 40 | (handle (reverse lines) out))] 41 | [else 42 | (loop (cons line lines))])) 43 | (flush-output out) 44 | (close-output-port out) 45 | (connection-loop))))))) 46 | (dynamic-wind 47 | void 48 | (lambda () 49 | (proc port)) 50 | (lambda () 51 | (channel-put stop-ch #t) 52 | (tcp-close listener)))) 53 | 54 | (define (call-with-web-server start proc) 55 | (define ch (make-async-channel)) 56 | (define stop 57 | (serve 58 | #:port 0 59 | #:dispatch (dispatch/servlet start) 60 | #:confirmation-channel ch)) 61 | 62 | (define exn-or-port (sync ch)) 63 | (when (exn:fail? exn-or-port) 64 | (raise exn-or-port)) 65 | 66 | (dynamic-wind 67 | void 68 | (lambda () 69 | (proc (format "http://127.0.0.1:~a" exn-or-port))) 70 | (lambda () 71 | (stop)))) 72 | -------------------------------------------------------------------------------- /http-easy-test/net/http-easy/private/payload.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require file/gunzip 4 | json 5 | net/http-easy/private/payload 6 | racket/port 7 | rackunit) 8 | 9 | (provide 10 | payload-tests) 11 | 12 | (define payload-tests 13 | (test-suite 14 | "payload" 15 | 16 | (test-suite 17 | "gzip-payload" 18 | 19 | (test-case "roundtrip" 20 | (define v (hasheq 'hello "world")) 21 | (define-values (hs inp) 22 | ((gzip-payload (json-payload v)) (hasheq))) 23 | 24 | (check-equal? hs (hasheq 'content-encoding #"gzip" 25 | 'content-type #"application/json; charset=utf-8")) 26 | 27 | (define-values (in out) (make-pipe)) 28 | (gunzip-through-ports inp out) 29 | (check-equal? (read-json in) (hasheq 'hello "world")))) 30 | 31 | (test-suite 32 | "multipart-payload" 33 | 34 | (test-case "payload" 35 | (define-values (hs inp) 36 | ((multipart-payload 37 | #:boundary "the-boundary" 38 | (field-part "a" "hello") 39 | (file-part "f" (open-input-string "untitled")) 40 | (file-part "f" (open-input-string "hello") "hello.txt") 41 | (file-part "f" (open-input-string "{}") "hello.json" "application/json")) 42 | (hasheq))) 43 | 44 | (check-equal? 45 | hs 46 | (hasheq 'content-type "multipart/form-data; boundary=the-boundary")) 47 | 48 | (define lines 49 | (port->lines inp #:line-mode 'return-linefeed)) 50 | (check-equal? 51 | lines 52 | '("--the-boundary" 53 | "content-disposition: form-data; name=\"a\"" 54 | "content-type: text/plain" 55 | "" 56 | "hello" 57 | "--the-boundary" 58 | "content-disposition: form-data; name=\"f\"; filename=\"string\"" 59 | "content-type: application/octet-stream" 60 | "" 61 | "untitled" 62 | "--the-boundary" 63 | "content-disposition: form-data; name=\"f\"; filename=\"hello.txt\"" 64 | "content-type: application/octet-stream" 65 | "" 66 | "hello" 67 | "--the-boundary" 68 | "content-disposition: form-data; name=\"f\"; filename=\"hello.json\"" 69 | "content-type: application/json" 70 | "" 71 | "{}" 72 | "--the-boundary--"))) 73 | 74 | (test-case "quoting" 75 | (define-values (_hs inp) 76 | ((multipart-payload 77 | #:boundary "boundary" 78 | (file-part "f" (open-input-string "hello") "a-name-with\\-and\"")) 79 | (hasheq))) 80 | 81 | (check-equal? 82 | (port->lines inp #:line-mode 'return-linefeed) 83 | '("--boundary" 84 | "content-disposition: form-data; name=\"f\"; filename=\"a-name-with\\\\-and\\\"\"" 85 | "content-type: application/octet-stream" 86 | "" 87 | "hello" 88 | "--boundary--")))))) 89 | 90 | (module+ test 91 | (require rackunit/text-ui) 92 | (run-tests payload-tests)) 93 | -------------------------------------------------------------------------------- /http-easy-test/net/http-easy/private/pool.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (prefix-in d: data/pool) 4 | net/http-client 5 | net/http-easy 6 | net/http-easy/private/pool 7 | rackunit) 8 | 9 | (provide 10 | pool-tests) 11 | 12 | (define pool-tests 13 | (test-suite 14 | "pool" 15 | 16 | (test-suite 17 | "pool-lease" 18 | 19 | (test-case "leases connections from the pool" 20 | (define p (make-pool (make-pool-config #:max-size 1) values)) 21 | (define c (pool-lease p)) 22 | (check-true (http-conn? c)) 23 | (pool-release p c)) 24 | 25 | (test-case "leases connections from the pool to waiters" 26 | (define p (make-pool (make-pool-config #:max-size 1) values)) 27 | (define c1 (pool-lease p)) 28 | (define c2 #f) 29 | (define thd 30 | (thread 31 | (lambda () 32 | (set! c2 (pool-lease p))))) 33 | 34 | (pool-release p c1) 35 | (sync thd) 36 | (check-true (http-conn? c2))) 37 | 38 | (test-case "times out when connections take too long" 39 | (define p 40 | (make-pool (make-pool-config #:max-size 1) 41 | (lambda (c) 42 | (begin0 c 43 | (sleep 10))))) 44 | 45 | (check-exn 46 | (lambda (e) 47 | (and (exn:fail:http-easy:timeout? e) 48 | (eq? (exn:fail:http-easy:timeout-kind e) 'connect))) 49 | (lambda () 50 | (pool-lease p (make-timeout-config #:connect 0.01))))) 51 | 52 | (test-case "times out when no connections are available" 53 | (define p (make-pool (make-pool-config #:max-size 1) values)) 54 | (define c1 (pool-lease p)) 55 | (check-exn 56 | (lambda (e) 57 | (and (exn:fail:http-easy:timeout? e) 58 | (eq? (exn:fail:http-easy:timeout-kind e) 'lease))) 59 | (lambda () 60 | (pool-lease p (make-timeout-config #:lease 0.01)))) 61 | 62 | (pool-release p c1) 63 | (define c2 (pool-lease p (make-timeout-config #:lease 1))) 64 | (check-true (http-conn? c2))) 65 | 66 | (test-case "times out idle connections" 67 | (parameterize ([d:current-idle-timeout-slack 0]) 68 | (define t 0.1) 69 | (define p (make-pool (make-pool-config #:max-size 1 #:idle-timeout t) values)) 70 | (define c1 (pool-lease p)) 71 | (pool-release p c1) 72 | (define c2 (pool-lease p)) 73 | (pool-release p c2) 74 | (check-eq? c1 c2) 75 | (sleep t) 76 | (sync (system-idle-evt)) 77 | (define c3 (pool-lease p)) 78 | (check-not-eq? c2 c3)))))) 79 | 80 | (module+ test 81 | (require rackunit/text-ui) 82 | (run-tests pool-tests)) 83 | -------------------------------------------------------------------------------- /http-easy-test/net/http-easy/private/response.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require net/http-easy/private/response 4 | racket/match 5 | rackunit) 6 | 7 | (provide 8 | response-tests) 9 | 10 | (define (make-test-response 11 | #:status [status #"HTTP/1.1 200 OK"] 12 | #:headers [headers null] 13 | #:body [body (open-input-bytes #"")] 14 | #:history [history null] 15 | #:closer [closer void]) 16 | (make-response status headers body history closer)) 17 | 18 | (define response-tests 19 | (test-suite 20 | "response" 21 | 22 | (test-suite 23 | "match expanders" 24 | 25 | (test-case "(response) matches every response" 26 | (check-true 27 | (match (make-test-response) 28 | [(response) #t]))) 29 | 30 | (test-case "(response #:accessor ...) matches on #:accessor" 31 | (check-equal? 32 | (match (make-test-response) 33 | [(response #:status-code 400) 400] 34 | [(response #:status-code 200 #:http-version #"1.1") 200]) 35 | 200)) 36 | 37 | (test-case "(response #:headers ...) matches on headers" 38 | (check-equal? 39 | (match (make-test-response #:headers (list #"Content-Type: text/html" 40 | #"Set-Cookie: a=1" 41 | #"Set-Cookie: b=2")) 42 | [(response #:headers [(set-cookie v1) 43 | (set-cookie v2)] hs) 44 | (check-equal? hs '(#"Content-Type: text/html")) 45 | (bytes-append v1 v2)] 46 | 47 | [_ 'fail]) 48 | #"a=1b=2"))))) 49 | 50 | (module+ test 51 | (require rackunit/text-ui) 52 | (run-tests response-tests)) 53 | -------------------------------------------------------------------------------- /http-easy-test/net/http-easy/private/url.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require net/http-easy/private/url 4 | (submod net/http-easy/private/url internal) 5 | net/url 6 | rackunit) 7 | 8 | (provide 9 | url-tests) 10 | 11 | (define url-tests 12 | (test-suite 13 | "url" 14 | 15 | (test-suite 16 | "url-request-uri" 17 | 18 | (test-case "extracts various kinds of paths" 19 | (define tests 20 | '(("http://example.com" () "/") 21 | ("http://example.com" ((a . "b")) "/?a=b") 22 | ("http://example.com/" () "/") 23 | ("://example.com/a/b/c" () "/a/b/c") 24 | ("/a/b/c/d" () "/a/b/c/d") 25 | ("/a/b/c/d/" () "/a/b/c/d/") 26 | ("/a/b?c=d" () "/a/b?c=d") 27 | ("/a/b?c=å" () "/a/b?c=%C3%A5") 28 | ("/a/b?c=å" ((d . "e")) "/a/b?c=%C3%A5&d=e") 29 | ("/a;b/c" () "/a;b/c") 30 | ("/å/b/c" () "/%C3%A5/b/c"))) 31 | 32 | (for* ([tuple (in-list tests)] 33 | [s (in-value (car tuple))] 34 | [p (in-value (cadr tuple))] 35 | [e (in-value (caddr tuple))]) 36 | (check-equal? (url-request-uri (string->url* s) p) e)))) 37 | 38 | (test-suite 39 | "string->url*" 40 | 41 | (test-case "normalizes various types of URIs before parsing" 42 | (define tests 43 | '(("example.com" . "http://example.com") 44 | ("example.com:80" . "http://example.com:80") 45 | ("example.com:443" . "http://example.com:443") 46 | ("example.com " . "http://example.com") 47 | ("example.com/a/b/c" . "http://example.com/a/b/c") 48 | ("://example.com " . "http://example.com") 49 | ("https://example.com?a=hello " . "https://example.com?a=hello+") 50 | ("https://example.com " . "https://example.com") 51 | ("https://example.com/a/b/c" . "https://example.com/a/b/c") 52 | ("https://example.com/a/b?c=d;e" . "https://example.com/a/b?c=d%3Be"))) 53 | 54 | (for* ([pair (in-list tests)] 55 | [s (in-value (car pair))] 56 | [e (in-value (cdr pair))]) 57 | (check-equal? (url->string (string->url* s)) e s)))) 58 | 59 | (test-suite 60 | "url/literal" 61 | 62 | (test-case "roundtrips" 63 | (define tests 64 | '(("http://example.com" . "http://example.com") 65 | ("http://bogdan@example.com:5100" . "http://bogdan@example.com:5100") 66 | ("http://example.com/a/b/c" . "http://example.com/a/b/c") 67 | ("http://example.com/a%2Bb.mp3" . "http://example.com/a%2Bb.mp3") 68 | ("http://example.com/a%2Bb.mp3?c=d+e" . "http://example.com/a%2Bb.mp3?c=d+e") 69 | ("http://example.com/a%2Bb.mp3?c=d+e&f&g=h" . "http://example.com/a%2Bb.mp3?c=d+e&f&g=h") 70 | ("https://yleawsaudioipv4.akamaized.net/download/world/78-e0812afa331548619c40a31f60a2d6c3/audio-1742305456621.mp3/filename/Nyhetspodden-Alla-vill-ha-Gronland--men-vad-vill-gronlanningarna-sjalva-2025-03-19.mp3?hdnts=exp=1742456407~acl=/download/world/78-e0812afa331548619c40a31f60a2d6c3/audio-1742305456621.mp3/filename/Nyhetspodden-Alla-vill-ha-Gronland--men-vad-vill-gronlanningarna-sjalva-2025-03-19.mp3~hmac=4cf1fae52a5f2aea1a12f2d677c364668a893b311a4ed761d9d7c259b229841a" 71 | . "https://yleawsaudioipv4.akamaized.net/download/world/78-e0812afa331548619c40a31f60a2d6c3/audio-1742305456621.mp3/filename/Nyhetspodden-Alla-vill-ha-Gronland--men-vad-vill-gronlanningarna-sjalva-2025-03-19.mp3?hdnts=exp=1742456407~acl=/download/world/78-e0812afa331548619c40a31f60a2d6c3/audio-1742305456621.mp3/filename/Nyhetspodden-Alla-vill-ha-Gronland--men-vad-vill-gronlanningarna-sjalva-2025-03-19.mp3~hmac=4cf1fae52a5f2aea1a12f2d677c364668a893b311a4ed761d9d7c259b229841a") 72 | ("a/b/c" . "a/b/c") 73 | ("/a/b/c" . "/a/b/c") 74 | ("/a;b;c" . "/a;b;c"))) 75 | 76 | (for* ([pair (in-list tests)] 77 | [s (in-value (car pair))] 78 | [e (in-value (cdr pair))]) 79 | (check-equal? (url/literal->string (string->url/literal s)) e s))) 80 | 81 | (test-case "oracle" 82 | (define tests 83 | '("http://example.com" 84 | "http://example.com/" 85 | "http://example.com/a/b/c?d=e" 86 | "http://example.com/a/b/c?d=e f" 87 | "http://example.com/a;b" 88 | "http://example.com/a/b c;d" 89 | "http://example.com/a/b c;d e" 90 | "http://bogdan@example.com" 91 | "http://bogdan:secret pass@example.com" 92 | "http://bogdan:secret pass@example.com#fragment" 93 | "http://bogdan:secret pass@example.com#fragment a" 94 | "a/b/c" 95 | "/a/b/c")) 96 | 97 | (for ([test (in-list tests)]) 98 | (check-equal? 99 | (url/literal->string (string->url/literal test)) 100 | (url->string (string->url test))))) 101 | 102 | (test-case "examples" 103 | (let ([example "https://d12xz7rzfw7xh7.cloudfront.net/v1/download/episodes/original/43796816?a=en&eg=https%3A%2F%2Fapi.spreaker.com%2Fepisode%2F57758598&eu=https%3A%2F%2Fdts.podtrac.com%2Fredirect.mp3%2Fapi.spreaker.com%2Fdownload%2Fepisode%2F57758598%2Ftmp9u92imeh.mp3&p=3&q=9808638&f=559&r=128&t=3&u=11393707&o=2401044&d=2023-11-22&g=57758598&h=5937276&k=https%3A%2F%2Fwww.spreaker.com%2Fshow%2F5937276%2Fepisodes%2Ffeed&i=43796816&n=Petros+And+Money&b=%5B%22IAB6-7%22%2C%22IAB7-39%22%2C%22IAB11-4%22%2C%22IAB26%22%5D&c=%5B%22sports%22%5D&l=%5B%22hosting_plan_ihr%22%5D&m=%5B904294%2C904294%2C904294%2C1436858%2C1436858%2C1436858%2C1436858%2C1436858%2C1937091%2C1937091%2C1937091%5D&rr=4444444444444&fax=0.4&Expires=1732993926&Signature=XDgffPCg91Gd6ThNXoenP4axeBN2zEUK6Bs56F2Pw-LGE9XJuLPghg1f2etV1l6I3%7Ed7Ms12AQbkCp1vfkqleStA30fPDH2PpO1IKkw5k7PlSYyPCeb1DOc1No8s6KHn7C8DZ7swXjWEz5WGzrj6KtSgI%7EWMhQyiLuGxEmT9YBQViowMGeO7p1PNocQmT-SKo8WqMDMdzMmSXP2WQFYSk3AjFM2ukhGLzDkIcrNxy2ZRLGeUykF9ZWgNnGGAOfwsmx6n0IFQZcdDo2QpRKxOUjSBYOTxTo1Y716OYb73P59QurF%7El-jM7WLHgvFxWnJQHj9SwCnjSaCJgzDBlh%7EEDQ__&Key-Pair-Id=K1J2BR3INU6RYD"]) 104 | (check-equal? (url/literal->string (string->url/literal example)) example)))) 105 | 106 | (test-suite 107 | "is-percent-encoded?" 108 | 109 | (check-false (is-percent-encoded? "")) 110 | (check-false (is-percent-encoded? "%")) 111 | (check-false (is-percent-encoded? "abc")) 112 | (check-false (is-percent-encoded? "a=b")) 113 | (check-true (is-percent-encoded? "a%2Bb")) 114 | (check-false (is-percent-encoded? "a%2Bb%"))))) 115 | 116 | (module+ test 117 | (require rackunit/text-ui) 118 | (run-tests url-tests)) 119 | -------------------------------------------------------------------------------- /http-easy/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2020-2022 Bogdan Popa 2 | 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions are 5 | met: 6 | 7 | 1. Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | 3. Neither the name of the copyright holder nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 21 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 22 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 23 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 24 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 25 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 26 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /http-easy/guide-log.rktd: -------------------------------------------------------------------------------- 1 | ;; This file was created by make-log-based-eval 2 | ((require racket/contract) ((3) 0 () 0 () () (c values c (void))) #"" #"") 3 | ((require net/http-easy) ((3) 0 () 0 () () (c values c (void))) #"" #"") 4 | ((define res (get "https://example.com")) 5 | ((3) 0 () 0 () () (c values c (void))) 6 | #"" 7 | #"") 8 | ((response-status-code res) ((3) 0 () 0 () () (q values 200)) #"" #"") 9 | ((response-status-message res) 10 | ((3) 0 () 0 () () (c values c (u . #"OK"))) 11 | #"" 12 | #"") 13 | ((response-headers-ref res 'date) 14 | ((3) 0 () 0 () () (c values c (u . #"Sat, 24 Apr 2021 06:58:51 GMT"))) 15 | #"" 16 | #"") 17 | ((subbytes (response-body res) 0 30) 18 | ((3) 0 () 0 () () (c values c (u . #"\n\n\n"))) 19 | #"" 20 | #"") 21 | ((response-close! res) ((3) 0 () 0 () () (c values c (void))) #"" #"") 22 | ((define res (get "https://example.com" #:stream? #t)) 23 | ((3) 0 () 0 () () (c values c (void))) 24 | #"" 25 | #"") 26 | ((input-port? (response-output res)) ((3) 0 () 0 () () (q values #t)) #"" #"") 27 | ((read-string 5 (response-output res)) 28 | ((3) 0 () 0 () () (c values c (u . "\n\n\n\n"))) 41 | #"" 42 | #"") 43 | ((port-closed? (response-output res)) ((3) 0 () 0 () () (q values #t)) #"" #"") 44 | ((response-status-line 45 | (get "https://httpbin.org/basic-auth/Aladdin/OpenSesame")) 46 | ((3) 0 () 0 () () (c values c (u . #"HTTP/1.1 401 UNAUTHORIZED"))) 47 | #"" 48 | #"") 49 | ((response-json 50 | (get 51 | "https://httpbin.org/basic-auth/Aladdin/OpenSesame" 52 | #:auth 53 | (basic-auth "Aladdin" "OpenSesame"))) 54 | ((3) 55 | 0 56 | () 57 | 0 58 | () 59 | () 60 | (c values c (h - () (authenticated . #t) (user u . "Aladdin")))) 61 | #"" 62 | #"") 63 | ((response-json 64 | (get "https://httpbin.org/bearer" #:auth (bearer-auth "secret-api-key"))) 65 | ((3) 66 | 0 67 | () 68 | 0 69 | () 70 | () 71 | (c values c (h - () (authenticated . #t) (token u . "secret-api-key")))) 72 | #"" 73 | #"") 74 | ((response-json 75 | (get 76 | "https://httpbin.org/bearer" 77 | #:auth 78 | (lambda (uri headers params) 79 | (values 80 | (hash-set headers 'authorization "Bearer secret-api-key") 81 | params)))) 82 | ((3) 83 | 0 84 | () 85 | 0 86 | () 87 | () 88 | (c values c (h - () (authenticated . #t) (token u . "secret-api-key")))) 89 | #"" 90 | #"") 91 | ((define res 92 | (response-json 93 | (post "https://httpbin.org/post" #:form '((a . "hello") (b . "there"))))) 94 | ((3) 0 () 0 () () (c values c (void))) 95 | #"" 96 | #"") 97 | ((hash-ref res 'form) 98 | ((3) 0 () 0 () () (c values c (h - () (b u . "there") (a u . "hello")))) 99 | #"" 100 | #"") 101 | ((define res 102 | (response-json 103 | (post 104 | "https://httpbin.org/anything" 105 | #:json 106 | (hasheq 'a "hello" 'b "there")))) 107 | ((3) 0 () 0 () () (c values c (void))) 108 | #"" 109 | #"") 110 | ((hash-ref res 'json) 111 | ((3) 0 () 0 () () (c values c (h - () (b u . "there") (a u . "hello")))) 112 | #"" 113 | #"") 114 | ((define res 115 | (response-json (post "https://httpbin.org/anything" #:data #"hello"))) 116 | ((3) 0 () 0 () () (c values c (void))) 117 | #"" 118 | #"") 119 | ((hash-ref res 'data) ((3) 0 () 0 () () (c values c (u . "hello"))) #"" #"") 120 | ((define res 121 | (response-json 122 | (post 123 | "https://httpbin.org/anything" 124 | #:data 125 | (gzip-payload (pure-payload #"hello"))))) 126 | ((3) 0 () 0 () () (c values c (void))) 127 | #"" 128 | #"") 129 | ((hash-ref res 'data) 130 | ((3) 131 | 0 132 | () 133 | 0 134 | () 135 | () 136 | (c 137 | values 138 | c 139 | (u 140 | . 141 | "data:application/octet-stream;base64,H4sIALDBg2AAA8tIzcnJBwCGphA2BQAAAA=="))) 142 | #"" 143 | #"") 144 | ((define res 145 | (response-json 146 | (post 147 | "https://httpbin.org/anything" 148 | #:data 149 | (gzip-payload (json-payload (hasheq 'hello "world")))))) 150 | ((3) 0 () 0 () () (c values c (void))) 151 | #"" 152 | #"") 153 | ((hash-ref res 'data) 154 | ((3) 155 | 0 156 | () 157 | 0 158 | () 159 | () 160 | (c 161 | values 162 | c 163 | (u 164 | . 165 | "data:application/octet-stream;base64,H4sIALHBg2AAA6tWykjNyclXslIqzy/KSVGqBQDRQQnYEQAAAA=="))) 166 | #"" 167 | #"") 168 | ((require net/cookies net/url racket/class) 169 | ((3) 0 () 0 () () (c values c (void))) 170 | #"" 171 | #"") 172 | ((define jar (new list-cookie-jar%)) 173 | ((3) 0 () 0 () () (c values c (void))) 174 | #"" 175 | #"") 176 | ((define session-with-cookies (make-session #:cookie-jar jar)) 177 | ((3) 0 () 0 () () (c values c (void))) 178 | #"" 179 | #"") 180 | ((parameterize 181 | ((current-session session-with-cookies)) 182 | (get "https://httpbin.org/cookies/set/hello/world") 183 | (response-json (get "https://httpbin.org/cookies"))) 184 | ((3) 0 () 0 () () (c values c (h - () (cookies h - () (hello u . "world"))))) 185 | #"" 186 | #"") 187 | ((for 188 | ((c 189 | (in-list (send jar cookies-matching (string->url "https://httpbin.org"))))) 190 | (printf "~a: ~a" (ua-cookie-name c) (ua-cookie-value c))) 191 | ((3) 0 () 0 () () (c values c (void))) 192 | #"hello: world" 193 | #"") 194 | ((response-status-code (get "http+unix://%2Fvar%2Frun%2Fdocker.sock/info")) 195 | ((3) 0 () 0 () () (q values 200)) 196 | #"" 197 | #"") 198 | ((define res 199 | (post 200 | #:data 201 | (json-payload (hasheq 'hello "world")) 202 | "https://httpbin.org/post")) 203 | ((3) 0 () 0 () () (c values c (void))) 204 | #"" 205 | #"") 206 | ((hash-ref (response-json res) 'data) 207 | ((3) 0 () 0 () () (c values c (u . "{\"hello\":\"world\"}"))) 208 | #"" 209 | #"") 210 | ((require racket/match) ((3) 0 () 0 () () (c values c (void))) #"" #"") 211 | ((match 212 | (get "https://example.com") 213 | ((response 214 | #:status-code 215 | 200 216 | #:headers 217 | ((content-type (and (regexp #"text/html") the-content-type)))) 218 | the-content-type)) 219 | ((3) 0 () 0 () () (c values c (u . #"text/html; charset=UTF-8"))) 220 | #"" 221 | #"") 222 | ((define resp 223 | (post 224 | #:data 225 | (multipart-payload 226 | (field-part "a" "hello") 227 | (file-part "f" (open-input-string "hello world!"))) 228 | "https://httpbin.org/anything")) 229 | ((3) 0 () 0 () () (c values c (void))) 230 | #"" 231 | #"") 232 | ((hash-ref (response-json resp) 'form) 233 | ((3) 0 () 0 () () (c values c (h - () (a u . "hello")))) 234 | #"" 235 | #"") 236 | ((hash-ref (response-json resp) 'files) 237 | ((3) 0 () 0 () () (c values c (h - () (f u . "hello world!")))) 238 | #"" 239 | #"") 240 | -------------------------------------------------------------------------------- /http-easy/http-easy.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require racket/runtime-path 4 | racket/sandbox 5 | scribble/example 6 | (for-label json 7 | net/cookies/user-agent 8 | net/http-client 9 | net/http-easy 10 | net/url 11 | openssl 12 | racket/base 13 | racket/class 14 | racket/contract/base 15 | racket/format 16 | racket/match 17 | racket/promise 18 | xml)) 19 | 20 | @title{@tt{http-easy}: a high-level HTTP client} 21 | @author[(author+email "Bogdan Popa" "bogdan@defn.io")] 22 | @defmodule[net/http-easy] 23 | 24 | This library wraps @tt{net/http-client} to provide a simple interface 25 | for day-to-day use. It automatically handles: 26 | 27 | @itemlist[ 28 | @item{connection pooling} 29 | @item{connection timeouts} 30 | @item{SSL verification} 31 | @item{automatic compression and decompression} 32 | @item{streaming responses} 33 | @item{authentication} 34 | @item{redirect following} 35 | @item{cookie storage} 36 | @item{multipart file uploads} 37 | ] 38 | 39 | 40 | @section{Guide} 41 | 42 | @(begin 43 | (define-syntax-rule (interaction e ...) (examples #:label #f e ...)) 44 | (define-runtime-path log-file "guide-log.rktd") 45 | (define log-mode (if (getenv "HTTP_EASY_RECORD") 'record 'replay)) 46 | (define (make-he-eval log-file) 47 | (define ev (make-log-based-eval log-file log-mode)) 48 | (begin0 ev 49 | (ev '(require racket/contract)))) 50 | (define he-eval (make-he-eval log-file))) 51 | 52 | @subsection{Making Requests} 53 | 54 | Getting started is as easy as requiring the @tt{net/http-easy} module: 55 | 56 | @interaction[ 57 | #:eval he-eval 58 | (require net/http-easy) 59 | ] 60 | 61 | And using one of the built-in requesters to perform a request: 62 | 63 | @interaction[ 64 | #:eval he-eval 65 | (define res 66 | (get "https://example.com")) 67 | ] 68 | 69 | The result is a @racket[response?] value that you can inspect: 70 | 71 | @interaction[ 72 | #:eval he-eval 73 | (response-status-code res) 74 | (response-status-message res) 75 | (response-headers-ref res 'date) 76 | (subbytes (response-body res) 0 30) 77 | ] 78 | 79 | Connections to remote servers are automatically pooled so closing the 80 | response returns its underlying connection to the pool: 81 | 82 | @interaction[ 83 | #:eval he-eval 84 | (response-close! res) 85 | ] 86 | 87 | @(define sr (secref "guide:streaming")) 88 | 89 | If you forget to manually close a response, its underlying connection 90 | will get returned to the pool when the response gets garbage-collected. 91 | Unless you explicitly use @|sr|, you don't have to worry about this 92 | much. 93 | 94 | @subsection[#:tag "guide:streaming"]{Streaming Responses} 95 | 96 | Response bodies can be streamed by passing @racket[#t] as the 97 | @racket[#:stream?] argument to any of the requesters: 98 | 99 | @interaction[ 100 | #:eval he-eval 101 | (define res 102 | (get "https://example.com" #:stream? #t)) 103 | ] 104 | 105 | The input port containing the response body can be accessed using 106 | @racket[response-output]: 107 | 108 | @interaction[ 109 | #:eval he-eval 110 | (input-port? (response-output res)) 111 | (read-string 5 (response-output res)) 112 | (read-string 5 (response-output res)) 113 | ] 114 | 115 | Using @racket[response-body] immediately drains the remaining data and 116 | closes the input port: 117 | 118 | @interaction[ 119 | #:eval he-eval 120 | (subbytes (response-body res) 0 10) 121 | (subbytes (response-body res) 0 20) 122 | (port-closed? (response-output res)) 123 | ] 124 | 125 | @subsection{Authenticating Requests} 126 | 127 | The library provides an auth procedure for HTTP basic auth: 128 | 129 | @interaction[ 130 | #:eval he-eval 131 | (response-status-line 132 | (get "https://httpbin.org/basic-auth/Aladdin/OpenSesame")) 133 | ] 134 | 135 | @interaction[ 136 | #:eval he-eval 137 | (response-json 138 | (get "https://httpbin.org/basic-auth/Aladdin/OpenSesame" 139 | #:auth (basic-auth "Aladdin" "OpenSesame"))) 140 | ] 141 | 142 | And for bearer auth: 143 | 144 | @interaction[ 145 | #:eval he-eval 146 | (response-json 147 | (get "https://httpbin.org/bearer" 148 | #:auth (bearer-auth "secret-api-key"))) 149 | ] 150 | 151 | The above example is equivalent to: 152 | 153 | @interaction[ 154 | #:eval he-eval 155 | (response-json 156 | (get "https://httpbin.org/bearer" 157 | #:auth (lambda (uri headers params) 158 | (values (hash-set headers 'authorization "Bearer secret-api-key") params)))) 159 | ] 160 | 161 | @subsection{Sending Data} 162 | 163 | You can supply a list of pairs to be sent as an 164 | @tt{application/x-www-form-urlencoded} payload: 165 | 166 | @interaction[ 167 | #:eval he-eval 168 | (define res 169 | (response-json 170 | (post "https://httpbin.org/post" 171 | #:form '((a . "hello") 172 | (b . "there"))))) 173 | (hash-ref res 'form) 174 | ] 175 | 176 | Alternatively, you can supply the @racket[#:json] keyword argument to 177 | send an @tt{application/json} payload: 178 | 179 | @interaction[ 180 | #:eval he-eval 181 | (define res 182 | (response-json 183 | (post "https://httpbin.org/anything" 184 | #:json (hasheq 'a "hello" 185 | 'b "there")))) 186 | (hash-ref res 'json) 187 | ] 188 | 189 | To send data using arbitrary formats, you can use the @racket[#:data] 190 | keyword argument: 191 | 192 | @interaction[ 193 | #:eval he-eval 194 | (define res 195 | (response-json 196 | (post "https://httpbin.org/anything" 197 | #:data #"hello"))) 198 | (hash-ref res 'data) 199 | ] 200 | 201 | To gzip the payload, use the @racket[gzip-payload] combinator: 202 | 203 | @interaction[ 204 | #:eval he-eval 205 | (define res 206 | (response-json 207 | (post "https://httpbin.org/anything" 208 | #:data (gzip-payload (pure-payload #"hello"))))) 209 | (hash-ref res 'data) 210 | ] 211 | 212 | @interaction[ 213 | #:eval he-eval 214 | (define res 215 | (response-json 216 | (post "https://httpbin.org/anything" 217 | #:data (gzip-payload (json-payload (hasheq 'hello "world")))))) 218 | (hash-ref res 'data) 219 | ] 220 | 221 | 222 | @subsection{Cookie Storage} 223 | 224 | To store cookies between requests pass a @racket[cookie-jar<%>] into 225 | your @racket[session?]: 226 | 227 | @interaction[ 228 | #:eval he-eval 229 | (require net/cookies 230 | net/url 231 | racket/class) 232 | 233 | (code:line) 234 | (define jar (new list-cookie-jar%)) 235 | (define session-with-cookies 236 | (make-session #:cookie-jar jar)) 237 | 238 | (code:line) 239 | (parameterize ([current-session session-with-cookies]) 240 | (get "https://httpbin.org/cookies/set/hello/world") 241 | (response-json (get "https://httpbin.org/cookies"))) 242 | 243 | (code:line) 244 | (for ([c (in-list (send jar cookies-matching (string->url "https://httpbin.org")))]) 245 | (printf "~a: ~a" (ua-cookie-name c) (ua-cookie-value c))) 246 | ] 247 | 248 | 249 | @subsection{UNIX Sockets} 250 | 251 | To make a request to a UNIX domain socket, pass @tt{http+unix} as the 252 | scheme and url-encode the path to the socket as the host. 253 | 254 | @interaction[ 255 | #:eval he-eval 256 | (response-status-code (get "http+unix://%2Fvar%2Frun%2Fdocker.sock/info")) 257 | ] 258 | 259 | 260 | @section{Reference} 261 | 262 | @(define-syntax-rule (defrequester id t ...) 263 | (defproc (id [uri (or/c bytes? string? url?)] 264 | [#:close? close? boolean? #f] 265 | [#:stream? stream? boolean? #f] 266 | [#:headers headers headers/c (hasheq)] 267 | [#:params params query-params/c null] 268 | [#:auth auth (or/c false/c auth-procedure/c) #f] 269 | [#:data data (or/c false/c bytes? string? input-port? payload-procedure/c) #f] 270 | [#:form form query-params/c _unsupplied] 271 | [#:json json jsexpr? _unsupplied] 272 | [#:timeouts timeouts timeout-config? (make-timeout-config)] 273 | [#:max-attempts max-attempts exact-positive-integer? 3] 274 | [#:max-redirects max-redirects exact-nonnegative-integer? 16] 275 | [#:user-agent user-agent (or/c bytes? string?) (current-user-agent)]) response? t ...)) 276 | 277 | @deftogether[( 278 | @defrequester[get] 279 | @defrequester[post] 280 | @defrequester[delete] 281 | @defrequester[head] 282 | @defrequester[options] 283 | @defrequester[patch] 284 | @defrequester[put] 285 | )]{ 286 | Requesters for each of the standard HTTP methods. See 287 | @racket[session-request] for a description of the individual 288 | arguments. 289 | } 290 | 291 | 292 | @subsection{Sessions} 293 | 294 | @deftogether[( 295 | @defthing[method/c (or/c 'delete 'head 'get 'options 'patch 'post 'put symbol?)] 296 | @defthing[headers/c (hash/c symbol? (or/c bytes? string?))] 297 | @defthing[form-data/c (listof (cons/c symbol? (or/c false/c string?)))] 298 | @defthing[query-params/c (listof (cons/c symbol? (or/c false/c string?)))] 299 | )] 300 | 301 | @defparam[current-session session session? #:value (make-session)]{ 302 | Holds the current session that is used by the @racket[delete], 303 | @racket[head], @racket[get], @racket[options], @racket[patch], 304 | @racket[post] and @racket[put] requesters. 305 | } 306 | 307 | @defproc[(session? [v any/c]) boolean?]{ 308 | Returns @racket[#t] when @racket[v] is a session value. 309 | } 310 | 311 | @defproc[(make-session [#:pool-config pool-config pool-config? (make-pool-config)] 312 | [#:ssl-context ssl-context (or/c #f ssl-client-context? (promise/c ssl-client-context?)) (delay (ssl-secure-client-context))] 313 | [#:cookie-jar cookie-jar (or/c false/c (is-a?/c cookie-jar<%>)) #f] 314 | [#:proxies proxies (listof proxy?) null]) session?]{ 315 | Produces a @racket[session?] value with @racket[#:pool-config] as 316 | its connection pool configuration. Each requested scheme, host and 317 | port pair has its own connection pool. 318 | 319 | The @racket[#:ssl-context] argument controls how HTTPS connections 320 | are handled. The default implementation verifies TLS certificates, 321 | verifies hostnames and avoids using weak ciphers. To use a custom 322 | certificate chain or private key, you can use 323 | @racket[ssl-make-client-context]. 324 | 325 | The @racket[#:cookie-jar] argument specifies the cookie jar to use 326 | to store cookies between requests made against a session. The 327 | default is to discard all cookies. See @racket[list-cookie-jar%]. 328 | 329 | The @racket[#:proxies] argument specifies an optional list of 330 | @tech{proxies} to use when making requests. 331 | 332 | @history[ 333 | #:changed "0.6" @elem{The @racket[#:ssl-context] argument accepts promises.} 334 | #:changed "0.3" @elem{Added the @racket[#:proxies] argument.} 335 | ] 336 | } 337 | 338 | @defproc[(session-close! [s session?]) void?]{ 339 | Closes @racket[s] and all of its associated connections and responses. 340 | } 341 | 342 | @defproc[(session-request [s session?] 343 | [uri (or/c bytes? string? url?)] 344 | [#:close? close? boolean? #f] 345 | [#:stream? stream? boolean? #f] 346 | [#:method method method/c 'get] 347 | [#:headers headers headers/c (hasheq)] 348 | [#:params params query-params/c null] 349 | [#:auth auth (or/c false/c auth-procedure/c) #f] 350 | [#:data data (or/c false/c bytes? string? input-port? payload-procedure/c) #f] 351 | [#:form form form-data/c _unsupplied] 352 | [#:json json jsexpr? _unsupplied] 353 | [#:timeouts timeouts timeout-config? (make-timeout-config)] 354 | [#:max-attempts max-attempts exact-positive-integer? 3] 355 | [#:max-redirects max-redirects exact-nonnegative-integer? 16] 356 | [#:user-agent user-agent (or/c bytes? string?) (current-user-agent)]) response?]{ 357 | 358 | Requests @racket[uri] using @racket[s]'s connection pool and 359 | associated settings (SSL context, proxy, cookie jar, etc.). The 360 | @racket[uri] argument may be a @tech{literal URL}. 361 | 362 | Response values returned by this function must be closed before their 363 | underlying connection is returned to the pool. If the @racket[close?] 364 | argument is @racket[#t], this is done automatically. Ditto if the 365 | responses are garbage-collected. 366 | 367 | If the @racket[close?] argument is @racket[#t], then the response's 368 | output port is drained and the connection is closed. 369 | 370 | If the @racket[stream?] argument is @racket[#f] (the default), then 371 | the response's output port is drained and the resulting byte string 372 | is stored on the response value. The drained data is accessible using 373 | the @racket[response-body] function. If the argument is @racket[#t], 374 | then the response body is streamed and the data is accessible via the 375 | @racket[response-output] function. This argument has no effect when 376 | @racket[close?] is @racket[#t]. 377 | 378 | The @racket[method] argument specifies the HTTP request method to use. 379 | 380 | Query parameters may be specified directly on the @racket[uri] 381 | argument or via the @racket[params] argument. If query parameters are 382 | specified via both arguments, then the list of @racket[params] is 383 | appended to those already in the @racket[uri]. 384 | 385 | The @racket[auth] argument allows authentication headers and query 386 | params to be added to the request. When following redirects, the 387 | auth procedure is applied to subsequent requests only if the target 388 | URL has the @tech{same origin} as the original request. Two URLs are 389 | considered to have the @deftech{same origin} if their scheme, hostname 390 | and port are the same. 391 | 392 | The @racket[data] argument can be used to send arbitrary request data 393 | to the remote end. A number of @tech{payload procedures} are available 394 | for producing data in standard formats: 395 | 396 | @interaction[ 397 | #:eval he-eval 398 | (define res 399 | (post #:data (json-payload (hasheq 'hello "world")) 400 | "https://httpbin.org/post")) 401 | (hash-ref (response-json res) 'data) 402 | ] 403 | 404 | The @racket[form] argument is a shorthand for passing a 405 | @racket[form-payload] as the @racket[data] argument. 406 | 407 | The @racket[json] argument is a shorthand for passing a 408 | @racket[json-payload] as the @racket[data] argument. 409 | 410 | The @racket[data], @racket[form] and @racket[json] arguments are 411 | mutually-exclusive. Supplying more than one at a time causes a 412 | contract error to be raised. 413 | 414 | The @racket[timeouts] argument controls how long various aspects of 415 | the request cycle will be waited on. When a timeout is exceeded, an 416 | @racket[exn:fail:http-easy:timeout?] error is raised. When redirects 417 | are followed, the timeouts are per request. 418 | 419 | The @racket[max-attempts] argument controls how many times connection 420 | errors are retried. This meant to handle connection resets and the 421 | like and isn't a general retry mechanism. 422 | 423 | The @racket[max-redirects] argument controls how many redirects 424 | are followed by the request. Redirect cycles are not detected. To 425 | disable redirect following, set this argument to @racket[0]. The 426 | @tt{Authorization} header is stripped from redirect requests if the 427 | target URL does not have the @tech{same origin} as the original 428 | request. 429 | 430 | @history[#:changed "0.3" @elem{Added support for the @tt{http+unix} 431 | scheme to allow requests to UNIX domain sockets.}] 432 | } 433 | 434 | @deftogether[( 435 | @defproc[(url/literal? [v any/c]) boolean?] 436 | @defproc[(string->url/literal [s string?]) url/literal?] 437 | @defproc[(url/literal->string [u url/literal?]) string?] 438 | )]{ 439 | A predicate and conversion procedures for a variant of @racket[url?] 440 | that does not decode user, path, query and fragment components 441 | upon conversion from string. When converting to a string, only 442 | the components of the aforementioned fields that are not already 443 | percent-encoded are encoded. A component is considered to be percent 444 | encoded if all of its percent characters are followed by two 445 | hexadecimal characters. 446 | 447 | @deftech{Literal URLs} are used automatically when handling redirects 448 | to avoid issues that may pop up when decoding an re-encoding URLs from 449 | standards-non-compliant servers. 450 | 451 | @history[#:added "0.7"] 452 | } 453 | 454 | 455 | @subsection{Responses} 456 | 457 | @defthing[status-code/c (integer-in 100 999)]{ 458 | The contract for HTTP status codes. 459 | } 460 | 461 | @defproc[(response? [v any/c]) boolean?]{ 462 | Returns @racket[#t] when @racket[v] is a response. 463 | } 464 | 465 | @defform[ 466 | (response clause ...) 467 | #:grammar ([clause (code:line #:status-line e) 468 | (code:line #:status-code e) 469 | (code:line #:status-message e) 470 | (code:line #:http-version e) 471 | (code:line #:history e) 472 | (code:line #:headers heads maybe-rest) 473 | (code:line #:body e) 474 | (code:line #:json e)] 475 | [heads ([header-id e] ...)] 476 | [maybe-rest (code:line) 477 | e])]{ 478 | 479 | A match expander for @racket[response?] values. 480 | 481 | @interaction[ 482 | #:eval he-eval 483 | (require racket/match) 484 | 485 | (code:line) 486 | (match (get "https://example.com") 487 | [(response 488 | #:status-code 200 489 | #:headers ([content-type (and (regexp #"text/html") the-content-type)])) 490 | the-content-type]) 491 | ] 492 | } 493 | 494 | @deftogether[( 495 | @defproc[(response-status-line [r response?]) bytes?] 496 | @defproc[(response-http-version [r response?]) bytes?] 497 | @defproc[(response-status-code [r response?]) status-code/c] 498 | @defproc[(response-status-message [r response?]) bytes?] 499 | @defproc[(response-headers [r response?]) (listof bytes?)] 500 | )]{ 501 | Accessors for the raw data available on a response. 502 | } 503 | 504 | @defproc[(response-headers-ref [r response?] 505 | [h symbol?]) (or/c false/c bytes?)]{ 506 | 507 | Looks up the first response header whose name is @racket[h]. Header 508 | names are normalized to lower case. 509 | } 510 | 511 | @defproc[(response-headers-ref* [r response?] 512 | [h symbol?]) (listof bytes?)]{ 513 | 514 | Looks up all the response headers whose names are @racket[h]. As in 515 | @racket[response-headers-ref], the names are all normalized to lower 516 | case. 517 | } 518 | 519 | @defproc[(response-history [r response?]) (listof response?)]{ 520 | When redirects are followed, the trail of redirected responses is 521 | preserved in each individual response. The responses are sorted 522 | reverse chronologically. 523 | } 524 | 525 | @defproc[(response-body [r response?]) bytes?]{ 526 | Drains @racket[r]'s output port and returns the result as a byte 527 | string. 528 | } 529 | 530 | @defproc[(response-output [r response?]) input-port?]{ 531 | Returns a port which contains the contents of the response. If 532 | @racket[response-body] has already been called on the response, then 533 | the port is closed. Likewise, if either @racket[#:close? #t] or 534 | @racket[#:stream? #f] were passed to @racket[session-request], then 535 | the response data is only accessible via @racket[response-body]. 536 | See the @sr section of the guide for an example. 537 | } 538 | 539 | @defproc[(response-json [r response?]) (or/c eof-object? jsexpr?)]{ 540 | Drains @racket[r]'s output port, parses the data as JSON and returns 541 | it. An exception is raised if the data is not valid JSON. 542 | } 543 | 544 | @defproc[(response-xexpr [r response?]) xexpr?]{ 545 | Drains @racket[r]'s output port, parses the data as an @racket[xexpr?] 546 | and returns it. An exception is raised if the data is not valid XML. 547 | } 548 | 549 | @defproc[(response-xml [r response?]) document?]{ 550 | Drains @racket[r]'s output port, parses the data as an XML 551 | @racket[document?] and returns it. An exception is raised if the 552 | data is not valid XML. 553 | } 554 | 555 | @defproc[(read-response [r response?]) any/c]{ 556 | Equivalent to @racket[(read (response-output r))]. 557 | } 558 | 559 | @defproc[(read-response-json [r response?]) (or/c eof-object? jsexpr?)]{ 560 | Equivalent to @racket[(read-json (response-output r))]. 561 | } 562 | 563 | @defproc[(read-response-xexpr [r response?]) xexpr?]{ 564 | Equivalent to @racket[(xml->xexpr (document-element (read-response-xml r)))]. 565 | } 566 | 567 | @defproc[(read-response-xml [r response?]) document?]{ 568 | Equivalent to @racket[(read-xml/document (response-output r))]. 569 | } 570 | 571 | @defproc[(response-drain! [r response?]) void?]{ 572 | Drains @racket[r]'s output port. 573 | } 574 | 575 | @defproc[(response-close! [r response?]) void?]{ 576 | Closes @racket[r] and returns its underlying connection to the pool. 577 | } 578 | 579 | 580 | @subsection{Connection Pooling} 581 | 582 | @defthing[limit/c (or/c +inf.0 exact-positive-integer?)]{ 583 | The contract for limit values. 584 | } 585 | 586 | @defproc[(pool-config? [v any/c]) boolean?]{ 587 | Returns @racket[#t] when @racket[v] is a pool config. 588 | } 589 | 590 | @defproc[(make-pool-config [#:max-size max-size limit/c 128] 591 | [#:idle-timeout idle-timeout timeout/c 600]) pool-config?]{ 592 | 593 | Produce a pool config values that can be passed to 594 | @racket[make-session]. 595 | 596 | The @racket[max-size] argument controls the maximum number of 597 | connections in a pool. Once a pool reaches this size, leasing a 598 | connection blocks until one is available or until the @tt{lease} 599 | timeout is reached. 600 | 601 | The @racket[idle-timeout] argument controls the amount of time idle 602 | connections are kept open for. 603 | } 604 | 605 | 606 | @subsection{Proxies} 607 | 608 | @(define socks5-doc (other-doc '(lib "socks5/socks5.rkt") #:indirect "socks5")) 609 | 610 | @deftech{Proxies} tunnel requests to one host through another. See 611 | @socks5-doc for a @tt{SOCKS5} proxy implementation that is compatible 612 | with this library. 613 | 614 | @defproc[(proxy? [v any/c]) boolean?]{ 615 | Returns @racket[#t] when @racket[v] is a @tech{proxy}. 616 | } 617 | 618 | @defproc[(make-proxy [matches? (-> url? boolean?)] 619 | [connect! (-> http-conn? url? (or/c #f ssl-client-context?) void?)]) proxy?]{ 620 | Returns a new @tech{proxy} that applies to requests whose URL 621 | @racket[matches?] returns @racket[#t] for. 622 | 623 | @history[#:added "0.3"] 624 | } 625 | 626 | @defproc[(make-http-proxy [proxy-url (or/c bytes? string? url?)] 627 | [matches? (-> url? boolean?) (λ (u) (equal? (url-scheme u) "http"))]) proxy?]{ 628 | Returns an HTTP @tt{CONNECT} @racket[proxy?] that tunnels requests 629 | whose URLs @racket[matches?] is @racket[#t] for through the server 630 | at @racket[proxy-url]. 631 | 632 | @history[#:added "0.3"] 633 | } 634 | 635 | @defproc[(make-https-proxy [proxy-url (or/c bytes? string? url?)] 636 | [matches? (-> url? boolean?) (λ (u) (equal? (url-scheme u) "https"))]) proxy?]{ 637 | Returns an HTTPS @tt{CONNECT} @racket[proxy?] that tunnels requests 638 | whose URLs @racket[matches?] is @racket[#t] for through the server 639 | at @racket[proxy-url]. 640 | 641 | @history[#:added "0.3"] 642 | } 643 | 644 | 645 | @subsection{Authentication} 646 | 647 | @defthing[auth-procedure/c (-> url? headers/c query-params/c (values headers/c query-params/c))]{ 648 | The contract for auth procedures. An auth procedure takes the 649 | current request url, headers and query params and returns a new set 650 | of headers and query params augmented with authentication 651 | information. 652 | } 653 | 654 | @defproc[(basic-auth [username (or/c bytes? string?)] 655 | [password (or/c bytes? string?)]) auth-procedure/c]{ 656 | 657 | Generates an auth procedure that authenticates requests using HTTP 658 | basic auth. 659 | } 660 | 661 | @defproc[(bearer-auth [token (or/c bytes? string?)]) auth-procedure/c]{ 662 | Generates an auth procedure that authenticates requests using the 663 | given bearer @racket[token]. 664 | } 665 | 666 | 667 | @subsection{Payload Procedures} 668 | 669 | @deftech{Payload procedures} produce data and associated headers to be 670 | sent to a remote server. 671 | 672 | @defthing[payload-procedure/c (-> headers/c (values headers/c (or/c bytes? string? input-port?)))]{ 673 | The contract for payload procedures. A payload procedure takes the 674 | current set of request headers and returns new request headers and a 675 | value to be used as the request body. 676 | } 677 | 678 | @defproc[(buffered-payload [p payload-procedure/c]) payload-procedure/c]{ 679 | Produces a payload procedure that buffers the output of @racket[p] 680 | in memory in order to determine its length before sending it to the 681 | server. 682 | 683 | @history[#:added "0.8"] 684 | } 685 | 686 | @defproc[(form-payload [v form-data/c]) payload-procedure/c]{ 687 | Produces a payload procedure that encodes @racket[v] as form data 688 | using the @tt{application/x-www-form-urlencoded} content type. 689 | } 690 | 691 | @defproc[(json-payload [v jsexpr?]) payload-procedure/c]{ 692 | Produces a payload procedure that encodes @racket[v] as JSON data. 693 | } 694 | 695 | @defproc[(gzip-payload [p payload-procedure/c]) payload-procedure/c]{ 696 | Produces a payload procedure that gzips the output of @racket[p]. 697 | } 698 | 699 | @defproc[(pure-payload [v (or/c bytes? string? input-port?)]) payload-procedure/c]{ 700 | Produces a payload procedure that uses @racket[v] as the request body. 701 | } 702 | 703 | @defproc[(part? [v any/c]) boolean?]{ 704 | Returns @racket[#t] when @racket[v] is a @racket[multipart-payload] part. 705 | } 706 | 707 | @defproc[(field-part [name (or/c bytes? string?)] 708 | [value (or/c bytes? string?)] 709 | [content-type (or/c bytes? string?) #"text/plain"]) part?]{ 710 | 711 | Produces a @racket[part?] for use with @racket[multipart-payload] 712 | that encapsulates a form field. 713 | } 714 | 715 | @defproc[(file-part [name (or/c bytes? string?)] 716 | [inp input-port?] 717 | [filename (or/c bytes? string?) (~a (object-name inp))] 718 | [content-type (or/c bytes? string?) #"application/octet-stream"]) part?]{ 719 | 720 | Produces a @racket[part?] for use with @racket[multipart-payload] 721 | that encapsulates a file. 722 | } 723 | 724 | @defproc[(multipart-payload [f part?] ... 725 | [#:boundary boundary (or/c bytes? string?) _unsupplied]) payload-procedure/c]{ 726 | 727 | Produces a @tt{multipart/form-data} payload. 728 | 729 | @interaction[ 730 | #:eval he-eval 731 | (define resp 732 | (post 733 | #:data (multipart-payload 734 | (field-part "a" "hello") 735 | (file-part "f" (open-input-string "hello world!"))) 736 | "https://httpbin.org/anything")) 737 | (hash-ref (response-json resp) 'form) 738 | (hash-ref (response-json resp) 'files) 739 | ] 740 | } 741 | 742 | 743 | @subsection{Timeouts} 744 | 745 | @defthing[timeout/c (or/c false/c (and/c real? positive?))]{ 746 | The contract for timeout values. All timeout values represent seconds. 747 | } 748 | 749 | @defproc[(timeout-config? [v any/c]) boolean?]{ 750 | Returns @racket[#t] when @racket[v] is a timeout config value. 751 | } 752 | 753 | @defproc[(make-timeout-config [#:lease lease timeout/c 5] 754 | [#:connect connect timeout/c 5] 755 | [#:request request timeout/c 30]) timeout-config?]{ 756 | 757 | Produces a timeout config value that can be passed to 758 | @racket[session-request]. 759 | 760 | The @racket[lease] argument controls the maximum amount of time 761 | leasing a connection from the connection pool can take. 762 | 763 | The @racket[connect] argument controls how long each connection can 764 | take to connect to the remote end. 765 | 766 | The @racket[request] argument controls how long to wait on a request 767 | before its response headers are returned. 768 | } 769 | 770 | 771 | @subsection{Errors} 772 | 773 | @deftogether[( 774 | @defproc[(exn:fail:http-easy? [v any/c]) boolean?] 775 | @defproc[(exn:fail:http-easy:timeout? [v any/c]) boolean?] 776 | @defproc[(exn:fail:http-easy:timeout-kind [e exn:fail:http-easy:timeout?]) (or/c 'lease 'connect 'request)] 777 | )] 778 | 779 | 780 | @subsection{User Agents} 781 | 782 | @defparam[current-user-agent user-agent (or/c bytes? string?)]{ 783 | Holds the value of the @tt{User-Agent} header that is sent with 784 | every request. 785 | } 786 | -------------------------------------------------------------------------------- /http-easy/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define license 'BSD-3-Clause) 4 | (define collection "net") 5 | (define deps 6 | '("base" 7 | "http-easy-lib")) 8 | (define build-deps 9 | '("net-cookies-doc" 10 | "net-cookies-lib" 11 | "net-doc" 12 | "racket-doc" 13 | "sandbox-lib" 14 | "scribble-lib")) 15 | (define implies 16 | '("http-easy-lib")) 17 | (define scribblings 18 | '(("http-easy.scrbl" () (net-library)))) 19 | --------------------------------------------------------------------------------