{-# LANGUAGE OverloadedStrings #-}
module Network.Google.Internal.Multipart where
import Control.Monad.IO.Class (MonadIO (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Builder.Extra (byteStringCopy)
import Data.Monoid ((<>))
import Network.Google.Types (Body (..))
import Network.HTTP.Client
import Network.HTTP.Client.MultipartFormData (webkitBoundary)
import Network.HTTP.Media (RenderHeader (..))
import Network.HTTP.Types (Header, hContentType)
newtype Boundary = Boundary ByteString
genBoundary :: MonadIO m => m Boundary
genBoundary = Boundary <$> liftIO webkitBoundary
multipartHeader :: Boundary -> Header
multipartHeader (Boundary bs) =
( hContentType
, "multipart/related; boundary=" <> bs
)
start :: Boundary -> RequestBody
start (Boundary bs) = copy "--" <> copy bs <> copy "\r\n"
part :: Boundary -> RequestBody
part (Boundary bs) = copy "--" <> copy bs <> copy "--\r\n"
copy :: ByteString -> RequestBody
copy bs = RequestBodyBuilder (fromIntegral (BS.length bs)) (byteStringCopy bs)
renderParts :: Boundary -> [Body] -> RequestBody
renderParts b = (<> part b) . foldMap go
where
go (Body ct x) =
start b
<> copy "Content-Type: "
<> copy (renderHeader ct)
<> copy "\r\n\r\n"
<> x
<> copy "\r\n"