diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/run.scm | 236 | ||||
| -rw-r--r-- | tests/testlib.scm | 2 |
2 files changed, 234 insertions, 4 deletions
diff --git a/tests/run.scm b/tests/run.scm index d8118ac..9ad7fd8 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -3,6 +3,8 @@ (include "../http-client.scm") (import http-client) +(import (chicken port)) + (include "testlib.scm") (test-begin "http-client") @@ -145,7 +147,7 @@ (test "Body was sent correctly" "lala=testing&another=data&more=stuff" (log-body log)))) - (test-group "alist form data body with file port" + (test-group "alist form data body with string port" (let* ((string-port (open-input-string "the file's contents")) (log (with-server-response (lambda () @@ -179,6 +181,165 @@ (test "Content type is multipart" 'multipart/form-data (header-value 'content-type h)) + (test "Content-length was set" + (string-length expected-data) (header-value 'content-length h)) + (test "Version is the default HTTP version of 1.1" + '(1 . 1) + (cons (request-major req) (request-minor req))) + (test "Transfer encoding is not set" + #f + (header-value 'transfer-encoding (request-headers req))) + (test "Body contains the file and other data, delimited by the boundary" + expected-data (log-body log)))) + + (test-group "alist form data body with string port using HTTP/1.0" + (let* ((string-port (open-input-string "the file's contents")) + (uri (uri-reference "http://example.com")) + (req (make-request uri: uri method: 'POST + major: 1 minor: 0)) + (log (with-server-response + (lambda () + (with-input-from-request + req + `((lala . "testing") + (the-file file: ,string-port + filename: "str") + ("more" . stuff)) + read-string)) + "HTTP/1.0 200 OK\r\n\r\n")) + (req (log-request log)) + (h (request-headers req)) + (boundary (header-param 'boundary 'content-type h)) + (expected-data + (conc + "--" boundary "\r\n" + "Content-Disposition: form-data; name=\"lala\"\r\n\r\n" + "testing\r\n" + "--" boundary "\r\n" + "Content-Disposition: form-data; name=\"the-file\"; " + "filename=\"str\"\r\n" + "Content-Type: application/octet-stream\r\n\r\n" + "the file's contents\r\n" + "--" boundary "\r\n" + "Content-Disposition: form-data; name=\"more\"\r\n\r\n" + "stuff\r\n" + "--" boundary "--\r\n"))) + + (test "Request method" 'POST (request-method req)) + (test "Content type is multipart" + 'multipart/form-data + (header-value 'content-type h)) + (test "Content-length was set" + (string-length expected-data) (header-value 'content-length h)) + (test "Version is correct" + '(1 . 0) + (cons (request-major req) (request-minor req))) + (test "Transfer encoding is not set" + #f + (header-value 'transfer-encoding (request-headers req))) + (test "Body contains the file and other data, delimited by the boundary" + expected-data (log-body log)))) + + (test-group "alist form data body with string port with redirect" + (test-error* "results in a port already consumed error" + (exn http port-already-consumed) + (let ((string-port (open-input-string "the file's contents"))) + (with-server-responses + (lambda () + (with-input-from-request + "http://example.com" + `((lala . "testing") + (the-file file: ,string-port + filename: "str") + ("more" . stuff)) + read-string)) + (conc "HTTP/1.0 301 Moved Permanently\r\n" + "Location: http://example.org/different/path\r\n" + "Content-Length: 8\r\n\r\nIgnored!") + "HTTP/1.0 200 OK\r\n\r\n")))) + + (test-group "alist form data body with string data" + (let* ((log (with-server-response + (lambda () + (with-input-from-request + "http://example.com" + `((lala . "testing") + (the-data data: "the data's contents" + filename: "str") + ("more" . stuff)) + read-string)) + "HTTP/1.0 200 OK\r\n\r\n")) + (req (log-request log)) + (h (request-headers req)) + (boundary (header-param 'boundary 'content-type h)) + (expected-data + (conc + "--" boundary "\r\n" + "Content-Disposition: form-data; name=\"lala\"\r\n\r\n" + "testing\r\n" + "--" boundary "\r\n" + "Content-Disposition: form-data; name=\"the-data\"; " + "filename=\"str\"\r\n" + "Content-Type: application/octet-stream\r\n\r\n" + "the data's contents\r\n" + "--" boundary "\r\n" + "Content-Disposition: form-data; name=\"more\"\r\n\r\n" + "stuff\r\n" + "--" boundary "--\r\n"))) + + (test "Request method" 'POST (request-method req)) + (test "Content type is multipart" + 'multipart/form-data + (header-value 'content-type h)) + (test "Content-length was set" + (string-length expected-data) (header-value 'content-length h)) + (test "Version is the default HTTP version of 1.1" + '(1 . 1) + (cons (request-major req) (request-minor req))) + (test "Transfer encoding is not set" + #f + (header-value 'transfer-encoding (request-headers req))) + (test "Body contains the file and other data, delimited by the boundary" + expected-data (log-body log)))) + + (test-group "alist form data body with custom port" + (let* ((string-port (open-input-string "the file's contents")) + (custom-port (make-input-port (lambda () (read-char string-port)) + (constantly #t) + (lambda () (close-input-port string-port)) + read-bytevector: (lambda (p bytes buf off) (read-bytevector! buf string-port off bytes)))) + (log (with-server-response + (lambda () + (with-input-from-request + "http://example.com" + `((lala . "testing") + (the-file file: ,custom-port + filename: "str") + ("more" . stuff)) + read-string)) + "HTTP/1.0 200 OK\r\n\r\n")) + (req (log-request log)) + (h (request-headers req)) + (boundary (header-param 'boundary 'content-type h)) + (expected-data + (conc + "--" boundary "\r\n" + "Content-Disposition: form-data; name=\"lala\"\r\n\r\n" + "testing\r\n" + "--" boundary "\r\n" + "Content-Disposition: form-data; name=\"the-file\"; " + "filename=\"str\"\r\n" + "Content-Type: application/octet-stream\r\n\r\n" + "the file's contents\r\n" + "--" boundary "\r\n" + "Content-Disposition: form-data; name=\"more\"\r\n\r\n" + "stuff\r\n" + "--" boundary "--\r\n"))) + + (test "Request method" 'POST (request-method req)) + (test "Content type is multipart" + 'multipart/form-data + (header-value 'content-type h)) (test "Content-length was not set" #f (header-value 'content-length h)) (test "Version is the default HTTP version of 1.1" @@ -190,8 +351,12 @@ (test "Body contains the file and other data, delimited by the boundary" expected-data (log-body log)))) - (test-group "alist form data body with file port using HTTP/1.0" + (test-group "alist form data body with custom port using HTTP/1.0" (let* ((string-port (open-input-string "the file's contents")) + (custom-port (make-input-port (lambda () (read-char string-port)) + (constantly #t) + (lambda () (close-input-port string-port)) + read-bytevector: (lambda (p bytes buf off) (read-bytevector! buf string-port off bytes)))) (uri (uri-reference "http://example.com")) (req (make-request uri: uri method: 'POST major: 1 minor: 0)) @@ -200,7 +365,7 @@ (with-input-from-request req `((lala . "testing") - (the-file file: ,string-port + (the-file file: ,custom-port filename: "str") ("more" . stuff)) read-string)) @@ -232,6 +397,8 @@ (test "Version is correct" '(1 . 0) (cons (request-major req) (request-minor req))) + ;; This is the important part - no chunking! And also, connection is closed, + ;; but we can't test for that here unless we expose the idle-connections pool. (test "Transfer encoding is not set" #f (header-value 'transfer-encoding (request-headers req))) @@ -520,6 +687,69 @@ '(1 1) (list (request-major req) (request-minor req))) (test "No body got sent (GET)" #f (log-body (last logs)))))) + (test-group "with POST and default value for 'retry-request?'" + (test-error* "results in a premature disconnection error due to retries not allowed for non-idempotent requests" + (exn http premature-disconnection) + (parameterize ((max-retry-attempts 3)) + (with-server-responses + (lambda () + (with-input-from-request + "http://example.com/blah" + `((lala . "testing") + (another . "thing")) + read-string)) + "" + (conc "HTTP/1.0 200 OK\r\n" + "Content-Length: 63\r\n\r\n" + "It would've worked on the second attempt, but we never get here"))))) + + (test-group "with POST and allowing retries for non-idempotent connections" + (parameterize ((retry-request? (constantly #t)) + (max-retry-attempts 3)) + (let* ((logs (with-server-responses + (lambda () + (with-input-from-request + "http://example.com/blah" + `((lala . "testing") + ("more" . stuff)) + read-string)) + "" + (conc "HTTP/1.0 200 OK\r\n" + "Content-Length: 63\r\n\r\n" + "It would've worked on the second attempt, but we never get here"))) + (req (log-request (last logs)))) + + ;; Just a few random checks + (test "URI is still OK" + "/blah" (uri->string (request-uri req))) + (test "host header is also OK" + '("example.com" . #f) + (header-value 'host (request-headers req))) + (test "HTTP request is version 1.1" + '(1 1) (list (request-major req) (request-minor req))) + (test "Body got sent again" + "lala=testing&more=stuff" (log-body (last logs)))))) + + (test-group "with port in data and allowing retries for non-idempotent connections" + (let ((string-port (open-input-string "the file's contents"))) + (test-error* "results in a port already consumed error" + (exn http port-already-consumed) + (parameterize ((retry-request? (constantly #t)) + (max-retry-attempts 3)) + (with-server-responses + (lambda () + (with-input-from-request + "http://example.com/blah" + `((lala . "testing") + (the-file file: ,string-port + filename: "str") + (another . "thing")) + read-string)) + "" + (conc "HTTP/1.0 200 OK\r\n" + "Content-Length: 63\r\n\r\n" + "It would've worked on the second attempt, but we never get here")))))) + (test-group "exceeding maximum retries" (parameterize ((max-retry-attempts 3)) (test-error* "results in a premature disconnection error" diff --git a/tests/testlib.scm b/tests/testlib.scm index 92e69da..e50e5da 100644 --- a/tests/testlib.scm +++ b/tests/testlib.scm @@ -3,7 +3,7 @@ ;; TODO: Test HTTPS somehow? -(import test uri-common intarweb srfi-1 srfi-18 (chicken tcp) +(import (scheme base) test uri-common intarweb srfi-1 srfi-18 (chicken tcp) (chicken string) (chicken io) (chicken file) (chicken format)) ;; From intarweb |