From 2d0f560bea358c65a314a03554a28d0dfcdbe815 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 19 Aug 2013 12:51:47 +0300 Subject: [PATCH] wai 2.0 --- yesod-core/Yesod/Core/Handler.hs | 23 ++++++++++- yesod-core/Yesod/Core/Internal/Response.hs | 15 ++++++- yesod-core/Yesod/Core/Internal/Run.hs | 46 +++++++++++++++++++--- yesod-core/yesod-core.cabal | 4 +- yesod-eventsource/yesod-eventsource.cabal | 4 +- yesod-static/yesod-static.cabal | 4 +- yesod/yesod.cabal | 6 +-- 7 files changed, 84 insertions(+), 18 deletions(-) diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index f3b1799b..c956abc4 100644 --- a/yesod-core/Yesod/Core/Handler.hs +++ b/yesod-core/Yesod/Core/Handler.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} @@ -229,11 +230,19 @@ runRequestBody = do Just rbc -> return rbc Nothing -> do rr <- waiRequest +#if MIN_VERSION_wai(0, 2, 0) + rbc <- liftIO $ rbHelper upload rr +#else rbc <- liftResourceT $ rbHelper upload rr +#endif put x { ghsRBC = Just rbc } return rbc +#if MIN_VERSION_wai(2, 0, 0) +rbHelper :: FileUpload -> W.Request -> IO RequestBodyContents +#else rbHelper :: FileUpload -> W.Request -> ResourceT IO RequestBodyContents +#endif rbHelper upload = case upload of FileUploadMemory s -> rbHelper' s mkFileInfoLBS @@ -243,7 +252,11 @@ rbHelper upload = rbHelper' :: NWP.BackEnd x -> (Text -> Text -> x -> FileInfo) -> W.Request +#if MIN_VERSION_wai(2, 0, 0) + -> IO ([(Text, Text)], [(Text, FileInfo)]) +#else -> ResourceT IO ([(Text, Text)], [(Text, FileInfo)]) +#endif rbHelper' backend mkFI req = (map fix1 *** mapMaybe fix2) <$> (NWP.parseRequestBody backend req) where @@ -916,7 +929,7 @@ selectRep w = do ]) reps -- match on the type for sub-type wildcards. - -- If the accept is text/* it should match a provided text/html + -- If the accept is text/ * it should match a provided text/html mainTypeMap = Map.fromList $ reverse $ map (\v@(ProvidedRep ct _) -> (fst $ contentTypeTypes ct, v)) reps @@ -972,7 +985,13 @@ provideRepType ct handler = rawRequestBody :: MonadHandler m => Source m S.ByteString rawRequestBody = do req <- lift waiRequest - transPipe liftResourceT $ W.requestBody req + transPipe +#if MIN_VERSION_wai(0, 2, 0) + liftIO +#else + liftResourceT +#endif + (W.requestBody req) -- | 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/Response.hs b/yesod-core/Yesod/Core/Internal/Response.hs index b71ea5c2..411713ac 100644 --- a/yesod-core/Yesod/Core/Internal/Response.hs +++ b/yesod-core/Yesod/Core/Internal/Response.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RankNTypes #-} @@ -12,6 +13,11 @@ import qualified Data.ByteString.Char8 as S8 import Data.CaseInsensitive (CI) import qualified Data.CaseInsensitive as CI import Network.Wai +#if MIN_VERSION_wai(2, 0, 0) +import Data.Conduit (transPipe) +import Control.Monad.Trans.Resource (runInternalState) +import Network.Wai.Internal +#endif import Prelude hiding (catch) import Web.Cookie (renderSetCookie) import Yesod.Core.Content @@ -30,9 +36,10 @@ yarToResponse :: Monad m => YesodResponse -> (SessionMap -> m [Header]) -- ^ save session -> YesodRequest + -> Request -> m Response -yarToResponse (YRWai a) _ _ = return a -yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq = do +yarToResponse (YRWai a) _ _ _ = return a +yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq req = do extraHeaders <- do let nsToken = maybe newSess @@ -47,7 +54,11 @@ yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq = do let hs' = maybe finalHeaders finalHeaders' mlen in ResponseBuilder s hs' b go (ContentFile fp p) = ResponseFile s finalHeaders fp p +#if MIN_VERSION_wai(0, 2, 0) + go (ContentSource body) = ResponseSource s finalHeaders $ transPipe (flip runInternalState $ resourceInternalState req) body +#else go (ContentSource body) = ResponseSource s finalHeaders body +#endif go (ContentDontEvaluate c') = go c' return $ go c where diff --git a/yesod-core/Yesod/Core/Internal/Run.hs b/yesod-core/Yesod/Core/Internal/Run.hs index 35f1d3fd..f60dd701 100644 --- a/yesod-core/Yesod/Core/Internal/Run.hs +++ b/yesod-core/Yesod/Core/Internal/Run.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RankNTypes #-} @@ -15,7 +16,7 @@ import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (liftIO) import Control.Monad.Logger (LogLevel (LevelError), LogSource, liftLoc) -import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState) +import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, getInternalState) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.IORef as I @@ -31,6 +32,9 @@ import Data.Text.Encoding.Error (lenientDecode) import Language.Haskell.TH.Syntax (Loc, qLocation) import qualified Network.HTTP.Types as H import Network.Wai +#if MIN_VERSION_wai(0, 2, 0) +import Network.Wai.Internal +#endif import Prelude hiding (catch) import System.Log.FastLogger (Logger) import System.Log.FastLogger (LogStr, toLogStr) @@ -161,9 +165,16 @@ runFakeHandler fakeSessionMap logger site handler = liftIO $ do ret <- I.newIORef (Left $ InternalError "runFakeHandler: no result") let handler' = do liftIO . I.writeIORef ret . Right =<< handler return () +#if MIN_VERSION_wai(0, 2, 0) + let yapp internalState = runHandler +#else let yapp = runHandler +#endif RunHandlerEnv - { rheRender = yesodRender site $ resolveApproot site fakeWaiRequest + { rheRender = yesodRender site $ resolveApproot site $ fakeWaiRequest +#if MIN_VERSION_wai(0, 2, 0) + internalState +#endif , rheRoute = Nothing , rheSite = site , rheUpload = fileUpload site @@ -179,14 +190,22 @@ runFakeHandler fakeSessionMap logger site handler = liftIO $ do typePlain (toContent ("runFakeHandler: errHandler" :: S8.ByteString)) (reqSession req) - fakeWaiRequest = + fakeWaiRequest +#if MIN_VERSION_wai(0, 2, 0) + internalState +#endif + = Request { requestMethod = "POST" , httpVersion = H.http11 , rawPathInfo = "/runFakeHandler/pathInfo" , rawQueryString = "" +#if MIN_VERSION_wai(0, 2, 0) + , resourceInternalState = internalState +#else , serverName = "runFakeHandler-serverName" , serverPort = 80 +#endif , requestHeaders = [] , isSecure = False , remoteHost = error "runFakeHandler-remoteHost" @@ -196,17 +215,30 @@ runFakeHandler fakeSessionMap logger site handler = liftIO $ do , vault = mempty , requestBodyLength = KnownLength 0 } +#if MIN_VERSION_wai(0, 2, 0) + fakeRequest internalState = +#else fakeRequest = +#endif YesodRequest { reqGetParams = [] , reqCookies = [] , reqWaiRequest = fakeWaiRequest +#if MIN_VERSION_wai(0, 2, 0) + internalState +#endif , reqLangs = [] , reqToken = Just "NaN" -- not a nonce =) , reqAccept = [] , reqSession = fakeSessionMap } +#if MIN_VERSION_wai(0, 2, 0) + _ <- runResourceT $ do + is <- getInternalState + yapp is $ fakeRequest is +#else _ <- runResourceT $ yapp fakeRequest +#endif I.readIORef ret {-# WARNING runFakeHandler "Usually you should *not* use runFakeHandler unless you really understand how it works and why you need it." #-} @@ -243,8 +275,12 @@ yesodRunner handler' YesodRunnerEnv {..} route req rhe = rheSafe { rheOnError = runHandler rheSafe . errorHandler } - yar <- runHandler rhe handler yreq - liftIO $ yarToResponse yar saveSession yreq + yar <- +#if MIN_VERSION_wai(0, 2, 0) + flip runInternalState (resourceInternalState req) $ +#endif + runHandler rhe handler yreq + liftIO $ yarToResponse yar saveSession yreq req where mmaxLen = maximumContentLength yreSite route handler = yesodMiddleware handler' diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index ce3217e3..8d25bb9a 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -26,8 +26,8 @@ library build-depends: base >= 4.3 && < 5 , time >= 1.1.4 , yesod-routes >= 1.2 && < 1.3 - , wai >= 1.4 && < 1.5 - , wai-extra >= 1.3 && < 1.4 + , wai >= 1.4 + , wai-extra >= 1.3 , bytestring >= 0.9.1.4 , text >= 0.7 && < 0.12 , template-haskell diff --git a/yesod-eventsource/yesod-eventsource.cabal b/yesod-eventsource/yesod-eventsource.cabal index f0abaee6..68978054 100644 --- a/yesod-eventsource/yesod-eventsource.cabal +++ b/yesod-eventsource/yesod-eventsource.cabal @@ -30,8 +30,8 @@ library build-depends: base >= 4 && < 5 , yesod-core == 1.2.* , conduit >= 0.5 && < 1.1 - , wai >= 1.3 && < 1.5 - , wai-eventsource >= 1.3 && < 1.4 + , wai >= 1.3 + , wai-eventsource >= 1.3 , blaze-builder , transformers exposed-modules: Yesod.EventSource diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index 62e819e9..be492e91 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -30,8 +30,8 @@ library , template-haskell , directory >= 1.0 , transformers >= 0.2.2 - , wai-app-static >= 1.3 && < 1.4 - , wai >= 1.3 && < 1.5 + , wai-app-static >= 1.3 + , wai >= 1.3 , text >= 0.9 , file-embed >= 0.0.4.1 && < 0.5 , http-types >= 0.7 diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index 33c43d5f..4869d881 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -28,12 +28,12 @@ library , yesod-form >= 1.3 && < 1.4 , monad-control >= 0.3 && < 0.4 , transformers >= 0.2.2 && < 0.4 - , wai >= 1.3 && < 1.5 - , wai-extra >= 1.3 && < 1.4 + , wai >= 1.3 + , wai-extra >= 1.3 , hamlet >= 1.1 && < 1.2 , shakespeare-js >= 1.0.2 && < 1.2 , shakespeare-css >= 1.0 && < 1.1 - , warp >= 1.3 && < 1.4 + , warp >= 1.3 , blaze-html >= 0.5 , blaze-markup >= 0.5.1 , aeson