http-client-multipart-0.2.0.0/0000755000000000000000000000000012247525235014316 5ustar0000000000000000http-client-multipart-0.2.0.0/Setup.hs0000644000000000000000000000005612247525235015753 0ustar0000000000000000import Distribution.Simple main = defaultMain http-client-multipart-0.2.0.0/http-client-multipart.cabal0000644000000000000000000000160012247525235021551 0ustar0000000000000000name: http-client-multipart version: 0.2.0.0 synopsis: Generate multipart uploads for http-client. homepage: https://github.com/snoyberg/http-client license: MIT license-file: LICENSE author: Michael Snoyman maintainer: michael@snoyman.com category: Network build-type: Simple cabal-version: >=1.10 library exposed-modules: Network.HTTP.Client.MultipartFormData build-depends: base >= 4 && < 5 , http-client >= 0.2 , bytestring , array , random , filepath , transformers , text , blaze-builder , http-types , mime-types default-language: Haskell2010 http-client-multipart-0.2.0.0/LICENSE0000644000000000000000000000207212247525235015324 0ustar0000000000000000The MIT License (MIT) Copyright (c) 2013 Michael Snoyman Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. http-client-multipart-0.2.0.0/Network/0000755000000000000000000000000012247525235015747 5ustar0000000000000000http-client-multipart-0.2.0.0/Network/HTTP/0000755000000000000000000000000012247525235016526 5ustar0000000000000000http-client-multipart-0.2.0.0/Network/HTTP/Client/0000755000000000000000000000000012247525235017744 5ustar0000000000000000http-client-multipart-0.2.0.0/Network/HTTP/Client/MultipartFormData.hs0000644000000000000000000001766112247525235023712 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} -- | This module handles building multipart/form-data. Example usage: -- -- > {-# LANGUAGE OverloadedStrings #-} -- > import Network -- > import Network.HTTP.Conduit -- > import Network.HTTP.Conduit.MultipartFormData -- > -- > import Data.Text.Encoding as TE -- > -- > import Control.Monad -- > -- > main = withSocketsDo $ withManager $ \m -> do -- > req1 <- parseUrl "http://random-cat-photo.net/cat.jpg" -- > res <- httpLbs req1 m -- > req2 <- parseUrl "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(..) -- * Constructing parts ,partBS ,partLBS ,partFile ,partFileSource ,partFileSourceChunked ,partFileRequestBody ,partFileRequestBodyM -- * Building form data ,formDataBody ,formDataBodyWithBoundary -- * Boundary ,webkitBoundary ,webkitBoundaryPure -- * Misc ,renderParts ,renderPart ) where import Network.HTTP.Client import Network.Mime import Network.HTTP.Types (hContentType, methodPost) import Data.Monoid ((<>)) 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 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) -- | A single part of a multipart message. data Part = Part { partName :: Text -- ^ Name of the corresponding \ , partFilename :: Maybe String -- ^ A file name, if this is an attached file , partContentType :: Maybe MimeType -- ^ Content type , partGetBody :: IO RequestBody -- ^ Action in m which returns the body -- of a message. } instance Show Part where showsPrec d (Part n f c _) = showParen (d>=11) $ showString "Part " . showsPrec 11 n . showString " " . showsPrec 11 f . showString " " . showsPrec 11 c . showString " " . showString "" partBS :: Text -> BS.ByteString -> Part partBS n b = Part n mempty mempty $ return $ RequestBodyBS b partLBS :: Text -> BL.ByteString -> Part partLBS n b = Part n mempty mempty $ return $ RequestBodyLBS b -- | Make a 'Part' from a file, the entire file will reside in memory at once. -- If you want constant memory usage use 'partFileSource' partFile :: Text -> FilePath -> Part partFile n f = partFileRequestBodyM n f $ do liftM RequestBodyBS $ liftIO $ BS.readFile f -- | Stream 'Part' from a file. partFileSource :: Text -> FilePath -> Part partFileSource n f = partFileRequestBodyM n f $ do size <- liftIO $ withBinaryFile f ReadMode hFileSize return $ RequestBodyStream (fromInteger size) $ streamFile f streamFile :: FilePath -> GivesPopper () streamFile fp np = withFile fp ReadMode $ np . go where go h = BS.hGetSome h 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. partFileSourceChunked :: Text -> FilePath -> Part partFileSourceChunked n f = partFileRequestBody n f $ do RequestBodyStreamChunked $ streamFile 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 partFileRequestBody :: Text -> FilePath -> RequestBody -> Part partFileRequestBody n f rqb = partFileRequestBodyM n f $ return 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 partFileRequestBodyM :: Text -> FilePath -> IO RequestBody -> Part partFileRequestBodyM n f rqb = Part n (Just f) (Just $ defaultMimeLookup $ pack f) rqb {-# INLINE cp #-} cp :: BS.ByteString -> RequestBody cp bs = RequestBodyBuilder (fromIntegral $ BS.length bs) $ copyByteString bs renderPart :: BS.ByteString -> Part -> IO RequestBody renderPart boundary (Part name mfilename mcontenttype get) = liftM render get where render renderBody = cp "--" <> cp boundary <> cp "\r\n" <> cp "Content-Disposition: form-data; name=\"" <> RequestBodyBS (TE.encodeUtf8 name) <> (case mfilename of Just f -> cp "\"; filename=\"" <> RequestBodyBS (TE.encodeUtf8 $ pack $ takeFileName f) _ -> mempty) <> cp "\"" <> (case mcontenttype of Just ct -> cp "\r\n" <> cp "Content-Type: " <> cp ct _ -> mempty) <> cp "\r\n\r\n" <> renderBody <> cp "\r\n" -- | Combine the 'Part's to form multipart/form-data body renderParts :: BS.ByteString -> [Part] -> IO RequestBody renderParts boundary parts = (fin . mconcat) `liftM` mapM (renderPart boundary) parts where fin = (<> cp "--" <> cp boundary <> cp "--\r\n") -- | Generate a boundary simillar to those generated by WebKit-based browsers. webkitBoundary :: IO BS.ByteString webkitBoundary = getStdRandom webkitBoundaryPure webkitBoundaryPure :: RandomGen g => g -> (BS.ByteString, g) webkitBoundaryPure g = (`runState` g) $ do fmap (BS.append prefix . BS.pack . Prelude.concat) $ replicateM 4 $ do randomness <- state $ random return [unsafeAt alphaNumericEncodingMap $ randomness `shiftR` 24 .&. 0x3F ,unsafeAt alphaNumericEncodingMap $ randomness `shiftR` 16 .&. 0x3F ,unsafeAt alphaNumericEncodingMap $ randomness `shiftR` 8 .&. 0x3F ,unsafeAt alphaNumericEncodingMap $ randomness .&. 0x3F] where prefix = "----WebKitFormBoundary" alphaNumericEncodingMap :: UArray Int Word8 alphaNumericEncodingMap = listArray (0, 63) [0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x41, 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 a b = liftIO $ do boundary <- webkitBoundary formDataBodyWithBoundary boundary a b -- | Add form data with supplied boundary formDataBodyWithBoundary :: BS.ByteString -> [Part] -> Request -> IO Request formDataBodyWithBoundary boundary parts req = do body <- renderParts boundary parts return $ req { method = methodPost , requestHeaders = (hContentType, "multipart/form-data; boundary=" <> boundary) : Prelude.filter (\(x, _) -> x /= hContentType) (requestHeaders req) , requestBody = body }