wai-3.2.1.1/ 0000755 0000000 0000000 00000000000 12720741000 010613 5 ustar 00 0000000 0000000 wai-3.2.1.1/ChangeLog.md 0000644 0000000 0000000 00000001734 12720741000 012771 0 ustar 00 0000000 0000000 ## 3.2.1.1
* Relax upper bound on bytestring-builder
## 3.2.1
* add mapResponseStatus [#532](https://github.com/yesodweb/wai/pull/532)
## 3.2.0.1
* Add missing changelog entry
## 3.2.0
* 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.
## 3.0.5.0
* Avoid using the IsString Builder instance
## 3.0.4.0
* A new module Network.Wai.HTTP2 is exported.
## 3.0.3.0
* mapResponseHeaders, ifRequest and modifyResponse are exported.
## 3.0.2.3
* Allow blaze-builder 0.4
## 3.0.2.2
* Clarify some documentation on `rawPathInfo`. [Relevant Github
discussion](https://github.com/yesodweb/wai/issues/325#issuecomment-69896780).
wai-3.2.1.1/LICENSE 0000644 0000000 0000000 00000002075 12720741000 011624 0 ustar 00 0000000 0000000 Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
"Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject to
the following conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
wai-3.2.1.1/README.md 0000644 0000000 0000000 00000005257 12720741000 012103 0 ustar 00 0000000 0000000 WAI: Web Application Interface
==============================
Getting started
---------------
You want a minimal example? Here it is!
~~~ {.haskell}
{-# LANGUAGE OverloadedStrings #-}
import Network.Wai
import Network.HTTP.Types
import Network.Wai.Handler.Warp (run)
app :: Application
app _ respond = do
putStrLn "I've done some IO here"
respond $ responseLBS
status200
[("Content-Type", "text/plain")]
"Hello, Web!"
main :: IO ()
main = do
putStrLn $ "http://localhost:8080/"
run 8080 app
~~~
Put that code into a file named _hello.hs_ and install [wai] and [warp] from Hackage:
cabal install wai warp
Run it:
runhaskell hello.hs
Point your browser to:
http://localhost:8080/
Serving static content
----------------------
We can modify our previous example to serve static content. For this create a file named _index.html_:
Hello, Web!
Now we redefine `responseBody` to refer to that file:
~~~ {.haskell}
app2 :: Application
app2 _ respond = respond index
index :: Response
index = responseFile
status200
[("Content-Type", "text/html")]
"index.html"
Nothing
~~~
Basic dispatching
-----------------
An `Application` maps `Request`s to `Response`s:
ghci> :info Application
type Application = Request -> IO Response
Depending on the path info provided with each `Request` we can serve different `Response`s:
~~~ {.haskell}
app3 :: Application
app3 request respond = respond $ case rawPathInfo request of
"/" -> index
"/raw/" -> plainIndex
_ -> notFound
plainIndex :: Response
plainIndex = responseFile
status200
[("Content-Type", "text/plain")]
"index.html"
Nothing
notFound :: Response
notFound = responseLBS
status404
[("Content-Type", "text/plain")]
"404 - Not Found"
~~~
Doing without overloaded strings
--------------------------------
For the sake of efficiency, WAI uses the [bytestring] package. We used GHCs [overloaded strings] to almost hide this fact. But we can easily do without. What follows is a more verbose definition of `notFound`, that works without GHC extensions:
~~~ {.haskell .ignore}
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as LB8
import Data.CaseInsensitive (mk)
notFound = responseLBS
status404
[(mk $ B8.pack "Content-Type", B8.pack "text/plain")]
(LB8.pack "404 - Not Found")
~~~
[wai]: http://hackage.haskell.org/package/wai
[warp]: http://hackage.haskell.org/package/warp
[overloaded strings]: http://www.haskell.org/ghc/docs/latest/html/users_guide/type-class-extensions.html#overloaded-strings
[bytestring]: http://hackage.haskell.org/package/bytestring
wai-3.2.1.1/Setup.lhs 0000644 0000000 0000000 00000000162 12720741000 012422 0 ustar 00 0000000 0000000 #!/usr/bin/env runhaskell
> module Main where
> import Distribution.Simple
> main :: IO ()
> main = defaultMain
wai-3.2.1.1/wai.cabal 0000644 0000000 0000000 00000003455 12720741000 012366 0 ustar 00 0000000 0000000 Name: wai
Version: 3.2.1.1
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 .
License: MIT
License-file: LICENSE
Author: Michael Snoyman
Maintainer: michael@snoyman.com
Homepage: https://github.com/yesodweb/wai
Category: Web
Build-Type: Simple
Cabal-Version: >=1.8
Stability: Stable
extra-source-files: README.md ChangeLog.md
Source-repository head
type: git
location: git://github.com/yesodweb/wai.git
Library
Build-Depends: base >= 4 && < 5
, bytestring >= 0.10
, bytestring-builder >= 0.10.4.0 && < 0.11
, blaze-builder >= 0.2.1.4 && < 0.5
, network >= 2.2.1.5
, http-types >= 0.7
, text >= 0.7
, transformers >= 0.0
, vault >= 0.3 && < 0.4
Exposed-modules: Network.Wai
Network.Wai.Internal
ghc-options: -Wall
test-suite test
hs-source-dirs: test
main-is: Spec.hs
type: exitcode-stdio-1.0
ghc-options: -threaded
cpp-options: -DTEST
build-depends: base
, wai
, hspec
, blaze-builder
, bytestring
other-modules: Network.WaiSpec
source-repository head
type: git
location: git://github.com/yesodweb/wai.git
wai-3.2.1.1/Network/ 0000755 0000000 0000000 00000000000 12720741000 012244 5 ustar 00 0000000 0000000 wai-3.2.1.1/Network/Wai.hs 0000644 0000000 0000000 00000030734 12720741000 013327 0 ustar 00 0000000 0000000 {-# LANGUAGE Rank2Types #-}
{-# LANGUAGE CPP #-}
{-|
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 is built on top of the conduit and
blaze-builder packages. The advantages of conduits 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]
[wai-test]
-}
module Network.Wai
(
-- * Types
Application
, Middleware
, ResponseReceived
-- * Request
, Request
, defaultRequest
, RequestBodyLength (..)
-- ** Request accessors
, requestMethod
, httpVersion
, rawPathInfo
, rawQueryString
, requestHeaders
, isSecure
, remoteHost
, pathInfo
, queryString
, requestBody
, vault
, requestBodyLength
, requestHeaderHost
, requestHeaderRange
, requestHeaderReferer
, requestHeaderUserAgent
, strictRequestBody
, lazyRequestBody
-- * Response
, Response
, StreamingBody
, FilePart (..)
-- ** Response composers
, responseFile
, responseBuilder
, responseLBS
, responseStream
, responseRaw
-- ** Response accessors
, responseStatus
, responseHeaders
-- ** Response modifiers
, responseToStream
, mapResponseHeaders
, mapResponseStatus
-- * Middleware composition
, ifRequest
, modifyResponse
) where
import Blaze.ByteString.Builder (Builder, fromLazyByteString)
import Blaze.ByteString.Builder (fromByteString)
import Control.Monad (unless)
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 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
import System.IO.Unsafe (unsafeInterleaveIO)
----------------------------------------------------------------
-- | 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:
--
-- Q1. Shouldn't it be at the user's discretion to use Builders internally and
-- then create a stream of ByteStrings?
--
-- A1. That would be less efficient, as we wouldn't get cheap concatenation
-- with the response headers.
--
-- Q2. Isn't it really inefficient to convert from ByteString to Builder, and
-- then right back to ByteString?
--
-- A2. No. If the ByteStrings are small, then they will be copied into a larger
-- buffer, which should be a performance gain overall (less system calls). If
-- they are already large, then blaze-builder uses an InsertByteString
-- instruction to avoid copying.
--
-- Q3. Doesn't this prevent us from creating comet-style servers, since data
-- will be cached?
--
-- A3. You can force blaze-builder to output a ByteString before it is an
-- optimal size by sending a flush command.
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 a stream of values.
--
-- In order to allocate resources in an exception-safe manner, you can use the
-- @bracket@ pattern outside of the call to @responseStream@. As a trivial
-- example:
--
-- @
-- app :: Application
-- app req respond = bracket_
-- (putStrLn \"Allocating scarce resource\")
-- (putStrLn \"Cleaning up\")
-- $ respond $ responseStream status200 [] $ \\write flush -> do
-- write $ fromByteString \"Hello\\n\"
-- flush
-- write $ fromByteString \"World\\n\"
-- @
--
-- Note that in some cases you can use @bracket@ from inside @responseStream@
-- 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
responseStream :: H.Status
-> H.ResponseHeaders
-> StreamingBody
-> Response
responseStream = ResponseStream
-- | Create a response for a raw application. This is useful for \"upgrade\"
-- situations such as WebSockets, where an application requests for the server
-- to grant it raw network access.
--
-- This function requires a backup response to be provided, for the case where
-- the handler in question does not support such upgrading (e.g., CGI apps).
--
-- In the event that you read from the request body before returning a
-- @responseRaw@, behavior is undefined.
--
-- Since 2.1.0
responseRaw :: (IO B.ByteString -> (B.ByteString -> IO ()) -> IO ())
-> Response
-> Response
responseRaw = ResponseRaw
----------------------------------------------------------------
-- | Accessing 'H.Status' in 'Response'.
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'.
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'.
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
, h
, \withBody -> IO.withBinaryFile fp IO.ReadMode $ \handle -> withBody $ \sendChunk _flush -> do
IO.hSeek handle IO.AbsoluteSeek $ filePartOffset part
let loop remaining | remaining <= 0 = return ()
loop remaining = do
bs <- B.hGetSome handle defaultChunkSize
unless (B.null bs) $ do
let x = B.take remaining bs
sendChunk $ fromByteString x
loop $ remaining - B.length x
loop $ fromIntegral $ filePartByteCount part
)
responseToStream (ResponseFile s h fp Nothing) =
( s
, h
, \withBody -> IO.withBinaryFile fp IO.ReadMode $ \handle ->
withBody $ \sendChunk _flush -> fix $ \loop -> do
bs <- B.hGetSome handle defaultChunkSize
unless (B.null bs) $ do
sendChunk $ fromByteString bs
loop
)
responseToStream (ResponseBuilder s h b) =
(s, h, \withBody -> withBody $ \sendChunk _flush -> sendChunk b)
responseToStream (ResponseRaw _ res) = responseToStream res
-- | Apply the provided function to the response header list of the 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
mapResponseHeaders _ r@(ResponseRaw _ _) = r
-- | Apply the provided function to the response status of the Response.
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
mapResponseStatus f (ResponseStream s h b) = ResponseStream (f s) h b
mapResponseStatus _ r@(ResponseRaw _ _) = r
----------------------------------------------------------------
-- | The WAI application.
--
-- Note that, since WAI 3.0, this type is structured in continuation passing
-- style to allow for proper safe resource handling. This was handled in the
-- past via other means (e.g., @ResourceT@). As a demonstration:
--
-- @
-- app :: Application
-- app req respond = bracket_
-- (putStrLn \"Allocating scarce resource\")
-- (putStrLn \"Cleaning up\")
-- (respond $ responseLBS status200 [] \"Hello World\")
-- @
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
}
-- | 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
-- general definition of middleware, though a middleware author should feel
-- free to modify this.
--
-- As an example of an alternate type for middleware, suppose you write a
-- function to load up session information. The session information is simply a
-- string map \[(String, String)\]. A logical type signature for this middleware
-- might be:
--
-- @ loadSession :: ([(String, String)] -> Application) -> Application @
--
-- Here, instead of taking a standard 'Application' as its first argument, the
-- middleware takes a function which consumes the session information as well.
type Middleware = Application -> Application
-- | apply a function that modifies a response as a 'Middleware'
modifyResponse :: (Response -> Response) -> Middleware
modifyResponse f app req respond = app req $ respond . f
-- | conditionally apply a 'Middleware'
ifRequest :: (Request -> Bool) -> Middleware -> Middleware
ifRequest rpred middle app req | rpred req = middle app req
| otherwise = app req
-- | Get the request body as a lazy ByteString. However, do /not/ use any lazy
-- I\/O, instead reading the entire body into memory strictly.
--
-- Since 3.0.1
strictRequestBody :: Request -> IO L.ByteString
strictRequestBody req =
loop id
where
loop front = do
bs <- requestBody req
if B.null bs
then return $ front LI.Empty
else loop (front . LI.Chunk bs)
-- | 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 -> IO L.ByteString
lazyRequestBody req =
loop
where
loop = unsafeInterleaveIO $ do
bs <- requestBody req
if B.null bs
then return LI.Empty
else do
bss <- loop
return $ LI.Chunk bs bss
wai-3.2.1.1/Network/Wai/ 0000755 0000000 0000000 00000000000 12720741000 012764 5 ustar 00 0000000 0000000 wai-3.2.1.1/Network/Wai/Internal.hs 0000644 0000000 0000000 00000015151 12720741000 015077 0 ustar 00 0000000 0000000 {-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
-- | 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 hiding (pack)
#if __GLASGOW_HASKELL__ < 709
import Data.Functor ((<$>))
#endif
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)
-- | 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.
--
-- 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.
, 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)
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)
]
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
-- data, and the second parameter provides a means of flushing the data to the
-- client.
--
-- 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
data RequestBodyLength = ChunkedBody | KnownLength Word64 deriving Show
-- | 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
-- | 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
-- Application.
--
-- It is /highly/ advised that only WAI handlers import and use the data
-- constructor for this data type.
--
-- Since 3.0.0
data ResponseReceived = ResponseReceived
deriving Typeable
wai-3.2.1.1/test/ 0000755 0000000 0000000 00000000000 12720741000 011572 5 ustar 00 0000000 0000000 wai-3.2.1.1/test/Spec.hs 0000644 0000000 0000000 00000000054 12720741000 013017 0 ustar 00 0000000 0000000 {-# OPTIONS_GHC -F -pgmF hspec-discover #-}
wai-3.2.1.1/test/Network/ 0000755 0000000 0000000 00000000000 12720741000 013223 5 ustar 00 0000000 0000000 wai-3.2.1.1/test/Network/WaiSpec.hs 0000644 0000000 0000000 00000007166 12720741000 015124 0 ustar 00 0000000 0000000 module Network.WaiSpec (spec) where
import Test.Hspec
import Test.Hspec.QuickCheck (prop)
import Network.Wai
import Network.Wai.Internal (Request (Request))
import Data.IORef
import Data.Monoid
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Blaze.ByteString.Builder (toByteString, Builder, fromWord8)
import Control.Monad (forM_)
spec :: Spec
spec = do
describe "responseToStream" $ do
let getBody res = do
let (_, _, f) = responseToStream res
f $ \streamingBody -> do
builderRef <- newIORef mempty
let add :: Builder -> IO ()
add b = atomicModifyIORef builderRef $ \builder ->
(builder `mappend` b, ())
flush :: IO ()
flush = return ()
streamingBody add flush
fmap toByteString $ readIORef builderRef
prop "responseLBS" $ \bytes -> do
body <- getBody $ responseLBS undefined undefined $ L.pack bytes
body `shouldBe` S.pack bytes
prop "responseBuilder" $ \bytes -> do
body <- getBody $ responseBuilder undefined undefined
$ mconcat $ map fromWord8 bytes
body `shouldBe` S.pack bytes
prop "responseStream" $ \chunks -> do
body <- getBody $ responseStream undefined undefined $ \sendChunk _ ->
forM_ chunks $ \chunk -> sendChunk $ mconcat $ map fromWord8 chunk
body `shouldBe` S.concat (map S.pack chunks)
it "responseFile total" $ do
let fp = "wai.cabal"
body <- getBody $ responseFile undefined undefined fp Nothing
expected <- S.readFile fp
body `shouldBe` expected
prop "responseFile partial" $ \offset' count' -> do
let fp = "wai.cabal"
totalBS <- S.readFile fp
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
}
let expected = S.take count $ S.drop offset totalBS
body `shouldBe` expected
describe "lazyRequestBody" $ do
prop "works" $ \chunks -> do
ref <- newIORef $ map S.pack $ filter (not . null) chunks
let req = Request
{ requestBody = atomicModifyIORef ref $ \bss ->
case bss of
[] -> ([], S.empty)
x:y -> (y, x)
}
body <- lazyRequestBody req
body `shouldBe` L.fromChunks (map S.pack chunks)
it "is lazy" $ do
let req = Request
{ requestBody = error "requestBody"
}
_ <- lazyRequestBody req
return ()
describe "strictRequestBody" $ do
prop "works" $ \chunks -> do
ref <- newIORef $ map S.pack $ filter (not . null) chunks
let req = Request
{ requestBody = atomicModifyIORef ref $ \bss ->
case bss of
[] -> ([], S.empty)
x:y -> (y, x)
}
body <- strictRequestBody req
body `shouldBe` L.fromChunks (map S.pack chunks)