This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap-server".
The branch, master has been updated
via a8bbe30b4753de28e0823004cb9876fc57233c25 (commit)
from 99cb4c4f3981e5c8a5dc586308ec5bcf1742c248 (commit)
Summary of changes:
src/Snap/Internal/Http/Parser.hs | 220 +++++---------------------------------
1 files changed, 25 insertions(+), 195 deletions(-)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit a8bbe30b4753de28e0823004cb9876fc57233c25
Author: Gregory Collins <[email protected]>
Date: Mon Jan 10 00:00:15 2011 +0100
Changes to snap-server to integrate file upload support.
diff --git a/src/Snap/Internal/Http/Parser.hs b/src/Snap/Internal/Http/Parser.hs
index fca553e..296a903 100644
--- a/src/Snap/Internal/Http/Parser.hs
+++ b/src/Snap/Internal/Http/Parser.hs
@@ -16,32 +16,30 @@ module Snap.Internal.Http.Parser
------------------------------------------------------------------------------
-import Control.Applicative
-import Control.Arrow (second)
-import Control.Monad (liftM)
-import Control.Monad.Trans
-import Data.Attoparsec hiding (many, Result(..))
-import Data.Attoparsec.Enumerator
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as S
-import Data.ByteString.Internal (c2w, w2c)
-import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.Nums.Careless.Hex as Cvt
-import Data.Char
-import Data.List (foldl')
-import Data.Int
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Maybe (catMaybes)
-import qualified Data.Vector.Unboxed as Vec
-import Data.Vector.Unboxed (Vector)
-import Data.Word (Word8)
-import Prelude hiding (head, take, takeWhile)
-------------------------------------------------------------------------------
-import Snap.Internal.Http.Types
-import Snap.Internal.Debug
-import Snap.Internal.Iteratee.Debug
-import Snap.Iteratee hiding (map, take)
+import Control.Applicative
+import Control.Arrow (second)
+import Control.Monad (liftM)
+import Control.Monad.Trans
+import Data.Attoparsec hiding (many, Result(..))
+import Data.Attoparsec.Enumerator
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as S
+import Data.ByteString.Internal (c2w, w2c)
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Nums.Careless.Hex as Cvt
+import Data.Char
+import Data.List (foldl')
+import Data.Int
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (catMaybes)
+import Prelude hiding (head, take, takeWhile)
+----------------------------------------------------------------------------
+import Snap.Internal.Http.Types
+import Snap.Internal.Debug
+import Snap.Internal.Iteratee.Debug
+import Snap.Internal.Parsing
+import Snap.Iteratee hiding (map, take)
------------------------------------------------------------------------------
@@ -120,37 +118,6 @@ chunkParserToEnumeratee getChunk client = do
------------------------------------------------------------------------------
--- | Parsers for different tokens in an HTTP request.
-sp, digit, letter :: Parser Word8
-sp = word8 $ c2w ' '
-digit = satisfy (isDigit . w2c)
-letter = satisfy (isAlpha . w2c)
-
-
-------------------------------------------------------------------------------
-untilEOL :: Parser ByteString
-untilEOL = takeWhile notend
- where
- notend d = let c = w2c d in not $ c == '\r' || c == '\n'
-
-
-------------------------------------------------------------------------------
-crlf :: Parser ByteString
-crlf = string "\r\n"
-
-
-------------------------------------------------------------------------------
--- | Parser for zero or more spaces.
-spaces :: Parser [Word8]
-spaces = many sp
-
-
-------------------------------------------------------------------------------
-pSpaces :: Parser ByteString
-pSpaces = takeWhile (isSpace . w2c)
-
-
-------------------------------------------------------------------------------
-- | Parser for the internal request data type.
pRequest :: Parser (Maybe IRequest)
pRequest = (Just <$> pRequest') <|>
@@ -194,53 +161,7 @@ pVersion :: Parser (Int, Int)
pVersion = string "HTTP/" *>
liftA2 (,) (digit' <* word8 (c2w '.')) digit'
where
- digit' = fmap (digitToInt . w2c) digit
-
-
-------------------------------------------------------------------------------
-fieldChars :: Parser ByteString
-fieldChars = takeWhile isFieldChar
- where
- isFieldChar c = (Vec.!) fieldCharTable (fromEnum c)
-
-
-------------------------------------------------------------------------------
-fieldCharTable :: Vector Bool
-fieldCharTable = Vec.generate 256 f
- where
- f d = let c=toEnum d in (isDigit c) || (isAlpha c) || c == '-' || c == '_'
-
-
-------------------------------------------------------------------------------
--- | Parser for request headers.
-pHeaders :: Parser [(ByteString, ByteString)]
-pHeaders = many header
- where
- header = {-# SCC "pHeaders/header" #-}
- liftA2 (,)
- fieldName
- (word8 (c2w ':') *> spaces *> contents)
-
- fieldName = {-# SCC "pHeaders/fieldName" #-}
- liftA2 S.cons letter fieldChars
-
- contents = {-# SCC "pHeaders/contents" #-}
- liftA2 S.append
- (untilEOL <* crlf)
- (continuation <|> pure S.empty)
-
- isLeadingWS w = {-# SCC "pHeaders/isLeadingWS" #-}
- elem w wstab
-
- wstab = map c2w " \t"
-
- leadingWhiteSpace = {-# SCC "pHeaders/leadingWhiteSpace" #-}
- takeWhile1 isLeadingWS
-
- continuation = {-# SCC "pHeaders/continuation" #-}
- liftA2 S.cons
- (leadingWhiteSpace *> pure (c2w ' '))
- contents
+ digit' = fmap digitToInt digit
------------------------------------------------------------------------------
@@ -268,60 +189,6 @@ pGetTransferChunk = do
-- (cookie spec): please point out any errors!
------------------------------------------------------------------------------
-{-# INLINE matchAll #-}
-matchAll :: [ Char -> Bool ] -> Char -> Bool
-matchAll x c = and $ map ($ c) x
-
-
-------------------------------------------------------------------------------
-{-# INLINE isToken #-}
-isToken :: Char -> Bool
-isToken c = (Vec.!) tokenTable (fromEnum c)
- where
- tokenTable :: Vector Bool
- tokenTable = Vec.generate 256 (f . toEnum)
-
- f = matchAll [ isAscii
- , not . isControl
- , not . isSpace
- , not . flip elem [ '(', ')', '<', '>', '@', ',', ';'
- , ':', '\\', '\"', '/', '[', ']'
- , '?', '=', '{', '}' ]
- ]
-
-------------------------------------------------------------------------------
-{-# INLINE isRFCText #-}
-isRFCText :: Char -> Bool
-isRFCText = not . isControl
-
-
-------------------------------------------------------------------------------
-pToken :: Parser ByteString
-pToken = takeWhile (isToken . w2c)
-
-
-------------------------------------------------------------------------------
-pQuotedString :: Parser ByteString
-pQuotedString = q *> quotedText <* q
- where
- quotedText = (S.concat . reverse) <$> f []
-
- f soFar = do
- t <- takeWhile qdtext
-
- let soFar' = t:soFar
-
- -- RFC says that backslash only escapes for <">
- choice [ string "\\\"" *> f ("\"" : soFar')
- , pure soFar' ]
-
-
- q = word8 $ c2w '\"'
-
- qdtext = matchAll [ isRFCText, (/= '\"'), (/= '\\') ] . w2c
-
-
-------------------------------------------------------------------------------
pCookies :: Parser [Cookie]
pCookies = do
-- grab kvps and turn to strict bytestrings
@@ -334,31 +201,6 @@ pCookies = do
------------------------------------------------------------------------------
--- unhelpfully, the spec mentions "old-style" cookies that don't have quotes
--- around the value. wonderful.
-pWord :: Parser ByteString
-pWord = pQuotedString <|> (takeWhile ((/= ';') . w2c))
-
-
-------------------------------------------------------------------------------
-pAvPairs :: Parser [(ByteString, ByteString)]
-pAvPairs = do
- a <- pAvPair
- b <- many (pSpaces *> char ';' *> pSpaces *> pAvPair)
-
- return $ a:b
-
-
-------------------------------------------------------------------------------
-pAvPair :: Parser (ByteString, ByteString)
-pAvPair = do
- key <- pToken <* pSpaces
- val <- option "" $ char '=' *> pSpaces *> pWord
-
- return (key,val)
-
-
-------------------------------------------------------------------------------
parseCookie :: ByteString -> Maybe [Cookie]
parseCookie = parseToCompletion pCookies
@@ -388,15 +230,3 @@ parseUrlEncoded s = foldl' (\m (k,v) -> Map.insertWith'
(++) k [v] m)
decoded = catMaybes $ map decodeOne parts
-------------------------------------------------------------------------------
--- utility functions
-------------------------------------------------------------------------------
-
-------------------------------------------------------------------------------
-strictize :: L.ByteString -> ByteString
-strictize = S.concat . L.toChunks
-
-
-------------------------------------------------------------------------------
-char :: Char -> Parser Word8
-char = word8 . c2w
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
