Test `parse-multipart/form-data' procedure.

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)))