git.iko.soy/typeable/wai
on master help sign in
Cleanup: import wrangling and comments
a45c735Andrew Pritchard
wai/Network/Wai/HTTP2.hs+19
compare with master
unifiedsplit
@@ -35,23 +35,42 @@ data PushPromise = PushPromise
35-- | The HTTP\/2-aware equivalent of 'Network.Wai.Application'.
35-- | The HTTP\/2-aware equivalent of 'Network.Wai.Application'.
36type HTTP2Application = Request -> PushFunc -> Responder
36type HTTP2Application = Request -> PushFunc -> Responder
37
37
38+-- | Part of a streaming response -- either a 'Builder' or a range of a file.
38data Chunk = FileChunk FilePath (Maybe FilePart) | BuilderChunk Builder
39data Chunk = FileChunk FilePath (Maybe FilePart) | BuilderChunk Builder
39
40
41+-- TODO send -> write
42+-- | Given the write function of a stream body, write the given 'Builder'.
40sendBuilder :: (Chunk -> IO ()) -> Builder -> IO ()
43sendBuilder :: (Chunk -> IO ()) -> Builder -> IO ()
41sendBuilder = (. BuilderChunk)
44sendBuilder = (. BuilderChunk)
42
45
46+-- | Given the write function of a stream body, write part or all of the given
47+-- file.
43sendFilePart :: (Chunk -> IO ()) -> FilePath -> Maybe FilePart -> IO ()
48sendFilePart :: (Chunk -> IO ()) -> FilePath -> Maybe FilePart -> IO ()
44sendFilePart = (.: FileChunk)
49sendFilePart = (.: FileChunk)
45 where f .: g = curry $ f . uncurry g
50 where f .: g = curry $ f . uncurry g
46
51
52+-- | The streaming body of a response. Equivalent to
53+-- 'Network.Wai.StreamingBody' except that it can also write file ranges and
54+-- return a result of type @a@.
47type Body a = (Chunk -> IO ()) -> IO () -> IO a
55type Body a = (Chunk -> IO ()) -> IO () -> IO a
48
56
57+-- | A function given to an 'HTTP2Application' used to send the response. This
58+-- is similar to the respond function in 'Network.Wai.Application', but the
59+-- status and headers are curried, and it passes on any result value from the
60+-- stream body.
49type RespondFunc = forall a. H.Status -> H.ResponseHeaders -> Body a -> IO a
61type RespondFunc = forall a. H.Status -> H.ResponseHeaders -> Body a -> IO a
50
62
63+-- | A continuation-passing style function that provides a response by calling
64+-- the 'RespondFunc', then returns the request's 'Trailers'.
51type Responder = RespondFunc -> IO Trailers
65type Responder = RespondFunc -> IO Trailers
52
66
67+-- | A function given to an 'HTTP2Application' to initiate a server-pushed
68+-- stream. Its argument is the same as the result of an 'HTTP2Application', so
69+-- you can either implement the response inline, or call your own application
70+-- to create the response.
53type PushFunc = PushPromise -> Responder -> IO Bool
71type PushFunc = PushPromise -> Responder -> IO Bool
54
72
73+-- | Create the 'H.RequestHeaders' corresponding to the given 'PushPromise'.
55promiseHeaders :: PushPromise -> H.RequestHeaders
74promiseHeaders :: PushPromise -> H.RequestHeaders
56promiseHeaders p =
75promiseHeaders p =
57 [ (":method", promisedMethod p)
76 [ (":method", promisedMethod p)
warp/Network/Wai/Handler/Warp/HTTP2/Sender.hs+18−8
@@ -22,8 +22,6 @@ import Network.HTTP2.Priority
22import Network.Wai (FilePart(..))
22import Network.Wai (FilePart(..))
23import Network.Wai.HTTP2 (Trailers, promiseHeaders)
23import Network.Wai.HTTP2 (Trailers, promiseHeaders)
24import Network.Wai.Handler.Warp.Buffer
24import Network.Wai.Handler.Warp.Buffer
25−import Network.Wai.Handler.Warp.FdCache (getFd)
26−import Network.Wai.Handler.Warp.SendFile (positionRead)
27import Network.Wai.Handler.Warp.HTTP2.EncodeFrame
25import Network.Wai.Handler.Warp.HTTP2.EncodeFrame
28import Network.Wai.Handler.Warp.HTTP2.HPACK
26import Network.Wai.Handler.Warp.HTTP2.HPACK
29import Network.Wai.Handler.Warp.HTTP2.Types
27import Network.Wai.Handler.Warp.HTTP2.Types
@@ -31,25 +29,37 @@ import Network.Wai.Handler.Warp.IORef
31import qualified Network.Wai.Handler.Warp.Settings as S
29import qualified Network.Wai.Handler.Warp.Settings as S
32import qualified Network.Wai.Handler.Warp.Timeout as T
30import qualified Network.Wai.Handler.Warp.Timeout as T
33import Network.Wai.Handler.Warp.Types
31import Network.Wai.Handler.Warp.Types
32+import qualified System.PosixCompat.Files as P
33+
34+#ifdef WINDOWS
35+import qualified System.IO as IO
36+#else
37+import Network.Wai.Handler.Warp.FdCache (getFd)
38+import Network.Wai.Handler.Warp.SendFile (positionRead)
34import System.Posix.IO (openFd, OpenFileFlags(..), defaultFileFlags, OpenMode(ReadOnly), closeFd)
39import System.Posix.IO (openFd, OpenFileFlags(..), defaultFileFlags, OpenMode(ReadOnly), closeFd)
35import System.Posix.Types (Fd)
40import System.Posix.Types (Fd)
36−import qualified System.PosixCompat.Files as P
41+#endif
37
42
38----------------------------------------------------------------
43----------------------------------------------------------------
39
44
40−data Leftover = LZero
45+-- | The platform-specific type of an open file to stream from. On Windows we
41− | LOne B.BufferWriter
46+-- don't have pread, so this is just a Handle; on Unix platforms with pread,
42− | LTwo BS.ByteString B.BufferWriter
47+-- this is a file descriptor supplied by the fd cache.
43− | LFile OpenFile Integer Integer (IO ())
44−
45#ifdef WINDOWS
48#ifdef WINDOWS
46type OpenFile = IO.Handle
49type OpenFile = IO.Handle
47#else
50#else
48type OpenFile = Fd
51type OpenFile = Fd
49#endif
52#endif
50
53
54+data Leftover = LZero
55+ | LOne B.BufferWriter
56+ | LTwo BS.ByteString B.BufferWriter
57+ | LFile OpenFile Integer Integer (IO ())
58+
51----------------------------------------------------------------
59----------------------------------------------------------------
52
60
61+-- | Run the given action if the stream is not closed; handle any exceptions by
62+-- resetting the stream.
53unlessClosed :: Connection -> Stream -> IO () -> IO Bool
63unlessClosed :: Connection -> Stream -> IO () -> IO Bool
54unlessClosed Connection{connSendAll}
64unlessClosed Connection{connSendAll}
55 strm@Stream{streamState,streamNumber}
65 strm@Stream{streamState,streamNumber}
warp/Network/Wai/Handler/Warp/HTTP2/Types.hs+14
@@ -87,15 +87,29 @@ outputStream _ = error "outputStream"
87
87
88----------------------------------------------------------------
88----------------------------------------------------------------
89
89
90+-- | An element on the queue between a running stream and the sender; the order
91+-- should consist of any number of 'SFile', 'SBuilder', and 'SFlush', followed
92+-- by a single 'SFinish'.
90data Sequence = SFinish Trailers
93data Sequence = SFinish Trailers
94+ -- ^ The stream is over; its trailers are provided.
91 | SFlush
95 | SFlush
96+ -- ^ Any buffered data should be sent immediately.
92 | SBuilder Builder
97 | SBuilder Builder
98+ -- ^ Append a chunk of data to the stream.
93 | SFile FilePath (Maybe FilePart)
99 | SFile FilePath (Maybe FilePart)
100+ -- ^ Append a chunk of a file's contents to the stream.
94
101
102+-- | A message from the sender to a stream's dedicated waiter thread.
95data Sync = SyncNone
103data Sync = SyncNone
104+ -- ^ Nothing interesting has happened. Go back to sleep.
96 | SyncFinish Trailers
105 | SyncFinish Trailers
106+ -- ^ The stream has ended; enqueue 'OTrailers' and quit.
97 | SyncNext Output
107 | SyncNext Output
108+ -- ^ The stream's queue has been drained; wait for more to be
109+ -- available and re-enqueue the given 'Output'.
98
110
111+-- | Auxiliary information needed to communicate with a running stream: a queue
112+-- of stream elements ('Sequence') and a 'TVar' connected to its waiter thread.
99data Aux = Persist (TBQueue Sequence) (TVar Sync)
113data Aux = Persist (TBQueue Sequence) (TVar Sync)
100
114
101----------------------------------------------------------------
115----------------------------------------------------------------
warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+14−2
@@ -57,6 +57,8 @@ response ctx mgr tconf tickle strm sq s h strmbdy = do
57
57
58 runStream ctx OResponse tickle strm sq s h strmbdy
58 runStream ctx OResponse tickle strm sq s h strmbdy
59
59
60+-- | Set up a waiter thread and run the stream body with functions to enqueue
61+-- 'Sequence's on the stream's queue.
60runStream :: Context
62runStream :: Context
61 -> (Stream -> H.Status -> H.ResponseHeaders -> Aux -> Output)
63 -> (Stream -> H.Status -> H.ResponseHeaders -> Aux -> Output)
62 -> Respond
64 -> Respond
@@ -68,14 +70,17 @@ runStream Context{outputQ} mkOutput tickle strm sq s h strmbdy = do
68 -- queue is not empty.
70 -- queue is not empty.
69 void $ forkIO $ waiter tvar sq strm outputQ
71 void $ forkIO $ waiter tvar sq strm outputQ
70 atomically $ writeTVar tvar (SyncNext out)
72 atomically $ writeTVar tvar (SyncNext out)
71− let push chunk = do
73+ let write chunk = do
72 atomically $ writeTBQueue sq $ case chunk of
74 atomically $ writeTBQueue sq $ case chunk of
73 BuilderChunk b -> SBuilder b
75 BuilderChunk b -> SBuilder b
74 FileChunk path part -> SFile path part
76 FileChunk path part -> SFile path part
75 tickle
77 tickle
76 flush = atomically $ writeTBQueue sq SFlush
78 flush = atomically $ writeTBQueue sq SFlush
77− strmbdy push flush
79+ strmbdy write flush
78
80
81+-- | Set up a queue for the stream and use the given 'Respond' to actually run
82+-- it. This will be 'response' for client-initiated streams and just plain
83+-- 'runStream' for pushed streams.
79runResponder :: Responder -> Respond -> IO () -> Stream -> IO ()
84runResponder :: Responder -> Respond -> IO () -> Stream -> IO ()
80runResponder responder respond tickle strm = do
85runResponder responder respond tickle strm = do
81 -- Since 'Body' is loop, we cannot control it.
86 -- Since 'Body' is loop, we cannot control it.
@@ -84,6 +89,8 @@ runResponder responder respond tickle strm = do
84 trailers <- responder $ respond tickle strm sq
89 trailers <- responder $ respond tickle strm sq
85 atomically $ writeTBQueue sq $ SFinish trailers
90 atomically $ writeTBQueue sq $ SFinish trailers
86
91
92+-- | Handle abnormal termination of a stream: mark it as closed, send a reset
93+-- frame, and call the user's 'settingsOnException' handler if applicable.
87cleanupStream :: Context -> S.Settings -> Stream -> Maybe Request -> Maybe SomeException -> IO ()
94cleanupStream :: Context -> S.Settings -> Stream -> Maybe Request -> Maybe SomeException -> IO ()
88cleanupStream Context{outputQ} set strm req me = do
95cleanupStream Context{outputQ} set strm req me = do
89 closed strm Killed
96 closed strm Killed
@@ -199,6 +206,11 @@ worker ctx@Context{inputQ} set tm app respond = do
199 cleanupStream ctx set strm (Just req) me
206 cleanupStream ctx set strm (Just req) me
200 clearStreamInfo sinfo
207 clearStreamInfo sinfo
201
208
209+-- | A dedicated waiter thread to re-enqueue the stream in the priority tree
210+-- whenever output becomes available. When the sender drains the queue and
211+-- moves on to another stream, it drops a message in the 'TVar', and this
212+-- thread wakes up, waits for more output to become available, and re-enqueues
213+-- the stream.
202waiter :: TVar Sync -> TBQueue Sequence -> Stream -> PriorityTree Output -> IO ()
214waiter :: TVar Sync -> TBQueue Sequence -> Stream -> PriorityTree Output -> IO ()
203waiter tvar sq strm outQ = do
215waiter tvar sq strm outQ = do
204 -- waiting for actions other than SyncNone
216 -- waiting for actions other than SyncNone