diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs index 8a2d0760..ccd4c358 100644 --- a/yesod-bin/Devel.hs +++ b/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 diff --git a/yesod-bin/hsfiles/mongo.hsfiles b/yesod-bin/hsfiles/mongo.hsfiles index c593f816..fd63bda9 100644 --- a/yesod-bin/hsfiles/mongo.hsfiles +++ b/yesod-bin/hsfiles/mongo.hsfiles @@ -122,7 +122,6 @@ import Yesod import Yesod.Static import Yesod.Auth import Yesod.Auth.BrowserId -import Yesod.Auth.GoogleEmail import Yesod.Default.Config import Yesod.Default.Util (addStaticContentExternal) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) @@ -251,7 +250,7 @@ instance YesodAuth App where } -- You can add other plugins like BrowserID, email or OAuth here - authPlugins _ = [authBrowserId def, authGoogleEmail] + authPlugins _ = [authBrowserId def] authHttpManager = httpManager @@ -346,7 +345,6 @@ infixr 5 <> {-# START_FILE Model.hs #-} module Model where -import Prelude import Yesod import Data.Text (Text) import Database.Persist.Quasi @@ -362,7 +360,7 @@ let mongoSettings = (mkPersistSettings (ConT ''MongoBackend)) { mpsGeneric = False } in share [mkPersist mongoSettings] - $(persistFileWith lowerCaseSettings "config/models") + $(persistFileWith upperCaseSettings "config/models") {-# START_FILE PROJECTNAME.cabal #-} name: PROJECTNAME @@ -423,11 +421,11 @@ library , shakespeare >= 2.0 && < 2.1 , hjsmin >= 0.1 && < 0.2 , monad-control >= 0.3 && < 0.4 - , wai-extra >= 2.1 && < 2.2 + , wai-extra >= 3.0 && < 3.1 , yaml >= 0.8 && < 0.9 , http-conduit >= 2.1 && < 2.2 , directory >= 1.1 && < 1.3 - , warp >= 2.1 && < 2.2 + , warp >= 3.0 && < 3.1 , data-default , aeson >= 0.6 && < 0.8 , conduit >= 1.0 && < 2.0 diff --git a/yesod-bin/hsfiles/mysql.hsfiles b/yesod-bin/hsfiles/mysql.hsfiles index 2fcd2dfe..613142ec 100644 --- a/yesod-bin/hsfiles/mysql.hsfiles +++ b/yesod-bin/hsfiles/mysql.hsfiles @@ -129,7 +129,6 @@ import Yesod import Yesod.Static import Yesod.Auth import Yesod.Auth.BrowserId -import Yesod.Auth.GoogleEmail import Yesod.Default.Config import Yesod.Default.Util (addStaticContentExternal) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) @@ -260,7 +259,7 @@ instance YesodAuth App where } -- You can add other plugins like BrowserID, email or OAuth here - authPlugins _ = [authBrowserId def, authGoogleEmail] + authPlugins _ = [authBrowserId def] authHttpManager = httpManager @@ -355,7 +354,6 @@ infixr 5 <> {-# START_FILE Model.hs #-} module Model where -import Prelude import Yesod import Data.Text (Text) import Database.Persist.Quasi @@ -427,11 +425,11 @@ library , shakespeare >= 2.0 && < 2.1 , hjsmin >= 0.1 && < 0.2 , monad-control >= 0.3 && < 0.4 - , wai-extra >= 2.1 && < 2.2 + , wai-extra >= 3.0 && < 3.1 , yaml >= 0.8 && < 0.9 , http-conduit >= 2.1 && < 2.2 , directory >= 1.1 && < 1.3 - , warp >= 2.1 && < 2.2 + , warp >= 3.0 && < 3.1 , data-default , aeson >= 0.6 && < 0.8 , conduit >= 1.0 && < 2.0 diff --git a/yesod-bin/hsfiles/postgres-fay.hsfiles b/yesod-bin/hsfiles/postgres-fay.hsfiles index 934cd676..6ae1cf2d 100644 --- a/yesod-bin/hsfiles/postgres-fay.hsfiles +++ b/yesod-bin/hsfiles/postgres-fay.hsfiles @@ -132,7 +132,6 @@ import Yesod import Yesod.Static import Yesod.Auth import Yesod.Auth.BrowserId -import Yesod.Auth.GoogleEmail import Yesod.Default.Config import Yesod.Default.Util (addStaticContentExternal) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) @@ -273,7 +272,7 @@ instance YesodAuth App where } -- You can add other plugins like BrowserID, email or OAuth here - authPlugins _ = [authBrowserId def, authGoogleEmail] + authPlugins _ = [authBrowserId def] authHttpManager = httpManager @@ -387,7 +386,6 @@ infixr 5 <> {-# START_FILE Model.hs #-} module Model where -import Prelude import Yesod import Data.Text (Text) import Database.Persist.Quasi @@ -464,11 +462,11 @@ library , template-haskell , shakespeare >= 2.0 && < 2.1 , monad-control >= 0.3 && < 0.4 - , wai-extra >= 2.1 && < 2.2 + , wai-extra >= 3.0 && < 3.1 , yaml >= 0.8 && < 0.9 , http-conduit >= 2.1 && < 2.2 , directory >= 1.1 && < 1.3 - , warp >= 2.1 && < 2.2 + , warp >= 3.0 && < 3.1 , data-default , aeson >= 0.6 && < 0.8 , conduit >= 1.0 && < 2.0 diff --git a/yesod-bin/hsfiles/postgres.hsfiles b/yesod-bin/hsfiles/postgres.hsfiles index eb743911..47214641 100644 --- a/yesod-bin/hsfiles/postgres.hsfiles +++ b/yesod-bin/hsfiles/postgres.hsfiles @@ -129,7 +129,6 @@ import Yesod import Yesod.Static import Yesod.Auth import Yesod.Auth.BrowserId -import Yesod.Auth.GoogleEmail import Yesod.Default.Config import Yesod.Default.Util (addStaticContentExternal) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) @@ -260,7 +259,7 @@ instance YesodAuth App where } -- You can add other plugins like BrowserID, email or OAuth here - authPlugins _ = [authBrowserId def, authGoogleEmail] + authPlugins _ = [authBrowserId def] authHttpManager = httpManager @@ -355,7 +354,6 @@ infixr 5 <> {-# START_FILE Model.hs #-} module Model where -import Prelude import Yesod import Data.Text (Text) import Database.Persist.Quasi @@ -427,11 +425,11 @@ library , shakespeare >= 2.0 && < 2.1 , hjsmin >= 0.1 && < 0.2 , monad-control >= 0.3 && < 0.4 - , wai-extra >= 2.1 && < 2.2 + , wai-extra >= 3.0 && < 3.1 , yaml >= 0.8 && < 0.9 , http-conduit >= 2.1 && < 2.2 , directory >= 1.1 && < 1.3 - , warp >= 2.1 && < 2.2 + , warp >= 3.0 && < 3.1 , data-default , aeson >= 0.6 && < 0.8 , conduit >= 1.0 && < 2.0 diff --git a/yesod-bin/hsfiles/simple.hsfiles b/yesod-bin/hsfiles/simple.hsfiles index f534c98f..65150af4 100644 --- a/yesod-bin/hsfiles/simple.hsfiles +++ b/yesod-bin/hsfiles/simple.hsfiles @@ -113,6 +113,8 @@ module Foundation where import Prelude import Yesod import Yesod.Static +import Yesod.Auth +import Yesod.Auth.BrowserId import Yesod.Default.Config import Yesod.Default.Util (addStaticContentExternal) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) @@ -351,11 +353,11 @@ library , shakespeare >= 2.0 && < 2.1 , hjsmin >= 0.1 && < 0.2 , monad-control >= 0.3 && < 0.4 - , wai-extra >= 2.1 && < 2.2 + , wai-extra >= 3.0 && < 3.1 , yaml >= 0.8 && < 0.9 , http-conduit >= 2.1 && < 2.2 , directory >= 1.1 && < 1.3 - , warp >= 2.1 && < 2.2 + , warp >= 3.0 && < 3.1 , data-default , aeson >= 0.6 && < 0.8 , conduit >= 1.0 && < 2.0 diff --git a/yesod-bin/hsfiles/sqlite.hsfiles b/yesod-bin/hsfiles/sqlite.hsfiles index d8caba18..9c57415e 100644 --- a/yesod-bin/hsfiles/sqlite.hsfiles +++ b/yesod-bin/hsfiles/sqlite.hsfiles @@ -129,7 +129,6 @@ import Yesod import Yesod.Static import Yesod.Auth import Yesod.Auth.BrowserId -import Yesod.Auth.GoogleEmail import Yesod.Default.Config import Yesod.Default.Util (addStaticContentExternal) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) @@ -260,7 +259,7 @@ instance YesodAuth App where } -- You can add other plugins like BrowserID, email or OAuth here - authPlugins _ = [authBrowserId def, authGoogleEmail] + authPlugins _ = [authBrowserId def] authHttpManager = httpManager @@ -355,7 +354,6 @@ infixr 5 <> {-# START_FILE Model.hs #-} module Model where -import Prelude import Yesod import Data.Text (Text) import Database.Persist.Quasi @@ -427,11 +425,11 @@ library , shakespeare >= 2.0 && < 2.1 , hjsmin >= 0.1 && < 0.2 , monad-control >= 0.3 && < 0.4 - , wai-extra >= 2.1 && < 2.2 + , wai-extra >= 3.0 && < 3.1 , yaml >= 0.8 && < 0.9 , http-conduit >= 2.1 && < 2.2 , directory >= 1.1 && < 1.3 - , warp >= 2.1 && < 2.2 + , warp >= 3.0 && < 3.1 , data-default , aeson >= 0.6 && < 0.8 , conduit >= 1.0 && < 2.0 diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index faecfbb0..24356f60 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -1,5 +1,5 @@ name: yesod-bin -version: 1.2.9.4 +version: 1.2.10.1 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-core/Yesod/Core/Dispatch.hs b/yesod-core/Yesod/Core/Dispatch.hs index 59663a8f..e0d1f0e6 100644 --- a/yesod-core/Yesod/Core/Dispatch.hs +++ b/yesod-core/Yesod/Core/Dispatch.hs @@ -92,8 +92,13 @@ toWaiAppYre yre req = where site = yreSite yre sendRedirect :: Yesod master => master -> [Text] -> W.Application +#if MIN_VERSION_wai(3, 0, 0) + sendRedirect y segments' env sendResponse = + sendResponse $ W.responseLBS status301 +#else sendRedirect y segments' env = return $ W.responseLBS status301 +#endif [ ("Content-Type", "text/plain") , ("Location", Blaze.ByteString.Builder.toByteString dest') ] "Redirecting" diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index e5cbc443..2e5d7cb4 100644 --- a/yesod-core/Yesod/Core/Handler.hs +++ b/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 @@ -198,6 +201,8 @@ import Control.Exception (throwIO) import Blaze.ByteString.Builder (Builder) import Safe (headMay) import Data.CaseInsensitive (CI) +import qualified Data.Conduit.List as CL +import Control.Monad (unless) import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO #if MIN_VERSION_wai(2, 0, 0) #else @@ -368,7 +373,11 @@ handlerToIO = where oldReq = handlerRequest oldHandlerData oldWaiReq = reqWaiRequest oldReq +#if MIN_VERSION_wai(3, 0, 0) + newWaiReq = oldWaiReq { W.requestBody = return mempty +#else newWaiReq = oldWaiReq { W.requestBody = mempty +#endif , W.requestBodyLength = W.KnownLength 0 } oldEnv = handlerEnv oldHandlerData @@ -576,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., @@ -585,6 +612,19 @@ sendWaiResponse = handlerError . HCWai sendRawResponse :: (MonadHandler m, MonadBaseControl IO m) => (Source IO S8.ByteString -> Sink S8.ByteString IO () -> m ()) -> m a +#if MIN_VERSION_wai(3, 0, 0) +sendRawResponse raw = control $ \runInIO -> + runInIO $ sendWaiResponse $ flip W.responseRaw fallback + $ \src sink -> runInIO (raw (src' src) (CL.mapM_ sink)) >> return () + where + fallback = W.responseLBS H.status500 [("Content-Type", "text/plain")] + "sendRawResponse: backend does not support raw responses" + src' src = do + bs <- liftIO src + unless (S.null bs) $ do + yield bs + src' src +#else sendRawResponse raw = control $ \runInIO -> runInIO $ sendWaiResponse $ flip W.responseRaw fallback $ \src sink -> runInIO (raw src sink) >> return () @@ -592,6 +632,7 @@ sendRawResponse raw = control $ \runInIO -> fallback = W.responseLBS H.status500 [("Content-Type", "text/plain")] "sendRawResponse: backend does not support raw responses" #endif +#endif -- | Return a 404 not found page. Also denotes no handler available. notFound :: MonadHandler m => m a @@ -1068,6 +1109,14 @@ provideRepType ct handler = rawRequestBody :: MonadHandler m => Source m S.ByteString rawRequestBody = do req <- lift waiRequest +#if MIN_VERSION_wai(3, 0, 0) + let loop = do + bs <- liftIO $ W.requestBody req + unless (S.null bs) $ do + yield bs + loop + loop +#else transPipe #if MIN_VERSION_wai(2, 0, 0) liftIO @@ -1075,6 +1124,7 @@ rawRequestBody = do liftResourceT #endif (W.requestBody req) +#endif -- | Stream the data from the file. Since Yesod 1.2, this has been generalized -- to work in any @MonadResource@. diff --git a/yesod-core/Yesod/Core/Internal/Request.hs b/yesod-core/Yesod/Core/Internal/Request.hs index 769fd2d3..ba2fd2fc 100644 --- a/yesod-core/Yesod/Core/Internal/Request.hs +++ b/yesod-core/Yesod/Core/Internal/Request.hs @@ -44,11 +44,28 @@ import Control.Monad.Trans.Resource (runResourceT, ResourceT) import Control.Exception (throwIO) import Yesod.Core.Types import qualified Data.Map as Map +import Data.IORef -- | Impose a limit on the size of the request body. -limitRequestBody :: Word64 -> W.Request -> W.Request +limitRequestBody :: Word64 -> W.Request -> IO W.Request +#if MIN_VERSION_wai(3, 0, 0) +limitRequestBody maxLen req = do + ref <- newIORef maxLen + return req + { W.requestBody = do + bs <- W.requestBody req + remaining <- readIORef ref + let len = fromIntegral $ S8.length bs + remaining' = remaining - len + if remaining < len + then throwIO $ HCWai tooLargeResponse + else do + writeIORef ref remaining' + return bs + } +#else limitRequestBody maxLen req = - req { W.requestBody = W.requestBody req $= limit maxLen } + return req { W.requestBody = W.requestBody req $= limit maxLen } where tooLarge = liftIO $ throwIO $ HCWai tooLargeResponse @@ -63,6 +80,7 @@ limitRequestBody maxLen req = else do yield bs limit $ remaining - len +#endif tooLargeResponse :: W.Response tooLargeResponse = W.responseLBS @@ -75,7 +93,7 @@ parseWaiRequest :: RandomGen g -> SessionMap -> Bool -> Maybe Word64 -- ^ max body size - -> (Either YesodRequest (g -> YesodRequest)) + -> (Either (IO YesodRequest) (g -> IO YesodRequest)) parseWaiRequest env session useToken mmaxBodySize = -- In most cases, we won't need to generate any random values. Therefore, -- we split our results: if we need a random generator, return a Right @@ -85,17 +103,19 @@ parseWaiRequest env session useToken mmaxBodySize = Left token -> Left $ mkRequest token Right mkToken -> Right $ mkRequest . mkToken where - mkRequest token' = YesodRequest - { reqGetParams = gets - , reqCookies = cookies - , reqWaiRequest = maybe id limitRequestBody mmaxBodySize env - , reqLangs = langs'' - , reqToken = token' - , reqSession = if useToken - then Map.delete tokenKey session - else session - , reqAccept = httpAccept env - } + mkRequest token' = do + envLimited <- maybe return limitRequestBody mmaxBodySize env + return YesodRequest + { reqGetParams = gets + , reqCookies = cookies + , reqWaiRequest = envLimited + , reqLangs = langs'' + , reqToken = token' + , reqSession = if useToken + then Map.delete tokenKey session + else session + , reqAccept = httpAccept env + } gets = textQueryString env reqCookie = lookup "Cookie" $ W.requestHeaders env cookies = maybe [] parseCookiesText reqCookie diff --git a/yesod-core/Yesod/Core/Internal/Response.hs b/yesod-core/Yesod/Core/Internal/Response.hs index 3f06ac23..7336ef1d 100644 --- a/yesod-core/Yesod/Core/Internal/Response.hs +++ b/yesod-core/Yesod/Core/Internal/Response.hs @@ -33,7 +33,49 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Map as Map import Yesod.Core.Internal.Request (tokenKey) import Data.Text.Encoding (encodeUtf8) +import Data.Conduit (Flush (..), ($$)) +import qualified Data.Conduit.List as CL +#if MIN_VERSION_wai(3, 0, 0) +yarToResponse :: YesodResponse + -> (SessionMap -> IO [Header]) -- ^ save session + -> YesodRequest + -> Request + -> InternalState + -> IO Response +yarToResponse (YRWai a) _ _ _ _ = return a +yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq req is = do + extraHeaders <- do + let nsToken = maybe + newSess + (\n -> Map.insert tokenKey (encodeUtf8 n) newSess) + (reqToken yreq) + sessionHeaders <- saveSession nsToken + return $ ("Content-Type", ct) : map headerToPair sessionHeaders + let finalHeaders = extraHeaders ++ map headerToPair hs + finalHeaders' len = ("Content-Length", S8.pack $ show len) + : finalHeaders + + let go (ContentBuilder b mlen) = do + let hs' = maybe finalHeaders finalHeaders' mlen + return $ ResponseBuilder s hs' b + go (ContentFile fp p) = do + return $ ResponseFile s finalHeaders fp p + go (ContentSource body) = return $ responseStream s finalHeaders + $ \sendChunk flush -> do + transPipe (flip runInternalState is) body + $$ CL.mapM_ (\mchunk -> + case mchunk of + Flush -> flush + Chunk builder -> sendChunk builder) + go (ContentDontEvaluate c') = go c' + go c + where + s + | s' == defaultStatus = H.status200 + | otherwise = s' + +#else yarToResponse :: YesodResponse -> (SessionMap -> IO [Header]) -- ^ save session -> YesodRequest @@ -106,6 +148,7 @@ yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq req s | s' == defaultStatus = H.status200 | otherwise = s' +#endif -- | Indicates that the user provided no specific status code to be used, and -- therefore the default status code should be used. For normal responses, this diff --git a/yesod-core/Yesod/Core/Internal/Run.hs b/yesod-core/Yesod/Core/Internal/Run.hs index 3e2e4e08..9a87f932 100644 --- a/yesod-core/Yesod/Core/Internal/Run.hs +++ b/yesod-core/Yesod/Core/Internal/Run.hs @@ -230,7 +230,11 @@ runFakeHandler fakeSessionMap logger site handler = liftIO $ do , remoteHost = error "runFakeHandler-remoteHost" , pathInfo = ["runFakeHandler", "pathInfo"] , queryString = [] +#if MIN_VERSION_wai(3, 0, 0) + , requestBody = return mempty +#else , requestBody = mempty +#endif , vault = mempty , requestBodyLength = KnownLength 0 } @@ -253,8 +257,13 @@ yesodRunner :: (ToTypedContent res, Yesod site) -> YesodRunnerEnv site -> Maybe (Route site) -> Application +#if MIN_VERSION_wai(3, 0, 0) +yesodRunner handler' YesodRunnerEnv {..} route req sendResponse + | Just maxLen <- mmaxLen, KnownLength len <- requestBodyLength req, maxLen < len = sendResponse tooLargeResponse +#else yesodRunner handler' YesodRunnerEnv {..} route req | Just maxLen <- mmaxLen, KnownLength len <- requestBodyLength req, maxLen < len = return tooLargeResponse +#endif | otherwise = do let dontSaveSession _ = return [] (session, saveSession) <- liftIO $ do @@ -281,6 +290,16 @@ yesodRunner handler' YesodRunnerEnv {..} route req rhe = rheSafe { rheOnError = runHandler rheSafe . errorHandler } +#if MIN_VERSION_wai(3, 0, 0) + + E.bracket createInternalState closeInternalState $ \is -> do + yreq' <- yreq + yar <- runInternalState (runHandler rhe handler yreq') is + res <- yarToResponse yar saveSession yreq' req is + sendResponse res + +#else + #if MIN_VERSION_wai(2, 0, 0) bracketOnError createInternalState closeInternalState $ \is -> do yar <- runInternalState (runHandler rhe handler yreq) is @@ -288,6 +307,7 @@ yesodRunner handler' YesodRunnerEnv {..} route req #else yar <- runHandler rhe handler yreq liftIO $ yarToResponse yar saveSession yreq req +#endif #endif where mmaxLen = maximumContentLength yreSite route diff --git a/yesod-core/test/YesodCoreTest/CleanPath.hs b/yesod-core/test/YesodCoreTest/CleanPath.hs index b5427e3f..cbbd0cb5 100644 --- a/yesod-core/test/YesodCoreTest/CleanPath.hs +++ b/yesod-core/test/YesodCoreTest/CleanPath.hs @@ -1,6 +1,7 @@ {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances, ViewPatterns #-} +{-# LANGUAGE CPP #-} module YesodCoreTest.CleanPath (cleanPathTest, Widget) where import Test.Hspec @@ -32,7 +33,11 @@ instance ParseRoute Subsite where parseRoute (x, _) = Just $ SubsiteRoute x instance YesodSubDispatch Subsite master where +#if MIN_VERSION_wai(3, 0, 0) + yesodSubDispatch _ req f = f $ responseLBS +#else yesodSubDispatch _ req = return $ responseLBS +#endif status200 [ ("Content-Type", "SUBSITE") ] $ L8.pack $ show (pathInfo req) diff --git a/yesod-core/test/YesodCoreTest/ErrorHandling.hs b/yesod-core/test/YesodCoreTest/ErrorHandling.hs index 1506c9c1..f904603f 100644 --- a/yesod-core/test/YesodCoreTest/ErrorHandling.hs +++ b/yesod-core/test/YesodCoreTest/ErrorHandling.hs @@ -128,7 +128,7 @@ errorHandlingTest = describe "Test.ErrorHandling" $ do it "builder includes content-length" caseGoodBuilder forM_ [1..10] $ \i -> it ("error case " ++ show i) (caseError i) -runner :: Session () -> IO () +runner :: Session a -> IO a runner f = toWaiApp App >>= runSession f caseNotFound :: IO () @@ -175,11 +175,10 @@ caseErrorInBody = runner $ do caseErrorInBodyNoEval :: IO () caseErrorInBodyNoEval = do eres <- try $ runner $ do - _ <- request defaultRequest { pathInfo = ["error-in-body-noeval"] } - return () + request defaultRequest { pathInfo = ["error-in-body-noeval"] } case eres of Left (_ :: SomeException) -> return () - Right _ -> error "Expected an exception" + Right x -> error $ "Expected an exception, got: " ++ show x caseOverrideStatus :: IO () caseOverrideStatus = runner $ do diff --git a/yesod-core/test/YesodCoreTest/InternalRequest.hs b/yesod-core/test/YesodCoreTest/InternalRequest.hs index 792b484f..94346aad 100644 --- a/yesod-core/test/YesodCoreTest/InternalRequest.hs +++ b/yesod-core/test/YesodCoreTest/InternalRequest.hs @@ -12,6 +12,7 @@ import Data.Monoid (mempty) import Data.Map (singleton) import Yesod.Core import Data.Word (Word64) +import System.IO.Unsafe (unsafePerformIO) randomStringSpecs :: Spec randomStringSpecs = describe "Yesod.Internal.Request.randomString" $ do @@ -36,7 +37,7 @@ parseWaiRequest' :: Request -> Bool -> Word64 -> YesodRequest -parseWaiRequest' a b c d = +parseWaiRequest' a b c d = unsafePerformIO $ -- ugly hack, just to ease migration, should be removed case parseWaiRequest a b c (Just d) of Left yreq -> yreq Right needGen -> needGen g diff --git a/yesod-core/test/YesodCoreTest/RequestBodySize.hs b/yesod-core/test/YesodCoreTest/RequestBodySize.hs index 514559ac..42fa767b 100644 --- a/yesod-core/test/YesodCoreTest/RequestBodySize.hs +++ b/yesod-core/test/YesodCoreTest/RequestBodySize.hs @@ -83,8 +83,8 @@ specs :: Spec specs = describe "Test.RequestBodySize" $ do caseHelper "lookupPostParam- large" "post" "foobarbaz=bin" 413 413 caseHelper "lookupPostParam- small" "post" "foo=bin" 200 200 - caseHelper "consume- large" "consume" "this is longer than 10" 413 413 - caseHelper "consume- small" "consume" "smaller" 200 200 + caseHelper "total consume- large" "consume" "this is longer than 10" 413 413 + caseHelper "total consume- small" "consume" "smaller" 200 200 caseHelper "partial consume- large" "partial-consume" "this is longer than 10" 200 413 caseHelper "partial consume- small" "partial-consume" "smaller" 200 200 caseHelper "unused- large" "unused" "this is longer than 10" 200 413 diff --git a/yesod-core/test/YesodCoreTest/WaiSubsite.hs b/yesod-core/test/YesodCoreTest/WaiSubsite.hs index a30469e5..b16d0f65 100644 --- a/yesod-core/test/YesodCoreTest/WaiSubsite.hs +++ b/yesod-core/test/YesodCoreTest/WaiSubsite.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-} +{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-} module YesodCoreTest.WaiSubsite (specs, Widget) where import YesodCoreTest.YesodTest @@ -6,7 +6,11 @@ import Yesod.Core import qualified Network.HTTP.Types as H myApp :: Application +#if MIN_VERSION_wai(3, 0, 0) +myApp _ f = f $ responseLBS H.status200 [("Content-type", "text/plain")] "WAI" +#else myApp _ = return $ responseLBS H.status200 [("Content-type", "text/plain")] "WAI" +#endif getApp :: a -> WaiSubsite getApp _ = WaiSubsite myApp diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 824a01d0..55e20529 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.2.15.2 +version: 1.2.16 license: MIT license-file: LICENSE author: Michael Snoyman @@ -38,7 +38,7 @@ library , shakespeare-css >= 1.0 , shakespeare-i18n >= 1.0 , blaze-builder >= 0.2.1.4 && < 0.4 - , transformers >= 0.2.2 && < 0.4 + , transformers >= 0.2.2 , mtl , clientsession >= 0.9 && < 0.10 , random >= 1.0.0.2 && < 1.1 @@ -131,6 +131,7 @@ test-suite tests , conduit-extra , shakespeare , streaming-commons + , wai-extra ghc-options: -Wall extensions: TemplateHaskell diff --git a/yesod-eventsource/Yesod/EventSource.hs b/yesod-eventsource/Yesod/EventSource.hs index df698cfd..4a265124 100644 --- a/yesod-eventsource/Yesod/EventSource.hs +++ b/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 diff --git a/yesod-eventsource/yesod-eventsource.cabal b/yesod-eventsource/yesod-eventsource.cabal index 0d3e20fc..52471574 100644 --- a/yesod-eventsource/yesod-eventsource.cabal +++ b/yesod-eventsource/yesod-eventsource.cabal @@ -1,5 +1,5 @@ name: yesod-eventsource -version: 1.1.0.2 +version: 1.1.1 license: MIT license-file: LICENSE author: Felipe Lessa @@ -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 diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal index 9edc6eb1..b771ba3f 100644 --- a/yesod-form/yesod-form.cabal +++ b/yesod-form/yesod-form.cabal @@ -1,5 +1,5 @@ name: yesod-form -version: 1.3.9.1 +version: 1.3.10 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-persistent/yesod-persistent.cabal b/yesod-persistent/yesod-persistent.cabal index af0d4dfb..a6ce68f7 100644 --- a/yesod-persistent/yesod-persistent.cabal +++ b/yesod-persistent/yesod-persistent.cabal @@ -1,5 +1,5 @@ name: yesod-persistent -version: 1.2.2.3 +version: 1.2.3 license: MIT license-file: LICENSE author: Michael Snoyman @@ -17,7 +17,7 @@ library , yesod-core >= 1.2.2 && < 1.3 , persistent >= 1.2 && < 2.1 , persistent-template >= 1.2 && < 2.1 - , transformers >= 0.2.2 && < 0.4 + , transformers >= 0.2.2 , blaze-builder , conduit , resourcet >= 0.4.5 @@ -34,6 +34,7 @@ test-suite test build-depends: base , hspec , wai-test + , wai-extra , yesod-core , persistent-sqlite , yesod-persistent diff --git a/yesod-platform/to-cabal.hs b/yesod-platform/to-cabal.hs index dcbaed6f..b8ff2220 100644 --- a/yesod-platform/to-cabal.hs +++ b/yesod-platform/to-cabal.hs @@ -3,7 +3,7 @@ import Control.Applicative ((<$>)) main = do pkgs <- map (intercalate " == ") - . filter (\xs -> not $ any (`isPrefixOf` xs) $ map return ["parsec", "text", "transformers", "mtl", "HUnit", "QuickCheck", "binary", "zlib", "stm", "regex-compat", "hashable", "vault"]) + . filter (\xs -> not $ any (`isPrefixOf` xs) $ map return ["parsec", "text", "transformers", "mtl", "HUnit", "QuickCheck", "binary", "zlib", "stm", "regex-compat", "hashable", "vault", "integer-gmp"]) . map words . filter (not . null) . lines diff --git a/yesod-platform/yesod-platform.cabal b/yesod-platform/yesod-platform.cabal index f7c94ce9..aa55459b 100644 --- a/yesod-platform/yesod-platform.cabal +++ b/yesod-platform/yesod-platform.cabal @@ -1,5 +1,5 @@ name: yesod-platform -version: 1.2.10 +version: 1.2.12 license: MIT license-file: LICENSE author: Michael Snoyman @@ -15,32 +15,32 @@ homepage: http://www.yesodweb.com/ library build-depends: base >= 4 && < 5 , SHA == 1.6.4 - , aeson == 0.7.0.3 + , aeson == 0.7.0.6 , ansi-terminal == 0.6.1.1 , ansi-wl-pprint == 0.6.7.1 , asn1-encoding == 0.8.1.3 , asn1-parse == 0.8.1 , asn1-types == 0.2.3 , async == 2.0.1.5 - , attoparsec == 0.11.2.1 + , attoparsec == 0.12.0.0 , attoparsec-conduit == 1.1.0 , authenticate == 1.3.2.8 - , base-unicode-symbols == 0.2.2.4 , base16-bytestring == 0.1.1.6 , base64-bytestring == 1.0.0.1 , blaze-builder == 0.3.3.2 , blaze-builder-conduit == 1.1.0 - , blaze-html == 0.7.0.1 - , blaze-markup == 0.6.0.0 + , blaze-html == 0.7.0.2 + , blaze-markup == 0.6.1.0 , byteable == 0.1.1 , byteorder == 1.0.4 , case-insensitive == 1.2.0.0 , cereal == 0.4.0.1 , cipher-aes == 0.2.7 + , cipher-des == 0.0.6 , cipher-rc4 == 0.1.4 , clientsession == 0.9.0.3 - , conduit == 1.1.0.2 - , conduit-extra == 1.1.0.1 + , conduit == 1.1.6 + , conduit-extra == 1.1.0.4 , connection == 0.2.1 , cookie == 0.4.1.1 , cprng-aes == 0.5.2 @@ -50,7 +50,7 @@ library , crypto-pubkey == 0.2.4 , crypto-pubkey-types == 0.4.2.2 , crypto-random == 0.0.7 - , cryptohash == 0.11.4 + , cryptohash == 0.11.5 , cryptohash-conduit == 0.1.1 , css-text == 0.1.2.1 , data-default == 0.5.3 @@ -61,46 +61,47 @@ library , data-default-instances-old-locale == 0.0.1 , dlist == 0.7.0.1 , email-validate == 2.0.1 - , entropy == 0.2.2.4 - , esqueleto == 1.3.12 - , exceptions == 0.5 + , entropy == 0.3 + , esqueleto == 1.4.1.2 + , exceptions == 0.6.1 , fast-logger == 2.1.5 - , file-embed == 0.0.6 + , file-embed == 0.0.7 , hamlet == 1.2.0 , hjsmin == 0.1.4.6 - , hspec == 1.9.2 + , hspec == 1.9.5 , hspec-expectations == 0.5.0.1 - , html-conduit == 1.1.0.4 - , http-client == 0.3.1.1 + , html-conduit == 1.1.0.5 + , http-client == 0.3.3 , http-client-tls == 0.2.1.1 - , http-conduit == 2.1.1 + , http-conduit == 2.1.2 , http-date == 0.0.4 - , http-reverse-proxy == 0.3.1.5 - , http-types == 0.8.4 - , language-javascript == 0.5.12 - , lifted-base == 0.2.2.1 - , mime-mail == 0.4.5.1 + , http-reverse-proxy == 0.3.1.8 + , http-types == 0.8.5 + , language-javascript == 0.5.13 + , lifted-base == 0.2.2.2 + , mime-mail == 0.4.5.2 , mime-types == 0.1.0.4 - , mmorph == 1.0.2 - , monad-control == 0.3.2.3 - , monad-logger == 0.3.6 + , mmorph == 1.0.3 + , monad-control == 0.3.3.0 + , monad-logger == 0.3.6.1 , monad-loops == 0.4.2 + , nats == 0.2 , network-conduit == 1.1.0 - , optparse-applicative == 0.8.0.1 + , optparse-applicative == 0.8.1 , path-pieces == 0.1.3.1 , pem == 0.2.2 - , persistent == 1.3.0.6 - , persistent-template == 1.3.1.3 - , primitive == 0.5.2.1 + , persistent == 1.3.1.1 + , persistent-template == 1.3.1.4 + , primitive == 0.5.3.0 , publicsuffixlist == 0.1 , pwstore-fast == 2.4.1 , quickcheck-io == 0.1.1 - , resource-pool == 0.2.1.1 - , resourcet == 1.1.2 + , resource-pool == 0.2.3.0 + , resourcet == 1.1.2.2 , safe == 0.3.4 - , scientific == 0.2.0.2 + , scientific == 0.3.2.1 , securemem == 0.1.3 - , semigroups == 0.13.0.1 + , semigroups == 0.15 , setenv == 0.1.1.1 , shakespeare == 2.0.0.3 , shakespeare-css == 1.1.0 @@ -112,47 +113,47 @@ library , skein == 1.0.9 , socks == 0.5.4 , stm-chans == 3.0.0.2 - , streaming-commons == 0.1.1 + , streaming-commons == 0.1.3 , stringsearch == 0.3.6.5 - , system-fileio == 0.3.12 - , system-filepath == 0.4.10 - , tagged == 0.7.1 + , system-fileio == 0.3.14 + , system-filepath == 0.4.12 + , tagged == 0.7.2 , tagsoup == 0.13.1 , tagstream-conduit == 0.5.5.1 , tf-random == 0.5 - , tls == 1.2.6 - , transformers-base == 0.4.1 + , tls == 1.2.8 + , transformers-base == 0.4.2 + -- , transformers-compat == 0.3.3.4 , unix-compat == 0.4.1.1 , unordered-containers == 0.2.4.0 - , utf8-string == 0.3.7 - , vector == 0.10.9.1 + , utf8-string == 0.3.8 + , vector == 0.10.11.0 , void == 0.6.1 - , wai == 2.1.0.2 - , wai-app-static == 2.0.1 - , wai-extra == 2.1.1.1 + , wai == 3.0.0 + , wai-app-static == 3.0.0 + , wai-extra == 3.0.0 , wai-logger == 2.1.1 - , wai-test == 2.0.1.1 - , warp == 2.1.4 - , warp-tls == 2.0.3.3 + , wai-test == 3.0.0 + , warp == 3.0.0 + , warp-tls == 3.0.0 , word8 == 0.0.4 , x509 == 1.4.11 , x509-store == 1.4.4 - , x509-system == 1.4.2 + , x509-system == 1.4.5 , x509-validation == 1.5.0 - , xml-conduit == 1.2.0.1 + , xml-conduit == 1.2.0.2 , xml-types == 0.3.4 , xss-sanitize == 0.3.5.2 - , yaml == 0.8.8.2 - , yesod == 1.2.5.2 - , yesod-auth == 1.3.0.4 + , yaml == 0.8.8.3 + , yesod == 1.2.6 + , yesod-auth == 1.3.1 , yesod-auth-hashdb == 1.3.0.1 - , yesod-core == 1.2.14 - , yesod-form == 1.3.8.2 - , yesod-persistent == 1.2.2.3 + , yesod-core == 1.2.16 + , yesod-form == 1.3.10 + , yesod-persistent == 1.2.3 , yesod-routes == 1.2.0.6 - , yesod-static == 1.2.2.5 - , yesod-test == 1.2.1.2 - , zlib-conduit == 1.1.0 + , yesod-static == 1.2.4 + , yesod-test == 1.2.3 exposed-modules: Yesod.Platform diff --git a/yesod-static/Yesod/EmbeddedStatic.hs b/yesod-static/Yesod/EmbeddedStatic.hs index e8196302..e5d2a14c 100644 --- a/yesod-static/Yesod/EmbeddedStatic.hs +++ b/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] diff --git a/yesod-static/Yesod/EmbeddedStatic/Internal.hs b/yesod-static/Yesod/EmbeddedStatic/Internal.hs index 0882c16d..640c4e32 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Internal.hs +++ b/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 (f:fs) r = do +tryExtraDevelFiles = toApp . tryExtraDevelFiles' + +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 diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index 2582a958..19ffec7e 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -1,5 +1,5 @@ name: yesod-static -version: 1.2.3 +version: 1.2.4 license: MIT license-file: LICENSE author: Michael Snoyman @@ -82,6 +82,7 @@ test-suite tests , hspec >= 1.3 , yesod-test >= 1.2 , wai-test + , wai-extra , HUnit -- copy from above diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index 48d0215b..acf1426e 100644 --- a/yesod-test/yesod-test.cabal +++ b/yesod-test/yesod-test.cabal @@ -1,5 +1,5 @@ name: yesod-test -version: 1.2.2 +version: 1.2.3 license: MIT license-file: LICENSE author: Nubis @@ -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 diff --git a/yesod-websockets/Yesod/WebSockets.hs b/yesod-websockets/Yesod/WebSockets.hs index eebe9202..ad2f5ad4 100644 --- a/yesod-websockets/Yesod/WebSockets.hs +++ b/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 diff --git a/yesod-websockets/yesod-websockets.cabal b/yesod-websockets/yesod-websockets.cabal index 49fb58b5..5185e45b 100644 --- a/yesod-websockets/yesod-websockets.cabal +++ b/yesod-websockets/yesod-websockets.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: yesod-websockets -version: 0.1.0.0 +version: 0.1.1 synopsis: WebSockets support for Yesod description: WebSockets support for Yesod homepage: https://github.com/yesodweb/yesod diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index 2cef56c1..d2282c2e 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -1,5 +1,5 @@ name: yesod -version: 1.2.5.3 +version: 1.2.6 license: MIT license-file: LICENSE author: Michael Snoyman @@ -27,7 +27,7 @@ library , yesod-persistent >= 1.2 && < 1.3 , yesod-form >= 1.3 && < 1.4 , monad-control >= 0.3 && < 0.4 - , transformers >= 0.2.2 && < 0.4 + , transformers >= 0.2.2 , wai >= 1.3 , wai-extra >= 1.3 , hamlet >= 1.1