{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

-- 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.V3 where

import API.Cargohold
import Codec.MIME.Type (showMIMEType)
import Crypto.Random
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString as BS
import Data.ByteString.Builder
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy as LBS
import Data.CaseInsensitive
import Data.String.Conversions
import Data.Text
import Data.Text.Encoding
import Data.Time.Clock (UTCTime)
import Data.Time.Format
import Data.Time.Format.ISO8601
import Network.HTTP.Client
import SetupHelpers
import Test.Cargohold.API.Util
import Testlib.Prelude
import Text.Read (readMaybe)

--------------------------------------------------------------------------------
-- Simple (single-step) uploads

testSimpleRoundtrip :: (HasCallStack) => App ()
testSimpleRoundtrip :: HasCallStack => App ()
testSimpleRoundtrip = do
  let defSettings :: [Pair]
defSettings = [String
"public" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False]
      rets :: [String]
rets = [String
"eternal", String
"persistent", String
"volatile", String
"eternal-infrequent_access", String
"expiring"]
      allSets :: [Value]
allSets = ([Pair] -> Value) -> [[Pair]] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Pair] -> Value
object ([[Pair]] -> [Value]) -> [[Pair]] -> [Value]
forall a b. (a -> b) -> a -> b
$ ([Pair]
defSettings :) ([[Pair]] -> [[Pair]]) -> [[Pair]] -> [[Pair]]
forall a b. (a -> b) -> a -> b
$ (\String
r -> [String
"retention" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
r]) (String -> [Pair]) -> [String] -> [[Pair]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
rets
  (Value -> App ()) -> [Value] -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HasCallStack => Value -> App ()
Value -> App ()
simpleRoundtrip [Value]
allSets
  where
    simpleRoundtrip :: (HasCallStack) => Value -> App ()
    simpleRoundtrip :: HasCallStack => Value -> App ()
simpleRoundtrip Value
sets = do
      Value
uid <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
      Value
uid2 <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
      -- Initial upload
      let bdy :: (MIMEType, ByteString)
bdy = (MIMEType
applicationText, String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"Hello World")
      Response
r1 <- Value -> Value -> (MIMEType, ByteString) -> App Response
forall user settings.
(HasCallStack, MakesValue user, MakesValue settings) =>
user -> settings -> (MIMEType, ByteString) -> App Response
uploadSimple Value
uid Value
sets (MIMEType, ByteString)
bdy
      Response
r1.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
      -- use v3 path instead of the one returned in the header
      (Value
key, String
tok, Maybe String
expires) <-
        (,,)
          (Value -> String -> Maybe String -> (Value, String, Maybe String))
-> App Value
-> App (String -> Maybe String -> (Value, String, Maybe String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response
r1.json
          App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key"
          App (String -> Maybe String -> (Value, String, Maybe String))
-> App String
-> App (Maybe String -> (Value, String, Maybe String))
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Response
r1.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString)
          App (Maybe String -> (Value, String, Maybe String))
-> App (Maybe String) -> App (Value, String, Maybe String)
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
r1.json String
"expires" App (Maybe Value)
-> (Maybe Value -> App (Maybe String)) -> App (Maybe String)
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= App (Maybe String)
-> (Value -> App (Maybe String))
-> Maybe Value
-> App (Maybe String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe String -> App (Maybe String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing) ((String -> Maybe String) -> App String -> App (Maybe String)
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (App String -> App (Maybe String))
-> (Value -> App String) -> Value -> App (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString))
      -- Check mandatory Date header
      let Just String
date = ByteString -> String
C8.unpack (ByteString -> String) -> Maybe ByteString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"Date") Response
r1.headers
          parseTime :: String -> UTCTime
parseTime = Bool -> TimeLocale -> String -> String -> UTCTime
forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> t
parseTimeOrError Bool
False TimeLocale
defaultTimeLocale String
rfc822DateFormat
          parseTimeIso :: String -> UTCTime
parseTimeIso String
t = UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe (String -> UTCTime
forall a. HasCallStack => String -> a
error (String -> UTCTime) -> String -> UTCTime
forall a b. (a -> b) -> a -> b
$ String
"Could not parse \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\" as ISO8601") (Maybe UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Format UTCTime -> String -> Maybe UTCTime
forall (m :: * -> *) t. MonadFail m => Format t -> String -> m t
formatParseM (forall t. ISO8601 t => Format t
iso8601Format @UTCTime) String
t
          utc :: UTCTime
utc = String -> UTCTime
parseTime String
date :: UTCTime
          expires' :: Maybe UTCTime
expires' = String -> UTCTime
parseTimeIso (String -> UTCTime) -> Maybe String -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
expires :: Maybe UTCTime
      -- Potentially check for the expires header
      case Value
sets of
        -- We don't care what the rentention value is here,
        -- we're just checking to see if other checks need
        -- to be done.
        Object Object
o -> case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (String -> Key
forall a. IsString a => String -> a
fromString String
"retention") Object
o of
          Maybe Value
Nothing -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just Value
r -> do
            String
r' <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Value
r
            -- These retention policies never expire, so an expiration date isn't sent back
            Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
r' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"eternal" Bool -> Bool -> Bool
|| String
r' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"persistent" Bool -> Bool -> Bool
|| String
r' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"eternal-infrequent_access")
              (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"invalid expiration" (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
utc Maybe UTCTime -> Maybe UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< Maybe UTCTime
expires')
        Value
_ -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      -- Lookup with token and download via redirect.
      Response
r2 <- Value -> Maybe Value -> String -> App Response
forall user loc tok.
(HasCallStack, MakesValue user, IsAssetLocation loc,
 IsAssetToken tok) =>
user -> loc -> tok -> App Response
downloadAsset' Value
uid Response
r1.jsonBody String
tok
      Response
r2.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
302
      HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"Response body should be empty" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Response
r2.body ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty

      let locReq :: String
locReq = ByteString -> String
C8.unpack (CI ByteString -> Response -> ByteString
getHeader' (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"Location") Response
r2)
      Request
req <- IO Request -> App Request
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> App Request) -> IO Request -> App Request
forall a b. (a -> b) -> a -> b
$ String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
locReq
      Response
r3 <- String -> Request -> App Response
submit String
"GET" Request
req
      Response
r3.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"content-type should always be application/octet-stream"
        (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ CI ByteString -> Response -> Maybe ByteString
getHeader (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"content-type") Response
r3
        Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ MIMEType -> Text
showMIMEType MIMEType
applicationOctetStream)
      HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"Token mismatch" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ CI ByteString -> Response -> Maybe ByteString
getHeader (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"x-amz-meta-token") Response
r3 Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
tok)
      String
uid' <- Value
uid Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
      HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"User mismatch" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ CI ByteString -> Response -> Maybe ByteString
getHeader (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"x-amz-meta-user") Response
r3 Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
uid')
      HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"Data mismatch" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Response
r3.body ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"Hello World"
      -- Delete (forbidden for other users)
      Value -> Maybe Value -> App Response
forall user key.
(HasCallStack, MakesValue user, MakesValue key) =>
user -> key -> App Response
deleteAssetV3 Value
uid2 Response
r1.jsonBody App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Response
r -> Response
r.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
      -- Delete (allowed for creator)
      Value -> Maybe Value -> App Response
forall user key.
(HasCallStack, MakesValue user, MakesValue key) =>
user -> key -> App Response
deleteAssetV3 Value
uid Response
r1.jsonBody App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Response
r -> Response
r.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
r4 <- Value -> Value -> String -> App Response
forall user loc tok.
(HasCallStack, MakesValue user, IsAssetLocation loc,
 IsAssetToken tok) =>
user -> loc -> tok -> App Response
downloadAsset' Value
uid Value
key String
tok
      Response
r4.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404
      let Just String
date' = ByteString -> String
C8.unpack (ByteString -> String) -> Maybe ByteString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"Date") Response
r4.headers
      let utc' :: UTCTime
utc' = Bool -> TimeLocale -> String -> String -> UTCTime
forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> t
parseTimeOrError Bool
False TimeLocale
defaultTimeLocale String
rfc822DateFormat String
date' :: UTCTime
      HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"bad date" (UTCTime
utc' UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= UTCTime
utc)

-- | Simulates an interrupted upload, where the user sends less data than expected.
testUploadWrongContentLength :: (HasCallStack) => App ()
testUploadWrongContentLength :: HasCallStack => App ()
testUploadWrongContentLength = do
  Value
uid <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  let payloadBytes :: Int
payloadBytes = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024
  ByteString
payload <- ByteString -> ByteString
BS.fromStrict (ByteString -> ByteString) -> App ByteString -> App ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO ByteString -> App ByteString
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> App ByteString)
-> (Int -> IO ByteString) -> Int -> App ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO ByteString
forall byteArray. ByteArray byteArray => Int -> IO byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes) Int
payloadBytes
  let -- A too small offset (<= 16) to the correct payloadBytes may lead to
      -- having the delimiter `--frontier--` being interpreted as content. So,
      -- we add a big offset here.
      tooBigContentLength :: Int
tooBigContentLength = Int
payloadBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1024
  Value -> ByteString -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> ByteString -> App Response
uploadRaw Value
uid (Int -> ByteString -> ByteString
body Int
tooBigContentLength ByteString
payload) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
    Response
resp.jsonBody Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"incomplete-body"

  -- Sanity check
  Value
key <-
    Value -> ByteString -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> ByteString -> App Response
uploadRaw Value
uid (Int -> ByteString -> ByteString
body Int
payloadBytes ByteString
payload) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key"

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value
-> Value -> Value -> String -> (Request -> Request) -> App Response
forall user key assetDomain.
(HasCallStack, MakesValue user, MakesValue key,
 MakesValue assetDomain) =>
user
-> assetDomain
-> key
-> String
-> (Request -> Request)
-> App Response
downloadAsset Value
uid Value
uid Value
key String
"nginz-https.example.com" Request -> Request
forall a. a -> a
id) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    let contentLength :: Maybe Int
contentLength = (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int)
-> (ByteString -> String) -> ByteString -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8) (ByteString -> Maybe Int)
-> ((CI ByteString, ByteString) -> ByteString)
-> (CI ByteString, ByteString)
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CI ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((CI ByteString, ByteString) -> Maybe Int)
-> Maybe (CI ByteString, ByteString) -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Response -> Maybe (CI ByteString, ByteString)
contentLengthHeader Response
resp
    HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"Content-Length matches" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Maybe Int
contentLength Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
payloadBytes)
    HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"Body" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Response
resp.body ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== (ByteString -> ByteString
LBS.toStrict ByteString
payload)
  where
    body :: Int -> LBS.ByteString -> LBS.ByteString
    body :: Int -> ByteString -> ByteString
body Int
contentLength ByteString
payload =
      let settings :: Value
settings = [Pair] -> Value
object [String
"public" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False, String
"retention" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"volatile"]
       in Builder -> ByteString
toLazyByteString
            (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> Type -> Word -> Builder
beginMultipartBody Value
settings Type
applicationOctetStream' (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
contentLength)
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteString ByteString
payload
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
endMultipartBody'