diff --git a/Network/Wai.hs b/Network/Wai.hs --- a/Network/Wai.hs +++ b/Network/Wai.hs @@ -1,7 +1,5 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE DeriveDataTypeable #-} {-| This module defines a generic web application interface. It is a common @@ -37,89 +35,69 @@ -} module Network.Wai - ( -- * WAI interface - Request (..) - , Response (..) - , responseSource - , Application + ( + -- * Ttypes + Application , Middleware - , FilePart (..) + -- * Request + , Request + , defaultRequest , RequestBodyLength (..) + -- ** Request accessors + , requestMethod + , httpVersion + , rawPathInfo + , rawQueryString + , requestHeaders + , isSecure + , remoteHost + , pathInfo + , queryString + , requestBody + , vault + , requestBodyLength + , requestHeaderHost + , requestHeaderRange , lazyRequestBody - -- * Response body smart constructors + -- * Response + , Response + , FilePart (..) + , WithSource + -- ** Response composers + , responseFile + , responseBuilder , responseLBS + , responseSource + , responseSourceBracket + -- * Response accessors , responseStatus + , responseHeaders + , responseToSource ) where -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as L -import Data.Typeable (Typeable) -import qualified Data.Conduit as C -import qualified Data.Conduit.List as CL -import Data.Conduit.Lazy (lazyConsume) -import qualified Data.Conduit.Binary as CB -import Blaze.ByteString.Builder (Builder, fromLazyByteString) -import Network.Socket (SockAddr) -import qualified Network.HTTP.Types as H -import Data.Text (Text) -import Data.ByteString.Lazy.Char8 () -- makes it easier to use responseLBS -import Blaze.ByteString.Builder (fromByteString) -#if MIN_VERSION_vault(0,3,0) -import Data.Vault.Lazy (Vault) -#else -import Data.Vault (Vault) -#endif -import Data.Word (Word64) +import Blaze.ByteString.Builder (Builder, fromLazyByteString) +import Blaze.ByteString.Builder (fromByteString) +import Control.Exception (bracket, bracketOnError) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import Data.ByteString.Lazy.Char8 () +import qualified Data.Conduit as C +import qualified Data.Conduit.Binary as CB +import Data.Conduit.Lazy (lazyConsume) +import qualified Data.Conduit.List as CL +import Data.Monoid (mempty) +import qualified Network.HTTP.Types as H +import Network.Socket (SockAddr (SockAddrInet)) +import Network.Wai.Internal +import qualified System.IO as IO --- | Information on the request sent by the client. This abstracts away the --- details of the underlying implementation. -data Request = Request - { requestMethod :: H.Method - , httpVersion :: H.HttpVersion - -- | Extra path information sent by the client. The meaning varies slightly - -- depending on backend; in a standalone server setting, this is most likely - -- all information after the domain name. In a CGI application, this would be - -- the information following the path to the CGI executable itself. - -- Do not modify this raw value- modify pathInfo instead. - , rawPathInfo :: B.ByteString - -- | If no query string was specified, this should be empty. This value - -- /will/ include the leading question mark. - -- Do not modify this raw value- modify queryString instead. - , rawQueryString :: B.ByteString - -- | Generally the host requested by the user via the Host request header. - -- Backends are free to provide alternative values as necessary. This value - -- should not be used to construct URLs. - , serverName :: B.ByteString - -- | The listening port that the server received this request on. It is - -- possible for a server to listen on a non-numeric port (i.e., Unix named - -- socket), in which case this value will be arbitrary. Like 'serverName', - -- this value should not be used in URL construction. - , serverPort :: Int - , requestHeaders :: H.RequestHeaders - -- | Was this request made over an SSL connection? - -- - -- This value should /not/ be used, and will be removed in future revisions - -- of WAI. There is no meaningful way that a backend can indicate whether the - -- request is actually over a secure channel, due to issues of reverse - -- proxying. - , isSecure :: Bool - -- | The client\'s host information. - , remoteHost :: SockAddr - -- | Path info in individual pieces- the url without a hostname/port and without a query string, split on forward slashes, - , pathInfo :: [Text] - -- | Parsed query string information - , queryString :: H.Query - , requestBody :: C.Source (C.ResourceT IO) B.ByteString - -- | A location for arbitrary data to be shared by applications and middleware. - , vault :: Vault - -- | The size of the request body. In the case of a chunked request body, this may be unknown. - -- - -- Since 1.4.0 - , requestBodyLength :: RequestBodyLength - } - deriving (Typeable) +---------------------------------------------------------------- --- | +-- | Creating 'Response' from a file. +responseFile :: H.Status -> H.ResponseHeaders -> FilePath -> Maybe FilePart -> Response +responseFile = ResponseFile + +-- | Creating 'Response' from 'Builder'. -- -- Some questions and answers about the usage of 'Builder' here: -- @@ -142,41 +120,72 @@ -- -- A3. You can force blaze-builder to output a ByteString before it is an -- optimal size by sending a flush command. -data Response - = ResponseFile H.Status H.ResponseHeaders FilePath (Maybe FilePart) - | ResponseBuilder H.Status H.ResponseHeaders Builder - | ResponseSource H.Status H.ResponseHeaders (C.Source (C.ResourceT IO) (C.Flush Builder)) - deriving Typeable +responseBuilder :: H.Status -> H.ResponseHeaders -> Builder -> Response +responseBuilder = ResponseBuilder +-- | Creating 'Response' from 'L.ByteString'. This is a wrapper for +-- 'responseBuilder'. +responseLBS :: H.Status -> H.ResponseHeaders -> L.ByteString -> Response +responseLBS s h = ResponseBuilder s h . fromLazyByteString + +-- | Creating 'Response' from 'C.Source'. +responseSource :: H.Status -> H.ResponseHeaders -> C.Source IO (C.Flush Builder) -> Response +responseSource st hs src = ResponseSource st hs ($ src) + +-- | Creating 'Response' with allocated resource safely released. +-- +-- * The first argument is an action to allocate resource. +-- +-- * The second argument is a function to release the resource. +-- +-- * The third argument is a function to create +-- ('H.Status','H.ResponseHeaders','C.Source' 'IO' ('C.Flush' 'Builder')) +-- from the resource. +responseSourceBracket :: IO a + -> (a -> IO ()) + -> (a -> IO (H.Status + ,H.ResponseHeaders + ,C.Source IO (C.Flush Builder))) + -> IO Response +responseSourceBracket setup teardown action = + bracketOnError setup teardown $ \resource -> do + (st,hdr,src) <- action resource + return $ ResponseSource st hdr $ \f -> + bracket (return resource) teardown (\_ -> f src) + +---------------------------------------------------------------- + +-- | Accessing 'H.Status' in 'Response'. responseStatus :: Response -> H.Status -responseStatus rsp = - case rsp of - ResponseFile s _ _ _ -> s - ResponseBuilder s _ _ -> s - ResponseSource s _ _ -> s +responseStatus (ResponseFile s _ _ _) = s +responseStatus (ResponseBuilder s _ _ ) = s +responseStatus (ResponseSource s _ _ ) = s -data FilePart = FilePart - { filePartOffset :: Integer - , filePartByteCount :: Integer - } deriving Show +-- | Accessing 'H.Status' in 'Response'. +responseHeaders :: Response -> H.ResponseHeaders +responseHeaders (ResponseFile _ hs _ _) = hs +responseHeaders (ResponseBuilder _ hs _ ) = hs +responseHeaders (ResponseSource _ hs _ ) = hs -responseSource :: Response -> (H.Status, H.ResponseHeaders, C.Source (C.ResourceT IO) (C.Flush Builder)) -responseSource (ResponseSource s h b) = (s, h, b) -responseSource (ResponseFile s h fp (Just part)) = - (s, h, sourceFilePart part fp C.$= CL.map (C.Chunk . fromByteString)) -responseSource (ResponseFile s h fp Nothing) = - (s, h, CB.sourceFile fp C.$= CL.map (C.Chunk . fromByteString)) -responseSource (ResponseBuilder s h b) = - (s, h, CL.sourceList [C.Chunk b]) +-- | Converting the body information in 'Response' to 'Source'. +responseToSource :: Response + -> (H.Status, H.ResponseHeaders, WithSource IO (C.Flush Builder) b) +responseToSource (ResponseSource s h b) = (s, h, b) +responseToSource (ResponseFile s h fp (Just part)) = + (s, h, \f -> IO.withFile fp IO.ReadMode $ \handle -> f $ sourceFilePart handle part C.$= CL.map (C.Chunk . fromByteString)) +responseToSource (ResponseFile s h fp Nothing) = + (s, h, \f -> IO.withFile fp IO.ReadMode $ \handle -> f $ CB.sourceHandle handle C.$= CL.map (C.Chunk . fromByteString)) +responseToSource (ResponseBuilder s h b) = + (s, h, ($ CL.sourceList [C.Chunk b])) -sourceFilePart :: C.MonadResource m => FilePart -> FilePath -> C.Source m B.ByteString -sourceFilePart (FilePart offset count) fp = - CB.sourceFileRange fp (Just offset) (Just count) +sourceFilePart :: IO.Handle -> FilePart -> C.Source IO B.ByteString +sourceFilePart handle (FilePart offset count _) = + CB.sourceHandleRange handle (Just offset) (Just count) -responseLBS :: H.Status -> H.ResponseHeaders -> L.ByteString -> Response -responseLBS s h = ResponseBuilder s h . fromLazyByteString +---------------------------------------------------------------- -type Application = Request -> C.ResourceT IO Response +-- | The WAI application. +type Application = Request -> IO Response -- | Middleware is a component that sits between the server and application. It -- can do such tasks as GZIP encoding or response caching. What follows is the @@ -194,15 +203,30 @@ -- middleware takes a function which consumes the session information as well. type Middleware = Application -> Application --- | The size of the request body. In the case of chunked bodies, the size will --- not be known. +-- | A default, blank request. -- --- Since 1.4.0 -data RequestBodyLength = ChunkedBody | KnownLength Word64 +-- Since 2.0.0 +defaultRequest :: Request +defaultRequest = Request + { requestMethod = H.methodGet + , httpVersion = H.http10 + , rawPathInfo = B.empty + , rawQueryString = B.empty + , requestHeaders = [] + , isSecure = False + , remoteHost = SockAddrInet 0 0 + , pathInfo = [] + , queryString = [] + , requestBody = return () + , vault = mempty + , requestBodyLength = KnownLength 0 + , requestHeaderHost = Nothing + , requestHeaderRange = Nothing + } -- | Get the request body as a lazy ByteString. This uses lazy I\/O under the -- surface, and therefore all typical warnings regarding lazy I/O apply. -- -- Since 1.4.1 -lazyRequestBody :: Request -> C.ResourceT IO L.ByteString +lazyRequestBody :: Request -> IO L.ByteString lazyRequestBody = fmap L.fromChunks . lazyConsume . requestBody diff --git a/Network/Wai/Internal.hs b/Network/Wai/Internal.hs new file mode 100644 --- /dev/null +++ b/Network/Wai/Internal.hs @@ -0,0 +1,108 @@ +{-# OPTIONS_HADDOCK not-home #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} +-- | Internal constructors and helper functions. Note that no guarantees are +-- given for stability of these interfaces. +module Network.Wai.Internal where + +import Blaze.ByteString.Builder (Builder) +import qualified Data.ByteString as B +import qualified Data.Conduit as C +import Data.Text (Text) +import Data.Typeable (Typeable) +#if MIN_VERSION_vault(0,3,0) +import Data.Vault.Lazy (Vault) +#else +import Data.Vault (Vault) +#endif +import Data.Word (Word64) +import qualified Network.HTTP.Types as H +import Network.Socket (SockAddr) + +-- | Information on the request sent by the client. This abstracts away the +-- details of the underlying implementation. +data Request = Request { + -- | Request method such as GET. + requestMethod :: H.Method + -- | HTTP version such as 1.1. + , httpVersion :: H.HttpVersion + -- | Extra path information sent by the client. The meaning varies slightly + -- depending on backend; in a standalone server setting, this is most likely + -- all information after the domain name. In a CGI application, this would be + -- the information following the path to the CGI executable itself. + -- Do not modify this raw value- modify pathInfo instead. + , rawPathInfo :: B.ByteString + -- | If no query string was specified, this should be empty. This value + -- /will/ include the leading question mark. + -- Do not modify this raw value- modify queryString instead. + , rawQueryString :: B.ByteString + -- | A list of header (a pair of key and value) in an HTTP request. + , requestHeaders :: H.RequestHeaders + -- | Was this request made over an SSL connection? + -- + -- Note that this value will /not/ tell you if the client originally made + -- this request over SSL, but rather whether the current connection is SSL. + -- The distinction lies with reverse proxies. In many cases, the client will + -- connect to a load balancer over SSL, but connect to the WAI handler + -- without SSL. In such a case, @isSecure@ will be @False@, but from a user + -- perspective, there is a secure connection. + , isSecure :: Bool + -- | The client\'s host information. + , remoteHost :: SockAddr + -- | Path info in individual pieces- the url without a hostname/port and without a query string, split on forward slashes, + , pathInfo :: [Text] + -- | Parsed query string information + , queryString :: H.Query + -- | A request body provided as 'Source'. + , requestBody :: C.Source IO B.ByteString + -- | A location for arbitrary data to be shared by applications and middleware. + , vault :: Vault + -- | The size of the request body. In the case of a chunked request body, this may be unknown. + -- + -- Since 1.4.0 + , requestBodyLength :: RequestBodyLength + -- | The value of the Host header in a HTTP request. + -- + -- Since 2.0.0 + , requestHeaderHost :: Maybe B.ByteString + -- | The value of the Range header in a HTTP request. + -- + -- Since 2.0.0 + , requestHeaderRange :: Maybe B.ByteString + } + deriving (Typeable) + +-- | The strange structure of the third field or ResponseSource is to allow for +-- exception-safe resource allocation. As an example: +-- +-- > app :: Application +-- > app _ = return $ ResponseSource status200 [] $ \f -> bracket +-- > (putStrLn "Allocation" >> return 5) +-- > (\i -> putStrLn $ "Cleaning up: " ++ show i) +-- > (\_ -> f $ do +-- > yield $ Chunk $ fromByteString "Hello " +-- > yield $ Chunk $ fromByteString "World!") +data Response + = ResponseFile H.Status H.ResponseHeaders FilePath (Maybe FilePart) + | ResponseBuilder H.Status H.ResponseHeaders Builder + | ResponseSource H.Status H.ResponseHeaders (forall b. WithSource IO (C.Flush Builder) b) + deriving Typeable + +-- | Auxiliary type for 'ResponseSource'. +type WithSource m a b = (C.Source m a -> m b) -> m b + +-- | The size of the request body. In the case of chunked bodies, the size will +-- not be known. +-- +-- Since 1.4.0 +data RequestBodyLength = ChunkedBody | KnownLength Word64 + +-- | Information on which part to be sent. +-- Sophisticated application handles Range (and If-Range) then +-- create 'FilePart'. +data FilePart = FilePart + { filePartOffset :: Integer + , filePartByteCount :: Integer + , filePartFileSize :: Integer + } deriving Show diff --git a/wai.cabal b/wai.cabal --- a/wai.cabal +++ b/wai.cabal @@ -1,5 +1,5 @@ Name: wai -Version: 1.4.1 +Version: 2.0.0 Synopsis: Web Application Interface. Description: Provides a common protocol for communication between web applications and web servers. License: MIT @@ -20,11 +20,12 @@ Build-Depends: base >= 4 && < 5 , bytestring >= 0.9.1.4 , blaze-builder >= 0.2.1.4 && < 0.4 - , conduit >= 0.5 && < 1.1 + , conduit >= 1.0.8 && < 1.1 , network >= 2.2.1.5 , http-types >= 0.7 , text >= 0.7 , transformers >= 0.2.2 , vault >= 0.1 && < 0.4 Exposed-modules: Network.Wai + Network.Wai.Internal ghc-options: -Wall