wai 3.0.5.0 → 3.2.0
raw patch · 4 files changed
+13/−372 lines, 4 filesdep −unix-compat
Dependencies removed: unix-compat
Files
- Network/Wai.hs +4/−0
- Network/Wai/HTTP2.hs +0/−272
- Network/Wai/Internal.hs +8/−97
- wai.cabal +1/−3
Network/Wai.hs view
@@ -59,6 +59,8 @@ , requestBodyLength , requestHeaderHost , requestHeaderRange+ , requestHeaderReferer+ , requestHeaderUserAgent , strictRequestBody , lazyRequestBody -- * Response@@ -274,6 +276,8 @@ , requestBodyLength = KnownLength 0 , requestHeaderHost = Nothing , requestHeaderRange = Nothing+ , requestHeaderReferer = Nothing+ , requestHeaderUserAgent = Nothing }
− Network/Wai/HTTP2.hs
@@ -1,272 +0,0 @@-{-# LANGUAGE OverloadedStrings, RankNTypes #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}---- | An HTTP\/2-aware variant of the 'Network.Wai.Application' type. Compared--- to the original, this exposes the new functionality of server push and--- trailers, allows stream fragments to be sent in the form of file ranges, and--- allows the stream body to produce a value to be used in constructing the--- trailers. Existing @Applications@ can be faithfully upgraded to HTTP\/2--- with 'promoteApplication' or served transparently over both protocols with--- the normal Warp 'Network.Wai.Handler.Warp.run' family of functions.------ An 'HTTP2Application' takes a 'Request' and a 'PushFunc' and produces a--- 'Responder' that will push any associated resources and send the response--- body. The response is always a stream of 'Builder's and file chunks.--- Equivalents of the 'Network.Wai.responseBuilder' family of functions are--- provided for creating 'Responder's conveniently.------ Pushed streams are handled by an IO action that triggers a server push. It--- returns @True@ if the @PUSH_PROMISE@ frame was sent, @False@ if not. Note--- this means it will still return @True@ if the client reset or ignored the--- stream. This gives handlers the freedom to implement their own heuristics--- for whether to actually push a resource, while also allowing middleware and--- frameworks to trigger server pushes automatically.--module Network.Wai.HTTP2- (- -- * Applications- HTTP2Application- -- * Responder- , Responder(..)- , RespondFunc- , Body- , Chunk(..)- , Trailers- -- * Server push- , PushFunc- , PushPromise(..)- , promiseHeaders- -- * Conveniences- , promoteApplication- -- ** Responders- , respond- , respondCont- , respondIO- , respondFile- , respondFilePart- , respondNotFound- , respondWith- -- ** Stream Bodies- , streamFilePart- , streamBuilder- , streamSimple- ) where--import Blaze.ByteString.Builder (Builder)-import Blaze.ByteString.Builder.ByteString (fromByteString)-import Control.Exception (Exception, throwIO)-import Control.Monad.Trans.Cont (ContT(..))-import Data.ByteString (ByteString)-#if __GLASGOW_HASKELL__ < 709-import Data.Functor ((<$>))-#endif-import Data.IORef (newIORef, readIORef, writeIORef)-#if __GLASGOW_HASKELL__ < 709-import Data.Monoid (mempty)-#endif-import Data.Typeable (Typeable)-import qualified Network.HTTP.Types as H--import Network.Wai (Application)-import Network.Wai.Internal- ( FilePart(..)- , Request(requestHeaders)- , Response(..)- , ResponseReceived(..)- , StreamingBody- , adjustForFilePart- , chooseFilePart- , tryGetFileSize- )---- | Headers sent after the end of a data stream, as defined by section 4.1.2 of--- the HTTP\/1.1 spec (RFC 7230), and section 8.1 of the HTTP\/2 spec.-type Trailers = [H.Header]---- | The synthesized request and headers of a pushed stream.-data PushPromise = PushPromise- { promisedMethod :: H.Method- , promisedPath :: ByteString- , promisedAuthority :: ByteString- , promisedScheme :: ByteString- , promisedHeader :: H.RequestHeaders- }---- | The HTTP\/2-aware equivalent of 'Network.Wai.Application'.-type HTTP2Application = Request -> PushFunc -> Responder---- | Part of a streaming response -- either a 'Builder' or a range of a file.-data Chunk = FileChunk FilePath FilePart | BuilderChunk Builder---- | The streaming body of a response. Equivalent to--- 'Network.Wai.StreamingBody' except that it can also write file ranges and--- return the stream's trailers.-type Body = (Chunk -> IO ()) -> IO () -> IO Trailers---- | Given to 'Responders'; provide a status, headers, and a stream body, and--- we'll give you a token proving you called the 'RespondFunc'.-type RespondFunc s = H.Status -> H.ResponseHeaders -> Body -> IO s---- | The result of an 'HTTP2Application'; or, alternately, an application--- that's independent of the request. This is a continuation-passing style--- function that first provides a response by calling the given respond--- function, then returns the request's 'Trailers'.------ The respond function is similar to the one in 'Network.Wai.Application', but--- it only takes a streaming body, the status and headers are curried, and it--- also produces trailers for the stream.-newtype Responder = Responder- { runResponder :: forall s. RespondFunc s -> IO s }---- | A function given to an 'HTTP2Application' to initiate a server-pushed--- stream. Its argument is the same as the result of an 'HTTP2Application', so--- you can either implement the response inline, or call your own application--- to create the response.------ The result is 'True' if the @PUSH_PROMISE@ frame will be sent, or 'False' if--- it will not. This can happen if server push is disabled, the concurrency--- limit of server-initiated streams is reached, or the associated stream has--- already been closed.------ This function shall ensure that stream data provided after it returns will--- be sent after the @PUSH_PROMISE@ frame, so that servers can implement the--- requirement that any pushed stream for a resource be initiated before--- sending DATA frames that reference it.-type PushFunc = PushPromise -> Responder -> IO Bool---- | Create the 'H.RequestHeaders' corresponding to the given 'PushPromise'.------ This is primarily useful for WAI handlers like Warp, and application--- implementers are unlikely to use it directly.-promiseHeaders :: PushPromise -> H.RequestHeaders-promiseHeaders p =- [ (":method", promisedMethod p)- , (":path", promisedPath p)- , (":authority", promisedAuthority p)- , (":scheme", promisedScheme p)- ] ++ promisedHeader p---- | Create a response body consisting of a single range of a file. Does not--- set Content-Length or Content-Range headers. For that, use--- 'respondFilePart' or 'respondFile'.-streamFilePart :: FilePath -> FilePart -> Body-streamFilePart path part write _ = write (FileChunk path part) >> return []---- | Respond with a single range of a file, adding the Accept-Ranges,--- Content-Length and Content-Range headers and changing the status to 206 as--- appropriate.------ If you want the range to be inferred automatically from the Range header,--- use 'respondFile' instead. On the other hand, if you want to avoid the--- automatic header and status adjustments, use 'respond' and 'streamFilePart'--- directly.-respondFilePart :: H.Status -> H.ResponseHeaders -> FilePath -> FilePart -> Responder-respondFilePart s h path part = Responder $ \k -> do- let (s', h') = adjustForFilePart s h part- k s' h' $ streamFilePart path part---- | Serve the requested range of the specified file (based on the Range--- header), using the given 'H.Status' and 'H.ResponseHeaders' as a base. If--- the file is not accessible, the status will be replaced with 404 and a--- default not-found message will be served. If a partial file is requested,--- the status will be replaced with 206 and the Content-Range header will be--- added. The Content-Length header will always be added.-respondFile :: H.Status -> H.ResponseHeaders -> FilePath -> H.RequestHeaders -> Responder-respondFile s h path reqHdrs = Responder $ \k -> do- fileSize <- tryGetFileSize path- case fileSize of- Left _ -> runResponder (respondNotFound h) k- Right size -> runResponder (respondFileExists s h path size reqHdrs) k---- As 'respondFile', but with prior knowledge of the file's existence and size.-respondFileExists :: H.Status -> H.ResponseHeaders -> FilePath -> Integer -> H.RequestHeaders -> Responder-respondFileExists s h path size reqHdrs =- respondFilePart s h path $ chooseFilePart size $ lookup H.hRange reqHdrs---- | Respond with a minimal 404 page with the given headers.-respondNotFound :: H.ResponseHeaders -> Responder-respondNotFound h = Responder $ \k -> k H.notFound404 h' $- streamBuilder $ fromByteString "File not found."- where- contentType = (H.hContentType, "text/plain; charset=utf-8")- h' = contentType:filter ((/=H.hContentType) . fst) h---- | Construct a 'Responder' that will just call the 'RespondFunc' with the--- given arguments.-respond :: H.Status -> H.ResponseHeaders -> Body -> Responder-respond s h b = Responder $ \k -> k s h b---- | Fold the given bracketing action into a 'Responder'. Note the first--- argument is isomorphic to @Codensity IO a@ or @forall s. ContT s IO a@, and--- is the type of a partially-applied 'Control.Exception.bracket' or--- @with@-style function.------ > respondWith (bracket acquire release) $--- > \x -> respondNotFound [("x", show x)]------ is equivalent to------ > Responder $ \k -> bracket acquire release $--- > \x -> runResponder (respondNotFound [("x", show x)] k------ This is morally equivalent to ('>>=') on 'Codensity' 'IO'.-respondWith :: (forall s. (a -> IO s) -> IO s) -> (a -> Responder) -> Responder-respondWith with f = respondCont $ f <$> ContT with---- | Fold the 'ContT' into the contained 'Responder'.-respondCont :: (forall r. ContT r IO Responder) -> Responder-respondCont cont = Responder $ \k -> runContT cont $ \r -> runResponder r k---- | Fold the 'IO' into the contained 'Responder'.-respondIO :: IO Responder -> Responder-respondIO io = Responder $ \k -> io >>= \r -> runResponder r k---- | Create a response body consisting of a single builder.-streamBuilder :: Builder -> Body-streamBuilder builder write _ = write (BuilderChunk builder) >> return []---- | Create a response body of a stream of 'Builder's.-streamSimple :: StreamingBody -> Body-streamSimple body write flush = body (write . BuilderChunk) flush >> return []---- | Use a normal WAI 'Response' to send the response. Useful if you're--- sharing code between HTTP\/2 applications and HTTP\/1 applications.------ The 'Request' is used to determine the right file range to serve for--- 'ResponseFile'.-promoteResponse :: Request -> Response -> Responder-promoteResponse req response = case response of- (ResponseBuilder s h b) ->- Responder $ \k -> k s h (streamBuilder b)- (ResponseStream s h body) ->- Responder $ \k -> k s h (streamSimple body)- (ResponseRaw _ fallback) -> promoteResponse req fallback- (ResponseFile s h path mpart) -> maybe- (respondFile s h path $ requestHeaders req)- (respondFilePart s h path)- mpart---- | An 'Network.Wai.Application' we tried to promote neither called its--- respond action nor raised; this is only possible if it imported the--- 'ResponseReceived' constructor and used it to lie about having called the--- action.-data RespondNeverCalled = RespondNeverCalled deriving (Show, Typeable)--instance Exception RespondNeverCalled---- | Promote a normal WAI 'Application' to an 'HTTP2Application' by ignoring--- the HTTP/2-specific features.-promoteApplication :: Application -> HTTP2Application-promoteApplication app req _ = Responder $ \k -> do- -- In HTTP2Applications, the Responder is required to ferry a value of- -- arbitrary type from the RespondFunc back to the caller of the- -- application, but in Application the type is fixed to ResponseReceived.- -- To add this extra power to an Application, we have to squirrel it away- -- in an IORef as a hack.- ref <- newIORef Nothing- let k' r = do- writeIORef ref . Just =<< runResponder (promoteResponse req r) k- return ResponseReceived- ResponseReceived <- app req k'- readIORef ref >>= maybe (throwIO RespondNeverCalled) return
Network/Wai/Internal.hs view
@@ -1,7 +1,6 @@ {-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} -- | Internal constructors and helper functions. Note that no guarantees are@@ -9,25 +8,17 @@ module Network.Wai.Internal where import Blaze.ByteString.Builder (Builder)-import Control.Exception (IOException, try) import qualified Data.ByteString as B hiding (pack)-import qualified Data.ByteString.Builder as B-import qualified Data.ByteString.Char8 as B (pack, readInteger)-import qualified Data.ByteString.Lazy as L #if __GLASGOW_HASKELL__ < 709 import Data.Functor ((<$>)) #endif-import Data.Maybe (listToMaybe) import Data.Text (Text) import Data.Typeable (Typeable) import Data.Vault.Lazy (Vault) import Data.Word (Word64) import qualified Network.HTTP.Types as H-import qualified Network.HTTP.Types.Header as HH import Network.Socket (SockAddr)-import Numeric (showInt) import Data.List (intercalate)-import qualified System.PosixCompat.Files as P -- | Information on the request sent by the client. This abstracts away the -- details of the underlying implementation.@@ -93,6 +84,14 @@ -- -- Since 2.0.0 , requestHeaderRange :: Maybe B.ByteString+ -- | The value of the Referer header in a HTTP request.+ --+ -- Since 3.2.0+ , requestHeaderReferer :: Maybe B.ByteString+ -- | The value of the User-Agent header in a HTTP request.+ --+ -- Since 3.2.0+ , requestHeaderUserAgent :: Maybe B.ByteString } deriving (Typeable) @@ -157,91 +156,3 @@ -- Since 3.0.0 data ResponseReceived = ResponseReceived deriving Typeable---- | Look up the size of a file in 'Right' or the 'IOException' in 'Left'.-tryGetFileSize :: FilePath -> IO (Either IOException Integer)-tryGetFileSize path =- fmap (fromIntegral . P.fileSize) <$> try (P.getFileStatus path)---- | \"Content-Range\".-hContentRange :: H.HeaderName-hContentRange = "Content-Range"---- | \"Accept-Ranges\".-hAcceptRanges :: H.HeaderName-hAcceptRanges = "Accept-Ranges"---- | @contentRangeHeader beg end total@ constructs a Content-Range 'H.Header'--- for the range specified.-contentRangeHeader :: Integer -> Integer -> Integer -> H.Header-contentRangeHeader beg end total = (hContentRange, range)- where- range = B.pack- -- building with ShowS- $ 'b' : 'y': 't' : 'e' : 's' : ' '- : (if beg > end then ('*':) else- showInt beg- . ('-' :)- . showInt end)- ( '/'- : showInt total "")---- | Given the full size of a file and optionally a Range header value,--- determine the range to serve by parsing the range header and obeying it, or--- serving the whole file if it's absent or malformed.-chooseFilePart :: Integer -> Maybe B.ByteString -> FilePart-chooseFilePart size Nothing = FilePart 0 size size-chooseFilePart size (Just range) = case parseByteRanges range >>= listToMaybe of- -- Range is broken- Nothing -> FilePart 0 size size- Just hrange -> checkRange hrange- where- checkRange (H.ByteRangeFrom beg) = fromRange beg (size - 1)- checkRange (H.ByteRangeFromTo beg end) = fromRange beg (min (size - 1) end)- checkRange (H.ByteRangeSuffix count) = fromRange (max 0 (size - count)) (size - 1)-- fromRange beg end = FilePart beg (end - beg + 1) size---- | Adjust the given 'H.Status' and 'H.ResponseHeaders' based on the given--- 'FilePart'. This means replacing the status with 206 if the response is--- partial, and adding the Content-Length and Accept-Ranges (always) and--- Content-Range (if appropriate) headers.-adjustForFilePart :: H.Status -> H.ResponseHeaders -> FilePart -> (H.Status, H.ResponseHeaders)-adjustForFilePart s h part = (s', h'')- where- off = filePartOffset part- len = filePartByteCount part- size = filePartFileSize part-- contentRange = contentRangeHeader off (off + len - 1) size- lengthBS = L.toStrict $ B.toLazyByteString $ B.integerDec len- s' = if filePartByteCount part /= size then H.partialContent206 else s- h' = (H.hContentLength, lengthBS):(hAcceptRanges, "bytes"):h- h'' = (if len == size then id else (contentRange:)) h'---- | Parse the value of a Range header into a 'HH.ByteRanges'.-parseByteRanges :: B.ByteString -> Maybe HH.ByteRanges-parseByteRanges bs1 = do- bs2 <- stripPrefix "bytes=" bs1- (r, bs3) <- range bs2- ranges (r:) bs3- where- range bs2 = do- (i, bs3) <- B.readInteger bs2- if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-")- then Just (HH.ByteRangeSuffix (negate i), bs3)- else do- bs4 <- stripPrefix "-" bs3- case B.readInteger bs4 of- Just (j, bs5) | j >= i -> Just (HH.ByteRangeFromTo i j, bs5)- _ -> Just (HH.ByteRangeFrom i, bs4)- ranges front bs3- | B.null bs3 = Just (front [])- | otherwise = do- bs4 <- stripPrefix "," bs3- (r, bs5) <- range bs4- ranges (front . (r:)) bs5-- stripPrefix x y- | x `B.isPrefixOf` y = Just (B.drop (B.length x) y)- | otherwise = Nothing
wai.cabal view
@@ -1,5 +1,5 @@ Name: wai-Version: 3.0.5.0+Version: 3.2.0 Synopsis: Web Application Interface. Description: Provides a common protocol for communication between web applications and web servers. description: API docs and the README are available at <http://www.stackage.org/package/wai>.@@ -27,10 +27,8 @@ , http-types >= 0.7 , text >= 0.7 , transformers >= 0.0- , unix-compat >= 0.2 , vault >= 0.3 && < 0.4 Exposed-modules: Network.Wai- Network.Wai.HTTP2 Network.Wai.Internal ghc-options: -Wall