06aa52b · typeable/wai

git.iko.soy/typeable/wai

Remove causes of compiler warnings. Use headers from http-types.

commit06aa52b3255f38d22e6b78c8d68cf51fe4552cce authorMikkel Christiansen <mikkel@rheosystems.com> dateTue 28 Jul 2015, 10:52 (11 years ago) parentf370437

25 files changed+89−91

compare with master

unifiedsplit

wai-extra/Network/Wai/EventSource.hs+3−5

@@ -1,4 +1,3 @@

1−{-# LANGUAGE OverloadedStrings #-}

21{-|

32 A WAI adapter to the HTML5 Server-Sent Events API.

43-}

@@ -8,12 +7,11 @@ module Network.Wai.EventSource (

87 eventSourceAppIO

98 ) where

109

11−import Blaze.ByteString.Builder (Builder)

1210import Data.Function (fix)

1311import Control.Concurrent.Chan (Chan, dupChan, readChan)

1412import Control.Monad.IO.Class (liftIO)

15−import Network.HTTP.Types (status200)

16−import Network.Wai (Application, Response, responseStream)

13+import Network.HTTP.Types (status200, hContentType)

14+import Network.Wai (Application, responseStream)

1715

1816import Network.Wai.EventSource.EventStream

1917

@@ -30,7 +28,7 @@ eventSourceAppIO :: IO ServerEvent -> Application

3028eventSourceAppIO src _ sendResponse =

3129 sendResponse $ responseStream

3230 status200

33− [("Content-Type", "text/event-stream")]

31+ [(hContentType, "text/event-stream")]

3432 $ \sendChunk flush -> fix $ \loop -> do

3533 se <- src

3634 case eventToBuilder se of

wai-extra/Network/Wai/EventSource/EventStream.hs+3−1

@@ -1,4 +1,4 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE CPP #-}

22{- code adapted by Mathias Billman originaly from Chris Smith https://github.com/cdsmith/gloss-web -}

44{-|

@@ -11,7 +11,9 @@ module Network.Wai.EventSource.EventStream (

1111

1212import Blaze.ByteString.Builder

1313import Blaze.ByteString.Builder.Char8

14+#if __GLASGOW_HASKELL__ < 710

1415import Data.Monoid

16+#endif

1517

1618{-|

1719 Type representing a communication over an event stream. This can be an

wai-extra/Network/Wai/Handler/CGI.hs+10−11

@@ -1,6 +1,4 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE RankNTypes #-}

3−{-# LANGUAGE CPP #-}

1+{-# LANGUAGE RankNTypes, CPP #-}

42-- | Backend for Common Gateway Interface. Almost all users should use the

53-- 'run' function.

64module Network.Wai.Handler.CGI

@@ -21,15 +19,16 @@ import Control.Arrow ((***))

2119import Data.Char (toLower)

2220import qualified System.IO

2321import qualified Data.String as String

24−import Data.Monoid (mconcat, mempty)

2522import Blaze.ByteString.Builder (fromByteString, toLazyByteString, flush)

2623import Blaze.ByteString.Builder.Char8 (fromChar, fromString)

2724import Data.ByteString.Lazy.Internal (defaultChunkSize)

2825import System.IO (Handle)

29−import Network.HTTP.Types (Status (..))

26+import Network.HTTP.Types (Status (..), hRange, hContentType, hContentLength)

3027import qualified Network.HTTP.Types as H

3128import qualified Data.CaseInsensitive as CI

32−import Data.Monoid (mappend)

29+#if __GLASGOW_HASKELL__ < 710

30+import Data.Monoid (mconcat, mempty, mappend)

31+#endif

3332import qualified Data.Streaming.Blaze as Blaze

3433import Data.Function (fix)

3534import Control.Monad (unless, void)

@@ -118,7 +117,7 @@ runGeneric vars inputH outputH xsendfile app = do

118117 , vault = mempty

119118 , requestBodyLength = KnownLength $ fromIntegral contentLength

120119 , requestHeaderHost = lookup "host" reqHeaders

121− , requestHeaderRange = lookup "range" reqHeaders

120+ , requestHeaderRange = lookup hRange reqHeaders

122121 }

123122 void $ app env $ \res ->

124123 case (xsendfile, res) of

@@ -162,13 +161,13 @@ runGeneric vars inputH outputH xsendfile app = do

162161 , fromByteString " not supported"

163162 ]

164163 fixHeaders h =

165− case lookup "content-type" h of

166− Nothing -> ("Content-Type", "text/html; charset=utf-8") : h

164+ case lookup hContentType h of

165+ Nothing -> (hContentType, "text/html; charset=utf-8") : h

167166 Just _ -> h

168167

169168cleanupVarName :: String -> CI.CI B.ByteString

170−cleanupVarName "CONTENT_TYPE" = "Content-Type"

171−cleanupVarName "CONTENT_LENGTH" = "Content-Length"

169+cleanupVarName "CONTENT_TYPE" = hContentType

170+cleanupVarName "CONTENT_LENGTH" = hContentLength

172171cleanupVarName "SCRIPT_NAME" = "CGI-Script-Name"

173172cleanupVarName s =

174173 case s of

wai-extra/Network/Wai/Middleware/AcceptOverride.hs−2

@@ -1,5 +1,3 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

31module Network.Wai.Middleware.AcceptOverride

42 ( acceptOverride

53 ) where

wai-extra/Network/Wai/Middleware/AddHeaders.hs+1−1

@@ -5,7 +5,7 @@ module Network.Wai.Middleware.AddHeaders

55 ( addHeaders

66 ) where

8−import Network.HTTP.Types (ResponseHeaders, Header)

8+import Network.HTTP.Types (Header)

99import Network.Wai (Middleware, modifyResponse, mapResponseHeaders)

1010import Network.Wai.Internal (Response(..))

1111import Data.ByteString (ByteString)

wai-extra/Network/Wai/Middleware/Approot.hs+2−4

@@ -1,5 +1,4 @@

11{-# LANGUAGE DeriveDataTypeable #-}

2−{-# LANGUAGE OverloadedStrings #-}

32-- | Middleware for establishing the root of the application.

43--

54-- Many application need the ability to create URLs referring back to the

@@ -29,13 +28,12 @@ module Network.Wai.Middleware.Approot

2928

3029import Control.Exception (Exception, throw)

3130import Data.ByteString (ByteString)

32−import qualified Data.ByteString as S

3331import qualified Data.ByteString.Char8 as S8

3432import Data.Maybe (fromMaybe)

3533import Data.Typeable (Typeable)

3634import qualified Data.Vault.Lazy as V

37−import Network.Wai (Request, vault, Middleware, requestHeaderHost)

38−import Network.Wai.Request (appearsSecure, guessApproot)

35+import Network.Wai (Request, vault, Middleware)

36+import Network.Wai.Request (guessApproot)

3937import System.Environment (getEnvironment)

4038import System.IO.Unsafe (unsafePerformIO)

4139

wai-extra/Network/Wai/Middleware/Autohead.hs+3−1

@@ -1,10 +1,12 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE CPP #-}

22-- | Automatically produce responses to HEAD requests based on the underlying

33-- applications GET response.

44module Network.Wai.Middleware.Autohead (autohead) where

66import Network.Wai

7+#if __GLASGOW_HASKELL__ < 710

78import Data.Monoid (mempty)

9+#endif

810

911autohead :: Middleware

1012autohead app req sendResponse

wai-extra/Network/Wai/Middleware/CleanPath.hs+5−3

@@ -1,4 +1,4 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE CPP #-}

22module Network.Wai.Middleware.CleanPath

33 ( cleanPath

44 ) where

@@ -6,9 +6,11 @@ module Network.Wai.Middleware.CleanPath

66import Network.Wai

77import qualified Data.ByteString.Char8 as B

88import qualified Data.ByteString.Lazy as L

9−import Network.HTTP.Types (status301)

9+import Network.HTTP.Types (status301, hLocation)

1010import Data.Text (Text)

11+#if __GLASGOW_HASKELL__ < 710

1112import Data.Monoid (mconcat)

13+#endif

1214

1315cleanPath :: ([Text] -> Either B.ByteString [Text])

1416 -> B.ByteString

@@ -19,7 +21,7 @@ cleanPath splitter prefix app env sendResponse =

1921 Right pieces -> app pieces env sendResponse

2022 Left p -> sendResponse

2123 $ responseLBS status301

22− [("Location", mconcat [prefix, p, suffix])]

24+ [(hLocation, mconcat [prefix, p, suffix])]

2325 $ L.empty

2426 where

2527 -- include the query string if present

wai-extra/Network/Wai/Middleware/ForceSSL.hs−1

@@ -1,5 +1,4 @@

11{-# LANGUAGE CPP #-}

2−{-# LANGUAGE OverloadedStrings #-}

32-- | Redirect non-SSL requests to https

43--

54-- Since 3.0.7

wai-extra/Network/Wai/Middleware/Gzip.hs+13−16

@@ -1,6 +1,4 @@

1−{-# LANGUAGE Rank2Types #-}

2−{-# LANGUAGE ScopedTypeVariables #-}

3−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE Rank2Types, ScopedTypeVariables #-}

42---------------------------------------------------------

53-- |

64-- Module : Network.Wai.Middleware.Gzip

@@ -29,9 +27,8 @@ import Data.Maybe (fromMaybe, isJust)

2927import qualified Data.ByteString.Char8 as S8

3028import qualified Data.ByteString as S

3129import Data.Default.Class

32−import Network.HTTP.Types (Status, Header)

33−import Control.Monad.IO.Class (liftIO)

34−import Control.Monad.Trans.Resource (runResourceT)

30+import Network.HTTP.Types ( Status, Header, hContentEncoding, hUserAgent

31+ , hContentType, hContentLength)

3532import System.Directory (doesFileExist, createDirectoryIfMissing)

3633import Blaze.ByteString.Builder (fromByteString)

3734import Control.Exception (try, SomeException)

@@ -85,7 +82,7 @@ gzip set app env sendResponse = app env $ \res ->

8582 then

8683 case (res, gzipFiles set) of

8784 (ResponseFile s hs file Nothing, GzipCacheFolder cache) ->

88− case lookup "content-type" hs of

85+ case lookup hContentType hs of

8986 Just m

9087 | gzipCheckMime set m -> compressFile s hs file cache sendResponse

9188 _ -> sendResponse res

@@ -94,9 +91,9 @@ gzip set app env sendResponse = app env $ \res ->

9491 where

9592 enc = fromMaybe [] $ (splitCommas . S8.unpack)

9693 `fmap` lookup "Accept-Encoding" (requestHeaders env)

97− ua = fromMaybe "" $ lookup "user-agent" $ requestHeaders env

94+ ua = fromMaybe "" $ lookup hUserAgent $ requestHeaders env

9895 isMSIE6 = "MSIE 6" `S.isInfixOf` ua

99− isEncoded res = isJust $ lookup "Content-Encoding" $ responseHeaders res

96+ isEncoded res = isJust $ lookup hContentEncoding $ responseHeaders res

10097

10198compressFile :: Status -> [Header] -> FilePath -> FilePath -> (Response -> IO a) -> IO a

10299compressFile s hs file cache sendResponse = do

@@ -118,7 +115,7 @@ compressFile s hs file cache sendResponse = do

118115 Z.PRNext bs -> do

119116 S.hPut outH bs

120117 loop

121− Z.PRError e -> throwIO e

118+ Z.PRError ex -> throwIO ex

122119 fix $ \loop -> do

123120 bs <- S.hGetSome inH defaultChunkSize

124121 unless (S.null bs) $ do

@@ -145,11 +142,11 @@ compressE :: GzipSettings

145142 -> (Response -> IO a)

146143 -> IO a

147144compressE set res sendResponse =

148− case lookup "content-type" hs of

145+ case lookup hContentType hs of

149146 Just m | gzipCheckMime set m ->

150147 let hs' = fixHeaders hs

151148 in wb $ \body -> sendResponse $ responseStream s hs' $ \sendChunk flush -> do

152− (blazeRecv, blazeFinish) <- B.newBlazeRecv B.defaultStrategy

149+ (blazeRecv, _) <- B.newBlazeRecv B.defaultStrategy

153150 deflate <- Z.initDeflate 1 (Z.WindowBits 31)

154151 let sendBuilder builder = do

155152 popper <- blazeRecv builder

@@ -164,8 +161,8 @@ compressE set res sendResponse =

164161 deflatePopper $ Z.flushDeflate deflate

165162 flush

166163 deflatePopper popper = fix $ \loop -> do

167− res <- popper

168− case res of

164+ result <- popper

165+ case result of

169166 Z.PRDone -> return ()

170167 Z.PRNext bs' -> do

171168 sendChunk $ fromByteString bs'

@@ -183,9 +180,9 @@ compressE set res sendResponse =

183180-- different length after gzip compression.

184181fixHeaders :: [Header] -> [Header]

185182fixHeaders =

186− (("Content-Encoding", "gzip") :) . filter notLength

183+ ((hContentEncoding, "gzip") :) . filter notLength

187184 where

188− notLength (x, _) = x /= "content-length"

185+ notLength (x, _) = x /= hContentLength

189186

190187splitCommas :: String -> [String]

191188splitCommas [] = []

wai-extra/Network/Wai/Middleware/HttpAuth.hs+6−5

@@ -1,4 +1,4 @@

1−{-# LANGUAGE RecordWildCards, OverloadedStrings, TupleSections #-}

1+{-# LANGUAGE RecordWildCards, TupleSections, CPP #-}

22-- | Implements HTTP Basic Authentication.

33--

44-- This module may add digest authentication in the future.

@@ -14,13 +14,14 @@ module Network.Wai.Middleware.HttpAuth

1414 , extractBasicAuth

1515 , extractBearerAuth

1616 ) where

17−

17+#if __GLASGOW_HASKELL__ < 710

1818import Control.Applicative

19+#endif

1920import Data.ByteString (ByteString)

2021import Data.ByteString.Base64 (decodeLenient)

2122import Data.String (IsString (..))

2223import Data.Word8 (isSpace, _colon, toLower)

23−import Network.HTTP.Types (status401)

24+import Network.HTTP.Types (status401, hContentType, hAuthorization)

2425import Network.Wai

2526

2627import qualified Data.ByteString as S

@@ -47,7 +48,7 @@ basicAuth checkCreds AuthSettings {..} app req sendResponse = do

4748 else authOnNoAuth authRealm req sendResponse

4849 where

4950 check =

50− case (lookup "Authorization" $ requestHeaders req)

51+ case (lookup hAuthorization $ requestHeaders req)

5152 >>= extractBasicAuth of

5253 Nothing -> return False

5354 Just (username, password) -> checkCreds username password

@@ -84,7 +85,7 @@ instance IsString AuthSettings where

8485 { authRealm = fromString s

8586 , authOnNoAuth = \realm _req f -> f $ responseLBS

8687 status401

87− [ ("Content-Type", "text/plain")

88+ [ (hContentType, "text/plain")

8889 , ("WWW-Authenticate", S.concat

8990 [ "Basic realm=\""

9091 , realm

wai-extra/Network/Wai/Middleware/Jsonp.hs+10−10

@@ -1,5 +1,4 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE RankNTypes #-}

1+{-# LANGUAGE RankNTypes, CPP #-}

32---------------------------------------------------------

43-- |

54-- Module : Network.Wai.Middleware.Jsonp

@@ -19,14 +18,15 @@ import Network.Wai

1918import Network.Wai.Internal

2019import Data.ByteString (ByteString)

2120import qualified Data.ByteString.Char8 as B8

22−import Blaze.ByteString.Builder (Builder, copyByteString)

21+import Blaze.ByteString.Builder (copyByteString)

2322import Blaze.ByteString.Builder.Char8 (fromChar)

23+#if __GLASGOW_HASKELL__ < 710

2424import Data.Monoid (mappend)

25+#endif

2526import Control.Monad (join)

2627import Data.Maybe (fromMaybe)

2728import qualified Data.ByteString as S

28−import Data.CaseInsensitive (CI)

29−import Network.HTTP.Types (Status)

29+import Network.HTTP.Types (hAccept, hContentType)

3030

3131-- | Wrap json responses in a jsonp callback.

3232--

@@ -37,7 +37,7 @@ import Network.HTTP.Types (Status)

3737-- callback function.

3838jsonp :: Middleware

3939jsonp app env sendResponse = do

40− let accept = fromMaybe B8.empty $ lookup "Accept" $ requestHeaders env

40+ let accept = fromMaybe B8.empty $ lookup hAccept $ requestHeaders env

4141 let callback :: Maybe B8.ByteString

4242 callback =

4343 if B8.pack "text/javascript" `B8.isInfixOf` accept

@@ -47,7 +47,7 @@ jsonp app env sendResponse = do

4747 case callback of

4848 Nothing -> env

4949 Just _ -> env

50− { requestHeaders = changeVal "Accept"

50+ { requestHeaders = changeVal hAccept

5151 "application/json"

5252 $ requestHeaders env

5353 }

@@ -72,17 +72,17 @@ jsonp app env sendResponse = do

7272 (s, hs, wb) = responseToStream r

7373

7474 checkJSON hs =

75− case lookup "Content-Type" hs of

75+ case lookup hContentType hs of

7676 Just x

7777 | B8.pack "application/json" `S.isPrefixOf` x ->

7878 Just $ fixHeaders hs

7979 _ -> Nothing

80− fixHeaders = changeVal "Content-Type" "text/javascript"

80+ fixHeaders = changeVal hContentType "text/javascript"

8181

8282 addCallback cb s hs wb =

8383 wb $ \body -> sendResponse $ responseStream s hs $ \sendChunk flush -> do

8484 sendChunk $ copyByteString cb `mappend` fromChar '('

85− body sendChunk flush

85+ _ <- body sendChunk flush

8686 sendChunk $ fromChar ')'

8787

8888changeVal :: Eq a

wai-extra/Network/Wai/Middleware/Local.hs+1−1

@@ -1,4 +1,4 @@

1−{-# LANGUAGE OverloadedStrings, CPP #-}

1+{-# LANGUAGE CPP #-}

22-- | Only allow local connections.

33--

44module Network.Wai.Middleware.Local

wai-extra/Network/Wai/Middleware/MethodOverride.hs−1

@@ -1,4 +1,3 @@

1−{-# LANGUAGE OverloadedStrings #-}

21module Network.Wai.Middleware.MethodOverride

32 ( methodOverride

43 ) where

wai-extra/Network/Wai/Middleware/MethodOverridePost.hs+6−3

@@ -1,4 +1,4 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE CPP #-}

22-----------------------------------------------------------------

33-- | Module : Network.Wai.Middleware.MethodOverridePost

44--

@@ -9,8 +9,11 @@ module Network.Wai.Middleware.MethodOverridePost

99 ) where

1010

1111import Network.Wai

12−import Network.HTTP.Types (parseQuery)

12+import Network.HTTP.Types (parseQuery, hContentType)

13+

14+#if __GLASGOW_HASKELL__ < 710

1315import Data.Monoid (mconcat, mempty)

16+#endif

1417import Data.IORef

1518import Data.ByteString.Lazy (toChunks)

1619

@@ -27,7 +30,7 @@ import Data.ByteString.Lazy (toChunks)

2730--

2831methodOverridePost :: Middleware

2932methodOverridePost app req send =

30− case (requestMethod req, lookup "Content-Type" (requestHeaders req)) of

33+ case (requestMethod req, lookup hContentType (requestHeaders req)) of

3134 ("POST", Just "application/x-www-form-urlencoded") -> setPost req >>= flip app send

3235 _ -> app req send

3336

wai-extra/Network/Wai/Middleware/RequestLogger.hs+5−10

@@ -1,6 +1,4 @@

1−{-# LANGUAGE OverloadedStrings #-}

21{-# LANGUAGE RecordWildCards #-}

3−

42-- NOTE: Due to https://github.com/yesodweb/wai/issues/192, this module should

53-- not use CPP.

64module Network.Wai.Middleware.RequestLogger

@@ -30,17 +28,14 @@ import Network.HTTP.Types as H

3028import Data.Maybe (fromMaybe)

3129import Data.Monoid (mconcat, (<>))

3230import Data.Time (getCurrentTime, diffUTCTime)

33−

34−import Network.Wai.Parse (sinkRequestBody, lbsBackEnd, fileName, Param, File, getRequestBodyType)

31+import Network.Wai.Parse (sinkRequestBody, lbsBackEnd, fileName, Param, File

32+ , getRequestBodyType)

3533import qualified Data.ByteString.Lazy as LBS

3634import qualified Data.ByteString.Char8 as S8

37−

3835import System.Console.ANSI

3936import Data.IORef.Lifted

4037import System.IO.Unsafe

41−import Control.Monad (unless)

4238import Network.Wai.Internal (Response (ResponseRaw))

43−

4439import Data.Default.Class (Default (def))

4540import Network.Wai.Logger

4641import Network.Wai.Middleware.RequestLogger.Internal

@@ -103,7 +98,7 @@ mkRequestLogger RequestLoggerSettings{..} = do

10398

10499apacheMiddleware :: ApacheLoggerActions -> Middleware

105100apacheMiddleware ala app req sendResponse = app req $ \res -> do

106− let msize = lookup "content-length" (responseHeaders res) >>= readInt'

101+ let msize = lookup H.hContentLength (responseHeaders res) >>= readInt'

107102 readInt' bs =

108103 case S8.readInteger bs of

109104 Just (i, "") -> Just i

@@ -193,7 +188,7 @@ detailedMiddleware' :: Callback

193188 -> (BS.ByteString -> BS.ByteString -> [BS.ByteString])

194189 -> Middleware

195190detailedMiddleware' cb ansiColor ansiMethod ansiStatusCode app req sendResponse = do

196− let mlen = lookup "content-length" (requestHeaders req) >>= readInt

191+ let mlen = lookup H.hContentLength (requestHeaders req) >>= readInt

197192 (req', body) <-

198193 case mlen of

199194 -- log the request body if it is small

@@ -231,7 +226,7 @@ detailedMiddleware' cb ansiColor ansiMethod ansiStatusCode app req sendResponse

231226 return $ collectPostParams postParams

232227

233228 let getParams = map emptyGetParam $ queryString req

234− accept = fromMaybe "" $ lookup "Accept" $ requestHeaders req

229+ accept = fromMaybe "" $ lookup H.hAccept $ requestHeaders req

235230 params = let par | not $ null postParams = [pack (show postParams)]

236231 | not $ null getParams = [pack (show getParams)]

237232 | otherwise = []

wai-extra/Network/Wai/Middleware/RequestLogger/Internal.hs+6−2

@@ -8,9 +8,10 @@ module Network.Wai.Middleware.RequestLogger.Internal

99import Data.ByteString (ByteString)

1010import Network.Wai.Logger (clockDateCacher)

11+#if !MIN_VERSION_wai_logger(2, 2, 0)

1112import Control.Concurrent (forkIO, threadDelay)

1213import Control.Monad (forever)

13−

14+#endif

1415import System.Log.FastLogger (LogStr, fromLogStr)

1516

1617logToByteString :: LogStr -> ByteString

@@ -18,12 +19,15 @@ logToByteString = fromLogStr

1819

1920getDateGetter :: IO () -- ^ flusher

2021 -> IO (IO ByteString)

22+#if !MIN_VERSION_wai_logger(2, 2, 0)

2123getDateGetter flusher = do

2224 (getter, updater) <- clockDateCacher

23−#if !MIN_VERSION_wai_logger(2, 2, 0)

2425 _ <- forkIO $ forever $ do

2526 threadDelay 1000000

2627 updater

2728 flusher

29+#else

30+getDateGetter _ = do

31+ (getter, _) <- clockDateCacher

2832#endif

2933 return getter

wai-extra/Network/Wai/Middleware/Rewrite.hs−1

@@ -1,4 +1,3 @@

1−{-# LANGUAGE OverloadedStrings #-}

21module Network.Wai.Middleware.Rewrite

32 ( rewrite, rewritePure

43 ) where

wai-extra/Network/Wai/Middleware/StreamFile.hs+2−3

@@ -1,5 +1,3 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

31-- |

42--

53-- Since 3.0.4

@@ -11,6 +9,7 @@ import Network.Wai.Internal

119import Network.Wai (Middleware, responseToStream)

1210import qualified Data.ByteString.Char8 as S8

1311import System.PosixCompat (getFileStatus, fileSize, FileOffset)

12+import Network.HTTP.Types (hContentLength)

1413

1514-- |Convert ResponseFile type responses into ResponseStream type

1615--

@@ -34,7 +33,7 @@ streamFile app env sendResponse = app env $ \res ->

3433 sendBody :: StreamingBody -> IO ResponseReceived

3534 sendBody body = do

3635 len <- getFileSize fp

37− let hs' = ("Content-Length", (S8.pack (show len))) : hs

36+ let hs' = (hContentLength, (S8.pack (show len))) : hs

3837 sendResponse $ responseStream s hs' body

3938 _ -> sendResponse res

4039

wai-extra/Network/Wai/Middleware/Vhost.hs+5−3

@@ -1,5 +1,5 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−module Network.Wai.Middleware.Vhost (vhost, redirectWWW, redirectTo, redirectToLogged) where

1+{-# LANGUAGE CPP #-}

2+ module Network.Wai.Middleware.Vhost (vhost, redirectWWW, redirectTo, redirectToLogged) where

44import Network.Wai

@@ -7,7 +7,9 @@ import Network.HTTP.Types as H

77import qualified Data.Text.Encoding as TE

88import Data.Text (Text)

99import qualified Data.ByteString as BS

10+#if __GLASGOW_HASKELL__ < 710

1011import Data.Monoid (mappend)

12+#endif

1113

1214vhost :: [(Request -> Bool, Application)] -> Application -> Application

1315vhost vhosts def req =

@@ -27,7 +29,7 @@ redirectIf home cond app req sendResponse =

2729

2830redirectTo :: BS.ByteString -> Response

2931redirectTo location = responseLBS H.status301

30− [ ("Content-Type", "text/plain") , ("Location", location) ] "Redirect"

32+ [ (H.hContentType, "text/plain") , (H.hLocation, location) ] "Redirect"

3133

3234redirectToLogged :: (Text -> IO ()) -> BS.ByteString -> IO Response

3335redirectToLogged logger loc = do

wai-extra/Network/Wai/Parse.hs+2−2

@@ -1,5 +1,4 @@

11{-# LANGUAGE CPP #-}

2−{-# LANGUAGE OverloadedStrings #-}

32{-# LANGUAGE ExistentialQuantification #-}

43{-# LANGUAGE PatternGuards #-}

54{-# LANGUAGE TypeFamilies #-}

@@ -45,6 +44,7 @@ import qualified Network.HTTP.Types as H

4544import Control.Monad (when, unless)

4645import Control.Monad.Trans.Resource (allocate, release, register, InternalState, runInternalState)

4746import Data.IORef

47+import Network.HTTP.Types (hContentType)

4848

4949breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)

5050breakDiscard w s =

@@ -140,7 +140,7 @@ data RequestBodyType = UrlEncoded | Multipart S.ByteString

140140

141141getRequestBodyType :: Request -> Maybe RequestBodyType

142142getRequestBodyType req = do

143− ctype' <- lookup "Content-Type" $ requestHeaders req

143+ ctype' <- lookup hContentType $ requestHeaders req

144144 let (ctype, attrs) = parseContentType ctype'

145145 case ctype of

146146 "application/x-www-form-urlencoded" -> return UrlEncoded

wai-extra/Network/Wai/Request.hs−1

@@ -1,4 +1,3 @@

1−{-# LANGUAGE OverloadedStrings #-}

21-- | Some helpers for interrogating a WAI 'Request'.

43module Network.Wai.Request

wai-extra/Network/Wai/UrlMap.hs+2−2

@@ -1,4 +1,4 @@

1−{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}

1+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

22{-# LANGUAGE ExistentialQuantification #-}

33{- | This module gives you a way to mount applications under sub-URIs.

44For example:

@@ -93,7 +93,7 @@ instance ToApplication UrlMap where

9393 Nothing ->

9494 sendResponse $ responseLBS

9595 status404

96− [("content-type", "text/plain")]

96+ [(hContentType, "text/plain")]

9797 "Not found\n"

9898

9999 where

wai-extra/test/Network/Wai/Middleware/RoutedSpec.hs+2−2

@@ -9,7 +9,7 @@ import Test.Hspec

99import Network.Wai.Middleware.Routed

1010import Network.Wai.Middleware.ForceSSL (forceSSL)

1111

12−import Network.HTTP.Types (methodPost, status200, status301, status307)

12+import Network.HTTP.Types (hContentType, status200)

1313import Network.Wai

1414import Network.Wai.Test

1515import Data.ByteString (ByteString)

@@ -39,7 +39,7 @@ spec = describe "forceSSL" $ do

3939

4040jsonApp :: Application

4141jsonApp _req cps = cps $ responseLBS status200

42− [("Content-Type", "application/json")]

42+ [(hContentType, "application/json")]

4343 "{\"foo\":\"bar\"}"

4444

4545testDPath :: ByteString -> Session SResponse

wai-extra/wai-extra.cabal+2

@@ -116,6 +116,8 @@ Library

116116 else

117117 build-depends: unix

118118

119+ extensions: OverloadedStrings

120+

119121 Exposed-modules: Network.Wai.Handler.CGI

120122 Network.Wai.Handler.SCGI

121123 Network.Wai.Middleware.AcceptOverride