From 72fee36bbcca76f6e6613a6bc50c98e67a1ea074 Mon Sep 17 00:00:00 2001
From: DarrenN <info@v25media.com>
Date: Mon, 22 Aug 2016 06:50:15 -0400
Subject: [PATCH 1/8] WIP Add json-requester

---
 request/private/base.rkt          | 38 +++++++++++++++++++++++++++++-
 request/private/call-response.rkt | 39 ++++++++++++++++++++++++++-----
 2 files changed, 70 insertions(+), 7 deletions(-)

diff --git a/request/private/base.rkt b/request/private/base.rkt
index 723a9dd..79faebc 100644
--- a/request/private/base.rkt
+++ b/request/private/base.rkt
@@ -2,11 +2,18 @@
 
 (require net/url
          fancy-app
+         json
          "call-response.rkt"
          "struct.rkt")
 
-(provide http-requester)
+(provide http-requester
+         json-requester)
 
+(define json-headers
+  '("Accept: application/json" "Content-Type: application/json"))
+
+(define (merge-headers headers)
+  (flatten (cons json-headers headers)))
 
 (define (http-get url #:headers [headers '()])
   (call-response/input-url url (get-impure-port _ headers)))
@@ -20,8 +27,37 @@
 (define (http-delete url #:headers [headers '()])
   (call-response/input-url url (delete-impure-port _ headers)))
 
+(define (http-json-get url #:headers [headers '()])
+  (call-response/input-json-url url (get-impure-port _ headers)))
+
+(define (http-json-put url body #:headers [headers '()])
+  (call-response/input-json-url url (put-impure-port _ body headers)))
+
+(define (http-json-post url body #:headers [headers '()])
+  (call-response/input-json-url url (post-impure-port _ body headers)))
+
+(define (http-json-delete url #:headers [headers '()])
+  (call-response/input-json-url url (delete-impure-port _ headers)))
+
+(define (wrap-json-headers method-fn)
+  (λ (url #:headers [headers '()] . rest)
+    (define json-headers (merge-headers headers))
+    (apply method-fn url #:headers json-headers rest)))
+
+(define (wrap-json-body method-fn)
+  (λ (url body #:headers [headers '()] . rest)
+    (define json-headers (merge-headers headers))
+    (define json-body (jsexpr->bytes body))
+    (apply method-fn url json-body #:headers json-headers rest)))
+
 (define http-requester
   (requester http-get
              http-put
              http-post
              http-delete))
+
+(define json-requester
+  (requester (wrap-json-headers http-json-get)
+             (wrap-json-body http-json-put)
+             (wrap-json-body http-json-post)
+             (wrap-json-headers http-json-delete)))
diff --git a/request/private/call-response.rkt b/request/private/call-response.rkt
index d3abe2d..761a732 100644
--- a/request/private/call-response.rkt
+++ b/request/private/call-response.rkt
@@ -2,12 +2,14 @@
 
 (require typed/net/url
          typed/net/head
-         fancy-app)
+         fancy-app
+         typed/json)
 
 (provide (struct-out http-response)
          HttpResponse
          Url
-         call-response/input-url)
+         call-response/input-url
+         call-response/input-json-url)
 
 
 (struct http-response
@@ -15,7 +17,13 @@
    [headers : (HashTable String String)]
    [body : String]) #:transparent)
 
+(struct json-response
+  ([code : Positive-Integer]
+   [headers : (HashTable String String)]
+   [body : JSExpr]) #:transparent)
+
 (define-type HttpResponse http-response)
+(define-type JsonResponse json-response)
 (define-type Url url)
 
 (: not-newline? (-> Char Boolean))
@@ -41,17 +49,36 @@
   (define code-chars (takef dropped-protocol not-whitespace?))
   (cast (string->number (apply string code-chars)) Positive-Integer))
 
-(: impure-port->response (-> Input-Port HttpResponse))
-(define (impure-port->response impure-port)
+(: impure-port->headers
+   (-> Input-Port (Values Positive-Integer (HashTable String String))))
+(define (impure-port->headers impure-port)
   (define HTTP-header+MIME-headers (purify-port impure-port))
   (define-values (HTTP-header MIME-headers)
     (split-combined-header HTTP-header+MIME-headers))
   (define status-code (http-header-code HTTP-header))
-  (define headers (cast (make-hash (extract-all-fields MIME-headers)) (HashTable String String)))
+  (define headers
+    (cast (make-hash (extract-all-fields MIME-headers))
+          (HashTable String String)))
+  (values status-code headers))
+
+(: impure-port->http-response (-> Input-Port HttpResponse))
+(define (impure-port->http-response impure-port)
+  (define-values (status-code headers)
+    (impure-port->headers impure-port))
   (define raw-body (port->string impure-port))
   (http-response status-code headers raw-body))
 
+(: impure-port->json-response (-> Input-Port JsonResponse))
+(define (impure-port->json-response impure-port)
+  (define-values (status-code headers)
+    (impure-port->headers impure-port))
+  (define json-body (string->jsexpr (port->string impure-port)))
+  (json-response status-code headers json-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))
+  (call/input-url url connect impure-port->http-response))
+
+(: call-response/input-json-url (-> Url (-> Url Input-Port) JsonResponse))
+(define (call-response/input-json-url url connect)
+  (call/input-url url connect impure-port->json-response))

From 12699bb01a5cbb94fbcacddfd6cab93ac8150141 Mon Sep 17 00:00:00 2001
From: DarrenN <info@v25media.com>
Date: Sun, 28 Aug 2016 12:54:52 -0400
Subject: [PATCH 2/8] Cleanup wrappers

---
 request/private/base.rkt | 58 +++++++++++++++++-----------------------
 1 file changed, 24 insertions(+), 34 deletions(-)

diff --git a/request/private/base.rkt b/request/private/base.rkt
index 79faebc..01d50f1 100644
--- a/request/private/base.rkt
+++ b/request/private/base.rkt
@@ -12,52 +12,42 @@
 (define json-headers
   '("Accept: application/json" "Content-Type: application/json"))
 
-(define (merge-headers headers)
+(define (merge-json-headers headers)
   (flatten (cons json-headers headers)))
 
-(define (http-get url #:headers [headers '()])
-  (call-response/input-url url (get-impure-port _ headers)))
+(define (get call-response-fn url #:headers [headers '()])
+  (call-response-fn url (get-impure-port _ headers)))
 
-(define (http-put url body #:headers [headers '()])
-  (call-response/input-url url (put-impure-port _ body headers)))
+(define (put call-response-fn url body #:headers [headers '()])
+  (call-response-fn url (put-impure-port _ body headers)))
 
-(define (http-post url body #:headers [headers '()])
-  (call-response/input-url url (post-impure-port _ body headers)))
+(define (post call-response-fn url body #:headers [headers '()])
+  (call-response-fn url (post-impure-port _ body headers)))
 
-(define (http-delete url #:headers [headers '()])
-  (call-response/input-url url (delete-impure-port _ headers)))
+(define (delete call-response-fn url #:headers [headers '()])
+  (call-response-fn url (delete-impure-port _ headers)))
 
-(define (http-json-get url #:headers [headers '()])
-  (call-response/input-json-url url (get-impure-port _ headers)))
-
-(define (http-json-put url body #:headers [headers '()])
-  (call-response/input-json-url url (put-impure-port _ body headers)))
-
-(define (http-json-post url body #:headers [headers '()])
-  (call-response/input-json-url url (post-impure-port _ body headers)))
-
-(define (http-json-delete url #:headers [headers '()])
-  (call-response/input-json-url url (delete-impure-port _ headers)))
+(define (wrap-http-method method-fn)
+  (λ (url #:headers [headers '()] . rest)
+    (apply method-fn call-response/input-url url #:headers headers rest)))
 
-(define (wrap-json-headers method-fn)
+(define (wrap-json-method method-fn)
   (λ (url #:headers [headers '()] . rest)
-    (define json-headers (merge-headers headers))
-    (apply method-fn url #:headers json-headers rest)))
+    (apply method-fn call-response/input-json-url url #:headers
+           (merge-json-headers headers) rest)))
 
 (define (wrap-json-body method-fn)
   (λ (url body #:headers [headers '()] . rest)
-    (define json-headers (merge-headers headers))
-    (define json-body (jsexpr->bytes body))
-    (apply method-fn url json-body #:headers json-headers rest)))
+    (apply method-fn url (jsexpr->bytes body) #:headers headers rest)))
 
 (define http-requester
-  (requester http-get
-             http-put
-             http-post
-             http-delete))
+  (requester (wrap-http-method get)
+             (wrap-http-method put)
+             (wrap-http-method post)
+             (wrap-http-method delete)))
 
 (define json-requester
-  (requester (wrap-json-headers http-json-get)
-             (wrap-json-body http-json-put)
-             (wrap-json-body http-json-post)
-             (wrap-json-headers http-json-delete)))
+  (requester (wrap-json-method get)
+             (wrap-json-body (wrap-json-method put))
+             (wrap-json-body (wrap-json-method post))
+             (wrap-json-method delete)))

From ea650228b1f07f956fe5e96da0473728e4de11a3 Mon Sep 17 00:00:00 2001
From: DarrenN <info@v25media.com>
Date: Sun, 28 Aug 2016 14:27:12 -0400
Subject: [PATCH 3/8] integration tests

---
 request/private/call-response.rkt |  1 +
 request/private/http-location.rkt | 68 +++++++++++++++++++++++++++----
 2 files changed, 62 insertions(+), 7 deletions(-)

diff --git a/request/private/call-response.rkt b/request/private/call-response.rkt
index 761a732..2acb30f 100644
--- a/request/private/call-response.rkt
+++ b/request/private/call-response.rkt
@@ -6,6 +6,7 @@
          typed/json)
 
 (provide (struct-out http-response)
+         (struct-out json-response)
          HttpResponse
          Url
          call-response/input-url
diff --git a/request/private/http-location.rkt b/request/private/http-location.rkt
index d39fcc6..7e711f8 100644
--- a/request/private/http-location.rkt
+++ b/request/private/http-location.rkt
@@ -29,8 +29,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 +40,76 @@
            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-json-req (make-domain-requester domain json-requester))
+  (define https-json-req (make-domain-requester
+                          domain (make-https-requester json-requester)))
+  
+  (check-pred requester? http-json-req)
+  (check-pred requester? https-json-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
+  (check-equal? (http-response-code https-resp) 200)
+  
+  (define http-json-get-resp
+    (get http-json-req "/get"
+         #:headers
+         '("Content-Type: application/json; charset=utf8"
+           "x-racket: yes")))
+  
+  (define http-json-post-resp
+    (post http-json-req "/post" (hasheq 'grand "larceny")))
+  (define https-json-get-resp (get https-json-req "/get"))
+  
+  (check-pred jsexpr? (json-response-body http-json-get-resp))
+  (check-pred jsexpr? (json-response-body https-json-get-resp))
+  
+  ; exception thrown for non-jsexpr body
+  (check-exn
+   exn:fail?
+   (λ ()
+     (post http-json-req "/post" 'felony)))
+  
+  (check-equal? (hash-ref
+                 (hash-ref
+                  (json-response-body http-json-get-resp)
+                  'headers)
+                 'Content-Type)
+                "application/json; charset=utf8")
+  
+  (check-equal? (hash-ref
+                 (hash-ref
+                  (json-response-body http-json-get-resp)
+                  'headers)
+                 'Accept)
+                "application/json")
+  
+  (check-equal? (hash-ref
+                 (hash-ref
+                  (json-response-body http-json-get-resp)
+                  'headers)
+                 'X-Racket)
+                "yes")
+  
+  (check-equal? (hash-ref
+                 (json-response-body http-json-post-resp)
+                 'data)
+                "{\"grand\":\"larceny\"}"))
\ No newline at end of file

From fd4b7ef497f37d2bfe59aebad94674fcd6b94188 Mon Sep 17 00:00:00 2001
From: DarrenN <info@v25media.com>
Date: Sun, 28 Aug 2016 15:08:21 -0400
Subject: [PATCH 4/8] add docs for json-requester

---
 request/private/base.scrbl | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

diff --git a/request/private/base.scrbl b/request/private/base.scrbl
index beeac19..44abf3b 100644
--- a/request/private/base.scrbl
+++ b/request/private/base.scrbl
@@ -29,3 +29,30 @@
   responses while this struct is used when
   @italic{receiving} them.
 }
+
+@defrequester[json-requester]{
+  A simple requester for the HTTP protocol specifically for JSON requests
+  built with @racket[get-impure-port], @racket[put-impure-port],
+  @racket[post-impure-port], and @racket[delete-impure-port].
+  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.
+  Two headers are automatically injected into the request:
+  "Content-Type: application/json" and "Accept: application/json".
+  The body of the request is automatically converted from a @racket[jsexpr?]
+  to a JSON string.
+}
+
+@defstruct*[json-response ([code exact-positive-integer?]
+                           [headers (hash/c string? string?
+                                            #:immutable? #t)]
+                           [body jsexpr?])]{
+  A structure type for HTTP JSON responses. Contains a status
+  code, a hash of headers, and a body @racket[jsexpr?].
+  @racket[json-requester] responds with instances of
+  this structure type. This is distinct from the
+  @racket[response] structure type in the web server
+  package, as that response is for @italic{sending}
+  responses while this struct is used when
+  @italic{receiving} them.
+}

From 7b54aba0343239bec110c3af4964404e4da0d008 Mon Sep 17 00:00:00 2001
From: DarrenN <info@v25media.com>
Date: Sun, 4 Sep 2016 16:02:48 -0400
Subject: [PATCH 5/8] refactors and moves json handling to json.rkt

---
 request/private/base.rkt          | 53 ++++++---------------
 request/private/call-response.rkt | 39 ++--------------
 request/private/http-location.rkt | 55 +---------------------
 request/private/json.rkt          | 76 +++++++++++++++++++++++++++++++
 4 files changed, 96 insertions(+), 127 deletions(-)
 create mode 100644 request/private/json.rkt

diff --git a/request/private/base.rkt b/request/private/base.rkt
index 01d50f1..3f0939b 100644
--- a/request/private/base.rkt
+++ b/request/private/base.rkt
@@ -2,52 +2,25 @@
 
 (require net/url
          fancy-app
-         json
          "call-response.rkt"
          "struct.rkt")
 
-(provide http-requester
-         json-requester)
+(provide http-requester)
 
-(define json-headers
-  '("Accept: application/json" "Content-Type: application/json"))
+(define (http-get url #:headers [headers '()])
+  (call-response/input-url url (get-impure-port _ headers)))
 
-(define (merge-json-headers headers)
-  (flatten (cons json-headers headers)))
+(define (http-put url body #:headers [headers '()])
+  (call-response/input-url url (put-impure-port _ body headers)))
 
-(define (get call-response-fn url #:headers [headers '()])
-  (call-response-fn url (get-impure-port _ headers)))
+(define (http-post url body #:headers [headers '()])
+  (call-response/input-url url (post-impure-port _ body headers)))
 
-(define (put call-response-fn url body #:headers [headers '()])
-  (call-response-fn url (put-impure-port _ body headers)))
-
-(define (post call-response-fn url body #:headers [headers '()])
-  (call-response-fn url (post-impure-port _ body headers)))
-
-(define (delete call-response-fn url #:headers [headers '()])
-  (call-response-fn url (delete-impure-port _ headers)))
-
-(define (wrap-http-method method-fn)
-  (λ (url #:headers [headers '()] . rest)
-    (apply method-fn call-response/input-url url #:headers headers rest)))
-
-(define (wrap-json-method method-fn)
-  (λ (url #:headers [headers '()] . rest)
-    (apply method-fn call-response/input-json-url url #:headers
-           (merge-json-headers headers) rest)))
-
-(define (wrap-json-body method-fn)
-  (λ (url body #:headers [headers '()] . rest)
-    (apply method-fn url (jsexpr->bytes body) #:headers headers rest)))
+(define (http-delete url #:headers [headers '()])
+  (call-response/input-url url (delete-impure-port _ headers)))
 
 (define http-requester
-  (requester (wrap-http-method get)
-             (wrap-http-method put)
-             (wrap-http-method post)
-             (wrap-http-method delete)))
-
-(define json-requester
-  (requester (wrap-json-method get)
-             (wrap-json-body (wrap-json-method put))
-             (wrap-json-body (wrap-json-method post))
-             (wrap-json-method delete)))
+  (requester http-get
+             http-put
+             http-post
+             http-delete))
\ No newline at end of file
diff --git a/request/private/call-response.rkt b/request/private/call-response.rkt
index 2acb30f..17bbc4f 100644
--- a/request/private/call-response.rkt
+++ b/request/private/call-response.rkt
@@ -6,11 +6,9 @@
          typed/json)
 
 (provide (struct-out http-response)
-         (struct-out json-response)
          HttpResponse
          Url
-         call-response/input-url
-         call-response/input-json-url)
+         call-response/input-url)
 
 
 (struct http-response
@@ -18,13 +16,7 @@
    [headers : (HashTable String String)]
    [body : String]) #:transparent)
 
-(struct json-response
-  ([code : Positive-Integer]
-   [headers : (HashTable String String)]
-   [body : JSExpr]) #:transparent)
-
 (define-type HttpResponse http-response)
-(define-type JsonResponse json-response)
 (define-type Url url)
 
 (: not-newline? (-> Char Boolean))
@@ -34,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))
@@ -50,36 +41,16 @@
   (define code-chars (takef dropped-protocol not-whitespace?))
   (cast (string->number (apply string code-chars)) Positive-Integer))
 
-(: impure-port->headers
-   (-> Input-Port (Values Positive-Integer (HashTable String String))))
-(define (impure-port->headers impure-port)
+(: impure-port->response (-> Input-Port HttpResponse))
+(define (impure-port->response impure-port)
   (define HTTP-header+MIME-headers (purify-port impure-port))
   (define-values (HTTP-header MIME-headers)
     (split-combined-header HTTP-header+MIME-headers))
   (define status-code (http-header-code HTTP-header))
-  (define headers
-    (cast (make-hash (extract-all-fields MIME-headers))
-          (HashTable String String)))
-  (values status-code headers))
-
-(: impure-port->http-response (-> Input-Port HttpResponse))
-(define (impure-port->http-response impure-port)
-  (define-values (status-code headers)
-    (impure-port->headers impure-port))
+  (define headers (cast (make-hash (extract-all-fields MIME-headers)) (HashTable String String)))
   (define raw-body (port->string impure-port))
   (http-response status-code headers raw-body))
 
-(: impure-port->json-response (-> Input-Port JsonResponse))
-(define (impure-port->json-response impure-port)
-  (define-values (status-code headers)
-    (impure-port->headers impure-port))
-  (define json-body (string->jsexpr (port->string impure-port)))
-  (json-response status-code headers json-body))
-
 (: call-response/input-url (-> Url (-> Url Input-Port) HttpResponse))
 (define (call-response/input-url url connect)
-  (call/input-url url connect impure-port->http-response))
-
-(: call-response/input-json-url (-> Url (-> Url Input-Port) JsonResponse))
-(define (call-response/input-json-url url connect)
-  (call/input-url url connect impure-port->json-response))
+  (call/input-url url connect impure-port->response))
diff --git a/request/private/http-location.rkt b/request/private/http-location.rkt
index 7e711f8..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")
 
@@ -50,13 +51,6 @@
   (check-pred requester? http-req)
   (check-pred requester? https-req)
   
-  (define http-json-req (make-domain-requester domain json-requester))
-  (define https-json-req (make-domain-requester
-                          domain (make-https-requester json-requester)))
-  
-  (check-pred requester? http-json-req)
-  (check-pred requester? https-json-req)
-  
   (define http-resp (get http-req "/get"))
   (define https-resp (get https-req "/get"))
   
@@ -67,49 +61,4 @@
    "https://httpbin.org/get")
   
   (check-equal? (http-response-code http-resp) 200)
-  (check-equal? (http-response-code https-resp) 200)
-  
-  (define http-json-get-resp
-    (get http-json-req "/get"
-         #:headers
-         '("Content-Type: application/json; charset=utf8"
-           "x-racket: yes")))
-  
-  (define http-json-post-resp
-    (post http-json-req "/post" (hasheq 'grand "larceny")))
-  (define https-json-get-resp (get https-json-req "/get"))
-  
-  (check-pred jsexpr? (json-response-body http-json-get-resp))
-  (check-pred jsexpr? (json-response-body https-json-get-resp))
-  
-  ; exception thrown for non-jsexpr body
-  (check-exn
-   exn:fail?
-   (λ ()
-     (post http-json-req "/post" 'felony)))
-  
-  (check-equal? (hash-ref
-                 (hash-ref
-                  (json-response-body http-json-get-resp)
-                  'headers)
-                 'Content-Type)
-                "application/json; charset=utf8")
-  
-  (check-equal? (hash-ref
-                 (hash-ref
-                  (json-response-body http-json-get-resp)
-                  'headers)
-                 'Accept)
-                "application/json")
-  
-  (check-equal? (hash-ref
-                 (hash-ref
-                  (json-response-body http-json-get-resp)
-                  'headers)
-                 'X-Racket)
-                "yes")
-  
-  (check-equal? (hash-ref
-                 (json-response-body http-json-post-resp)
-                 'data)
-                "{\"grand\":\"larceny\"}"))
\ No newline at end of file
+  (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..e246a6f
--- /dev/null
+++ b/request/private/json.rkt
@@ -0,0 +1,76 @@
+#lang racket
+
+(require json
+         "base.rkt"
+         "exn.rkt"
+         "struct.rkt"
+         "wrap.rkt")
+
+(define json-headers
+  '("Accept: application/json" "Content-Type: application/json"))
+
+(define (wrap-json-body body)
+  (if (jsexpr? body)
+      (jsexpr->bytes body)
+      body))
+
+(define (handle-json-response response)
+  (string->jsexpr response))
+
+(define json-requester
+  (wrap-requester-response
+   handle-json-response
+   (wrap-requester-body
+    wrap-json-body
+    (add-requester-headers
+     json-headers http-requester/exn))))
+
+(module+ 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)
+
+  ;; 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

From 6114fbc62740cbc586e4df5cec5ee24d4c5933f0 Mon Sep 17 00:00:00 2001
From: DarrenN <info@v25media.com>
Date: Sun, 4 Sep 2016 16:03:27 -0400
Subject: [PATCH 6/8] corrected test module

---
 request/private/json.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/request/private/json.rkt b/request/private/json.rkt
index e246a6f..b64f321 100644
--- a/request/private/json.rkt
+++ b/request/private/json.rkt
@@ -25,7 +25,7 @@
     (add-requester-headers
      json-headers http-requester/exn))))
 
-(module+ test
+(module+ integration-test
   (require net/url
            rackunit)
 

From fb5369ad2d5a494c93088e8fdab14d7349fb4601 Mon Sep 17 00:00:00 2001
From: DarrenN <info@v25media.com>
Date: Tue, 20 Sep 2016 18:25:53 -0400
Subject: [PATCH 7/8] add exception for invalid JSON

---
 request/private/base.scrbl | 33 +++++++++------------------------
 request/private/exn.rkt    |  1 -
 request/private/exn.scrbl  |  7 +++++++
 request/private/json.rkt   | 23 +++++++++++++++++++++--
 4 files changed, 37 insertions(+), 27 deletions(-)

diff --git a/request/private/base.scrbl b/request/private/base.scrbl
index 44abf3b..709dc28 100644
--- a/request/private/base.scrbl
+++ b/request/private/base.scrbl
@@ -31,28 +31,13 @@
 }
 
 @defrequester[json-requester]{
-  A simple requester for the HTTP protocol specifically for JSON requests
-  built with @racket[get-impure-port], @racket[put-impure-port],
-  @racket[post-impure-port], and @racket[delete-impure-port].
-  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.
-  Two headers are automatically injected into the request:
-  "Content-Type: application/json" and "Accept: application/json".
-  The body of the request is automatically converted from a @racket[jsexpr?]
-  to a JSON string.
-}
-
-@defstruct*[json-response ([code exact-positive-integer?]
-                           [headers (hash/c string? string?
-                                            #:immutable? #t)]
-                           [body jsexpr?])]{
-  A structure type for HTTP JSON responses. Contains a status
-  code, a hash of headers, and a body @racket[jsexpr?].
-  @racket[json-requester] responds with instances of
-  this structure type. This is distinct from the
-  @racket[response] structure type in the web server
-  package, as that response is for @italic{sending}
-  responses while this struct is used when
-  @italic{receiving} them.
+  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/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/json.rkt b/request/private/json.rkt
index b64f321..ceca934 100644
--- a/request/private/json.rkt
+++ b/request/private/json.rkt
@@ -6,16 +6,29 @@
          "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)
-  (string->jsexpr 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
@@ -25,7 +38,7 @@
     (add-requester-headers
      json-headers http-requester/exn))))
 
-(module+ integration-test
+(module+ test
   (require net/url
            rackunit)
 
@@ -47,6 +60,7 @@
 
   (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")
@@ -66,6 +80,11 @@
   (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?

From 84f1237402a701a3e1a487691cfc69635878ffb6 Mon Sep 17 00:00:00 2001
From: DarrenN <info@v25media.com>
Date: Tue, 20 Sep 2016 18:29:26 -0400
Subject: [PATCH 8/8] correct test submodule name, again

---
 request/private/json.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/request/private/json.rkt b/request/private/json.rkt
index ceca934..d49bb8c 100644
--- a/request/private/json.rkt
+++ b/request/private/json.rkt
@@ -38,7 +38,7 @@
     (add-requester-headers
      json-headers http-requester/exn))))
 
-(module+ test
+(module+ integraton-test
   (require net/url
            rackunit)