diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs index a54f5dfd..f09b2b93 100644 --- a/yesod-auth/Yesod/Auth.hs +++ b/yesod-auth/Yesod/Auth.hs @@ -34,6 +34,8 @@ module Yesod.Auth , AuthException (..) -- * Helper , AuthHandler + -- * Internal + , credsKey ) where import Control.Monad (when) @@ -163,6 +165,9 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage => HandlerT master IO (Maybe (AuthId master)) maybeAuthId = defaultMaybeAuthId +-- | Internal session key used to hold the authentication information. +-- +-- Since 1.2.3 credsKey :: Text credsKey = "_ID" diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index 591ced53..881b76d1 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -1,5 +1,5 @@ name: yesod-auth -version: 1.2.3 +version: 1.2.4 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs index 26a31540..097cc0fb 100644 --- a/yesod-bin/Devel.hs +++ b/yesod-bin/Devel.hs @@ -1,9 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -#ifdef EMBED_REFRESH {-# LANGUAGE TemplateHaskell #-} -#endif module Devel ( devel , DevelOpts(..) @@ -69,7 +67,12 @@ import qualified Config as GHC import Data.Conduit.Network (HostPreference (HostIPv4), bindPort) import Network (withSocketsDo) +#if MIN_VERSION_http_conduit(2, 0, 0) +import Network.HTTP.Conduit (conduitManagerSettings, newManager) +import Data.Default (def) +#else import Network.HTTP.Conduit (def, newManager) +#endif import Network.HTTP.ReverseProxy (ProxyDest (ProxyDest), waiProxyToSettings, wpsTimeout, wpsOnExc) #if MIN_VERSION_http_reverse_proxy(0, 2, 0) @@ -80,11 +83,7 @@ import Network.Socket (sClose) import Network.Wai (responseLBS) import Network.Wai.Handler.Warp (run) import SrcLoc (Located) -#ifdef EMBED_REFRESH import Data.FileEmbed (embedFile) -#else -import Paths_yesod_bin -#endif lockFile :: DevelOpts -> FilePath lockFile _opts = "yesod-devel/devel-terminate" @@ -131,12 +130,12 @@ cabalProgram opts | isCabalDev opts = "cabal-dev" -- 3001, give an appropriate message to the user. reverseProxy :: DevelOpts -> I.IORef Int -> IO () reverseProxy opts iappPort = do - manager <- newManager def -#ifdef EMBED_REFRESH - let refreshHtml = LB.fromStrict $(embedFile "refreshing.html") +#if MIN_VERSION_http_conduit(2, 0, 0) + manager <- newManager conduitManagerSettings #else - refreshHtml <- liftIO $ getDataFileName "refreshing.html" >>= LB.readFile + manager <- newManager def #endif + let refreshHtml = LB.fromChunks $ return $(embedFile "refreshing.html") let onExc _ _ = return $ responseLBS status200 [ ("content-type", "text/html") , ("Refresh", "1") diff --git a/yesod-bin/hsfiles/mongo.hsfiles b/yesod-bin/hsfiles/mongo.hsfiles index e3055394..ef8463b4 100644 --- a/yesod-bin/hsfiles/mongo.hsfiles +++ b/yesod-bin/hsfiles/mongo.hsfiles @@ -30,10 +30,16 @@ import Yesod.Default.Config import Yesod.Default.Main import Yesod.Default.Handlers import Network.Wai.Middleware.RequestLogger + ( mkRequestLogger, outputFormat, OutputFormat (..), IPAddrSource (..), destination + ) +import qualified Network.Wai.Middleware.RequestLogger as RequestLogger import qualified Database.Persist -import Network.HTTP.Conduit (newManager, def) -import System.IO (stdout) -import System.Log.FastLogger (mkLogger) +import Network.HTTP.Conduit (newManager, conduitManagerSettings) +import qualified GHC.IO.FD +import System.Log.FastLogger (newLoggerSet, defaultBufSize) +import Network.Wai.Logger (clockDateCacher) +import Data.Default (def) +import Yesod.Core.Types (loggerSet, Logger (Logger)) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! @@ -58,7 +64,7 @@ makeApplication conf = do if development then Detailed True else Apache FromSocket - , destination = Logger $ appLogger foundation + , destination = RequestLogger.Logger $ loggerSet $ appLogger foundation } -- Create the WAI application and apply middlewares @@ -69,14 +75,18 @@ makeApplication conf = do -- performs some initialization. makeFoundation :: AppConfig DefaultEnv Extra -> IO App makeFoundation conf = do - manager <- newManager def + manager <- newManager conduitManagerSettings s <- staticSite dbconf <- withYamlEnvironment "config/mongoDB.yml" (appEnv conf) Database.Persist.loadConfig >>= Database.Persist.applyEnv p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) - logger <- mkLogger True stdout - let foundation = App conf s p manager dbconf logger + + loggerSet' <- newLoggerSet defaultBufSize GHC.IO.FD.stdout + (getter, _) <- clockDateCacher + + let logger = Yesod.Core.Types.Logger loggerSet' getter + foundation = App conf s p manager dbconf logger return foundation @@ -110,7 +120,7 @@ import Settings (widgetFile, Extra (..)) import Model import Text.Jasmine (minifym) import Text.Hamlet (hamletFile) -import System.Log.FastLogger (Logger) +import Yesod.Core.Types (Logger) -- | The site argument for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -395,16 +405,17 @@ library , shakespeare-text >= 1.0 && < 1.1 , hjsmin >= 0.1 && < 0.2 , monad-control >= 0.3 && < 0.4 - , wai-extra >= 1.3 && < 1.4 + , wai-extra >= 2.0 && < 2.1 , yaml >= 0.8 && < 0.9 - , http-conduit >= 1.9 && < 1.10 + , http-conduit >= 2.0 && < 2.1 , directory >= 1.1 && < 1.3 - , warp >= 1.3 && < 1.4 + , warp >= 2.0 && < 2.1 , data-default , aeson , conduit >= 1.0 , monad-logger >= 0.3 - , fast-logger >= 0.3 + , fast-logger >= 2.0 + , wai-logger >= 2.0 executable PROJECTNAME if flag(library-only) diff --git a/yesod-bin/hsfiles/mysql.hsfiles b/yesod-bin/hsfiles/mysql.hsfiles index 2657e63e..c24c6055 100644 --- a/yesod-bin/hsfiles/mysql.hsfiles +++ b/yesod-bin/hsfiles/mysql.hsfiles @@ -30,12 +30,18 @@ import Yesod.Default.Config import Yesod.Default.Main import Yesod.Default.Handlers import Network.Wai.Middleware.RequestLogger + ( mkRequestLogger, outputFormat, OutputFormat (..), IPAddrSource (..), destination + ) +import qualified Network.Wai.Middleware.RequestLogger as RequestLogger import qualified Database.Persist import Database.Persist.Sql (runMigration) -import Network.HTTP.Conduit (newManager, def) +import Network.HTTP.Conduit (newManager, conduitManagerSettings) import Control.Monad.Logger (runLoggingT) -import System.IO (stdout) -import System.Log.FastLogger (mkLogger) +import qualified GHC.IO.FD +import System.Log.FastLogger (newLoggerSet, defaultBufSize) +import Network.Wai.Logger (clockDateCacher) +import Data.Default (def) +import Yesod.Core.Types (loggerSet, Logger (Logger)) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! @@ -60,7 +66,7 @@ makeApplication conf = do if development then Detailed True else Apache FromSocket - , destination = Logger $ appLogger foundation + , destination = RequestLogger.Logger $ loggerSet $ appLogger foundation } -- Create the WAI application and apply middlewares @@ -71,14 +77,18 @@ makeApplication conf = do -- performs some initialization. makeFoundation :: AppConfig DefaultEnv Extra -> IO App makeFoundation conf = do - manager <- newManager def + manager <- newManager conduitManagerSettings s <- staticSite dbconf <- withYamlEnvironment "config/mysql.yml" (appEnv conf) Database.Persist.loadConfig >>= Database.Persist.applyEnv p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) - logger <- mkLogger True stdout - let foundation = App conf s p manager dbconf logger + + loggerSet' <- newLoggerSet defaultBufSize GHC.IO.FD.stdout + (getter, _) <- clockDateCacher + + let logger = Yesod.Core.Types.Logger loggerSet' getter + foundation = App conf s p manager dbconf logger -- Perform database migration using our application's logging settings. runLoggingT @@ -117,7 +127,7 @@ import Settings (widgetFile, Extra (..)) import Model import Text.Jasmine (minifym) import Text.Hamlet (hamletFile) -import System.Log.FastLogger (Logger) +import Yesod.Core.Types (Logger) -- | The site argument for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -399,16 +409,17 @@ library , shakespeare-text >= 1.0 && < 1.1 , hjsmin >= 0.1 && < 0.2 , monad-control >= 0.3 && < 0.4 - , wai-extra >= 1.3 && < 1.4 + , wai-extra >= 2.0 && < 2.1 , yaml >= 0.8 && < 0.9 - , http-conduit >= 1.9 && < 1.10 + , http-conduit >= 2.0 && < 2.1 , directory >= 1.1 && < 1.3 - , warp >= 1.3 && < 1.4 + , warp >= 2.0 && < 2.1 , data-default , aeson , conduit >= 1.0 , monad-logger >= 0.3 - , fast-logger >= 0.3 + , fast-logger >= 2.0 + , wai-logger >= 2.0 executable PROJECTNAME if flag(library-only) diff --git a/yesod-bin/hsfiles/postgres-fay.hsfiles b/yesod-bin/hsfiles/postgres-fay.hsfiles index ded715f0..543559b8 100644 --- a/yesod-bin/hsfiles/postgres-fay.hsfiles +++ b/yesod-bin/hsfiles/postgres-fay.hsfiles @@ -31,13 +31,19 @@ import Yesod.Default.Config import Yesod.Default.Main import Yesod.Default.Handlers import Network.Wai.Middleware.RequestLogger + ( mkRequestLogger, outputFormat, OutputFormat (..), IPAddrSource (..), destination + ) +import qualified Network.Wai.Middleware.RequestLogger as RequestLogger import qualified Database.Persist import Database.Persist.Sql (runMigration) -import Network.HTTP.Conduit (newManager, def) +import Network.HTTP.Conduit (newManager, conduitManagerSettings) import Yesod.Fay (getFaySite) import Control.Monad.Logger (runLoggingT) -import System.IO (stdout) -import System.Log.FastLogger (mkLogger) +import qualified GHC.IO.FD +import System.Log.FastLogger (newLoggerSet, defaultBufSize) +import Network.Wai.Logger (clockDateCacher) +import Data.Default (def) +import Yesod.Core.Types (loggerSet, Logger (Logger)) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! @@ -63,7 +69,7 @@ makeApplication conf = do if development then Detailed True else Apache FromSocket - , destination = Logger $ appLogger foundation + , destination = RequestLogger.Logger $ loggerSet $ appLogger foundation } -- Create the WAI application and apply middlewares @@ -74,14 +80,18 @@ makeApplication conf = do -- performs some initialization. makeFoundation :: AppConfig DefaultEnv Extra -> IO App makeFoundation conf = do - manager <- newManager def + manager <- newManager conduitManagerSettings s <- staticSite dbconf <- withYamlEnvironment "config/postgresql.yml" (appEnv conf) Database.Persist.loadConfig >>= Database.Persist.applyEnv p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) - logger <- mkLogger True stdout - let foundation = App conf s p manager dbconf onCommand logger + + loggerSet' <- newLoggerSet defaultBufSize GHC.IO.FD.stdout + (getter, _) <- clockDateCacher + + let logger = Yesod.Core.Types.Logger loggerSet' getter + foundation = App conf s p manager dbconf onCommand logger -- Perform database migration using our application's logging settings. runLoggingT @@ -120,7 +130,7 @@ import Settings (widgetFile, Extra (..)) import Model import Text.Hamlet (hamletFile) import Yesod.Fay -import System.Log.FastLogger (Logger) +import Yesod.Core.Types (Logger) -- | The site argument for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -436,16 +446,17 @@ library , shakespeare-js >= 1.2 && < 1.3 , shakespeare-text >= 1.0 && < 1.1 , monad-control >= 0.3 && < 0.4 - , wai-extra >= 1.3 && < 1.4 + , wai-extra >= 2.0 && < 2.1 , yaml >= 0.8 && < 0.9 - , http-conduit >= 1.9 && < 1.10 + , http-conduit >= 2.0 && < 2.1 , directory >= 1.1 && < 1.3 - , warp >= 1.3 && < 1.4 + , warp >= 2.0 && < 2.1 , data-default , aeson , conduit >= 1.0 , monad-logger >= 0.3 - , fast-logger >= 0.3 + , fast-logger >= 2.0 + , wai-logger >= 2.0 executable PROJECTNAME if flag(library-only) diff --git a/yesod-bin/hsfiles/postgres.hsfiles b/yesod-bin/hsfiles/postgres.hsfiles index 9aef1ae3..32a9e2f5 100644 --- a/yesod-bin/hsfiles/postgres.hsfiles +++ b/yesod-bin/hsfiles/postgres.hsfiles @@ -30,12 +30,18 @@ import Yesod.Default.Config import Yesod.Default.Main import Yesod.Default.Handlers import Network.Wai.Middleware.RequestLogger + ( mkRequestLogger, outputFormat, OutputFormat (..), IPAddrSource (..), destination + ) +import qualified Network.Wai.Middleware.RequestLogger as RequestLogger import qualified Database.Persist import Database.Persist.Sql (runMigration) -import Network.HTTP.Conduit (newManager, def) +import Network.HTTP.Conduit (newManager, conduitManagerSettings) import Control.Monad.Logger (runLoggingT) -import System.IO (stdout) -import System.Log.FastLogger (mkLogger) +import qualified GHC.IO.FD +import System.Log.FastLogger (newLoggerSet, defaultBufSize) +import Network.Wai.Logger (clockDateCacher) +import Data.Default (def) +import Yesod.Core.Types (loggerSet, Logger (Logger)) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! @@ -60,7 +66,7 @@ makeApplication conf = do if development then Detailed True else Apache FromSocket - , destination = Logger $ appLogger foundation + , destination = RequestLogger.Logger $ loggerSet $ appLogger foundation } -- Create the WAI application and apply middlewares @@ -71,14 +77,18 @@ makeApplication conf = do -- performs some initialization. makeFoundation :: AppConfig DefaultEnv Extra -> IO App makeFoundation conf = do - manager <- newManager def + manager <- newManager conduitManagerSettings s <- staticSite dbconf <- withYamlEnvironment "config/postgresql.yml" (appEnv conf) Database.Persist.loadConfig >>= Database.Persist.applyEnv p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) - logger <- mkLogger True stdout - let foundation = App conf s p manager dbconf logger + + loggerSet' <- newLoggerSet defaultBufSize GHC.IO.FD.stdout + (getter, _) <- clockDateCacher + + let logger = Yesod.Core.Types.Logger loggerSet' getter + foundation = App conf s p manager dbconf logger -- Perform database migration using our application's logging settings. runLoggingT @@ -117,7 +127,7 @@ import Settings (widgetFile, Extra (..)) import Model import Text.Jasmine (minifym) import Text.Hamlet (hamletFile) -import System.Log.FastLogger (Logger) +import Yesod.Core.Types (Logger) -- | The site argument for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -399,16 +409,17 @@ library , shakespeare-text >= 1.0 && < 1.1 , hjsmin >= 0.1 && < 0.2 , monad-control >= 0.3 && < 0.4 - , wai-extra >= 1.3 && < 1.4 + , wai-extra >= 2.0 && < 2.1 , yaml >= 0.8 && < 0.9 - , http-conduit >= 1.9 && < 1.10 + , http-conduit >= 2.0 && < 2.1 , directory >= 1.1 && < 1.3 - , warp >= 1.3 && < 1.4 + , warp >= 2.0 && < 2.1 , data-default , aeson , conduit >= 1.0 , monad-logger >= 0.3 - , fast-logger >= 0.3 + , fast-logger >= 2.0 + , wai-logger >= 2.0 executable PROJECTNAME if flag(library-only) diff --git a/yesod-bin/hsfiles/simple.hsfiles b/yesod-bin/hsfiles/simple.hsfiles index 73fc703c..2617e814 100644 --- a/yesod-bin/hsfiles/simple.hsfiles +++ b/yesod-bin/hsfiles/simple.hsfiles @@ -28,9 +28,15 @@ import Yesod.Default.Config import Yesod.Default.Main import Yesod.Default.Handlers import Network.Wai.Middleware.RequestLogger -import Network.HTTP.Conduit (newManager, def) -import System.IO (stdout) -import System.Log.FastLogger (mkLogger) + ( mkRequestLogger, outputFormat, OutputFormat (..), IPAddrSource (..), destination + ) +import qualified Network.Wai.Middleware.RequestLogger as RequestLogger +import Network.HTTP.Conduit (newManager, conduitManagerSettings) +import qualified GHC.IO.FD +import System.Log.FastLogger (newLoggerSet, defaultBufSize) +import Network.Wai.Logger (clockDateCacher) +import Data.Default (def) +import Yesod.Core.Types (loggerSet, Logger (Logger)) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! @@ -55,7 +61,7 @@ makeApplication conf = do if development then Detailed True else Apache FromSocket - , destination = Logger $ appLogger foundation + , destination = RequestLogger.Logger $ loggerSet $ appLogger foundation } -- Create the WAI application and apply middlewares @@ -66,10 +72,14 @@ makeApplication conf = do -- performs some initialization. makeFoundation :: AppConfig DefaultEnv Extra -> IO App makeFoundation conf = do - manager <- newManager def + manager <- newManager conduitManagerSettings s <- staticSite - logger <- mkLogger True stdout - let foundation = App conf s manager logger + + loggerSet' <- newLoggerSet defaultBufSize GHC.IO.FD.stdout + (getter, _) <- clockDateCacher + + let logger = Yesod.Core.Types.Logger loggerSet' getter + foundation = App conf s manager logger return foundation @@ -97,7 +107,7 @@ import Settings.StaticFiles import Settings (widgetFile, Extra (..)) import Text.Jasmine (minifym) import Text.Hamlet (hamletFile) -import System.Log.FastLogger (Logger) +import Yesod.Core.Types (Logger) -- | The site argument for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -326,16 +336,17 @@ library , shakespeare-text >= 1.0 && < 1.1 , hjsmin >= 0.1 && < 0.2 , monad-control >= 0.3 && < 0.4 - , wai-extra >= 1.3 && < 1.4 + , wai-extra >= 2.0 && < 2.1 , yaml >= 0.8 && < 0.9 - , http-conduit >= 1.9 && < 1.10 + , http-conduit >= 2.0 && < 2.1 , directory >= 1.1 && < 1.3 - , warp >= 1.3 && < 1.4 + , warp >= 2.0 && < 2.1 , data-default , aeson , conduit >= 1.0 , monad-logger >= 0.3 - , fast-logger >= 0.3 + , fast-logger >= 2.0 + , wai-logger >= 2.0 executable PROJECTNAME if flag(library-only) diff --git a/yesod-bin/hsfiles/sqlite.hsfiles b/yesod-bin/hsfiles/sqlite.hsfiles index 9b7ca111..252dc12c 100644 --- a/yesod-bin/hsfiles/sqlite.hsfiles +++ b/yesod-bin/hsfiles/sqlite.hsfiles @@ -30,12 +30,18 @@ import Yesod.Default.Config import Yesod.Default.Main import Yesod.Default.Handlers import Network.Wai.Middleware.RequestLogger + ( mkRequestLogger, outputFormat, OutputFormat (..), IPAddrSource (..), destination + ) +import qualified Network.Wai.Middleware.RequestLogger as RequestLogger import qualified Database.Persist import Database.Persist.Sql (runMigration) -import Network.HTTP.Conduit (newManager, def) +import Network.HTTP.Conduit (newManager, conduitManagerSettings) import Control.Monad.Logger (runLoggingT) -import System.IO (stdout) -import System.Log.FastLogger (mkLogger) +import qualified GHC.IO.FD +import System.Log.FastLogger (newLoggerSet, defaultBufSize) +import Network.Wai.Logger (clockDateCacher) +import Data.Default (def) +import Yesod.Core.Types (loggerSet, Logger (Logger)) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! @@ -60,7 +66,7 @@ makeApplication conf = do if development then Detailed True else Apache FromSocket - , destination = Logger $ appLogger foundation + , destination = RequestLogger.Logger $ loggerSet $ appLogger foundation } -- Create the WAI application and apply middlewares @@ -71,14 +77,18 @@ makeApplication conf = do -- performs some initialization. makeFoundation :: AppConfig DefaultEnv Extra -> IO App makeFoundation conf = do - manager <- newManager def + manager <- newManager conduitManagerSettings s <- staticSite dbconf <- withYamlEnvironment "config/sqlite.yml" (appEnv conf) Database.Persist.loadConfig >>= Database.Persist.applyEnv p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) - logger <- mkLogger True stdout - let foundation = App conf s p manager dbconf logger + + loggerSet' <- newLoggerSet defaultBufSize GHC.IO.FD.stdout + (getter, _) <- clockDateCacher + + let logger = Yesod.Core.Types.Logger loggerSet' getter + foundation = App conf s p manager dbconf logger -- Perform database migration using our application's logging settings. runLoggingT @@ -117,7 +127,7 @@ import Settings (widgetFile, Extra (..)) import Model import Text.Jasmine (minifym) import Text.Hamlet (hamletFile) -import System.Log.FastLogger (Logger) +import Yesod.Core.Types (Logger) -- | The site argument for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -399,16 +409,17 @@ library , shakespeare-text >= 1.0 && < 1.1 , hjsmin >= 0.1 && < 0.2 , monad-control >= 0.3 && < 0.4 - , wai-extra >= 1.3 && < 1.4 + , wai-extra >= 2.0 && < 2.1 , yaml >= 0.8 && < 0.9 - , http-conduit >= 1.9 && < 1.10 + , http-conduit >= 2.0 && < 2.1 , directory >= 1.1 && < 1.3 - , warp >= 1.3 && < 1.4 + , warp >= 2.0 && < 2.1 , data-default , aeson , conduit >= 1.0 , monad-logger >= 0.3 - , fast-logger >= 0.3 + , fast-logger >= 2.0 + , wai-logger >= 2.0 executable PROJECTNAME if flag(library-only) diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index dec2ee9e..c21b2ff5 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -1,5 +1,5 @@ name: yesod-bin -version: 1.2.5 +version: 1.2.5.1 license: MIT license-file: LICENSE author: Michael Snoyman @@ -93,6 +93,7 @@ executable yesod , transformers , warp >= 1.3.7.5 , wai >= 1.4 + , data-default ghc-options: -Wall -threaded main-is: main.hs diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs index cf02a1ad..a64d6ebc 100644 --- a/yesod-core/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/Yesod/Core/Class/Yesod.hs @@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} module Yesod.Core.Class.Yesod where import Control.Monad.Logger (logErrorS) @@ -39,10 +40,16 @@ import Data.Default (def) import Network.Wai.Parse (lbsBackEnd, tempFileBackEnd) import System.IO (stdout) +#if MIN_VERSION_fast_logger(2, 0, 0) +import Network.Wai.Logger (ZonedDate, clockDateCacher) +import System.Log.FastLogger +import qualified GHC.IO.FD +#else +import System.Log.FastLogger.Date (ZonedDate) import System.Log.FastLogger (LogStr (..), Logger, loggerDate, loggerPutStr, mkLogger) -import System.Log.FastLogger.Date (ZonedDate) +#endif import Text.Blaze (customAttribute, textTag, toValue, (!)) import Text.Blaze (preEscapedToMarkup) @@ -209,7 +216,14 @@ class RenderRoute site => Yesod site where -- -- Default: Sends to stdout and automatically flushes on each write. makeLogger :: site -> IO Logger +#if MIN_VERSION_fast_logger(2, 0, 0) + makeLogger _ = do + loggerSet <- newLoggerSet defaultBufSize GHC.IO.FD.stdout + (getter, _) <- clockDateCacher + return $! Logger loggerSet getter +#else makeLogger _ = mkLogger True stdout +#endif -- | Send a message to the @Logger@ provided by @getLogger@. -- @@ -523,6 +537,30 @@ asyncHelper render scripts jscript jsLoc = Nothing -> Nothing Just j -> Just $ jelper j +#if MIN_VERSION_fast_logger(2, 0, 0) +formatLogMessage :: IO ZonedDate + -> Loc + -> LogSource + -> LogLevel + -> LogStr -- ^ message + -> IO LogStr +formatLogMessage getdate loc src level msg = do + now <- getdate + return $ + toLogStr now `mappend` + " [" `mappend` + (case level of + LevelOther t -> toLogStr t + _ -> toLogStr $ drop 5 $ show level) `mappend` + (if T.null src + then mempty + else "#" `mappend` toLogStr src) `mappend` + "] " `mappend` + msg `mappend` + " @(" `mappend` + toLogStr (fileLocationToString loc) `mappend` + ")\n" +#else formatLogMessage :: IO ZonedDate -> Loc -> LogSource @@ -548,7 +586,7 @@ formatLogMessage getdate loc src level msg = do , LS $ fileLocationToString loc , LB ")\n" ] - +#endif -- | Customize the cookies used by the session backend. You may -- use this function on your definition of 'makeSessionBackend'. diff --git a/yesod-core/Yesod/Core/Dispatch.hs b/yesod-core/Yesod/Core/Dispatch.hs index 335a15c8..df822e2d 100644 --- a/yesod-core/Yesod/Core/Dispatch.hs +++ b/yesod-core/Yesod/Core/Dispatch.hs @@ -3,6 +3,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE CPP #-} module Yesod.Core.Dispatch ( -- * Quasi-quoted routing parseRoutes @@ -146,6 +147,7 @@ warp :: YesodDispatch site => Int -> site -> IO () warp port site = toWaiApp site >>= Network.Wai.Handler.Warp.runSettings Network.Wai.Handler.Warp.defaultSettings { Network.Wai.Handler.Warp.settingsPort = port + {- FIXME , Network.Wai.Handler.Warp.settingsServerName = S8.pack $ concat [ "Warp/" , Network.Wai.Handler.Warp.warpVersion @@ -153,6 +155,7 @@ warp port site = toWaiApp site >>= Network.Wai.Handler.Warp.runSettings , showVersion Paths_yesod_core.version , " (core)" ] + -} } -- | A default set of middlewares. @@ -161,7 +164,11 @@ warp port site = toWaiApp site >>= Network.Wai.Handler.Warp.runSettings mkDefaultMiddlewares :: Logger -> IO W.Middleware mkDefaultMiddlewares logger = do logWare <- mkRequestLogger def +#if MIN_VERSION_fast_logger(2, 0, 0) + { destination = Network.Wai.Middleware.RequestLogger.Logger $ loggerSet logger +#else { destination = Logger logger +#endif , outputFormat = Apache FromSocket } return $ logWare diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index f3b1799b..7c24adc8 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 #-} @@ -194,6 +195,9 @@ import Control.Failure (failure) import Blaze.ByteString.Builder (Builder) import Safe (headMay) import Data.CaseInsensitive (CI) +#if MIN_VERSION_wai(2, 0, 0) +import qualified System.PosixCompat.Files as PC +#endif get :: MonadHandler m => m GHState get = liftHandlerT $ HandlerT $ I.readIORef . handlerState @@ -229,11 +233,19 @@ runRequestBody = do Just rbc -> return rbc Nothing -> do rr <- waiRequest +#if MIN_VERSION_wai(2, 0, 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 +255,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 @@ -486,8 +502,17 @@ sendFilePart :: MonadHandler m -> Integer -- ^ offset -> Integer -- ^ count -> m a -sendFilePart ct fp off count = +sendFilePart ct fp off count = do +#if MIN_VERSION_wai(2, 0, 0) + fs <- liftIO $ PC.getFileStatus fp + handlerError $ HCSendFile ct fp $ Just W.FilePart + { W.filePartOffset = off + , W.filePartByteCount = count + , W.filePartFileSize = fromIntegral $ PC.fileSize fs + } +#else handlerError $ HCSendFile ct fp $ Just $ W.FilePart off count +#endif -- | Bypass remaining handler code and output the given content with a 200 -- status code. @@ -697,7 +722,7 @@ newIdent = do x <- get let i' = ghsIdent x + 1 put x { ghsIdent = i' } - return $ T.pack $ 'h' : show i' + return $ T.pack $ "hident" ++ show i' -- | Redirect to a POST resource. -- @@ -916,7 +941,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 +997,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(2, 0, 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..fce9e2e7 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,13 @@ 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, getInternalState, runResourceT, InternalState, closeInternalState) +import Control.Monad.Trans.Class (lift) +import Network.Wai.Internal +import Control.Exception (finally) +#endif import Prelude hiding (catch) import Web.Cookie (renderSetCookie) import Yesod.Core.Content @@ -26,13 +34,30 @@ import qualified Data.Map as Map import Yesod.Core.Internal.Request (tokenKey) import Data.Text.Encoding (encodeUtf8) -yarToResponse :: Monad m - => YesodResponse - -> (SessionMap -> m [Header]) -- ^ save session +yarToResponse :: YesodResponse + -> (SessionMap -> IO [Header]) -- ^ save session -> YesodRequest - -> m Response -yarToResponse (YRWai a) _ _ = return a -yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq = do + -> Request +#if MIN_VERSION_wai(2, 0, 0) + -> InternalState +#endif + -> IO Response +#if MIN_VERSION_wai(2, 0, 0) +yarToResponse (YRWai a) _ _ _ is = + case a of + ResponseSource s hs w -> return $ ResponseSource s hs $ \f -> + w f `finally` closeInternalState is + _ -> do + closeInternalState is + return a +#else +yarToResponse (YRWai a) _ _ _ = return a +#endif +yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq req +#if MIN_VERSION_wai(2, 0, 0) + is +#endif + = do extraHeaders <- do let nsToken = maybe newSess @@ -43,6 +68,21 @@ yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq = do let finalHeaders = extraHeaders ++ map headerToPair hs finalHeaders' len = ("Content-Length", S8.pack $ show len) : finalHeaders + +#if MIN_VERSION_wai(2, 0, 0) + let go (ContentBuilder b mlen) = do + let hs' = maybe finalHeaders finalHeaders' mlen + closeInternalState is + return $ ResponseBuilder s hs' b + go (ContentFile fp p) = do + closeInternalState is + return $ ResponseFile s finalHeaders fp p + go (ContentSource body) = return $ ResponseSource s finalHeaders $ \f -> + f (transPipe (flip runInternalState is) body) `finally` + closeInternalState is + go (ContentDontEvaluate c') = go c' + go c +#else let go (ContentBuilder b mlen) = let hs' = maybe finalHeaders finalHeaders' mlen in ResponseBuilder s hs' b @@ -50,6 +90,7 @@ yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq = do go (ContentSource body) = ResponseSource s finalHeaders body go (ContentDontEvaluate c') = go c' return $ go c +#endif where s | s' == defaultStatus = H.status200 diff --git a/yesod-core/Yesod/Core/Internal/Run.hs b/yesod-core/Yesod/Core/Internal/Run.hs index 35f1d3fd..25f51f12 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 #-} @@ -9,13 +10,13 @@ module Yesod.Core.Internal.Run where import Yesod.Core.Internal.Response import Blaze.ByteString.Builder (toByteString) import Control.Applicative ((<$>)) -import Control.Exception (fromException) +import Control.Exception (fromException, bracketOnError) import Control.Exception.Lifted (catch) 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, createInternalState, closeInternalState) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.IORef as I @@ -31,8 +32,13 @@ 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(2, 0, 0) +import Network.Wai.Internal +#endif import Prelude hiding (catch) +#if !MIN_VERSION_fast_logger(2, 0, 0) import System.Log.FastLogger (Logger) +#endif import System.Log.FastLogger (LogStr, toLogStr) import System.Random (newStdGen) import Yesod.Core.Content @@ -179,14 +185,17 @@ runFakeHandler fakeSessionMap logger site handler = liftIO $ do typePlain (toContent ("runFakeHandler: errHandler" :: S8.ByteString)) (reqSession req) - fakeWaiRequest = - Request + fakeWaiRequest = Request { requestMethod = "POST" , httpVersion = H.http11 , rawPathInfo = "/runFakeHandler/pathInfo" , rawQueryString = "" +#if MIN_VERSION_wai(2, 0, 0) + , requestHeaderHost = Nothing +#else , serverName = "runFakeHandler-serverName" , serverPort = 80 +#endif , requestHeaders = [] , isSecure = False , remoteHost = error "runFakeHandler-remoteHost" @@ -243,8 +252,14 @@ yesodRunner handler' YesodRunnerEnv {..} route req rhe = rheSafe { rheOnError = runHandler rheSafe . errorHandler } +#if MIN_VERSION_wai(2, 0, 0) + bracketOnError createInternalState closeInternalState $ \is -> do + yar <- runInternalState (runHandler rhe handler yreq) is + liftIO $ yarToResponse yar saveSession yreq req is +#else yar <- runHandler rhe handler yreq - liftIO $ yarToResponse yar saveSession yreq + liftIO $ yarToResponse yar saveSession yreq req +#endif where mmaxLen = maximumContentLength yreSite route handler = yesodMiddleware handler' diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs index 3c44e78c..fa20c621 100644 --- a/yesod-core/Yesod/Core/Types.hs +++ b/yesod-core/Yesod/Core/Types.hs @@ -5,6 +5,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE CPP #-} module Yesod.Core.Types where import qualified Blaze.ByteString.Builder as BBuilder @@ -46,7 +47,12 @@ import Network.Wai (FilePart, RequestBodyLength) import qualified Network.Wai as W import qualified Network.Wai.Parse as NWP +#if MIN_VERSION_fast_logger(2, 0, 0) +import System.Log.FastLogger (LogStr, LoggerSet, toLogStr, pushLogStr) +import Network.Wai.Logger (DateCacheGetter) +#else import System.Log.FastLogger (LogStr, Logger, toLogStr) +#endif import Text.Blaze.Html (Html) import Text.Hamlet (HtmlUrl) import Text.Julius (JavascriptUrl) @@ -445,3 +451,13 @@ instance RenderRoute WaiSubsite where renderRoute (WaiSubsiteRoute ps qs) = (ps, qs) instance ParseRoute WaiSubsite where parseRoute (x, y) = Just $ WaiSubsiteRoute x y + +#if MIN_VERSION_fast_logger(2, 0, 0) +data Logger = Logger + { loggerSet :: !LoggerSet + , loggerDate :: !DateCacheGetter + } + +loggerPutStr :: Logger -> LogStr -> IO () +loggerPutStr (Logger ls _) = pushLogStr ls +#endif diff --git a/yesod-core/test/YesodCoreTest/Auth.hs b/yesod-core/test/YesodCoreTest/Auth.hs index 7daf209d..393737b9 100644 --- a/yesod-core/test/YesodCoreTest/Auth.hs +++ b/yesod-core/test/YesodCoreTest/Auth.hs @@ -8,6 +8,7 @@ import Network.Wai import qualified Data.ByteString.Char8 as S8 import qualified Data.Text as T import Data.List (isSuffixOf) +import qualified Network.HTTP.Types as H data App = App @@ -51,6 +52,7 @@ test method path f = it (method ++ " " ++ path) $ do , requestHeaders = if not $ isSuffixOf "json" path then [] else [("Accept", S8.pack "application/json")] + , httpVersion = H.http11 } f sres diff --git a/yesod-core/test/YesodCoreTest/Redirect.hs b/yesod-core/test/YesodCoreTest/Redirect.hs index da6f9725..3980cbc8 100644 --- a/yesod-core/test/YesodCoreTest/Redirect.hs +++ b/yesod-core/test/YesodCoreTest/Redirect.hs @@ -45,7 +45,8 @@ specs = describe "Redirect" $ do it "303 redirect for regular, HTTP 1.1" $ app $ do res <- request defaultRequest { - pathInfo = ["rregular"] + pathInfo = ["rregular"], + httpVersion = H.http11 } assertStatus 303 res assertBodyContains "" res diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 1c158074..98993d21 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.2.5 +version: 1.2.6.1 license: MIT license-file: LICENSE author: Michael Snoyman @@ -26,10 +26,10 @@ 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 + , text >= 0.7 , template-haskell , path-pieces >= 0.1.2 && < 0.2 , hamlet >= 1.1 && < 1.2 @@ -55,9 +55,10 @@ library , vector >= 0.9 && < 0.11 , aeson >= 0.5 , fast-logger >= 0.2 + , wai-logger >= 0.2 , monad-logger >= 0.3.1 && < 0.4 , conduit >= 0.5 - , resourcet >= 0.4.6 && < 0.5 + , resourcet >= 0.4.9 && < 0.5 , lifted-base >= 0.1.2 , attoparsec-conduit , blaze-html >= 0.5 @@ -65,6 +66,7 @@ library , data-default , safe , warp >= 1.3.8 + , unix-compat exposed-modules: Yesod.Core Yesod.Core.Content diff --git a/yesod-eventsource/yesod-eventsource.cabal b/yesod-eventsource/yesod-eventsource.cabal index f0abaee6..f658d14d 100644 --- a/yesod-eventsource/yesod-eventsource.cabal +++ b/yesod-eventsource/yesod-eventsource.cabal @@ -1,5 +1,5 @@ name: yesod-eventsource -version: 1.1 +version: 1.1.0.1 license: MIT license-file: LICENSE author: Felipe Lessa @@ -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-persistent/yesod-persistent.cabal b/yesod-persistent/yesod-persistent.cabal index 98c21466..69787503 100644 --- a/yesod-persistent/yesod-persistent.cabal +++ b/yesod-persistent/yesod-persistent.cabal @@ -1,5 +1,5 @@ name: yesod-persistent -version: 1.2.1 +version: 1.2.2 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-platform/yesod-platform.cabal b/yesod-platform/yesod-platform.cabal index 864d4fc5..b80b6e48 100644 --- a/yesod-platform/yesod-platform.cabal +++ b/yesod-platform/yesod-platform.cabal @@ -1,5 +1,5 @@ name: yesod-platform -version: 1.2.4.4 +version: 1.2.5 license: MIT license-file: LICENSE author: Michael Snoyman @@ -15,38 +15,40 @@ homepage: http://www.yesodweb.com/ library build-depends: base >= 4 && < 5 , SHA == 1.6.1 - , aeson == 0.6.2.0 + , aeson == 0.6.2.1 , ansi-terminal == 0.6 , asn1-data == 0.7.1 - , asn1-types == 0.2.0 + , asn1-types == 0.2.2 , attoparsec == 0.10.4.0 , attoparsec-conduit == 1.0.1.2 , authenticate == 1.3.2.6 , base-unicode-symbols == 0.2.2.4 , base64-bytestring == 1.0.0.1 - , blaze-builder == 0.3.1.1 + , blaze-builder == 0.3.3.2 , blaze-builder-conduit == 1.0.0 - , blaze-html == 0.6.1.1 - , blaze-markup == 0.5.1.5 + , blaze-html == 0.6.1.2 + , blaze-markup == 0.5.1.6 , byteable == 0.1.1 , byteorder == 1.0.4 - , case-insensitive == 1.1 - , cereal == 0.3.5.2 - , certificate == 1.3.8 - , cipher-aes == 0.2.5 - , cipher-rc4 == 0.1.2 + , case-insensitive == 1.1.0.2 + , cereal == 0.4.0.1 + , certificate == 1.3.9 + , cipher-aes == 0.2.6 + , cipher-rc4 == 0.1.4 , clientsession == 0.9.0.3 - , conduit == 1.0.7.4 + , conduit == 1.0.9.3 + , connection == 0.1.3.1 + , control-monad-loop == 0.1 , cookie == 0.4.0.1 , cprng-aes == 0.5.2 , crypto-api == 0.12.2.2 - , crypto-cipher-types == 0.0.4 - , crypto-conduit == 0.5.2 - , crypto-numbers == 0.2.1 - , crypto-pubkey == 0.2.1 - , crypto-pubkey-types == 0.4.0 + , crypto-cipher-types == 0.0.9 + , crypto-conduit == 0.5.2.1 + , crypto-numbers == 0.2.3 + , crypto-pubkey == 0.2.3 + , crypto-pubkey-types == 0.4.1 , crypto-random == 0.0.7 - , cryptohash == 0.10.0 + , cryptohash == 0.11.1 , cryptohash-cryptoapi == 0.1.0 , css-text == 0.1.1 , data-default == 0.5.3 @@ -55,89 +57,94 @@ library , data-default-instances-containers == 0.0.1 , data-default-instances-dlist == 0.0.1 , data-default-instances-old-locale == 0.0.1 - , date-cache == 0.3.0 - , dlist == 0.5 + , dlist == 0.6.0.1 , email-validate == 1.0.0 , entropy == 0.2.2.4 , failure == 0.2.0.1 - , fast-logger == 0.3.3 - , file-embed == 0.0.4.9 + , fast-logger == 2.0.0 + , file-embed == 0.0.6 , filesystem-conduit == 1.0.0.1 - , hamlet == 1.1.7.2 - , hjsmin == 0.1.4.1 - , hspec == 1.7.2 - , hspec-expectations == 0.3.3 - , html-conduit == 1.1.0 + , hamlet == 1.1.7.5 + , hjsmin == 0.1.4.4 + , hspec == 1.8.1.1 + , hspec-expectations == 0.5.0.1 + , html-conduit == 1.1.0.1 , http-attoparsec == 0.1.0 - , http-conduit == 1.9.4.5 + , http-client == 0.2.0.2 + , http-client-conduit == 0.2.0.0 + , http-client-tls == 0.2.0.0 + , http-conduit == 2.0.0.2 , http-date == 0.0.4 - , http-types == 0.8.1 - , language-javascript == 0.5.7 - , lifted-base == 0.2.1.0 + , http-types == 0.8.3 + , language-javascript == 0.5.8 + , lifted-base == 0.2.1.1 , mime-mail == 0.4.2.1 , mime-types == 0.1.0.3 , mmorph == 1.0.0 - , monad-control == 0.3.2.1 - , monad-logger == 0.3.1.1 + , monad-control == 0.3.2.2 + , monad-logger == 0.3.3.1 + , monad-loops == 0.4.2 , network-conduit == 1.0.0 - , path-pieces == 0.1.2 - , pem == 0.1.2 + , path-pieces == 0.1.3 + , pem == 0.2.1 , persistent == 1.2.3.0 - , persistent-template == 1.2.0.2 + , persistent-template == 1.2.0.5 , pool-conduit == 0.1.2 - , primitive == 0.5.0.1 + , primitive == 0.5.1.0 + , process-conduit == 1.0.0.1 , publicsuffixlist == 0.1 , pureMD5 == 2.1.2.1 - , pwstore-fast == 2.3 + , pwstore-fast == 2.4.1 , quickcheck-io == 0.1.0 , resource-pool == 0.2.1.1 - , resourcet == 0.4.8 + , resourcet == 0.4.9 , safe == 0.3.3 , securemem == 0.1.3 - , semigroups == 0.9.2 - , setenv == 0.1.0 - , shakespeare == 1.2.0 - , shakespeare-css == 1.0.6.3 - , shakespeare-i18n == 1.0.0.4 - , shakespeare-js == 1.2.0 - , shakespeare-text == 1.0.0.7 + , semigroups == 0.12.1 + , setenv == 0.1.1 + , shakespeare == 1.2.0.3 + , shakespeare-css == 1.0.6.6 + , shakespeare-i18n == 1.0.0.5 + , shakespeare-js == 1.2.0.2 + , shakespeare-text == 1.0.0.10 , silently == 1.2.4.1 - , simple-sendfile == 0.2.12 - , skein == 1.0.6 - , socks == 0.5.3 - , stringsearch == 0.3.6.4 + , simple-sendfile == 0.2.13 + , skein == 1.0.8 + , socks == 0.5.4 + , stm-chans == 3.0.0 + , stringsearch == 0.3.6.5 , system-fileio == 0.3.11 - , system-filepath == 0.4.7 + , system-filepath == 0.4.8 , tagged == 0.7 , tagsoup == 0.13 - , tagstream-conduit == 0.5.4 + , tagstream-conduit == 0.5.4.1 , tls == 1.1.5 - , tls-extra == 0.6.5 + , tls-extra == 0.6.6 , transformers-base == 0.4.1 , unix-compat == 0.4.1.1 - , unordered-containers == 0.2.3.2 - , utf8-light == 0.4.0.1 + , unordered-containers == 0.2.3.3 + , utf8-light == 0.4.2 , utf8-string == 0.3.7 - , vector == 0.10.0.1 + , vector == 0.10.9.1 , void == 0.6.1 - , wai == 1.4.0.2 - , wai-app-static == 1.3.1.4 - , wai-extra == 1.3.4.4 - , wai-logger == 0.3.1 - , wai-test == 1.3.1.1 - , warp == 1.3.9.2 - , word8 == 0.0.3 - , xml-conduit == 1.1.0.7 + , wai == 2.0.0 + , wai-app-static == 2.0.0.1 + , wai-extra == 2.0.0.1 + , wai-logger == 2.0.1 + , wai-test == 2.0.0.1 + , warp == 2.0.0.1 + , word8 == 0.0.4 + , xml-conduit == 1.1.0.9 , xml-types == 0.3.4 , xss-sanitize == 0.3.4 - , yaml == 0.8.4.1 - , yesod == 1.2.2.1 - , yesod-auth == 1.2.2.1 - , yesod-core == 1.2.4.2 - , yesod-form == 1.3.2.1 - , yesod-persistent == 1.2.1 - , yesod-routes == 1.2.0.1 - , yesod-static == 1.2.0.1 + , yaml == 0.8.5.2 + , yesod == 1.2.4 + , yesod-auth == 1.2.4 + , yesod-core == 1.2.6.1 + , yesod-form == 1.3.4 + , yesod-persistent == 1.2.2 + , yesod-routes == 1.2.0.2 + , yesod-static == 1.2.2 , yesod-test == 1.2.1 , zlib-bindings == 0.1.1.3 , zlib-conduit == 1.0.0 diff --git a/yesod-routes/yesod-routes.cabal b/yesod-routes/yesod-routes.cabal index 0b245f26..120d0e64 100644 --- a/yesod-routes/yesod-routes.cabal +++ b/yesod-routes/yesod-routes.cabal @@ -1,5 +1,5 @@ name: yesod-routes -version: 1.2.0.1 +version: 1.2.0.2 license: MIT license-file: LICENSE author: Michael Snoyman @@ -16,7 +16,7 @@ extra-source-files: library build-depends: base >= 4 && < 5 - , text >= 0.5 && < 0.12 + , text >= 0.5 , vector >= 0.8 && < 0.11 , containers >= 0.2 , template-haskell @@ -42,7 +42,7 @@ test-suite runtests build-depends: base >= 4.3 && < 5 , yesod-routes - , text >= 0.5 && < 0.12 + , text >= 0.5 , HUnit >= 1.2 && < 1.3 , hspec >= 1.3 , containers diff --git a/yesod-static/Yesod/Static.hs b/yesod-static/Yesod/Static.hs index 85e95e87..ef27f1b8 100644 --- a/yesod-static/Yesod/Static.hs +++ b/yesod-static/Yesod/Static.hs @@ -101,7 +101,7 @@ import Filesystem (createTree) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE import Data.Default -import Text.Lucius (luciusRTMinified) +--import Text.Lucius (luciusRTMinified) import Network.Wai.Application.Static ( StaticSettings (..) @@ -478,10 +478,13 @@ data CombineSettings = CombineSettings instance Default CombineSettings where def = CombineSettings { csStaticDir = "static" + {- Disabled due to: https://github.com/yesodweb/yesod/issues/623 , csCssPostProcess = \fps -> either (error . (errorIntro fps)) (return . TLE.encodeUtf8) . flip luciusRTMinified [] . TLE.decodeUtf8 + -} + , csCssPostProcess = const return , csJsPostProcess = const return -- FIXME The following borders on a hack. With combining of files, -- the final location of the CSS is no longer fixed, so relative diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index a599b4e4..df05ecf5 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -1,5 +1,5 @@ name: yesod-static -version: 1.2.1 +version: 1.2.2 license: MIT license-file: LICENSE author: Michael Snoyman @@ -34,8 +34,8 @@ library , template-haskell , directory >= 1.0 , transformers >= 0.2.2 - , wai-app-static >= 1.3.2 && < 1.4 - , wai >= 1.3 && < 1.5 + , wai-app-static >= 1.3.2 + , 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 9c1e2a24..88aff16b 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -1,5 +1,5 @@ name: yesod -version: 1.2.3 +version: 1.2.4 license: MIT license-file: LICENSE author: Michael Snoyman @@ -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.3 , shakespeare-css >= 1.0 && < 1.1 - , warp >= 1.3 && < 1.4 + , warp >= 1.3 , blaze-html >= 0.5 , blaze-markup >= 0.5.1 , aeson