on master help sign in
Merge pull request #793 from flip111/patch-1
fa92d08Michael Snoyman
stack.yaml+1−1
@@ -1,4 +1,4 @@
1−resolver: lts-14.20
1+resolver: lts-14.22
2packages:
2packages:
3- ./auto-update
3- ./auto-update
4- ./mime-types
4- ./mime-types
wai-app-static/Network/Wai/Application/Static.hs+1−1
@@ -245,7 +245,7 @@ staticAppPieces ss rawPieces req sendResponse = liftIO $ do
245 response :: StaticResponse -> IO W.ResponseReceived
245 response :: StaticResponse -> IO W.ResponseReceived
246 response (FileResponse file ch) = do
246 response (FileResponse file ch) = do
247 mimetype <- ssGetMimeType ss file
247 mimetype <- ssGetMimeType ss file
248− let filesize = fileGetSize file
248+ -- let filesize = fileGetSize file
249 let headers = ("Content-Type", mimetype)
249 let headers = ("Content-Type", mimetype)
250 -- Let Warp provide the content-length, since it takes
250 -- Let Warp provide the content-length, since it takes
251 -- range requests into account
251 -- range requests into account
wai-app-static/WaiAppStatic/CmdLine.hs+1
@@ -39,6 +39,7 @@ data Args = Args
39 }
39 }
40
40
41#if MIN_VERSION_optparse_applicative(0, 10, 0)
41#if MIN_VERSION_optparse_applicative(0, 10, 0)
42+option' :: Mod OptionFields Int -> Parser Int
42option' = option auto
43option' = option auto
43#else
44#else
44option' = option
45option' = option
wai-app-static/WaiAppStatic/Listing.hs+1−1
@@ -64,7 +64,7 @@ defaultListing pieces (Folder contents) = do
64
64
65 -- Add a link to the root of the tree
65 -- Add a link to the root of the tree
66 showFolder' :: Bool -> Pieces -> H.Html
66 showFolder' :: Bool -> Pieces -> H.Html
67− showFolder' hasTrailingSlash pieces = showFolder hasTrailingSlash (unsafeToPiece "root" : pieces)
67+ showFolder' hasTrailingSlash pieces' = showFolder hasTrailingSlash (unsafeToPiece "root" : pieces')
68
68
69 showFolder :: Bool -> Pieces -> H.Html
69 showFolder :: Bool -> Pieces -> H.Html
70 showFolder _ [] = "/" -- won't happen
70 showFolder _ [] = "/" -- won't happen
wai-app-static/WaiAppStatic/Storage/Embedded/TH.hs−1
@@ -7,7 +7,6 @@ module WaiAppStatic.Storage.Embedded.TH(
7
7
8import Data.ByteString.Builder.Extra (byteStringInsert)
8import Data.ByteString.Builder.Extra (byteStringInsert)
9import Codec.Compression.GZip (compress)
9import Codec.Compression.GZip (compress)
10−import Control.Applicative
11import Data.ByteString.Unsafe (unsafePackAddressLen)
10import Data.ByteString.Unsafe (unsafePackAddressLen)
12import Data.Either (lefts, rights)
11import Data.Either (lefts, rights)
13import GHC.Exts (Int(..))
12import GHC.Exts (Int(..))
wai-conduit/Network/Wai/Conduit.hs+5−6
@@ -17,17 +17,16 @@ import qualified Data.ByteString as S
17import Control.Monad (unless)
17import Control.Monad (unless)
18import Network.HTTP.Types
18import Network.HTTP.Types
19import Data.ByteString.Builder (Builder)
19import Data.ByteString.Builder (Builder)
20−import Data.IORef
21import qualified Data.Conduit.List as CL
20import qualified Data.Conduit.List as CL
22
21
23-- | Stream the request body.
22-- | Stream the request body.
24--
23--
25-- Since 3.0.0
24-- Since 3.0.0
26−sourceRequestBody :: MonadIO m => Request -> Source m ByteString
25+sourceRequestBody :: MonadIO m => Request -> ConduitT () ByteString m ()
27sourceRequestBody req =
26sourceRequestBody req =
28 loop
27 loop
29 where
28 where
30− go = liftIO (requestBody req)
29+ go = liftIO (getRequestBodyChunk req)
31
30
32 loop = do
31 loop = do
33 bs <- go
32 bs <- go
@@ -38,9 +37,9 @@ sourceRequestBody req =
38-- | Create an HTTP response out of a @Source@.
37-- | Create an HTTP response out of a @Source@.
39--
38--
40-- Since 3.0.0
39-- Since 3.0.0
41−responseSource :: Status -> ResponseHeaders -> Source IO (Flush Builder) -> Response
40+responseSource :: Status -> ResponseHeaders -> ConduitT () (Flush Builder) IO () -> Response
42responseSource s hs src = responseStream s hs $ \send flush ->
41responseSource s hs src = responseStream s hs $ \send flush ->
43− src $$ CL.mapM_ (\mbuilder ->
42+ runConduit $ src .| CL.mapM_ (\mbuilder ->
44 case mbuilder of
43 case mbuilder of
45 Chunk b -> send b
44 Chunk b -> send b
46 Flush -> flush)
45 Flush -> flush)
@@ -50,7 +49,7 @@ responseSource s hs src = responseStream s hs $ \send flush ->
50--
49--
51-- Since 3.0.0
50-- Since 3.0.0
52responseRawSource :: (MonadIO m, MonadIO n)
51responseRawSource :: (MonadIO m, MonadIO n)
53− => (Source m ByteString -> Sink ByteString n () -> IO ())
52+ => (ConduitT () ByteString m () -> ConduitT ByteString Void n () -> IO ())
54 -> Response
53 -> Response
55 -> Response
54 -> Response
56responseRawSource app =
55responseRawSource app =
wai-extra/example/Main.hs+2−2
@@ -42,10 +42,10 @@ eventRaw = handle 0
42 where
42 where
43 handle counter emit flush = do
43 handle counter emit flush = do
44 threadDelay 1000000
44 threadDelay 1000000
45− emit $ ServerEvent (Just $ string8 "raw")
45+ _ <- emit $ ServerEvent (Just $ string8 "raw")
46 Nothing
46 Nothing
47 [string8 . show $ counter]
47 [string8 . show $ counter]
48− flush
48+ _ <- flush
49 handle (counter + 1) emit flush
49 handle (counter + 1) emit flush
50
50
51main :: IO ()
51main :: IO ()
wai-websockets/server.lhs+6
@@ -8,6 +8,8 @@ this example, keep the [reference](http://jaspervdj.be/websockets/reference)
8nearby to check out the functions we use.
8nearby to check out the functions we use.
9
9
10> {-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
10> {-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
11+> {-# LANGUAGE CPP #-}
12+> {-# OPTIONS_GHC -Wno-unused-top-binds #-} -- for numClients
11> import Data.Char (isPunctuation, isSpace)
13> import Data.Char (isPunctuation, isSpace)
12> import Data.Monoid (mappend)
14> import Data.Monoid (mappend)
13> import Data.Text (Text)
15> import Data.Text (Text)
@@ -99,7 +101,11 @@ stays alive on some browsers.
99
101
100> application state pending = do
102> application state pending = do
101> conn <- WS.acceptRequest pending
103> conn <- WS.acceptRequest pending
104+#if __GLASGOW_HASKELL__ >= 806
105+> WS.withPingThread conn 30 (return ()) $ do
106+#else
102> WS.forkPingThread conn 30
107> WS.forkPingThread conn 30
108+#endif
103
109
104When a client is successfully connected, we read the first message. This should
110When a client is successfully connected, we read the first message. This should
105be in the format of "Hi! I am Jasper", where Jasper is the requested username.
111be in the format of "Hi! I am Jasper", where Jasper is the requested username.
wai-websockets/wai-websockets.cabal+1
@@ -45,6 +45,7 @@ Executable wai-websockets-example
45 , text
45 , text
46 , file-embed
46 , file-embed
47 , http-types
47 , http-types
48+ other-modules: Network.Wai.Handler.WebSockets
48 else
49 else
49 buildable: False
50 buildable: False
50
51
warp/Network/Wai/Handler/Warp/Recv.hs+2
@@ -153,6 +153,8 @@ receiveloop sock ptr size = do
153 else
153 else
154 return bytes
154 return bytes
155
155
156+#ifndef mingw32_HOST_OS
156-- fixme: the type of the return value
157-- fixme: the type of the return value
157foreign import ccall unsafe "recv"
158foreign import ccall unsafe "recv"
158 c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt
159 c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt
160+#endif
warp/Network/Wai/Handler/Warp/Run.hs+4
@@ -59,7 +59,11 @@ import Network.Socket (fdSocket)
59
59
60-- | Creating 'Connection' for plain HTTP based on a given socket.
60-- | Creating 'Connection' for plain HTTP based on a given socket.
61socketConnection :: Settings -> Socket -> IO Connection
61socketConnection :: Settings -> Socket -> IO Connection
62+#if MIN_VERSION_network(3,1,1)
62socketConnection set s = do
63socketConnection set s = do
64+#else
65+socketConnection _ s = do
66+#endif
63 bufferPool <- newBufferPool
67 bufferPool <- newBufferPool
64 writeBuf <- allocateBuffer bufferSize
68 writeBuf <- allocateBuffer bufferSize
65 let sendall = Sock.sendAll s
69 let sendall = Sock.sendAll s