diff --git a/request/private/base.rkt b/request/private/base.rkt index 723a9dd..3f0939b 100644 --- a/request/private/base.rkt +++ b/request/private/base.rkt @@ -7,7 +7,6 @@ (provide http-requester) - (define (http-get url #:headers [headers '()]) (call-response/input-url url (get-impure-port _ headers))) @@ -24,4 +23,4 @@ (requester http-get http-put http-post - http-delete)) + http-delete)) \ No newline at end of file diff --git a/request/private/base.scrbl b/request/private/base.scrbl index beeac19..709dc28 100644 --- a/request/private/base.scrbl +++ b/request/private/base.scrbl @@ -29,3 +29,15 @@ responses while this struct is used when @italic{receiving} them. } + +@defrequester[json-requester]{ + Wraps @racket[http-requester] and modifies the request to + include two headers: "Content-Type: application/json" and + "Accept: application/json". The body of the request is automatically converted + from a @racket[jsexpr?] to a JSON string. Locations are @racket[url?]s, + headers are @racket[string?]s as in the impure port functions, bodies are + @racket[jsexpr?], and responses are instances of the + @racket[json-response] struct. If the response comes back with non-JSON or it + cannot otherwise be parsed correctly into a @racket[jsexpr?] it will throw + @racket[exn:fail:json?] +} diff --git a/request/private/call-response.rkt b/request/private/call-response.rkt index d3abe2d..17bbc4f 100644 --- a/request/private/call-response.rkt +++ b/request/private/call-response.rkt @@ -2,7 +2,8 @@ (require typed/net/url typed/net/head - fancy-app) + fancy-app + typed/json) (provide (struct-out http-response) HttpResponse @@ -25,7 +26,6 @@ (: not-whitespace? (-> Char Boolean)) (define (not-whitespace? char) (not (char-whitespace? char))) - (: split-combined-header (-> String (Values String String))) (define (split-combined-header HTTP-header+MIME-headers) (define chars (string->list HTTP-header+MIME-headers)) @@ -51,7 +51,6 @@ (define raw-body (port->string impure-port)) (http-response status-code headers raw-body)) - (: call-response/input-url (-> Url (-> Url Input-Port) HttpResponse)) (define (call-response/input-url url connect) (call/input-url url connect impure-port->response)) diff --git a/request/private/exn.rkt b/request/private/exn.rkt index f64d5ec..417dba5 100644 --- a/request/private/exn.rkt +++ b/request/private/exn.rkt @@ -11,7 +11,6 @@ http-requester/exn http-exn-of-code?) - (define message-codes (hash 400 "Bad Request" 401 "Unauthorized" diff --git a/request/private/exn.scrbl b/request/private/exn.scrbl index 597b43c..49ee3d3 100644 --- a/request/private/exn.scrbl +++ b/request/private/exn.scrbl @@ -15,6 +15,13 @@ wrapped by @racket[requester-http-exn]. } +@defstruct*[(exn:fail:json exn:fail) + ([response string?])]{ + This exception is thrown by @racket[json-requester]s + when they cannot parse the response as valid JSON. The original response + is returned as a string in the body of the exception. +} + @defproc[(requester-http-exn [requester requester?]) requester?]{ Given a @racket[requester] whose responses are @racket[http-response]s, diff --git a/request/private/http-location.rkt b/request/private/http-location.rkt index d39fcc6..70e1eec 100644 --- a/request/private/http-location.rkt +++ b/request/private/http-location.rkt @@ -2,6 +2,7 @@ (require net/url fancy-app + "json.rkt" "struct.rkt" "wrap.rkt") @@ -29,8 +30,8 @@ (domain+relative-path->http-url domain _) requester)) (define (make-https-requester requester) - (wrap-requester-location - (http-url->https-url _) requester)) + (wrap-requester-location + (http-url->https-url _) requester)) (define (make-host+port-requester host port requester) (make-domain-requester (host+port->domain host port) requester)) @@ -40,22 +41,24 @@ rackunit "base.rkt" "call-response.rkt") - + (define domain "httpbin.org") (define http-url (domain+relative-path->http-url domain "/")) (define http-req (make-domain-requester domain http-requester)) (define https-req (make-domain-requester domain (make-https-requester http-requester))) - + + (check-pred requester? http-req) + (check-pred requester? https-req) + (define http-resp (get http-req "/get")) (define https-resp (get https-req "/get")) - + (check-pred url? http-url) (check-equal? (url-scheme http-url) "http") (check-equal? (hash-ref (string->jsexpr (http-response-body https-resp)) 'url) "https://httpbin.org/get") - (check-pred requester? http-req) (check-equal? (http-response-code http-resp) 200) (check-equal? (http-response-code https-resp) 200)) \ No newline at end of file diff --git a/request/private/json.rkt b/request/private/json.rkt new file mode 100644 index 0000000..d49bb8c --- /dev/null +++ b/request/private/json.rkt @@ -0,0 +1,95 @@ +#lang racket + +(require json + "base.rkt" + "exn.rkt" + "struct.rkt" + "wrap.rkt") + +(provide (struct-out exn:fail:json) + json-requester) + +(struct exn:fail:json exn () #:transparent) + +(define json-headers + '("Accept: application/json" "Content-Type: application/json")) + +(define (make-json-exn handler-response) + (exn:fail:json (~a handler-response) (current-continuation-marks))) + +(define (wrap-json-body body) + (if (jsexpr? body) + (jsexpr->bytes body) + body)) + +(define (handle-json-response response) + (define json-resp + (with-handlers ([exn:fail:read? (λ (e) #f)]) + (string->jsexpr response))) + (if (not json-resp) + (raise (make-json-exn response)) + json-resp)) + +(define json-requester + (wrap-requester-response + handle-json-response + (wrap-requester-body + wrap-json-body + (add-requester-headers + json-headers http-requester/exn)))) + +(module+ integraton-test + (require net/url + rackunit) + + (check-pred requester? json-requester) + + (define (make-url path) + (string->url (format "http://httpbin.org/~a" path))) + + (define (get-headers response) + (hash-ref response 'headers)) + + (define (get-data response) + (hash-ref response 'data)) + + (define json-get (requester-get json-requester)) + (define json-put (requester-put json-requester)) + (define json-post (requester-post json-requester)) + (define json-delete (requester-delete json-requester)) + + (define get-200 ((requester-get json-requester) + (make-url "get") #:headers '("x-men: colossus"))) + + (check-pred jsexpr? get-200) + (check-equal? (hash-ref (get-headers get-200) 'Content-Type) + "application/json") + (check-equal? (hash-ref (get-headers get-200) 'Accept) + "application/json") + (check-equal? (hash-ref (get-headers get-200) 'X-Men) + "colossus") + + (define put-200 (json-put (make-url "put") (hash 'foo "bar"))) + (check-pred jsexpr? put-200) + (check-equal? (get-data put-200) "{\"foo\":\"bar\"}") + + (define post-200 (json-post (make-url "post") (hash 'foo "bar"))) + (check-pred jsexpr? post-200) + (check-equal? (get-data post-200) "{\"foo\":\"bar\"}") + + (define delete-200 (json-delete (make-url "delete"))) + (check-pred jsexpr? delete-200) + + ;; get HTML which should throw exn:fail:json + (check-exn + exn:fail:json? + (λ () ((requester-get json-requester) (make-url "html")))) + + ;; httpbin returns a non-JSON body for 418 Teapot + (check-exn + exn:fail:network:http:code? + (λ () (json-get (make-url "status/418")))) + + (check-exn + exn:fail:network:http:code? + (λ () (json-get (make-url "status/406"))))) \ No newline at end of file