diff --git a/test/Test/Hspec/Wai/Extra.hs b/test/Test/Hspec/Wai/Extra.hs new file mode 100644 index 0000000..8bbabb8 --- /dev/null +++ b/test/Test/Hspec/Wai/Extra.hs @@ -0,0 +1,65 @@ +-- | This should be in 'hspec-wai', PR pending as of Feb 2024 : https://github.com/hspec/hspec-wai/pull/77 + +{-# language OverloadedStrings #-} +module Test.Hspec.Wai.Extra (postMultipartForm, FileMeta(..)) where + +import qualified Data.Char as Char +import Data.List (intersperse) + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Builder as Builder +import qualified Data.ByteString.Lazy as LB + +import Data.Word (Word8) + +import Network.HTTP.Types (methodPost, hContentType) +import Network.Wai.Test (SResponse) + +import Test.Hspec.Wai (request) +import Test.Hspec.Wai.Internal (WaiSession) + +-- | @POST@ a @multipart/form-data@ form which might include files. +-- +-- The @Content-Type@ is set to @multipart/form-data; boundary=@ where @bd@ is the part separator without the @--@ prefix. +postMultipartForm :: ByteString -- ^ path + -> ByteString -- ^ part separator without any dashes + -> [(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 + +-- | Encode the body of a multipart form post +-- +-- schema from : https://swagger.io/docs/specification/describing-request-body/multipart-requests/ +formMultipartQuery :: ByteString -- ^ part separator without any dashes + -> [(FileMeta, ByteString, ByteString, ByteString)] -- ^ (file metadata, field MIME type, field name, field contents) + -> LB.ByteString +formMultipartQuery sbs = Builder.toLazyByteString . mconcat . (preamble :) . intersperse newline . encodeAll + where + preamble = + kv "Content-Type" ("multipart/form-data; boundary=" <> Builder.byteString sbs <> newline <> newline) + encodeAll fs = map encodeFile fs <> [sepEnd] + encodeFile (fieldMeta, ty, n, payload) = mconcat $ [ + sep + , newline + , kv "Content-Disposition" ("form-data;" <> " name=" <> quoted n <> encodeMPField fieldMeta) + , newline + , kv "Content-Type" (Builder.byteString ty) + , newline, newline + , Builder.byteString payload + ] + sep = Builder.byteString ("--" <> sbs) + sepEnd = Builder.byteString ("--" <> sbs <> "--") + encodeMPField FMFormField = mempty + encodeMPField (FMFile fname) = "; filename=" <> quoted fname + quoted x = Builder.byteString ("\"" <> x <> "\"") + kv k v = k <> ": " <> v + newline = Builder.word8 (ord '\n') + + +data FileMeta = FMFormField -- ^ any form field except a file + | FMFile ByteString -- ^ file name + + +ord :: Char -> Word8 +ord = fromIntegral . Char.ord