{-# LANGUAGE OverloadedStrings #-}
-- | This module handles building multipart/form-data. Example usage:
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > import Network
-- > import Network.HTTP.Client
-- > import Network.HTTP.Client.MultipartFormData
-- >
-- > import Data.Text.Encoding as TE
-- >
-- > import Control.Monad
-- >
-- > main = void $ withManager defaultManagerSettings $ \m -> do
-- >     req1 <- parseRequest "http://random-cat-photo.net/cat.jpg"
-- >     res <- httpLbs req1 m
-- >     req2 <- parseRequest "http://example.org/~friedrich/blog/addPost.hs"
-- >     flip httpLbs m =<<
-- >         (formDataBody [partBS "title" "Bleaurgh"
-- >                       ,partBS "text" $ TE.encodeUtf8 "矢田矢田矢田矢田矢田"
-- >                       ,partFileSource "file1" "/home/friedrich/Photos/MyLittlePony.jpg"
-- >                       ,partFileRequestBody "file2" "cat.jpg" $ RequestBodyLBS $ responseBody res]
-- >             req2)
module Network.HTTP.Client.MultipartFormData
    (
    -- * Part type
     Part
    ,PartM
    ,partName
    ,partFilename
    ,partContentType
    ,partHeaders
    ,partGetBody
    -- * Constructing parts
    ,partBS
    ,partLBS
    ,partFile
    ,partFileSource
    ,partFileSourceChunked
    ,partFileRequestBody
    ,partFileRequestBodyM
    -- * Headers
    ,addPartHeaders
    -- * Building form data
    ,formDataBody
    ,formDataBodyWithBoundary
    -- * Boundary
    ,webkitBoundary
    ,webkitBoundaryPure
    -- * Misc
    ,renderParts
    ,renderPart
    ) where

import Network.HTTP.Client hiding (streamFile)
import Network.Mime
import Network.HTTP.Types (hContentType, methodPost, Header())
import Data.Monoid ((<>))
import Data.Foldable (foldMap)

import Blaze.ByteString.Builder

import Data.Text
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString as BS

import qualified Data.CaseInsensitive as CI

import Control.Monad.Trans.State.Strict (state, runState)
import Control.Monad.IO.Class
import System.FilePath
import System.Random
import Data.Array.Base
import System.IO
import Data.Bits
import Data.Word
import Data.Monoid (Monoid(..))
import Control.Monad
import Data.ByteString.Lazy.Internal (defaultChunkSize)

type Part = PartM IO

-- | A single part of a multipart message.
data PartM m = Part
    { forall (m :: * -> *). PartM m -> Text
partName :: Text -- ^ Name of the corresponding \<input\>
    , forall (m :: * -> *). PartM m -> Maybe String
partFilename :: Maybe String -- ^ A file name, if this is an attached file
    , forall (m :: * -> *). PartM m -> Maybe MimeType
partContentType :: Maybe MimeType -- ^ Content type
    , forall (m :: * -> *). PartM m -> [Header]
partHeaders :: [Header] -- ^ List of additional headers
    , forall (m :: * -> *). PartM m -> m RequestBody
partGetBody :: m RequestBody -- ^ Action in m which returns the body
                                   -- of a message.
    }

instance Show (PartM m) where
    showsPrec :: Int -> PartM m -> ShowS
showsPrec Int
d (Part Text
n Maybe String
f Maybe MimeType
c [Header]
h m RequestBody
_) =
        Bool -> ShowS -> ShowS
showParen (Int
dforall a. Ord a => a -> a -> Bool
>=Int
11) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Part "
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
n
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe String
f
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe MimeType
c
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Header]
h
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"<m (RequestBody m)>"

-- | Make a 'Part' whose content is a strict 'BS.ByteString'.
--
-- The 'Part' does not have a file name or content type associated
-- with it.
partBS :: Applicative m
       => Text              -- ^ Name of the corresponding \<input\>.
       -> BS.ByteString     -- ^ The body for this 'Part'.
       -> PartM m
partBS :: forall (m :: * -> *). Applicative m => Text -> MimeType -> PartM m
partBS Text
n MimeType
b = forall (m :: * -> *).
Text
-> Maybe String
-> Maybe MimeType
-> [Header]
-> m RequestBody
-> PartM m
Part Text
n forall a. Monoid a => a
Data.Monoid.mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ MimeType -> RequestBody
RequestBodyBS MimeType
b

-- | Make a 'Part' whose content is a lazy 'BL.ByteString'.
--
-- The 'Part' does not have a file name or content type associated
-- with it.
partLBS :: Applicative m
        => Text             -- ^ Name of the corresponding \<input\>.
        -> BL.ByteString    -- ^ The body for this 'Part'.
        -> PartM m
partLBS :: forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partLBS Text
n ByteString
b = forall (m :: * -> *).
Text
-> Maybe String
-> Maybe MimeType
-> [Header]
-> m RequestBody
-> PartM m
Part Text
n forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> RequestBody
RequestBodyLBS ByteString
b

-- | Make a 'Part' from a file.
--
-- The entire file will reside in memory at once.  If you want
-- constant memory usage, use 'partFileSource'.
--
-- The 'FilePath' supplied will be used as the file name of the
-- 'Part'. If you do not want to reveal this name to the server, you
-- must remove it prior to uploading.
--
-- The 'Part' does not have a content type associated with it.
partFile :: Text            -- ^ Name of the corresponding \<input\>.
         -> FilePath        -- ^ The name of the local file to upload.
         -> Part
partFile :: Text -> String -> Part
partFile Text
n String
f =
    forall (m :: * -> *). Text -> String -> m RequestBody -> PartM m
partFileRequestBodyM Text
n String
f forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM MimeType -> RequestBody
RequestBodyBS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO MimeType
BS.readFile String
f

-- | Stream a 'Part' from a file.
--
-- The 'FilePath' supplied will be used as the file name of the
-- 'Part'. If you do not want to reveal this name to the server, you
-- must remove it prior to uploading.
--
-- The 'Part' does not have a content type associated with it.
partFileSource :: Text      -- ^ Name of the corresponding \<input\>.
               -> FilePath  -- ^ The name of the local file to upload.
               -> Part
partFileSource :: Text -> String -> Part
partFileSource Text
n String
f =
    forall (m :: * -> *). Text -> String -> m RequestBody -> PartM m
partFileRequestBodyM Text
n String
f forall a b. (a -> b) -> a -> b
$ do
        Integer
size <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
f IOMode
ReadMode Handle -> IO Integer
hFileSize
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int64 -> GivesPopper () -> RequestBody
RequestBodyStream (forall a. Num a => Integer -> a
fromInteger Integer
size) forall a b. (a -> b) -> a -> b
$ String -> GivesPopper ()
streamFile String
f

streamFile :: FilePath -> GivesPopper ()
streamFile :: String -> GivesPopper ()
streamFile String
fp NeedsPopper ()
np =
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
fp IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ NeedsPopper ()
np forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO MimeType
go
  where
    go :: Handle -> IO MimeType
go Handle
h = Handle -> Int -> IO MimeType
BS.hGetSome Handle
h Int
defaultChunkSize

-- | 'partFileSourceChunked' will read a file and send it in chunks.
--
-- Note that not all servers support this. Only use 'partFileSourceChunked'
-- if you know the server you're sending to supports chunked request bodies.
--
-- The 'FilePath' supplied will be used as the file name of the
-- 'Part'. If you do not want to reveal this name to the server, you
-- must remove it prior to uploading.
--
-- The 'Part' does not have a content type associated with it.
partFileSourceChunked :: Text -> FilePath -> Part
partFileSourceChunked :: Text -> String -> Part
partFileSourceChunked Text
n String
f =
    forall (m :: * -> *).
Applicative m =>
Text -> String -> RequestBody -> PartM m
partFileRequestBody Text
n String
f forall a b. (a -> b) -> a -> b
$ do
        GivesPopper () -> RequestBody
RequestBodyStreamChunked forall a b. (a -> b) -> a -> b
$ String -> GivesPopper ()
streamFile String
f

-- | Construct a 'Part' from form name, filepath and a 'RequestBody'
--
-- > partFileRequestBody "who_calls" "caller.json" $ RequestBodyBS "{\"caller\":\"Jason J Jason\"}"
--
-- > -- empty upload form
-- > partFileRequestBody "file" mempty mempty
--
-- The 'Part' does not have a content type associated with it.
partFileRequestBody :: Applicative m
                    => Text        -- ^ Name of the corresponding \<input\>.
                    -> FilePath    -- ^ File name to supply to the server.
                    -> RequestBody -- ^ Data to upload.
                    -> PartM m
partFileRequestBody :: forall (m :: * -> *).
Applicative m =>
Text -> String -> RequestBody -> PartM m
partFileRequestBody Text
n String
f RequestBody
rqb =
    forall (m :: * -> *). Text -> String -> m RequestBody -> PartM m
partFileRequestBodyM Text
n String
f forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure RequestBody
rqb

-- | Construct a 'Part' from action returning the 'RequestBody'
--
-- > partFileRequestBodyM "cat_photo" "haskell-the-cat.jpg" $ do
-- >     size <- fromInteger <$> withBinaryFile "haskell-the-cat.jpg" ReadMode hFileSize
-- >     return $ RequestBodySource size $ CB.sourceFile "haskell-the-cat.jpg" $= CL.map fromByteString
--
-- The 'Part' does not have a content type associated with it.
partFileRequestBodyM :: Text        -- ^ Name of the corresponding \<input\>.
                     -> FilePath    -- ^ File name to supply to the server.
                     -> m RequestBody -- ^ Action that will supply data to upload.
                     -> PartM m
partFileRequestBodyM :: forall (m :: * -> *). Text -> String -> m RequestBody -> PartM m
partFileRequestBodyM Text
n String
f m RequestBody
rqb =
    forall (m :: * -> *).
Text
-> Maybe String
-> Maybe MimeType
-> [Header]
-> m RequestBody
-> PartM m
Part Text
n (forall a. a -> Maybe a
Just String
f) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> MimeType
defaultMimeLookup forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
f) forall a. Monoid a => a
mempty m RequestBody
rqb

{-# INLINE cp #-}
cp :: BS.ByteString -> RequestBody
cp :: MimeType -> RequestBody
cp MimeType
bs = Int64 -> Builder -> RequestBody
RequestBodyBuilder (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ MimeType -> Int
BS.length MimeType
bs) forall a b. (a -> b) -> a -> b
$ MimeType -> Builder
copyByteString MimeType
bs

-- | Add a list of additional headers to this 'Part'.
addPartHeaders :: PartM m -> [Header] -> PartM m
addPartHeaders :: forall (m :: * -> *). PartM m -> [Header] -> PartM m
addPartHeaders PartM m
p [Header]
hs = PartM m
p { partHeaders :: [Header]
partHeaders = forall (m :: * -> *). PartM m -> [Header]
partHeaders PartM m
p forall a. Semigroup a => a -> a -> a
<> [Header]
hs }

renderPart :: Functor m
           => BS.ByteString     -- ^ Boundary between parts.
           -> PartM m -> m RequestBody
renderPart :: forall (m :: * -> *).
Functor m =>
MimeType -> PartM m -> m RequestBody
renderPart MimeType
boundary (Part Text
name Maybe String
mfilename Maybe MimeType
mcontenttype [Header]
hdrs m RequestBody
get) = RequestBody -> RequestBody
render forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m RequestBody
get
  where render :: RequestBody -> RequestBody
render RequestBody
renderBody =
            MimeType -> RequestBody
cp MimeType
"--" forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
boundary forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"\r\n"
         forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"Content-Disposition: form-data; name=\""
         forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
RequestBodyBS (Text -> MimeType
TE.encodeUtf8 Text
name)
         forall a. Semigroup a => a -> a -> a
<> (case Maybe String
mfilename of
                 Just String
f -> MimeType -> RequestBody
cp MimeType
"\"; filename=\""
                        forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
RequestBodyBS (Text -> MimeType
TE.encodeUtf8 forall a b. (a -> b) -> a -> b
$ String -> Text
pack forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName String
f)
                 Maybe String
_ -> forall a. Monoid a => a
mempty)
         forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"\""
         forall a. Semigroup a => a -> a -> a
<> (case Maybe MimeType
mcontenttype of
                Just MimeType
ct -> MimeType -> RequestBody
cp MimeType
"\r\n"
                        forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"Content-Type: "
                        forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
ct
                Maybe MimeType
_ -> forall a. Monoid a => a
mempty)
         forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Data.Foldable.foldMap (\(CI MimeType
k, MimeType
v) ->
               MimeType -> RequestBody
cp MimeType
"\r\n"
            forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp (forall s. CI s -> s
CI.original CI MimeType
k)
            forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
": "
            forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
v) [Header]
hdrs
         forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"\r\n\r\n"
         forall a. Semigroup a => a -> a -> a
<> RequestBody
renderBody forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"\r\n"

-- | Combine the 'Part's to form multipart/form-data body
renderParts :: Applicative m
            => BS.ByteString    -- ^ Boundary between parts.
            -> [PartM m] -> m RequestBody
renderParts :: forall (m :: * -> *).
Applicative m =>
MimeType -> [PartM m] -> m RequestBody
renderParts MimeType
boundary [PartM m]
parts = (RequestBody -> RequestBody
fin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *).
Functor m =>
MimeType -> PartM m -> m RequestBody
renderPart MimeType
boundary) [PartM m]
parts
  where fin :: RequestBody -> RequestBody
fin = (forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"--" forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
boundary forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"--\r\n")

-- | Generate a boundary simillar to those generated by WebKit-based browsers.
webkitBoundary :: IO BS.ByteString
webkitBoundary :: IO MimeType
webkitBoundary = forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom forall g. RandomGen g => g -> (MimeType, g)
webkitBoundaryPure

webkitBoundaryPure :: RandomGen g => g -> (BS.ByteString, g)
webkitBoundaryPure :: forall g. RandomGen g => g -> (MimeType, g)
webkitBoundaryPure g
g = (forall s a. State s a -> s -> (a, s)
`runState` g
g) forall a b. (a -> b) -> a -> b
$ do
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MimeType -> MimeType -> MimeType
BS.append MimeType
prefix forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> MimeType
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Prelude.concat) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 forall a b. (a -> b) -> a -> b
$ do
        Int
randomness <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ forall a g. (Random a, RandomGen g) => g -> (a, g)
random
        forall (m :: * -> *) a. Monad m => a -> m a
return [forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Word8
alphaNumericEncodingMap forall a b. (a -> b) -> a -> b
$ Int
randomness forall a. Bits a => a -> Int -> a
`shiftR` Int
24 forall a. Bits a => a -> a -> a
.&. Int
0x3F
               ,forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Word8
alphaNumericEncodingMap forall a b. (a -> b) -> a -> b
$ Int
randomness forall a. Bits a => a -> Int -> a
`shiftR` Int
16 forall a. Bits a => a -> a -> a
.&. Int
0x3F
               ,forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Word8
alphaNumericEncodingMap forall a b. (a -> b) -> a -> b
$ Int
randomness forall a. Bits a => a -> Int -> a
`shiftR` Int
8 forall a. Bits a => a -> a -> a
.&. Int
0x3F
               ,forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Word8
alphaNumericEncodingMap forall a b. (a -> b) -> a -> b
$ Int
randomness forall a. Bits a => a -> a -> a
.&. Int
0x3F]
  where
    prefix :: MimeType
prefix = MimeType
"----WebKitFormBoundary"
    alphaNumericEncodingMap :: UArray Int Word8
    alphaNumericEncodingMap :: UArray Int Word8
alphaNumericEncodingMap = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, Int
63)
        [Word8
0x41, Word8
0x42, Word8
0x43, Word8
0x44, Word8
0x45, Word8
0x46, Word8
0x47, Word8
0x48,
         Word8
0x49, Word8
0x4A, Word8
0x4B, Word8
0x4C, Word8
0x4D, Word8
0x4E, Word8
0x4F, Word8
0x50,
         Word8
0x51, Word8
0x52, Word8
0x53, Word8
0x54, Word8
0x55, Word8
0x56, Word8
0x57, Word8
0x58,
         Word8
0x59, Word8
0x5A, Word8
0x61, Word8
0x62, Word8
0x63, Word8
0x64, Word8
0x65, Word8
0x66,
         Word8
0x67, Word8
0x68, Word8
0x69, Word8
0x6A, Word8
0x6B, Word8
0x6C, Word8
0x6D, Word8
0x6E,
         Word8
0x6F, Word8
0x70, Word8
0x71, Word8
0x72, Word8
0x73, Word8
0x74, Word8
0x75, Word8
0x76,
         Word8
0x77, Word8
0x78, Word8
0x79, Word8
0x7A, Word8
0x30, Word8
0x31, Word8
0x32, Word8
0x33,
         Word8
0x34, Word8
0x35, Word8
0x36, Word8
0x37, Word8
0x38, Word8
0x39, Word8
0x41, Word8
0x42]

-- | Add form data to the 'Request'.
--
-- This sets a new 'requestBody', adds a content-type request header and changes the method to POST.
formDataBody :: MonadIO m => [Part] -> Request -> m Request
formDataBody :: forall (m :: * -> *). MonadIO m => [Part] -> Request -> m Request
formDataBody [Part]
a Request
b = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    MimeType
boundary <- IO MimeType
webkitBoundary
    forall (m :: * -> *).
Applicative m =>
MimeType -> [PartM m] -> Request -> m Request
formDataBodyWithBoundary MimeType
boundary [Part]
a Request
b

-- | Add form data with supplied boundary
formDataBodyWithBoundary :: Applicative m => BS.ByteString -> [PartM m] -> Request -> m Request
formDataBodyWithBoundary :: forall (m :: * -> *).
Applicative m =>
MimeType -> [PartM m] -> Request -> m Request
formDataBodyWithBoundary MimeType
boundary [PartM m]
parts Request
req = do
    (\ RequestBody
body -> Request
req
        { method :: MimeType
method = MimeType
methodPost
        , requestHeaders :: [Header]
requestHeaders =
            (CI MimeType
hContentType, MimeType
"multipart/form-data; boundary=" forall a. Semigroup a => a -> a -> a
<> MimeType
boundary)
          forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (\(CI MimeType
x, MimeType
_) -> CI MimeType
x forall a. Eq a => a -> a -> Bool
/= CI MimeType
hContentType) (Request -> [Header]
requestHeaders Request
req)
        , requestBody :: RequestBody
requestBody = RequestBody
body
        }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Applicative m =>
MimeType -> [PartM m] -> m RequestBody
renderParts MimeType
boundary [PartM m]
parts