diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for wai +## 3.2.5 + +* Add a `requestSendEarlyHints :: [Header] -> IO ()` field to `Request` for sending `103 Early Hints` responses. [#1085](https://github.com/yesodweb/wai/pull/1085) + ## 3.2.4 * Add helpers for modifying request headers: `modifyRequest` and `mapRequestHeaders`. [#710](https://github.com/yesodweb/wai/pull/710) [#952](https://github.com/yesodweb/wai/pull/952) diff --git a/Network/Wai.hs b/Network/Wai.hs --- a/Network/Wai.hs +++ b/Network/Wai.hs @@ -1,116 +1,136 @@ -{-| +-- Ignore deprecations, because this module needs to use the deprecated requestBody to construct a response. +{-# OPTIONS_GHC -fno-warn-deprecations #-} -This module defines a generic web application interface. It is a common -protocol between web servers and web applications. +-- | +-- +-- This module defines a generic web application interface. It is a common +-- protocol between web servers and web applications. +-- +-- The overriding design principles here are performance and generality. To +-- address performance, this library uses a streaming interface for request and +-- response bodies, paired with bytestring's 'Builder' type. The advantages of a +-- streaming API over lazy IO have been debated elsewhere and so will not be +-- addressed here. However, helper functions like 'responseLBS' allow you to +-- continue using lazy IO if you so desire. +-- +-- Generality is achieved by removing many variables commonly found in similar +-- projects that are not universal to all servers. The goal is that the 'Request' +-- object contains only data which is meaningful in all circumstances. +-- +-- Please remember when using this package that, while your application may +-- compile without a hitch against many different servers, there are other +-- considerations to be taken when moving to a new backend. For example, if you +-- transfer from a CGI application to a FastCGI one, you might suddenly find you +-- have a memory leak. Conversely, a FastCGI application would be well served to +-- preload all templates from disk when first starting; this would kill the +-- performance of a CGI application. +-- +-- This package purposely provides very little functionality. You can find various +-- middlewares, backends and utilities on Hackage. Some of the most commonly used +-- include: +-- +-- [warp] +-- +-- [wai-extra] +module Network.Wai ( + -- * Types + Application, + Middleware, + ResponseReceived, -The overriding design principles here are performance and generality. To -address performance, this library uses a streaming interface for request and -response bodies, paired with bytestring's 'Builder' type. The advantages of a -streaming API over lazy IO have been debated elsewhere and so will not be -addressed here. However, helper functions like 'responseLBS' allow you to -continue using lazy IO if you so desire. + -- * Request + Request, + defaultRequest, + RequestBodyLength (..), -Generality is achieved by removing many variables commonly found in similar -projects that are not universal to all servers. The goal is that the 'Request' -object contains only data which is meaningful in all circumstances. + -- ** Request accessors + requestMethod, + httpVersion, + rawPathInfo, + rawQueryString, + requestHeaders, + isSecure, + remoteHost, + pathInfo, + queryString, + getRequestBodyChunk, + requestBody, + vault, + requestBodyLength, + requestHeaderHost, + requestHeaderRange, + requestHeaderReferer, + requestHeaderUserAgent, + requestSendEarlyHints, + -- $streamingRequestBodies + strictRequestBody, + consumeRequestBodyStrict, + lazyRequestBody, + consumeRequestBodyLazy, -Please remember when using this package that, while your application may -compile without a hitch against many different servers, there are other -considerations to be taken when moving to a new backend. For example, if you -transfer from a CGI application to a FastCGI one, you might suddenly find you -have a memory leak. Conversely, a FastCGI application would be well served to -preload all templates from disk when first starting; this would kill the -performance of a CGI application. + -- ** Request modifiers + setRequestBodyChunks, + mapRequestHeaders, -This package purposely provides very little functionality. You can find various -middlewares, backends and utilities on Hackage. Some of the most commonly used -include: + -- * Response + Response, + StreamingBody, + FilePart (..), -[warp] + -- ** Response composers + responseFile, + responseBuilder, + responseLBS, + responseStream, + responseRaw, -[wai-extra] + -- ** Response accessors + responseStatus, + responseHeaders, --} --- Ignore deprecations, because this module needs to use the deprecated requestBody to construct a response. -{-# OPTIONS_GHC -fno-warn-deprecations #-} -module Network.Wai - ( - -- * Types - Application - , Middleware - , ResponseReceived - -- * Request - , Request - , defaultRequest - , RequestBodyLength (..) - -- ** Request accessors - , requestMethod - , httpVersion - , rawPathInfo - , rawQueryString - , requestHeaders - , isSecure - , remoteHost - , pathInfo - , queryString - , getRequestBodyChunk - , requestBody - , vault - , requestBodyLength - , requestHeaderHost - , requestHeaderRange - , requestHeaderReferer - , requestHeaderUserAgent - -- $streamingRequestBodies - , strictRequestBody - , consumeRequestBodyStrict - , lazyRequestBody - , consumeRequestBodyLazy - -- ** Request modifiers - , setRequestBodyChunks - , mapRequestHeaders - -- * Response - , Response - , StreamingBody - , FilePart (..) - -- ** Response composers - , responseFile - , responseBuilder - , responseLBS - , responseStream - , responseRaw - -- ** Response accessors - , responseStatus - , responseHeaders - -- ** Response modifiers - , responseToStream - , mapResponseHeaders - , mapResponseStatus - -- * Middleware composition - , ifRequest - , modifyRequest - , modifyResponse - ) where + -- ** Response modifiers + responseToStream, + mapResponseHeaders, + mapResponseStatus, -import Data.ByteString.Builder (Builder, byteString, lazyByteString) -import Control.Monad (unless) -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as L + -- * Middleware composition + ifRequest, + modifyRequest, + modifyResponse, +) where + +import Control.Monad (unless) +import qualified Data.ByteString as B +import Data.ByteString.Builder ( + Builder, + byteString, + lazyByteString, + ) +import qualified Data.ByteString.Lazy as L +import Data.ByteString.Lazy.Internal (defaultChunkSize) import qualified Data.ByteString.Lazy.Internal as LI -import Data.ByteString.Lazy.Internal (defaultChunkSize) -import Data.Function (fix) -import qualified Network.HTTP.Types as H -import Network.Socket (SockAddr (SockAddrInet)) -import Network.Wai.Internal -import qualified System.IO as IO -import System.IO.Unsafe (unsafeInterleaveIO) +import Data.Function (fix) +import qualified Network.HTTP.Types as H +import Network.Socket (SockAddr (SockAddrInet)) +import Network.Wai.Internal +import qualified System.IO as IO +import System.IO.Unsafe (unsafeInterleaveIO) ---------------------------------------------------------------- -- | Creating 'Response' from a file. -- +-- Server implementations like @warp@ might disregard the t'Status' when +-- using 'responseFile', since the server might rework the response based on +-- headers or presence/absence of the file. +-- @warp@ does not do do any extra processing when sending file parts, though, +-- so be mindful of how each server implementation handles file responses. +-- +-- /The above was written when @warp-3.4.14@ was the newest version/ +-- -- @since 2.0.0 -responseFile :: H.Status -> H.ResponseHeaders -> FilePath -> Maybe FilePart -> Response +responseFile + :: H.Status -> H.ResponseHeaders -> FilePath -> Maybe FilePart -> Response responseFile = ResponseFile -- | Creating 'Response' from 'Builder'. @@ -170,10 +190,11 @@ -- and response headers to depend on the scarce resource. -- -- @since 3.0.0 -responseStream :: H.Status - -> H.ResponseHeaders - -> StreamingBody - -> Response +responseStream + :: H.Status + -> H.ResponseHeaders + -> StreamingBody + -> Response responseStream = ResponseStream -- | Create a response for a raw application. This is useful for \"upgrade\" @@ -187,9 +208,10 @@ -- @responseRaw@, behavior is undefined. -- -- @since 2.1.0 -responseRaw :: (IO B.ByteString -> (B.ByteString -> IO ()) -> IO ()) - -> Response - -> Response +responseRaw + :: (IO B.ByteString -> (B.ByteString -> IO ()) -> IO ()) + -> Response + -> Response responseRaw = ResponseRaw ---------------------------------------------------------------- @@ -198,28 +220,29 @@ -- -- @since 1.2.0 responseStatus :: Response -> H.Status -responseStatus (ResponseFile s _ _ _) = s -responseStatus (ResponseBuilder s _ _ ) = s -responseStatus (ResponseStream s _ _ ) = s -responseStatus (ResponseRaw _ res ) = responseStatus res +responseStatus (ResponseFile s _ _ _) = s +responseStatus (ResponseBuilder s _ _) = s +responseStatus (ResponseStream s _ _) = s +responseStatus (ResponseRaw _ res) = responseStatus res -- | Accessing 'H.ResponseHeaders' in 'Response'. -- -- @since 2.0.0 responseHeaders :: Response -> H.ResponseHeaders -responseHeaders (ResponseFile _ hs _ _) = hs -responseHeaders (ResponseBuilder _ hs _ ) = hs -responseHeaders (ResponseStream _ hs _ ) = hs -responseHeaders (ResponseRaw _ res) = responseHeaders res +responseHeaders (ResponseFile _ hs _ _) = hs +responseHeaders (ResponseBuilder _ hs _) = hs +responseHeaders (ResponseStream _ hs _) = hs +responseHeaders (ResponseRaw _ res) = responseHeaders res -- | Converting the body information in 'Response' to a 'StreamingBody'. -- -- @since 3.0.0 -responseToStream :: Response - -> ( H.Status - , H.ResponseHeaders - , (StreamingBody -> IO a) -> IO a - ) +responseToStream + :: Response + -> ( H.Status + , H.ResponseHeaders + , (StreamingBody -> IO a) -> IO a + ) responseToStream (ResponseStream s h b) = (s, h, ($ b)) responseToStream (ResponseFile s h fp (Just part)) = ( s @@ -239,7 +262,7 @@ ( s , h , \withBody -> IO.withBinaryFile fp IO.ReadMode $ \handle -> - withBody $ \sendChunk _flush -> fix $ \loop -> do + withBody $ \sendChunk _flush -> fix $ \loop -> do bs <- B.hGetSome handle defaultChunkSize unless (B.null bs) $ do sendChunk $ byteString bs @@ -252,7 +275,8 @@ -- | Apply the provided function to the response header list of the Response. -- -- @since 3.0.3.0 -mapResponseHeaders :: (H.ResponseHeaders -> H.ResponseHeaders) -> Response -> Response +mapResponseHeaders + :: (H.ResponseHeaders -> H.ResponseHeaders) -> Response -> Response mapResponseHeaders f (ResponseFile s h b1 b2) = ResponseFile s (f h) b1 b2 mapResponseHeaders f (ResponseBuilder s h b) = ResponseBuilder s (f h) b mapResponseHeaders f (ResponseStream s h b) = ResponseStream s (f h) b @@ -282,32 +306,33 @@ -- (putStrLn \"Cleaning up\") -- (respond $ responseLBS status200 [] \"Hello World\") -- @ -type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived - +type Application = + Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived -- | A default, blank request. -- -- @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 B.empty - , vault = mempty - , requestBodyLength = KnownLength 0 - , requestHeaderHost = Nothing - , requestHeaderRange = Nothing - , requestHeaderReferer = Nothing - , requestHeaderUserAgent = Nothing - } - +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 B.empty + , vault = mempty + , requestBodyLength = KnownLength 0 + , requestHeaderHost = Nothing + , requestHeaderRange = Nothing + , requestHeaderReferer = Nothing + , requestHeaderUserAgent = Nothing + , requestSendEarlyHints = \_ -> return () + } -- | A @Middleware@ is a component that sits between the server and application. -- @@ -451,7 +476,6 @@ -- However, modifying the response (especially the response body) is not trivial, -- so in order to get a sense of how to do it (dealing with the type of 'responseToStream'), -- it’s best to look at an example, for example . - type Middleware = Application -> Application -- | Apply a function that modifies a request as a 'Middleware' @@ -472,7 +496,7 @@ ifRequest :: (Request -> Bool) -> Middleware -> Middleware ifRequest rpred middle app req | rpred req = middle app req - | otherwise = app req + | otherwise = app req -- $streamingRequestBodies -- @@ -576,5 +600,6 @@ -- | Apply the provided function to the request header list of the 'Request'. -- -- @since 3.2.4 -mapRequestHeaders :: (H.RequestHeaders -> H.RequestHeaders) -> Request -> Request -mapRequestHeaders f request = request { requestHeaders = f (requestHeaders request) } +mapRequestHeaders + :: (H.RequestHeaders -> H.RequestHeaders) -> Request -> Request +mapRequestHeaders f request = request{requestHeaders = f (requestHeaders request)} diff --git a/Network/Wai/Internal.hs b/Network/Wai/Internal.hs --- a/Network/Wai/Internal.hs +++ b/Network/Wai/Internal.hs @@ -1,95 +1,108 @@ -{-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_HADDOCK not-home #-} + -- | Internal constructors and helper functions. Note that no guarantees are -- given for stability of these interfaces. module Network.Wai.Internal where -import Data.ByteString.Builder (Builder) -import qualified Data.ByteString as B -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 Network.Socket (SockAddr) -import Data.List (intercalate) +import qualified Data.ByteString as B +import Data.ByteString.Builder (Builder) +import Data.List (intercalate) +import Data.Text (Text) +import Data.Vault.Lazy (Vault) +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. -{-# DEPRECATED requestBody "requestBody's name is misleading because it only gets a partial chunk of the body. Use getRequestBodyChunk instead when getting the field, and setRequestBodyChunks when setting the field." #-} -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. - -- - -- Middlewares and routing tools should not modify this raw value, as it may - -- be used for such things as creating redirect destinations by applications. - -- Instead, if you are writing a middleware or routing framework, modify the - -- @pathInfo@ instead. This is the approach taken by systems like Yesod - -- subsites. - -- - -- /Note/: At the time of writing this documentation, there is at least one - -- system (@Network.Wai.UrlMap@ from @wai-extra@) that does not follow the - -- above recommendation. Therefore, it is recommended that you test the - -- behavior of your application when using @rawPathInfo@ and any form of - -- library that might modify the @Request@. - , 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 headers (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 - -- | Get the next chunk of the body. Returns 'B.empty' when the - -- body is fully consumed. Since 3.2.2, this is deprecated in favor of 'getRequestBodyChunk'. - , requestBody :: 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 - -- | 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) +{-# DEPRECATED + requestBody + "requestBody's name is misleading because it only gets a partial chunk of the body. Use getRequestBodyChunk instead when getting the field, and setRequestBodyChunks when setting the field." + #-} +data Request = Request + { requestMethod :: H.Method + -- ^ Request method such as GET. + , httpVersion :: H.HttpVersion + -- ^ HTTP version such as 1.1. + , rawPathInfo :: B.ByteString + -- ^ 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. + -- + -- Middlewares and routing tools should not modify this raw value, as it may + -- be used for such things as creating redirect destinations by applications. + -- Instead, if you are writing a middleware or routing framework, modify the + -- @pathInfo@ instead. This is the approach taken by systems like Yesod + -- subsites. + -- + -- /Note/: At the time of writing this documentation, there is at least one + -- system (@Network.Wai.UrlMap@ from @wai-extra@) that does not follow the + -- above recommendation. Therefore, it is recommended that you test the + -- behavior of your application when using @rawPathInfo@ and any form of + -- library that might modify the @Request@. + , rawQueryString :: 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. + , requestHeaders :: H.RequestHeaders + -- ^ A list of headers (a pair of key and value) in an HTTP request. + , isSecure :: Bool + -- ^ 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. + , remoteHost :: SockAddr + -- ^ The client\'s host information. + , pathInfo :: [Text] + -- ^ Path info in individual pieces - the URL without a hostname/port and + -- without a query string, split on forward slashes. + , queryString :: H.Query + -- ^ Parsed query string information. + , requestBody :: IO B.ByteString + -- ^ Get the next chunk of the body. Returns 'B.empty' when the + -- body is fully consumed. Since 3.2.2, this is deprecated in favor of 'getRequestBodyChunk'. + , vault :: Vault + -- ^ A location for arbitrary data to be shared by applications and middleware. + , requestBodyLength :: RequestBodyLength + -- ^ The size of the request body. In the case of a chunked request body, + -- this may be unknown. + -- + -- @since 1.4.0 + , requestHeaderHost :: Maybe B.ByteString + -- ^ The value of the Host header in a HTTP request. + -- + -- @since 2.0.0 + , requestHeaderRange :: Maybe B.ByteString + -- ^ The value of the Range header in a HTTP request. + -- + -- @since 2.0.0 + , requestHeaderReferer :: Maybe B.ByteString + -- ^ The value of the Referer header in a HTTP request. + -- + -- @since 3.2.0 + , requestHeaderUserAgent :: Maybe B.ByteString + -- ^ The value of the User-Agent header in a HTTP request. + -- + -- @since 3.2.0 + , requestSendEarlyHints :: H.ResponseHeaders -> IO () + -- ^ Send a @103 Early Hints@ informational response carrying the given + -- headers, ahead of the final response. This lets a client (typically over + -- HTTP\/2) start fetching resources named in @Link@ headers while the final + -- response is still being produced. + -- + -- A handler (e.g. Warp over HTTP\/2) that supports early hints installs an + -- action here; otherwise it is a no-op. + -- + -- @since 3.2.5 + } + -- | Get the next chunk of the body. Returns 'B.empty' when the -- body is fully consumed. -- @@ -106,35 +119,33 @@ -- @since 3.2.4 setRequestBodyChunks :: IO B.ByteString -> Request -> Request setRequestBodyChunks requestBody r = - r {requestBody = requestBody} + r{requestBody = requestBody} instance Show Request where - show Request{..} = "Request {" ++ intercalate ", " [a ++ " = " ++ b | (a,b) <- fields] ++ "}" - where - fields = - [("requestMethod",show requestMethod) - ,("httpVersion",show httpVersion) - ,("rawPathInfo",show rawPathInfo) - ,("rawQueryString",show rawQueryString) - ,("requestHeaders",show requestHeaders) - ,("isSecure",show isSecure) - ,("remoteHost",show remoteHost) - ,("pathInfo",show pathInfo) - ,("queryString",show queryString) - ,("requestBody","") - ,("vault","") - ,("requestBodyLength",show requestBodyLength) - ,("requestHeaderHost",show requestHeaderHost) - ,("requestHeaderRange",show requestHeaderRange) - ] - + show Request{..} = "Request {" ++ intercalate ", " [a ++ " = " ++ b | (a, b) <- fields] ++ "}" + where + fields = + [ ("requestMethod", show requestMethod) + , ("httpVersion", show httpVersion) + , ("rawPathInfo", show rawPathInfo) + , ("rawQueryString", show rawQueryString) + , ("requestHeaders", show requestHeaders) + , ("isSecure", show isSecure) + , ("remoteHost", show remoteHost) + , ("pathInfo", show pathInfo) + , ("queryString", show queryString) + , ("requestBody", "") + , ("vault", "") + , ("requestBodyLength", show requestBodyLength) + , ("requestHeaderHost", show requestHeaderHost) + , ("requestHeaderRange", show requestHeaderRange) + ] data Response = ResponseFile H.Status H.ResponseHeaders FilePath (Maybe FilePart) | ResponseBuilder H.Status H.ResponseHeaders Builder | ResponseStream H.Status H.ResponseHeaders StreamingBody | ResponseRaw (IO B.ByteString -> (B.ByteString -> IO ()) -> IO ()) Response - deriving Typeable -- | Represents a streaming HTTP response body. It's a function of two -- parameters; the first parameter provides a means of sending another chunk of @@ -148,7 +159,7 @@ -- not be known. -- -- @since 1.4.0 -data RequestBodyLength = ChunkedBody | KnownLength Word64 deriving Show +data RequestBodyLength = ChunkedBody | KnownLength Word64 deriving (Show) -- | Information on which part to be sent. -- Sophisticated application handles Range (and If-Range) then @@ -156,10 +167,11 @@ -- -- @since 0.4.0 data FilePart = FilePart - { filePartOffset :: Integer + { filePartOffset :: Integer , filePartByteCount :: Integer - , filePartFileSize :: Integer - } deriving Show + , filePartFileSize :: Integer + } + deriving (Show) -- | A special datatype to indicate that the WAI handler has received the -- response. This is to avoid the need for Rank2Types in the definition of @@ -170,4 +182,3 @@ -- -- @since 3.0.0 data ResponseReceived = ResponseReceived - deriving Typeable diff --git a/test/Network/WaiSpec.hs b/test/Network/WaiSpec.hs --- a/test/Network/WaiSpec.hs +++ b/test/Network/WaiSpec.hs @@ -1,15 +1,16 @@ {-# LANGUAGE LambdaCase #-} + module Network.WaiSpec (spec) where -import Test.Hspec -import Test.Hspec.QuickCheck (prop) -import Network.Wai -import Data.Word (Word8) -import Data.IORef +import Control.Monad (forM_) import qualified Data.ByteString as S -import qualified Data.ByteString.Lazy as L import Data.ByteString.Builder (Builder, toLazyByteString, word8) -import Control.Monad (forM_) +import qualified Data.ByteString.Lazy as L +import Data.IORef +import Data.Word (Word8) +import Network.Wai +import Test.Hspec +import Test.Hspec.QuickCheck (prop) spec :: Spec spec = do @@ -29,8 +30,11 @@ body <- getBody $ responseLBS undefined undefined $ L.pack bytes body `shouldBe` S.pack bytes prop "responseBuilder" $ \bytes -> do - body <- getBody $ responseBuilder undefined undefined - $ mconcat $ map word8 bytes + body <- + getBody $ + responseBuilder undefined undefined $ + mconcat $ + map word8 bytes body `shouldBe` S.pack bytes prop "responseStream" $ \chunks -> do body <- getBody $ responseStream undefined undefined $ \sendChunk _ -> @@ -47,11 +51,15 @@ let total = S.length totalBS offset = abs offset' `mod` total count = abs count' `mod` (total - offset) - body <- getBody $ responseFile undefined undefined fp $ Just FilePart - { filePartOffset = fromIntegral offset - , filePartByteCount = fromIntegral count - , filePartFileSize = fromIntegral total - } + body <- + getBody $ + responseFile undefined undefined fp $ + Just + FilePart + { filePartOffset = fromIntegral offset + , filePartByteCount = fromIntegral count + , filePartFileSize = fromIntegral total + } let expected = S.take count $ S.drop offset totalBS body `shouldBe` expected describe "lazyRequestBody" $ do @@ -76,4 +84,4 @@ flip setRequestBodyChunks defaultRequest $ atomicModifyIORef ref $ \case [] -> ([], S.empty) - x:y -> (y, x) + x : y -> (y, x) diff --git a/wai.cabal b/wai.cabal --- a/wai.cabal +++ b/wai.cabal @@ -1,6 +1,6 @@ Cabal-Version: >=1.10 Name: wai -Version: 3.2.4 +Version: 3.2.5 Synopsis: Web Application Interface. Description: Provides a common protocol for communication between web applications and web servers. . @@ -17,7 +17,8 @@ Source-repository head type: git - location: git://github.com/yesodweb/wai.git + location: https://github.com/yesodweb/wai.git + subdir: wai Library default-language: Haskell2010 @@ -44,7 +45,3 @@ , bytestring other-modules: Network.WaiSpec build-tool-depends: hspec-discover:hspec-discover - -source-repository head - type: git - location: git://github.com/yesodweb/wai.git