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, 0.3 has been updated
via 09d180cc7d5f7211493f677def49c45fbf51ecde (commit)
via be58906bd728ab6e5e70b07dbbcc1b6bedc1816f (commit)
via 5160fec00d245a612f691780eccd56d97d2c01eb (commit)
via edca479ff52b933a2c1a0c9e3dd7e4bf583d2177 (commit)
via 5131d6f4f7453e122de3e708df4af4e5bd7cad9d (commit)
via 91d88ecbec9cad82933849889e9b7f4d05a2c425 (commit)
from f912888eaa3ad3d306bd08340eec69c2e1cd9881 (commit)
Summary of changes:
snap-core.cabal | 2 +-
src/Snap/Internal/Debug.hs | 8 +-
src/Snap/Internal/Iteratee/Debug.hs | 7 +-
src/Snap/Internal/Types.hs | 6 +-
src/Snap/Iteratee.hs | 3 +-
src/Snap/Util/FileServe.hs | 30 +++-
src/Snap/Util/GZip.hs | 46 +++----
test/runTestsAndCoverage.sh | 1 +
test/snap-core-testsuite.cabal | 1 +
test/suite/Snap/Internal/Http/Types/Tests.hs | 2 +-
test/suite/Snap/Iteratee/Tests.hs | 8 +-
test/suite/Snap/Types/Tests.hs | 8 +-
test/suite/Snap/Util/FileServe/Tests.hs | 99 +++++++++++++-
test/suite/Snap/Util/GZip/Tests.hs | 195 ++++++++++++++++++++------
14 files changed, 318 insertions(+), 98 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 09d180cc7d5f7211493f677def49c45fbf51ecde
Merge: be58906 f912888
Author: Gregory Collins <[email protected]>
Date: Sun Oct 10 21:03:20 2010 +0200
Merge branch '0.3' of git.snapframework.com:snap-core into 0.3
Conflicts:
snap-core.cabal
src/Snap/Internal/Debug.hs
src/Snap/Internal/Iteratee/Debug.hs
src/Snap/Internal/Types.hs
src/Snap/Iteratee.hs
commit be58906bd728ab6e5e70b07dbbcc1b6bedc1816f
Merge: 5160fec fcf4397
Author: Gregory Collins <[email protected]>
Date: Sun Oct 10 16:37:12 2010 +0200
Merge branch '0.3' into master
Conflicts:
snap-core.cabal
src/Snap/Internal/Types.hs
src/Snap/Iteratee.hs
src/Snap/Starter.hs
diff --cc snap-core.cabal
index 1f264d3,10729b7..12b7c73
--- a/snap-core.cabal
+++ b/snap-core.cabal
@@@ -1,5 -1,5 +1,5 @@@
name: snap-core
- version: 0.2.13
-version: 0.3
++version: 0.3.0
synopsis: Snap: A Haskell Web Framework (Core)
description:
@@@ -140,7 -133,7 +133,8 @@@ Librar
Snap.Util.GZip
other-modules:
+ Snap.Internal.Parsing,
+ Snap.Internal.Instances,
Snap.Internal.Routing,
Snap.Internal.Types
diff --cc src/Snap/Internal/Types.hs
index 1a7ef53,54b6873..10cb4b7
--- a/src/Snap/Internal/Types.hs
+++ b/src/Snap/Internal/Types.hs
@@@ -6,29 -8,38 +8,40 @@@
module Snap.Internal.Types where
------------------------------------------------------------------------------
- import Control.Applicative
- import Control.Exception (throwIO, ErrorCall(..))
- import Control.Monad.CatchIO
- 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.Int
- import Data.IORef
- import qualified Data.Iteratee as Iter
- import Data.Maybe
- import qualified Data.Text as T
- import qualified Data.Text.Encoding as T
- import qualified Data.Text.Lazy as LT
- import qualified Data.Text.Lazy.Encoding as LT
+ import "MonadCatchIO-transformers" Control.Monad.CatchIO
+
+ import Control.Applicative
+ import Control.Exception (throwIO, ErrorCall(..))
+ import "monads-fd" Control.Monad.Cont
+ import "monads-fd" Control.Monad.Error
+ import "monads-fd" Control.Monad.List
+ import "monads-fd" Control.Monad.RWS.Strict hiding (pass)
+ import qualified "monads-fd" Control.Monad.RWS.Lazy as LRWS
+ import "monads-fd" Control.Monad.Reader
+ import "monads-fd" Control.Monad.State.Strict
+ import qualified "monads-fd" Control.Monad.State.Lazy as LState
+ import "monads-fd" Control.Monad.Writer.Strict hiding (pass)
+ import qualified "monads-fd" Control.Monad.Writer.Lazy as LWriter
+ 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.Int
+ import Data.IORef
+ import qualified Data.Iteratee as Iter
+ import Data.Maybe
+ import qualified Data.Text as T
+ import qualified Data.Text.Encoding as T
+ import qualified Data.Text.Lazy as LT
+ import qualified Data.Text.Lazy.Encoding as LT
+ import Data.Typeable
+ import Prelude hiding (catch)
- import Data.Typeable
------------------------------------------------------------------------------
- import Snap.Iteratee hiding (Enumerator)
- import Snap.Internal.Http.Types
- import Snap.Internal.Iteratee.Debug
+ import Snap.Internal.Http.Types
+ import Snap.Iteratee hiding (Enumerator, filter)
++import Snap.Internal.Iteratee.Debug
------------------------------------------------------------------------------
@@@ -479,24 -503,8 +520,24 @@@ writeLazyText s = writeLBS $ LT.encodeU
--
-- If the response body is modified (using 'modifyResponseBody'), the file
will
-- be read using @mmap()@.
- sendFile :: FilePath -> Snap ()
-sendFile :: MonadSnap m => FilePath -> m ()
-sendFile f = modifyResponse $ \r -> r { rspBody = SendFile f }
++sendFile :: (MonadSnap m) => FilePath -> m ()
+sendFile f = modifyResponse $ \r -> r { rspBody = SendFile f Nothing }
+
+
+------------------------------------------------------------------------------
+-- | Sets the output to be the contents of the specified file, within the
given
+-- (start,end) range.
+--
+-- Calling 'sendFilePartial' will overwrite any output queued to be sent in
the
+-- 'Response'. If the response body is not modified after the call to
+-- 'sendFilePartial', Snap will use the efficient @sendfile()@ system call on
+-- platforms that support it.
+--
+-- If the response body is modified (using 'modifyResponseBody'), the file
will
+-- be read using @mmap()@.
- sendFilePartial :: FilePath -> (Int64,Int64) -> Snap ()
++sendFilePartial :: (MonadSnap m) => FilePath -> (Int64,Int64) -> m ()
+sendFilePartial f rng = modifyResponse $ \r ->
+ r { rspBody = SendFile f (Just rng) }
------------------------------------------------------------------------------
diff --cc src/Snap/Iteratee.hs
index 27a5ef7,34e00d7..e6e102b
--- a/src/Snap/Iteratee.hs
+++ b/src/Snap/Iteratee.hs
@@@ -1,11 -1,9 +1,12 @@@
+ {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Snap Framework type aliases and utilities for iteratees. Note that as a
-- convenience, this module also exports everything from @Data.Iteratee@ in
the
@@@ -50,9 -46,8 +51,9 @@@ module Snap.Iterate
) where
------------------------------------------------------------------------------
- import Control.Monad
- import Control.Monad.CatchIO
+import Control.Exception (SomeException)
+ import Control.Monad
+ import "MonadCatchIO-transformers" Control.Monad.CatchIO
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Unsafe as S
diff --cc src/Snap/Util/FileServe.hs
index bd8222b,4d68a5d..0179879
--- a/src/Snap/Util/FileServe.hs
+++ b/src/Snap/Util/FileServe.hs
@@@ -223,19 -216,13 +226,20 @@@ fileServeSingle fp
------------------------------------------------------------------------------
-- | Same as 'fileServeSingle', with control over the MIME mapping used.
- fileServeSingle' :: ByteString -- ^ MIME type mapping
+ fileServeSingle' :: MonadSnap m
+ => ByteString -- ^ MIME type mapping
-> FilePath -- ^ path to file
- -> Snap ()
+ -> m ()
fileServeSingle' mime fp = do
- req <- getRequest
-
+ reqOrig <- getRequest
+
+ -- If-Range header must be ignored if there is no Range: header in the
+ -- request (RFC 2616 section 14.27)
+ let req = if isNothing $ getHeader "range" reqOrig
+ then deleteHeader "if-range" reqOrig
+ else reqOrig
+
+ -- check "If-Modified-Since" and "If-Range" headers
let mbH = getHeader "if-modified-since" req
mbIfModified <- liftIO $ case mbH of
Nothing -> return Nothing
@@@ -310,113 -266,3 +314,113 @@@ fileType mm f
------------------------------------------------------------------------------
defaultMimeType :: ByteString
defaultMimeType = "application/octet-stream"
+
+
+------------------------------------------------------------------------------
+data RangeReq = RangeReq { _rangeFirst :: !Int64
+ , _rangeLast :: !(Maybe Int64)
+ }
+ | SuffixRangeReq { _suffixLength :: !Int64 }
+ deriving (Eq, Prelude.Show)
+
+
+------------------------------------------------------------------------------
+rangeParser :: Parser RangeReq
+rangeParser = string "bytes=" *>
+ (byteRangeSpec <|> suffixByteRangeSpec) <*
+ endOfInput
+ where
+ byteRangeSpec = do
+ start <- parseNum
+ char '-'
+ end <- option Nothing $ liftM Just parseNum
+
+ return $ RangeReq start end
+
+ suffixByteRangeSpec = liftM SuffixRangeReq $ char '-' *> parseNum
+
+
+------------------------------------------------------------------------------
- checkRangeReq :: Request -> FilePath -> Int64 -> Snap Bool
++checkRangeReq :: (MonadSnap m) => Request -> FilePath -> Int64 -> m Bool
+checkRangeReq req fp sz = do
+ -- TODO/FIXME: multiple ranges
+ dbg $ "checkRangeReq, fp=" ++ fp ++ ", sz=" ++ Prelude.show sz
+ maybe (return False)
+ (\s -> either (const $ return False)
+ withRange
+ (fullyParse s rangeParser))
+ (getHeader "range" req)
+
+ where
+ withRange rng@(RangeReq start mend) = do
+ dbg $ "withRange: got Range request: " ++ Prelude.show rng
+ let end = fromMaybe (sz-1) mend
+ dbg $ "withRange: start=" ++ Prelude.show start
+ ++ ", end=" ++ Prelude.show end
+
+ if start < 0 || end < start || start >= sz || end >= sz
+ then send416
+ else send206 start end
+
+ withRange rng@(SuffixRangeReq nbytes) = do
+ dbg $ "withRange: got Range request: " ++ Prelude.show rng
+ let end = sz-1
+ let start = sz - nbytes
+
+ dbg $ "withRange: start=" ++ Prelude.show start
+ ++ ", end=" ++ Prelude.show end
+
+ if start < 0 || end < start || start >= sz || end >= sz
+ then send416
+ else send206 start end
+
+ -- note: start and end INCLUSIVE here
+ send206 start end = do
+ dbg "inside send206"
+ let len = end-start+1
+ let crng = S.concat $
+ L.toChunks $
+ L.concat [ "bytes "
+ , show start
+ , "-"
+ , show end
+ , "/"
+ , show sz ]
+
+ modifyResponse $ setResponseCode 206
+ . setHeader "Content-Range" crng
+ . setContentLength len
+
+ dbg $ "send206: sending range (" ++ Prelude.show start
+ ++ "," ++ Prelude.show (end+1) ++ ") to sendFilePartial"
+
+ -- end here was inclusive, sendFilePartial is exclusive
+ sendFilePartial fp (start,end+1)
+ return True
+
+
+ send416 = do
+ dbg "inside send416"
+ -- if there's an "If-Range" header in the request, then we just send
+ -- back 200
+ if getHeader "If-Range" req /= Nothing
+ then return False
+ else do
+ let crng = S.concat $
+ L.toChunks $
+ L.concat ["bytes */", show sz]
+
+ modifyResponse $ setResponseCode 416
+ . setHeader "Content-Range" crng
+ . setContentLength 0
+ . deleteHeader "Content-Type"
+ . deleteHeader "Content-Encoding"
+ . deleteHeader "Transfer-Encoding"
+ . setResponseBody (enumBS "")
+
+ return True
+
+
+
+dbg :: (MonadIO m) => String -> m ()
+dbg s = debug $ "FileServe:" ++ s
-----------------------------------------------------------------------
hooks/post-receive
--
snap-core
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
