diff options
| -rw-r--r-- | tests/guile/cantius-test.scm | 100 |
1 files changed, 99 insertions, 1 deletions
diff --git a/tests/guile/cantius-test.scm b/tests/guile/cantius-test.scm index 328573c..3591b64 100644 --- a/tests/guile/cantius-test.scm +++ b/tests/guile/cantius-test.scm @@ -3,15 +3,113 @@ ;;; Copyright (C) 2023, 2024 Wojtek Kosior <koszko@koszko.org> (use-modules ((scheme base) #:select (bytevector-copy string->utf8)) + ((rnrs bytevectors) #:prefix bv:) ((srfi srfi-8) #:select (receive)) ((srfi srfi-26) #:select (cut)) ((srfi srfi-34) #:select (guard raise)) + ((srfi srfi-35) #:select (condition-has-type?)) ((ice-9 safe-r5rs) #:select (null-environment)) ((ice-9 format) #:select (format)) + ((ice-9 regex) #:select (regexp-substitute/global)) ((web client) #:select (open-socket-for-uri http-get)) ((web response) #:prefix rsp:) ((web uri) #:prefix uri:) - ((myra-test-utils) #:prefix tu:)) + ((myra-test-utils) #:prefix tu:) + ((cantius) #:prefix cant:)) + +(define (use-crlf text) + (regexp-substitute/global #f "\n" text 'pre "\r\n" 'post)) + +(define %form-data-good + (use-crlf "\ +----boundary +Content-Disposition: form-data; name=\"binary-field\"; filename=\"somefile\" +Content-Type: application/octet-stream + +śómę-ńóń-ĄŚĆII-dątą\\ +----boundary +Content-Disposition: form-data; name=\"text-field1\" +Content-Transfer-Encoding: binary + +óthęr-ńóń-ĄŚĆII-dątą\\ +----boundary +Content-Disposition: form-data; name=\"text-field2\"; +Content-Type: text/plain + +//yęt-óthęr-ńóń-ĄŚĆII-dątą +----boundary-- +")) + +(define %form-data-bad-epilogue + (use-crlf "\ +----boundary +Content-Disposition: form-data; name=\"field\" + +value +----boundary--SOMETHING-INCORRECT-HERE +")) + +(define %form-data-unsupported-encoding + (use-crlf "\ +----boundary +Content-Disposition: form-data; name=\"field\" +Content-Transfer-Encoding: 7bit + +value +----boundary-- +")) + +(define %form-boundary-1 + "--boundary") + +(define %form-boundary-2 + "--boundary-with-\\-(a-backslash)") + +(tu:test-group "parse-multipart/form-data" + (for-each + (lambda (boundary form-data) + (define (parsed-multipart) + (cant:parse-multipart/form-data boundary (bv:string->utf8 form-data))) + + (tu:test-eqv 3 (length (parsed-multipart))) + + (tu:test-equal '("binary-field" "text-field1" "text-field2") + (map cant:form-data-part-name (parsed-multipart))) + + (tu:test-equal '(((content-disposition . (form-data + (name . "binary-field") + (filename . "somefile"))) + (content-type . (application/octet-stream))) + ((content-disposition . (form-data + (name . "text-field1"))) + (content-transfer-encoding . "binary")) + ((content-disposition . (form-data + (name . "text-field2"))) + (content-type . (text/plain)))) + (map cant:form-data-part-headers (parsed-multipart))) + + (tu:test-equal '(#t #f #f) + (map cant:form-data-part-binary? (parsed-multipart))) + + (tu:test-equal `(,(bv:string->utf8 "śómę-ńóń-ĄŚĆII-dątą\\") + "óthęr-ńóń-ĄŚĆII-dątą\\" + "//yęt-óthęr-ńóń-ĄŚĆII-dątą") + (map cant:form-data-part-data (parsed-multipart)))) + (list %form-boundary-1 %form-boundary-2) + (list %form-data-good + (regexp-substitute/global #f %form-boundary-1 %form-data-good + 'pre %form-boundary-2 'post))) + + (tu:test-error (cut condition-has-type? <> cant:&bad-request) + (cant:parse-multipart/form-data + %form-boundary-1 + (bv:string->utf8 %form-data-bad-epilogue))) + + (tu:test-error (compose (cut = 415 <>) + cant:condition-http-code) + (cant:parse-multipart/form-data + %form-boundary-1 + (bv:string->utf8 %form-data-unsupported-encoding)))) (define (make-env) (let ((env (null-environment 5))) |