-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Test.Cargohold.API.Util where

import qualified Codec.MIME.Parse as MIME
import qualified Codec.MIME.Type as MIME
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.KeyMap as Aeson
import Data.ByteString.Builder
import Data.ByteString.Conversion
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString.Lazy.Char8 as Lazy8
import Data.CaseInsensitive
import Data.String.Conversions
import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, decodeUtf8, encodeUtf8, encodeUtf8Builder)
import GHC.Stack
import Network.HTTP.Client (Request (requestHeaders))
import qualified Network.HTTP.Client as HTTP
import Network.HTTP.Types.Header (HeaderName)
import Testlib.Prelude

uploadSimple ::
  (HasCallStack, MakesValue user, MakesValue settings) =>
  user ->
  settings ->
  (MIME.MIMEType, Lazy8.ByteString) ->
  App Response
uploadSimple :: forall user settings.
(HasCallStack, MakesValue user, MakesValue settings) =>
user -> settings -> (MIMEType, ByteString) -> App Response
uploadSimple user
usr settings
sts (MIMEType
ct, ByteString
bs) = do
  ByteString
body <- settings -> ByteString -> MIMEType -> App ByteString
forall header.
(HasCallStack, MakesValue header) =>
header -> ByteString -> MIMEType -> App ByteString
buildMultipartBody settings
sts ByteString
bs MIMEType
ct
  user -> ByteString -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> ByteString -> App Response
uploadRaw user
usr ByteString
body

decodeHeaderOrFail :: (HasCallStack, FromByteString a) => HeaderName -> Response -> a
decodeHeaderOrFail :: forall a.
(HasCallStack, FromByteString a) =>
HeaderName -> Response -> a
decodeHeaderOrFail HeaderName
h =
  a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"decodeHeaderOrFail: missing or invalid header: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HeaderName -> String
forall a. Show a => a -> String
show HeaderName
h)
    (Maybe a -> a) -> (Response -> Maybe a) -> Response -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe a
forall a. FromByteString a => ByteString -> Maybe a
fromByteString
    (ByteString -> Maybe a)
-> (Response -> ByteString) -> Response -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> Response -> ByteString
getHeader' HeaderName
h

-- | Like 'getHeader', but if no value exists for the given key, return the
-- static ByteString \"NO_HEADER_VALUE\".
getHeader' :: HeaderName -> Response -> ByteString
getHeader' :: HeaderName -> Response -> ByteString
getHeader' HeaderName
h = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"NO_HEADER_VALUE") (Maybe ByteString -> ByteString)
-> (Response -> Maybe ByteString) -> Response -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> Response -> Maybe ByteString
getHeader HeaderName
h

getHeader :: HeaderName -> Response -> Maybe ByteString
getHeader :: HeaderName -> Response -> Maybe ByteString
getHeader HeaderName
h = ((HeaderName, ByteString) -> ByteString)
-> Maybe (HeaderName, ByteString) -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HeaderName, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (Maybe (HeaderName, ByteString) -> Maybe ByteString)
-> (Response -> Maybe (HeaderName, ByteString))
-> Response
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HeaderName, ByteString) -> Bool)
-> [(HeaderName, ByteString)] -> Maybe (HeaderName, ByteString)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((HeaderName
h ==) (HeaderName -> Bool)
-> ((HeaderName, ByteString) -> HeaderName)
-> (HeaderName, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderName, ByteString) -> HeaderName
forall a b. (a, b) -> a
fst) ([(HeaderName, ByteString)] -> Maybe (HeaderName, ByteString))
-> (Response -> [(HeaderName, ByteString)])
-> Response
-> Maybe (HeaderName, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> [(HeaderName, ByteString)]
headers

uploadRaw ::
  (HasCallStack, MakesValue user) =>
  user ->
  Lazy.ByteString ->
  App Response
uploadRaw :: forall user.
(HasCallStack, MakesValue user) =>
user -> ByteString -> App Response
uploadRaw user
usr ByteString
bs = do
  Request
req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
usr Service
Cargohold (Int -> Versioned
ExplicitVersion Int
1) String
"assets/v3"
  String -> Request -> App Response
submit String
"POST" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& Request -> Request
contentTypeMixed Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& (\Request
r -> Request
r {HTTP.requestBody = HTTP.RequestBodyLBS bs})

getContentType :: Response -> Maybe MIME.Type
getContentType :: Response -> Maybe Type
getContentType = SubType -> Maybe Type
MIME.parseContentType (SubType -> Maybe Type)
-> (Response -> SubType) -> Response -> Maybe Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SubType
decodeLatin1 (ByteString -> SubType)
-> (Response -> ByteString) -> Response -> SubType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> Response -> ByteString
getHeader' (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
mk (ByteString -> HeaderName) -> ByteString -> HeaderName
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"Content-Type")

applicationText :: MIME.MIMEType
applicationText :: MIMEType
applicationText = SubType -> MIMEType
MIME.Application (SubType -> MIMEType) -> SubType -> MIMEType
forall a b. (a -> b) -> a -> b
$ String -> SubType
forall a b. ConvertibleStrings a b => a -> b
cs String
"text"

applicationOctetStream :: MIME.MIMEType
applicationOctetStream :: MIMEType
applicationOctetStream = SubType -> MIMEType
MIME.Application (SubType -> MIMEType) -> SubType -> MIMEType
forall a b. (a -> b) -> a -> b
$ String -> SubType
forall a b. ConvertibleStrings a b => a -> b
cs String
"octet-stream"

applicationOctetStream' :: MIME.Type
applicationOctetStream' :: Type
applicationOctetStream' = MIMEType -> [MIMEParam] -> Type
MIME.Type MIMEType
applicationOctetStream []

deleteAssetV3 :: (HasCallStack, MakesValue user, MakesValue key) => user -> key -> App Response
deleteAssetV3 :: forall user key.
(HasCallStack, MakesValue user, MakesValue key) =>
user -> key -> App Response
deleteAssetV3 user
user key
key = do
  String
k <- key
key key -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  Request
req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Cargohold (Int -> Versioned
ExplicitVersion Int
1) (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ String
"assets/v3/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
k
  String -> Request -> App Response
submit String
"DELETE" Request
req

deleteAsset :: (HasCallStack, MakesValue user, MakesValue key) => user -> key -> App Response
deleteAsset :: forall user key.
(HasCallStack, MakesValue user, MakesValue key) =>
user -> key -> App Response
deleteAsset user
user key
key = do
  String
k <- key
key key -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  String
d <- key
key key -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  Request
req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Cargohold Versioned
Versioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ String
"/assets/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
d String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
k
  String -> Request -> App Response
submit String
"DELETE" Request
req

header :: String -> String -> Request -> Request
header :: String -> String -> Request -> Request
header String
name String
value Request
req =
  Request
req {requestHeaders = (mk $ cs name, cs value) : requestHeaders req}

class IsAssetToken tok where
  tokenParam :: tok -> Request -> Request

instance IsAssetToken () where
  tokenParam :: () -> Request -> Request
tokenParam ()
_ = Request -> Request
forall a. a -> a
id

instance IsAssetToken String where
  tokenParam :: String -> Request -> Request
tokenParam = String -> String -> Request -> Request
header String
"Asset-Token"

instance (IsAssetToken a, IsAssetToken b) => IsAssetToken (Either a b) where
  tokenParam :: Either a b -> Request -> Request
tokenParam = (a -> Request -> Request)
-> (b -> Request -> Request) -> Either a b -> Request -> Request
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Request -> Request
forall tok. IsAssetToken tok => tok -> Request -> Request
tokenParam b -> Request -> Request
forall tok. IsAssetToken tok => tok -> Request -> Request
tokenParam

instance IsAssetToken Value where
  tokenParam :: Value -> Request -> Request
tokenParam Value
v =
    case Value
v of
      String SubType
s -> String -> String -> Request -> Request
header String
h (String -> Request -> Request) -> String -> Request -> Request
forall a b. (a -> b) -> a -> b
$ SubType -> String
forall a b. ConvertibleStrings a b => a -> b
cs SubType
s
      Object Object
o -> (Request -> Request)
-> (Value -> Request -> Request)
-> Maybe Value
-> Request
-> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request -> Request
forall a. a -> a
id Value -> Request -> Request
forall tok. IsAssetToken tok => tok -> Request -> Request
tokenParam (Maybe Value -> Request -> Request)
-> Maybe Value -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
Aeson.lookup (String -> Key
forall a. IsString a => String -> a
fromString String
"token") Object
o
      Value
_ -> String -> Request -> Request
forall a. HasCallStack => String -> a
error String
"Non-matching Asset-Token value"
    where
      h :: String
h = String
"Asset-Token"

instance IsAssetToken (Request -> Request) where
  tokenParam :: (Request -> Request) -> Request -> Request
tokenParam = (Request -> Request) -> Request -> Request
forall a. a -> a
id

downloadAssetWithQualifiedAssetKey ::
  (HasCallStack, IsAssetToken tok, MakesValue key, MakesValue user) =>
  (HTTP.Request -> HTTP.Request) ->
  user ->
  key ->
  tok ->
  App Response
downloadAssetWithQualifiedAssetKey :: forall tok key user.
(HasCallStack, IsAssetToken tok, MakesValue key,
 MakesValue user) =>
(Request -> Request) -> user -> key -> tok -> App Response
downloadAssetWithQualifiedAssetKey Request -> Request
r user
user key
key tok
tok = do
  String
dom <- key
key key -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  String
keyId <- key
key key -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  Request
req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Cargohold (Int -> Versioned
ExplicitVersion Int
2) (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ String
"assets/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
dom String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
keyId
  String -> Request -> App Response
submit String
"GET"
    (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req
    Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& tok -> Request -> Request
forall tok. IsAssetToken tok => tok -> Request -> Request
tokenParam tok
tok
    Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& Request -> Request
r

postToken :: (MakesValue user, HasCallStack) => user -> String -> App Response
postToken :: forall user.
(MakesValue user, HasCallStack) =>
user -> String -> App Response
postToken user
user String
key = do
  Request
req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Cargohold Versioned
Versioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ String
"assets/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
key String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/token"
  String -> Request -> App Response
submit String
"POST" Request
req

deleteToken :: (MakesValue user, HasCallStack) => user -> String -> App Response
deleteToken :: forall user.
(MakesValue user, HasCallStack) =>
user -> String -> App Response
deleteToken user
user String
key = do
  Request
req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Cargohold Versioned
Versioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ String
"assets/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
key String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/token"
  String -> Request -> App Response
submit String
"DELETE" Request
req

-- | Build a complete @multipart/mixed@ request body for a one-shot,
-- non-resumable asset upload.
buildMultipartBody :: (HasCallStack, MakesValue header) => header -> Lazy.ByteString -> MIME.MIMEType -> App Lazy.ByteString
buildMultipartBody :: forall header.
(HasCallStack, MakesValue header) =>
header -> ByteString -> MIMEType -> App ByteString
buildMultipartBody header
header' ByteString
body MIMEType
bodyMimeType = do
  Value
h <- header -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make header
header'
  let headerJson :: ByteString
headerJson = Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Value
h

      render :: Builder
      render :: Builder
render = Builder
renderBody Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
endMultipartBody

      endMultipartBody :: Builder
      endMultipartBody :: Builder
endMultipartBody = Builder
lineBreak Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
boundary Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
stringUtf8 String
"--" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
lineBreak

      renderBody :: Builder
      renderBody :: Builder
renderBody = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ MIMEValue -> Builder
renderPart (MIMEValue -> Builder) -> [MIMEValue] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MIMEValue]
multipartContent

      renderPart :: MIME.MIMEValue -> Builder
      renderPart :: MIMEValue -> Builder
renderPart MIMEValue
v =
        Builder
boundary
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
lineBreak
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Type -> Builder
contentType (Type -> Builder) -> (MIMEValue -> Type) -> MIMEValue -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MIMEValue -> Type
MIME.mime_val_type) MIMEValue
v
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
lineBreak
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ([MIMEParam] -> Builder
headers ([MIMEParam] -> Builder)
-> (MIMEValue -> [MIMEParam]) -> MIMEValue -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MIMEValue -> [MIMEParam]
MIME.mime_val_headers) MIMEValue
v
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
lineBreak
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
lineBreak
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (MIMEContent -> Builder
content (MIMEContent -> Builder)
-> (MIMEValue -> MIMEContent) -> MIMEValue -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MIMEValue -> MIMEContent
MIME.mime_val_content) MIMEValue
v
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
lineBreak

      boundary :: Builder
      boundary :: Builder
boundary = String -> Builder
stringUtf8 String
"--" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
stringUtf8 String
multipartBoundary

      lineBreak :: Builder
      lineBreak :: Builder
lineBreak = String -> Builder
stringUtf8 String
"\r\n"

      contentType :: MIME.Type -> Builder
      contentType :: Type -> Builder
contentType Type
t = String -> Builder
stringUtf8 String
"Content-Type: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (SubType -> Builder
encodeUtf8Builder (SubType -> Builder) -> (Type -> SubType) -> Type -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> SubType
MIME.showType) Type
t

      headers :: [MIME.MIMEParam] -> Builder
      headers :: [MIMEParam] -> Builder
headers [] = Builder
forall a. Monoid a => a
mempty
      headers (MIMEParam
x : [MIMEParam]
xs) = MIMEParam -> Builder
renderHeader MIMEParam
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [MIMEParam] -> Builder
headers [MIMEParam]
xs

      renderHeader :: MIME.MIMEParam -> Builder
      renderHeader :: MIMEParam -> Builder
renderHeader MIMEParam
p =
        SubType -> Builder
encodeUtf8Builder (MIMEParam -> SubType
MIME.paramName MIMEParam
p)
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
stringUtf8 String
": "
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SubType -> Builder
encodeUtf8Builder (MIMEParam -> SubType
MIME.paramValue MIMEParam
p)

      content :: MIME.MIMEContent -> Builder
      content :: MIMEContent -> Builder
content (MIME.Single SubType
c) = SubType -> Builder
encodeUtf8Builder SubType
c
      content (MIME.Multi [MIMEValue]
_) = String -> Builder
forall a. HasCallStack => String -> a
error String
"Not implemented."

      multipartContent :: [MIME.MIMEValue]
      multipartContent :: [MIMEValue]
multipartContent =
        [ MIMEType -> ByteString -> MIMEValue
part (SubType -> MIMEType
MIME.Application (String -> SubType
T.pack String
"json")) ByteString
headerJson,
          MIMEType -> ByteString -> MIMEValue
part MIMEType
bodyMimeType ByteString
body
        ]

      part :: MIME.MIMEType -> Lazy.ByteString -> MIME.MIMEValue
      part :: MIMEType -> ByteString -> MIMEValue
part MIMEType
mtype ByteString
c =
        MIMEValue
MIME.nullMIMEValue
          { MIME.mime_val_type = MIME.Type mtype [],
            MIME.mime_val_headers = [MIME.MIMEParam (T.pack "Content-Length") ((T.pack . show . LBS.length) c)],
            MIME.mime_val_content = MIME.Single ((decodeUtf8 . LBS.toStrict) c)
          }

  ByteString -> App ByteString
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> App ByteString) -> ByteString -> App ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString Builder
render

multipartBoundary :: String
multipartBoundary :: String
multipartBoundary = String
"frontier"

buildMultipartBody' :: Value -> MIME.Type -> LBS.ByteString -> Builder
buildMultipartBody' :: Value -> Type -> ByteString -> Builder
buildMultipartBody' Value
sets Type
typ ByteString
bs =
  Value -> Type -> Word -> Builder
beginMultipartBody Value
sets Type
typ (Int64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word) -> Int64 -> Word
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LBS.length ByteString
bs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteString ByteString
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
endMultipartBody'

-- | Begin building a @multipart/mixed@ request body for a non-resumable upload.
-- The returned 'Builder' can be immediately followed by the actual asset bytes.
beginMultipartBody :: Value -> MIME.Type -> Word -> Builder
beginMultipartBody :: Value -> Type -> Word -> Builder
beginMultipartBody Value
sets Type
t Word
l =
  ByteString -> Builder
byteString
    ( String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs
        String
"--frontier\r\n\
        \Content-Type: application/json\r\n\
        \Content-Length: "
    )
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Dec (ByteString -> Int64
LBS.length ByteString
settingsJson)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString
      ( String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs
          String
"\r\n\
          \\r\n"
      )
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteString ByteString
settingsJson
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString
      ( String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs
          String
"\r\n\
          \--frontier\r\n\
          \Content-Type: "
      )
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString (SubType -> ByteString
encodeUtf8 (Type -> SubType
MIME.showType Type
t))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString
      ( String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs
          String
"\r\n\
          \Content-Length: "
      )
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word -> Builder
wordDec Word
l
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString
      ( String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs
          String
"\r\n\
          \\r\n"
      )
  where
    settingsJson :: ByteString
settingsJson = Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Value
sets

-- | The trailer of a non-resumable @multipart/mixed@ request body initiated
-- via 'beginMultipartBody'.
endMultipartBody' :: Builder
endMultipartBody' :: Builder
endMultipartBody' = ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"\r\n--frontier--\r\n"