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 d9d119f04cc979ea3399e476c08a901d1be585fe (commit)
from e8294b37500d3f9e5a9f71751e4a2da2629b2b6d (commit)
Summary of changes:
TODO | 7 ----
snap-core.cabal | 3 +-
src/Snap/Internal/Http/Types.hs | 5 ++-
src/Snap/Iteratee.hs | 64 +++++++++++++++++++++++++-----------
src/Snap/Util/FileServe.hs | 2 +-
test/snap-core-testsuite.cabal | 1 +
test/suite/Snap/Iteratee/Tests.hs | 11 +++++--
7 files changed, 59 insertions(+), 34 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 d9d119f04cc979ea3399e476c08a901d1be585fe
Author: shu <[email protected]>
Date: Mon Jun 7 03:09:51 2010 -0700
Change content-length and enumerator lengths from Int to Int64
diff --git a/TODO b/TODO
index 910195b..48c0d59 100644
--- a/TODO
+++ b/TODO
@@ -1,12 +1,5 @@
-*- org -*-
-* TODO [#A] Large file support
- :LOGBOOK:
- - Note taken on [2010-06-06 Sun 17:04] \\
- We can't support it right now because drop/take in iteratee is hard-
- coded to Int, so we can't enumFile if filesize > 2Gb
- :END:
-
* TODO [#B] ipv6 support
:LOGBOOK:
- Note taken on [2010-05-22 Sat 03:31] \\
diff --git a/snap-core.cabal b/snap-core.cabal
index 6ce2c11..721e346 100644
--- a/snap-core.cabal
+++ b/snap-core.cabal
@@ -151,7 +151,8 @@ Library
directory,
dlist >= 0.5 && < 0.6,
filepath,
- iteratee >= 0.3.1 && <0.4,
+ iteratee >= 0.3.1 && < 0.4,
+ ListLike >= 1 && < 2,
MonadCatchIO-transformers >= 0.2.1 && < 0.3,
monads-fd,
old-locale,
diff --git a/src/Snap/Internal/Http/Types.hs b/src/Snap/Internal/Http/Types.hs
index 6b2ba21..2a0cb34 100644
--- a/src/Snap/Internal/Http/Types.hs
+++ b/src/Snap/Internal/Http/Types.hs
@@ -29,6 +29,7 @@ import qualified Data.ByteString.Unsafe as S
import Data.Char
import Data.DList (DList)
import qualified Data.DList as DL
+import Data.Int
import Data.IORef
import Data.Map (Map)
import qualified Data.Map as Map
@@ -357,7 +358,7 @@ data Response = Response
-- | We will need to inspect the content length no matter what, and
-- looking up \"content-length\" in the headers and parsing the number
-- out of the text will be too expensive.
- , rspContentLength :: !(Maybe Int)
+ , rspContentLength :: !(Maybe Int64)
, rspBody :: ResponseBody
-- | Returns the HTTP status code.
@@ -501,7 +502,7 @@ addCookie (Cookie k v mbExpTime mbDomain mbPath) =
updateHeaders f
-- disabled for HTTP\/1.0 clients, forcing a @Connection: cl...@. For HTTP\/1.1
-- clients, Snap will switch to the chunked transfer encoding if
-- @Content-Length@ is not specified.
-setContentLength :: Int -> Response -> Response
+setContentLength :: Int64 -> Response -> Response
setContentLength l r = r { rspContentLength = Just l }
{-# INLINE setContentLength #-}
diff --git a/src/Snap/Iteratee.hs b/src/Snap/Iteratee.hs
index 545ed36..dc04a6a 100644
--- a/src/Snap/Iteratee.hs
+++ b/src/Snap/Iteratee.hs
@@ -33,6 +33,7 @@ module Snap.Iteratee
, toWrap
-- ** Iteratee utilities
+ , drop'
, takeExactly
, takeNoMoreThan
, countBytes
@@ -49,6 +50,7 @@ import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Unsafe as S
import qualified Data.ByteString.Lazy as L
+import Data.Int
import Data.IORef
import Data.Iteratee
#ifdef PORTABLE
@@ -56,6 +58,7 @@ import Data.Iteratee.IO (enumHandle)
#endif
import qualified Data.Iteratee.Base.StreamChunk as SC
import Data.Iteratee.WrappedByteString
+import qualified Data.ListLike as LL
import Data.Monoid (mappend)
import Foreign
import Foreign.C.Types
@@ -96,7 +99,7 @@ instance (Functor m, MonadCatchIO m) =>
------------------------------------------------------------------------------
-- | Wraps an 'Iteratee', counting the number of bytes consumed by it.
-countBytes :: (Monad m) => Iteratee m a -> Iteratee m (a, Int)
+countBytes :: (Monad m) => Iteratee m a -> Iteratee m (a, Int64)
countBytes = go 0
where
go !n iter = IterateeG $ f n iter
@@ -108,10 +111,10 @@ countBytes = go 0
in return $! Done (x, n') rest
Cont i err -> return $ Cont ((go $! n + m) i) err
where
- m = S.length $ unWrap ws
+ m = fromIntegral $ S.length (unWrap ws)
- len (EOF _) = 0
- len (Chunk s) = S.length $ unWrap s
+ len (EOF _) = 0
+ len (Chunk s) = fromIntegral $ S.length (unWrap s)
f !n !iter stream = do
iterv <- runIter iter stream
@@ -332,12 +335,29 @@ fromWrap = L.fromChunks . (:[]) . unWrap
------------------------------------------------------------------------------
+-- | Skip n elements of the stream, if there are that many
+-- This is the Int64 version of the drop function in the iteratee library
+drop' :: (SC.StreamChunk s el, Monad m)
+ => Int64
+ -> IterateeG s el m ()
+drop' 0 = return ()
+drop' n = IterateeG step
+ where
+ step (Chunk str)
+ | strlen <= n = return $ Cont (drop' (n - strlen)) Nothing
+ where
+ strlen = fromIntegral $ SC.length str
+ step (Chunk str) = return $ Done () (Chunk (LL.drop (fromIntegral n) str))
+ step stream = return $ Done () stream
+
+
+------------------------------------------------------------------------------
-- | Reads n elements from a stream and applies the given iteratee to
-- the stream of the read elements. Reads exactly n elements, and if
-- the stream is short propagates an error.
-takeExactly :: (SC.StreamChunk s el, Monad m) =>
- Int ->
- EnumeratorN s el s el m a
+takeExactly :: (SC.StreamChunk s el, Monad m)
+ => Int64
+ -> EnumeratorN s el s el m a
takeExactly 0 iter = return iter
takeExactly n' iter =
if n' < 0
@@ -346,15 +366,17 @@ takeExactly n' iter =
where
step n chk@(Chunk str)
| SC.null str = return $ Cont (takeExactly n iter) Nothing
- | SC.length str < n = liftM (flip Cont Nothing) inner
- where inner = liftM (check (n - SC.length str)) (runIter iter chk)
- step n (Chunk str) = done (Chunk s1) (Chunk s2)
- where (s1, s2) = SC.splitAt n str
+ | strlen < n = liftM (flip Cont Nothing) inner
+ | otherwise = done (Chunk s1) (Chunk s2)
+ where
+ strlen = fromIntegral $ SC.length str
+ inner = liftM (check (n - strlen)) (runIter iter chk)
+ (s1, s2) = SC.splitAt (fromIntegral n) str
step _n (EOF (Just e)) = return $ Cont undefined (Just e)
step _n (EOF Nothing) = return $ Cont undefined (Just (Err "short
write"))
- check n (Done x _) = drop n >> return (return x)
+ check n (Done x _) = drop' n >> return (return x)
check n (Cont x Nothing) = takeExactly n x
- check n (Cont _ (Just e)) = drop n >> throwErr e
+ check n (Cont _ (Just e)) = drop' n >> throwErr e
done s1 s2 = liftM (flip Done s2) (runIter iter s1 >>= checkIfDone return)
@@ -362,9 +384,9 @@ takeExactly n' iter =
-- | Reads up to n elements from a stream and applies the given iteratee to the
-- stream of the read elements. If more than n elements are read, propagates an
-- error.
-takeNoMoreThan :: (SC.StreamChunk s el, Monad m) =>
- Int ->
- EnumeratorN s el s el m a
+takeNoMoreThan :: (SC.StreamChunk s el, Monad m)
+ => Int64
+ -> EnumeratorN s el s el m a
takeNoMoreThan n' iter =
if n' < 0
then takeNoMoreThan 0 iter
@@ -372,10 +394,12 @@ takeNoMoreThan n' iter =
where
step n chk@(Chunk str)
| SC.null str = return $ Cont (takeNoMoreThan n iter) Nothing
- | SC.length str < n = liftM (flip Cont Nothing) inner
- | otherwise = done (Chunk s1) (Chunk s2)
- where inner = liftM (check (n - SC.length str)) (runIter iter chk)
- (s1, s2) = SC.splitAt n str
+ | strlen < n = liftM (flip Cont Nothing) inner
+ | otherwise = done (Chunk s1) (Chunk s2)
+ where
+ strlen = fromIntegral $ SC.length str
+ inner = liftM (check (n - strlen)) (runIter iter chk)
+ (s1, s2) = SC.splitAt (fromIntegral n) str
step _n (EOF (Just e)) = return $ Cont undefined (Just e)
step _n chk@(EOF Nothing) = do
diff --git a/src/Snap/Util/FileServe.hs b/src/Snap/Util/FileServe.hs
index 63bead3..3a01289 100644
--- a/src/Snap/Util/FileServe.hs
+++ b/src/Snap/Util/FileServe.hs
@@ -229,7 +229,7 @@ fileServeSingle' mime fp = do
let mt = modificationTime filestat
maybe (return ()) (chkModificationTime mt) mbIfModified
- let sz = fromEnum $ fileSize filestat
+ let sz = fromIntegral $ fileSize filestat
lm <- liftIO $ formatHttpTime mt
modifyResponse $ setHeader "Last-Modified" lm
diff --git a/test/snap-core-testsuite.cabal b/test/snap-core-testsuite.cabal
index 33727d5..b267f02 100644
--- a/test/snap-core-testsuite.cabal
+++ b/test/snap-core-testsuite.cabal
@@ -47,6 +47,7 @@ Executable testsuite
filepath,
HUnit >= 1.2 && < 2,
iteratee >= 0.3.1 && < 0.4,
+ ListLike >= 1 && < 2,
MonadCatchIO-transformers >= 0.2 && < 0.3,
monads-fd,
old-locale,
diff --git a/test/suite/Snap/Iteratee/Tests.hs
b/test/suite/Snap/Iteratee/Tests.hs
index 8ea2687..0e1752d 100644
--- a/test/suite/Snap/Iteratee/Tests.hs
+++ b/test/suite/Snap/Iteratee/Tests.hs
@@ -12,6 +12,7 @@ import Control.Monad.Identity
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Monoid
+import Data.Int
import Data.IORef
import Data.Iteratee.WrappedByteString
import Data.Word
@@ -28,6 +29,10 @@ import System.IO.Unsafe
import Snap.Iteratee
import Snap.Test.Common ()
+instance Arbitrary Int64 where
+ arbitrary = arbitraryBoundedIntegral
+ shrink = shrinkIntegral
+
liftQ :: forall a m . (Monad m) => m a -> PropertyM m a
liftQ = QC.run
@@ -342,7 +347,7 @@ testTakeNoMoreThan3 :: Test
testTakeNoMoreThan3 = testProperty "takeNoMoreLong" $
monadicIO $ forAllM arbitrary prop
where
- prop :: (Int,L.ByteString) -> PropertyM IO ()
+ prop :: (Int64,L.ByteString) -> PropertyM IO ()
prop (m,s) = do
v <- liftQ $ enumLBS "" (joinI (takeNoMoreThan 0 stream2stream)) >>=
run
assert $ fromWrap v == ""
@@ -356,7 +361,7 @@ testTakeNoMoreThan3 = testProperty "takeNoMoreLong" $
where
doIter = enumLBS s (joinI (takeNoMoreThan (n-abs m) stream2stream))
- n = fromIntegral $ L.length s
+ n = L.length s
testCountBytes :: Test
@@ -379,7 +384,7 @@ testCountBytes = testProperty "count bytes" $
erriter = countBytes $ throwErr $ Err "foo"
g iter = enumLBS s iter >>= run
f = liftQ . g
- n = fromEnum $ L.length s
+ n = L.length s
testCountBytes2 :: Test
-----------------------------------------------------------------------
hooks/post-receive
--
snap-core
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
