{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Snap.Util.FileUploads.Tests
  ( tests ) where

------------------------------------------------------------------------------
import           Control.Applicative            (Alternative ((<|>)))
import           Control.DeepSeq                (deepseq)
import           Control.Exception              (ErrorCall (..), evaluate, throwIO)
import           Control.Exception.Lifted       (Exception (fromException, toException), catch, finally, throw)
import           Control.Monad                  (Monad (return, (>>), (>>=)), liftM, void)
import           Control.Monad.IO.Class         (MonadIO (liftIO))
import           Data.ByteString                (ByteString)
import qualified Data.ByteString.Char8          as S
import           Data.IORef                     (atomicModifyIORef, newIORef, readIORef, writeIORef)
import           Data.List                      (foldl')
import qualified Data.Map                       as Map
import           Data.Maybe                     (Maybe (..), fromJust, maybe)
import qualified Data.Text                      as T
import           Data.Typeable                  (Typeable)
import           Prelude                        (Bool (..), Either (..), Eq (..), FilePath, IO, Int, Num (..), Show (..), const, either, error, filter, map, seq, snd, ($), ($!), (&&), (++), (.))
import           Snap.Internal.Core             (EscapeSnap (TerminateConnection), Snap, getParam, getPostParam, getQueryParam, runSnap)
import           Snap.Internal.Http.Types       (Request (rqBody), Response, setHeader)
import           Snap.Internal.Util.FileUploads (BadPartException (..), FileUploadException (..), PartDisposition (..), PartInfo (..), PolicyViolationException (..), allowWithMaximumSize, defaultUploadPolicy, disallow, doProcessFormInputs, fileUploadExceptionReason, getMaximumNumberOfFormInputs, getMinimumUploadRate, getMinimumUploadSeconds, getUploadTimeout, handleFileUploads, setMaximumFormInputSize, setMaximumNumberOfFormInputs, setMinimumUploadRate, setMinimumUploadSeconds, setProcessFormInputs, setUploadTimeout, toPartDisposition)
import qualified Snap.Test                      as Test
import           Snap.Test.Common               (coverEqInstance, coverShowInstance, coverTypeableInstance, eatException, expectExceptionH, seconds, waitabit)
import qualified Snap.Types.Headers             as H
import           System.Directory               (createDirectoryIfMissing, getDirectoryContents, removeDirectoryRecursive)
import           System.IO.Streams              (RateTooSlowException)
import qualified System.IO.Streams              as Streams
import           System.Mem                     (performGC)
import           System.Timeout                 (timeout)
import           Test.Framework                 (Test)
import           Test.Framework.Providers.HUnit (testCase)
import           Test.HUnit                     (assertBool, assertEqual, assertFailure)
------------------------------------------------------------------------------


------------------------------------------------------------------------------
data TestException = TestException
  deriving (Show, Typeable)

instance Exception TestException

------------------------------------------------------------------------------
tests :: [Test]
tests = [ testSuccess1
        , testSuccess2
        , testBadParses
        , testPerPartPolicyViolation1
        , testPerPartPolicyViolation2
        , testFormInputsPolicyViolation
        , testFormSizePolicyViolation
        , testNoFileName
        , testNoFileNameTooBig
        , testTooManyHeaders
        , testNoBoundary
        , testNoMixedBoundary
        , testWrongContentType
        , testSlowEnumerator
        , testSlowEnumerator2
        , testAbortedBody
        , testTrivials
        , testDisconnectionCleanup
        ]


------------------------------------------------------------------------------
testSuccess1 :: Test
testSuccess1 = testCase "fileUploads/success1" $
               harness tmpdir hndl mixedTestBody

  where
    tmpdir = "tempdir1"

    hndl = do
        xs <- handleFileUploads tmpdir
                                defaultUploadPolicy
                                (const $ allowWithMaximumSize 300000)
                               hndl'

        let fileMap = foldl' f Map.empty xs
        p1  <- getParam "field1"
        p1P <- getPostParam "field1"
        p1Q <- getQueryParam "field1"
        p2  <- getParam "field2"

        liftIO $ do
            let Just (a1, a2, a3) = Map.lookup "file1.txt" fileMap
            let Just (b1, b2, b3) = Map.lookup "file2.gif" fileMap
            assertEqual "file1 contents"
                        ("text/plain", file1Contents)
                        (a1, a2)
            assertEqual "file1 header 1"
                        (Just "text/plain")
                        (H.lookup "content-type" a3)
            assertEqual "file1 header 2"
                        (Just "attachment; filename=\"file1.txt\"")
                        (H.lookup "content-disposition" a3)

            assertEqual "file2 contents"
                        ("image/gif", file2Contents)
                        (b1, b2)
            assertEqual "file2 header 1"
                        (Just "image/gif")
                        (H.lookup "content-type" b3)
            assertEqual "file2 header 2"
                        (Just "attachment; filename=\"file2.gif\"")
                        (H.lookup "content-disposition" b3)

            assertEqual "field1 contents"
                        (Just formContents1)
                        p1

            assertEqual "field1 POST contents" (Just formContents1) p1P
            assertEqual "field1 query contents" Nothing p1Q
            assertEqual "field2 contents" (Just formContents2) p2

    f mp (fn, ct, x, hdrs) = Map.insert fn (ct,x,hdrs) mp

    hndl' partInfo =
        either throw
               (\fp -> do
                    x <- liftIO $ S.readFile fp
                    let fn = fromJust $ partFileName partInfo
                    let ct = partContentType partInfo
                    let hdrs = partHeaders partInfo
                    return (fn, ct, x, hdrs))


------------------------------------------------------------------------------
testSuccess2 :: Test
testSuccess2 = testCase "fileUploads/success2" $
               harness tmpdir hndl mixedTestBody

  where
    tmpdir = "tempdir2"

    policy = setProcessFormInputs False defaultUploadPolicy

    hndl = do
        ref <- liftIO $ newIORef (0::Int)
        _ <- handleFileUploads tmpdir
                               policy
                               (const $ allowWithMaximumSize 300000)
                               (hndl' ref)

        n <- liftIO $ readIORef ref
        liftIO $ assertEqual "num params" 4 n

    hndl' !ref !_ !_ = atomicModifyIORef ref (\x -> (x+1, ()))


------------------------------------------------------------------------------
testBadParses :: Test
testBadParses = testCase "fileUploads/badParses" $ do
                harness tmpdir hndl mixedTestBodyWithBadTypes
  where
    tmpdir = "tempdir_bad_types"

    hndl = do
        xs <- handleFileUploads tmpdir
                                defaultUploadPolicy
                                (const $ allowWithMaximumSize 300000)
                                hndl'

        let fileMap = foldl' f Map.empty xs
        p1   <- getParam "field1"
        p1P  <- getPostParam "field1"
        p1Q  <- getQueryParam "field1"
        p2   <- getParam "field2"
        pBoo <- getParam "boo"

        liftIO $ do
            assertEqual "file1 contents"
                        (Just ("text/plain", file1Contents))
                        (Map.lookup "file1.txt" fileMap)

            assertEqual "file2 contents"
                        (Just ("text/plain", file2Contents))
                        (Map.lookup "file2.gif" fileMap)

            assertEqual "field1 param contents" (Just formContents1) p1
            assertEqual "field1 POST contents" (Just formContents1) p1P
            assertEqual "field1 query contents" Nothing p1Q
            assertEqual "field2 contents" Nothing p2
            assertEqual "boo contents" (Just "boo") pBoo

    f mp (fn, ct, x) = Map.insert fn (ct,x) mp

    hndl' partInfo =
        either throw
               (\fp -> do
                    x <- liftIO $ S.readFile fp
                    let fn = fromJust $ partFileName partInfo
                    let ct = partContentType partInfo
                    return (fn, ct, x))



------------------------------------------------------------------------------
testPerPartPolicyViolation1 :: Test
testPerPartPolicyViolation1 = testCase "fileUploads/perPartPolicyViolation1" $
                              harness tmpdir hndl mixedTestBody
  where
    tmpdir = "tempdir_pol1"

    hndl = do
        _ <- handleFileUploads tmpdir defaultUploadPolicy
                               (const disallow)
                               hndl'

        p1 <- getParam "field1"
        p2 <- getParam "field2"


        liftIO $ do
            assertEqual "field1 contents"
                        (Just formContents1)
                        p1

            assertEqual "field2 contents"
                        (Just formContents2)
                        p2

    hndl' !_ e = either (\i -> show i `deepseq` return $! ())
                        (const $ error "expected policy violation")
                        e


------------------------------------------------------------------------------
testPerPartPolicyViolation2 :: Test
testPerPartPolicyViolation2 = testCase "fileUploads/perPartPolicyViolation2" $
                              harness tmpdir hndl mixedTestBody
  where
    tmpdir = "tempdir_pol2"

    hndl = handleFileUploads tmpdir defaultUploadPolicy
                             (const $ allowWithMaximumSize 4)
                             hndl'

    hndl' partInfo e = (if partFileName partInfo == Just "file1.txt"
                          then ePass
                          else eFail) e

    eFail = either (\i -> show i `deepseq` return ())
                   (const $ error "expected policy violation")

    ePass = either (throw)
                   (\i -> show i `deepseq` return ())



------------------------------------------------------------------------------
testNoFileName :: Test
testNoFileName = testCase "fileUploads/noFileName" $
                 (harness tmpdir hndl noFileNameTestBody)
  where
    tmpdir = "tempdir_noname"

    hndl = handleFileUploads tmpdir defaultUploadPolicy
                             (const $ allowWithMaximumSize 400000)
                             hndl'

    hndl' pinfo !_ = do
        assertEqual "filename" Nothing $ partFileName pinfo
        assertEqual "disposition" DispositionFile $ partDisposition pinfo


------------------------------------------------------------------------------
testNoFileNameTooBig :: Test
testNoFileNameTooBig = testCase "fileUploads/noFileNameTooBig" $
                       assertThrows (harness tmpdir hndl noFileNameTestBody) h
  where
    h !(e :: FileUploadException) = do
        let r = fileUploadExceptionReason e
        assertBool "correct exception"
                   (T.isInfixOf "File" r &&
                    T.isInfixOf "exceeded maximum allowable size" r)

    tmpdir = "tempdir_noname_toobig"

    hndl = handleFileUploads tmpdir defaultUploadPolicy
                             (const $ allowWithMaximumSize 1)
                             hndl'

    hndl' pinfo !e = do
        let (Left !x) = e
        coverShowInstance x
        assertEqual "filename" Nothing $ partFileName pinfo
        assertEqual "disposition" DispositionFile $ partDisposition pinfo
        throwIO x


------------------------------------------------------------------------------
testFormSizePolicyViolation :: Test
testFormSizePolicyViolation =
    testCase "fileUploads/formSizePolicy" $
    assertThrows (harness tmpdir hndl mixedTestBody) h
  where
    h !(e :: FileUploadException) = do
        let r = fileUploadExceptionReason e
        assertBool "correct exception"
                   (T.isInfixOf "form input" r &&
                    T.isInfixOf "exceeded maximum permissible" r)

    tmpdir = "tempdir_formpol"

    policy = setMaximumFormInputSize 2 defaultUploadPolicy

    hndl = handleFileUploads tmpdir policy
                             (const $ allowWithMaximumSize 4)
                             hndl'

    hndl' xs _ = show xs `deepseq` return ()


------------------------------------------------------------------------------
testFormInputsPolicyViolation :: Test
testFormInputsPolicyViolation =
    testCase "fileUploads/formInputsPolicy" $
    assertThrows (harness tmpdir hndl mixedTestBody) h
  where
    h !(e :: FileUploadException) = do
        let r = fileUploadExceptionReason e
        assertBool "correct exception"
                   (T.isInfixOf "number of form inputs" r &&
                    T.isInfixOf "exceeded maximum" r)

    tmpdir = "tempdir_formpol2"

    policy = setMaximumNumberOfFormInputs 0 defaultUploadPolicy

    hndl = handleFileUploads tmpdir policy
                             (\x -> x `seq` allowWithMaximumSize 4000)
                             hndl'

    hndl' xs _ = show xs `deepseq` return ()


------------------------------------------------------------------------------
testNoBoundary :: Test
testNoBoundary = testCase "fileUploads/noBoundary" $
                 expectExceptionH $
                 harness' goBadContentType tmpdir hndl mixedTestBody
  where
    tmpdir = "tempdir_noboundary"

    hndl = handleFileUploads tmpdir
                             defaultUploadPolicy
                             (const $ allowWithMaximumSize 300000)
                             hndl'

    hndl' xs _ = show xs `deepseq` return ()


------------------------------------------------------------------------------
testNoMixedBoundary :: Test
testNoMixedBoundary = testCase "fileUploads/noMixedBoundary" $
                      expectExceptionH $
                      harness' go tmpdir hndl badMixedBody
  where
    tmpdir = "tempdir_mixednoboundary"

    hndl = handleFileUploads tmpdir
                             defaultUploadPolicy
                             (const $ allowWithMaximumSize 300000)
                             hndl'

    hndl' xs _ = show xs `deepseq` return ()


------------------------------------------------------------------------------
testWrongContentType :: Test
testWrongContentType = testCase "fileUploads/wrongContentType" $
                       expectExceptionH $
                       harness' goWrongContentType tmpdir hndl mixedTestBody
  where
    tmpdir = "tempdir_noboundary"

    hndl = handleFileUploads tmpdir
                             defaultUploadPolicy
                             (const $ allowWithMaximumSize 300000)
                             hndl'
           <|> error "expect fail here"

    hndl' xs _ = show xs `deepseq` return ()


------------------------------------------------------------------------------
testTooManyHeaders :: Test
testTooManyHeaders = testCase "fileUploads/tooManyHeaders" $
                     assertThrows (harness tmpdir hndl bigHeadersBody) h
  where
    h (e :: BadPartException) = show e `deepseq` return ()

    tmpdir = "tempdir_tooManyHeaders"

    hndl = handleFileUploads tmpdir defaultUploadPolicy
                             (const $ allowWithMaximumSize 4)
                             hndl'

    hndl' xs _ = show xs `deepseq` return ()


------------------------------------------------------------------------------
testAbortedBody :: Test
testAbortedBody = testCase "fileUploads/abortedBody" $
                  expectExceptionH $
                  harness' goAndAbort tmpdir hndl abortedTestBody
  where
    tmpdir = "tempdir_abort"

    hndl = handleFileUploads tmpdir defaultUploadPolicy
                             (const $ allowWithMaximumSize 400000)
                             hndl'

    hndl' xs _ = show xs `deepseq` return ()



------------------------------------------------------------------------------
testSlowEnumerator :: Test
testSlowEnumerator =
    testCase "fileUploads/tooSlow" $
    assertThrows (harness' goSlowEnumerator tmpdir hndl mixedTestBody) h0
  where
    h0 (e :: EscapeSnap) = do
        let (TerminateConnection se) = e
            (me :: Maybe RateTooSlowException) = fromException se
        maybe (throw e) h me

    h (e :: RateTooSlowException) = coverShowInstance e

    tmpdir = "tempdir_tooslow"

    policy = setMinimumUploadRate 200000 $
             setMinimumUploadSeconds 2 $
             defaultUploadPolicy

    hndl = handleFileUploads tmpdir policy
                             (const $ allowWithMaximumSize 400000)
                             hndl'

    hndl' xs _ = show xs `deepseq` return ()


------------------------------------------------------------------------------
testSlowEnumerator2 :: Test
testSlowEnumerator2 =
    testCase "fileUploads/tooSlow2" $
    assertThrows (harness' goSlowEnumerator tmpdir hndl mixedTestBody) h0
  where
    h0 (e :: EscapeSnap) = do
        let (TerminateConnection se) = e
            (me :: Maybe RateTooSlowException) = fromException se
        maybe (throw e) h me

    h (e :: RateTooSlowException) = e `seq` return ()

    tmpdir = "tempdir_tooslow2"

    policy = setUploadTimeout 2 defaultUploadPolicy

    hndl = handleFileUploads tmpdir policy
                             (const $ allowWithMaximumSize 400000)
                             hndl'

    hndl' xs _ = show xs `deepseq` return ()


------------------------------------------------------------------------------
testTrivials :: Test
testTrivials = testCase "fileUploads/trivials" $ do
    assertEqual "" False $ doProcessFormInputs policy
    assertEqual "" 1000  $ getMinimumUploadRate policy
    assertEqual "" 1000  $ getMinimumUploadRate defaultUploadPolicy
    assertEqual "" 5     $ getMinimumUploadSeconds policy
    assertEqual "" 9     $ getUploadTimeout policy

    let pvi = PolicyViolationException ""
    coverTypeableInstance pvi
    evaluate $ ((fromJust $
                 fromException (toException pvi)) :: PolicyViolationException)
    evaluate $ ((fromJust $
                 fromException (toException pvi)) :: FileUploadException)
    let !_ = policyViolationExceptionReason pvi

    let bpi = BadPartException ""
    coverTypeableInstance bpi
    let !_ = badPartExceptionReason bpi

    coverShowInstance $ WrappedFileUploadException $ BadPartException ""
    coverShowInstance $ PartInfo "" Nothing "" DispositionFile (H.empty)
    coverShowInstance $ toPartDisposition ""
    coverEqInstance $ DispositionOther ""

    let !gfui = WrappedFileUploadException $ BadPartException ""
    evaluate $ fileUploadExceptionReason gfui

    void $ evaluate
         $ getMaximumNumberOfFormInputs
         $ setMaximumNumberOfFormInputs 2 policy

  where
    policy = setProcessFormInputs False $
             setMinimumUploadRate 1000 $
             setMinimumUploadSeconds 5 $
             setUploadTimeout 9 $
             defaultUploadPolicy


------------------------------------------------------------------------------
testDisconnectionCleanup :: Test
testDisconnectionCleanup = testCase "fileUploads/disconnectionCleanup" $ do
    runTest `finally` removeDirectoryRecursive tmpdir
  where
    runTest = do
        eatException $ removeDirectoryRecursive tmpdir
        createDirectoryIfMissing True tmpdir
        rq <- mkDamagedRequest mixedTestBody
        eatException $ liftM snd (runIt hndl rq)
        performGC
        dirs <- liftM (filter (\x -> x /= "." && x /= "..")) $
                getDirectoryContents tmpdir
        assertEqual "files should be cleaned up" [] dirs


    tmpdir = "tempdirC"
    hndl = handleFileUploads tmpdir
                             defaultUploadPolicy
                             (const $ allowWithMaximumSize 300000)
                             hndl'

    hndl' _ _ = return ()


------------------------------------------------------------------------------
harness :: FilePath -> Snap a -> ByteString -> IO ()
harness = harness' go


------------------------------------------------------------------------------
harness' :: (Snap a -> ByteString -> IO Response)
         -> FilePath
         -> Snap a
         -> ByteString
         -> IO ()
harness' g tmpdir hndl body = (do
    createDirectoryIfMissing True tmpdir
    !_ <- g hndl body
    return ()) `finally` removeDirectoryRecursive tmpdir


------------------------------------------------------------------------------
assertThrows :: Exception e => IO a -> (e -> IO ()) -> IO ()
assertThrows act handle = catch action handle
  where
    action = act >> assertFailure "Expected exception to be thrown"


------------------------------------------------------------------------------
mkRequest :: ByteString -> IO Request
mkRequest body = Test.buildRequest $ Test.postRaw "/" ct body
  where
    ct = S.append "multipart/form-data; boundary=" boundaryValue


------------------------------------------------------------------------------
mkDamagedRequest :: ByteString -> IO Request
mkDamagedRequest body = do
    req <- Test.buildRequest $ Test.postRaw "/" ct ""

    e <- newIORef False >>= Streams.makeInputStream . enum

    return $! req { rqBody = e }

  where
    ct = S.append "multipart/form-data; boundary=" boundaryValue
    enum ref = do
        x <- readIORef ref
        if x
           then throw TestException
           else do writeIORef ref True
                   return $! Just $! S.take (S.length body - 1) body


------------------------------------------------------------------------------
go :: Snap a -> ByteString -> IO Response
go m s = do
    rq <- mkRequest s
    liftM snd (runIt m rq)


------------------------------------------------------------------------------
goBadContentType :: Snap a -> ByteString -> IO Response
goBadContentType m s = do
    rq <- mkRequest s
    let rq' = setHeader "Content-Type" "multipart/form-data" rq
    liftM snd (runIt m rq')


------------------------------------------------------------------------------
goWrongContentType :: Snap a -> ByteString -> IO Response
goWrongContentType m s = do
    rq <- mkRequest s
    let rq' = setHeader "Content-Type" "text/plain" rq
    liftM snd (runIt m rq')


------------------------------------------------------------------------------
goSlowEnumerator :: Snap a -> ByteString -> IO Response
goSlowEnumerator m s = do
    rq <- mkRequest s
    e  <- Streams.fromGenerator slowInput
    let rq' = rq { rqBody = e }
    mx <- timeout (20*seconds) (liftM snd (runIt m rq'))
    maybe (error "timeout") return mx

  where
    body = S.unpack s

    slowInput = f body
      where
        f []     = return ()
        f (x:xs) = do
            liftIO waitabit
            Streams.yield $ S.singleton x
            f xs


------------------------------------------------------------------------------
goAndAbort :: Snap a -> ByteString -> IO Response
goAndAbort m s = do
    rq <- mkRequest s
    e  <- Streams.fromGenerator generator
    let rq' = rq { rqBody = e }
    mx <- timeout (20*seconds) (liftM snd (runIt m rq'))
    maybe (error "timeout") return mx

  where
    generator = do
        Streams.yield s
        liftIO $ throwIO
               $ ErrorCall "For in that sleep of death what dreams may come."


------------------------------------------------------------------------------
runIt :: Snap a -> Request -> IO (Request, Response)
runIt m rq = runSnap m d bump rq
  where
    bump !f = let !_ = f 1 in return $! ()

    d :: forall a . Show a => a -> IO ()
    d = \x -> show x `deepseq` return ()


------------------------------------------------------------------------------
-- TEST DATA

formContents1 :: ByteString
formContents1 = "form contents 1"

formContents2 :: ByteString
formContents2 = "form contents 2 zzzzzzzzzzzzzzzzzzzz"

file1Contents :: ByteString
file1Contents = "foo"

file2Contents :: ByteString
file2Contents = "... contents of file2.gif ..."

boundaryValue :: ByteString
boundaryValue = "fkjldsakjfdlsafldksjf"

subBoundaryValue :: ByteString
subBoundaryValue = "zjkzjjfjskzjzjkz"

crlf :: ByteString
crlf = "\r\n"


------------------------------------------------------------------------------
mixedTestBody :: ByteString
mixedTestBody =
    S.concat
         [ "--"
         , boundaryValue
         , crlf
         , "content-disposition: form-data; name=\"field1\"\r\n"
         , crlf
         , formContents1
         , crlf
         , "--"
         , boundaryValue
         , crlf
         , "content-disposition: form-data; name=\"field2\"\r\n"
         , crlf
         , formContents2
         , crlf
         , "--"
         , boundaryValue
         , crlf
         , "content-disposition: form-data; name=\"files\"\r\n"
         , "Content-type: multipart/mixed; boundary="
         , subBoundaryValue
         , crlf
         , crlf
         , "--"
         , subBoundaryValue
         , crlf
         , "Content-disposition: attachment; filename=\"file1.txt\"\r\n"
         , "Content-Type: text/plain\r\n"
         , crlf
         , file1Contents
         , crlf
         , "--"
         , subBoundaryValue
         , crlf
         , "Content-disposition: attachment; filename=\"file2.gif\"\r\n"
         , "Content-type: image/gif\r\n"
         , "Content-Transfer-Encoding: binary\r\n"
         , crlf
         , file2Contents
         , crlf
         , "--"
         , subBoundaryValue
         , "--\r\n"
         , "--"
         , boundaryValue
         , "--\r\n"
         ]

------------------------------------------------------------------------------
mixedTestBodyWithBadTypes :: ByteString
mixedTestBodyWithBadTypes =
    S.concat
         [ "--"
         , boundaryValue
         , crlf
         , "content-type: ;\x01;\x01;\x01;\r\n"
         , "content-disposition: form-data; name=\"field1\"\r\n\r\n"
         , formContents1
         , crlf
         , "--"
         , boundaryValue
         , crlf
         , "content-disposition: form-data;\x01;;;\x01 name=\"field2\"\r\n"
         , crlf
         , formContents2
         , crlf
         , "--"
         , boundaryValue
         , crlf
         , "content-disposition: \x01\x01\x01\x01\r\n"
         , "Content-type: multipart/mixed; boundary="
         , subBoundaryValue
         , crlf
         , crlf
         , "--"
         , subBoundaryValue
         , crlf
         , "Content-disposition: attachment; filename=\"file1.txt\"\r\n"
         , "Content-Type: ;\x01;\x01;\x01;\r\n"
         , crlf
         , file1Contents
         , crlf
         , "--"
         , subBoundaryValue
         , crlf
         , "Content-disposition: attachment; filename=\"file2.gif\"\r\n"
         , "Content-type: ;\x01;\x01;\x01\r\n"
         , "Content-Transfer-Encoding: binary\r\n"
         , crlf
         , file2Contents
         , crlf
         , "--"
         , subBoundaryValue
         , "--\r\n"
         , "--"
         , boundaryValue
         , crlf
         , "Content-type: multipart/mixed; \x01\x01;;\x01;\r\n"
         , "Content-disposition: form-data; name=boo\r\n"
         , crlf
         , "boo"
         , crlf
         , "--"
         , boundaryValue
         , "--\r\n"
         ]


------------------------------------------------------------------------------
badMixedBody :: ByteString
badMixedBody =
    S.concat
         [ crlf
         , "--"
         , boundaryValue
         , crlf
         , "content-disposition: form-data; name=\"field1\"\r\n"
         , crlf
         , formContents1
         , crlf
         , "--"
         , boundaryValue
         , crlf
         , "content-disposition: form-data; name=\"field2\"\r\n"
         , crlf
         , formContents2
         , crlf
         , "--"
         , boundaryValue
         , crlf
         , "content-disposition: form-data; name=\"files\"\r\n"
         , "Content-type: multipart/mixed"
         , crlf
         , crlf
         , "--"
         , subBoundaryValue
         , crlf
         , "Content-disposition: attachment; filename=\"file1.txt\"\r\n"
         , "Content-Type: text/plain\r\n"
         , crlf
         , file1Contents
         , crlf
         , "--"
         , subBoundaryValue
         , crlf
         , "Content-disposition: attachment; filename=\"file2.gif\"\r\n"
         , "Content-type: image/gif\r\n"
         , "Content-Transfer-Encoding: binary\r\n"
         , crlf
         , file2Contents
         , crlf
         , "--"
         , subBoundaryValue
         , "--\r\n"
         , "--"
         , boundaryValue
         , "--\r\n"
         ]


------------------------------------------------------------------------------
bigHeadersBody :: ByteString
bigHeadersBody =
    S.concat (
         [ "--"
         , boundaryValue
         , crlf
         , "content-disposition: form-data; name=\"field1\"\r\n" ]
         ++
         map (\i -> S.pack ("field_" ++ show i ++ ": bar\r\n")) [1..40000::Int]
         ++
         [ crlf
         , formContents1
         , crlf
         , "--"
         , boundaryValue
         , "--\r\n"
         ])


------------------------------------------------------------------------------
noFileNameTestBody :: ByteString
noFileNameTestBody =
    S.concat
         [ "--"
         , boundaryValue
         , crlf
         , "content-disposition: form-data; name=\"field1\"\r\n"
         , crlf
         , formContents1
         , crlf
         , "--"
         , boundaryValue
         , crlf
         , "content-disposition: form-data; name=\"field2\"\r\n"
         , crlf
         , formContents2
         , crlf
         , "--"
         , boundaryValue
         , crlf
         , "content-disposition: form-data; name=\"files\"\r\n"
         , "Content-type: multipart/mixed; boundary="
         , subBoundaryValue
         , crlf
         , crlf
         , "--"
         , subBoundaryValue
         , crlf
         , "Content-disposition: file\r\n"
         , "Content-Type: text/plain\r\n"
         , crlf
         , file1Contents
         , crlf
         , "--"
         , subBoundaryValue
         , crlf
         , "Content-disposition: file\r\n"
         , "Content-type: image/gif\r\n"
         , "Content-Transfer-Encoding: binary\r\n"
         , crlf
         , file2Contents
         , crlf
         , "--"
         , subBoundaryValue
         , "--\r\n"
         , "--"
         , boundaryValue
         , "--\r\n"
         ]


------------------------------------------------------------------------------
abortedTestBody :: ByteString
abortedTestBody =
 S.concat [ "--"
          , boundaryValue
          , crlf
          , "content-disposition: form-data; name=\"field1\"\r\n"
          , crlf
          , formContents1
          , crlf
          , "--"
          , boundaryValue
          , crlf
          , "content-disposition: form-data; name=\"field2\"\r\n"
          , "fdjkljflsdkjfsd"
          ]