yesod-core 1.4.15.1 → 1.4.16

raw patch · 5 files changed

+50/−11 lines, 5 filesdep ~wai-extra

Dependency ranges changed: wai-extra

Files

• ChangeLog.md +5/−1
• Yesod/Core.hs +3/−0
• Yesod/Core/Class/Yesod.hs +28/−0
• Yesod/Core/Internal/Session.hs +12/−8
• yesod-core.cabal +2/−2

@@ -1,4 +1,8 @@-## 1.4.16.1+## 1.4.16++* Add `guessApproot` and `guessApprootOr`++## 1.4.15.1  * bugfix neverExpires leaked threads 

@@ -71,6 +71,9 @@     , MonadWidget (..)     , getRouteToParent     , defaultLayoutSub+      -- * Approot+    , guessApproot+    , guessApprootOr       -- * Misc     , yesodVersion     , yesodRender

@@ -56,6 +56,7 @@ import           Yesod.Core.Widget import Control.Monad.Trans.Class (lift) import Data.CaseInsensitive (CI)+import qualified Network.Wai.Request  -- | Define settings for a Yesod applications. All methods have intelligent -- defaults, and therefore no implementation is required.@@ -826,3 +827,30 @@   where     line = show . fst . loc_start     char = show . snd . loc_start++-- | Guess the approot based on request headers. For more information, see+-- "Network.Wai.Middleware.Approot"+--+-- In the case of headers being unavailable, it falls back to 'ApprootRelative'+--+-- Since 1.4.16+guessApproot :: Approot site+guessApproot = guessApprootOr ApprootRelative++-- | Guess the approot based on request headers, with fall back to the+-- specified 'AppRoot'.+--+-- Since 1.4.16+guessApprootOr :: Approot site -> Approot site+guessApprootOr fallback = ApprootRequest $ \master req ->+    case W.requestHeaderHost req of+        Nothing -> case fallback of+                       ApprootRelative  -> ""+                       ApprootStatic t  -> t+                       ApprootMaster f  -> f master+                       ApprootRequest f -> f master req+        Just host ->+            (if Network.Wai.Request.appearsSecure req+                then "https://"+                else "http://")+            `T.append` TE.decodeUtf8With TEE.lenientDecode host

@@ -16,6 +16,7 @@ import Yesod.Core.Types import Yesod.Core.Internal.Util import qualified Data.IORef as I+import Control.AutoUpdate  encodeClientSession :: CS.Key                     -> CS.IV@@ -44,25 +45,28 @@ ----------------------------------------------------------------------  --- Mostly copied from Kazu's date-cache, but with modifications--- that better suit our needs.+-- Originally copied from Kazu's date-cache, but now using mkAutoUpdate. -- -- The cached date is updated every 10s, we don't need second -- resolution for session expiration times.+--+-- The second component of the returned tuple used to be an action that+-- killed the updater thread, but is now a no-op that's just there+-- to preserve the type.  clientSessionDateCacher ::      NominalDiffTime -- ^ Inactive session valitity.   -> IO (IO ClientSessionDateCache, IO ()) clientSessionDateCacher validity = do-    ref <- getUpdated >>= I.newIORef-    tid <- forkIO $ forever (doUpdate ref)-    return $! (I.readIORef ref, killThread tid)+    getClientSessionDateCache <- mkAutoUpdate defaultUpdateSettings+      { updateAction = getUpdated+      , updateFreq   = 10000000 -- 10s+      }++    return $! (getClientSessionDateCache, return ())   where     getUpdated = do       now <- getCurrentTime       let expires  = validity `addUTCTime` now           expiresS = runPut (putTime expires)       return $! ClientSessionDateCache now expires expiresS-    doUpdate ref = do-      threadDelay 10000000 -- 10s-      I.writeIORef ref =<< getUpdated

@@ -1,5 +1,5 @@ name:            yesod-core-version:         1.4.15.1+version:         1.4.16 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -25,7 +25,7 @@     build-depends:   base                  >= 4.3      && < 5                    , time                  >= 1.1.4                    , wai                   >= 3.0-                   , wai-extra             >= 3.0.5+                   , wai-extra             >= 3.0.7                    , bytestring            >= 0.9.1.4                    , text                  >= 0.7                    , template-haskell