yesod-core 1.4.15 → 1.4.15.1
raw patch · 12 files changed
+74/−40 lines, 12 files
Files
- ChangeLog.md +4/−0
- Yesod/Core/Class/Handler.hs +3/−2
- Yesod/Core/Content.hs +6/−7
- Yesod/Core/Dispatch.hs +14/−0
- Yesod/Core/Handler.hs +8/−3
- Yesod/Core/Internal/LiteApp.hs +4/−3
- Yesod/Core/Internal/Run.hs +12/−19
- Yesod/Core/Internal/Util.hs +10/−1
- Yesod/Core/Types.hs +6/−3
- Yesod/Core/Unsafe.hs +3/−0
- Yesod/Routes/TH/RenderRoute.hs +3/−1
- yesod-core.cabal +1/−1
ChangeLog.md view
@@ -1,3 +1,7 @@+## 1.4.16.1++* bugfix neverExpires leaked threads+ ## 1.4.15 * mkYesod avoids using reify when it isn't necessary. This avoids needing to define the site type below the call to mkYesod.
Yesod/Core/Class/Handler.hs view
@@ -11,12 +11,13 @@ ) where import Yesod.Core.Types-import Data.Monoid (mempty) import Control.Monad (liftM) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Resource (MonadResource, MonadResourceBase) import Control.Monad.Trans.Class (lift)-import Data.Monoid (Monoid)+#if __GLASGOW_HASKELL__ < 710+import Data.Monoid (Monoid, mempty)+#endif import Data.Conduit.Internal (Pipe, ConduitM) import Control.Monad.Trans.Identity ( IdentityT)
Yesod/Core/Content.hs view
@@ -56,8 +56,9 @@ import Control.Monad (liftM) import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString)+#if __GLASGOW_HASKELL__ < 710 import Data.Monoid (mempty)-+#endif import Text.Hamlet (Html) import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder) import Data.Conduit (Source, Flush (Chunk), ResumableSource, mapOutput)@@ -76,6 +77,7 @@ import Yesod.Core.Types import Text.Lucius (Css, renderCss) import Text.Julius (Javascript, unJavascript)+import Data.Word8 (_semicolon, _slash) -- | Zero-length enumerator. emptyContent :: Content@@ -224,18 +226,15 @@ -- For example, \"text/html; charset=utf-8\" is commonly used to specify the -- character encoding for HTML data. This function would return \"text/html\". simpleContentType :: ContentType -> ContentType-simpleContentType = fst . B.breakByte 59 -- 59 == ;+simpleContentType = fst . B.break (== _semicolon) -- Give just the media types as a pair. -- For example, \"text/html; charset=utf-8\" returns ("text", "html") contentTypeTypes :: ContentType -> (B.ByteString, B.ByteString)-contentTypeTypes ct = (main, fst $ B.breakByte semicolon (tailEmpty sub))+contentTypeTypes ct = (main, fst $ B.break (== _semicolon) (tailEmpty sub)) where tailEmpty x = if B.null x then "" else B.tail x- (main, sub) = B.breakByte slash ct- slash = 47- semicolon = 59-+ (main, sub) = B.break (== _slash) ct instance HasContentType a => HasContentType (DontFullyEvaluate a) where getContentType = getContentType . liftM unDontFullyEvaluate
Yesod/Core/Dispatch.hs view
@@ -45,7 +45,9 @@ import Data.ByteString.Lazy.Char8 () import Data.Text (Text)+#if __GLASGOW_HASKELL__ < 710 import Data.Monoid (mappend)+#endif import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Blaze.ByteString.Builder@@ -57,6 +59,8 @@ import Yesod.Core.Internal.Run import Safe (readMay) import System.Environment (getEnvironment)+import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction, updateFreq)+import Yesod.Core.Internal.Util (getCurrentMaxExpiresRFC1123) import Network.Wai.Middleware.Autohead import Network.Wai.Middleware.AcceptOverride@@ -80,11 +84,13 @@ logger <- makeLogger site sb <- makeSessionBackend site gen <- MWC.createSystemRandom+ getMaxExpires <- getGetMaxExpires return $ toWaiAppYre $ YesodRunnerEnv { yreLogger = logger , yreSite = site , yreSessionBackend = sb , yreGen = gen+ , yreGetMaxExpires = getMaxExpires } toWaiAppYre :: YesodDispatch site => YesodRunnerEnv site -> W.Application@@ -137,11 +143,13 @@ toWaiAppLogger logger site = do sb <- makeSessionBackend site gen <- MWC.createSystemRandom+ getMaxExpires <- getGetMaxExpires let yre = YesodRunnerEnv { yreLogger = logger , yreSite = site , yreSessionBackend = sb , yreGen = gen+ , yreGetMaxExpires = getMaxExpires } messageLoggerSource site@@ -228,3 +236,9 @@ case readMay portS of Nothing -> error $ "warpEnv: invalid PORT environment variable: " ++ show portS Just port -> warp port site++getGetMaxExpires :: IO (IO Text)+getGetMaxExpires = mkAutoUpdate defaultUpdateSettings+ { updateAction = getCurrentMaxExpiresRFC1123+ , updateFreq = 24 * 60 * 60 * 1000000 -- Update once per day+ }
Yesod/Core/Handler.hs view
@@ -178,7 +178,12 @@ import Yesod.Core.Internal.Request (langKey, mkFileInfoFile, mkFileInfoLBS, mkFileInfoSource) -import Control.Applicative ((<$>), (<|>))++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+import Data.Monoid (mempty, mappend)+#endif+import Control.Applicative ((<|>)) import Control.Exception (evaluate, SomeException) import Control.Exception.Lifted (handle) @@ -208,7 +213,7 @@ import Control.Arrow ((***)) import qualified Data.ByteString.Char8 as S8-import Data.Monoid (Endo (..), mappend, mempty)+import Data.Monoid (Endo (..)) import Data.Text (Text) import qualified Network.Wai.Parse as NWP import Text.Shakespeare.I18N (RenderMessage (..))@@ -728,7 +733,7 @@ -- is never (realistically) expired. neverExpires :: MonadHandler m => m () neverExpires = do- askHandlerEnv >>= liftIO . rheGetMaxExpires >>= setHeader "Expires"+ setHeader "Expires" . rheMaxExpires =<< askHandlerEnv cacheSeconds oneYear where oneYear :: Int
Yesod/Core/Internal/LiteApp.hs view
@@ -1,9 +1,10 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE TypeFamilies, PatternGuards, CPP #-} module Yesod.Core.Internal.LiteApp where -import Yesod.Routes.Class+#if __GLASGOW_HASKELL__ < 710 import Data.Monoid+#endif+import Yesod.Routes.Class import Yesod.Core.Class.Yesod import Yesod.Core.Class.Dispatch import Yesod.Core.Types
Yesod/Core/Internal/Run.hs view
@@ -7,9 +7,12 @@ {-# LANGUAGE FlexibleContexts #-} module Yesod.Core.Internal.Run where ++#if __GLASGOW_HASKELL__ < 710+import Data.Monoid (mempty)+#endif import Yesod.Core.Internal.Response import Blaze.ByteString.Builder (toByteString)-import Control.Applicative ((<$>)) import Control.Exception (fromException, evaluate) import qualified Control.Exception as E import Control.Exception.Lifted (catch)@@ -25,13 +28,12 @@ import qualified Data.Map as Map import Data.Maybe (isJust) import Data.Maybe (fromMaybe)-import Data.Monoid (appEndo, mempty)+import Data.Monoid (appEndo) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode)-import Data.Time (getCurrentTime, addUTCTime) import Language.Haskell.TH.Syntax (Loc, qLocation) import qualified Network.HTTP.Types as H import Network.Wai@@ -40,17 +42,14 @@ import Prelude hiding (catch) #endif import System.Log.FastLogger (LogStr, toLogStr)-import System.Random (newStdGen) import Yesod.Core.Content import Yesod.Core.Class.Yesod import Yesod.Core.Types import Yesod.Core.Internal.Request (parseWaiRequest, tooLargeResponse)-import Yesod.Core.Internal.Util (formatRFC1123)+import Yesod.Core.Internal.Util (getCurrentMaxExpiresRFC1123) import Yesod.Routes.Class (Route, renderRoute)-import Control.DeepSeq (($!!), NFData)-import Control.Monad (liftM)-import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction, updateFreq)+import Control.DeepSeq (($!!)) returnDeepSessionMap :: Monad m => SessionMap -> m SessionMap #if MIN_VERSION_bytestring(0, 10, 0)@@ -197,7 +196,7 @@ -> m (Either ErrorResponse a) runFakeHandler fakeSessionMap logger site handler = liftIO $ do ret <- I.newIORef (Left $ InternalError "runFakeHandler: no result")- getMaxExpires <- getGetMaxExpires+ maxExpires <- getCurrentMaxExpiresRFC1123 let handler' = do liftIO . I.writeIORef ret . Right =<< handler return () let yapp = runHandler@@ -208,7 +207,7 @@ , rheUpload = fileUpload site , rheLog = messageLoggerSource site $ logger site , rheOnError = errHandler- , rheGetMaxExpires = getMaxExpires+ , rheMaxExpires = maxExpires } handler' errHandler err req = do@@ -259,11 +258,11 @@ let dontSaveSession _ = return [] (session, saveSession) <- liftIO $ do maybe (return (Map.empty, dontSaveSession)) (\sb -> sbLoadSession sb req) yreSessionBackend- getMaxExpires <- getGetMaxExpires+ maxExpires <- yreGetMaxExpires let mkYesodReq = parseWaiRequest req session (isJust yreSessionBackend) mmaxLen let yreq = case mkYesodReq of- Left yreq -> yreq+ Left yreq' -> yreq' Right needGen -> needGen yreGen let ra = resolveApproot yreSite req let log' = messageLoggerSource yreSite yreLogger@@ -278,7 +277,7 @@ , rheUpload = fileUpload yreSite , rheLog = log' , rheOnError = safeEh log'- , rheGetMaxExpires = getMaxExpires+ , rheMaxExpires = maxExpires } rhe = rheSafe { rheOnError = runHandler rheSafe . errorHandler@@ -291,12 +290,6 @@ where mmaxLen = maximumContentLength yreSite route handler = yesodMiddleware handler'--getGetMaxExpires :: MonadIO m => m (IO Text)-getGetMaxExpires = liftIO $ mkAutoUpdate defaultUpdateSettings- { updateAction = liftM (formatRFC1123 . addUTCTime (60*60*24*365)) getCurrentTime- , updateFreq = 60 * 60 * 1000000 -- Update once per hour- } yesodRender :: Yesod y => y
Yesod/Core/Internal/Util.hs view
@@ -5,13 +5,16 @@ , formatW3 , formatRFC1123 , formatRFC822+ , getCurrentMaxExpiresRFC1123 ) where import Data.Int (Int64) import Data.Serialize (Get, Put, Serialize (..)) import qualified Data.Text as T import Data.Time (Day (ModifiedJulianDay, toModifiedJulianDay),- DiffTime, UTCTime (..), formatTime)+ DiffTime, UTCTime (..), formatTime,+ getCurrentTime, addUTCTime)+import Control.Monad (liftM) #if MIN_VERSION_time(1,5,0) import Data.Time (defaultTimeLocale)@@ -50,3 +53,9 @@ -- | Format as per RFC 822. formatRFC822 :: UTCTime -> T.Text formatRFC822 = T.pack . formatTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S %z"++{- | Get the time 365 days from now in RFC 1123 format. For use as an expiry+date on a resource that never expires. See RFC 2616 section 14.21 for details.+-}+getCurrentMaxExpiresRFC1123 :: IO T.Text+getCurrentMaxExpiresRFC1123 = liftM (formatRFC1123 . addUTCTime (60*60*24*365)) getCurrentTime
Yesod/Core/Types.hs view
@@ -10,8 +10,11 @@ import qualified Blaze.ByteString.Builder as BBuilder import qualified Blaze.ByteString.Builder.Char.Utf8+#if __GLASGOW_HASKELL__ < 710 import Control.Applicative (Applicative (..)) import Control.Applicative ((<$>))+import Data.Monoid (Monoid (..))+#endif import Control.Arrow (first) import Control.Exception (Exception) import Control.Monad (liftM, ap)@@ -29,8 +32,7 @@ import Data.IORef (IORef) import Data.Map (Map, unionWith) import qualified Data.Map as Map-import Data.Monoid (Endo (..), Last (..),- Monoid (..))+import Data.Monoid (Endo (..), Last (..)) import Data.Serialize (Serialize (..), putByteString) import Data.String (IsString (fromString))@@ -181,10 +183,10 @@ , rheUpload :: !(RequestBodyLength -> FileUpload) , rheLog :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ()) , rheOnError :: !(ErrorResponse -> YesodApp)- , rheGetMaxExpires :: IO Text -- ^ How to respond when an error is thrown internally. -- -- Since 1.2.0+ , rheMaxExpires :: !Text } data HandlerData site parentRoute = HandlerData@@ -200,6 +202,7 @@ , yreSite :: !site , yreSessionBackend :: !(Maybe SessionBackend) , yreGen :: !MWC.GenIO+ , yreGetMaxExpires :: IO Text } data YesodSubRunnerEnv sub parent parentMonad = YesodSubRunnerEnv
Yesod/Core/Unsafe.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | This is designed to be used as -- -- > qualified import Yesod.Core.Unsafe as Unsafe@@ -9,7 +10,9 @@ import Yesod.Core.Types import Yesod.Core.Class.Yesod+#if __GLASGOW_HASKELL__ < 710 import Data.Monoid (mempty, mappend)+#endif import Control.Monad.IO.Class (MonadIO) -- | designed to be used as
Yesod/Routes/TH/RenderRoute.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskell, CPP #-} module Yesod.Routes.TH.RenderRoute ( -- ** RenderRoute mkRenderRouteInstance@@ -14,7 +14,9 @@ import Data.Text (pack) import Web.PathPieces (PathPiece (..), PathMultiPiece (..)) import Yesod.Routes.Class+#if __GLASGOW_HASKELL__ < 710 import Data.Monoid (mconcat)+#endif -- | Generate the constructors of a route data type. mkRouteCons :: [ResourceTree Type] -> ([Con], [Dec])
yesod-core.cabal view
@@ -1,5 +1,5 @@ name: yesod-core-version: 1.4.15+version: 1.4.15.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>