{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Client.MultipartFormData
(
Part
,PartM
,partName
,partFilename
,partContentType
,partHeaders
,partGetBody
,partBS
,partLBS
,partFile
,partFileSource
,partFileSourceChunked
,partFileRequestBody
,partFileRequestBodyM
,addPartHeaders
,formDataBody
,formDataBodyWithBoundary
,webkitBoundary
,webkitBoundaryPure
,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
data PartM m = Part
{ forall (m :: * -> *). PartM m -> Text
partName :: Text
, forall (m :: * -> *). PartM m -> Maybe String
partFilename :: Maybe String
, forall (m :: * -> *). PartM m -> Maybe MimeType
partContentType :: Maybe MimeType
, :: [Header]
, forall (m :: * -> *). PartM m -> m RequestBody
partGetBody :: m RequestBody
}
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
dInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Part "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
n
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe String
f
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe MimeType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe MimeType
c
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Header] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Header]
h
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"<m (RequestBody m)>"
partBS :: Applicative m
=> Text
-> BS.ByteString
-> PartM m
partBS :: forall (m :: * -> *). Applicative m => Text -> MimeType -> PartM m
partBS Text
n MimeType
b = Text
-> Maybe String
-> Maybe MimeType
-> [Header]
-> m RequestBody
-> PartM m
forall (m :: * -> *).
Text
-> Maybe String
-> Maybe MimeType
-> [Header]
-> m RequestBody
-> PartM m
Part Text
n Maybe String
forall a. Monoid a => a
Data.Monoid.mempty Maybe MimeType
forall a. Monoid a => a
mempty [Header]
forall a. Monoid a => a
mempty (m RequestBody -> PartM m) -> m RequestBody -> PartM m
forall a b. (a -> b) -> a -> b
$ RequestBody -> m RequestBody
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RequestBody -> m RequestBody) -> RequestBody -> m RequestBody
forall a b. (a -> b) -> a -> b
$ MimeType -> RequestBody
RequestBodyBS MimeType
b
partLBS :: Applicative m
=> Text
-> BL.ByteString
-> PartM m
partLBS :: forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partLBS Text
n ByteString
b = Text
-> Maybe String
-> Maybe MimeType
-> [Header]
-> m RequestBody
-> PartM m
forall (m :: * -> *).
Text
-> Maybe String
-> Maybe MimeType
-> [Header]
-> m RequestBody
-> PartM m
Part Text
n Maybe String
forall a. Monoid a => a
mempty Maybe MimeType
forall a. Monoid a => a
mempty [Header]
forall a. Monoid a => a
mempty (m RequestBody -> PartM m) -> m RequestBody -> PartM m
forall a b. (a -> b) -> a -> b
$ RequestBody -> m RequestBody
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RequestBody -> m RequestBody) -> RequestBody -> m RequestBody
forall a b. (a -> b) -> a -> b
$ ByteString -> RequestBody
RequestBodyLBS ByteString
b
partFile :: Text
-> FilePath
-> Part
partFile :: Text -> String -> Part
partFile Text
n String
f =
Text -> String -> IO RequestBody -> Part
forall (m :: * -> *). Text -> String -> m RequestBody -> PartM m
partFileRequestBodyM Text
n String
f (IO RequestBody -> Part) -> IO RequestBody -> Part
forall a b. (a -> b) -> a -> b
$ do
(MimeType -> RequestBody) -> IO MimeType -> IO RequestBody
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM MimeType -> RequestBody
RequestBodyBS (IO MimeType -> IO RequestBody) -> IO MimeType -> IO RequestBody
forall a b. (a -> b) -> a -> b
$ IO MimeType -> IO MimeType
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MimeType -> IO MimeType) -> IO MimeType -> IO MimeType
forall a b. (a -> b) -> a -> b
$ String -> IO MimeType
BS.readFile String
f
partFileSource :: Text
-> FilePath
-> Part
partFileSource :: Text -> String -> Part
partFileSource Text
n String
f =
Text -> String -> IO RequestBody -> Part
forall (m :: * -> *). Text -> String -> m RequestBody -> PartM m
partFileRequestBodyM Text
n String
f (IO RequestBody -> Part) -> IO RequestBody -> Part
forall a b. (a -> b) -> a -> b
$ do
Integer
size <- IO Integer -> IO Integer
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> IO Integer) -> IO Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> (Handle -> IO Integer) -> IO Integer
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
f IOMode
ReadMode Handle -> IO Integer
hFileSize
RequestBody -> IO RequestBody
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RequestBody -> IO RequestBody) -> RequestBody -> IO RequestBody
forall a b. (a -> b) -> a -> b
$ Int64 -> GivesPopper () -> RequestBody
RequestBodyStream (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
size) (GivesPopper () -> RequestBody) -> GivesPopper () -> RequestBody
forall a b. (a -> b) -> a -> b
$ String -> GivesPopper ()
streamFile String
f
streamFile :: FilePath -> GivesPopper ()
streamFile :: String -> GivesPopper ()
streamFile String
fp NeedsPopper ()
np =
String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
fp IOMode
ReadMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ NeedsPopper ()
np NeedsPopper () -> (Handle -> IO MimeType) -> Handle -> IO ()
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 :: Text -> FilePath -> Part
partFileSourceChunked :: Text -> String -> Part
partFileSourceChunked Text
n String
f =
Text -> String -> RequestBody -> Part
forall (m :: * -> *).
Applicative m =>
Text -> String -> RequestBody -> PartM m
partFileRequestBody Text
n String
f (RequestBody -> Part) -> RequestBody -> Part
forall a b. (a -> b) -> a -> b
$ do
GivesPopper () -> RequestBody
RequestBodyStreamChunked (GivesPopper () -> RequestBody) -> GivesPopper () -> RequestBody
forall a b. (a -> b) -> a -> b
$ String -> GivesPopper ()
streamFile String
f
partFileRequestBody :: Applicative m
=> Text
-> FilePath
-> RequestBody
-> PartM m
partFileRequestBody :: forall (m :: * -> *).
Applicative m =>
Text -> String -> RequestBody -> PartM m
partFileRequestBody Text
n String
f RequestBody
rqb =
Text -> String -> m RequestBody -> PartM m
forall (m :: * -> *). Text -> String -> m RequestBody -> PartM m
partFileRequestBodyM Text
n String
f (m RequestBody -> PartM m) -> m RequestBody -> PartM m
forall a b. (a -> b) -> a -> b
$ RequestBody -> m RequestBody
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RequestBody
rqb
partFileRequestBodyM :: Text
-> FilePath
-> m RequestBody
-> PartM m
partFileRequestBodyM :: forall (m :: * -> *). Text -> String -> m RequestBody -> PartM m
partFileRequestBodyM Text
n String
f m RequestBody
rqb =
Text
-> Maybe String
-> Maybe MimeType
-> [Header]
-> m RequestBody
-> PartM m
forall (m :: * -> *).
Text
-> Maybe String
-> Maybe MimeType
-> [Header]
-> m RequestBody
-> PartM m
Part Text
n (String -> Maybe String
forall a. a -> Maybe a
Just String
f) (MimeType -> Maybe MimeType
forall a. a -> Maybe a
Just (MimeType -> Maybe MimeType) -> MimeType -> Maybe MimeType
forall a b. (a -> b) -> a -> b
$ Text -> MimeType
defaultMimeLookup (Text -> MimeType) -> Text -> MimeType
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
f) [Header]
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 (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ MimeType -> Int
BS.length MimeType
bs) (Builder -> RequestBody) -> Builder -> RequestBody
forall a b. (a -> b) -> a -> b
$ MimeType -> Builder
copyByteString MimeType
bs
addPartHeaders :: PartM m -> [Header] -> PartM m
PartM m
p [Header]
hs = PartM m
p { partHeaders = partHeaders p <> hs }
renderPart :: Functor m
=> BS.ByteString
-> 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 (RequestBody -> RequestBody) -> m RequestBody -> m RequestBody
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
"--" RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
boundary RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"\r\n"
RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"Content-Disposition: form-data; name=\""
RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
RequestBodyBS (Text -> MimeType
TE.encodeUtf8 Text
name)
RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> (case Maybe String
mfilename of
Just String
f -> MimeType -> RequestBody
cp MimeType
"\"; filename=\""
RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
RequestBodyBS (Text -> MimeType
TE.encodeUtf8 (Text -> MimeType) -> Text -> MimeType
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName String
f)
Maybe String
_ -> RequestBody
forall a. Monoid a => a
mempty)
RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"\""
RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> (case Maybe MimeType
mcontenttype of
Just MimeType
ct -> MimeType -> RequestBody
cp MimeType
"\r\n"
RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"Content-Type: "
RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
ct
Maybe MimeType
_ -> RequestBody
forall a. Monoid a => a
mempty)
RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> (Header -> RequestBody) -> [Header] -> RequestBody
forall m a. Monoid m => (a -> m) -> [a] -> m
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"
RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp (CI MimeType -> MimeType
forall s. CI s -> s
CI.original CI MimeType
k)
RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
": "
RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
v) [Header]
hdrs
RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"\r\n\r\n"
RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> RequestBody
renderBody RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"\r\n"
renderParts :: Applicative m
=> BS.ByteString
-> [PartM m] -> m RequestBody
renderParts :: forall (m :: * -> *).
Applicative m =>
MimeType -> [PartM m] -> m RequestBody
renderParts MimeType
boundary [PartM m]
parts = (RequestBody -> RequestBody
fin (RequestBody -> RequestBody)
-> ([RequestBody] -> RequestBody) -> [RequestBody] -> RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RequestBody] -> RequestBody
forall a. Monoid a => [a] -> a
mconcat) ([RequestBody] -> RequestBody) -> m [RequestBody] -> m RequestBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PartM m -> m RequestBody) -> [PartM m] -> m [RequestBody]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (MimeType -> PartM m -> m RequestBody
forall (m :: * -> *).
Functor m =>
MimeType -> PartM m -> m RequestBody
renderPart MimeType
boundary) [PartM m]
parts
where fin :: RequestBody -> RequestBody
fin = (RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"--" RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
boundary RequestBody -> RequestBody -> RequestBody
forall a. Semigroup a => a -> a -> a
<> MimeType -> RequestBody
cp MimeType
"--\r\n")
webkitBoundary :: IO BS.ByteString
webkitBoundary :: IO MimeType
webkitBoundary = (StdGen -> (MimeType, StdGen)) -> IO MimeType
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom StdGen -> (MimeType, StdGen)
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 = (State g MimeType -> g -> (MimeType, g)
forall s a. State s a -> s -> (a, s)
`runState` g
g) (State g MimeType -> (MimeType, g))
-> State g MimeType -> (MimeType, g)
forall a b. (a -> b) -> a -> b
$ do
([[Word8]] -> MimeType)
-> StateT g Identity [[Word8]] -> State g MimeType
forall a b. (a -> b) -> StateT g Identity a -> StateT g Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MimeType -> MimeType -> MimeType
BS.append MimeType
prefix (MimeType -> MimeType)
-> ([[Word8]] -> MimeType) -> [[Word8]] -> MimeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> MimeType
BS.pack ([Word8] -> MimeType)
-> ([[Word8]] -> [Word8]) -> [[Word8]] -> MimeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Word8]] -> [Word8]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Prelude.concat) (StateT g Identity [[Word8]] -> State g MimeType)
-> StateT g Identity [[Word8]] -> State g MimeType
forall a b. (a -> b) -> a -> b
$ Int -> StateT g Identity [Word8] -> StateT g Identity [[Word8]]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 (StateT g Identity [Word8] -> StateT g Identity [[Word8]])
-> StateT g Identity [Word8] -> StateT g Identity [[Word8]]
forall a b. (a -> b) -> a -> b
$ do
Int
randomness <- (g -> (Int, g)) -> StateT g Identity Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((g -> (Int, g)) -> StateT g Identity Int)
-> (g -> (Int, g)) -> StateT g Identity Int
forall a b. (a -> b) -> a -> b
$ g -> (Int, g)
forall g. RandomGen g => g -> (Int, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random
[Word8] -> StateT g Identity [Word8]
forall a. a -> StateT g Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [UArray Int Word8 -> Int -> Word8
forall i. Ix i => UArray i Word8 -> Int -> Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Word8
alphaNumericEncodingMap (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
randomness Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
24 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F
,UArray Int Word8 -> Int -> Word8
forall i. Ix i => UArray i Word8 -> Int -> Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Word8
alphaNumericEncodingMap (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
randomness Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F
,UArray Int Word8 -> Int -> Word8
forall i. Ix i => UArray i Word8 -> Int -> Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Word8
alphaNumericEncodingMap (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
randomness Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F
,UArray Int Word8 -> Int -> Word8
forall i. Ix i => UArray i Word8 -> Int -> Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Word8
alphaNumericEncodingMap (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
randomness Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F]
where
prefix :: MimeType
prefix = MimeType
"----WebKitFormBoundary"
alphaNumericEncodingMap :: UArray Int Word8
alphaNumericEncodingMap :: UArray Int Word8
alphaNumericEncodingMap = (Int, Int) -> [Word8] -> UArray Int Word8
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]
formDataBody :: MonadIO m => [Part] -> Request -> m Request
formDataBody :: forall (m :: * -> *). MonadIO m => [Part] -> Request -> m Request
formDataBody [Part]
a Request
b = IO Request -> m Request
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> m Request) -> IO Request -> m Request
forall a b. (a -> b) -> a -> b
$ do
MimeType
boundary <- IO MimeType
webkitBoundary
MimeType -> [Part] -> Request -> IO Request
forall (m :: * -> *).
Applicative m =>
MimeType -> [PartM m] -> Request -> m Request
formDataBodyWithBoundary MimeType
boundary [Part]
a Request
b
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 = methodPost
, requestHeaders =
(hContentType, "multipart/form-data; boundary=" <> boundary)
: Prelude.filter (\(CI MimeType
x, MimeType
_) -> CI MimeType
x CI MimeType -> CI MimeType -> Bool
forall a. Eq a => a -> a -> Bool
/= CI MimeType
hContentType) (requestHeaders req)
, requestBody = body
}) (RequestBody -> Request) -> m RequestBody -> m Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MimeType -> [PartM m] -> m RequestBody
forall (m :: * -> *).
Applicative m =>
MimeType -> [PartM m] -> m RequestBody
renderParts MimeType
boundary [PartM m]
parts