--
-- HTTP client for use with io-streams
--
-- Copyright © 2012-2021 Athae Eredh Siniath and Others
--
-- The code in this file, and the program it is a part of, is made
-- available to you by its authors as open source software: you can
-- redistribute it and/or modify it under a BSD licence.
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS -fno-warn-unused-imports #-}

module TestSuite where

import Blaze.ByteString.Builder (Builder)
import qualified Blaze.ByteString.Builder as Builder (
    fromByteString,
    toByteString,
 )
import qualified Blaze.ByteString.Builder.Char8 as Builder (
    fromChar,
    fromString,
 )
import Control.Applicative
import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar)
import Control.Exception (Exception, bracket, handleJust)
import Control.Monad (forM_, guard)
import Data.Aeson (
    FromJSON,
    ToJSON,
    Value (..),
    encode,
    object,
    parseJSON,
    toJSON,
    (.:),
    (.=),
 )
import Data.Aeson.Encode.Pretty
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KeyMap
#else
import qualified Data.HashMap.Strict as KeyMap
#endif
import Data.Bits
import Data.Maybe (fromJust)
import Data.Monoid
import Data.String
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import GHC.Generics hiding (Selector)
import Network.Socket (SockAddr (..))
import Network.URI (URI (..), URIAuth (..), parseURI)
import System.Timeout (timeout)
import Test.HUnit
import Test.Hspec (Spec, describe, it)
import Test.Hspec.Expectations (Selector, anyException, shouldThrow)

import Debug.Trace

--
-- Otherwise redundent imports, but useful for testing in GHCi.
--

import Data.Attoparsec.ByteString.Char8 (Parser, parseOnly, parseTest)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy as L
import Debug.Trace
import System.IO.Streams (InputStream, OutputStream)
import qualified System.IO.Streams as Streams
import qualified System.IO.Streams.Debug as Streams

--
-- what we're actually testing
--

import MockServer (localPort)
import Network.Http.Client
import Network.Http.Connection (Connection (..))
import Network.Http.Inconvenience (
    HttpClientError (..),
    TooManyRedirects (..),
    parseURL,
    splitURI,
 )
import Network.Http.Internal (
    Request (..),
    Response (..),
    composeRequestBytes,
    lookupHeader,
 )
import Network.Http.ResponseParser (readDecimal, readResponseHeader)

localhost = S.pack ("localhost:" ++ show localPort)

suite :: Spec
suite = do
    describe "Opening a connection" $ do
        testConnectionHost

    describe "Request, when serialized" $ do
        testRequestLineFormat
        testRequestTermination
        testEnsureHostField
        testAcceptHeaderFormat
        testBasicAuthorizatonHeader

    describe "Parsing responses" $ do
        testResponseParser1
        testResponseParserMismatch
        testPaddedContentLength
        --      testTrailingWhitespace
        testChunkedEncoding
        testContentLength
        testDevoidOfContent
        testCompressedResponse
        testRepeatedResponseHeaders

    describe "Expectation handling" $ do
        testExpectationContinue

    describe "Convenience API" $ do
        testPutChunks
        testPostChunks
        testPostWithForm
        testGetRedirects
        testSplitURI
        testParseURL
        testParseURLHasEscaped
        testGetLocalRedirects
        testGetFormatsRequest
        testExcessiveRedirects
        testGeneralHandler
        testEstablishConnection
        testParsingJson1
        testParsingJson2
        testPutWithSimple
        testPutWithJson
        testMultipartUpload

    describe "Corner cases in protocol compliance" $ do
        testSendBodyFor PUT
        testSendBodyFor DELETE
        testSendBodyFor PATCH

testRequestTermination =
    it "terminates with a blank line" $ do
        c <- openConnection "localhost" localPort
        let q = buildRequest1 $ do
                http GET "/time"
                setAccept "text/plain"

        let e' = Builder.toByteString $ composeRequestBytes q "booga"
        let n = S.length e' - 4
        let (a', b') = S.splitAt n e'

        assertEqual "Termination not CRLF CRLF" "\r\n\r\n" b'
        assertBool
            "Must be only one blank line at end of headers"
            ('\n' /= S.last a')

        closeConnection c

testRequestLineFormat = do
    it "has a properly formatted request line" $
        bracket
            (fakeConnection)
            (return)
            ( \c -> do
                let q = buildRequest1 $ do
                        http GET "/time"

                let e' = Builder.toByteString $ composeRequestBytes q (cHost c)
                let l' = S.takeWhile (/= '\r') e'

                assertEqual "Invalid HTTP request line" "GET /time HTTP/1.1" l'
            )

    it "handles empty request path" $
        bracket
            (fakeConnection)
            (return)
            ( \c -> do
                let q = buildRequest1 $ do
                        http GET ""

                let e' = Builder.toByteString $ composeRequestBytes q (cHost c)
                let l' = S.takeWhile (/= '\r') e'

                assertEqual "Invalid HTTP request line" "GET / HTTP/1.1" l'
            )

fakeConnection :: IO Connection
fakeConnection = do
    i <- Streams.nullInput
    o <- Streams.nullOutput
    c <- makeConnection "www.example.com" (return ()) o i
    return c

testAcceptHeaderFormat =
    it "properly formats Accept header" $ do
        let q = buildRequest1 $ do
                setAccept' [("text/html", 1), ("*/*", 0.0)]

        let h = qHeaders q
        let (Just a) = lookupHeader h "Accept"
        assertEqual "Failed to format header" "text/html; q=1.0, */*; q=0.0" a

testBasicAuthorizatonHeader =
    it "properly formats Authorization header" $ do
        let q = buildRequest1 $ do
                setAuthorizationBasic "Aladdin" "open sesame"

        let h = qHeaders q
        let (Just a) = lookupHeader h "Authorization"
        assertEqual "Failed to format header" "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==" a

testConnectionHost = do
    it "properly caches hostname and port" $ do
        bracket
            (openConnection "localhost" localPort)
            closeConnection
            ( \c -> do
                let h' = cHost c
                assertEqual
                    "Host value needs to be name, not IP address"
                    expected
                    h'
            )
  where
    expected = S.pack $ "localhost:" ++ show localPort

{-
    Incidentally, Host is *not* stored in the Headers map, but is a field
    of the Request object.
-}
testEnsureHostField =
    it "has a properly formatted Host header" $ do
        let q1 = buildRequest1 $ do
                http GET "/hello.txt"

        let h1 = qHost q1
        assertEqual "Incorrect Host header" Nothing h1

        let q2 = buildRequest1 $ do
                http GET "/hello.txt"
                setHostname "other.example.com" 80

        let h2 = qHost q2
        assertEqual "Incorrect Host header" (Just "other.example.com") h2

        let q3 = buildRequest1 $ do
                http GET "/hello.txt"
                setHostname "other.example.com" 54321

        let h3 = qHost q3
        assertEqual "Incorrect Host header" (Just "other.example.com:54321") h3

testResponseParser1 =
    it "parses a simple 200 response" $ do
        p <- Streams.withFileAsInput "tests/example1.txt" (\i -> readResponseHeader i)

        assertEqual "Incorrect parse of response" 200 (getStatusCode p)
        return ()

testResponseParserMismatch =
    it "parses response when HTTP version doesn't match" $ do
        p <- Streams.withFileAsInput "tests/example3.txt" (\i -> readResponseHeader i)

        assertEqual "Incorrect parse of response" 200 (getStatusCode p)
        return ()

testPaddedContentLength =
    it "handles padded Content-Length" $ do
        p <- Streams.withFileAsInput "tests/example4.txt" (\i -> readResponseHeader i)

        let (Just len) = pContentLength p
        assertEqual "Should have trimmed in decimal conversion" 86 len

{-
    Presently inactive
-}
testTrailingWhitespace =
    it "where headers have trailing whitespace" $ do
        p <- Streams.withFileAsInput "tests/example4.txt" (\i -> readResponseHeader i)

        let (Just value) = getHeader p "Content-Length"
        assertEqual "Should have trimmed field value" "86" value

testChunkedEncoding =
    it "recognizes chunked transfer encoding and decodes" $ do
        c <- openConnection "localhost" localPort

        let q = buildRequest1 $ do
                http GET "/time"

        sendRequest c q emptyBody
        receiveResponse
            c
            ( \p i1 -> do
                let cm = getHeader p "Transfer-Encoding"
                assertEqual "Should be chunked encoding!" (Just "chunked") cm

                (i2, getCount) <- Streams.countInput i1
                Streams.skipToEof i2

                len <- getCount
                assertEqual "Incorrect number of bytes read" 29 len
            )

testContentLength = do
    it "recognzies fixed length message" $ do
        c <- openConnection "localhost" localPort

        let q = buildRequest1 $ do
                http GET "/static/statler.jpg"

        sendRequest c q emptyBody

        receiveResponse
            c
            ( \p i1 -> do
                let nm = getHeader p "Content-Length"
                assertMaybe "Should be a Content-Length header!" nm

                let n = read $ S.unpack $ fromJust nm :: Int
                assertEqual "Should be a fixed length message!" 4611 n

                (i2, getCount) <- Streams.countInput i1
                x' <- Streams.readExactly 4611 i2

                len <- getCount
                assertEqual "Incorrect number of bytes read" 4611 len
                assertBool "Incorrect length" (4611 == S.length x')

                end <- Streams.atEOF i2
                assertBool "Expected end of stream" end
            )

    it "doesn't choke if server neglects Content-Length" $ do
        p <- Streams.withFileAsInput "tests/example3.txt" (\i -> readResponseHeader i)

        assertEqual "Incorrect parse of response" 200 (getStatusCode p)
        assertEqual "Incorrect parse of response" Nothing (getHeader p "Content-Length")
        assertEqual "Should not have pContentLength" Nothing (pContentLength p)
        return ()

    it "reads body without Content-Length or Transfer-Encoding" $ do
        c <- fakeConnectionHttp10
        let q = buildRequest1 $ do
                http GET "/fake"
        sendRequest c q emptyBody
        receiveResponse
            c
            ( \_ i1 -> do
                (i2, getCount) <- Streams.countInput i1
                o <- Streams.nullOutput
                Streams.connect i2 o

                end <- Streams.atEOF i2
                assertBool "Expected end of stream" end

                len <- getCount
                assertEqual "Incorrect number of bytes read" 4611 len
            )

        return ()

fakeConnectionHttp10 :: IO Connection
fakeConnectionHttp10 = do
    x' <- S.readFile "tests/example3.txt"
    i <- Streams.fromByteString x'

    o <- Streams.nullOutput
    c <- makeConnection "bad.example.com" (return ()) o i
    return c

{-
    Corner case where servers responding 204 No Content are not required to
    transmit a Content-Length header; Snap *does* send one, so we can't test it
    in the MockServer, so fake it with example5.txt
-}

testDevoidOfContent = do
    it "handles 204 No Content response without Content-Length" $
        timeout_ 2 $ do
            (c, mv) <- fakeConnectionNoContent
            let q = buildRequest1 $ do
                    http GET "/fake"
            sendRequest c q emptyBody
            receiveResponse
                c
                ( \_ i1 -> do
                    (i2, getCount) <- Streams.countInput i1
                    o <- Streams.nullOutput
                    Streams.connect i2 o

                    end <- Streams.atEOF i2
                    assertBool "Expected end of stream" end

                    len <- getCount
                    assertEqual "Incorrect number of bytes read" 0 len
                )
            putMVar mv ()
            return ()
  where
    secs :: Int
    secs = 10 ^ (6 :: Int)

    timeout_ :: Int -> IO a -> IO a
    timeout_ t m = timeout (t * secs) m >>= maybe (error "timeout") return

fakeConnectionNoContent :: IO (Connection, MVar ())
fakeConnectionNoContent = do
    x' <- S.readFile "tests/example5.txt"
    i1 <- Streams.fromByteString x'
    mv <- newEmptyMVar
    i2 <- Streams.makeInputStream $ blockOn mv
    i3 <- Streams.concatInputStreams [i1, i2]

    o <- Streams.nullOutput
    c <- makeConnection "worse.example.com" (return ()) o i3
    return (c, mv)
  where
    blockOn :: MVar () -> IO (Maybe ByteString)
    blockOn mv = takeMVar mv >> return Nothing

{-
    This had to change when we moved to an internal test server; seems
    Snap is doing something funny when gzipping and switching to chunked
    encoding no matter what I do.
-}
testCompressedResponse =
    it "recognizes gzip content encoding and decompresses" $ do
        c <- openConnection "localhost" localPort

        let q = buildRequest1 $ do
                http GET "/static/hello.html"
                setHeader "Accept-Encoding" "gzip"

        sendRequest c q emptyBody

        receiveResponse
            c
            ( \p i -> do
                let nm = getHeader p "Content-Encoding"
                assertMaybe "Should be a Content-Encoding header!" nm
                assertEqual "Content-Encoding header should be 'gzip'!" (Just "gzip") nm

                (i2, getCount) <- Streams.countInput i
                x' <- Streams.readExactly 102 i2

                len <- getCount
                assertEqual "Incorrect number of bytes read" 102 len
                assertBool "Incorrect length" (102 == S.length x')

                end <- Streams.atEOF i
                assertBool "Expected end of stream" end
            )

{-
    This isn't much of a test yet; we really need to test
    a) that 100 Continue was received b) that it was absorbed
    c) that body is correct size, and then d) 4xx and 5xx
    responses are propegated through.
-}

testExpectationContinue =
    it "sends expectation and handles 100 response" $ do
        c <- openConnection "localhost" localPort

        let q = buildRequest1 $ do
                http PUT "/resource/x149"
                setExpectContinue

        sendRequest
            c
            q
            ( \o -> do
                Streams.write (Just (Builder.fromString "Hello world\n")) o
            )

        receiveResponse
            c
            ( \p i -> do
                assertEqual "Incorrect status code" 201 (getStatusCode p)
                x' <- Streams.readExactly 12 i

                end <- Streams.atEOF i
                assertBool "Expected end of stream" end

                assertEqual "Incorrect body" "Hello world\n" x'
            )

        closeConnection c

assertMaybe :: String -> Maybe a -> Assertion
assertMaybe prefix m0 =
    case m0 of
        Nothing -> assertFailure prefix
        Just _ -> assertBool "" True

testPutChunks =
    it "PUT correctly chunks known size entity body" $ do
        let url = S.concat ["http://", localhost, "/size"]

        put url "text/plain" body handler
  where
    body :: OutputStream Builder -> IO ()
    body o = do
        let x = mconcat $ replicate 33000 (Builder.fromChar 'x')
        Streams.write (Just x) o

    handler :: Response -> InputStream ByteString -> IO ()
    handler _ i = do
        (Just b') <- Streams.read i

        end <- Streams.atEOF i
        assertBool "Expected end of stream" end

        let size = readDecimal b' :: Int
        assertEqual "Should have replied with correct file size" 33000 size

testSendBodyFor meth =
    it ("Sends a request body for " ++ show meth) $ do
        c <- openConnection "localhost" localPort

        let q = buildRequest1 $ do
                http meth "/size"
                setContentType "text/plain"
                setTransferEncoding

        sendRequest
            c
            q
            ( \o -> do
                Streams.write (Just (Builder.fromString "a request")) o
            )

        receiveResponse
            c
            ( \p i -> do
                assertEqual "Incorrect status code" 200 (getStatusCode p)
                (Just b') <- Streams.read i

                let size = readDecimal b' :: Int
                assertEqual "Should have received a request body" 9 size
            )

        closeConnection c

testPostChunks =
    it "POST correctly chunks a fileBody" $ do
        let url = S.concat ["http://", localhost, "/size"]

        post url "image/jpeg" (fileBody "tests/statler.jpg") handler
  where
    handler :: Response -> InputStream ByteString -> IO ()
    handler p i = do
        let code = getStatusCode p
        assertEqual "Expected 200 OK" 200 code

        (Just b') <- Streams.read i

        end <- Streams.atEOF i
        assertBool "Expected end of stream" end

        let size = readDecimal b' :: Int
        assertEqual "Should have replied with correct file size" 4611 size

testPostWithForm =
    it "POST with form data correctly encodes parameters" $ do
        let url = S.concat ["http://", localhost, "/postbox"]

        postForm
            url
            [ ("name", "Kermit")
            , ("role", "St&gehand")
            , ("country", Text.encodeUtf8 $ Text.pack "Nørway")
            ]
            handler
  where
    handler :: Response -> InputStream ByteString -> IO ()
    handler p i = do
        let code = getStatusCode p
        assertEqual "Expected 201" 201 code

        b' <- Streams.readExactly 48 i

        end <- Streams.atEOF i
        assertBool "Expected end of stream" end

        assertEqual
            "Incorrect URL encoding"
            "name=Kermit&role=St%26gehand&country=N%c3%b8rway"
            b'

testGetRedirects =
    it "GET internal handler follows redirect on 307" $ do
        let url = S.concat ["http://", localhost, "/bounce"]

        get url handler
  where
    handler :: Response -> InputStream ByteString -> IO ()
    handler p i1 = do
        let code = getStatusCode p
        assertEqual "Should have been final code" 200 code

        (i2, getCount) <- Streams.countInput i1
        Streams.skipToEof i2

        len <- getCount
        assertEqual "Incorrect number of bytes read" 29 len

testGetLocalRedirects =
    it "GET internal handler follows local redirect on 307" $ do
        let url = S.concat ["http://", localhost, "/local"]

        get url handler
  where
    handler :: Response -> InputStream ByteString -> IO ()
    handler p i1 = do
        let code = getStatusCode p
        assertEqual "Should have been final code" 200 code

        (i2, getCount) <- Streams.countInput i1
        Streams.skipToEof i2

        len <- getCount
        assertEqual "Incorrect number of bytes read" 29 len

testSplitURI =
    it "check splitURI for local redirects" $ do
        let a1 = "http://asdf@ya.ru:8000/hello/?asd=asd&abc=2"
            r1 = S.pack "/hello/?asd=asd&abc=2"
        assertEqual "Incorrect split uri 1" (S.pack a1) (splitURI (fromJust $ parseURI a1) r1)

        let a2 = "http://asdf@ya.ru:8000/again/?asd=asd&abc=2"
            r2 = S.pack "/again/?asd=asd&abc=2"
        assertEqual "Incorrect split uri 2" (S.pack a2) (splitURI (fromJust $ parseURI a2) r2)

        let a3 = "http://ya.ru:8000/here/?asd=asd&abc=2"
            r3 = S.pack "/here/?asd=asd&abc=2"
        assertEqual "Incorrect split uri 3" (S.pack a3) (splitURI (fromJust $ parseURI a3) r3)

        let a4 = "http://ya.ru/?asd=asd&abc=2#papa"
            r4 = S.pack "/?asd=asd&abc=2#papa"
        assertEqual "Incorrect split uri 4" (S.pack a4) (splitURI (fromJust $ parseURI a4) r4)

        let a5 = "http://ya.ru/?asd=asd&abc=2#papa"
            r5 = S.pack "http://google.ru/"
        assertEqual "Incorrect split uri 5" r5 (splitURI (fromJust $ parseURI a5) r5)

testParseURL =
    it "Parse URL with chars needing encoding" $ do
        let url = parseURL (Text.encodeUtf8 $ Text.pack "http://example.com/α")
        assertEqual
            "Incorrect URL parsing"
            (URI "http:" (Just $ URIAuth "" "example.com" "") "/%CE%B1" "" "")
            url

testParseURLHasEscaped =
    it "Parse URL with chars already encoded" $ do
        let url = parseURL (Text.encodeUtf8 $ Text.pack "http://example.com/hello%20world")
        assertEqual
            "Incorrect URL parsing"
            (URI "http:" (Just $ URIAuth "" "example.com" "") "/hello%20world" "" "")
            url

testGetFormatsRequest =
    it "GET includes a properly formatted request path" $ do
        let url = S.concat ["http://", localhost]
        x' <- get url concatHandler'

        assertBool "Incorrect context path" (S.length x' > 0)

testExcessiveRedirects =
    it "too many redirects result in an exception" $ do
        let url = S.concat ["http://", localhost, "/loop"]

        get url handler `shouldThrow` tooManyRedirects
  where
    handler :: Response -> InputStream ByteString -> IO ()
    handler _ _ = do
        assertBool "Should have thrown exception before getting here" False

testRepeatedResponseHeaders =
    it "repeated response headers are properly concatonated" $ do
        let url = S.concat ["http://", localhost, "/cookies"]

        get url handler
  where
    handler :: Response -> InputStream ByteString -> IO ()
    handler r _ = do
        assertEqual "Invalid response headers" (Just "stone=diamond,metal=tungsten") (getHeader r "Set-Cookie")

{-
    From http://stackoverflow.com/questions/6147435/is-there-an-assertexception-in-any-of-the-haskell-test-frameworks
    because "although HUnit doesn't have this, it's easy to write your
    own". Uh huh. Surely there's an easier way to do this.
-}

assertException :: (Exception e, Eq e) => e -> IO a -> IO ()
assertException ex action =
    handleJust isWanted (const $ return ()) $ do
        _ <- action
        assertFailure $ "Expected exception: " ++ show ex
  where
    isWanted = guard . (== ex)

testGeneralHandler =
    it "GET with general purpose handler throws exception on 404" $ do
        let url = S.concat ["http://", localhost, "/booga"]

        get url concatHandler' `shouldThrow` httpClientError 404

tooManyRedirects :: Selector TooManyRedirects
tooManyRedirects = const True

--              :: Int -> Selector HttpClientError
httpClientError :: Int -> HttpClientError -> Bool
httpClientError expected (HttpClientError actual _) = expected == actual

testEstablishConnection =
    it "public establish function behaves correctly" $ do
        let url = S.concat ["http://", localhost, "/static/statler.jpg"]

        x' <-
            withConnection (establishConnection url) $
                ( \c -> do
                    let q = buildRequest1 $ do
                            http GET "/static/statler.jpg"
                    -- TODO be nice if we could replace that with 'url';
                    -- fix the routeRequests function in TestServer maybe?
                    sendRequest c q emptyBody
                    receiveResponse c concatHandler'
                )

        let len = S.length x'
        assertEqual "Incorrect number of bytes read" 4611 len

testParsingJson1 =
    it "GET with JSON handler behaves" $ do
        let url = S.concat ["http://", localhost, "/static/data-eu-gdp.json"]

        x <- get url jsonHandler
        let (Object o) = x
        let (Just v) = KeyMap.lookup "label" o
        let (String t) = v

        assertEqual "Incorrect response" "Europe (EU27)" t

testParsingJson2 =
    it "GET with JSON handler parses using Aeson" $ do
        let url = S.concat ["http://", localhost, "/static/data-jp-gdp.json"]

        x <- get url jsonHandler :: IO GrossDomesticProduct

        assertEqual "Incorrect response" "Japan" (gLabel x)
        assertEqual "Data not parsed as expected" 2008 (fst $ last $ gData x)

--      L.putStr $ encodePretty x

{-
    Go to the trouble to create a Haskell data type representing the JSON feed
    we're getting from the sample data files. The Generic trick doesn't work
    because data is a reserved word, of course.
-}

data GrossDomesticProduct = GrossDomesticProduct
    { gLabel :: Text
    , gData :: [(Int, Double)]
    }
    deriving (Show, Generic)

instance FromJSON GrossDomesticProduct where
    parseJSON (Object o) =
        GrossDomesticProduct
            <$> o .: "label"
            <*> o .: "data"
    parseJSON _ = undefined

instance ToJSON GrossDomesticProduct where
    toJSON (GrossDomesticProduct l d) =
        object
            [ "label" .= l
            , "data" .= d
            ]

testPutWithSimple =
    it "PUT with static data" $ do
        let url = S.concat ["http://", localhost, "/resource/y98"]

        x' <- put url "text/plain" (simpleBody b') simpleHandler

        assertEqual
            "Object was encoded to JSON as expected"
            "Hello"
            x'
  where
    b' :: ByteString
    b' = S.pack "Hello"

testPutWithJson =
    it "PUT with json data" $ do
        let url = S.concat ["http://", localhost, "/resource/y99"]

        x' <- put url "application/json" (jsonBody obj) simpleHandler

        assertEqual
            "Object was encoded to JSON as expected"
            "{\"data\":[[2000,1],[2020,0]],\"label\":\"Sealand\"}"
            x'
  where
    obj :: GrossDomesticProduct
    obj =
        GrossDomesticProduct
            { gLabel = "Sealand"
            , gData = [(2000, 1), (2020, 0)]
            }

    obj' :: ByteString
    obj' = L.toStrict (encode obj)

testMultipartUpload =
    it "PUT with json data" $ do
        let url = S.concat ["http://", localhost, "/postbox"]

        let boundary = packBoundary "bEacHV0113YB@ll"

        let q = buildRequest1 $ do
                http POST "/postbox"
                setContentMultipart boundary

        let parts =
                [ simplePart "first" Nothing "Old guys in the box."
                , filePart "second" (Just "text/plain") "tests/hello.txt"
                ]

        c <- openConnection "localhost" localPort

        sendRequest c q (multipartFormBody boundary parts)

        result <- receiveResponse c simpleHandler

        closeConnection c

        expected <- S.readFile "tests/multipart.bin"
        assertEqual
            "Multipart form data was not encoded as expected"
            expected
            result