Various additional WAI 3.0 fixes

yesod-bin/Devel.hs

@@ -161,7 +161,11 @@ reverseProxy opts iappPort = do
 #endif
                         $ ProxyDest "127.0.0.1" appPort)
                 def
+#if MIN_VERSION_wai(3, 0, 0)
+                    { wpsOnExc = \e req f -> onExc e req >>= f
+#else
                     { wpsOnExc = onExc
+#endif
                     , wpsTimeout =
                         if proxyTimeout opts == 0
                             then Nothing

yesod-core/Yesod/Core/Handler.hs

@@ -93,6 +93,9 @@ module Yesod.Core.Handler
     , sendWaiResponse
 #if MIN_VERSION_wai(2, 1, 0)
     , sendRawResponse
+#endif
+#if MIN_VERSION_wai(3, 0, 0)
+    , sendRawResponseNoConduit
 #endif
       -- * Different representations
       -- $representations
@@ -582,6 +585,24 @@ sendResponseCreated url = do
 sendWaiResponse :: MonadHandler m => W.Response -> m b
 sendWaiResponse = handlerError . HCWai
 
+#if MIN_VERSION_wai(3, 0, 0)
+-- | Send a raw response without conduit. This is used for cases such as
+-- WebSockets. Requires WAI 3.0 or later, and a web server which supports raw
+-- responses (e.g., Warp).
+--
+-- Since 1.2.16
+sendRawResponseNoConduit
+    :: (MonadHandler m, MonadBaseControl IO m)
+    => (IO S8.ByteString -> (S8.ByteString -> IO ()) -> m ())
+    -> m a
+sendRawResponseNoConduit raw = control $ \runInIO ->
+    runInIO $ sendWaiResponse $ flip W.responseRaw fallback
+    $ \src sink -> runInIO (raw src sink) >> return ()
+  where
+    fallback = W.responseLBS H.status500 [("Content-Type", "text/plain")]
+        "sendRawResponse: backend does not support raw responses"
+#endif
+
 #if MIN_VERSION_wai(2, 1, 0)
 -- | Send a raw response. This is used for cases such as WebSockets. Requires
 -- WAI 2.1 or later, and a web server which supports raw responses (e.g.,

yesod-core/yesod-core.cabal

@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         1.2.15.1
+version:         1.2.16
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>

yesod-eventsource/Yesod/EventSource.hs

@@ -46,7 +46,18 @@ repEventSource :: (EventSourcePolyfill -> C.Source (HandlerT site IO) ES.ServerE
                -> HandlerT site IO TypedContent
 repEventSource src =
   prepareForEventSource >>=
-  respondEventStream . ES.sourceToSource . src
+  respondEventStream . sourceToSource . src
+
+-- | Convert a ServerEvent source into a Builder source of serialized
+-- events.
+sourceToSource :: Monad m => C.Source m ES.ServerEvent -> C.Source m (C.Flush Builder)
+sourceToSource src =
+    src C.$= C.awaitForever eventToFlushBuilder
+  where
+    eventToFlushBuilder event =
+        case ES.eventToBuilder event of
+            Nothing -> return ()
+            Just x -> C.yield (C.Chunk x) >> C.yield C.Flush
 
 
 -- | Return a Server-Sent Event stream given a 'HandlerT' action

yesod-eventsource/yesod-eventsource.cabal

@@ -32,6 +32,7 @@ library
                    , conduit               >= 0.5      && < 1.2
                    , wai                   >= 1.3
                    , wai-eventsource       >= 1.3
+                   , wai-extra
                    , blaze-builder
                    , transformers
     exposed-modules: Yesod.EventSource

yesod-persistent/yesod-persistent.cabal

@@ -34,6 +34,7 @@ test-suite test
     build-depends: base
                  , hspec
                  , wai-test
+                 , wai-extra
                  , yesod-core
                  , persistent-sqlite
                  , yesod-persistent

yesod-static/Yesod/EmbeddedStatic.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -89,7 +90,11 @@ instance Yesod master => YesodSubDispatch EmbeddedStatic (HandlerT master IO) wh
             resp = case pathInfo req of
                             ("res":_) -> stApp site req
                             ("widget":_) -> staticApp (widgetSettings site) req
+#if MIN_VERSION_wai(3,0,0)
+                            _ -> ($ responseLBS status404 [] "Not Found")
+#else
                             _ -> return $ responseLBS status404 [] "Not Found"
+#endif
 
 -- | Create the haskell variable for the link to the entry
 mkRoute :: ComputedEntry -> Q [Dec]

yesod-static/Yesod/EmbeddedStatic/Internal.hs

@@ -106,12 +106,22 @@ prodEmbed e = do
                  }
     return $ ComputedEntry (ebHaskellName e) st link
 
+toApp :: (Request -> IO Response) -> Application
+#if MIN_VERSION_wai(3, 0, 0)
+toApp f req g = f req >>= g
+#else
+toApp = id
+#endif
+
 tryExtraDevelFiles :: [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application
-tryExtraDevelFiles [] _ = return $ responseLBS status404 [] ""
+tryExtraDevelFiles = toApp . tryExtraDevelFiles'
-tryExtraDevelFiles (f:fs) r = do
+
+tryExtraDevelFiles' :: [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Request -> IO Response
+tryExtraDevelFiles' [] _ = return $ responseLBS status404 [] ""
+tryExtraDevelFiles' (f:fs) r = do
     mct <- liftIO $ f $ drop 1 $ pathInfo r -- drop the initial "res"
     case mct of
-        Nothing -> tryExtraDevelFiles fs r
+        Nothing -> tryExtraDevelFiles' fs r
         Just (mime, ct) -> do
             let hash = T.encodeUtf8 $ T.pack $ base64md5 ct
             let headers = [ ("Content-Type", mime)
@@ -123,11 +133,19 @@ tryExtraDevelFiles (f:fs) r = do
 
 -- | Helper to create the development application at runtime
 develApp :: StaticSettings -> [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application
+#if MIN_VERSION_wai(3, 0, 0)
+develApp settings extra req sendResponse = do
+    staticApp settings {ssMaxAge = NoMaxAge} req $ \resp ->
+        if statusCode (responseStatus resp) == 404
+            then tryExtraDevelFiles extra req sendResponse
+            else sendResponse resp
+#else
 develApp settings extra req = do
     resp <- staticApp settings {ssMaxAge = NoMaxAge} req
     if statusCode (responseStatus resp) == 404
         then tryExtraDevelFiles extra req
         else return resp
+#endif
 
 -- | The type of 'addStaticContent'
 type AddStaticContent site = T.Text -> T.Text -> BL.ByteString

yesod-static/yesod-static.cabal

@@ -82,6 +82,7 @@ test-suite tests
                    , hspec >= 1.3
                    , yesod-test >= 1.2
                    , wai-test
+                   , wai-extra
                    , HUnit
 
                    -- copy from above

yesod-test/yesod-test.cabal

@@ -20,6 +20,7 @@ library
                    , transformers              >= 0.2.2
                    , wai                       >= 1.3
                    , wai-test                  >= 1.3
+                   , wai-extra
                    , network                   >= 2.2
                    , http-types                >= 0.7
                    , HUnit                     >= 1.2

yesod-websockets/Yesod/WebSockets.hs

@@ -46,7 +46,7 @@ webSockets :: (Y.MonadBaseControl IO m, Y.MonadHandler m) => WebSocketsT m () ->
 webSockets inner = do
     req <- Y.waiRequest
     when (WaiWS.isWebSocketsReq req) $
-        Y.sendRawResponse $ \src sink -> control $ \runInIO -> WaiWS.runWebSockets
+        Y.sendRawResponseNoConduit $ \src sink -> control $ \runInIO -> WaiWS.runWebSockets
             WS.defaultConnectionOptions
             (WaiWS.getRequestHead req)
             (\pconn -> do