snap-server 0.1.2 → 0.1.3

raw patch · 5 files changed

+19/−60 lines, 5 files

Files

• snap-server.cabal +1/−1
• src/Snap/Internal/Http/Parser.hs +9/−33
• src/Snap/Internal/Http/Server.hs +2/−1
• test/suite/Snap/Internal/Http/Parser/Tests.hs +4/−22
• test/suite/Snap/Internal/Http/Server/Tests.hs +3/−3

@@ -1,5 +1,5 @@ name:           snap-server-version:        0.1.2+version:        0.1.3 synopsis:       A fast, iteratee-based, epoll-enabled web server for the Snap Framework description:   This is the first developer prerelease of the Snap framework.  Snap is a

@@ -16,7 +16,7 @@  ------------------------------------------------------------------------------ import           Control.Applicative-import           Control.Arrow (first, second)+import           Control.Arrow (second) import           Control.Monad (liftM) import           Control.Monad.Trans import           Data.Attoparsec hiding (many, Result(..))@@ -28,21 +28,18 @@ import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Nums.Careless.Hex as Cvt import           Data.Char-import           Data.CIByteString import           Data.List (foldl') import           Data.Int import           Data.Map (Map) import qualified Data.Map as Map-import           Data.Maybe (catMaybes, fromMaybe)-import           Data.Time.Format (parseTime)+import           Data.Maybe (catMaybes) import qualified Data.Vector.Unboxed as Vec import           Data.Vector.Unboxed (Vector) import           Data.Word (Word8, Word64) import           Prelude hiding (take, takeWhile)-import           System.Locale (defaultTimeLocale) ------------------------------------------------------------------------------ import           Snap.Internal.Http.Types hiding (Enumerator)-import           Snap.Iteratee hiding (take, foldl')+import           Snap.Iteratee hiding (take, foldl', filter)   @@ -349,36 +346,15 @@     qdtext = matchAll [ isRFCText, (/= '\"'), (/= '\\') ] . w2c      -pCookie :: Parser Cookie-pCookie = do+pCookies :: Parser [Cookie]+pCookies = do     -- grab kvps and turn to strict bytestrings     kvps <- pAvPairs -    -- kvps guaranteed non-null due to grammar. First avpair specifies-    -- name=value mapping.-    let ((nm,val):attrs') = kvps-    let attrs             = map (first toCI) attrs'--    -- and we'll gather the rest of the fields with helper functions.-    return $ foldl' field (nullCookie nm val) attrs-+    return $ map toCookie $ filter (not . S.isPrefixOf "$" . fst) kvps    where-    nullCookie nm val = Cookie nm val Nothing Nothing Nothing--    fieldFuncs :: [ (CIByteString, Cookie -> ByteString -> Cookie) ]-    fieldFuncs = [ ("domain", domain)-                 , ("expires", expires)-                 , ("path", path) ]--    domain c d     = c { cookieDomain  = Just d }-    path c p       = c { cookiePath    = Just p }-    expires c e    = c { cookieExpires = parseExpires e }-    parseExpires e = parseTime defaultTimeLocale-                               "%a, %d-%b-%Y %H:%M:%S GMT"-                               (map w2c $ S.unpack e)--    field c (k,v) = fromMaybe c (flip ($ c) v <$> lookup k fieldFuncs)+    toCookie (nm,val) = Cookie nm val Nothing Nothing Nothing   -- unhelpfully, the spec mentions "old-style" cookies that don't have quotes@@ -400,8 +376,8 @@      return (key,val) -parseCookie :: ByteString -> Maybe Cookie-parseCookie = parseToCompletion pCookie+parseCookie :: ByteString -> Maybe [Cookie]+parseCookie = parseToCompletion pCookies  ------------------------------------------------------------------------------ -- MULTIPART/FORMDATA

@@ -443,7 +443,8 @@         mbContentLength = liftM (Cvt.int . head) $                           Map.lookup "content-length" hdrs -        cookies         = maybe []+        cookies         = concat $+                          maybe []                                 (catMaybes . map parseCookie)                                 (Map.lookup "cookie" hdrs) 

@@ -10,17 +10,12 @@ import           Control.Monad import           Control.Monad.Identity import           Control.Parallel.Strategies-import qualified Data.Attoparsec as Atto 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, w2c)+import           Data.ByteString.Internal (c2w) import qualified Data.Map as Map-import           Data.Maybe (fromJust)-import           Data.Time.Clock-import           Data.Time.Format-import           System.Locale import           Test.Framework  import           Test.Framework.Providers.HUnit import           Test.Framework.Providers.QuickCheck2@@ -163,31 +158,18 @@ testCookie :: Test testCookie =     testCase "parseCookie" $ do-        assertEqual "cookie parsing" (Just cv) cv2+        assertEqual "cookie parsing" (Just [cv]) cv2    where-    cv  = Cookie nm v (Just d) (Just domain) (Just path)+    cv  = Cookie nm v Nothing Nothing Nothing     cv2 = parseCookie ct --    d = (fromJust $-         parseTime defaultTimeLocale "%a, %d-%b-%Y %H:%M:%S %Z" dts) :: UTCTime--    dt     = "Fri, 22-Jan-2010 12:34:56 GMT"-    dts    = map w2c $ S.unpack dt     nm     = "foo"     v      = "bar"-    domain = ".foo.com"-    path   = "/zzz"      ct = S.concat [ nm                   , "="-                  , v-                  , "; expires="-                  , dt-                  , "; domain="-                  , domain-                  , "; path=/zzz; freeform=unparsed" ]+                  , v ]   testFormEncoded :: Test

@@ -61,7 +61,7 @@              , "Host: www.zabble.com:7777\r\n"              , "Content-Length: 10\r\n"              , "X-Random-Other-Header: foo\r\n bar\r\n"-             , "Set-Cookie: foo=\"bar\\\"\"\r\n"+             , "Cookie: foo=\"bar\\\"\"\r\n"              , "\r\n"              , "0123456789" ] @@ -71,7 +71,7 @@              , "Host: www.zabble.com:7777\r\n"              , "Content-Length: 10\r\n"              , "X-Random-Other-Header: foo\r\n bar\r\n"-             , "Set-Cookie: foo=\"bar\\\"\"\r\n"+             , "Cookie: foo=\"bar\\\"\"\r\n"              , "\r\n"              , "0123456789" ] @@ -426,7 +426,7 @@              , "Content-Length: 10\r\n"              , "Connection: close\r\n"              , "X-Random-Other-Header: foo\r\n bar\r\n"-             , "Set-Cookie: foo=\"bar\\\"\"\r\n"+             , "Cookie: foo=\"bar\\\"\"\r\n"              , "\r\n"              , "0123456789" ]