├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── info.rkt └── request ├── check.rkt ├── check.scrbl ├── doc-utils ├── def.rkt └── examples.rkt ├── info.rkt ├── main.rkt ├── main.scrbl ├── param.rkt ├── param.scrbl └── private ├── base.rkt ├── base.scrbl ├── call-response.rkt ├── exn.rkt ├── exn.scrbl ├── http-location.rkt ├── http-location.scrbl ├── struct.rkt ├── struct.scrbl ├── wrap.rkt └── wrap.scrbl /.gitignore: -------------------------------------------------------------------------------- 1 | **/compiled/* 2 | **/*.bak 3 | **/*.html 4 | **/*.css 5 | **/*.js 6 | *~ 7 | **.rktd 8 | **.sxref 9 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: false 3 | env: 4 | global: 5 | - RACKET_DIR=~/racket 6 | matrix: 7 | - RACKET_VERSION=6.4 8 | - RACKET_VERSION=6.5 9 | - RACKET_VERSION=6.6 10 | - RACKET_VERSION=7.4 RUN_COVER=true 11 | - RACKET_VERSION=HEAD 12 | 13 | before_install: 14 | - git clone https://github.com/greghendershott/travis-racket.git ../travis-racket 15 | - cat ../travis-racket/install-racket.sh | bash 16 | - export PATH="${RACKET_DIR}/bin:${PATH}" 17 | - raco pkg install --auto cover cover-coveralls doc-coverage 18 | 19 | install: 20 | - raco pkg install --auto $TRAVIS_BUILD_DIR 21 | 22 | script: 23 | - raco test -c request 24 | - raco test --submodule integration-test request 25 | - raco doc-coverage request 26 | - if [ -n "$RUN_COVER" ]; then raco cover -f coveralls -d $TRAVIS_BUILD_DIR/coverage -c request; fi 27 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2016 Jack Firth 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # racket-request [![Build Status](https://travis-ci.org/jackfirth/racket-request.svg?branch=master)](https://travis-ci.org/jackfirth/racket-request) [![Coverage Status](https://coveralls.io/repos/jackfirth/racket-request/badge.svg?branch=master&service=github)](https://coveralls.io/github/jackfirth/racket-request?branch=master) 2 | 3 | [Documentation](http://pkg-build.racket-lang.org/doc/request/index.html) 4 | 5 | Package for simplifying HTTP requests and writing integration tests of REST-ful APIs in Racket 6 | 7 | ``` 8 | $ raco pkg install request 9 | 10 | > (require request) 11 | ``` 12 | 13 | Currently unstable and not guaranteed to maintain backwards compatibility 14 | -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define version "0.1") 6 | 7 | (define deps 8 | '("base" 9 | "fancy-app" 10 | "rackunit-lib" 11 | "scribble-lib" 12 | "typed-racket-lib" 13 | "typed-racket-more")) 14 | 15 | (define build-deps 16 | '("net-doc" 17 | "rackunit-lib" 18 | "rackunit-doc" 19 | "racket-doc")) 20 | 21 | (define test-omit-paths 22 | '("info.rkt" 23 | "request/main.scrbl" 24 | "request/doc-utils" 25 | "request/private/base.scrbl" 26 | "request/private/struct.scrbl")) 27 | -------------------------------------------------------------------------------- /request/check.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "param.rkt" 4 | rackunit) 5 | 6 | (provide (all-from-out "param.rkt") 7 | check-get 8 | check-get-exn 9 | check-get-not-exn 10 | check-put 11 | check-put-exn 12 | check-put-not-exn 13 | check-post 14 | check-post-exn 15 | check-post-not-exn 16 | check-delete 17 | check-delete-exn 18 | check-delete-not-exn) 19 | 20 | (define (fail-check-unless-responses-equal actual-response expected-response) 21 | (unless (equal? actual-response expected-response) 22 | (fail-check "Check failure - expected response does not equal actual response"))) 23 | 24 | 25 | (define-syntax-rule (with-request-check-info (location response) body ...) 26 | (with-check-info (['location location] 27 | ['response response]) 28 | body ...)) 29 | 30 | (define-syntax-rule (with-request-check-info/body (location request-body response) body ...) 31 | (with-check-info (['location location] 32 | ['request-body request-body] 33 | ['response response]) 34 | body ...)) 35 | 36 | 37 | (define (check-response location actual-response response) 38 | (with-request-check-info (location actual-response) 39 | (fail-check-unless-responses-equal actual-response response))) 40 | 41 | (define (check-response/body location body actual-response response) 42 | (with-request-check-info/body (location body actual-response) 43 | (fail-check-unless-responses-equal actual-response response))) 44 | 45 | 46 | (define-check (check-get location response) 47 | (check-response location (get location) response)) 48 | 49 | (define-check (check-get-exn exn-pred location) 50 | (check-exn exn-pred (thunk (get location)))) 51 | 52 | (define-check (check-get-not-exn location) 53 | (check-not-exn (thunk (get location)))) 54 | 55 | 56 | (define-check (check-put location body response) 57 | (check-response/body location body (put location body) response)) 58 | 59 | (define-check (check-put-exn exn-pred location body) 60 | (check-exn exn-pred (thunk (put location body)))) 61 | 62 | (define-check (check-put-not-exn location body) 63 | (check-not-exn (thunk (put location body)))) 64 | 65 | 66 | (define-check (check-post location body response) 67 | (check-response/body location body (post location body) response)) 68 | 69 | (define-check (check-post-exn exn-pred location body) 70 | (check-exn exn-pred (thunk (post location body)))) 71 | 72 | (define-check (check-post-not-exn location body) 73 | (check-not-exn (thunk (post location body)))) 74 | 75 | 76 | (define-simple-check (check-delete location response) 77 | (check-response location (delete location) response)) 78 | 79 | (define-check (check-delete-exn exn-pred location) 80 | (check-exn exn-pred (thunk (delete location)))) 81 | 82 | (define-check (check-delete-not-exn location) 83 | (check-not-exn (thunk (delete location)))) 84 | -------------------------------------------------------------------------------- /request/check.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "doc-utils/examples.rkt" 4 | "doc-utils/def.rkt" 5 | (for-label request/param 6 | racket 7 | rackunit)) 8 | 9 | @title{RackUnit Requester Integration Testing} 10 | @defmodule[request/check] 11 | 12 | This module provides @racket[rackunit] checks that test 13 | requests using the @racket[current-requester] from 14 | @racket[request/param]. This can be used as a lightweight 15 | HTTP API integration testing framework. Note that none of 16 | these checks accept headers. Use @racket[with-requester] 17 | and @racket[add-requester-headers] to add headers to the 18 | current requester for a set of checks. This module also 19 | re-provides everything in @racket[request/param]. 20 | 21 | @(define-syntax-rule (defvoidproc id+formals pre-flow ...) 22 | (defproc id+formals void? pre-flow ...)) 23 | 24 | @defvoidproc[(check-get [location any/c] 25 | [expected-response any/c])]{ 26 | Checks that the result of @racket[(get location)] is 27 | @racket[equal?] to @racket[expected-response]. 28 | } 29 | 30 | @defvoidproc[(check-put [location any/c] 31 | [body any/c] 32 | [expected-response any/c])]{ 33 | Checks that the result of @racket[(put location body)] is 34 | @racket[equal?] to @racket[expected-response]. 35 | } 36 | 37 | @defvoidproc[(check-post [location any/c] 38 | [body any/c] 39 | [expected-response any/c])]{ 40 | Checks that the result of @racket[(post location body)] is 41 | @racket[equal?] to @racket[expected-response]. 42 | } 43 | 44 | @defvoidproc[(check-delete [location any/c] 45 | [expected-response any/c])]{ 46 | Checks that the result of @racket[(delete location body)] is 47 | @racket[equal?] to @racket[expected-response]. 48 | } 49 | 50 | @defvoidproc[(check-get-exn [exn-pred predicate/c] 51 | [location any/c])]{ 52 | Checks that evaluating @racket[(get location)] raises an exception 53 | satisfying @racket[exn-pred]. 54 | } 55 | 56 | @defvoidproc[(check-get-not-exn [location any/c])]{ 57 | Checks that evaluating @racket[(get location)] raises no exceptions. 58 | } 59 | 60 | @defvoidproc[(check-put-exn [exn-pred predicate/c] 61 | [location any/c] 62 | [body any/c])]{ 63 | Checks that evaluating @racket[(put location body)] raises an exception 64 | satisfying @racket[exn-pred]. 65 | } 66 | 67 | @defvoidproc[(check-put-not-exn [location any/c] 68 | [body any/c])]{ 69 | Checks that evaluating @racket[(put location body)] raises no exceptions. 70 | } 71 | 72 | @defvoidproc[(check-post-exn [exn-pred predicate/c] 73 | [location any/c] 74 | [body any/c])]{ 75 | Checks that evaluating @racket[(post location body)] raises an exception 76 | satisfying @racket[exn-pred]. 77 | } 78 | 79 | @defvoidproc[(check-post-not-exn [location any/c] 80 | [body any/c])]{ 81 | Checks that evaluating @racket[(post location body)] raises no exceptions. 82 | } 83 | 84 | @defvoidproc[(check-delete-exn [exn-pred predicate/c] 85 | [location any/c])]{ 86 | Checks that evaluating @racket[(delete location)] raises an exception 87 | satisfying @racket[exn-pred]. 88 | } 89 | 90 | @defvoidproc[(check-delete-not-exn [location any/c])]{ 91 | Checks that evaluating @racket[(delete location)] raises no exceptions. 92 | } 93 | -------------------------------------------------------------------------------- /request/doc-utils/def.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide defrequester 4 | defpredicate 5 | defstructinfo) 6 | 7 | (require scribble/manual 8 | "../private/struct.rkt") 9 | 10 | 11 | (define-syntax-rule (define-defthing-syntax id contract) 12 | (define-syntax-rule (id thing-id pre-flow (... ...)) 13 | (defthing thing-id contract pre-flow (... ...)))) 14 | 15 | (define-defthing-syntax defrequester requester?) 16 | (define-defthing-syntax defpredicate predicate/c) 17 | (define-defthing-syntax defstructinfo struct-info?) 18 | -------------------------------------------------------------------------------- /request/doc-utils/examples.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide request-examples) 4 | 5 | (require scribble/eval) 6 | 7 | 8 | (define-syntax-rule (define-examples-form id require-spec ...) 9 | (begin 10 | (define (eval-factory) 11 | (define base-eval (make-base-eval)) 12 | (base-eval '(require require-spec)) ... 13 | base-eval) 14 | (define-syntax-rule (id datum (... ...)) 15 | (examples #:eval (eval-factory) datum (... ...))))) 16 | 17 | 18 | (define-examples-form request-examples request) 19 | -------------------------------------------------------------------------------- /request/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define name "request") 4 | 5 | (define scribblings '(("main.scrbl" () (library) "request"))) 6 | -------------------------------------------------------------------------------- /request/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | 4 | (require 5 | "private/base.rkt" 6 | "private/struct.rkt" 7 | "private/exn.rkt" 8 | "private/http-location.rkt" 9 | "private/call-response.rkt" 10 | "private/wrap.rkt") 11 | 12 | 13 | (provide 14 | (except-out 15 | (all-from-out 16 | "private/base.rkt" 17 | "private/struct.rkt" 18 | "private/exn.rkt" 19 | "private/http-location.rkt" 20 | "private/wrap.rkt") 21 | requester-get 22 | requester-put 23 | requester-post 24 | requester-delete 25 | struct:requester) 26 | (struct-out http-response)) 27 | -------------------------------------------------------------------------------- /request/main.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @title{Requests} 4 | 5 | @defmodule[request] 6 | 7 | This library includes functions and forms for working with 8 | @deftech[#:key "request"]{requests} and 9 | @deftech[#:key "requester"]{requesters}. A @italic{request} 10 | is either a @deftech[#:key "GET"]{GET} request, a 11 | @deftech[#:key "PUT"]{PUT} request, a 12 | @deftech[#:key "POST"]{POST} request, or a 13 | @deftech[#:key "DELETE"]{DELETE} request. A @italic{requester} 14 | is a value that can be used to perform these types of requests. 15 | This library provides several requesters built on top of the 16 | HTTP protocol, however in principle these functions work with 17 | any requester that can be constructed to perform each of the 18 | types of requests. 19 | 20 | @author[@author+email["Jack Firth" "jackhfirth@gmail.com"]] 21 | 22 | source code: @url["https://github.com/jackfirth/racket-request"] 23 | 24 | @include-section["private/struct.scrbl"] 25 | @include-section["private/wrap.scrbl"] 26 | @include-section["private/base.scrbl"] 27 | @include-section["private/exn.scrbl"] 28 | @include-section["private/http-location.scrbl"] 29 | @include-section["param.scrbl"] 30 | @include-section["check.scrbl"] 31 | -------------------------------------------------------------------------------- /request/param.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "main.rkt") 4 | 5 | (provide 6 | current-requester 7 | with-requester 8 | (rename-out [param-get get] 9 | [param-put put] 10 | [param-post post] 11 | [param-delete delete]) 12 | (except-out (all-from-out "main.rkt") get put post delete)) 13 | 14 | 15 | (define current-requester (make-parameter http-requester)) 16 | 17 | (define-syntax-rule (with-requester requester body ...) 18 | (parameterize ([current-requester requester]) body ...)) 19 | 20 | (define (param-get location #:headers [headers '()]) 21 | (get (current-requester) location #:headers headers)) 22 | 23 | (define (param-put location body #:headers [headers '()]) 24 | (put (current-requester) location body #:headers headers)) 25 | 26 | (define (param-post location body #:headers [headers '()]) 27 | (post (current-requester) location body #:headers headers)) 28 | 29 | (define (param-delete location #:headers [headers '()]) 30 | (delete (current-requester) location #:headers headers)) 31 | -------------------------------------------------------------------------------- /request/param.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "doc-utils/examples.rkt" 4 | "doc-utils/def.rkt" 5 | "private/base.rkt" 6 | (for-label (except-in request get put post delete) 7 | racket 8 | request/param)) 9 | 10 | @title{Parameterized Requests} 11 | 12 | @defmodule[request/param] 13 | 14 | When using requesters, it is usually the case that 15 | first a requester is constructed, then all requests 16 | are made with it. This makes specifying the requester 17 | in each request verbose and redundant. This module 18 | provides request functions that operate using a 19 | @racket[current-requester] parameter which can be 20 | modified using @racket[with-requester]. 21 | 22 | @defparam[current-requester requester requester? 23 | #:value http-requester]{ 24 | The current requester. Defaults to the simple 25 | @racket[http-requester]. 26 | } 27 | 28 | @defform[(with-requester requester-expr body ...) 29 | #:contracts ([requester-expr requester?])]{ 30 | @racket[parameterize]s the @racket[current-requester] to 31 | the result of @racket[requester-expr] in @racket[body ...]. 32 | } 33 | 34 | @deftogether[( 35 | @defproc[(get [location any/c] 36 | [#:headers headers list? '()]) 37 | any/c] 38 | @defproc[(put [location any/c] 39 | [body any/c] 40 | [#:headers headers list? '()]) 41 | any/c] 42 | @defproc[(post [location any/c] 43 | [body any/c] 44 | [#:headers headers list? '()]) 45 | any/c] 46 | @defproc[(delete [location any/c] 47 | [#:headers headers list? '()]) 48 | any/c])]{ 49 | Equivalent to those defined in @racketmodname[request], but using 50 | the @racket[current-requester] to make requests. 51 | } 52 | -------------------------------------------------------------------------------- /request/private/base.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require net/url 4 | fancy-app 5 | "call-response.rkt" 6 | "struct.rkt") 7 | 8 | (provide http-requester) 9 | 10 | 11 | (define (http-get url #:headers [headers '()]) 12 | (call-response/input-url url (get-impure-port _ headers))) 13 | 14 | (define (http-put url body #:headers [headers '()]) 15 | (call-response/input-url url (put-impure-port _ body headers))) 16 | 17 | (define (http-post url body #:headers [headers '()]) 18 | (call-response/input-url url (post-impure-port _ body headers))) 19 | 20 | (define (http-delete url #:headers [headers '()]) 21 | (call-response/input-url url (delete-impure-port _ headers))) 22 | 23 | (define http-requester 24 | (requester http-get 25 | http-put 26 | http-post 27 | http-delete)) 28 | -------------------------------------------------------------------------------- /request/private/base.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "../doc-utils/examples.rkt" 4 | "../doc-utils/def.rkt" 5 | (for-label request 6 | racket)) 7 | 8 | @title{HTTP Requests and Requester} 9 | 10 | @defrequester[http-requester]{ 11 | A simple requester for the HTTP protocol built with 12 | @racket[get-impure-port], @racket[put-impure-port], 13 | @racket[post-impure-port], and @racket[delete-impure-port]. 14 | Locations are @racket[url?]s, headers are @racket[string?]s 15 | as in the impure port functions, bodies are @racket[bytes?], 16 | and responses are instances of the @racket[http-response] struct. 17 | } 18 | 19 | @defstruct*[http-response ([code exact-positive-integer?] 20 | [headers (hash/c string? string? 21 | #:immutable? #t)] 22 | [body string?])]{ 23 | A structure type for HTTP responses. Contains a status 24 | code, a hash of headers, and a raw body string. 25 | @racket[http-requester] responds with instances of 26 | this structure type. This is distinct from the 27 | @racket[response] structure type in the web server 28 | package, as that response is for @italic{sending} 29 | responses while this struct is used when 30 | @italic{receiving} them. 31 | } 32 | -------------------------------------------------------------------------------- /request/private/call-response.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require typed/net/url 4 | typed/net/head 5 | fancy-app) 6 | 7 | (provide (struct-out http-response) 8 | HttpResponse 9 | Url 10 | call-response/input-url) 11 | 12 | 13 | (struct http-response 14 | ([code : Positive-Integer] 15 | [headers : (HashTable String String)] 16 | [body : String]) #:transparent) 17 | 18 | (define-type HttpResponse http-response) 19 | (define-type Url url) 20 | 21 | (: not-newline? (-> Char Boolean)) 22 | (define (not-newline? char) 23 | (not (char=? #\newline char))) 24 | 25 | (: not-whitespace? (-> Char Boolean)) 26 | (define (not-whitespace? char) 27 | (not (char-whitespace? char))) 28 | 29 | (: split-combined-header (-> String (Values String String))) 30 | (define (split-combined-header HTTP-header+MIME-headers) 31 | (define chars (string->list HTTP-header+MIME-headers)) 32 | (define-values (http-chars mime-chars) 33 | (splitf-at chars not-newline?)) 34 | (values (apply string http-chars) 35 | (apply string mime-chars))) 36 | 37 | (: http-header-code (-> String Positive-Integer)) 38 | (define (http-header-code HTTP-header) 39 | (define chars (string->list HTTP-header)) 40 | (define dropped-protocol (rest (dropf chars not-whitespace?))) 41 | (define code-chars (takef dropped-protocol not-whitespace?)) 42 | (cast (string->number (apply string code-chars)) Positive-Integer)) 43 | 44 | (: impure-port->response (-> Input-Port HttpResponse)) 45 | (define (impure-port->response impure-port) 46 | (define HTTP-header+MIME-headers (purify-port impure-port)) 47 | (define-values (HTTP-header MIME-headers) 48 | (split-combined-header HTTP-header+MIME-headers)) 49 | (define status-code (http-header-code HTTP-header)) 50 | (define headers (cast (make-hash (extract-all-fields MIME-headers)) (HashTable String String))) 51 | (define raw-body (port->string impure-port)) 52 | (http-response status-code headers raw-body)) 53 | 54 | 55 | (: call-response/input-url (-> Url (-> Url Input-Port) HttpResponse)) 56 | (define (call-response/input-url url connect) 57 | (call/input-url url connect impure-port->response)) 58 | -------------------------------------------------------------------------------- /request/private/exn.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require fancy-app 4 | "struct.rkt" 5 | "base.rkt" 6 | "wrap.rkt" 7 | "call-response.rkt") 8 | 9 | (provide (struct-out exn:fail:network:http:code) 10 | requester-http-exn 11 | http-requester/exn 12 | http-exn-of-code?) 13 | 14 | 15 | (define message-codes 16 | (hash 400 "Bad Request" 17 | 401 "Unauthorized" 18 | 402 "Payment Required" 19 | 403 "Forbidden" 20 | 404 "Not Found" 21 | 405 "Method Not Allowed" 22 | 406 "Not Acceptable" 23 | 407 "Proxy Authentication Required" 24 | 408 "Request Timeout" 25 | 409 "Conflict" 26 | 410 "Gone" 27 | 411 "Length Required" 28 | 412 "Precondition Failed" 29 | 500 "Internal Server Error" 30 | 501 "Not Implemented" 31 | 502 "Bad Gateway" 32 | 503 "Service Unavailable" 33 | 504 "Gateway Timeout")) 34 | 35 | (define code->message (hash-ref message-codes _)) 36 | 37 | (struct exn:fail:network:http:code exn:fail:network (code) #:transparent) 38 | 39 | (define (make-http-exn handler-response) 40 | (define code (http-response-code handler-response)) 41 | (define body (http-response-body handler-response)) 42 | (exn:fail:network:http:code (~a body) (current-continuation-marks) code)) 43 | 44 | (define (http-exn-of-code? code v) 45 | (and (exn:fail:network:http:code? v) 46 | (= code (exn:fail:network:http:code-code v)))) 47 | 48 | (define (raise-request-error handler-response) 49 | (raise (make-http-exn handler-response))) 50 | 51 | (define failure-code? (<= 400 _ 600)) 52 | 53 | (define (check-code handler-response) 54 | (when (failure-code? (http-response-code handler-response)) 55 | (raise-request-error handler-response))) 56 | 57 | (define (parse-response handler-response) 58 | (check-code handler-response) 59 | (http-response-body handler-response)) 60 | 61 | (define requester-http-exn (wrap-requester-response parse-response _)) 62 | (define http-requester/exn (requester-http-exn http-requester)) 63 | -------------------------------------------------------------------------------- /request/private/exn.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "../doc-utils/examples.rkt" 4 | "../doc-utils/def.rkt" 5 | (for-label request 6 | racket)) 7 | 8 | @title{HTTP Status Code Exception Throwing} 9 | 10 | @defstruct*[(exn:fail:network:http:code exn:fail:network) 11 | ([code exact-positive-integer?])]{ 12 | An exception structure type for non-success HTTP error codes. 13 | All codes in the range @racket[(<= 400 code 599)] are defined 14 | as error cases. This exception is thrown by @racket[http-requester]s 15 | wrapped by @racket[requester-http-exn]. 16 | } 17 | 18 | @defproc[(requester-http-exn [requester requester?]) 19 | requester?]{ 20 | Given a @racket[requester] whose responses are @racket[http-response]s, 21 | returns a requester whose responses are the only the response bodies 22 | of @racket[requester]. In the event of failure error codes 23 | in the response, an @racket[exn:fail:network:http:code] exception 24 | is thrown which contains the code and response body. 25 | } 26 | 27 | @defrequester[http-requester/exn]{ 28 | Like @racket[http-requester], but throws exceptions for failure codes 29 | and returns the http response body as it's response. Equivalent to 30 | @racket[(requester-http-exn http-requester)]. 31 | } 32 | 33 | @defproc[(http-exn-of-code? [code exact-positive-integer?] 34 | [v any/c]) 35 | boolean?]{ 36 | Returns @racket[#t] if @racket[v] is an instance of 37 | @racket[exn:fail:network:http:code] whose status code is 38 | @racket[code], and returns @racket[#f] otherwise. 39 | } 40 | -------------------------------------------------------------------------------- /request/private/http-location.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require net/url 4 | fancy-app 5 | "struct.rkt" 6 | "wrap.rkt") 7 | 8 | (provide 9 | (contract-out 10 | [make-domain-requester 11 | (-> string? requester? requester?)] 12 | [make-host+port-requester 13 | (-> string? exact-nonnegative-integer? requester? requester?)] 14 | [make-https-requester 15 | (-> requester? requester?)])) 16 | 17 | 18 | (define (domain+relative-path->http-url domain relative-path) 19 | (string->url (format "http://~a/~a" domain relative-path))) 20 | 21 | (define (host+port->domain host port) 22 | (format "~a:~a" host port)) 23 | 24 | (define (http-url->https-url location) 25 | (struct-copy url location [scheme "https"])) 26 | 27 | (define (make-domain-requester domain requester) 28 | (wrap-requester-location 29 | (domain+relative-path->http-url domain _) requester)) 30 | 31 | (define (make-https-requester requester) 32 | (wrap-requester-location 33 | (http-url->https-url _) requester)) 34 | 35 | (define (make-host+port-requester host port requester) 36 | (make-domain-requester (host+port->domain host port) requester)) 37 | 38 | (module+ integration-test 39 | (require json 40 | rackunit 41 | "base.rkt" 42 | "call-response.rkt") 43 | 44 | (define domain "httpbin.org") 45 | (define http-url (domain+relative-path->http-url domain "/")) 46 | (define http-req (make-domain-requester domain http-requester)) 47 | (define https-req (make-domain-requester 48 | domain (make-https-requester http-requester))) 49 | 50 | (define http-resp (get http-req "/get")) 51 | (define https-resp (get https-req "/get")) 52 | 53 | (check-pred url? http-url) 54 | (check-equal? (url-scheme http-url) "http") 55 | (check-equal? 56 | (hash-ref (string->jsexpr (http-response-body https-resp)) 'url) 57 | "https://httpbin.org/get") 58 | 59 | (check-pred requester? http-req) 60 | (check-equal? (http-response-code http-resp) 200) 61 | (check-equal? (http-response-code https-resp) 200)) -------------------------------------------------------------------------------- /request/private/http-location.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "../doc-utils/examples.rkt" 4 | "../doc-utils/def.rkt" 5 | (for-label request 6 | net/url 7 | racket)) 8 | 9 | @title{HTTP Requester Location Wrappers} 10 | 11 | Usually an http requester is constructed for a 12 | single REST API at a particular domain. These 13 | functions allow the construction of requesters 14 | that operate at only one domain and accept 15 | relative paths as locations. 16 | 17 | @defproc[(make-domain-requester [domain string?] 18 | [requester requester?]) 19 | requester?]{ 20 | Given a requester that accepts @racket[url?]s 21 | as locations, returns a requester that accepts 22 | @racket[string]s representing relative paths as 23 | locations. Each path is combined with the given 24 | @racket[domain] to construct a full http @racket[url], 25 | which is then passed to the underlying @racket[requester]. 26 | The relative path should not begin with a slash. 27 | @racketblock[ 28 | (define foo-com-requester 29 | (make-domain-requester "foo.com" http-requester)) 30 | (code:comment @#,elem{request to http://foo.com/some/sort/of/path}) 31 | (get foo-com-requester "some/sort/of/path") 32 | ]} 33 | 34 | @defproc[(make-host+port-requester [host string?] 35 | [port exact-nonnegative-integer?] 36 | [requester requester?]) 37 | requester?]{ 38 | Like @racket[make-domain-requester], except combines 39 | the @racket[host] and @racket[port] into a domain string. 40 | @racket[(make-host+port-requester "foo.com" 8080 some-requester)] 41 | is equivalent to @racket[(make-domain-requester "foo.com:8080" some-requester)] 42 | } 43 | 44 | @defproc[(make-https-requester [requester requester?]) 45 | requester?]{ 46 | Given a requester that accepts @racket[url?]s 47 | as locations, returns a requester that accepts a @racket[url] and converts 48 | it to use an https scheme before being passed to the underlying @racket[requester]. 49 | @racketblock[ 50 | (define foo-https-requester 51 | (make-domain-requester "foo.com" (make-https-requester http-requester))) 52 | (code:comment @#,elem{request to https://foo.com/some/sort/of/path}) 53 | (get foo-https-requester "some/sort/of/path") 54 | ]} 55 | -------------------------------------------------------------------------------- /request/private/struct.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide (struct-out requester) 4 | get 5 | put 6 | post 7 | delete) 8 | 9 | (struct requester (get put post delete)) 10 | 11 | (define (get requester url #:headers [headers '()]) 12 | ((requester-get requester) url #:headers headers)) 13 | 14 | (define (put requester url data #:headers [headers '()]) 15 | ((requester-put requester) url data #:headers headers)) 16 | 17 | (define (post requester url data #:headers [headers '()]) 18 | ((requester-post requester) url data #:headers headers)) 19 | 20 | (define (delete requester url #:headers [headers '()]) 21 | ((requester-delete requester) url #:headers headers)) 22 | -------------------------------------------------------------------------------- /request/private/struct.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "../doc-utils/examples.rkt" 4 | "../doc-utils/def.rkt" 5 | (for-label request 6 | racket)) 7 | 8 | @title{Requesters} 9 | 10 | @defproc[(requester [get (->* (any/c) (#:headers list?) any/c)] 11 | [put (->* (any/c any/c) (#:headers list?) any/c)] 12 | [post (->* (any/c any/c) (#:headers list?) any/c)] 13 | [delete (->* (any/c) (#:headers list?) any/c)]) 14 | requester?]{ 15 | Constructs a requester. A requester is defined on a 16 | @italic{location} type, a @italic{body} type, a @italic{header} 17 | type, and a @italic{response} type. A requester is composed 18 | of four procedures, each of which may take an optional list of 19 | headers to modify the request or add additional information. 20 | @itemlist[ 21 | @item{ 22 | GET - Given a location, returns a response. Should be 23 | @italic{safe} - calling GET on a location should never 24 | modify the resource at the location, and the GET should 25 | be invisible to anyone else viewing or modifying that 26 | resource. 27 | } 28 | @item{ 29 | PUT - Given a location and a body, returns a response. 30 | Should be @italic{idempotent} - doing a PUT twice at 31 | the same location with the same body should be exactly 32 | the same as doing it once. Additionally, for a location 33 | that can be PUT to, a GET response should contain what 34 | was last PUT there. 35 | } 36 | @item{ 37 | POST - Given a location and a body, returns a response. 38 | A post need not be either @italic{safe} or @italic{idempotent}, 39 | it may perform arbitrary modification of the resource at 40 | the location or other resources related to that resource. 41 | A location that is POST-ed to should contain a resource - 42 | that is, a GET at that location should not return a resource 43 | not found response. 44 | } 45 | @item{ 46 | DELETE - Given a location, returns a response. In the 47 | event of a successful response, later GETs (and DELETEs) 48 | at that location should be unsuccessful. 49 | } 50 | ] 51 | Provided the four provided procedures behave according to the 52 | specifications outlined above, the constructed @racket[requester] 53 | defines a REST-ful interface. 54 | } 55 | 56 | @defpredicate[requester?]{ 57 | Predicate identifying requesters 58 | } 59 | 60 | @defproc[(get [requester requester?] 61 | [location any/c] 62 | [#:headers headers list? '()]) 63 | any/c]{ 64 | Performs a GET request for the resource at @racket[location] 65 | with the supplied @racket[headers] using the given @racket[requester] 66 | and returns a response from the @racket[requester]. 67 | } 68 | 69 | @defproc[(put [requester requester?] 70 | [location any/c] 71 | [body any/c] 72 | [#:headers headers list? '()]) 73 | any/c]{ 74 | Performs a PUT request for the resource at @racket[location] 75 | with the supplied @racket[body] and @racket[headers] using 76 | the given @racket[requester] and returns a response from 77 | the @racket[requester]. 78 | } 79 | 80 | @defproc[(post [requester requester?] 81 | [location any/c] 82 | [body any/c] 83 | [#:headers headers list? '()]) 84 | any/c]{ 85 | Performs a POST request for the resource at @racket[location] 86 | with the supplied @racket[body] and @racket[headers] using 87 | the given @racket[requester] and returns a response from 88 | the @racket[requester]. 89 | } 90 | 91 | @defproc[(delete [requester requester?] 92 | [location any/c] 93 | [#:headers headers list? '()]) 94 | any/c]{ 95 | Performs a DELETE request for the resource at @racket[location] 96 | with the supplied @racket[headers] using the given @racket[requester] 97 | and returns a response from the @racket[requester]. 98 | } 99 | -------------------------------------------------------------------------------- /request/private/wrap.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "struct.rkt" 4 | fancy-app) 5 | 6 | (provide wrap-requester 7 | wrap-requester-location 8 | wrap-requester-body 9 | wrap-requester-response 10 | add-requester-headers) 11 | 12 | 13 | (define (wrap-requester wrapper requester-to-wrap) 14 | (requester (wrapper (requester-get requester-to-wrap)) 15 | (wrapper (requester-put requester-to-wrap)) 16 | (wrapper (requester-post requester-to-wrap)) 17 | (wrapper (requester-delete requester-to-wrap)))) 18 | 19 | 20 | (define (wrap-requester-location location-func requester) 21 | (define ((wrapper handler) location #:headers [headers '()] . rest) 22 | (apply handler (location-func location) #:headers headers rest)) 23 | (wrap-requester wrapper requester)) 24 | 25 | (define (wrap-requester-body body-func requester) 26 | (define ((wrapper handler) location #:headers [headers '()] . rest) 27 | (apply handler location #:headers headers (map body-func rest))) 28 | (wrap-requester wrapper requester)) 29 | 30 | (define (wrap-requester-response response-func requester) 31 | (define ((wrapper handler) location #:headers [headers '()] . rest) 32 | (response-func (apply handler location #:headers headers rest))) 33 | (wrap-requester wrapper requester)) 34 | 35 | (define (add-requester-headers base-headers requester) 36 | (define ((wrapper handler) location #:headers [headers '()] . rest) 37 | (apply handler location #:headers (append base-headers headers) rest)) 38 | (wrap-requester wrapper requester)) 39 | -------------------------------------------------------------------------------- /request/private/wrap.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "../doc-utils/examples.rkt" 4 | "../doc-utils/def.rkt" 5 | (for-label request 6 | racket)) 7 | 8 | @title{Extending and Wrapping Requesters} 9 | 10 | @defproc[(wrap-requester [wrapper (or/c (-> (->* (any/c) (#:headers list?) any/c) 11 | (->* (any/c) (#:headers list?) any/c)) 12 | (-> (->* (any/c any/c) (#:headers list?) any/c) 13 | (->* (any/c any/c) (#:headers list?) any/c)))] 14 | [requester requester?]) 15 | requester?]{ 16 | Constructs a new requester by wrapping each procedure 17 | of the old requester with @racket[wrapper]. 18 | @racket[(wrap-requester f (requester get put post delete))] 19 | is equivalent to 20 | @racket[(requester (f get) (f put) (f post) (f delete))]. 21 | } 22 | 23 | @defproc[(wrap-requester-location [location-wrapper (-> any/c any/c)] 24 | [requester requester?]) 25 | requester?]{ 26 | Constructs a new requester which is identical to @racket[requester] 27 | except that any locations it's given are first transformed with 28 | @racket[location-wrapper] and then passed on to @racket[requester]. 29 | } 30 | 31 | @defproc[(wrap-requester-body [body-wrapper (-> any/c any/c)] 32 | [requester requester?]) 33 | requester?]{ 34 | Constructs a new requester which is identical to @racket[requester] 35 | except that any request bodies it's given are first transformed 36 | with @racket[body-wrapper] and then passed on to @racket[reqeuster]. 37 | } 38 | 39 | @defproc[(wrap-requester-response [response-wrapper (-> any/c any/c)] 40 | [requester requester?]) 41 | requester?]{ 42 | Constructs a new requester which is identical to @racket[requester] 43 | except that any responses it returns are transformed with 44 | @racket[response-wrapper] after being received from @racket[requester]. 45 | } 46 | 47 | @defproc[(add-requester-headers [headers list?] 48 | [requester requester?]) 49 | requester?]{ 50 | Constructs a new requester which is identical to @racket[requester] 51 | except that it includes @racket[headers] with every request. If 52 | individual requests are given a header with the same name as any 53 | of the base @racket[headers], the individual header overwrites 54 | the base @racket[headers]. This can be used to construct an HTTP 55 | requester that sends authorization headers on every request or 56 | always requests a certain content type, for example. 57 | } 58 | --------------------------------------------------------------------------------