{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Snap.Internal.Http.Parser.Tests ( tests ) where import qualified Control.Exception as E import Control.Exception hiding (try, assert) import Control.Monad import Control.Parallel.Strategies import Data.Attoparsec hiding (Result(..)) import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.ByteString.Internal (c2w) import Data.List import qualified Data.Map as Map import Data.Maybe (isNothing) import Data.Monoid import Test.Framework import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.QuickCheck import qualified Test.QuickCheck.Monadic as QC import Test.QuickCheck.Monadic hiding (run, assert) import Test.HUnit hiding (Test, path) import Text.Printf import Snap.Internal.Http.Parser import Snap.Internal.Http.Types import Snap.Internal.Debug import Snap.Iteratee hiding (map, sequence) import qualified Snap.Iteratee as I import Snap.Test.Common() tests :: [Test] tests = [ testShow , testCookie , testChunked , testBothChunked , testBothChunkedPipelined , testBothChunkedEmpty , testP2I , testNull , testPartial , testParseError , testFormEncoded ] emptyParser :: Parser ByteString emptyParser = option "foo" $ string "bar" testShow :: Test testShow = testCase "parser/show" $ do let i = IRequest GET "/" (1,1) [] let !b = show i `using` rdeepseq return $ b `seq` () testP2I :: Test testP2I = testCase "parser/iterParser" $ do i <- liftM (enumBS "z") $ runIteratee (iterParser emptyParser) l <- run_ i assertEqual "should be foo" "foo" l forceErr :: SomeException -> IO () forceErr e = f `seq` (return ()) where !f = show e testNull :: Test testNull = testCase "parser/shortParse" $ do f <- run_ (parseRequest) assertBool "should be Nothing" $ isNothing f testPartial :: Test testPartial = testCase "parser/partial" $ do i <- liftM (enumBS "GET / ") $ runIteratee parseRequest f <- E.try $ run_ i case f of (Left e) -> forceErr e (Right x) -> assertFailure $ "expected exception, got " ++ show x testParseError :: Test testParseError = testCase "parser/error" $ do step <- runIteratee parseRequest let i = enumBS "ZZZZZZZZZZ" step f <- E.try $ run_ i case f of (Left e) -> forceErr e (Right x) -> assertFailure $ "expected exception, got " ++ show x -- | convert a bytestring to chunked transfer encoding transferEncodingChunked :: L.ByteString -> L.ByteString transferEncodingChunked = f . L.toChunks where toChunk s = L.concat [ len, "\r\n", L.fromChunks [s], "\r\n" ] where len = L.pack $ map c2w $ printf "%x" $ S.length s f l = L.concat $ (map toChunk l ++ ["0\r\n\r\n"]) -- | ensure that running the 'readChunkedTransferEncoding' iteratee against -- 'transferEncodingChunked' returns the original string testChunked :: Test testChunked = testProperty "parser/chunkedTransferEncoding" $ monadicIO $ forAllM arbitrary prop_chunked where prop_chunked s = do QC.run $ debug "==============================" QC.run $ debug $ "input is " ++ show s QC.run $ debug $ "chunked is " ++ show chunked QC.run $ debug "------------------------------" sstep <- QC.run $ runIteratee $ stream2stream step <- QC.run $ runIteratee $ joinI $ readChunkedTransferEncoding sstep out <- QC.run $ run_ $ enum step QC.assert $ s == out QC.run $ debug "==============================\n" where chunked = (transferEncodingChunked s) enum = enumLBS chunked testBothChunked :: Test testBothChunked = testProperty "parser/invertChunked" $ monadicIO $ forAllM arbitrary prop where prop s = do sstep <- QC.run $ runIteratee stream2stream let it = joinI $ writeChunkedTransferEncoding sstep bs <- QC.run $ runIteratee it >>= run_ . enumLBS s let enum = enumLBS bs x <- QC.run $ runIteratee (joinI $ readChunkedTransferEncoding sstep) >>= run_ . enum QC.assert $ s == x testBothChunkedPipelined :: Test testBothChunkedPipelined = testProperty "parser/testBothChunkedPipelined" $ monadicIO prop where prop = do sz <- QC.pick (choose (1000,4000)) s' <- QC.pick $ resize sz arbitrary ntimes <- QC.pick (choose (4,7)) --let s' = L.take 2000 $ L.fromChunks $ repeat s let e = enumLBS s' let n = fromEnum $ L.length s' let enum = foldl' (>==>) (enumBS "") (replicate ntimes e) bufi <- QC.run $ unsafeBufferIteratee copyingStream2Stream >>= runIteratee iter' <- QC.run $ runIteratee $ joinI $ writeChunkedTransferEncoding bufi let iter = I.joinI $ I.take n iter' let iters = replicate ntimes iter let mothra = foldM (\s it -> it >>= \t -> return $ s `mappend` t) mempty iters bs <- QC.run $ runIteratee mothra >>= run_ . enum let e2 = enumBS bs let pcrlf = \s -> iterParser $ string "\r\n" >> return s sstep <- QC.run $ runIteratee stream2stream let iters' = replicate ntimes $ joinI $ readChunkedTransferEncoding sstep let godzilla = sequence $ map (>>= pcrlf) iters' x <- QC.run $ runIteratee godzilla >>= run_ . e2 QC.assert $ x == (replicate ntimes s') testBothChunkedEmpty :: Test testBothChunkedEmpty = testCase "parser/testBothChunkedEmpty" prop where prop = do let s' = "" let e = enumLBS s' let n = fromEnum $ L.length s' let ntimes = 5 let enum = foldl' (>==>) (enumBS "") (replicate ntimes e) sstep <- runIteratee stream2stream step <- runIteratee $ joinI $ writeChunkedTransferEncoding sstep iter <- liftM returnI $ runIteratee $ joinI $ I.take n step let iters = replicate ntimes (iter :: Iteratee ByteString IO L.ByteString) let mothra = foldM (\s it -> it >>= \t -> return $ s `mappend` t) mempty iters mothraStep <- runIteratee mothra bs <- run_ $ enum mothraStep let e2 = enumLBS bs let pcrlf = \s -> iterParser $ string "\r\n" >> return s let iters' = replicate ntimes $ joinI $ readChunkedTransferEncoding sstep godzilla <- runIteratee $ sequence $ map (>>= pcrlf) iters' x <- run_ $ e2 godzilla assertBool "empty chunked transfer" $ x == (replicate ntimes s') testCookie :: Test testCookie = testCase "parser/parseCookie" $ do assertEqual "cookie parsing" (Just [cv]) cv2 where cv = Cookie nm v Nothing Nothing Nothing cv2 = parseCookie ct nm = "foo" v = "bar" ct = S.concat [ nm , "=" , v ] testFormEncoded :: Test testFormEncoded = testCase "parser/formEncoded" $ do let bs = "foo1=bar1&foo2=bar2+baz2&foo3=foo%20bar" let mp = parseUrlEncoded bs assertEqual "foo1" (Just ["bar1"] ) $ Map.lookup "foo1" mp assertEqual "foo2" (Just ["bar2 baz2"]) $ Map.lookup "foo2" mp assertEqual "foo3" (Just ["foo bar"] ) $ Map.lookup "foo3" mp copyingStream2Stream :: (Monad m) => Iteratee ByteString m ByteString copyingStream2Stream = go [] where go l = do mbx <- I.head maybe (return $ S.concat $ reverse l) (\x -> let !z = S.copy x in go (z:l)) mbx stream2stream :: (Monad m) => Iteratee ByteString m L.ByteString stream2stream = liftM L.fromChunks consume