From 2f5d1a9fb20ba44d96ef00e4f59b787faa085367 Mon Sep 17 00:00:00 2001
From: Marco Zocca <marco.zocca@unfoldml.com>
Date: Mon, 1 Jan 2024 12:01:16 +0100
Subject: [PATCH] add test and docs

---
 src/Test/Hspec/Wai.hs      | 23 ++++++++++++++++++++++-
 src/Test/Hspec/Wai/Util.hs | 33 ++++++++++++++++++++++++++++++---
 test/Test/Hspec/WaiSpec.hs | 11 +++++++++++
 3 files changed, 63 insertions(+), 4 deletions(-)

diff --git a/src/Test/Hspec/Wai.hs b/src/Test/Hspec/Wai.hs
index 25f72ec..4c2b7fa 100644
--- a/src/Test/Hspec/Wai.hs
+++ b/src/Test/Hspec/Wai.hs
@@ -19,7 +19,12 @@ module Test.Hspec.Wai (
 , request
 
 -- ** Posting HTML forms
+  -- *** URL-encoded
 , postHtmlForm
+, postUrlEncodedForm
+-- *** Files
+, postMultipartForm
+, FileMeta(..)
 
 -- * Matching on the response
 , shouldRespondWith
@@ -153,5 +158,21 @@ request method path headers = WaiSession . lift . Wai.srequest . SRequest req
 -- @application/x-www-form-urlencoded@ and used as request body.
 --
 -- In addition the @Content-Type@ is set to @application/x-www-form-urlencoded@.
-postHtmlForm :: ByteString -> [(String, String)] -> WaiSession st SResponse
+postHtmlForm :: ByteString -- ^ path
+             -> [(String, String)] -> WaiSession st SResponse
 postHtmlForm path = request methodPost path [(hContentType, "application/x-www-form-urlencoded")] . formUrlEncodeQuery
+
+-- | Synonym for 'postHtmlForm'
+postUrlEncodedForm :: ByteString -- ^ path
+                   -> [(String, String)] -> WaiSession st SResponse
+postUrlEncodedForm = postHtmlForm
+
+-- | @POST@ a @multipart/form-data@ form which might include files.
+--
+-- The @Content-Type@ is set to @multipart/form-data; boundary=<bd>@ where @bd@ is the part separator without the @--@ prefix.
+postMultipartForm :: ByteString -- ^ path
+                  -> ByteString -- ^ part separator
+                  -> [(FileMeta, ByteString, ByteString, ByteString)] -- ^ (file metadata, field MIME type, field name, field contents)
+                  -> WaiSession st SResponse
+postMultipartForm path sbs =
+  request methodPost path [(hContentType, "multipart/form-data; boundary=" <> sbs)] . formMultipartQuery sbs
diff --git a/src/Test/Hspec/Wai/Util.hs b/src/Test/Hspec/Wai/Util.hs
index 347af6d..32e931c 100644
--- a/src/Test/Hspec/Wai/Util.hs
+++ b/src/Test/Hspec/Wai/Util.hs
@@ -38,6 +38,36 @@ safeToString bs = do
 toStrict :: LB.ByteString -> ByteString
 toStrict = mconcat . LB.toChunks
 
+-- | Encode the body of a multipart form post
+--
+-- schema from : https://swagger.io/docs/specification/describing-request-body/multipart-requests/
+formMultipartQuery :: ByteString -- ^ part separator
+                   -> [(FileMeta, ByteString, ByteString, ByteString)] -- ^ (file metadata, field MIME type, field name, field contents)
+                   -> LB.ByteString
+formMultipartQuery sbs = Builder.toLazyByteString . mconcat . intersperse newline . map encodeFile
+  where
+    sep = Builder.byteString ("--" <> sbs)
+    newline = Builder.word8 (ord '\n')
+    kv k v = k <> ": " <> v
+    quoted x = Builder.byteString ("\"" <> x <> "\"")
+    encodeMPField FMFormField = mempty
+    encodeMPField (FMFile fname) = "; filename=" <> quoted fname
+    encodeFile (fieldMeta, ty, n, payload) = mconcat $ intersperse newline [
+      kv "Content-Disposition" ("form-data;" <> " name=" <> quoted n <> encodeMPField fieldMeta)
+      , kv "Content-Type" (Builder.byteString ty)
+      -- , newline
+      , Builder.byteString payload
+      , sep
+      ]
+
+
+data FileMeta = FMFormField -- ^ any form field except a file
+              | FMFile ByteString -- ^ file name
+
+
+ord :: Char -> Word8
+ord = fromIntegral . Char.ord
+
 formUrlEncodeQuery :: [(String, String)] -> LB.ByteString
 formUrlEncodeQuery = Builder.toLazyByteString . mconcat . intersperse amp . map encodePair
   where
@@ -77,9 +107,6 @@ formUrlEncodeQuery = Builder.toLazyByteString . mconcat . intersperse amp . map
           || ord '0' <= c && c <= ord '9'
           || ord 'A' <= c && c <= ord 'Z'
 
-    ord :: Char -> Word8
-    ord = fromIntegral . Char.ord
-
     percentEncode :: Word8 -> Builder
     percentEncode n = percent <> hex hi <> hex lo
       where
diff --git a/test/Test/Hspec/WaiSpec.hs b/test/Test/Hspec/WaiSpec.hs
index 1191faa..8524443 100644
--- a/test/Test/Hspec/WaiSpec.hs
+++ b/test/Test/Hspec/WaiSpec.hs
@@ -64,7 +64,18 @@ spec = do
     it "sends a post request with form-encoded params" $ do
       postHtmlForm "/foo" [("foo", "bar")] `shouldRespondWith` 200
 
+  describe "postMultipartForm" $ with (return $ expectRequest methodPost "/foo" "Content-Disposition: form-data; name=\"id\"\nContent-Type: text/plain\n123e4567-e89b-12d3-a456-426655440000\n--abcde12345\nContent-Disposition: form-data; name=\"profileImage\"; filename=\"image1.png\"\nContent-Type: application/octet-stream\n{_file content_}\n--abcde12345" multipartEncoded) $ do
+    it "sends a multipart form" $ do
+      postMultipartForm "foo" "abcde12345" [
+        (FMFormField, "text/plain", "id", "123e4567-e89b-12d3-a456-426655440000")
+        , (FMFile "image1.png", "application/octet-stream", "profileImage", "{_file content_}")
+        ] `shouldRespondWith` 200
+
   where
     accept = [(hAccept, "application/json")]
     body = "{\"foo\": 1}"
     formEncoded = [(hContentType, "application/x-www-form-urlencoded")]
+    mpSep = "abcde12345"
+    multipartEncoded = [(hContentType, "multipart/form-data; boundary=" <> mpSep)]
+
+