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-core".
The branch, master has been updated
via efc5dc8b3806253d649d701797b4427e36cbfc2c (commit)
via 5b05b45a0955a485d52f23b0fc69769a68568141 (commit)
from a0b5853787963aa8cb4b76f17810746e957f0061 (commit)
Summary of changes:
src/Snap/Internal/Http/Types.hs | 33 +++++++-----
src/Snap/Internal/Iteratee/KnuthMorrisPratt.hs | 27 +++++-----
src/Snap/Internal/Parsing.hs | 3 +-
src/Snap/Internal/Types.hs | 15 +++---
src/Snap/Util/FileUploads.hs | 66 +++++++++++++-----------
5 files changed, 77 insertions(+), 67 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 efc5dc8b3806253d649d701797b4427e36cbfc2c
Merge: 5b05b45 a0b5853
Author: Mighty Byte <[email protected]>
Date: Sat Feb 5 15:56:05 2011 -0500
Merge branch 'master' of git.snapframework.com:snap-core
commit 5b05b45a0955a485d52f23b0fc69769a68568141
Author: Mighty Byte <[email protected]>
Date: Sat Feb 5 15:55:26 2011 -0500
Style cleanup
diff --git a/src/Snap/Internal/Http/Types.hs b/src/Snap/Internal/Http/Types.hs
index fc1a8f4..5dcc908 100644
--- a/src/Snap/Internal/Http/Types.hs
+++ b/src/Snap/Internal/Http/Types.hs
@@ -301,7 +301,8 @@ instance Show Request where
, ":"
, show $ rqServerPort r
]
- beginheaders = "Headers:\n
========================================"
+ beginheaders =
+ "Headers:\n ========================================"
endheaders = " ========================================"
hdrs' (a,b) = (B.unpack $ unCI a) ++ ": " ++ (show (map B.unpack b))
hdrs = " " ++ (concat $ intersperse "\n " $
@@ -317,11 +318,12 @@ instance Show Request where
]
cookies' = " " ++ (concat $ intersperse "\n " $
map show $ rqCookies r)
- cookies = concat [ "cookies:\n"
- , "
========================================\n"
- , cookies'
- , "\n
========================================"
- ]
+ cookies = concat
+ [ "cookies:\n"
+ , " ========================================\n"
+ , cookies'
+ , "\n ========================================"
+ ]
pathinfo = concat [ "pathinfo: ", toStr $ rqPathInfo r ]
contextpath = concat [ "contextpath: ", toStr $ rqContextPath r ]
snapletpath = concat [ "snapletpath: ", toStr $ rqSnapletPath r ]
@@ -330,11 +332,12 @@ instance Show Request where
(concat $ intersperse "\n " $
map (\ (a,b) -> B.unpack a ++ ": " ++ show b) $
Map.toAscList $ rqParams r)
- params = concat [ "params:\n"
- , "
========================================\n"
- , params'
- , "\n
========================================"
- ]
+ params = concat
+ [ "params:\n"
+ , " ========================================\n"
+ , params'
+ , "\n ========================================"
+ ]
------------------------------------------------------------------------------
@@ -471,7 +474,7 @@ rqSetParam k v = rqModifyParams $ Map.insert k v
-- | An empty 'Response'.
emptyResponse :: Response
emptyResponse = Response Map.empty Map.empty (1,1) Nothing
- (Enum (I.enumBuilder mempty))
+ (Enum (I.enumBuilder mempty))
200 "OK" False
@@ -528,7 +531,7 @@ setContentType = setHeader "Content-Type"
------------------------------------------------------------------------------
-- | addCookie has been deprecated and will be removed in 0.4. Please use
-- 'addResponseCookie' instead.
-addCookie :: Cookie -- ^ cookie value
+addCookie :: Cookie -- ^ cookie value
-> Response -- ^ response to modify
-> Response
addCookie = addResponseCookie
@@ -557,13 +560,13 @@ getResponseCookie cn r = Map.lookup cn $ rspCookies r
-- | Returns a list of 'Cookie's present in 'Response'
getResponseCookies :: Response -- ^ response to query
-> [Cookie]
-getResponseCookies = Map.elems . rspCookies
+getResponseCookies = Map.elems . rspCookies
{-# INLINE getResponseCookies #-}
------------------------------------------------------------------------------
-- | Deletes an HTTP 'Cookie' from the 'Response' headers.
-deleteResponseCookie :: ByteString -- ^ cookie name
+deleteResponseCookie :: ByteString -- ^ cookie name
-> Response -- ^ response to modify
-> Response
deleteResponseCookie cn r = r { rspCookies = cks' }
diff --git a/src/Snap/Internal/Iteratee/KnuthMorrisPratt.hs
b/src/Snap/Internal/Iteratee/KnuthMorrisPratt.hs
index 453c3a3..10e0dc1 100644
--- a/src/Snap/Internal/Iteratee/KnuthMorrisPratt.hs
+++ b/src/Snap/Internal/Iteratee/KnuthMorrisPratt.hs
@@ -2,7 +2,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
-module Snap.Internal.Iteratee.KnuthMorrisPratt
+module Snap.Internal.Iteratee.KnuthMorrisPratt
( kmpEnumeratee
, MatchInfo(..) )
where
@@ -34,12 +34,11 @@ kmpEnumeratee needle = checkDone (iter "" 0)
--------------------------------------------------------------------------
iter :: (Monad m) =>
- ByteString -- ^ num bytes left
- -- over from previous
- -- match
- -> Int -- ^ needle index
- -> (Stream MatchInfo -> Iteratee MatchInfo m a) -- ^ iteratee
- -- continuation
+ ByteString
+ -- ^ num bytes left over from previous match
+ -> Int -- ^ needle index
+ -> (Stream MatchInfo -> Iteratee MatchInfo m a)
+ -- ^ iteratee continuation
-> Iteratee ByteString m (Step MatchInfo m a)
iter !leftOver !needleIndex !k = do
EL.head >>= maybe (finish leftOver k)
@@ -86,13 +85,13 @@ kmpEnumeratee needle = checkDone (iter "" 0)
i' = max 0 ti
----------------------------------------------------------------------
- -- here we've reached the end of the input chunk. A couple of things we
- -- know:
+ -- here we've reached the end of the input chunk. A couple of things
+ -- we know:
--
- -- * the input from [0..m) doesn't match the needle and we should yield
- -- it to the inner iteratee. However if m == 0 then the whole input
- -- string was a match and we need to feed our previous leftovers
- -- forward plus our entire input string.
+ -- * the input from [0..m) doesn't match the needle and we should
+ -- yield it to the inner iteratee. However if m == 0 then the whole
+ -- input string was a match and we need to feed our previous
+ -- leftovers forward plus our entire input string.
--
-- * the input from [m..ilen) is a partial match that we need to feed
-- forward
@@ -127,7 +126,7 @@ kmpEnumeratee needle = checkDone (iter "" 0)
notmatching = S.append leftOver nomatch
rest0 = S.drop (m+needleLen-leftOverLen) input
rest = S.drop (m+needleLen) input
-
+
------------------------------------------------------------------------------
buildKmpTable :: ByteString -> Vector Int
diff --git a/src/Snap/Internal/Parsing.hs b/src/Snap/Internal/Parsing.hs
index 55cdcb5..0dc0744 100644
--- a/src/Snap/Internal/Parsing.hs
+++ b/src/Snap/Internal/Parsing.hs
@@ -194,7 +194,8 @@ pValueWithParameters = do
pParam = pSpaces *> char ';' *> pSpaces *> pParameter
------------------------------------------------------------------------------
-pContentTypeWithParameters :: Parser (ByteString, [(CIByteString, ByteString)])
+pContentTypeWithParameters ::
+ Parser (ByteString, [(CIByteString, ByteString)])
pContentTypeWithParameters = do
value <- liftM trim (pSpaces *> takeWhile (not . isSep))
params <- many (pSpaces *> satisfy isSep *> pSpaces *> pParameter)
diff --git a/src/Snap/Internal/Types.hs b/src/Snap/Internal/Types.hs
index 4b3dd4a..7430aaf 100644
--- a/src/Snap/Internal/Types.hs
+++ b/src/Snap/Internal/Types.hs
@@ -713,10 +713,11 @@ runSnap (Snap m) logerr timeoutAction req = do
return (_snapRequest ss', resp)
where
- fourohfour = setContentLength 3 $
- setResponseStatus 404 "Not Found" $
- modifyResponseBody (>==> enumBuilder (fromByteString "404")) $
- emptyResponse
+ fourohfour =
+ setContentLength 3 $
+ setResponseStatus 404 "Not Found" $
+ modifyResponseBody (>==> enumBuilder (fromByteString "404")) $
+ emptyResponse
dresp = emptyResponse { rspHttpVersion = rqVersion req }
@@ -764,10 +765,10 @@ getParam k = do
------------------------------------------------------------------------------
--- | See 'rqParams'. Convenience function to return 'Params' from the 'Request'
--- inside of a 'MonadSnap' instance.
+-- | See 'rqParams'. Convenience function to return 'Params' from the
+-- 'Request' inside of a 'MonadSnap' instance.
getParams :: MonadSnap m => m Params
-getParams = getRequest >>= return . rqParams
+getParams = getRequest >>= return . rqParams
------------------------------------------------------------------------------
diff --git a/src/Snap/Util/FileUploads.hs b/src/Snap/Util/FileUploads.hs
index eda5e2d..9dbd5bc 100644
--- a/src/Snap/Util/FileUploads.hs
+++ b/src/Snap/Util/FileUploads.hs
@@ -4,6 +4,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
+------------------------------------------------------------------------------
-- | This module contains primitives and helper functions for handling
-- requests with @Content-type: multipart/form-data@, i.e. HTML forms and file
-- uploads.
@@ -22,7 +23,8 @@
-- allowed to upload?\" and \"should we read form inputs into the parameters
-- mapping?\". Policy is specified on a \"global\" basis (using
-- 'UploadPolicy'), and on a per-file basis (using 'PartUploadPolicy', which
--- allows you to reject or limit the size of certain uploaded @Content-type@s).
+-- allows you to reject or limit the size of certain uploaded
+-- @Content-type@s).
module Snap.Util.FileUploads
( -- * Functions
handleFileUploads
@@ -99,26 +101,26 @@ import Snap.Types
------------------------------------------------------------------------------
--- | Read uploaded files into a temporary directory and calls a user handler to
--- process them.
+-- | Reads uploaded files into a temporary directory and calls a user handler
+-- to process them.
--
--- Given a temporary directory, global and file-specific upload policies, and a
--- user handler, this function consumes a request body uploaded with
+-- Given a temporary directory, global and file-specific upload policies, and
+-- a user handler, this function consumes a request body uploaded with
-- @Content-type: multipart/form-data@. Each file is read into the temporary
-- directory, and then a list of the uploaded files is passed to the user
-- handler. After the user handler runs (but before the 'Response' body
--- 'Enumerator' is streamed to the client), the files are deleted from disk; so
--- if you want to retain or use the uploaded files in the generated response,
--- you would need to move or otherwise process them.
+-- 'Enumerator' is streamed to the client), the files are deleted from disk;
+-- so if you want to retain or use the uploaded files in the generated
+-- response, you would need to move or otherwise process them.
--
-- The argument passed to the user handler is a list of:
--
-- > (PartInfo, Either PolicyViolationException FilePath)
--
--- The first half of this tuple is a 'PartInfo', which contains the information
--- the client browser sent about the given upload part (like filename,
--- content-type, etc). The second half of this tuple is an 'Either' stipulating
--- that either:
+-- The first half of this tuple is a 'PartInfo', which contains the
+-- information the client browser sent about the given upload part (like
+-- filename, content-type, etc). The second half of this tuple is an 'Either'
+-- stipulating that either:
--
-- 1. the file was rejected on a policy basis because of the provided
-- 'PartUploadPolicy' handler
@@ -134,8 +136,8 @@ import Snap.Types
-- against slowloris-style denial of service attacks.
--
-- If the given 'UploadPolicy' stipulates that you wish form inputs to be
--- placed in the 'rqParams' parameter map (using 'setProcessFormInputs'), and a
--- form input exceeds the maximum allowable size, this function will throw a
+-- placed in the 'rqParams' parameter map (using 'setProcessFormInputs'), and
+-- a form input exceeds the maximum allowable size, this function will throw a
-- 'PolicyViolationException'.
--
-- If an uploaded part contains MIME headers longer than a fixed internal
@@ -218,8 +220,8 @@ handleFileUploads tmpdir uploadPolicy partPolicy handler =
do
-- against slowloris-style denial of service attacks.
--
-- If the given 'UploadPolicy' stipulates that you wish form inputs to be
--- placed in the 'rqParams' parameter map (using 'setProcessFormInputs'), and a
--- form input exceeds the maximum allowable size, this function will throw a
+-- placed in the 'rqParams' parameter map (using 'setProcessFormInputs'), and
+-- a form input exceeds the maximum allowable size, this function will throw a
-- 'PolicyViolationException'.
--
-- If an uploaded part contains MIME headers longer than a fixed internal
@@ -328,7 +330,8 @@ fileUploadExceptionReason (WrappedFileUploadException _ r)
= r
------------------------------------------------------------------------------
uploadExceptionToException :: Exception e => e -> Text -> SomeException
-uploadExceptionToException e r = SomeException $ WrappedFileUploadException e r
+uploadExceptionToException e r =
+ SomeException $ WrappedFileUploadException e r
------------------------------------------------------------------------------
@@ -356,7 +359,8 @@ data PolicyViolationException = PolicyViolationException {
} deriving (Typeable)
instance Exception PolicyViolationException where
- toException e@(PolicyViolationException r) = uploadExceptionToException e r
+ toException e@(PolicyViolationException r) =
+ uploadExceptionToException e r
fromException = uploadExceptionFromException
instance Show PolicyViolationException where
@@ -725,9 +729,9 @@ processPart = checkDone go
------------------------------------------------------------------------------
-- | Assuming we've already identified the boundary value and run
--- 'kmpEnumeratee' to split the input up into parts which match and parts which
--- don't, run the given 'ByteString' iteratee over each part and grab a list of
--- the resulting values.
+-- 'kmpEnumeratee' to split the input up into parts which match and parts
+-- which don't, run the given 'ByteString' iteratee over each part and grab a
+-- list of the resulting values.
processParts :: Iteratee ByteString IO a
-> Iteratee MatchInfo IO [a]
processParts partIter = iterateeDebugWrapper "processParts" $ go D.empty
@@ -747,7 +751,8 @@ processParts partIter = iterateeDebugWrapper "processParts"
$ go D.empty
if b
then return $ D.toList soFar
else do
- -- processPart $$ iter :: Iteratee MatchInfo m (Step ByteString m a)
+ -- processPart $$ iter
+ -- :: Iteratee MatchInfo m (Step ByteString m a)
innerStep <- processPart $$ iter
-- output :: Maybe a
@@ -757,7 +762,8 @@ processParts partIter = iterateeDebugWrapper "processParts"
$ go D.empty
Just x -> go (D.append soFar $ D.singleton x)
Nothing -> return $ D.toList soFar
- bParser = iterateeDebugWrapper "boundary debugger" $ iterParser $
pBoundaryEnd
+ bParser = iterateeDebugWrapper "boundary debugger" $
+ iterParser $ pBoundaryEnd
pBoundaryEnd = (eol *> pure False) <|> (string "--" *> pure True)
@@ -787,12 +793,12 @@ mAX_HDRS_SIZE = 32768
------------------------------------------------------------------------------
-- We need some code to keep track of the files we have already successfully
--- created in case an exception is thrown by the request body enumerator or one
--- of the client iteratees.
+-- created in case an exception is thrown by the request body enumerator or
+-- one of the client iteratees.
data UploadedFilesState = UploadedFilesState {
- -- | This is the file which is currently being written to. If the calling
- -- function gets an exception here, it is responsible for closing and
- -- deleting this file.
+ -- | This is the file which is currently being written to. If the
+ -- calling function gets an exception here, it is responsible for
+ -- closing and deleting this file.
_currentFile :: Maybe (FilePath, Handle)
-- | .. and these files have already been successfully read and closed.
@@ -841,8 +847,8 @@ openFileForUpload :: (MonadIO m) =>
openFileForUpload ufs@(UploadedFiles stateRef) tmpdir = liftIO $ do
state <- readIORef stateRef
- -- It should be an error to open a new file with this interface if there is
- -- already a file handle active.
+ -- It should be an error to open a new file with this interface if there
+ -- is already a file handle active.
when (isJust $ _currentFile state) $ do
cleanupUploadedFiles ufs
throw $ GenericFileUploadException alreadyOpenMsg
-----------------------------------------------------------------------
hooks/post-receive
--
snap-core
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
