content: {-# LANGUAGE OverloadedStrings #-}
  
  -- |
  -- Module      : Gogol.Internal.Multipart
  -- Copyright   : (c) 2015-2022 Brendan Hay
  -- License     : Mozilla Public License, v. 2.0.
  -- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
  -- Stability   : provisional
  -- Portability : non-portable (GHC extensions)
  module Gogol.Internal.Multipart where
  
  import Control.Monad.IO.Class (MonadIO (..))
  import Data.ByteString (ByteString)
  import Data.ByteString qualified as BS
  import Data.ByteString.Builder.Extra (byteStringCopy)
  import Gogol.Types (GBody (..))
  import Network.HTTP.Client
  import Network.HTTP.Client.MultipartFormData (webkitBoundary)
  import Network.HTTP.Media (RenderHeader (..))
  import Network.HTTP.Types (Header, hContentType)
  
  -- POST /upload/drive/v2/files?uploadType=multipart HTTP/1.1
  -- Host: www.googleapis.com
  -- Authorization: Bearer your_auth_token
  -- Content-Type: multipart/related; boundary="foo_bar_baz"
  -- Content-Length: number_of_bytes_in_entire_request_body
  
  -- --foo_bar_baz
  -- Content-Type: application/json; charset=UTF-8N
  -- {
  --   "title": "My File"
  -- }
  -- --foo_bar_baz
  -- Content-Type: image/jpeg
  -- JPEG data
  -- --foo_bar_baz--
  
  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 -> [GBody] -> RequestBody
  renderParts b = (<> part b) . foldMap go
    where
      go (GBody ct x) =
        start b
          <> copy "Content-Type: "
          <> copy (renderHeader ct)
          <> copy "\r\n\r\n"
          <> x
          <> copy "\r\n"
  