Change content-length and enumerator lengths from Int to Int64

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] \\

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,

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: close@. 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 #-}
 

src/Snap/Iteratee.hs

@@ -33,6 +33,7 @@ module Snap.Iteratee
   , toWrap
 
     -- ** Iteratee utilities
+  , drop'
   , takeExactly
   , takeNoMoreThan
   , countBytes
@@ -49,13 +50,15 @@ 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
 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
@@ -331,13 +334,30 @@ fromWrap = L.fromChunks . (:[]) . unWrap
 {-# INLINE fromWrap #-}
 
 
+------------------------------------------------------------------------------
+-- | 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,36 +366,40 @@ 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)
 
 
 ------------------------------------------------------------------------------
 -- | 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
       else IterateeG (step n')
   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

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

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,

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