e8c300c · typeable/wai

git.iko.soy/typeable/wai

cleaning up the types of Connection.

'Cleaner' is internal only. So, the signature of 'connSendFile' should not hold it.

commite8c300c5c88549caca78cca1ebded9ff2c22a8eb authorKazu Yamamoto <kazu@iij.ad.jp> dateFri 11 Oct 2013, 18:18 (13 years ago) parent443a93c

7 files changed+45−34

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp.hs+2−2 warp/Network/Wai/Handler/Warp/Response.hs+1−1 warp/Network/Wai/Handler/Warp/Run.hs+5−15 warp/Network/Wai/Handler/Warp/SendFile.hs+29 warp/Network/Wai/Handler/Warp/Timeout.hs−8 warp/Network/Wai/Handler/Warp/Types.hs+7−8 warp/warp.cabal+1

warp/Network/Wai/Handler/Warp.hs+2−2

@@ -40,15 +40,15 @@ module Network.Wai.Handler.Warp (

4040 , HostPreference (..)

4141 , Port

4242 , InvalidRequest (..)

43+ , ConnSendFileOverride (..)

4344 -- * Connection

4445 , Connection (..)

4546 , socketConnection

4647 -- * Internal

4748 -- ** Time out manager

4849 , module Network.Wai.Handler.Warp.Timeout

49− -- ** Cleaner

50+ -- ** Data types

5051 , Cleaner

51− , dummyCleaner

5252 -- ** Request and response

5353 , parseRequest

5454 , sendResponse

warp/Network/Wai/Handler/Warp/Response.hs+1−1

@@ -86,7 +86,7 @@ sendResponse settings cleaner req conn restore (ResponseFile s0 hs0 path mpart0)

8686 sendResponse' (Right (s, lengthyHeaders, beg, end))

8787 | hasBody s req = liftIO $ do

8888 lheader <- composeHeader settings version s lengthyHeaders

89− connSendFile conn path beg end (T.tickle th) [lheader] cleaner

89+ connSendFile conn path beg end (T.tickle th) [lheader]

9090 T.tickle th

9191 return isPersist

9292 | otherwise = liftIO $ do

warp/Network/Wai/Handler/Warp/Run.hs+5−15

@@ -17,7 +17,6 @@ import qualified Data.Conduit.List as CL

1717import Data.Conduit.Network (bindPort)

1818import Network (sClose, Socket)

1919import qualified Network.HTTP.Types as H

20−import Network.Sendfile

2120import Network.Socket (accept, SockAddr)

2221import qualified Network.Socket.ByteString as Sock

2322import Network.Wai

@@ -28,6 +27,7 @@ import Network.Wai.Handler.Warp.Response

2827import Network.Wai.Handler.Warp.Settings

2928import qualified Network.Wai.Handler.Warp.Timeout as T

3029import Network.Wai.Handler.Warp.Types

30+import Network.Wai.Handler.Warp.SendFile

3131

3232#if WINDOWS

3333import qualified Control.Concurrent.MVar as MV

@@ -49,23 +49,12 @@ socketConnection s = do

4949 return Connection {

5050 connSendMany = Sock.sendMany s

5151 , connSendAll = Sock.sendAll s

52− , connSendFile = sendFile s

52+ , connSendFile = defaultSendFile s

5353 , connClose = sClose s >> freeRecvBuffer buf

5454 , connRecv = receive s buf bytesPerRead

55+ , connSendFileOverride = Override s

5556 }

5657

57−sendFile :: Socket -> FilePath -> Integer -> Integer -> IO () -> [ByteString] -> Cleaner -> IO ()

58−#if SENDFILEFD

59−sendFile s path off len act hdr cleaner = case fdCacher cleaner of

60− Nothing -> sendfileWithHeader s path (PartOfFile off len) act hdr

61− Just fdc -> do

62− (fd, fresher) <- F.getFd fdc path

63− sendfileFdWithHeader s fd (PartOfFile off len) (act>>fresher) hdr

64−#else

65−sendFile s path off len act hdr _ =

66− sendfileWithHeader s path (PartOfFile off len) act hdr

67−#endif

68−

6958#if __GLASGOW_HASKELL__ < 702

7059allowInterrupt :: IO ()

7160allowInterrupt = unblock $ return ()

@@ -178,12 +167,13 @@ runSettingsConnectionMaker set getConnMaker app = do

178167 -- We grab the connection before registering timeouts since the

179168 -- timeouts will be useless during connection creation, due to the

180169 -- fact that async exceptions are still masked.

181− bracket mkConn connClose $ \conn ->

170+ bracket mkConn connClose $ \conn' ->

182171

183172 -- We need to register a timeout handler for this thread, and

184173 -- cancel that handler as soon as we exit.

185174 bracket (T.registerKillThread tm) T.cancel $ \th ->

186175 let cleaner = Cleaner th fc

176+ conn = setSendFile conn' fc

187177 -- We now have fully registered a connection close handler

188178 -- in the case of all exceptions, so it is safe to one

189179 -- again allow async exceptions.

warp/Network/Wai/Handler/Warp/SendFile.hsnew file+29

@@ -0,0 +1,29 @@

1+{-# LANGUAGE CPP #-}

3+module Network.Wai.Handler.Warp.SendFile where

5+import Data.ByteString (ByteString)

6+import Network.Sendfile

7+import Network.Socket (Socket)

8+import qualified Network.Wai.Handler.Warp.FdCache as F

9+import Network.Wai.Handler.Warp.Types

10+

11+defaultSendFile :: Socket -> FilePath -> Integer -> Integer -> IO () -> [ByteString] -> IO ()

12+defaultSendFile s path off len act hdr = sendfileWithHeader s path (PartOfFile off len) act hdr

13+

14+

15+#if SENDFILEFD

16+setSendFile :: Connection -> Maybe F.MutableFdCache -> Connection

17+setSendFile conn Nothing = conn

18+setSendFile conn (Just fdc) = case connSendFileOverride conn of

19+ NotOverride -> conn

20+ Override s -> conn { connSendFile = sendFile fdc s }

21+

22+sendFile :: F.MutableFdCache -> Socket -> FilePath -> Integer -> Integer -> IO () -> [ByteString] -> IO ()

23+sendFile fdc s path off len act hdr = do

24+ (fd, fresher) <- F.getFd fdc path

25+ sendfileFdWithHeader s fd (PartOfFile off len) (act>>fresher) hdr

26+#else

27+setSendFile :: Connection -> Maybe F.MutableFdCache -> Connection

28+setSendFile conn _ = conn

29+#endif

warp/Network/Wai/Handler/Warp/Timeout.hs−8

@@ -26,7 +26,6 @@ module Network.Wai.Handler.Warp.Timeout (

2626 Manager

2727 , TimeoutAction

2828 , Handle

29− , dummyHandle

3029 -- * Manager

3130 , initialize

3231 , stopManager

@@ -55,7 +54,6 @@ import Control.Monad (forever, void)

5554import Data.IORef (IORef)

5655import qualified Data.IORef as I

5756import Data.Typeable (Typeable)

58−import System.IO.Unsafe (unsafePerformIO)

5957import System.Mem.Weak (deRefWeak)

6058

6159----------------------------------------------------------------

@@ -76,12 +74,6 @@ data State = Active -- Manager turns it to Inactive.

7674

7775----------------------------------------------------------------

7876

79−-- | A dummy @Handle@.

80−dummyHandle :: Handle

81−dummyHandle = Handle (return ()) (unsafePerformIO $ I.newIORef Active)

82−

83−----------------------------------------------------------------

84−

8577data TimeoutManagerStopped = TimeoutManagerStopped

8678 deriving (Show, Typeable)

8779instance E.Exception TimeoutManagerStopped

warp/Network/Wai/Handler/Warp/Types.hs+7−8

@@ -8,6 +8,7 @@ import Control.Exception

88import Data.ByteString (ByteString)

99import Data.Typeable (Typeable)

1010import Data.Version (showVersion)

11+import Network.Socket (Socket)

1112import Network.HTTP.Types.Header

1213import qualified Paths_warp

1314import qualified Network.Wai.Handler.Warp.Timeout as T

@@ -50,24 +51,22 @@ instance Exception InvalidRequest

5051

5152----------------------------------------------------------------

5253

54+data ConnSendFileOverride = NotOverride | Override Socket

55+

56+----------------------------------------------------------------

57+

5358-- | Data type to manipulate IO actions for connections.

5459data Connection = Connection

5560 { connSendMany :: [ByteString] -> IO ()

5661 , connSendAll :: ByteString -> IO ()

57− , connSendFile :: FilePath -> Integer -> Integer -> IO () -> [ByteString] -> Cleaner -> IO () -- ^ filepath, offset, length, hook action, HTTP headers, fd clear

62+ , connSendFile :: FilePath -> Integer -> Integer -> IO () -> [ByteString] -> IO () -- ^ filepath, offset, length, hook action, HTTP headers

5863 , connClose :: IO ()

5964 , connRecv :: IO ByteString

65+ , connSendFileOverride :: ConnSendFileOverride

6066 }

6167

6268----------------------------------------------------------------

6369

64−-- | A dummy @Cleaner@, intended for applications making use of the low-level

65−-- request parsing and rendering functions.

66−--

67−-- Since 1.3.4

68−dummyCleaner :: Cleaner

69−dummyCleaner = Cleaner T.dummyHandle Nothing

70−

7170-- | A type used to clean up file descriptor caches.

7271data Cleaner = Cleaner {

7372 threadHandle :: T.Handle

warp/warp.cabal+1

@@ -61,6 +61,7 @@ Library

6161 Network.Wai.Handler.Warp.Response

6262 Network.Wai.Handler.Warp.ResponseHeader

6363 Network.Wai.Handler.Warp.Run

64+ Network.Wai.Handler.Warp.SendFile

6465 Network.Wai.Handler.Warp.Settings

6566 Network.Wai.Handler.Warp.Types

6667 Paths_warp