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 951b20a280150164ee615b07f71e4f8e82dbaab9 (commit)
via 7384c9cd0082d09980a788e4d9dc1714e235cf9d (commit)
via 7ae69fc808a270bd027f5367c33c856d2fc46958 (commit)
from 2c50d52c7154db5042759ebc20102f83635791b6 (commit)
Summary of changes:
src/Snap/Internal/Types.hs | 29 +++++++++++++++++++++++++----
src/Snap/Types.hs | 6 ++++--
2 files changed, 29 insertions(+), 6 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 951b20a280150164ee615b07f71e4f8e82dbaab9
Author: Carl Howells <[email protected]>
Date: Thu Jun 17 21:17:40 2010 -0700
Add actions for setting the rqRemoteAddr field based on the content of a
header
diff --git a/src/Snap/Internal/Types.hs b/src/Snap/Internal/Types.hs
index a456754..39cbd83 100644
--- a/src/Snap/Internal/Types.hs
+++ b/src/Snap/Internal/Types.hs
@@ -13,6 +13,7 @@ import Control.Monad.State.Strict
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.CIByteString as CIB
import Data.IORef
import qualified Data.Iteratee as Iter
import Data.Maybe
@@ -459,6 +460,26 @@ withResponse = (getResponse >>=)
------------------------------------------------------------------------------
+-- | Modifies the 'Request' in the state to set the 'rqRemoteAddr'
+-- field to the value in the X-Forwarded-For header. If the header is
+-- not present, this action has no effect.
+ipHeaderFilter :: Snap ()
+ipHeaderFilter = ipHeaderFilter' "x-forwarded-for"
+
+
+------------------------------------------------------------------------------
+-- | Modifies the 'Request' in the state to set the 'rqRemoteAddr'
+-- field to the value from the header specified. If the header
+-- specified is not present, this action has no effect.
+ipHeaderFilter' :: CIB.CIByteString -> Snap ()
+ipHeaderFilter' header = do
+ headerContents <- getHeader header <$> getRequest
+
+ let setIP ip = modifyRequest $ \rq -> rq { rqRemoteAddr = ip }
+ maybe (return ()) setIP headerContents
+
+
+------------------------------------------------------------------------------
-- | This exception is thrown if the handler you supply to 'runSnap' fails.
data NoHandlerException = NoHandlerException
deriving (Eq, Typeable)
diff --git a/src/Snap/Types.hs b/src/Snap/Types.hs
index f78292f..31344d8 100644
--- a/src/Snap/Types.hs
+++ b/src/Snap/Types.hs
@@ -57,6 +57,8 @@ module Snap.Types
, addHeader
, setHeader
, getHeader
+ , ipHeaderFilter
+ , ipHeaderFilter'
-- ** Requests
, rqServerName
commit 7384c9cd0082d09980a788e4d9dc1714e235cf9d
Author: Carl Howells <[email protected]>
Date: Thu Jun 17 20:59:17 2010 -0700
minor whitespace cleanup
diff --git a/src/Snap/Types.hs b/src/Snap/Types.hs
index ba327c8..f78292f 100644
--- a/src/Snap/Types.hs
+++ b/src/Snap/Types.hs
@@ -5,7 +5,7 @@ for HTTP as well as the 'Snap' monad, which is used for web
handlers.
-}
module Snap.Types
- (
+ (
-- * The Snap Monad
Snap
, runSnap
@@ -105,7 +105,7 @@ module Snap.Types
-- * HTTP utilities
, formatHttpTime
- , parseHttpTime
+ , parseHttpTime
, urlEncode
, urlDecode
) where
commit 7ae69fc808a270bd027f5367c33c856d2fc46958
Author: Carl Howells <[email protected]>
Date: Thu Jun 17 20:29:36 2010 -0700
minor whitespace cleanup
diff --git a/src/Snap/Internal/Types.hs b/src/Snap/Internal/Types.hs
index e8b2953..a456754 100644
--- a/src/Snap/Internal/Types.hs
+++ b/src/Snap/Internal/Types.hs
@@ -202,7 +202,7 @@ getRequestBody = liftM fromWrap $ runRequestBody
stream2stream
-- returns it. You would want to use this if you needed to send the
-- HTTP request body (transformed or otherwise) through to the output
-- in O(1) space. (Examples: transcoding, \"echo\", etc)
---
+--
-- Normally Snap is careful to ensure that the request body is fully
-- consumed after your web handler runs; this function is marked
-- \"unsafe\" because it breaks this guarantee and leaves the
@@ -362,7 +362,7 @@ modifyRequest f = smodify $ \ss -> ss { _snapRequest = f $
_snapRequest ss }
------------------------------------------------------------------------------
-- | Modifes the 'Response' object stored in a 'Snap' monad.
-modifyResponse :: (Response -> Response) -> Snap ()
+modifyResponse :: (Response -> Response) -> Snap ()
modifyResponse f = smodify $ \ss -> ss { _snapResponse = f $ _snapResponse ss }
{-# INLINE modifyResponse #-}
@@ -487,7 +487,7 @@ runSnap (Snap m) logerr req = do
r
-- is this a case of early termination?
- let resp = case e of
+ let resp = case e of
Left x -> x
Right _ -> _snapResponse ss'
@@ -518,7 +518,7 @@ evalSnap (Snap m) logerr req = do
r
-- is this a case of early termination?
- case e of
+ case e of
Left _ -> liftIO $ throwIO $ ErrorCall "no value"
Right x -> return x
where
-----------------------------------------------------------------------
hooks/post-receive
--
snap-core
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
