Adds protocol support to make-domain-requester

.travis.yml

@@ -24,5 +24,6 @@ install:
 
 script:
   - raco test -c request
+  - raco test --submodule integration-test request
   - raco doc-coverage request
   - if [ -n "$RUN_COVER" ]; then raco cover -f coveralls -d $TRAVIS_BUILD_DIR/coverage -c request; fi

request/private/http-location.rkt

@@ -7,8 +7,12 @@
 
 (provide
  (contract-out
-  [make-domain-requester (-> string? requester? requester?)]
-  [make-host+port-requester (-> string? exact-nonnegative-integer? requester? requester?)]))
+  [make-domain-requester
+   (-> string? requester? requester?)]
+  [make-host+port-requester
+   (-> string? exact-nonnegative-integer? requester? requester?)]
+  [make-https-requester
+   (-> requester? requester?)]))
 
 
 (define (domain+relative-path->http-url domain relative-path)
@@ -17,8 +21,41 @@
 (define (host+port->domain host port)
   (format "~a:~a" host port))
 
+(define (http-url->https-url location)
+  (struct-copy url location [scheme "https"]))
+
 (define (make-domain-requester domain requester)
-  (wrap-requester-location (domain+relative-path->http-url domain _) requester))
+  (wrap-requester-location
+   (domain+relative-path->http-url domain _) requester))
+
+(define (make-https-requester 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))
+
+(module+ integration-test
+  (require json
+           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)))
+
+  (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))

request/private/http-location.scrbl

@@ -24,10 +24,11 @@ relative paths as locations.
   @racket[domain] to construct a full http @racket[url],
   which is then passed to the underlying @racket[requester].
   The relative path should not begin with a slash.
-  @racketinput[
+  @racketblock[
     (define foo-com-requester
       (make-domain-requester "foo.com" http-requester))
-    (get foo-com-requester "some/sort/of/path") ;; request to http://foo.com/some/sort/of/path
+    (code:comment @#,elem{request to http://foo.com/some/sort/of/path})                                                    
+    (get foo-com-requester "some/sort/of/path")
 ]}
 
 @defproc[(make-host+port-requester [host string?]
@@ -39,3 +40,15 @@ relative paths as locations.
   @racket[(make-host+port-requester "foo.com" 8080 some-requester)]
   is equivalent to @racket[(make-domain-requester "foo.com:8080" some-requester)]
 }
+
+@defproc[(make-https-requester [requester requester?])
+         requester?]{
+ Given a requester that accepts @racket[url?]s
+ as locations, returns a requester that accepts a @racket[url] and converts
+ it to use an https scheme before being passed to the underlying @racket[requester].
+ @racketblock[
+   (define foo-https-requester
+     (make-domain-requester "foo.com" (make-https-requester http-requester)))
+ (code:comment @#,elem{request to https://foo.com/some/sort/of/path})                                                    
+ (get foo-https-requester "some/sort/of/path")
+ ]}