Merge pull request #952 from Vlix/wai-request-functions

`wai` request modifying functions

wai/ChangeLog.md

@@ -1,11 +1,10 @@
 # ChangeLog for wai
 
-## 3.2.5
-
-* Add `setRequestBodyChunks` to mirror `getRequestBodyChunk` and avoid deprecation warnings when using `requestBody` as a setter. [#949](https://github.com/yesodweb/wai/pull/949)
-
 ## 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)
+* Small documentation adjustments like adding more `@since` markers. [#952](https://github.com/yesodweb/wai/pull/952)
+* Add `setRequestBodyChunks` to mirror `getRequestBodyChunk` and avoid deprecation warnings when using `requestBody` as a setter. [#949](https://github.com/yesodweb/wai/pull/949)
 * Overhaul documentation of `Middleware`. [#858](https://github.com/yesodweb/wai/pull/858)
 
 ## 3.2.3
@@ -42,23 +41,23 @@
 
 * Major version up due to breaking changes. We chose 3.2.0, not 3.1.0
   for consistency with Warp 3.2.0.
-* The Network.Wai.HTTP2 module was removed.
-* tryGetFileSize, hContentRange, hAcceptRanges, contentRangeHeader and
-  chooseFilePart, adjustForFilePart and parseByteRanges were removed
-  from the Network.Wai.Internal module.
-* New fields for Request:  requestHeaderReferer and requestHeaderUserAgent.
+* The `Network.Wai.HTTP2` module was removed.
+* `tryGetFileSize`, `hContentRange`, `hAcceptRanges`, `contentRangeHeader` and
+  `chooseFilePart`, `adjustForFilePart` and `parseByteRanges` were removed
+  from the `Network.Wai.Internal` module.
+* New fields for `Request`: `requestHeaderReferer` and `requestHeaderUserAgent`.
 
 ## 3.0.5.0
 
-* Avoid using the IsString Builder instance
+* Avoid using the `IsString` Builder instance
 
 ## 3.0.4.0
 
-* A new module Network.Wai.HTTP2 is exported.
+* A new module `Network.Wai.HTTP2` is exported.
 
 ## 3.0.3.0
 
-* mapResponseHeaders, ifRequest and modifyResponse are exported.
+* `mapResponseHeaders`, `ifRequest` and `modifyResponse` are exported.
 
 ## 3.0.2.3
 

wai/Network/Wai.hs

@@ -53,7 +53,6 @@ module Network.Wai
     , remoteHost
     , pathInfo
     , queryString
-    , setRequestBodyChunks
     , getRequestBodyChunk
     , requestBody
     , vault
@@ -67,6 +66,9 @@ module Network.Wai
     , consumeRequestBodyStrict
     , lazyRequestBody
     , consumeRequestBodyLazy
+      -- ** Request modifiers
+    , setRequestBodyChunks
+    , mapRequestHeaders
       -- * Response
     , Response
     , StreamingBody
@@ -86,6 +88,7 @@ module Network.Wai
     , mapResponseStatus
       -- * Middleware composition
     , ifRequest
+    , modifyRequest
     , modifyResponse
     ) where
 
@@ -95,7 +98,6 @@ import qualified Data.ByteString              as B
 import qualified Data.ByteString.Lazy         as L
 import qualified Data.ByteString.Lazy.Internal as LI
 import           Data.ByteString.Lazy.Internal (defaultChunkSize)
-import           Data.ByteString.Lazy.Char8   ()
 import           Data.Function                (fix)
 import qualified Network.HTTP.Types           as H
 import           Network.Socket               (SockAddr (SockAddrInet))
@@ -106,6 +108,8 @@ import           System.IO.Unsafe             (unsafeInterleaveIO)
 ----------------------------------------------------------------
 
 -- | Creating 'Response' from a file.
+--
+-- @since 2.0.0
 responseFile :: H.Status -> H.ResponseHeaders -> FilePath -> Maybe FilePart -> Response
 responseFile = ResponseFile
 
@@ -132,11 +136,15 @@ responseFile = ResponseFile
 --
 -- A3. You can force a Builder to output a ByteString before it is an
 -- optimal size by sending a flush command.
+--
+-- @since 2.0.0
 responseBuilder :: H.Status -> H.ResponseHeaders -> Builder -> Response
 responseBuilder = ResponseBuilder
 
 -- | Creating 'Response' from 'L.ByteString'. This is a wrapper for
 --   'responseBuilder'.
+--
+-- @since 0.3.0
 responseLBS :: H.Status -> H.ResponseHeaders -> L.ByteString -> Response
 responseLBS s h = ResponseBuilder s h . lazyByteString
 
@@ -161,7 +169,7 @@ responseLBS s h = ResponseBuilder s h . lazyByteString
 -- as well. However, placing the call on the outside allows your status value
 -- and response headers to depend on the scarce resource.
 --
--- Since 3.0.0
+-- @since 3.0.0
 responseStream :: H.Status
                -> H.ResponseHeaders
                -> StreamingBody
@@ -178,7 +186,7 @@ responseStream = ResponseStream
 -- In the event that you read from the request body before returning a
 -- @responseRaw@, behavior is undefined.
 --
--- Since 2.1.0
+-- @since 2.1.0
 responseRaw :: (IO B.ByteString -> (B.ByteString -> IO ()) -> IO ())
             -> Response
             -> Response
@@ -187,20 +195,26 @@ responseRaw = ResponseRaw
 ----------------------------------------------------------------
 
 -- | Accessing 'H.Status' in 'Response'.
+--
+-- @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
 
 -- | 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
 
 -- | Converting the body information in 'Response' to a 'StreamingBody'.
+--
+-- @since 3.0.0
 responseToStream :: Response
                  -> ( H.Status
                     , H.ResponseHeaders
@@ -236,13 +250,17 @@ responseToStream (ResponseBuilder s h b) =
 responseToStream (ResponseRaw _ res) = responseToStream res
 
 -- | 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 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
 mapResponseHeaders _ r@(ResponseRaw _ _) = r
 
 -- | Apply the provided function to the response status of the Response.
+--
+-- @since 3.2.1
 mapResponseStatus :: (H.Status -> H.Status) -> Response -> Response
 mapResponseStatus f (ResponseFile s h b1 b2) = ResponseFile (f s) h b1 b2
 mapResponseStatus f (ResponseBuilder s h b) = ResponseBuilder (f s) h b
@@ -269,7 +287,7 @@ type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseRe
 
 -- | A default, blank request.
 --
--- Since 2.0.0
+-- @since 2.0.0
 defaultRequest :: Request
 defaultRequest = Request
     { requestMethod = H.methodGet
@@ -436,16 +454,25 @@ defaultRequest = Request
 
 type Middleware = Application -> Application
 
+-- | Apply a function that modifies a request as a 'Middleware'
+--
+-- @since 3.2.4
+modifyRequest :: (Request -> Request) -> Middleware
+modifyRequest f app = app . f
 
--- | apply a function that modifies a response as a 'Middleware'
+-- | Apply a function that modifies a response as a 'Middleware'
+--
+-- @since 3.0.3.0
 modifyResponse :: (Response -> Response) -> Middleware
 modifyResponse f app req respond = app req $ respond . f
 
-
--- | conditionally apply a 'Middleware'
+-- | Conditionally apply a 'Middleware'
+--
+-- @since 3.0.3.0
 ifRequest :: (Request -> Bool) -> Middleware -> Middleware
-ifRequest rpred middle app req | rpred req = middle app req
-                               | otherwise =        app req
+ifRequest rpred middle app req
+    | rpred req = middle app req
+    | otherwise =        app req
 
 -- $streamingRequestBodies
 --
@@ -503,7 +530,7 @@ ifRequest rpred middle app req | rpred req = middle app req
 --
 -- Note: Since this function consumes the request body, future calls to it will return the empty string.
 --
--- Since 3.0.1
+-- @since 3.0.1
 strictRequestBody :: Request -> IO L.ByteString
 strictRequestBody req =
     loop id
@@ -526,7 +553,7 @@ consumeRequestBodyStrict = strictRequestBody
 --
 -- Note: Since this function consumes the request body, future calls to it will return the empty string.
 --
--- Since 1.4.1
+-- @since 1.4.1
 lazyRequestBody :: Request -> IO L.ByteString
 lazyRequestBody req =
     loop
@@ -545,3 +572,9 @@ lazyRequestBody req =
 -- @since 3.2.3
 consumeRequestBodyLazy :: Request -> IO L.ByteString
 consumeRequestBodyLazy = lazyRequestBody
+
+-- | 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) }

wai/Network/Wai/Internal.hs

@@ -1,12 +1,11 @@
 {-# OPTIONS_HADDOCK not-home #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE RecordWildCards #-}
 -- | 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 hiding (pack)
+import qualified Data.ByteString              as B
 import           Data.Text                    (Text)
 import           Data.Typeable                (Typeable)
 import           Data.Vault.Lazy              (Vault)
@@ -17,7 +16,7 @@ import           Data.List                    (intercalate)
 
 -- | 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." #-}
+{-# 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
@@ -70,23 +69,23 @@ data Request = Request {
   -- | The size of the request body. In the case of a chunked request body,
   -- this may be unknown.
   --
-  -- Since 1.4.0
+  -- @since 1.4.0
   ,  requestBodyLength     :: RequestBodyLength
   -- | The value of the Host header in a HTTP request.
   --
-  -- Since 2.0.0
+  -- @since 2.0.0
   ,  requestHeaderHost     :: Maybe B.ByteString
   -- | The value of the Range header in a HTTP request.
   --
-  -- Since 2.0.0
+  -- @since 2.0.0
   ,  requestHeaderRange   :: Maybe B.ByteString
   -- | The value of the Referer header in a HTTP request.
   --
-  -- Since 3.2.0
+  -- @since 3.2.0
   ,  requestHeaderReferer   :: Maybe B.ByteString
   -- | The value of the User-Agent header in a HTTP request.
   --
-  -- Since 3.2.0
+  -- @since 3.2.0
   ,  requestHeaderUserAgent :: Maybe B.ByteString
   }
   deriving (Typeable)
@@ -142,18 +141,20 @@ data Response
 -- data, and the second parameter provides a means of flushing the data to the
 -- client.
 --
--- Since 3.0.0
+-- @since 3.0.0
 type StreamingBody = (Builder -> IO ()) -> IO () -> IO ()
 
 -- | The size of the request body. In the case of chunked bodies, the size will
 -- not be known.
 --
--- Since 1.4.0
+-- @since 1.4.0
 data RequestBodyLength = ChunkedBody | KnownLength Word64 deriving Show
 
 -- | Information on which part to be sent.
 --   Sophisticated application handles Range (and If-Range) then
 --   create 'FilePart'.
+--
+-- @since 0.4.0
 data FilePart = FilePart
     { filePartOffset    :: Integer
     , filePartByteCount :: Integer
@@ -167,6 +168,6 @@ data FilePart = FilePart
 -- It is /highly/ advised that only WAI handlers import and use the data
 -- constructor for this data type.
 --
--- Since 3.0.0
+-- @since 3.0.0
 data ResponseReceived = ResponseReceived
     deriving Typeable

wai/test/Network/WaiSpec.hs

@@ -1,8 +1,10 @@
+{-# 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 qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
@@ -54,29 +56,24 @@ spec = do
             body `shouldBe` expected
     describe "lazyRequestBody" $ do
         prop "works" $ \chunks -> do
-            ref <- newIORef $ map S.pack $ filter (not . null) chunks
-            let req = defaultRequest
-                        { requestBody = atomicModifyIORef ref $ \bss ->
-                            case bss of
-                                [] -> ([], S.empty)
-                                x:y -> (y, x)
-                        }
+            req <- mkRequestFromChunks chunks
             body <- lazyRequestBody req
             body `shouldBe` L.fromChunks (map S.pack chunks)
         it "is lazy" $ do
-            let req = defaultRequest
-                        { requestBody = error "requestBody"
-                        }
+            let req = setRequestBodyChunks (error "requestBody") defaultRequest
             _ <- lazyRequestBody req
             return ()
     describe "strictRequestBody" $ do
         prop "works" $ \chunks -> do
-            ref <- newIORef $ map S.pack $ filter (not . null) chunks
-            let req = defaultRequest
-                        { requestBody = atomicModifyIORef ref $ \bss ->
-                            case bss of
-                                [] -> ([], S.empty)
-                                x:y -> (y, x)
-                        }
+            req <- mkRequestFromChunks chunks
             body <- strictRequestBody req
             body `shouldBe` L.fromChunks (map S.pack chunks)
+
+mkRequestFromChunks :: [[Word8]] -> IO Request
+mkRequestFromChunks chunks = do
+    ref <- newIORef $ map S.pack $ filter (not . null) chunks
+    pure $
+        flip setRequestBodyChunks defaultRequest $
+            atomicModifyIORef ref $ \case
+                [] -> ([], S.empty)
+                x:y -> (y, x)

wai/wai.cabal

@@ -1,6 +1,6 @@
 Cabal-Version:       >=1.10
 Name:                wai
-Version:             3.2.5
+Version:             3.2.4
 Synopsis:            Web Application Interface.
 Description:         Provides a common protocol for communication between web applications and web servers.
                      .