From ce74e23d872943834bde77c6b5f759f2b025bf72 Mon Sep 17 00:00:00 2001
From: Maximilian Tagher <feedback.tagher@gmail.com>
Date: Fri, 28 Nov 2014 15:57:01 -0500
Subject: [PATCH 01/43] `timeField` now uses `type="time"`

* Also removes deprecation from `timeField`
* Also mildly discourages using `timeFieldTypeText`
---
 yesod-form/Yesod/Form/Fields.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs
index 84c42c8b..3c3a0d2b 100644
--- a/yesod-form/Yesod/Form/Fields.hs
+++ b/yesod-form/Yesod/Form/Fields.hs
@@ -154,10 +154,9 @@ $newline never
     }
   where showVal = either id (pack . show)
 
--- | An alias for 'timeFieldTypeText'.
+-- | An alias for 'timeFieldTypeTime'.
 timeField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay
-timeField = timeFieldTypeText
-{-# DEPRECATED timeField "'timeField' currently defaults to an input of type=\"text\". In the next major release, it will default to type=\"time\". To opt in to the new functionality, use 'timeFieldTypeTime'. To keep the existing behavior, use 'timeFieldTypeText'. See 'https://github.com/yesodweb/yesod/pull/874' for details." #-}
+timeField = timeFieldTypeTime
 
 -- | Creates an input with @type="time"@. <http://caniuse.com/#search=time%20input%20type Browsers not supporting this type> will fallback to a text field, and Yesod will parse the time as described in 'timeFieldTypeText'.
 -- 
@@ -168,6 +167,8 @@ timeFieldTypeTime :: Monad m => RenderMessage (HandlerSite m) FormMessage => Fie
 timeFieldTypeTime = timeFieldOfType "time"
 
 -- | Creates an input with @type="text"@, parsing the time from an [H]H:MM[:SS] format, with an optional AM or PM (if not given, AM is assumed for compatibility with the 24 hour clock system).
+--
+-- This function exists for backwards compatibility with the old implementation of 'timeField', which used to use @type="text"@. Consider using 'timeField' or 'timeFieldTypeTime' for improved UX and validation from the browser.
 -- 
 -- Add the @time@ package and import the "Data.Time.LocalTime" module to use this function.
 --

From 79aefc694ae2e3eb176dfd26f4e3d83def3d1e12 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 13 Oct 2015 10:34:31 +0000
Subject: [PATCH 02/43] Make guessApproot the default (for yesod-core1.5)

---
 yesod-core/Yesod/Core/Class/Yesod.hs | 16 ++++++----------
 1 file changed, 6 insertions(+), 10 deletions(-)

diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs
index 47f4fb49..184d6721 100644
--- a/yesod-core/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/Yesod/Core/Class/Yesod.hs
@@ -64,18 +64,14 @@ class RenderRoute site => Yesod site where
     -- | An absolute URL to the root of the application. Do not include
     -- trailing slash.
     --
-    -- Default value: 'ApprootRelative'. This is valid under the following
-    -- conditions:
+    -- Default value: 'guessApproot'. If you know your application root
+    -- statically, it will be more efficient and more reliable to instead use
+    -- 'ApprootStatic' or 'ApprootMaster'. If you do not need full absolute
+    -- URLs, you can use 'ApprootRelative' instead.
     --
-    -- * Your application is served from the root of the domain.
-    --
-    -- * You do not use any features that require absolute URLs, such as Atom
-    -- feeds and XML sitemaps.
-    --
-    -- If this is not true, you should override with a different
-    -- implementation.
+    -- Note: Prior to yesod-core 1.5, the default value was 'ApprootRelative'.
     approot :: Approot site
-    approot = ApprootRelative
+    approot = guessApproot
 
     -- | Output error response pages.
     --

From c5ac8211151d99ed6730e3b4c3deaeea8c90c8ad Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 12 Dec 2017 12:08:06 +0200
Subject: [PATCH 03/43] Remove some conditionals for old versions

---
 yesod-core/Yesod/Core/Class/Handler.hs     |  6 -----
 yesod-core/Yesod/Core/Content.hs           | 24 --------------------
 yesod-core/Yesod/Core/Handler.hs           |  4 ----
 yesod-core/Yesod/Core/Internal/Response.hs |  3 ---
 yesod-core/Yesod/Core/Internal/Util.hs     |  7 +-----
 yesod-core/Yesod/Core/Json.hs              | 16 -------------
 yesod-core/Yesod/Core/Types.hs             | 26 ----------------------
 yesod-core/test/RouteSpec.hs               |  8 -------
 yesod-core/yesod-core.cabal                | 10 ++++-----
 9 files changed, 6 insertions(+), 98 deletions(-)

diff --git a/yesod-core/Yesod/Core/Class/Handler.hs b/yesod-core/Yesod/Core/Class/Handler.hs
index 1d711900..409b867b 100644
--- a/yesod-core/Yesod/Core/Class/Handler.hs
+++ b/yesod-core/Yesod/Core/Class/Handler.hs
@@ -25,9 +25,7 @@ import Control.Monad.Trans.Identity ( IdentityT)
 import Control.Monad.Trans.List     ( ListT    )
 import Control.Monad.Trans.Maybe    ( MaybeT   )
 import Control.Monad.Trans.Error    ( ErrorT, Error)
-#if MIN_VERSION_transformers(0,4,0)
 import Control.Monad.Trans.Except   ( ExceptT  )
-#endif
 import Control.Monad.Trans.Reader   ( ReaderT  )
 import Control.Monad.Trans.State    ( StateT   )
 import Control.Monad.Trans.Writer   ( WriterT  )
@@ -59,9 +57,7 @@ GO(IdentityT)
 GO(ListT)
 GO(MaybeT)
 GOX(Error e, ErrorT e)
-#if MIN_VERSION_transformers(0,4,0)
 GO(ExceptT e)
-#endif
 GO(ReaderT r)
 GO(StateT s)
 GOX(Monoid w, WriterT w)
@@ -85,9 +81,7 @@ GO(IdentityT)
 GO(ListT)
 GO(MaybeT)
 GOX(Error e, ErrorT e)
-#if MIN_VERSION_transformers(0,4,0)
 GO(ExceptT e)
-#endif
 GO(ReaderT r)
 GO(StateT s)
 GOX(Monoid w, WriterT w)
diff --git a/yesod-core/Yesod/Core/Content.hs b/yesod-core/Yesod/Core/Content.hs
index 1313a1ea..d98d967e 100644
--- a/yesod-core/Yesod/Core/Content.hs
+++ b/yesod-core/Yesod/Core/Content.hs
@@ -66,12 +66,6 @@ import Data.Conduit.Internal (ResumableSource (ResumableSource))
 import qualified Data.Conduit.Internal as CI
 
 import qualified Data.Aeson as J
-#if MIN_VERSION_aeson(1, 0, 0)
-#elif MIN_VERSION_aeson(0, 7, 0)
-import Data.Aeson.Encode (encodeToTextBuilder)
-#else
-import Data.Aeson.Encode (fromValue)
-#endif
 import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
 import Data.Text.Lazy.Builder (toLazyText)
 import Yesod.Core.Types
@@ -243,34 +237,18 @@ instance ToContent a => ToContent (DontFullyEvaluate a) where
     toContent (DontFullyEvaluate a) = ContentDontEvaluate $ toContent a
 
 instance ToContent J.Value where
-#if MIN_VERSION_aeson(1, 0, 0)
     toContent = flip ContentBuilder Nothing
               . J.fromEncoding
               . J.toEncoding
-#else
-    toContent = flip ContentBuilder Nothing
-              . Blaze.fromLazyText
-              . toLazyText
-#if MIN_VERSION_aeson(0, 7, 0)
-              . encodeToTextBuilder
-#else
-              . fromValue
-#endif
 
-#endif
-
-#if MIN_VERSION_aeson(0, 11, 0)
 instance ToContent J.Encoding where
     toContent = flip ContentBuilder Nothing . J.fromEncoding
-#endif
 
 instance HasContentType J.Value where
     getContentType _ = typeJson
 
-#if MIN_VERSION_aeson(0, 11, 0)
 instance HasContentType J.Encoding where
     getContentType _ = typeJson
-#endif
 
 instance HasContentType Html where
     getContentType _ = typeHtml
@@ -307,10 +285,8 @@ instance ToTypedContent RepXml where
     toTypedContent (RepXml c) = TypedContent typeXml c
 instance ToTypedContent J.Value where
     toTypedContent v = TypedContent typeJson (toContent v)
-#if MIN_VERSION_aeson(0, 11, 0)
 instance ToTypedContent J.Encoding where
     toTypedContent e = TypedContent typeJson (toContent e)
-#endif
 instance ToTypedContent Html where
     toTypedContent h = TypedContent typeHtml (toContent h)
 instance ToTypedContent T.Text where
diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs
index 9a340803..bfd254d0 100644
--- a/yesod-core/Yesod/Core/Handler.hs
+++ b/yesod-core/Yesod/Core/Handler.hs
@@ -635,11 +635,7 @@ sendResponseStatus s = handlerError . HCContent s . toTypedContent
 --
 -- @since 1.4.18
 sendStatusJSON :: (MonadHandler m, ToJSON c) => H.Status -> c -> m a
-#if MIN_VERSION_aeson(0, 11, 0)
 sendStatusJSON s v = sendResponseStatus s (toEncoding v)
-#else
-sendStatusJSON s v = sendResponseStatus s (toJSON v)
-#endif
 
 -- | Send a 201 "Created" response with the given route as the Location
 -- response header.
diff --git a/yesod-core/Yesod/Core/Internal/Response.hs b/yesod-core/Yesod/Core/Internal/Response.hs
index 7b2f2dde..a7263b61 100644
--- a/yesod-core/Yesod/Core/Internal/Response.hs
+++ b/yesod-core/Yesod/Core/Internal/Response.hs
@@ -12,9 +12,6 @@ import           Network.Wai
 import           Control.Monad                (mplus)
 import           Control.Monad.Trans.Resource (runInternalState, InternalState)
 import           Network.Wai.Internal
-#if !MIN_VERSION_base(4, 6, 0)
-import           Prelude                      hiding (catch)
-#endif
 import           Web.Cookie                   (renderSetCookie)
 import           Yesod.Core.Content
 import           Yesod.Core.Types
diff --git a/yesod-core/Yesod/Core/Internal/Util.hs b/yesod-core/Yesod/Core/Internal/Util.hs
index 204602c7..5f747855 100644
--- a/yesod-core/Yesod/Core/Internal/Util.hs
+++ b/yesod-core/Yesod/Core/Internal/Util.hs
@@ -13,12 +13,7 @@ import           Data.Serialize (Get, Put, Serialize (..))
 import qualified Data.Text      as T
 import           Data.Time      (Day (ModifiedJulianDay, toModifiedJulianDay),
                                  DiffTime, UTCTime (..), formatTime,
-                                 getCurrentTime, addUTCTime)
-#if MIN_VERSION_time(1,5,0)
-import           Data.Time      (defaultTimeLocale)
-#else
-import           System.Locale  (defaultTimeLocale)
-#endif
+                                 getCurrentTime, addUTCTime, defaultTimeLocale)
 
 putTime :: UTCTime -> Put
 putTime (UTCTime d t) =
diff --git a/yesod-core/Yesod/Core/Json.hs b/yesod-core/Yesod/Core/Json.hs
index dc1116ba..245aad90 100644
--- a/yesod-core/Yesod/Core/Json.hs
+++ b/yesod-core/Yesod/Core/Json.hs
@@ -6,9 +6,7 @@ module Yesod.Core.Json
       defaultLayoutJson
     , jsonToRepJson
     , returnJson
-#if MIN_VERSION_aeson(0, 11, 0)
     , returnJsonEncoding
-#endif
     , provideJson
 
       -- * Convert to a JSON value
@@ -29,9 +27,7 @@ module Yesod.Core.Json
 
       -- * Convenience functions
     , jsonOrRedirect
-#if MIN_VERSION_aeson(0, 11, 0)
     , jsonEncodingOrRedirect
-#endif
     , acceptsJson
     ) where
 
@@ -67,11 +63,7 @@ defaultLayoutJson :: (Yesod site, J.ToJSON a)
                   -> HandlerT site IO TypedContent
 defaultLayoutJson w json = selectRep $ do
     provideRep $ defaultLayout w
-#if MIN_VERSION_aeson(0, 11, 0)
     provideRep $ fmap J.toEncoding json
-#else
-    provideRep $ fmap J.toJSON json
-#endif
 
 -- | Wraps a data type in a 'RepJson'.  The data type must
 -- support conversion to JSON via 'J.ToJSON'.
@@ -87,24 +79,18 @@ jsonToRepJson = return . J.toJSON
 returnJson :: (Monad m, J.ToJSON a) => a -> m J.Value
 returnJson = return . J.toJSON
 
-#if MIN_VERSION_aeson(0, 11, 0)
 -- | Convert a value to a JSON representation via aeson\'s 'J.toEncoding' function.
 --
 -- @since 1.4.21
 returnJsonEncoding :: (Monad m, J.ToJSON a) => a -> m J.Encoding
 returnJsonEncoding = return . J.toEncoding
-#endif
 
 -- | Provide a JSON representation for usage with 'selectReps', using aeson\'s
 -- 'J.toJSON' (aeson >= 0.11: 'J.toEncoding') function to perform the conversion.
 --
 -- @since 1.2.1
 provideJson :: (Monad m, J.ToJSON a) => a -> Writer (Endo [ProvidedRep m]) ()
-#if MIN_VERSION_aeson(0, 11, 0)
 provideJson = provideRep . return . J.toEncoding
-#else
-provideJson = provideRep . return . J.toJSON
-#endif
 
 -- | Parse the request body to a data type as a JSON value.  The
 -- data type must support conversion from JSON via 'J.FromJSON'.
@@ -173,7 +159,6 @@ jsonOrRedirect :: (MonadHandler m, J.ToJSON a)
                -> m J.Value
 jsonOrRedirect = jsonOrRedirect' J.toJSON
 
-#if MIN_VERSION_aeson(0, 11, 0)
 -- | jsonEncodingOrRedirect simplifies the scenario where a POST handler sends a different
 -- response based on Accept headers:
 --
@@ -187,7 +172,6 @@ jsonEncodingOrRedirect :: (MonadHandler m, J.ToJSON a)
             -> a            -- ^ Data to send via JSON
             -> m J.Encoding
 jsonEncodingOrRedirect = jsonOrRedirect' J.toEncoding
-#endif
 
 jsonOrRedirect' :: MonadHandler m
             => (a -> b)
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index 5067c480..a1c960de 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -59,16 +59,11 @@ import           Yesod.Core.Internal.Util           (getTime, putTime)
 import           Control.Monad.Trans.Class          (MonadTrans (..))
 import           Yesod.Routes.Class                 (RenderRoute (..), ParseRoute (..))
 import           Control.Monad.Reader               (MonadReader (..))
-#if !MIN_VERSION_base(4, 6, 0)
-import Prelude hiding (catch)
-#endif
 import Control.DeepSeq (NFData (rnf))
 import Control.DeepSeq.Generics (genericRnf)
 import Data.Conduit.Lazy (MonadActive, monadActive)
 import Yesod.Core.TypeCache (TypeMap, KeyedTypeMap)
-#if MIN_VERSION_monad_logger(0, 3, 10)
 import Control.Monad.Logger (MonadLoggerIO (..))
-#endif
 import Data.Semigroup (Semigroup)
 
 -- Sessions
@@ -422,21 +417,12 @@ instance MonadIO m => MonadIO (WidgetT site m) where
 instance MonadBase b m => MonadBase b (WidgetT site m) where
     liftBase = WidgetT . const . liftBase . fmap (, mempty)
 instance MonadBaseControl b m => MonadBaseControl b (WidgetT site m) where
-#if MIN_VERSION_monad_control(1,0,0)
     type StM (WidgetT site m) a = StM m (a, GWData (Route site))
     liftBaseWith f = WidgetT $ \reader' ->
         liftBaseWith $ \runInBase ->
             fmap (\x -> (x, mempty))
             (f $ runInBase . flip unWidgetT reader')
     restoreM = WidgetT . const . restoreM
-#else
-    data StM (WidgetT site m) a = StW (StM m (a, GWData (Route site)))
-    liftBaseWith f = WidgetT $ \reader' ->
-        liftBaseWith $ \runInBase ->
-            fmap (\x -> (x, mempty))
-            (f $ fmap StW . runInBase . flip unWidgetT reader')
-    restoreM (StW base) = WidgetT $ const $ restoreM base
-#endif
 instance Monad m => MonadReader site (WidgetT site m) where
     ask = WidgetT $ \hd -> return (rheSite $ handlerEnv hd, mempty)
     local f (WidgetT g) = WidgetT $ \hd -> g hd
@@ -479,10 +465,8 @@ instance MonadIO m => MonadLogger (WidgetT site m) where
     monadLoggerLog a b c d = WidgetT $ \hd ->
         liftIO $ (, mempty) <$> rheLog (handlerEnv hd) a b c (toLogStr d)
 
-#if MIN_VERSION_monad_logger(0, 3, 10)
 instance MonadIO m => MonadLoggerIO (WidgetT site m) where
     askLoggerIO = WidgetT $ \hd -> return (rheLog (handlerEnv hd), mempty)
-#endif
 
 instance MonadActive m => MonadActive (WidgetT site m) where
     monadActive = lift monadActive
@@ -521,19 +505,11 @@ instance Monad m => MonadReader site (HandlerT site m) where
 -- \"Control.Monad.Trans.Resource.register\': The mutable state is being accessed
 -- after cleanup. Please contact the maintainers.\"
 instance MonadBaseControl b m => MonadBaseControl b (HandlerT site m) where
-#if MIN_VERSION_monad_control(1,0,0)
     type StM (HandlerT site m) a = StM m a
     liftBaseWith f = HandlerT $ \reader' ->
         liftBaseWith $ \runInBase ->
             f $ runInBase . (\(HandlerT r) -> r reader')
     restoreM = HandlerT . const . restoreM
-#else
-    data StM (HandlerT site m) a = StH (StM m a)
-    liftBaseWith f = HandlerT $ \reader' ->
-        liftBaseWith $ \runInBase ->
-            f $ fmap StH . runInBase . (\(HandlerT r) -> r reader')
-    restoreM (StH base) = HandlerT $ const $ restoreM base
-#endif
 
 instance MonadThrow m => MonadThrow (HandlerT site m) where
     throwM = lift . monadThrow
@@ -545,10 +521,8 @@ instance MonadIO m => MonadLogger (HandlerT site m) where
     monadLoggerLog a b c d = HandlerT $ \hd ->
         liftIO $ rheLog (handlerEnv hd) a b c (toLogStr d)
 
-#if MIN_VERSION_monad_logger(0, 3, 10)
 instance MonadIO m => MonadLoggerIO (HandlerT site m) where
     askLoggerIO = HandlerT $ \hd -> return (rheLog (handlerEnv hd))
-#endif
 
 instance Monoid (UniqueList x) where
     mempty = UniqueList id
diff --git a/yesod-core/test/RouteSpec.hs b/yesod-core/test/RouteSpec.hs
index 283119e2..5766a4cf 100644
--- a/yesod-core/test/RouteSpec.hs
+++ b/yesod-core/test/RouteSpec.hs
@@ -30,11 +30,7 @@ data MyApp = MyApp
 data MySub = MySub
 instance RenderRoute MySub where
     data
-#if MIN_VERSION_base(4,5,0)
         Route
-#else
-        YRC.Route
-#endif
         MySub = MySubRoute ([Text], [(Text, Text)])
         deriving (Show, Eq, Read)
     renderRoute (MySubRoute x) = x
@@ -47,11 +43,7 @@ getMySub MyApp = MySub
 data MySubParam = MySubParam Int
 instance RenderRoute MySubParam where
     data
-#if MIN_VERSION_base(4,5,0)
         Route
-#else
-        YRC.Route
-#endif
         MySubParam = ParamRoute Char
         deriving (Show, Eq, Read)
     renderRoute (ParamRoute x) = ([singleton x], [])
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index c1d6f8a8..fe3165a4 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -22,7 +22,7 @@ extra-source-files:
 
 library
     build-depends:   base                  >= 4.7      && < 5
-                   , time                  >= 1.1.4
+                   , time                  >= 1.5
                    , wai                   >= 3.0
                    , wai-extra             >= 3.0.7
                    , bytestring            >= 0.10
@@ -31,7 +31,7 @@ library
                    , path-pieces           >= 0.1.2    && < 0.3
                    , shakespeare           >= 2.0
                    , blaze-builder         >= 0.2.1.4  && < 0.5
-                   , transformers          >= 0.2.2
+                   , transformers          >= 0.4
                    , mtl
                    , clientsession         >= 0.9.1    && < 0.10
                    , random                >= 1.0.0.2  && < 1.2
@@ -39,7 +39,7 @@ library
                    , old-locale            >= 1.0.0.2  && < 1.1
                    , containers            >= 0.2
                    , unordered-containers  >= 0.2
-                   , monad-control         >= 0.3      && < 1.1
+                   , monad-control         >= 1.0      && < 1.1
                    , transformers-base     >= 0.4
                    , cookie                >= 0.4.2    && < 0.5
                    , http-types            >= 0.7
@@ -47,10 +47,10 @@ library
                    , parsec                >= 2        && < 3.2
                    , directory             >= 1
                    , vector                >= 0.9      && < 0.13
-                   , aeson                 >= 0.5
+                   , aeson                 >= 1.0
                    , fast-logger           >= 2.2
                    , wai-logger            >= 0.2
-                   , monad-logger          >= 0.3.1    && < 0.4
+                   , monad-logger          >= 0.3.10   && < 0.4
                    , conduit               >= 1.2
                    , resourcet             >= 0.4.9    && < 1.2
                    , lifted-base           >= 0.1.2

From 5c8b1b542a24437b9014f87713df4dc4210d2e44 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 12 Dec 2017 12:46:35 +0200
Subject: [PATCH 04/43] WidgetT uses IORef

---
 yesod-core/ChangeLog.md                |  7 ++++
 yesod-core/Yesod/Core/Class/Handler.hs |  9 ++--
 yesod-core/Yesod/Core/Class/Yesod.hs   |  5 ++-
 yesod-core/Yesod/Core/Types.hs         | 57 +++++++++++++-------------
 yesod-core/Yesod/Core/Widget.hs        | 16 +++++---
 yesod-core/yesod-core.cabal            |  2 +-
 6 files changed, 55 insertions(+), 41 deletions(-)

diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md
index 43266e77..88a0dcb2 100644
--- a/yesod-core/ChangeLog.md
+++ b/yesod-core/ChangeLog.md
@@ -1,3 +1,10 @@
+## 1.4.38
+
+* Internal only change, users of stable API are unaffected: `WidgetT`
+  holds its data in an `IORef` so that it is isomorphic to `ReaderT`,
+  avoiding state-loss issues..
+* Instances for `MonadUnliftIO`
+
 ## 1.4.37.2
 
 * Improve error messages for the CSRF checking functions [#1455](https://github.com/yesodweb/yesod/issues/1455)
diff --git a/yesod-core/Yesod/Core/Class/Handler.hs b/yesod-core/Yesod/Core/Class/Handler.hs
index 409b867b..8e447eab 100644
--- a/yesod-core/Yesod/Core/Class/Handler.hs
+++ b/yesod-core/Yesod/Core/Class/Handler.hs
@@ -12,12 +12,11 @@ module Yesod.Core.Class.Handler
     ) where
 
 import Yesod.Core.Types
-import Control.Monad (liftM)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Resource (MonadResource, MonadResourceBase)
 import Control.Monad.Trans.Class (lift)
 #if __GLASGOW_HASKELL__ < 710
-import Data.Monoid (Monoid, mempty)
+import Data.Monoid (Monoid)
 #endif
 import Data.Conduit.Internal (Pipe, ConduitM)
 
@@ -48,8 +47,8 @@ instance MonadResourceBase m => MonadHandler (HandlerT site m) where
 
 instance MonadResourceBase m => MonadHandler (WidgetT site m) where
     type HandlerSite (WidgetT site m) = site
-    liftHandlerT (HandlerT f) = WidgetT $ liftIO . liftM (, mempty) . f . replaceToParent
-{-# RULES "liftHandlerT (WidgetT site IO)" forall f. liftHandlerT (HandlerT f) = WidgetT $ liftM (, mempty) . f #-}
+    liftHandlerT (HandlerT f) = WidgetT $ \_ref env -> liftIO $ f $ replaceToParent env
+{-# RULES "liftHandlerT (WidgetT site IO)" forall f. liftHandlerT (HandlerT f) = WidgetT $ const f #-}
 
 #define GO(T) instance MonadHandler m => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandlerT = lift . liftHandlerT
 #define GOX(X, T) instance (X, MonadHandler m) => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandlerT = lift . liftHandlerT
@@ -73,7 +72,7 @@ GO(ConduitM i o)
 class MonadHandler m => MonadWidget m where
     liftWidgetT :: WidgetT (HandlerSite m) IO a -> m a
 instance MonadResourceBase m => MonadWidget (WidgetT site m) where
-    liftWidgetT (WidgetT f) = WidgetT $ liftIO . f . replaceToParent
+    liftWidgetT (WidgetT f) = WidgetT $ \ref env -> liftIO $ f ref $ replaceToParent env
 
 #define GO(T) instance MonadWidget m => MonadWidget (T m) where liftWidgetT = lift . liftWidgetT
 #define GOX(X, T) instance (X, MonadWidget m) => MonadWidget (T m) where liftWidgetT = lift . liftWidgetT
diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs
index 385ebe7a..5e169d7e 100644
--- a/yesod-core/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/Yesod/Core/Class/Yesod.hs
@@ -59,6 +59,7 @@ import           Yesod.Core.Widget
 import Control.Monad.Trans.Class (lift)
 import Data.CaseInsensitive (CI)
 import qualified Network.Wai.Request
+import Data.IORef
 
 -- | Define settings for a Yesod applications. All methods have intelligent
 -- defaults, and therefore no implementation is required.
@@ -550,7 +551,9 @@ widgetToPageContent :: Yesod site
 widgetToPageContent w = do
     master <- getYesod
     hd <- HandlerT return
-    ((), GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head')) <- lift $ unWidgetT w hd
+    ref <- lift $ newIORef mempty
+    lift $ unWidgetT w ref hd
+    GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head') <- lift $ readIORef ref
     let title = maybe mempty unTitle mTitle
         scripts = runUniqueList scripts'
         stylesheets = runUniqueList stylesheets'
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index a1c960de..607dde01 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -29,7 +29,7 @@ import           Control.Monad.Trans.Resource       (MonadResource (..), Interna
 import           Data.ByteString                    (ByteString)
 import qualified Data.ByteString.Lazy               as L
 import           Data.Conduit                       (Flush, Source)
-import           Data.IORef                         (IORef)
+import           Data.IORef                         (IORef, modifyIORef')
 import           Data.Map                           (Map, unionWith)
 import qualified Data.Map                           as Map
 import           Data.Monoid                        (Endo (..), Last (..))
@@ -59,6 +59,7 @@ import           Yesod.Core.Internal.Util           (getTime, putTime)
 import           Control.Monad.Trans.Class          (MonadTrans (..))
 import           Yesod.Routes.Class                 (RenderRoute (..), ParseRoute (..))
 import           Control.Monad.Reader               (MonadReader (..))
+import           Data.Monoid                        ((<>))
 import Control.DeepSeq (NFData (rnf))
 import Control.DeepSeq.Generics (genericRnf)
 import Data.Conduit.Lazy (MonadActive, monadActive)
@@ -248,7 +249,7 @@ type YesodApp = YesodRequest -> ResourceT IO YesodResponse
 -- site datatypes. While this is simply a @WriterT@, we define a newtype for
 -- better error messages.
 newtype WidgetT site m a = WidgetT
-    { unWidgetT :: HandlerData site (MonadRoute m) -> m (a, GWData (Route site))
+    { unWidgetT :: IORef (GWData (Route site)) -> HandlerData site (MonadRoute m) -> m a
     }
 
 instance (a ~ (), Monad m) => Monoid (WidgetT site m a) where
@@ -261,10 +262,12 @@ instance (a ~ (), Monad m) => Semigroup (WidgetT site m a)
 -- For example, in a yesod-scaffold site you could use:
 --
 -- @getHomeR = do defaultLayout "Widget text"@
-instance (Monad m, a ~ ()) => IsString (WidgetT site m a) where
+instance (MonadIO m, a ~ ()) => IsString (WidgetT site m a) where -- FIXME turn it into WidgetFor?
     fromString = toWidget . toHtml . T.pack
-      where toWidget x = WidgetT $ const $ return ((), GWData (Body (const x))
-                         mempty mempty mempty mempty mempty mempty)
+      where toWidget x = tellWidget mempty { gwdBody = Body (const x) }
+
+tellWidget :: MonadIO m => GWData (Route site) -> WidgetT site m ()
+tellWidget d = WidgetT $ \ref _ -> liftIO $ modifyIORef' ref (<> d)
 
 type RY master = Route master -> [(Text, Text)] -> Text
 
@@ -407,32 +410,30 @@ instance Monad m => Applicative (WidgetT site m) where
     pure = return
     (<*>) = ap
 instance Monad m => Monad (WidgetT site m) where
-    return a = WidgetT $ const $ return (a, mempty)
-    WidgetT x >>= f = WidgetT $ \r -> do
-        (a, wa) <- x r
-        (b, wb) <- unWidgetT (f a) r
-        return (b, wa `mappend` wb)
+    return a = WidgetT $ \_ _ -> return a
+    WidgetT x >>= f = WidgetT $ \ref r -> do
+        a <- x ref r
+        unWidgetT (f a) ref r
 instance MonadIO m => MonadIO (WidgetT site m) where
     liftIO = lift . liftIO
 instance MonadBase b m => MonadBase b (WidgetT site m) where
-    liftBase = WidgetT . const . liftBase . fmap (, mempty)
+    liftBase = WidgetT . const . const . liftBase
 instance MonadBaseControl b m => MonadBaseControl b (WidgetT site m) where
-    type StM (WidgetT site m) a = StM m (a, GWData (Route site))
-    liftBaseWith f = WidgetT $ \reader' ->
+    type StM (WidgetT site m) a = StM m a
+    liftBaseWith f = WidgetT $ \ref reader' ->
         liftBaseWith $ \runInBase ->
-            fmap (\x -> (x, mempty))
-            (f $ runInBase . flip unWidgetT reader')
-    restoreM = WidgetT . const . restoreM
+            f $ runInBase . (\(WidgetT w) -> w ref reader')
+    restoreM = WidgetT . const . const . restoreM
 instance Monad m => MonadReader site (WidgetT site m) where
-    ask = WidgetT $ \hd -> return (rheSite $ handlerEnv hd, mempty)
-    local f (WidgetT g) = WidgetT $ \hd -> g hd
+    ask = WidgetT $ \_ hd -> return (rheSite $ handlerEnv hd)
+    local f (WidgetT g) = WidgetT $ \ref hd -> g ref hd
         { handlerEnv = (handlerEnv hd)
             { rheSite = f $ rheSite $ handlerEnv hd
             }
         }
 
 instance MonadTrans (WidgetT site) where
-    lift = WidgetT . const . liftM (, mempty)
+    lift = WidgetT . const . const
 instance MonadThrow m => MonadThrow (WidgetT site m) where
     throwM = lift . throwM
 
@@ -445,13 +446,13 @@ instance MonadMask m => MonadMask (HandlerT site m) where
     HandlerT $ \e -> uninterruptibleMask $ \u -> unHandlerT (a $ q u) e
       where q u (HandlerT b) = HandlerT (u . b)
 instance MonadCatch m => MonadCatch (WidgetT site m) where
-  catch (WidgetT m) c = WidgetT $ \r -> m r `catch` \e -> unWidgetT (c e) r
+  catch (WidgetT m) c = WidgetT $ \ref r -> m ref r `catch` \e -> unWidgetT (c e) ref r
 instance MonadMask m => MonadMask (WidgetT site m) where
-  mask a = WidgetT $ \e -> mask $ \u -> unWidgetT (a $ q u) e
-    where q u (WidgetT b) = WidgetT (u . b)
+  mask a = WidgetT $ \ref e -> mask $ \u -> unWidgetT (a $ q u) ref e
+    where q u (WidgetT b) = WidgetT (\ref e -> u $ b ref e)
   uninterruptibleMask a =
-    WidgetT $ \e -> uninterruptibleMask $ \u -> unWidgetT (a $ q u) e
-      where q u (WidgetT b) = WidgetT (u . b)
+    WidgetT $ \ref e -> uninterruptibleMask $ \u -> unWidgetT (a $ q u) ref e
+      where q u (WidgetT b) = WidgetT (\ref e -> u $ b ref e)
 
 -- CPP to avoid a redundant constraints warning
 #if MIN_VERSION_base(4,9,0)
@@ -459,14 +460,14 @@ instance (MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (WidgetT sit
 #else
 instance (Applicative m, MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (WidgetT site m) where
 #endif
-    liftResourceT f = WidgetT $ \hd -> liftIO $ (, mempty) <$> runInternalState f (handlerResource hd)
+    liftResourceT f = WidgetT $ \_ hd -> liftIO $ runInternalState f (handlerResource hd)
 
 instance MonadIO m => MonadLogger (WidgetT site m) where
-    monadLoggerLog a b c d = WidgetT $ \hd ->
-        liftIO $ (, mempty) <$> rheLog (handlerEnv hd) a b c (toLogStr d)
+    monadLoggerLog a b c d = WidgetT $ \_ hd ->
+        liftIO $ rheLog (handlerEnv hd) a b c (toLogStr d)
 
 instance MonadIO m => MonadLoggerIO (WidgetT site m) where
-    askLoggerIO = WidgetT $ \hd -> return (rheLog (handlerEnv hd), mempty)
+    askLoggerIO = WidgetT $ \_ hd -> return $ rheLog $ handlerEnv hd
 
 instance MonadActive m => MonadActive (WidgetT site m) where
     monadActive = lift monadActive
diff --git a/yesod-core/Yesod/Core/Widget.hs b/yesod-core/Yesod/Core/Widget.hs
index 4f4a119a..f9e1eeb3 100644
--- a/yesod-core/Yesod/Core/Widget.hs
+++ b/yesod-core/Yesod/Core/Widget.hs
@@ -60,7 +60,6 @@ import Yesod.Core.Handler (getMessageRender, getUrlRenderParams)
 #if __GLASGOW_HASKELL__ < 710
 import Control.Applicative ((<$>))
 #endif
-import Control.Monad (liftM)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Text.Shakespeare.I18N (RenderMessage)
 import Data.Text (Text)
@@ -73,6 +72,7 @@ import Data.Text.Lazy.Builder (fromLazyText)
 import Text.Blaze.Html (toHtml, preEscapedToMarkup)
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Builder as TB
+import Data.IORef
 
 import Yesod.Core.Types
 import Yesod.Core.Class.Handler
@@ -268,20 +268,24 @@ ihamletToHtml ih = do
     return $ ih (toHtml . mrender) urender
 
 tell :: MonadWidget m => GWData (Route (HandlerSite m)) -> m ()
-tell w = liftWidgetT $ WidgetT $ const $ return ((), w)
+tell = liftWidgetT . tellWidget
 
 toUnique :: x -> UniqueList x
 toUnique = UniqueList . (:)
 
 handlerToWidget :: Monad m => HandlerT site m a -> WidgetT site m a
-handlerToWidget (HandlerT f) = WidgetT $ liftM (, mempty) . f
+handlerToWidget (HandlerT f) = WidgetT $ const f
 
 widgetToParentWidget :: MonadIO m
                      => WidgetT child IO a
                      -> HandlerT child (HandlerT parent m) (WidgetT parent m a)
-widgetToParentWidget (WidgetT f) = HandlerT $ \hd -> do
-    (a, gwd) <- liftIO $ f hd { handlerToParent = const () }
-    return $ WidgetT $ const $ return (a, liftGWD (handlerToParent hd) gwd)
+widgetToParentWidget (WidgetT f) = HandlerT $ \hdChild -> do
+    return $ WidgetT $ \ref _hdParent -> liftIO $ do
+      tmp <- newIORef mempty
+      a <- f tmp hdChild { handlerToParent = const () }
+      gwd <- readIORef tmp
+      modifyIORef' ref (<> liftGWD (handlerToParent hdChild) gwd)
+      return a
 
 liftGWD :: (child -> parent) -> GWData child -> GWData parent
 liftGWD tp gwd = GWData
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index fe3165a4..3dc85c18 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         1.4.37.2
+version:         1.4.38
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>

From 1c2914eded9fee8674e3ad2402cf42f4da8025ef Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 12 Dec 2017 12:46:49 +0200
Subject: [PATCH 05/43] MonadUnliftIO instances

---
 stack.yaml                     |  2 ++
 yesod-core/Yesod/Core/Types.hs | 13 +++++++++++++
 yesod-core/yesod-core.cabal    |  1 +
 3 files changed, 16 insertions(+)

diff --git a/stack.yaml b/stack.yaml
index 213e9db3..b53c2b2e 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -13,3 +13,5 @@ packages:
   - ./yesod
   - ./yesod-eventsource
   - ./yesod-websockets
+extra-deps:
+- unliftio-core-0.1.0.0
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index 607dde01..fd4572de 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -66,6 +66,7 @@ import Data.Conduit.Lazy (MonadActive, monadActive)
 import Yesod.Core.TypeCache (TypeMap, KeyedTypeMap)
 import Control.Monad.Logger (MonadLoggerIO (..))
 import Data.Semigroup (Semigroup)
+import Control.Monad.IO.Unlift (MonadUnliftIO (..), UnliftIO (..), withUnliftIO)
 
 -- Sessions
 type SessionMap = Map Text ByteString
@@ -424,6 +425,12 @@ instance MonadBaseControl b m => MonadBaseControl b (WidgetT site m) where
         liftBaseWith $ \runInBase ->
             f $ runInBase . (\(WidgetT w) -> w ref reader')
     restoreM = WidgetT . const . const . restoreM
+-- | @since 1.4.38
+instance MonadUnliftIO m => MonadUnliftIO (WidgetT site m) where
+  {-# INLINE askUnliftIO #-}
+  askUnliftIO = WidgetT $ \ref r ->
+                withUnliftIO $ \u ->
+                return (UnliftIO (\(WidgetT w) -> unliftIO u $ w ref r))
 instance Monad m => MonadReader site (WidgetT site m) where
     ask = WidgetT $ \_ hd -> return (rheSite $ handlerEnv hd)
     local f (WidgetT g) = WidgetT $ \ref hd -> g ref hd
@@ -511,6 +518,12 @@ instance MonadBaseControl b m => MonadBaseControl b (HandlerT site m) where
         liftBaseWith $ \runInBase ->
             f $ runInBase . (\(HandlerT r) -> r reader')
     restoreM = HandlerT . const . restoreM
+-- | @since 1.4.38
+instance MonadUnliftIO m => MonadUnliftIO (HandlerT site m) where
+  {-# INLINE askUnliftIO #-}
+  askUnliftIO = HandlerT $ \r ->
+                withUnliftIO $ \u ->
+                return (UnliftIO (unliftIO u . flip unHandlerT r))
 
 instance MonadThrow m => MonadThrow (HandlerT site m) where
     throwM = lift . monadThrow
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index 3dc85c18..84ae5ab0 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -70,6 +70,7 @@ library
                    , auto-update
                    , semigroups
                    , byteable
+                   , unliftio-core
 
     exposed-modules: Yesod.Core
                      Yesod.Core.Content

From 47ee7384ea123135d090c4e931657cb11c583b94 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 13 Dec 2017 09:53:14 +0200
Subject: [PATCH 06/43] Be gone with ye HandlerT!

---
 yesod-core/ChangeLog.md                       |   4 +
 yesod-core/Yesod/Core.hs                      |  14 +-
 yesod-core/Yesod/Core/Class/Breadcrumbs.hs    |   4 +-
 yesod-core/Yesod/Core/Class/Dispatch.hs       |  77 ++++--
 yesod-core/Yesod/Core/Class/Handler.hs        |  48 ++--
 yesod-core/Yesod/Core/Class/Yesod.hs          |  64 ++---
 yesod-core/Yesod/Core/Dispatch.hs             |   1 -
 yesod-core/Yesod/Core/Handler.hs              |  57 ++---
 yesod-core/Yesod/Core/Internal/LiteApp.hs     |   4 +-
 yesod-core/Yesod/Core/Internal/Run.hs         |  11 +-
 yesod-core/Yesod/Core/Internal/TH.hs          |   9 +-
 yesod-core/Yesod/Core/Json.hs                 |  10 +-
 yesod-core/Yesod/Core/Types.hs                | 226 ++++++++----------
 yesod-core/Yesod/Core/Unsafe.hs               |   5 +-
 yesod-core/Yesod/Core/Widget.hs               |  56 +----
 .../test/YesodCoreTest/NoOverloadedStrings.hs |  15 +-
 .../YesodCoreTest/NoOverloadedStringsSub.hs   |   4 +-
 17 files changed, 290 insertions(+), 319 deletions(-)

diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md
index 88a0dcb2..521e68fc 100644
--- a/yesod-core/ChangeLog.md
+++ b/yesod-core/ChangeLog.md
@@ -1,3 +1,7 @@
+## 1.5.0
+
+* Overhaul of `HandlerT`/`WidgetT` to no longer be transformers.
+
 ## 1.4.38
 
 * Internal only change, users of stable API are unaffected: `WidgetT`
diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs
index 1d5de1d1..d13d5cf4 100644
--- a/yesod-core/Yesod/Core.hs
+++ b/yesod-core/Yesod/Core.hs
@@ -67,15 +67,15 @@ module Yesod.Core
     -- * JS loaders
     , ScriptLoadPosition (..)
     , BottomOfHeadAsync
-      -- * Subsites
+    -- * Generalizing type classes
     , MonadHandler (..)
     , MonadWidget (..)
-    , getRouteToParent
-    , defaultLayoutSub
       -- * Approot
     , guessApproot
     , guessApprootOr
     , getApprootText
+      -- * Subsites
+    , MonadSubHandler (..)
       -- * Misc
     , yesodVersion
     , yesodRender
@@ -185,14 +185,6 @@ maybeAuthorized r isWrite = do
     x <- isAuthorized r isWrite
     return $ if x == Authorized then Just r else Nothing
 
-getRouteToParent :: Monad m => HandlerT child (HandlerT parent m) (Route child -> Route parent)
-getRouteToParent = HandlerT $ return . handlerToParent
-
-defaultLayoutSub :: Yesod parent
-                 => WidgetT child IO ()
-                 -> HandlerT child (HandlerT parent IO) Html
-defaultLayoutSub cwidget = widgetToParentWidget cwidget >>= lift . defaultLayout
-
 showIntegral :: Integral a => a -> String
 showIntegral x = show (fromIntegral x :: Integer)
 
diff --git a/yesod-core/Yesod/Core/Class/Breadcrumbs.hs b/yesod-core/Yesod/Core/Class/Breadcrumbs.hs
index 84586055..1e956ff2 100644
--- a/yesod-core/Yesod/Core/Class/Breadcrumbs.hs
+++ b/yesod-core/Yesod/Core/Class/Breadcrumbs.hs
@@ -11,11 +11,11 @@ import Data.Text (Text)
 class YesodBreadcrumbs site where
     -- | Returns the title and the parent resource, if available. If you return
     -- a 'Nothing', then this is considered a top-level page.
-    breadcrumb :: Route site -> HandlerT site IO (Text , Maybe (Route site))
+    breadcrumb :: Route site -> HandlerFor site (Text , Maybe (Route site))
 
 -- | Gets the title of the current page and the hierarchy of parent pages,
 -- along with their respective titles.
-breadcrumbs :: YesodBreadcrumbs site => HandlerT site IO (Text, [(Route site, Text)])
+breadcrumbs :: YesodBreadcrumbs site => HandlerFor site (Text, [(Route site, Text)])
 breadcrumbs = do
     x <- getCurrentRoute
     case x of
diff --git a/yesod-core/Yesod/Core/Class/Dispatch.hs b/yesod-core/Yesod/Core/Class/Dispatch.hs
index b68340ea..16910ecf 100644
--- a/yesod-core/Yesod/Core/Class/Dispatch.hs
+++ b/yesod-core/Yesod/Core/Class/Dispatch.hs
@@ -6,13 +6,13 @@
 {-# LANGUAGE FlexibleContexts  #-}
 module Yesod.Core.Class.Dispatch where
 
-import Yesod.Routes.Class
 import qualified Network.Wai as W
 import Yesod.Core.Types
-import Yesod.Core.Content
-import Yesod.Core.Handler (sendWaiApplication, stripHandlerT)
-import Yesod.Core.Class.Yesod
+import Yesod.Core.Content (ToTypedContent (..))
+import Yesod.Core.Handler (sendWaiApplication, getYesod, getCurrentRoute)
 import Yesod.Core.Class.Handler
+import Yesod.Core.Class.Yesod
+import Control.Monad.Trans.Reader (ReaderT (..), ask)
 
 -- | This class is automatically instantiated when you use the template haskell
 -- mkYesod function. You should never need to deal with it directly.
@@ -28,24 +28,63 @@ instance YesodSubDispatch WaiSubsite master where
       where
         WaiSubsite app = ysreGetSub $ yreSite ysreParentEnv
 
-instance YesodSubDispatch WaiSubsiteWithAuth (HandlerT master IO) where
+instance MonadHandler m => YesodSubDispatch WaiSubsiteWithAuth m where
   yesodSubDispatch YesodSubRunnerEnv {..} req =
-      ysreParentRunner base ysreParentEnv (fmap ysreToParentRoute route) req
+      ysreParentRunner handlert ysreParentEnv (fmap ysreToParentRoute route) req
     where
-      base  = stripHandlerT handlert ysreGetSub ysreToParentRoute route
       route = Just $ WaiSubsiteWithAuthRoute (W.pathInfo req) []
       WaiSubsiteWithAuth set = ysreGetSub $ yreSite $ ysreParentEnv
-      handlert = sendWaiApplication $ set
+      handlert = sendWaiApplication set
 
--- | A helper function for creating YesodSubDispatch instances, used by the
--- internal generated code. This function has been exported since 1.4.11.
--- It promotes a subsite handler to a wai application.
-subHelper :: Monad m -- NOTE: This is incredibly similar in type signature to yesodRunner, should probably be pointed out/explained.
-          => HandlerT child (HandlerT parent m) TypedContent
-          -> YesodSubRunnerEnv child parent (HandlerT parent m)
-          -> Maybe (Route child)
-          -> W.Application
-subHelper handlert YesodSubRunnerEnv {..} route =
-    ysreParentRunner base ysreParentEnv (fmap ysreToParentRoute route)
+type SubHandler child parent a = ReaderT (SubsiteData child parent) (HandlerFor parent) a
+
+data SubsiteData child parent = SubsiteData
+  { sdToParentRoute :: !(Route child -> Route parent)
+  , sdCurrentRoute :: !(Maybe (Route child))
+  , sdSubsiteData :: !child
+  }
+
+class MonadHandler m => MonadSubHandler m where
+  type SubHandlerSite m
+
+  getSubYesod :: m (SubHandlerSite m)
+  getToParentRoute :: m (Route (SubHandlerSite m) -> Route (HandlerSite m))
+  getSubCurrentRoute :: m (Maybe (Route (SubHandlerSite m)))
+
+instance MonadSubHandler (HandlerFor site) where
+  type SubHandlerSite (HandlerFor site) = site
+
+  getSubYesod = getYesod
+  getToParentRoute = return id
+  getSubCurrentRoute = getCurrentRoute
+
+instance MonadSubHandler (WidgetFor site) where
+  type SubHandlerSite (WidgetFor site) = site
+
+  getSubYesod = getYesod
+  getToParentRoute = return id
+  getSubCurrentRoute = getCurrentRoute
+
+instance (MonadSubHandler m, parent ~ SubHandlerSite m) => MonadSubHandler (ReaderT (SubsiteData child parent) m) where
+  type SubHandlerSite (ReaderT (SubsiteData child parent) m) = child
+
+  getSubYesod = fmap sdSubsiteData ask
+  getSubCurrentRoute = fmap sdCurrentRoute ask
+  getToParentRoute = ReaderT $ \sd -> do
+    toParent' <- getToParentRoute
+    return $ toParent' . sdToParentRoute sd
+
+subHelper
+  :: (ToTypedContent content, MonadSubHandler m, parent ~ HandlerSite m)
+  => ReaderT (SubsiteData child parent) m content
+  -> YesodSubRunnerEnv child parent m
+  -> Maybe (Route child)
+  -> W.Application
+subHelper (ReaderT f) YesodSubRunnerEnv {..} mroute =
+    ysreParentRunner handler ysreParentEnv (fmap ysreToParentRoute mroute)
   where
-    base = stripHandlerT (fmap toTypedContent handlert) ysreGetSub ysreToParentRoute route
+    handler = fmap toTypedContent $ f SubsiteData
+      { sdToParentRoute = ysreToParentRoute
+      , sdCurrentRoute = mroute
+      , sdSubsiteData = ysreGetSub $ yreSite ysreParentEnv
+      }
diff --git a/yesod-core/Yesod/Core/Class/Handler.hs b/yesod-core/Yesod/Core/Class/Handler.hs
index 8e447eab..7373d261 100644
--- a/yesod-core/Yesod/Core/Class/Handler.hs
+++ b/yesod-core/Yesod/Core/Class/Handler.hs
@@ -9,11 +9,12 @@
 module Yesod.Core.Class.Handler
     ( MonadHandler (..)
     , MonadWidget (..)
+    , liftHandlerT
+    , liftWidgetT
     ) where
 
 import Yesod.Core.Types
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Resource (MonadResource, MonadResourceBase)
+import Control.Monad.Trans.Resource (MonadResource)
 import Control.Monad.Trans.Class (lift)
 #if __GLASGOW_HASKELL__ < 710
 import Data.Monoid (Monoid)
@@ -33,25 +34,27 @@ import qualified Control.Monad.Trans.RWS.Strict    as Strict ( RWST   )
 import qualified Control.Monad.Trans.State.Strict  as Strict ( StateT )
 import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )
 
+-- FIXME should we just use MonadReader instances instead?
 class MonadResource m => MonadHandler m where
     type HandlerSite m
-    liftHandlerT :: HandlerT (HandlerSite m) IO a -> m a
+    liftHandler :: HandlerFor (HandlerSite m) a -> m a
 
-replaceToParent :: HandlerData site route -> HandlerData site ()
-replaceToParent hd = hd { handlerToParent = const () }
+liftHandlerT :: MonadHandler m => HandlerFor (HandlerSite m) a -> m a
+liftHandlerT = liftHandler
+{-# DEPRECATED liftHandlerT "Use liftHandler instead" #-}
 
-instance MonadResourceBase m => MonadHandler (HandlerT site m) where
-    type HandlerSite (HandlerT site m) = site
-    liftHandlerT (HandlerT f) = HandlerT $ liftIO . f . replaceToParent
-{-# RULES "liftHandlerT (HandlerT site IO)" liftHandlerT = id #-}
+instance MonadHandler (HandlerFor site) where
+    type HandlerSite (HandlerFor site) = site
+    liftHandler = id
+    {-# INLINE liftHandler #-}
 
-instance MonadResourceBase m => MonadHandler (WidgetT site m) where
-    type HandlerSite (WidgetT site m) = site
-    liftHandlerT (HandlerT f) = WidgetT $ \_ref env -> liftIO $ f $ replaceToParent env
-{-# RULES "liftHandlerT (WidgetT site IO)" forall f. liftHandlerT (HandlerT f) = WidgetT $ const f #-}
+instance MonadHandler (WidgetFor site) where
+    type HandlerSite (WidgetFor site) = site
+    liftHandler (HandlerFor f) = WidgetFor $ f . wdHandler
+    {-# INLINE liftHandler #-}
 
-#define GO(T) instance MonadHandler m => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandlerT = lift . liftHandlerT
-#define GOX(X, T) instance (X, MonadHandler m) => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandlerT = lift . liftHandlerT
+#define GO(T) instance MonadHandler m => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandler = lift . liftHandler
+#define GOX(X, T) instance (X, MonadHandler m) => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandler = lift . liftHandler
 GO(IdentityT)
 GO(ListT)
 GO(MaybeT)
@@ -70,12 +73,17 @@ GO(ConduitM i o)
 #undef GOX
 
 class MonadHandler m => MonadWidget m where
-    liftWidgetT :: WidgetT (HandlerSite m) IO a -> m a
-instance MonadResourceBase m => MonadWidget (WidgetT site m) where
-    liftWidgetT (WidgetT f) = WidgetT $ \ref env -> liftIO $ f ref $ replaceToParent env
+    liftWidget :: WidgetFor (HandlerSite m) a -> m a
+instance MonadWidget (WidgetFor site) where
+    liftWidget = id
+    {-# INLINE liftWidget #-}
 
-#define GO(T) instance MonadWidget m => MonadWidget (T m) where liftWidgetT = lift . liftWidgetT
-#define GOX(X, T) instance (X, MonadWidget m) => MonadWidget (T m) where liftWidgetT = lift . liftWidgetT
+liftWidgetT :: MonadWidget m => WidgetFor (HandlerSite m) a -> m a
+liftWidgetT = liftWidget
+{-# DEPRECATED liftWidgetT "Use liftWidget instead" #-}
+
+#define GO(T) instance MonadWidget m => MonadWidget (T m) where liftWidget = lift . liftWidget
+#define GOX(X, T) instance (X, MonadWidget m) => MonadWidget (T m) where liftWidget = lift . liftWidget
 GO(IdentityT)
 GO(ListT)
 GO(MaybeT)
diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs
index 5e169d7e..eafd1b34 100644
--- a/yesod-core/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/Yesod/Core/Class/Yesod.hs
@@ -56,7 +56,6 @@ import           Web.Cookie                         (SetCookie (..), parseCookie
 import           Yesod.Core.Types
 import           Yesod.Core.Internal.Session
 import           Yesod.Core.Widget
-import Control.Monad.Trans.Class (lift)
 import Data.CaseInsensitive (CI)
 import qualified Network.Wai.Request
 import Data.IORef
@@ -83,11 +82,11 @@ class RenderRoute site => Yesod site where
     -- | Output error response pages.
     --
     -- Default value: 'defaultErrorHandler'.
-    errorHandler :: ErrorResponse -> HandlerT site IO TypedContent
+    errorHandler :: ErrorResponse -> HandlerFor site TypedContent
     errorHandler = defaultErrorHandler
 
     -- | Applies some form of layout to the contents of a page.
-    defaultLayout :: WidgetT site IO () -> HandlerT site IO Html
+    defaultLayout :: WidgetFor site () -> HandlerFor site Html
     defaultLayout w = do
         p <- widgetToPageContent w
         msgs <- getMessages
@@ -139,7 +138,7 @@ class RenderRoute site => Yesod site where
     -- If authentication is required, return 'AuthenticationRequired'.
     isAuthorized :: Route site
                  -> Bool -- ^ is this a write request?
-                 -> HandlerT site IO AuthResult
+                 -> HandlerFor site AuthResult
     isAuthorized _ _ = return Authorized
 
     -- | Determines whether the current request is a write request. By default,
@@ -149,7 +148,7 @@ class RenderRoute site => Yesod site where
     --
     -- This function is used to determine if a request is authorized; see
     -- 'isAuthorized'.
-    isWriteRequest :: Route site -> HandlerT site IO Bool
+    isWriteRequest :: Route site -> HandlerFor site Bool
     isWriteRequest _ = do
         wai <- waiRequest
         return $ W.requestMethod wai `notElem`
@@ -215,7 +214,7 @@ class RenderRoute site => Yesod site where
     addStaticContent :: Text -- ^ filename extension
                      -> Text -- ^ mime-type
                      -> L.ByteString -- ^ content
-                     -> HandlerT site IO (Maybe (Either Text (Route site, [(Text, Text)])))
+                     -> HandlerFor site (Maybe (Either Text (Route site, [(Text, Text)])))
     addStaticContent _ _ _ = return Nothing
 
     -- | Maximum allowed length of the request body, in bytes.
@@ -304,7 +303,7 @@ class RenderRoute site => Yesod site where
     -- Default: the 'defaultYesodMiddleware' function.
     --
     -- Since: 1.1.6
-    yesodMiddleware :: ToTypedContent res => HandlerT site IO res -> HandlerT site IO res
+    yesodMiddleware :: ToTypedContent res => HandlerFor site res -> HandlerFor site res
     yesodMiddleware = defaultYesodMiddleware
 
     -- | How to allocate an @InternalState@ for each request.
@@ -325,7 +324,7 @@ class RenderRoute site => Yesod site where
     -- primarily for wrapping up error messages for better display.
     --
     -- @since 1.4.30
-    defaultMessageWidget :: Html -> HtmlUrl (Route site) -> WidgetT site IO ()
+    defaultMessageWidget :: Html -> HtmlUrl (Route site) -> WidgetFor site ()
     defaultMessageWidget title body = do
         setTitle title
         toWidget
@@ -384,7 +383,7 @@ defaultShouldLogIO a b = return $ defaultShouldLog a b
 -- \"Vary: Accept, Accept-Language\" and performs authorization checks.
 --
 -- Since 1.2.0
-defaultYesodMiddleware :: Yesod site => HandlerT site IO res -> HandlerT site IO res
+defaultYesodMiddleware :: Yesod site => HandlerFor site res -> HandlerFor site res
 defaultYesodMiddleware handler = do
     addHeader "Vary" "Accept, Accept-Language"
     authorizationCheck
@@ -444,8 +443,8 @@ sameSiteSession s = (fmap . fmap) secureSessionCookies
 --
 -- Since 1.4.7
 sslOnlyMiddleware :: Int -- ^ minutes
-                  -> HandlerT site IO res
-                  -> HandlerT site IO res
+                  -> HandlerFor site res
+                  -> HandlerFor site res
 sslOnlyMiddleware timeout handler = do
     addHeader "Strict-Transport-Security"
               $ T.pack $ concat [ "max-age="
@@ -458,7 +457,7 @@ sslOnlyMiddleware timeout handler = do
 -- 'isWriteRequest'.
 --
 -- Since 1.2.0
-authorizationCheck :: Yesod site => HandlerT site IO ()
+authorizationCheck :: Yesod site => HandlerFor site ()
 authorizationCheck = getCurrentRoute >>= maybe (return ()) checkUrl
   where
     checkUrl url = do
@@ -482,7 +481,7 @@ authorizationCheck = getCurrentRoute >>= maybe (return ()) checkUrl
 -- | Calls 'csrfCheckMiddleware' with 'isWriteRequest', 'defaultCsrfHeaderName', and 'defaultCsrfParamName' as parameters.
 --
 -- Since 1.4.14
-defaultCsrfCheckMiddleware :: Yesod site => HandlerT site IO res -> HandlerT site IO res
+defaultCsrfCheckMiddleware :: Yesod site => HandlerFor site res -> HandlerFor site res
 defaultCsrfCheckMiddleware handler =
     csrfCheckMiddleware
         handler
@@ -496,11 +495,11 @@ defaultCsrfCheckMiddleware handler =
 -- For details, see the "AJAX CSRF protection" section of "Yesod.Core.Handler".
 --
 -- Since 1.4.14
-csrfCheckMiddleware :: HandlerT site IO res
-                    -> HandlerT site IO Bool -- ^ Whether or not to perform the CSRF check.
+csrfCheckMiddleware :: HandlerFor site res
+                    -> HandlerFor site Bool -- ^ Whether or not to perform the CSRF check.
                     -> CI S8.ByteString -- ^ The header name to lookup the CSRF token from.
                     -> Text -- ^ The POST parameter name to lookup the CSRF token from.
-                    -> HandlerT site IO res
+                    -> HandlerFor site res
 csrfCheckMiddleware handler shouldCheckFn headerName paramName = do
     shouldCheck <- shouldCheckFn
     when shouldCheck (checkCsrfHeaderOrParam headerName paramName)
@@ -511,7 +510,7 @@ csrfCheckMiddleware handler shouldCheckFn headerName paramName = do
 -- The cookie's path is set to @/@, making it valid for your whole website.
 --
 -- Since 1.4.14
-defaultCsrfSetCookieMiddleware :: HandlerT site IO res -> HandlerT site IO res
+defaultCsrfSetCookieMiddleware :: HandlerFor site res -> HandlerFor site res
 defaultCsrfSetCookieMiddleware handler = setCsrfCookie >> handler
 
 -- | Takes a 'SetCookie' and overrides its value with a CSRF token, then sets the cookie. See 'setCsrfCookieWithCookie'.
@@ -521,7 +520,7 @@ defaultCsrfSetCookieMiddleware handler = setCsrfCookie >> handler
 -- Make sure to set the 'setCookiePath' to the root path of your application, otherwise you'll generate a new CSRF token for every path of your app. If your app is run from from e.g. www.example.com\/app1, use @app1@. The vast majority of sites will just use @/@.
 --
 -- Since 1.4.14
-csrfSetCookieMiddleware :: HandlerT site IO res -> SetCookie -> HandlerT site IO res
+csrfSetCookieMiddleware :: HandlerFor site res -> SetCookie -> HandlerFor site res
 csrfSetCookieMiddleware handler cookie = setCsrfCookieWithCookie cookie >> handler
 
 -- | Calls 'defaultCsrfSetCookieMiddleware' and 'defaultCsrfCheckMiddleware'.
@@ -541,23 +540,26 @@ csrfSetCookieMiddleware handler cookie = setCsrfCookieWithCookie cookie >> handl
 -- @
 --
 -- Since 1.4.14
-defaultCsrfMiddleware :: Yesod site => HandlerT site IO res -> HandlerT site IO res
+defaultCsrfMiddleware :: Yesod site => HandlerFor site res -> HandlerFor site res
 defaultCsrfMiddleware = defaultCsrfSetCookieMiddleware . defaultCsrfCheckMiddleware
 
 -- | Convert a widget to a 'PageContent'.
 widgetToPageContent :: Yesod site
-                    => WidgetT site IO ()
-                    -> HandlerT site IO (PageContent (Route site))
-widgetToPageContent w = do
-    master <- getYesod
-    hd <- HandlerT return
-    ref <- lift $ newIORef mempty
-    lift $ unWidgetT w ref hd
-    GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head') <- lift $ readIORef ref
-    let title = maybe mempty unTitle mTitle
-        scripts = runUniqueList scripts'
-        stylesheets = runUniqueList stylesheets'
+                    => WidgetFor site ()
+                    -> HandlerFor site (PageContent (Route site))
+widgetToPageContent w = HandlerFor $ \hd -> do
+  master <- unHandlerFor getYesod hd
+  ref <- newIORef mempty
+  unWidgetFor w WidgetData
+    { wdRef = ref
+    , wdHandler = hd
+    }
+  GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head') <- readIORef ref
+  let title = maybe mempty unTitle mTitle
+      scripts = runUniqueList scripts'
+      stylesheets = runUniqueList stylesheets'
 
+  flip unHandlerFor hd $ do
     render <- getUrlRenderParams
     let renderLoc x =
             case x of
@@ -645,7 +647,7 @@ widgetToPageContent w = do
     runUniqueList (UniqueList x) = nub $ x []
 
 -- | The default error handler for 'errorHandler'.
-defaultErrorHandler :: Yesod site => ErrorResponse -> HandlerT site IO TypedContent
+defaultErrorHandler :: Yesod site => ErrorResponse -> HandlerFor site TypedContent
 defaultErrorHandler NotFound = selectRep $ do
     provideRep $ defaultLayout $ do
         r <- waiRequest
diff --git a/yesod-core/Yesod/Core/Dispatch.hs b/yesod-core/Yesod/Core/Dispatch.hs
index d13a154d..bd3c41c6 100644
--- a/yesod-core/Yesod/Core/Dispatch.hs
+++ b/yesod-core/Yesod/Core/Dispatch.hs
@@ -35,7 +35,6 @@ module Yesod.Core.Dispatch
       -- * WAI subsites
     , WaiSubsite (..)
     , WaiSubsiteWithAuth (..)
-    , subHelper
     ) where
 
 import Prelude hiding (exp)
diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs
index bfd254d0..f8cd1666 100644
--- a/yesod-core/Yesod/Core/Handler.hs
+++ b/yesod-core/Yesod/Core/Handler.hs
@@ -27,6 +27,7 @@
 module Yesod.Core.Handler
     ( -- * Handler monad
       HandlerT
+    , HandlerFor
       -- ** Read information from handler
     , getYesod
     , getsYesod
@@ -161,7 +162,6 @@ module Yesod.Core.Handler
       -- * Per-request caching
     , cached
     , cachedBy
-    , stripHandlerT
       -- * AJAX CSRF protection
 
       -- $ajaxCSRFOverview
@@ -254,14 +254,17 @@ import qualified Data.Foldable as Fold
 import           Data.Default
 import           Control.Monad.Logger (MonadLogger, logWarnS)
 
+type HandlerT site (m :: * -> *) = HandlerFor site
+{-# DEPRECATED HandlerT "Use HandlerFor directly" #-}
+
 get :: MonadHandler m => m GHState
-get = liftHandlerT $ HandlerT $ I.readIORef . handlerState
+get = liftHandler $ HandlerFor $ I.readIORef . handlerState
 
 put :: MonadHandler m => GHState -> m ()
-put x = liftHandlerT $ HandlerT $ flip I.writeIORef x . handlerState
+put x = liftHandler $ HandlerFor $ flip I.writeIORef x . handlerState
 
 modify :: MonadHandler m => (GHState -> GHState) -> m ()
-modify f = liftHandlerT $ HandlerT $ flip I.modifyIORef f . handlerState
+modify f = liftHandler $ HandlerFor $ flip I.modifyIORef f . handlerState
 
 tell :: MonadHandler m => Endo [Header] -> m ()
 tell hs = modify $ \g -> g { ghsHeaders = ghsHeaders g `mappend` hs }
@@ -273,14 +276,14 @@ hcError :: MonadHandler m => ErrorResponse -> m a
 hcError = handlerError . HCError
 
 getRequest :: MonadHandler m => m YesodRequest
-getRequest = liftHandlerT $ HandlerT $ return . handlerRequest
+getRequest = liftHandler $ HandlerFor $ return . handlerRequest
 
 runRequestBody :: MonadHandler m => m RequestBodyContents
 runRequestBody = do
     HandlerData
         { handlerEnv = RunHandlerEnv {..}
         , handlerRequest = req
-        } <- liftHandlerT $ HandlerT return
+        } <- liftHandler $ HandlerFor return
     let len = W.requestBodyLength $ reqWaiRequest req
         upload = rheUpload len
     x <- get
@@ -320,7 +323,7 @@ rbHelper' backend mkFI req =
     go = decodeUtf8With lenientDecode
 
 askHandlerEnv :: MonadHandler m => m (RunHandlerEnv (HandlerSite m))
-askHandlerEnv = liftHandlerT $ HandlerT $ return . handlerEnv
+askHandlerEnv = liftHandler $ HandlerFor $ return . handlerEnv
 
 -- | Get the master site application argument.
 getYesod :: MonadHandler m => m (HandlerSite m)
@@ -396,9 +399,9 @@ getCurrentRoute = rheRoute <$> askHandlerEnv
 -- This allows the inner 'GHandler' to outlive the outer
 -- 'GHandler' (e.g., on the @forkIO@ example above, a response
 -- may be sent to the client without killing the new thread).
-handlerToIO :: (MonadIO m1, MonadIO m2) => HandlerT site m1 (HandlerT site IO a -> m2 a)
+handlerToIO :: MonadIO m => HandlerFor site (HandlerFor site a -> m a)
 handlerToIO =
-  HandlerT $ \oldHandlerData -> do
+  HandlerFor $ \oldHandlerData -> do
     -- Take just the bits we need from oldHandlerData.
     let newReq = oldReq { reqWaiRequest = newWaiReq }
           where
@@ -420,7 +423,7 @@ handlerToIO =
     liftIO $ evaluate (newReq `seq` oldEnv `seq` newState `seq` ())
 
     -- Return GHandler running function.
-    return $ \(HandlerT f) ->
+    return $ \(HandlerFor f) ->
       liftIO $
       runResourceT $ withInternalState $ \resState -> do
         -- The state IORef needs to be created here, otherwise it
@@ -431,7 +434,6 @@ handlerToIO =
                 { handlerRequest  = newReq
                 , handlerEnv      = oldEnv
                 , handlerState    = newStateIORef
-                , handlerToParent = const ()
                 , handlerResource = resState
                 }
         liftIO (f newHandlerData)
@@ -442,9 +444,9 @@ handlerToIO =
 -- for correctness and efficiency
 --
 -- @since 1.2.8
-forkHandler :: (SomeException -> HandlerT site IO ()) -- ^ error handler
-              -> HandlerT site IO ()
-              -> HandlerT site IO ()
+forkHandler :: (SomeException -> HandlerFor site ()) -- ^ error handler
+              -> HandlerFor site ()
+              -> HandlerFor site ()
 forkHandler onErr handler = do
     yesRunner <- handlerToIO
     void $ liftResourceT $ resourceForkIO $ yesRunner $ handle onErr handler
@@ -1370,14 +1372,14 @@ respond ct = return . TypedContent ct . toContent
 --
 -- @since 1.2.0
 respondSource :: ContentType
-              -> Source (HandlerT site IO) (Flush Builder)
-              -> HandlerT site IO TypedContent
-respondSource ctype src = HandlerT $ \hd ->
+              -> Source (HandlerFor site) (Flush Builder)
+              -> HandlerFor site TypedContent
+respondSource ctype src = HandlerFor $ \hd ->
     -- Note that this implementation relies on the fact that the ResourceT
     -- environment provided by the server is the same one used in HandlerT.
     -- This is a safe assumption assuming the HandlerT is run correctly.
     return $ TypedContent ctype $ ContentSource
-           $ transPipe (lift . flip unHandlerT hd) src
+           $ transPipe (lift . flip unHandlerFor hd) src
 
 -- | In a streaming response, send a single chunk of data. This function works
 -- on most datatypes, such as @ByteString@ and @Html@.
@@ -1423,25 +1425,6 @@ sendChunkLazyText = sendChunk
 sendChunkHtml :: Monad m => Html -> Producer m (Flush Builder)
 sendChunkHtml = sendChunk
 
--- | Converts a child handler to a parent handler
---
--- Exported since 1.4.11
-stripHandlerT :: HandlerT child (HandlerT parent m) a
-              -> (parent -> child)
-              -> (Route child -> Route parent)
-              -> Maybe (Route child)
-              -> HandlerT parent m a
-stripHandlerT (HandlerT f) getSub toMaster newRoute = HandlerT $ \hd -> do
-    let env = handlerEnv hd
-    ($ hd) $ unHandlerT $ f hd
-        { handlerEnv = env
-            { rheSite = getSub $ rheSite env
-            , rheRoute = newRoute
-            , rheRender = \url params -> rheRender env (toMaster url) params
-            }
-        , handlerToParent = toMaster
-        }
-
 -- $ajaxCSRFOverview
 -- When a user has authenticated with your site, all requests made from the browser to your server will include the session information that you use to verify that the user is logged in.
 -- Unfortunately, this allows attackers to make unwanted requests on behalf of the user by e.g. submitting an HTTP request to your site when the user visits theirs.
diff --git a/yesod-core/Yesod/Core/Internal/LiteApp.hs b/yesod-core/Yesod/Core/Internal/LiteApp.hs
index b09217c6..c9a6f51d 100644
--- a/yesod-core/Yesod/Core/Internal/LiteApp.hs
+++ b/yesod-core/Yesod/Core/Internal/LiteApp.hs
@@ -46,8 +46,8 @@ instance Monoid LiteApp where
     mempty = LiteApp $ \_ _ -> Nothing
     mappend (LiteApp x) (LiteApp y) = LiteApp $ \m ps -> x m ps <|> y m ps
 
-type LiteHandler = HandlerT LiteApp IO
-type LiteWidget = WidgetT LiteApp IO
+type LiteHandler = HandlerFor LiteApp
+type LiteWidget = WidgetFor LiteApp
 
 liteApp :: Writer LiteApp () -> LiteApp
 liteApp = execWriter
diff --git a/yesod-core/Yesod/Core/Internal/Run.hs b/yesod-core/Yesod/Core/Internal/Run.hs
index 668e8604..4f8e69a1 100644
--- a/yesod-core/Yesod/Core/Internal/Run.hs
+++ b/yesod-core/Yesod/Core/Internal/Run.hs
@@ -83,7 +83,7 @@ errFromShow x = evaluate $!! InternalError $! T.pack $! show x
 -- represented by the @HandlerContents@.
 basicRunHandler :: ToTypedContent c
                 => RunHandlerEnv site
-                -> HandlerT site IO c
+                -> HandlerFor site c
                 -> YesodRequest
                 -> InternalState
                 -> IO (GHState, HandlerContents)
@@ -96,7 +96,7 @@ basicRunHandler rhe handler yreq resState = do
     -- converting them into a @HandlerContents@
     contents' <- catchSync
         (do
-            res <- unHandlerT handler (hd istate)
+            res <- unHandlerFor handler (hd istate)
             tc <- evaluate (toTypedContent res)
             -- Success! Wrap it up in an @HCContent@
             return (HCContent defaultStatus tc))
@@ -121,7 +121,6 @@ basicRunHandler rhe handler yreq resState = do
         { handlerRequest = yreq
         , handlerEnv     = rhe
         , handlerState   = istate
-        , handlerToParent = const ()
         , handlerResource = resState
         }
 
@@ -208,7 +207,7 @@ evalFallback contents val = catchSync
 -- 'HandlerT' into an 'Application'. Should not be needed by users.
 runHandler :: ToTypedContent c
            => RunHandlerEnv site
-           -> HandlerT site IO c
+           -> HandlerFor site c
            -> YesodApp
 runHandler rhe@RunHandlerEnv {..} handler yreq = withInternalState $ \resState -> do
     -- Get the raw state and original contents
@@ -263,7 +262,7 @@ runFakeHandler :: (Yesod site, MonadIO m) =>
                   SessionMap
                -> (site -> Logger)
                -> site
-               -> HandlerT site IO a
+               -> HandlerFor site a
                -> m (Either ErrorResponse a)
 runFakeHandler fakeSessionMap logger site handler = liftIO $ do
   ret <- I.newIORef (Left $ InternalError "runFakeHandler: no result")
@@ -322,7 +321,7 @@ runFakeHandler fakeSessionMap logger site handler = liftIO $ do
   I.readIORef ret
 
 yesodRunner :: (ToTypedContent res, Yesod site)
-            => HandlerT site IO res
+            => HandlerFor site res
             -> YesodRunnerEnv site
             -> Maybe (Route site)
             -> Application
diff --git a/yesod-core/Yesod/Core/Internal/TH.hs b/yesod-core/Yesod/Core/Internal/TH.hs
index 8ee5b4e0..fbfee2ed 100644
--- a/yesod-core/Yesod/Core/Internal/TH.hs
+++ b/yesod-core/Yesod/Core/Internal/TH.hs
@@ -32,7 +32,6 @@ import Text.ParserCombinators.Parsec.Char (alphaNum, spaces, string, char)
 import Yesod.Routes.TH
 import Yesod.Routes.Parse
 import Yesod.Core.Types
-import Yesod.Core.Content
 import Yesod.Core.Class.Dispatch
 import Yesod.Core.Internal.Run
 
@@ -102,12 +101,12 @@ mkYesodDispatch :: String -> [ResourceTree String] -> Q [Dec]
 mkYesodDispatch name = fmap snd . mkYesodGeneral name [] False return
 
 -- | Get the Handler and Widget type synonyms for the given site.
-masterTypeSyns :: [Name] -> Type -> [Dec]
+masterTypeSyns :: [Name] -> Type -> [Dec] -- FIXME remove from here, put into the scaffolding itself?
 masterTypeSyns vs site =
     [ TySynD (mkName "Handler") (fmap PlainTV vs)
-      $ ConT ''HandlerT `AppT` site `AppT` ConT ''IO
+      $ ConT ''HandlerFor `AppT` site
     , TySynD (mkName "Widget")  (fmap PlainTV vs)
-      $ ConT ''WidgetT `AppT` site `AppT` ConT ''IO `AppT` ConT ''()
+      $ ConT ''WidgetFor `AppT` site `AppT` ConT ''()
     ]
 
 -- | 'Left' arguments indicate a monomorphic type, a 'Right' argument
@@ -242,7 +241,7 @@ mkDispatchInstance master cxt f res = do
 
 mkYesodSubDispatch :: [ResourceTree a] -> Q Exp
 mkYesodSubDispatch res = do
-    clause' <- mkDispatchClause (mkMDS return [|subHelper . fmap toTypedContent|]) res
+    clause' <- mkDispatchClause (mkMDS return [|subHelper|]) res
     inner <- newName "inner"
     let innerFun = FunD inner [clause']
     helper <- newName "helper"
diff --git a/yesod-core/Yesod/Core/Json.hs b/yesod-core/Yesod/Core/Json.hs
index 245aad90..441b3e92 100644
--- a/yesod-core/Yesod/Core/Json.hs
+++ b/yesod-core/Yesod/Core/Json.hs
@@ -31,14 +31,14 @@ module Yesod.Core.Json
     , acceptsJson
     ) where
 
-import Yesod.Core.Handler (HandlerT, getRequest, invalidArgs, redirect, selectRep, provideRep, rawRequestBody, ProvidedRep, lookupHeader)
+import Yesod.Core.Handler (HandlerFor, getRequest, invalidArgs, redirect, selectRep, provideRep, rawRequestBody, ProvidedRep, lookupHeader)
 import Control.Monad.Trans.Writer (Writer)
 import Data.Monoid (Endo)
 import Yesod.Core.Content (TypedContent)
 import Yesod.Core.Types (reqAccept)
 import Yesod.Core.Class.Yesod (defaultLayout, Yesod)
 import Yesod.Core.Class.Handler
-import Yesod.Core.Widget (WidgetT)
+import Yesod.Core.Widget (WidgetFor)
 import Yesod.Routes.Class
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Parser as JP
@@ -58,9 +58,9 @@ import Control.Monad (liftM)
 --
 -- @since 0.3.0
 defaultLayoutJson :: (Yesod site, J.ToJSON a)
-                  => WidgetT site IO ()  -- ^ HTML
-                  -> HandlerT site IO a  -- ^ JSON
-                  -> HandlerT site IO TypedContent
+                  => WidgetFor site ()  -- ^ HTML
+                  -> HandlerFor site a  -- ^ JSON
+                  -> HandlerFor site TypedContent
 defaultLayoutJson w json = selectRep $ do
     provideRep $ defaultLayout w
     provideRep $ fmap J.toEncoding json
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index fd4572de..4211ba43 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TupleSections #-}
@@ -18,14 +19,14 @@ import           Data.Monoid                        (Monoid (..))
 #endif
 import           Control.Arrow                      (first)
 import           Control.Exception                  (Exception)
-import           Control.Monad                      (liftM, ap)
+import           Control.Monad                      (ap)
 import           Control.Monad.Base                 (MonadBase (liftBase))
 import           Control.Monad.Catch                (MonadMask (..), MonadCatch (..))
 import           Control.Monad.IO.Class             (MonadIO (liftIO))
 import           Control.Monad.Logger               (LogLevel, LogSource,
                                                      MonadLogger (..))
 import           Control.Monad.Trans.Control        (MonadBaseControl (..))
-import           Control.Monad.Trans.Resource       (MonadResource (..), InternalState, runInternalState, MonadThrow (..), monadThrow, ResourceT)
+import           Control.Monad.Trans.Resource       (MonadResource (..), InternalState, runInternalState, MonadThrow (..), ResourceT)
 import           Data.ByteString                    (ByteString)
 import qualified Data.ByteString.Lazy               as L
 import           Data.Conduit                       (Flush, Source)
@@ -56,7 +57,6 @@ import           Text.Hamlet                        (HtmlUrl)
 import           Text.Julius                        (JavascriptUrl)
 import           Web.Cookie                         (SetCookie)
 import           Yesod.Core.Internal.Util           (getTime, putTime)
-import           Control.Monad.Trans.Class          (MonadTrans (..))
 import           Yesod.Routes.Class                 (RenderRoute (..), ParseRoute (..))
 import           Control.Monad.Reader               (MonadReader (..))
 import           Data.Monoid                        ((<>))
@@ -66,7 +66,7 @@ import Data.Conduit.Lazy (MonadActive, monadActive)
 import Yesod.Core.TypeCache (TypeMap, KeyedTypeMap)
 import Control.Monad.Logger (MonadLoggerIO (..))
 import Data.Semigroup (Semigroup)
-import Control.Monad.IO.Unlift (MonadUnliftIO (..), UnliftIO (..), withUnliftIO)
+import Control.Monad.IO.Unlift (MonadUnliftIO (..), UnliftIO (..))
 
 -- Sessions
 type SessionMap = Map Text ByteString
@@ -193,11 +193,10 @@ data RunHandlerEnv site = RunHandlerEnv
     , rheMaxExpires :: !Text
     }
 
-data HandlerData site parentRoute = HandlerData
+data HandlerData site = HandlerData
     { handlerRequest  :: !YesodRequest
     , handlerEnv      :: !(RunHandlerEnv site)
     , handlerState    :: !(IORef GHState)
-    , handlerToParent :: !(Route site -> parentRoute)
     , handlerResource :: !InternalState
     }
 
@@ -224,16 +223,13 @@ type ParentRunner parent m
 
 -- | A generic handler monad, which can have a different subsite and master
 -- site. We define a newtype for better error message.
-newtype HandlerT site m a = HandlerT
-    { unHandlerT :: HandlerData site (MonadRoute m) -> m a
+newtype HandlerFor site a = HandlerFor
+    { unHandlerFor :: HandlerData site -> IO a
     }
-
-type family MonadRoute (m :: * -> *)
-type instance MonadRoute IO = ()
-type instance MonadRoute (HandlerT site m) = (Route site)
+    deriving Functor
 
 data GHState = GHState
-    { ghsSession :: SessionMap
+    { ghsSession :: !SessionMap
     , ghsRBC     :: Maybe RequestBodyContents
     , ghsIdent   :: Int
     , ghsCache   :: TypeMap
@@ -249,26 +245,32 @@ type YesodApp = YesodRequest -> ResourceT IO YesodResponse
 -- | A generic widget, allowing specification of both the subsite and master
 -- site datatypes. While this is simply a @WriterT@, we define a newtype for
 -- better error messages.
-newtype WidgetT site m a = WidgetT
-    { unWidgetT :: IORef (GWData (Route site)) -> HandlerData site (MonadRoute m) -> m a
+newtype WidgetFor site a = WidgetFor
+    { unWidgetFor :: WidgetData site -> IO a
     }
+    deriving Functor
 
-instance (a ~ (), Monad m) => Monoid (WidgetT site m a) where
+data WidgetData site = WidgetData
+  { wdRef :: {-# UNPACK #-} !(IORef (GWData (Route site)))
+  , wdHandler :: {-# UNPACK #-} !(HandlerData site)
+  }
+
+instance a ~ () => Monoid (WidgetFor site a) where
     mempty = return ()
     mappend x y = x >> y
-instance (a ~ (), Monad m) => Semigroup (WidgetT site m a)
+instance a ~ () => Semigroup (WidgetFor site a)
 
 -- | A 'String' can be trivially promoted to a widget.
 --
 -- For example, in a yesod-scaffold site you could use:
 --
 -- @getHomeR = do defaultLayout "Widget text"@
-instance (MonadIO m, a ~ ()) => IsString (WidgetT site m a) where -- FIXME turn it into WidgetFor?
+instance a ~ () => IsString (WidgetFor site a) where
     fromString = toWidget . toHtml . T.pack
       where toWidget x = tellWidget mempty { gwdBody = Body (const x) }
 
-tellWidget :: MonadIO m => GWData (Route site) -> WidgetT site m ()
-tellWidget d = WidgetT $ \ref _ -> liftIO $ modifyIORef' ref (<> d)
+tellWidget :: GWData (Route site) -> WidgetFor site ()
+tellWidget d = WidgetFor $ \wd -> modifyIORef' (wdRef wd) (<> d)
 
 type RY master = Route master -> [(Text, Text)] -> Text
 
@@ -404,106 +406,85 @@ instance Show HandlerContents where
     show (HCWaiApp _) = "HCWaiApp"
 instance Exception HandlerContents
 
--- Instances for WidgetT
-instance Monad m => Functor (WidgetT site m) where
-    fmap = liftM
-instance Monad m => Applicative (WidgetT site m) where
-    pure = return
+-- Instances for WidgetFor
+instance Applicative (WidgetFor site) where
+    pure = WidgetFor . const . pure
     (<*>) = ap
-instance Monad m => Monad (WidgetT site m) where
-    return a = WidgetT $ \_ _ -> return a
-    WidgetT x >>= f = WidgetT $ \ref r -> do
-        a <- x ref r
-        unWidgetT (f a) ref r
-instance MonadIO m => MonadIO (WidgetT site m) where
-    liftIO = lift . liftIO
-instance MonadBase b m => MonadBase b (WidgetT site m) where
-    liftBase = WidgetT . const . const . liftBase
-instance MonadBaseControl b m => MonadBaseControl b (WidgetT site m) where
-    type StM (WidgetT site m) a = StM m a
-    liftBaseWith f = WidgetT $ \ref reader' ->
+instance Monad (WidgetFor site) where
+    return = pure
+    WidgetFor x >>= f = WidgetFor $ \wd -> do
+        a <- x wd
+        unWidgetFor (f a) wd
+instance MonadIO (WidgetFor site) where
+    liftIO = WidgetFor . const
+instance b ~ IO => MonadBase b (WidgetFor site) where
+    liftBase = WidgetFor . const
+instance b ~ IO => MonadBaseControl b (WidgetFor site) where
+    type StM (WidgetFor site) a = a
+    liftBaseWith f = WidgetFor $ \wd ->
         liftBaseWith $ \runInBase ->
-            f $ runInBase . (\(WidgetT w) -> w ref reader')
-    restoreM = WidgetT . const . const . restoreM
+            f $ runInBase . (flip unWidgetFor wd)
+    restoreM = WidgetFor . const . return
 -- | @since 1.4.38
-instance MonadUnliftIO m => MonadUnliftIO (WidgetT site m) where
+instance MonadUnliftIO (WidgetFor site) where
   {-# INLINE askUnliftIO #-}
-  askUnliftIO = WidgetT $ \ref r ->
-                withUnliftIO $ \u ->
-                return (UnliftIO (\(WidgetT w) -> unliftIO u $ w ref r))
-instance Monad m => MonadReader site (WidgetT site m) where
-    ask = WidgetT $ \_ hd -> return (rheSite $ handlerEnv hd)
-    local f (WidgetT g) = WidgetT $ \ref hd -> g ref hd
-        { handlerEnv = (handlerEnv hd)
-            { rheSite = f $ rheSite $ handlerEnv hd
-            }
-        }
+  askUnliftIO = WidgetFor $ \wd ->
+                return (UnliftIO (flip unWidgetFor wd))
+instance MonadReader (WidgetData site) (WidgetFor site) where
+    ask = WidgetFor return
+    local f (WidgetFor g) = WidgetFor $ g . f
 
-instance MonadTrans (WidgetT site) where
-    lift = WidgetT . const . const
-instance MonadThrow m => MonadThrow (WidgetT site m) where
-    throwM = lift . throwM
+instance MonadThrow (WidgetFor site) where
+    throwM = liftIO . throwM
 
-instance MonadCatch m => MonadCatch (HandlerT site m) where
-  catch (HandlerT m) c = HandlerT $ \r -> m r `catch` \e -> unHandlerT (c e) r
-instance MonadMask m => MonadMask (HandlerT site m) where
-  mask a = HandlerT $ \e -> mask $ \u -> unHandlerT (a $ q u) e
-    where q u (HandlerT b) = HandlerT (u . b)
+instance MonadCatch (HandlerFor site) where
+  catch (HandlerFor m) c = HandlerFor $ \r -> m r `catch` \e -> unHandlerFor (c e) r
+instance MonadMask (HandlerFor site) where
+  mask a = HandlerFor $ \e -> mask $ \u -> unHandlerFor (a $ q u) e
+    where q u (HandlerFor b) = HandlerFor (u . b)
   uninterruptibleMask a =
-    HandlerT $ \e -> uninterruptibleMask $ \u -> unHandlerT (a $ q u) e
-      where q u (HandlerT b) = HandlerT (u . b)
-instance MonadCatch m => MonadCatch (WidgetT site m) where
-  catch (WidgetT m) c = WidgetT $ \ref r -> m ref r `catch` \e -> unWidgetT (c e) ref r
-instance MonadMask m => MonadMask (WidgetT site m) where
-  mask a = WidgetT $ \ref e -> mask $ \u -> unWidgetT (a $ q u) ref e
-    where q u (WidgetT b) = WidgetT (\ref e -> u $ b ref e)
+    HandlerFor $ \e -> uninterruptibleMask $ \u -> unHandlerFor (a $ q u) e
+      where q u (HandlerFor b) = HandlerFor (u . b)
+instance MonadCatch (WidgetFor site) where
+  catch (WidgetFor m) c = WidgetFor $ \r -> m r `catch` \e -> unWidgetFor (c e) r
+instance MonadMask (WidgetFor site) where
+  mask a = WidgetFor $ \e -> mask $ \u -> unWidgetFor (a $ q u) e
+    where q u (WidgetFor b) = WidgetFor (u . b)
   uninterruptibleMask a =
-    WidgetT $ \ref e -> uninterruptibleMask $ \u -> unWidgetT (a $ q u) ref e
-      where q u (WidgetT b) = WidgetT (\ref e -> u $ b ref e)
+    WidgetFor $ \e -> uninterruptibleMask $ \u -> unWidgetFor (a $ q u) e
+      where q u (WidgetFor b) = WidgetFor (u . b)
 
--- CPP to avoid a redundant constraints warning
-#if MIN_VERSION_base(4,9,0)
-instance (MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (WidgetT site m) where
-#else
-instance (Applicative m, MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (WidgetT site m) where
-#endif
-    liftResourceT f = WidgetT $ \_ hd -> liftIO $ runInternalState f (handlerResource hd)
+instance MonadResource (WidgetFor site) where
+    liftResourceT f = WidgetFor $ runInternalState f . handlerResource . wdHandler
 
-instance MonadIO m => MonadLogger (WidgetT site m) where
-    monadLoggerLog a b c d = WidgetT $ \_ hd ->
-        liftIO $ rheLog (handlerEnv hd) a b c (toLogStr d)
+instance MonadLogger (WidgetFor site) where
+    monadLoggerLog a b c d = WidgetFor $ \wd ->
+        rheLog (handlerEnv $ wdHandler wd) a b c (toLogStr d)
 
-instance MonadIO m => MonadLoggerIO (WidgetT site m) where
-    askLoggerIO = WidgetT $ \_ hd -> return $ rheLog $ handlerEnv hd
+instance MonadLoggerIO (WidgetFor site) where
+    askLoggerIO = WidgetFor $ return . rheLog . handlerEnv . wdHandler
 
-instance MonadActive m => MonadActive (WidgetT site m) where
-    monadActive = lift monadActive
-instance MonadActive m => MonadActive (HandlerT site m) where
-    monadActive = lift monadActive
-
-instance MonadTrans (HandlerT site) where
-    lift = HandlerT . const
+-- FIXME look at implementation of ResourceT
+instance MonadActive (WidgetFor site) where
+    monadActive = liftIO monadActive
+instance MonadActive (HandlerFor site) where
+    monadActive = liftIO monadActive
 
 -- Instances for HandlerT
-instance Monad m => Functor (HandlerT site m) where
-    fmap = liftM
-instance Monad m => Applicative (HandlerT site m) where
-    pure = return
+instance Applicative (HandlerFor site) where
+    pure = HandlerFor . const . return
     (<*>) = ap
-instance Monad m => Monad (HandlerT site m) where
-    return = HandlerT . const . return
-    HandlerT x >>= f = HandlerT $ \r -> x r >>= \x' -> unHandlerT (f x') r
-instance MonadIO m => MonadIO (HandlerT site m) where
-    liftIO = lift . liftIO
-instance MonadBase b m => MonadBase b (HandlerT site m) where
-    liftBase = lift . liftBase
-instance Monad m => MonadReader site (HandlerT site m) where
-    ask = HandlerT $ return . rheSite . handlerEnv
-    local f (HandlerT g) = HandlerT $ \hd -> g hd
-        { handlerEnv = (handlerEnv hd)
-            { rheSite = f $ rheSite $ handlerEnv hd
-            }
-        }
+instance Monad (HandlerFor site) where
+    return = pure
+    HandlerFor x >>= f = HandlerFor $ \r -> x r >>= \x' -> unHandlerFor (f x') r
+instance MonadIO (HandlerFor site) where
+    liftIO = HandlerFor . const
+instance b ~ IO => MonadBase b (HandlerFor site) where
+    liftBase = liftIO
+instance MonadReader (HandlerData site) (HandlerFor site) where
+    ask = HandlerFor return
+    local f (HandlerFor g) = HandlerFor $ g . f
+
 -- | Note: although we provide a @MonadBaseControl@ instance, @lifted-base@'s
 -- @fork@ function is incompatible with the underlying @ResourceT@ system.
 -- Instead, if you must fork a separate thread, you should use
@@ -512,31 +493,30 @@ instance Monad m => MonadReader site (HandlerT site m) where
 -- Using fork usually leads to an exception that says
 -- \"Control.Monad.Trans.Resource.register\': The mutable state is being accessed
 -- after cleanup. Please contact the maintainers.\"
-instance MonadBaseControl b m => MonadBaseControl b (HandlerT site m) where
-    type StM (HandlerT site m) a = StM m a
-    liftBaseWith f = HandlerT $ \reader' ->
+instance b ~ IO => MonadBaseControl b (HandlerFor site) where
+    type StM (HandlerFor site) a = a
+    liftBaseWith f = HandlerFor $ \reader' ->
         liftBaseWith $ \runInBase ->
-            f $ runInBase . (\(HandlerT r) -> r reader')
-    restoreM = HandlerT . const . restoreM
+            f $ runInBase . (flip unHandlerFor reader')
+    restoreM = HandlerFor . const . return
 -- | @since 1.4.38
-instance MonadUnliftIO m => MonadUnliftIO (HandlerT site m) where
+instance MonadUnliftIO (HandlerFor site) where
   {-# INLINE askUnliftIO #-}
-  askUnliftIO = HandlerT $ \r ->
-                withUnliftIO $ \u ->
-                return (UnliftIO (unliftIO u . flip unHandlerT r))
+  askUnliftIO = HandlerFor $ \r ->
+                return (UnliftIO (flip unHandlerFor r))
 
-instance MonadThrow m => MonadThrow (HandlerT site m) where
-    throwM = lift . monadThrow
+instance MonadThrow (HandlerFor site) where
+    throwM = liftIO . throwM
 
-instance (MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (HandlerT site m) where
-    liftResourceT f = HandlerT $ \hd -> liftIO $ runInternalState f (handlerResource hd)
+instance MonadResource (HandlerFor site) where
+    liftResourceT f = HandlerFor $ runInternalState f . handlerResource
 
-instance MonadIO m => MonadLogger (HandlerT site m) where
-    monadLoggerLog a b c d = HandlerT $ \hd ->
-        liftIO $ rheLog (handlerEnv hd) a b c (toLogStr d)
+instance MonadLogger (HandlerFor site) where
+    monadLoggerLog a b c d = HandlerFor $ \hd ->
+        rheLog (handlerEnv hd) a b c (toLogStr d)
 
-instance MonadIO m => MonadLoggerIO (HandlerT site m) where
-    askLoggerIO = HandlerT $ \hd -> return (rheLog (handlerEnv hd))
+instance MonadLoggerIO (HandlerFor site) where
+    askLoggerIO = HandlerFor $ \hd -> return (rheLog (handlerEnv hd))
 
 instance Monoid (UniqueList x) where
     mempty = UniqueList id
diff --git a/yesod-core/Yesod/Core/Unsafe.hs b/yesod-core/Yesod/Core/Unsafe.hs
index ea15e7b3..c4d75b1e 100644
--- a/yesod-core/Yesod/Core/Unsafe.hs
+++ b/yesod-core/Yesod/Core/Unsafe.hs
@@ -19,7 +19,10 @@ import Control.Monad.IO.Class (MonadIO)
 --
 -- > unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
 fakeHandlerGetLogger :: (Yesod site, MonadIO m)
-                     => (site -> Logger) -> site -> HandlerT site IO a -> m a
+                     => (site -> Logger)
+                     -> site
+                     -> HandlerFor site a
+                     -> m a
 fakeHandlerGetLogger getLogger app f =
      runFakeHandler mempty getLogger app f
  >>= either (error . ("runFakeHandler issue: " `mappend`) . show)
diff --git a/yesod-core/Yesod/Core/Widget.hs b/yesod-core/Yesod/Core/Widget.hs
index f9e1eeb3..67ac6380 100644
--- a/yesod-core/Yesod/Core/Widget.hs
+++ b/yesod-core/Yesod/Core/Widget.hs
@@ -14,6 +14,7 @@
 module Yesod.Core.Widget
     ( -- * Datatype
       WidgetT
+    , WidgetFor
     , PageContent (..)
       -- * Special Hamlet quasiquoter/TH for Widgets
     , whamlet
@@ -43,7 +44,6 @@ module Yesod.Core.Widget
     , addScriptRemoteAttrs
     , addScriptEither
       -- * Subsites
-    , widgetToParentWidget
     , handlerToWidget
       -- * Internal
     , whamletFileWithSettings
@@ -60,7 +60,6 @@ import Yesod.Core.Handler (getMessageRender, getUrlRenderParams)
 #if __GLASGOW_HASKELL__ < 710
 import Control.Applicative ((<$>))
 #endif
-import Control.Monad.IO.Class (MonadIO, liftIO)
 import Text.Shakespeare.I18N (RenderMessage)
 import Data.Text (Text)
 import qualified Data.Map as Map
@@ -72,11 +71,13 @@ import Data.Text.Lazy.Builder (fromLazyText)
 import Text.Blaze.Html (toHtml, preEscapedToMarkup)
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Builder as TB
-import Data.IORef
 
 import Yesod.Core.Types
 import Yesod.Core.Class.Handler
 
+type WidgetT site (m :: * -> *) = WidgetFor site
+{-# DEPRECATED WidgetT "Use WidgetFor directly" #-}
+
 preEscapedLazyText :: TL.Text -> Html
 preEscapedLazyText = preEscapedToMarkup
 
@@ -97,8 +98,8 @@ instance render ~ RY site => ToWidget site (render -> Javascript) where
     toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just x) mempty
 instance ToWidget site Javascript where
     toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just $ const x) mempty
-instance (site' ~ site, IO ~ m, a ~ ()) => ToWidget site' (WidgetT site m a) where
-    toWidget = liftWidgetT
+instance (site' ~ site, a ~ ()) => ToWidget site' (WidgetFor site a) where
+    toWidget = liftWidget
 instance ToWidget site Html where
     toWidget = toWidget . const
 -- | @since 1.4.28
@@ -268,49 +269,10 @@ ihamletToHtml ih = do
     return $ ih (toHtml . mrender) urender
 
 tell :: MonadWidget m => GWData (Route (HandlerSite m)) -> m ()
-tell = liftWidgetT . tellWidget
+tell = liftWidget . tellWidget
 
 toUnique :: x -> UniqueList x
 toUnique = UniqueList . (:)
 
-handlerToWidget :: Monad m => HandlerT site m a -> WidgetT site m a
-handlerToWidget (HandlerT f) = WidgetT $ const f
-
-widgetToParentWidget :: MonadIO m
-                     => WidgetT child IO a
-                     -> HandlerT child (HandlerT parent m) (WidgetT parent m a)
-widgetToParentWidget (WidgetT f) = HandlerT $ \hdChild -> do
-    return $ WidgetT $ \ref _hdParent -> liftIO $ do
-      tmp <- newIORef mempty
-      a <- f tmp hdChild { handlerToParent = const () }
-      gwd <- readIORef tmp
-      modifyIORef' ref (<> liftGWD (handlerToParent hdChild) gwd)
-      return a
-
-liftGWD :: (child -> parent) -> GWData child -> GWData parent
-liftGWD tp gwd = GWData
-    { gwdBody        = fixBody $ gwdBody gwd
-    , gwdTitle       = gwdTitle gwd
-    , gwdScripts     = fixUnique fixScript $ gwdScripts gwd
-    , gwdStylesheets = fixUnique fixStyle $ gwdStylesheets gwd
-    , gwdCss         = fixCss <$> gwdCss gwd
-    , gwdJavascript  = fixJS <$> gwdJavascript gwd
-    , gwdHead        = fixHead $ gwdHead gwd
-    }
-  where
-    fixRender f route = f (tp route)
-
-    fixBody (Body h) = Body $ h . fixRender
-    fixHead (Head h) = Head $ h . fixRender
-
-    fixUnique go (UniqueList f) = UniqueList (map go (f []) ++)
-
-    fixScript (Script loc attrs) = Script (fixLoc loc) attrs
-    fixStyle (Stylesheet loc attrs) = Stylesheet (fixLoc loc) attrs
-
-    fixLoc (Local url) = Local $ tp url
-    fixLoc (Remote t) = Remote t
-
-    fixCss f = f . fixRender
-
-    fixJS f = f . fixRender
+handlerToWidget :: HandlerFor site a -> WidgetFor site a
+handlerToWidget (HandlerFor f) = WidgetFor $ f . wdHandler
diff --git a/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs b/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs
index 0785df0b..c01af705 100644
--- a/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs
+++ b/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleInstances, ViewPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-} -- the module name is a lie!!!
 module YesodCoreTest.NoOverloadedStrings
     ( noOverloadedTest
@@ -20,19 +21,19 @@ import qualified Data.ByteString.Lazy.Char8 as L8
 getSubsite :: a -> Subsite
 getSubsite _ = Subsite $(mkYesodSubDispatch resourcesSubsite)
 
-getBarR :: Monad m => m T.Text
+getBarR :: MonadSubHandler m => m T.Text
 getBarR = return $ T.pack "BarR"
 
-getBazR :: Yesod master => HandlerT Subsite (HandlerT master IO) Html
-getBazR = lift $ defaultLayout [whamlet|Used Default Layout|]
+getBazR :: (MonadSubHandler m, Yesod (HandlerSite m)) => m Html
+getBazR = liftHandler $ defaultLayout [whamlet|Used Default Layout|]
 
-getBinR :: Yesod master => HandlerT Subsite (HandlerT master IO) Html
+getBinR :: (MonadSubHandler m, Yesod (HandlerSite m), SubHandlerSite m ~ Subsite) => m Html
 getBinR = do
-    widget <- widgetToParentWidget [whamlet|
+    toParentRoute <- getToParentRoute
+    liftHandler $ defaultLayout [whamlet|
         <p>Used defaultLayoutT
-        <a href=@{BazR}>Baz
+        <a href=@{toParentRoute BazR}>Baz
     |]
-    lift $ defaultLayout widget
 
 getOnePiecesR :: Monad m => Int -> m ()
 getOnePiecesR _ = return ()
diff --git a/yesod-core/test/YesodCoreTest/NoOverloadedStringsSub.hs b/yesod-core/test/YesodCoreTest/NoOverloadedStringsSub.hs
index e8be9c14..170fd711 100644
--- a/yesod-core/test/YesodCoreTest/NoOverloadedStringsSub.hs
+++ b/yesod-core/test/YesodCoreTest/NoOverloadedStringsSub.hs
@@ -10,7 +10,7 @@ module YesodCoreTest.NoOverloadedStringsSub where
 import Yesod.Core
 import Yesod.Core.Types
 
-data Subsite = Subsite (forall master. Yesod master => YesodSubRunnerEnv Subsite master (HandlerT master IO) -> Application)
+data Subsite = Subsite (forall master. Yesod master => YesodSubRunnerEnv Subsite master (HandlerFor master) -> Application)
 
 mkYesodSubData "Subsite" [parseRoutes|
 /bar BarR GET
@@ -21,7 +21,7 @@ mkYesodSubData "Subsite" [parseRoutes|
 /has-three-pieces/#Int/#Int/#Int ThreePiecesR GET
 |]
 
-instance Yesod master => YesodSubDispatch Subsite (HandlerT master IO) where
+instance Yesod master => YesodSubDispatch Subsite (HandlerFor master) where
     yesodSubDispatch ysre =
         f ysre
       where

From 61c887f5014f3090ce5237609237edfa26eafcb2 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 13 Dec 2017 13:44:59 +0200
Subject: [PATCH 07/43] Start converting yesod-auth over

---
 yesod-auth/Yesod/Auth.hs                      | 113 +++++++++---------
 yesod-auth/Yesod/Auth/BrowserId.hs            |  11 +-
 yesod-core/Yesod/Core/Class/Dispatch.hs       |  32 ++---
 yesod-core/Yesod/Core/Class/Handler.hs        |   3 +-
 .../test/YesodCoreTest/NoOverloadedStrings.hs |   4 +-
 5 files changed, 83 insertions(+), 80 deletions(-)

diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs
index 4a0eb390..c5b1c163 100644
--- a/yesod-auth/Yesod/Auth.hs
+++ b/yesod-auth/Yesod/Auth.hs
@@ -64,7 +64,7 @@ import Network.HTTP.Client (Manager, Request, withResponse, Response, BodyReader
 import qualified Network.Wai as W
 
 import Yesod.Core
-import Yesod.Core.Types (HandlerT(..), unHandlerT)
+import Yesod.Core.Types (HandlerFor(..))
 import Yesod.Persist
 import Yesod.Auth.Message (AuthMessage, defaultMessage)
 import qualified Yesod.Auth.Message as Msg
@@ -72,13 +72,12 @@ import Yesod.Form (FormMessage)
 import Data.Typeable (Typeable)
 import Control.Exception (Exception)
 import Network.HTTP.Types (Status, internalServerError500, unauthorized401)
-import Control.Monad.Trans.Resource (MonadResourceBase)
 import qualified Control.Monad.Trans.Writer    as Writer
 import Control.Monad (void)
 
 type AuthRoute = Route Auth
 
-type AuthHandler master a = YesodAuth master => HandlerT Auth (HandlerT master IO) a
+type AuthHandler master a = forall m. (MonadSubHandler m, YesodAuth master, master ~ HandlerSite m, Auth ~ SubHandlerSite m) => m a
 
 type Method = Text
 type Piece = Text
@@ -94,7 +93,7 @@ data AuthenticationResult master
 data AuthPlugin master = AuthPlugin
     { apName :: Text
     , apDispatch :: Method -> [Piece] -> AuthHandler master TypedContent
-    , apLogin :: (Route Auth -> Route master) -> WidgetT master IO ()
+    , apLogin :: (Route Auth -> Route master) -> WidgetFor master ()
     }
 
 getAuth :: a -> Auth
@@ -111,7 +110,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     type AuthId master
 
     -- | specify the layout. Uses defaultLayout by default
-    authLayout :: WidgetT master IO () -> HandlerT master IO Html
+    authLayout :: WidgetFor master () -> HandlerFor master Html
     authLayout = defaultLayout
 
     -- | Default destination on successful login, if no other
@@ -127,7 +126,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     -- Default implementation is in terms of @'getAuthId'@
     --
     -- Since: 1.4.4
-    authenticate :: Creds master -> HandlerT master IO (AuthenticationResult master)
+    authenticate :: Creds master -> HandlerFor master (AuthenticationResult master)
     authenticate creds = do
         muid <- getAuthId creds
 
@@ -137,7 +136,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     --
     -- Default implementation is in terms of @'authenticate'@
     --
-    getAuthId :: Creds master -> HandlerT master IO (Maybe (AuthId master))
+    getAuthId :: Creds master -> HandlerFor master (Maybe (AuthId master))
     getAuthId creds = do
         auth <- authenticate creds
 
@@ -167,7 +166,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     -- >             lift $ redirect HomeR   -- or any other Handler code you want
     -- >         defaultLoginHandler
     --
-    loginHandler :: HandlerT Auth (HandlerT master IO) Html
+    loginHandler :: AuthHandler master Html
     loginHandler = defaultLoginHandler
 
     -- | Used for i18n of messages provided by this package.
@@ -196,11 +195,11 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
 
     -- | Called on a successful login. By default, calls
     -- @addMessageI "success" NowLoggedIn@.
-    onLogin :: HandlerT master IO ()
+    onLogin :: HandlerFor master ()
     onLogin = addMessageI "success" Msg.NowLoggedIn
 
     -- | Called on logout. By default, does nothing
-    onLogout :: HandlerT master IO ()
+    onLogout :: HandlerFor master ()
     onLogout = return ()
 
     -- | Retrieves user credentials, if user is authenticated.
@@ -212,16 +211,16 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     -- other than a browser.
     --
     -- Since 1.2.0
-    maybeAuthId :: HandlerT master IO (Maybe (AuthId master))
+    maybeAuthId :: HandlerFor master (Maybe (AuthId master))
 
     default maybeAuthId
         :: (YesodAuthPersist master, Typeable (AuthEntity master))
-        => HandlerT master IO (Maybe (AuthId master))
+        => HandlerFor master (Maybe (AuthId master))
     maybeAuthId = defaultMaybeAuthId
 
     -- | Called on login error for HTTP requests. By default, calls
     -- @addMessage@ with "error" as status and redirects to @dest@.
-    onErrorHtml :: (MonadResourceBase m) => Route master -> Text -> HandlerT master m Html
+    onErrorHtml :: Route master -> Text -> HandlerFor master Html
     onErrorHtml dest msg = do
         addMessage "error" $ toHtml msg
         fmap asHtml $ redirect dest
@@ -231,10 +230,10 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     --
     --  The HTTP 'Request' is given in case it is useful to change behavior based on inspecting the request.
     --  This is an experimental API that is not broadly used throughout the yesod-auth code base
-    runHttpRequest :: Request -> (Response BodyReader -> HandlerT master IO a) -> HandlerT master IO a
+    runHttpRequest :: Request -> (Response BodyReader -> HandlerFor master a) -> HandlerFor master a
     runHttpRequest req inner = do
       man <- authHttpManager Control.Applicative.<$> getYesod
-      HandlerT $ \t -> withResponse req man $ \res -> unHandlerT (inner res) t
+      HandlerFor $ \t -> withResponse req man $ \res -> unHandlerFor (inner res) t
 
     {-# MINIMAL loginDest, logoutDest, (authenticate | getAuthId), authPlugins, authHttpManager #-}
 
@@ -255,7 +254,7 @@ credsKey = "_ID"
 -- Since 1.1.2
 defaultMaybeAuthId
     :: (YesodAuthPersist master, Typeable (AuthEntity master))
-    => HandlerT master IO (Maybe (AuthId master))
+    => HandlerFor master (Maybe (AuthId master))
 defaultMaybeAuthId = runMaybeT $ do
     s   <- MaybeT $ lookupSession credsKey
     aid <- MaybeT $ return $ fromPathPiece s
@@ -264,7 +263,7 @@ defaultMaybeAuthId = runMaybeT $ do
 
 cachedAuth
     :: (YesodAuthPersist master, Typeable (AuthEntity master))
-    => AuthId master -> HandlerT master IO (Maybe (AuthEntity master))
+    => AuthId master -> HandlerFor master (Maybe (AuthEntity master))
 cachedAuth
     = fmap unCachedMaybeAuth
     . cached
@@ -281,48 +280,47 @@ cachedAuth
 defaultLoginHandler :: AuthHandler master Html
 defaultLoginHandler = do
     tp <- getRouteToParent
-    lift $ authLayout $ do
+    liftHandler $ authLayout $ do
         setTitleI Msg.LoginTitle
         master <- getYesod
         mapM_ (flip apLogin tp) (authPlugins master)
 
 
-loginErrorMessageI :: (MonadResourceBase m, YesodAuth master)
-                   => Route child
+loginErrorMessageI :: (YesodAuth (HandlerSite m), MonadSubHandler m)
+                   => Route (SubHandlerSite m)
                    -> AuthMessage
-                   -> HandlerT child (HandlerT master m) TypedContent
+                   -> m TypedContent
 loginErrorMessageI dest msg = do
   toParent <- getRouteToParent
-  lift $ loginErrorMessageMasterI (toParent dest) msg
+  liftHandler $ loginErrorMessageMasterI (toParent dest) msg
 
 
-loginErrorMessageMasterI :: (YesodAuth master, MonadResourceBase m, RenderMessage master AuthMessage)
+loginErrorMessageMasterI :: (YesodAuth master, RenderMessage master AuthMessage)
          => Route master
          -> AuthMessage
-         -> HandlerT master m TypedContent
+         -> HandlerFor master TypedContent
 loginErrorMessageMasterI dest msg = do
   mr <- getMessageRender
   loginErrorMessage dest (mr msg)
 
 -- | For HTML, set the message and redirect to the route.
 -- For JSON, send the message and a 401 status
-loginErrorMessage :: (YesodAuth master, MonadResourceBase m)
+loginErrorMessage :: YesodAuth master
          => Route master
          -> Text
-         -> HandlerT master m TypedContent
+         -> HandlerFor master TypedContent
 loginErrorMessage dest msg = messageJson401 msg (onErrorHtml dest msg)
 
-messageJson401 :: MonadResourceBase m => Text -> HandlerT master m Html -> HandlerT master m TypedContent
+messageJson401 :: Text -> HandlerFor master Html -> HandlerFor master TypedContent
 messageJson401 = messageJsonStatus unauthorized401
 
-messageJson500 :: MonadResourceBase m => Text -> HandlerT master m Html -> HandlerT master m TypedContent
+messageJson500 :: Text -> HandlerFor master Html -> HandlerFor master TypedContent
 messageJson500 = messageJsonStatus internalServerError500
 
-messageJsonStatus :: MonadResourceBase m
-                  => Status
+messageJsonStatus :: Status
                   -> Text
-                  -> HandlerT master m Html
-                  -> HandlerT master m TypedContent
+                  -> HandlerFor master Html
+                  -> HandlerFor master TypedContent
 messageJsonStatus status msg html = selectRep $ do
     provideRep html
     provideRep $ do
@@ -336,7 +334,7 @@ provideJsonMessage msg = provideRep $ return $ object ["message" .= msg]
 
 setCredsRedirect :: YesodAuth master
          => Creds master -- ^ new credentials
-         -> HandlerT master IO TypedContent
+         -> HandlerFor master TypedContent
 setCredsRedirect creds = do
     y    <- getYesod
     auth <- authenticate creds
@@ -378,7 +376,7 @@ setCredsRedirect creds = do
 setCreds :: YesodAuth master
          => Bool         -- ^ if HTTP redirects should be done
          -> Creds master -- ^ new credentials
-         -> HandlerT master IO ()
+         -> HandlerFor master ()
 setCreds doRedirects creds =
     if doRedirects
       then void $ setCredsRedirect creds
@@ -389,9 +387,9 @@ setCreds doRedirects creds =
 
 -- | same as defaultLayoutJson, but uses authLayout
 authLayoutJson :: (YesodAuth site, ToJSON j)
-                  => WidgetT site IO ()  -- ^ HTML
-                  -> HandlerT site IO j  -- ^ JSON
-                  -> HandlerT site IO TypedContent
+                  => WidgetFor site ()  -- ^ HTML
+                  -> HandlerFor site j  -- ^ JSON
+                  -> HandlerFor site TypedContent
 authLayoutJson w json = selectRep $ do
     provideRep $ authLayout w
     provideRep $ fmap toJSON json
@@ -399,18 +397,18 @@ authLayoutJson w json = selectRep $ do
 -- | Clears current user credentials for the session.
 --
 -- Since 1.1.7
-clearCreds :: YesodAuth master
+clearCreds :: (MonadHandler m, YesodAuth (HandlerSite m))
            => Bool -- ^ if HTTP redirect to 'logoutDest' should be done
-           -> HandlerT master IO ()
+           -> m ()
 clearCreds doRedirects = do
     y <- getYesod
-    onLogout
+    liftHandler onLogout
     deleteSession credsKey
     when doRedirects $ do
         redirectUltDest $ logoutDest y
 
 getCheckR :: AuthHandler master TypedContent
-getCheckR = lift $ do
+getCheckR = liftHandler $ do
     creds <- maybeAuthId
     authLayoutJson (do
         setTitle "Authentication Status"
@@ -431,7 +429,7 @@ $nothing
             ]
 
 setUltDestReferer' :: AuthHandler master ()
-setUltDestReferer' = lift $ do
+setUltDestReferer' = liftHandler $ do
     master <- getYesod
     when (redirectToReferer master) setUltDestReferer
 
@@ -439,14 +437,16 @@ getLoginR :: AuthHandler master Html
 getLoginR = setUltDestReferer' >> loginHandler
 
 getLogoutR :: AuthHandler master ()
-getLogoutR = setUltDestReferer' >> redirectToPost LogoutR
+getLogoutR = do
+  tp <- getRouteToParent
+  setUltDestReferer' >> redirectToPost (tp LogoutR)
 
 postLogoutR :: AuthHandler master ()
-postLogoutR = lift $ clearCreds True
+postLogoutR = clearCreds True
 
 handlePluginR :: Text -> [Text] -> AuthHandler master TypedContent
 handlePluginR plugin pieces = do
-    master <- lift getYesod
+    master <- getYesod
     env <- waiRequest
     let method = decodeUtf8With lenientDecode $ W.requestMethod env
     case filter (\x -> apName x == plugin) (authPlugins master) of
@@ -463,7 +463,7 @@ maybeAuth :: ( YesodAuthPersist master
              , Key val ~ AuthId master
              , PersistEntity val
              , Typeable val
-             ) => HandlerT master IO (Maybe (Entity val))
+             ) => HandlerFor master (Maybe (Entity val))
 maybeAuth = runMaybeT $ do
     (aid, ae) <- MaybeT maybeAuthPair
     return $ Entity aid ae
@@ -473,7 +473,7 @@ maybeAuth = runMaybeT $ do
 --
 -- Since 1.4.0
 maybeAuthPair :: (YesodAuthPersist master, Typeable (AuthEntity master))
-              => HandlerT master IO (Maybe (AuthId master, AuthEntity master))
+              => HandlerFor master (Maybe (AuthId master, AuthEntity master))
 maybeAuthPair = runMaybeT $ do
     aid <- MaybeT maybeAuthId
     ae  <- MaybeT $ cachedAuth aid
@@ -504,7 +504,7 @@ class (YesodAuth master, YesodPersist master) => YesodAuthPersist master where
     type AuthEntity master :: *
     type AuthEntity master = KeyEntity (AuthId master)
 
-    getAuthEntity :: AuthId master -> HandlerT master IO (Maybe (AuthEntity master))
+    getAuthEntity :: AuthId master -> HandlerFor master (Maybe (AuthEntity master))
 
 #if MIN_VERSION_persistent(2,5,0)
     default getAuthEntity
@@ -513,7 +513,7 @@ class (YesodAuth master, YesodPersist master) => YesodAuthPersist master where
            , Key (AuthEntity master) ~ AuthId master
            , PersistStore backend
            )
-        => AuthId master -> HandlerT master IO (Maybe (AuthEntity master))
+        => AuthId master -> HandlerFor master (Maybe (AuthEntity master))
 #else
     default getAuthEntity
         :: ( YesodPersistBackend master
@@ -522,7 +522,7 @@ class (YesodAuth master, YesodPersist master) => YesodAuthPersist master where
            , PersistStore (YesodPersistBackend master)
            , PersistEntity (AuthEntity master)
            )
-        => AuthId master -> HandlerT master IO (Maybe (AuthEntity master))
+        => AuthId master -> HandlerFor master (Maybe (AuthEntity master))
 #endif
     getAuthEntity = runDB . get
 
@@ -534,7 +534,7 @@ type instance KeyEntity (Key x) = x
 -- authenticated or responds with error 401 if this is an API client (expecting JSON).
 --
 -- Since 1.1.0
-requireAuthId :: YesodAuth master => HandlerT master IO (AuthId master)
+requireAuthId :: YesodAuth master => HandlerFor master (AuthId master)
 requireAuthId = maybeAuthId >>= maybe handleAuthLack return
 
 -- | Similar to 'maybeAuth', but redirects to a login page if user is not
@@ -546,7 +546,7 @@ requireAuth :: ( YesodAuthPersist master
                , Key val ~ AuthId master
                , PersistEntity val
                , Typeable val
-               ) => HandlerT master IO (Entity val)
+               ) => HandlerFor master (Entity val)
 requireAuth = maybeAuth >>= maybe handleAuthLack return
 
 -- | Similar to 'requireAuth', but not tied to Persistent's 'Entity' type.
@@ -554,15 +554,15 @@ requireAuth = maybeAuth >>= maybe handleAuthLack return
 --
 -- Since 1.4.0
 requireAuthPair :: (YesodAuthPersist master, Typeable (AuthEntity master))
-                => HandlerT master IO (AuthId master, AuthEntity master)
+                => HandlerFor master (AuthId master, AuthEntity master)
 requireAuthPair = maybeAuthPair >>= maybe handleAuthLack return
 
-handleAuthLack :: YesodAuth master => HandlerT master IO a
+handleAuthLack :: YesodAuth master => HandlerFor master a
 handleAuthLack = do
     aj <- acceptsJson
     if aj then notAuthenticated else redirectLogin
 
-redirectLogin :: YesodAuth master => HandlerT master IO a
+redirectLogin :: YesodAuth master => HandlerFor master a
 redirectLogin = do
     y <- getYesod
     when (redirectToCurrent y) setUltDestCurrent
@@ -577,7 +577,8 @@ data AuthException = InvalidFacebookResponse
     deriving (Show, Typeable)
 instance Exception AuthException
 
-instance YesodAuth master => YesodSubDispatch Auth (HandlerT master IO) where
+-- FIXME this is ugly, and I probably want to ditch the MonadSubHandler typeclass anyway
+instance (YesodAuth (HandlerSite m), MonadSubHandler m) => YesodSubDispatch Auth m where
     yesodSubDispatch = $(mkYesodSubDispatch resourcesAuth)
 
 asHtml :: Html -> Html
diff --git a/yesod-auth/Yesod/Auth/BrowserId.hs b/yesod-auth/Yesod/Auth/BrowserId.hs
index a63ed0e1..802cba03 100644
--- a/yesod-auth/Yesod/Auth/BrowserId.hs
+++ b/yesod-auth/Yesod/Auth/BrowserId.hs
@@ -70,20 +70,21 @@ authBrowserId bis@BrowserIdSettings {..} = AuthPlugin
     , apDispatch = \m ps ->
         case (m, ps) of
             ("GET", [assertion]) -> do
-                master <- lift getYesod
+                master <- getYesod
                 audience <-
                     case bisAudience of
                         Just a -> return a
                         Nothing -> do
                             r <- getUrlRender
-                            return $ T.takeWhile (/= '/') $ stripScheme $ r LoginR
-                memail <- lift $ checkAssertion audience assertion (authHttpManager master)
+                            tm <- getRouteToParent
+                            return $ T.takeWhile (/= '/') $ stripScheme $ r $ tm LoginR
+                memail <- liftHandler $ checkAssertion audience assertion (authHttpManager master)
                 case memail of
                     Nothing -> do
                       $logErrorS "yesod-auth" "BrowserID assertion failure"
                       tm <- getRouteToParent
-                      lift $ loginErrorMessage (tm LoginR) "BrowserID login error."
-                    Just email -> lift $ setCredsRedirect Creds
+                      liftHandler $ loginErrorMessage (tm LoginR) "BrowserID login error."
+                    Just email -> liftHandler $ setCredsRedirect Creds
                         { credsPlugin = pid
                         , credsIdent = email
                         , credsExtra = []
diff --git a/yesod-core/Yesod/Core/Class/Dispatch.hs b/yesod-core/Yesod/Core/Class/Dispatch.hs
index 16910ecf..7c4d6bd8 100644
--- a/yesod-core/Yesod/Core/Class/Dispatch.hs
+++ b/yesod-core/Yesod/Core/Class/Dispatch.hs
@@ -36,10 +36,8 @@ instance MonadHandler m => YesodSubDispatch WaiSubsiteWithAuth m where
       WaiSubsiteWithAuth set = ysreGetSub $ yreSite $ ysreParentEnv
       handlert = sendWaiApplication set
 
-type SubHandler child parent a = ReaderT (SubsiteData child parent) (HandlerFor parent) a
-
 data SubsiteData child parent = SubsiteData
-  { sdToParentRoute :: !(Route child -> Route parent)
+  { sdRouteToParent :: !(Route child -> Route parent)
   , sdCurrentRoute :: !(Maybe (Route child))
   , sdSubsiteData :: !child
   }
@@ -48,21 +46,21 @@ class MonadHandler m => MonadSubHandler m where
   type SubHandlerSite m
 
   getSubYesod :: m (SubHandlerSite m)
-  getToParentRoute :: m (Route (SubHandlerSite m) -> Route (HandlerSite m))
+  getRouteToParent :: m (Route (SubHandlerSite m) -> Route (HandlerSite m))
   getSubCurrentRoute :: m (Maybe (Route (SubHandlerSite m)))
 
 instance MonadSubHandler (HandlerFor site) where
   type SubHandlerSite (HandlerFor site) = site
 
   getSubYesod = getYesod
-  getToParentRoute = return id
+  getRouteToParent = return id
   getSubCurrentRoute = getCurrentRoute
 
 instance MonadSubHandler (WidgetFor site) where
   type SubHandlerSite (WidgetFor site) = site
 
   getSubYesod = getYesod
-  getToParentRoute = return id
+  getRouteToParent = return id
   getSubCurrentRoute = getCurrentRoute
 
 instance (MonadSubHandler m, parent ~ SubHandlerSite m) => MonadSubHandler (ReaderT (SubsiteData child parent) m) where
@@ -70,21 +68,23 @@ instance (MonadSubHandler m, parent ~ SubHandlerSite m) => MonadSubHandler (Read
 
   getSubYesod = fmap sdSubsiteData ask
   getSubCurrentRoute = fmap sdCurrentRoute ask
-  getToParentRoute = ReaderT $ \sd -> do
-    toParent' <- getToParentRoute
-    return $ toParent' . sdToParentRoute sd
+  getRouteToParent = ReaderT $ \sd -> do
+    toParent' <- getRouteToParent
+    return $ toParent' . sdRouteToParent sd
 
 subHelper
-  :: (ToTypedContent content, MonadSubHandler m, parent ~ HandlerSite m)
-  => ReaderT (SubsiteData child parent) m content
+  :: (ToTypedContent content, MonadSubHandler m, master ~ HandlerSite m, parent ~ SubHandlerSite m)
+  => ReaderT (SubsiteData child master) m content
   -> YesodSubRunnerEnv child parent m
   -> Maybe (Route child)
   -> W.Application
 subHelper (ReaderT f) YesodSubRunnerEnv {..} mroute =
     ysreParentRunner handler ysreParentEnv (fmap ysreToParentRoute mroute)
   where
-    handler = fmap toTypedContent $ f SubsiteData
-      { sdToParentRoute = ysreToParentRoute
-      , sdCurrentRoute = mroute
-      , sdSubsiteData = ysreGetSub $ yreSite ysreParentEnv
-      }
+    handler = fmap toTypedContent $ do
+      tm <- getRouteToParent
+      f SubsiteData
+        { sdRouteToParent = tm . ysreToParentRoute
+        , sdCurrentRoute = mroute
+        , sdSubsiteData = ysreGetSub $ yreSite ysreParentEnv
+        }
diff --git a/yesod-core/Yesod/Core/Class/Handler.hs b/yesod-core/Yesod/Core/Class/Handler.hs
index 7373d261..f32e1477 100644
--- a/yesod-core/Yesod/Core/Class/Handler.hs
+++ b/yesod-core/Yesod/Core/Class/Handler.hs
@@ -14,6 +14,7 @@ module Yesod.Core.Class.Handler
     ) where
 
 import Yesod.Core.Types
+import Control.Monad.Logger (MonadLogger)
 import Control.Monad.Trans.Resource (MonadResource)
 import Control.Monad.Trans.Class (lift)
 #if __GLASGOW_HASKELL__ < 710
@@ -35,7 +36,7 @@ import qualified Control.Monad.Trans.State.Strict  as Strict ( StateT )
 import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )
 
 -- FIXME should we just use MonadReader instances instead?
-class MonadResource m => MonadHandler m where
+class (MonadResource m, MonadLogger m) => MonadHandler m where
     type HandlerSite m
     liftHandler :: HandlerFor (HandlerSite m) a -> m a
 
diff --git a/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs b/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs
index c01af705..11d3a145 100644
--- a/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs
+++ b/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs
@@ -29,10 +29,10 @@ getBazR = liftHandler $ defaultLayout [whamlet|Used Default Layout|]
 
 getBinR :: (MonadSubHandler m, Yesod (HandlerSite m), SubHandlerSite m ~ Subsite) => m Html
 getBinR = do
-    toParentRoute <- getToParentRoute
+    routeToParent <- getRouteToParent
     liftHandler $ defaultLayout [whamlet|
         <p>Used defaultLayoutT
-        <a href=@{toParentRoute BazR}>Baz
+        <a href=@{routeToParent BazR}>Baz
     |]
 
 getOnePiecesR :: Monad m => Int -> m ()

From aed10fc84a69745f849d26fa033bae5ed9a28ec2 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 13 Dec 2017 14:39:59 +0200
Subject: [PATCH 08/43] WIP

---
 yesod-auth/Yesod/Auth.hs       | 52 ++++++++++++++++++++--------------
 yesod-auth/Yesod/Auth/Dummy.hs |  7 +++--
 yesod-auth/Yesod/Auth/Email.hs | 36 +++++++++++------------
 yesod-auth/yesod-auth.cabal    |  2 ++
 yesod-core/Yesod/Core.hs       |  1 +
 5 files changed, 55 insertions(+), 43 deletions(-)

diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs
index c5b1c163..8c2a4f4c 100644
--- a/yesod-auth/Yesod/Auth.hs
+++ b/yesod-auth/Yesod/Auth.hs
@@ -47,9 +47,10 @@ module Yesod.Auth
     , asHtml
     ) where
 
-import           Control.Applicative ((<$>))
 import Control.Monad                 (when)
 import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Reader    (ReaderT)
+import Control.Monad.IO.Unlift       (withRunInIO)
 
 import Yesod.Auth.Routes
 import Data.Aeson hiding (json)
@@ -60,11 +61,11 @@ import qualified Data.Text as T
 import qualified Data.HashMap.Lazy as Map
 import Data.Monoid (Endo)
 import Network.HTTP.Client (Manager, Request, withResponse, Response, BodyReader)
+import Network.HTTP.Client.TLS (getGlobalManager)
 
 import qualified Network.Wai as W
 
 import Yesod.Core
-import Yesod.Core.Types (HandlerFor(..))
 import Yesod.Persist
 import Yesod.Auth.Message (AuthMessage, defaultMessage)
 import qualified Yesod.Auth.Message as Msg
@@ -110,8 +111,8 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     type AuthId master
 
     -- | specify the layout. Uses defaultLayout by default
-    authLayout :: WidgetFor master () -> HandlerFor master Html
-    authLayout = defaultLayout
+    authLayout :: WidgetFor master () -> AuthHandler master Html
+    authLayout = liftHandler . defaultLayout
 
     -- | Default destination on successful login, if no other
     -- destination exists.
@@ -126,7 +127,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     -- Default implementation is in terms of @'getAuthId'@
     --
     -- Since: 1.4.4
-    authenticate :: Creds master -> HandlerFor master (AuthenticationResult master)
+    authenticate :: Creds master -> AuthHandler master (AuthenticationResult master)
     authenticate creds = do
         muid <- getAuthId creds
 
@@ -136,7 +137,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     --
     -- Default implementation is in terms of @'authenticate'@
     --
-    getAuthId :: Creds master -> HandlerFor master (Maybe (AuthId master))
+    getAuthId :: Creds master -> AuthHandler master (Maybe (AuthId master))
     getAuthId creds = do
         auth <- authenticate creds
 
@@ -191,15 +192,16 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     -- type. This allows backends to reuse persistent connections. If none of
     -- the backends you're using use HTTP connections, you can safely return
     -- @error \"authHttpManager\"@ here.
-    authHttpManager :: master -> Manager
+    authHttpManager :: master -> IO Manager
+    authHttpManager _ = getGlobalManager
 
     -- | Called on a successful login. By default, calls
     -- @addMessageI "success" NowLoggedIn@.
-    onLogin :: HandlerFor master ()
+    onLogin :: AuthHandler master ()
     onLogin = addMessageI "success" Msg.NowLoggedIn
 
     -- | Called on logout. By default, does nothing
-    onLogout :: HandlerFor master ()
+    onLogout :: AuthHandler master ()
     onLogout = return ()
 
     -- | Retrieves user credentials, if user is authenticated.
@@ -211,16 +213,16 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     -- other than a browser.
     --
     -- Since 1.2.0
-    maybeAuthId :: HandlerFor master (Maybe (AuthId master))
+    maybeAuthId :: AuthHandler master (Maybe (AuthId master))
 
     default maybeAuthId
         :: (YesodAuthPersist master, Typeable (AuthEntity master))
-        => HandlerFor master (Maybe (AuthId master))
+        => AuthHandler master (Maybe (AuthId master))
     maybeAuthId = defaultMaybeAuthId
 
     -- | Called on login error for HTTP requests. By default, calls
     -- @addMessage@ with "error" as status and redirects to @dest@.
-    onErrorHtml :: Route master -> Text -> HandlerFor master Html
+    onErrorHtml :: Route master -> Text -> AuthHandler master Html
     onErrorHtml dest msg = do
         addMessage "error" $ toHtml msg
         fmap asHtml $ redirect dest
@@ -230,10 +232,13 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     --
     --  The HTTP 'Request' is given in case it is useful to change behavior based on inspecting the request.
     --  This is an experimental API that is not broadly used throughout the yesod-auth code base
-    runHttpRequest :: Request -> (Response BodyReader -> HandlerFor master a) -> HandlerFor master a
+    runHttpRequest :: (MonadSubHandler m, HandlerSite m ~ master, SubHandlerSite m ~ Auth)
+                   => Request
+                   -> (Response BodyReader -> ReaderT (SubsiteData Auth master) (HandlerFor master) a)
+                   -> m a
     runHttpRequest req inner = do
-      man <- authHttpManager Control.Applicative.<$> getYesod
-      HandlerFor $ \t -> withResponse req man $ \res -> unHandlerFor (inner res) t
+      man <- getYesod >>= liftIO . authHttpManager
+      lift $ withRunInIO $ \run -> withResponse req man $ run . inner
 
     {-# MINIMAL loginDest, logoutDest, (authenticate | getAuthId), authPlugins, authHttpManager #-}
 
@@ -254,7 +259,7 @@ credsKey = "_ID"
 -- Since 1.1.2
 defaultMaybeAuthId
     :: (YesodAuthPersist master, Typeable (AuthEntity master))
-    => HandlerFor master (Maybe (AuthId master))
+    => AuthHandler master (Maybe (AuthId master))
 defaultMaybeAuthId = runMaybeT $ do
     s   <- MaybeT $ lookupSession credsKey
     aid <- MaybeT $ return $ fromPathPiece s
@@ -263,7 +268,7 @@ defaultMaybeAuthId = runMaybeT $ do
 
 cachedAuth
     :: (YesodAuthPersist master, Typeable (AuthEntity master))
-    => AuthId master -> HandlerFor master (Maybe (AuthEntity master))
+    => AuthId master -> AuthHandler master (Maybe (AuthEntity master))
 cachedAuth
     = fmap unCachedMaybeAuth
     . cached
@@ -298,7 +303,7 @@ loginErrorMessageI dest msg = do
 loginErrorMessageMasterI :: (YesodAuth master, RenderMessage master AuthMessage)
          => Route master
          -> AuthMessage
-         -> HandlerFor master TypedContent
+         -> AuthHandler master TypedContent
 loginErrorMessageMasterI dest msg = do
   mr <- getMessageRender
   loginErrorMessage dest (mr msg)
@@ -308,10 +313,13 @@ loginErrorMessageMasterI dest msg = do
 loginErrorMessage :: YesodAuth master
          => Route master
          -> Text
-         -> HandlerFor master TypedContent
+         -> AuthHandler master TypedContent
 loginErrorMessage dest msg = messageJson401 msg (onErrorHtml dest msg)
 
-messageJson401 :: Text -> HandlerFor master Html -> HandlerFor master TypedContent
+messageJson401 :: (MonadSubHandler m, HandlerSite m ~ master, SubHandlerSite m ~ Auth)
+               => Text
+               -> m Html
+               -> m TypedContent
 messageJson401 = messageJsonStatus unauthorized401
 
 messageJson500 :: Text -> HandlerFor master Html -> HandlerFor master TypedContent
@@ -577,8 +585,8 @@ data AuthException = InvalidFacebookResponse
     deriving (Show, Typeable)
 instance Exception AuthException
 
--- FIXME this is ugly, and I probably want to ditch the MonadSubHandler typeclass anyway
-instance (YesodAuth (HandlerSite m), MonadSubHandler m) => YesodSubDispatch Auth m where
+-- FIXME HandlerSite m ~ SubHandlerSite m should be unnecessary
+instance (YesodAuth (HandlerSite m), HandlerSite m ~ SubHandlerSite m, MonadSubHandler m) => YesodSubDispatch Auth m where
     yesodSubDispatch = $(mkYesodSubDispatch resourcesAuth)
 
 asHtml :: Html -> Html
diff --git a/yesod-auth/Yesod/Auth/Dummy.hs b/yesod-auth/Yesod/Auth/Dummy.hs
index 9e4611d6..4899f99d 100644
--- a/yesod-auth/Yesod/Auth/Dummy.hs
+++ b/yesod-auth/Yesod/Auth/Dummy.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
 -- | Provides a dummy authentication module that simply lets a user specify
 -- his/her identifier. This is not intended for real world use, just for
 -- testing.
@@ -15,9 +16,9 @@ authDummy :: YesodAuth m => AuthPlugin m
 authDummy =
     AuthPlugin "dummy" dispatch login
   where
-    dispatch "POST" [] = do
-        ident <- lift $ runInputPost $ ireq textField "ident"
-        lift $ setCredsRedirect $ Creds "dummy" ident []
+    dispatch "POST" [] = liftHandler $ do
+        ident <- runInputPost $ ireq textField "ident"
+        setCredsRedirect $ Creds "dummy" ident []
     dispatch _ _ = notFound
     url = PluginR "dummy" []
     login authToMaster = do
diff --git a/yesod-auth/Yesod/Auth/Email.hs b/yesod-auth/Yesod/Auth/Email.hs
index 51cbea7c..60b65fb7 100644
--- a/yesod-auth/Yesod/Auth/Email.hs
+++ b/yesod-auth/Yesod/Auth/Email.hs
@@ -325,7 +325,7 @@ class ( YesodAuth site
     -- Default: 'defaultRegisterHandler'.
     --
     -- @since: 1.2.6
-    registerHandler :: HandlerT Auth (HandlerT site IO) Html
+    registerHandler :: AuthHandler site Html
     registerHandler = defaultRegisterHandler
 
     -- | Handler called to render the \"forgot password\" page.
@@ -335,7 +335,7 @@ class ( YesodAuth site
     -- Default: 'defaultForgotPasswordHandler'.
     --
     -- @since: 1.2.6
-    forgotPasswordHandler :: HandlerT Auth (HandlerT site IO) Html
+    forgotPasswordHandler :: AuthHandler site Html
     forgotPasswordHandler = defaultForgotPasswordHandler
 
     -- | Handler called to render the \"set password\" page.  The
@@ -351,7 +351,7 @@ class ( YesodAuth site
          -- field for the old password should be presented.
          -- Otherwise, just two fields for the new password are
          -- needed.
-      -> HandlerT Auth (HandlerT site IO) TypedContent
+      -> AuthHandler site TypedContent
     setPasswordHandler = defaultSetPasswordHandler
 
 authEmail :: (YesodAuthEmail m) => AuthPlugin m
@@ -371,7 +371,7 @@ authEmail =
     dispatch "POST" ["set-password"] = postPasswordR >>= sendResponse
     dispatch _ _ = notFound
 
-getRegisterR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html
+getRegisterR :: YesodAuthEmail master => AuthHandler master Html
 getRegisterR = registerHandler
 
 -- | Default implementation of 'emailLoginHandler'.
@@ -437,7 +437,7 @@ defaultEmailLoginHandler toParent = do
 -- | Default implementation of 'registerHandler'.
 --
 -- @since 1.2.6
-defaultRegisterHandler :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html
+defaultRegisterHandler :: YesodAuthEmail master => AuthHandler master Html
 defaultRegisterHandler = do
     (widget, enctype) <- lift $ generateFormPost registrationForm
     toParentRoute <- getRouteToParent
@@ -480,7 +480,7 @@ parseEmail = withObject "email" (\obj -> do
 registerHelper :: YesodAuthEmail master
                => Bool -- ^ allow usernames?
                -> Route Auth
-               -> HandlerT Auth (HandlerT master IO) TypedContent
+               -> AuthHandler master TypedContent
 registerHelper allowUsername dest = do
     y <- lift getYesod
     checkCsrfHeaderOrParam defaultCsrfHeaderName defaultCsrfParamName
@@ -525,16 +525,16 @@ registerHelper allowUsername dest = do
                     lift $ sendVerifyEmail email verKey verUrl
                     lift $ confirmationEmailSentResponse identifier
 
-postRegisterR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) TypedContent
+postRegisterR :: YesodAuthEmail master => AuthHandler master TypedContent
 postRegisterR = registerHelper False registerR
 
-getForgotPasswordR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html
+getForgotPasswordR :: YesodAuthEmail master => AuthHandler master Html
 getForgotPasswordR = forgotPasswordHandler
 
 -- | Default implementation of 'forgotPasswordHandler'.
 --
 -- @since 1.2.6
-defaultForgotPasswordHandler :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html
+defaultForgotPasswordHandler :: YesodAuthEmail master => AuthHandler master Html
 defaultForgotPasswordHandler = do
     (widget, enctype) <- lift $ generateFormPost forgotPasswordForm
     toParent <- getRouteToParent
@@ -569,13 +569,13 @@ defaultForgotPasswordHandler = do
             fsAttrs = [("autofocus", "")]
         }
 
-postForgotPasswordR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) TypedContent
+postForgotPasswordR :: YesodAuthEmail master => AuthHandler master TypedContent
 postForgotPasswordR = registerHelper True forgotPasswordR
 
 getVerifyR :: YesodAuthEmail site
            => AuthEmailId site
            -> Text
-           -> HandlerT Auth (HandlerT site IO) TypedContent
+           -> AuthHandler site TypedContent
 getVerifyR lid key = do
     realKey <- lift $ getVerifyKey lid
     memail <- lift $ getEmail lid
@@ -612,7 +612,7 @@ parseCreds = withObject "creds" (\obj -> do
                                    return (email', pass))
 
 
-postLoginR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) TypedContent
+postLoginR :: YesodAuthEmail master => AuthHandler master TypedContent
 postLoginR = do
     result <- lift $ runInputPostResult $ (,)
         <$> ireq textField "email"
@@ -658,7 +658,7 @@ postLoginR = do
                                    then Msg.InvalidEmailPass
                                    else Msg.InvalidUsernamePass
 
-getPasswordR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) TypedContent
+getPasswordR :: YesodAuthEmail master => AuthHandler master TypedContent
 getPasswordR = do
     maid <- lift maybeAuthId
     case maid of
@@ -670,7 +670,7 @@ getPasswordR = do
 -- | Default implementation of 'setPasswordHandler'.
 --
 -- @since 1.2.6
-defaultSetPasswordHandler :: YesodAuthEmail master => Bool -> HandlerT Auth (HandlerT master IO) TypedContent
+defaultSetPasswordHandler :: YesodAuthEmail master => Bool -> AuthHandler master TypedContent
 defaultSetPasswordHandler needOld = do
     messageRender <- lift getMessageRender
     toParent <- getRouteToParent
@@ -749,7 +749,7 @@ parsePassword = withObject "password" (\obj -> do
                                          curr <- obj .:? "current"
                                          return (email', pass, curr))
 
-postPasswordR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) TypedContent
+postPasswordR :: YesodAuthEmail master => AuthHandler master TypedContent
 postPasswordR = do
     maid <- lift maybeAuthId
     (creds :: Result Value) <- lift parseCheckJsonBody
@@ -773,14 +773,14 @@ postPasswordR = do
                 mrealpass <- lift $ getPassword aid
                 case (mrealpass, current) of
                     (Nothing, _) ->
-                        lift $ loginErrorMessage (tm setpassR) "You do not currently have a password set on your account"
+                        liftHandler $ loginErrorMessage (tm setpassR) "You do not currently have a password set on your account"
                     (_, Nothing) ->
                         loginErrorMessageI LoginR Msg.BadSetPass
                     (Just realpass, Just current') -> do
-                        passValid <- lift $ verifyPassword current' realpass
+                        passValid <- liftHandler $ verifyPassword current' realpass
                         if passValid
                           then confirmPassword aid tm jcreds
-                          else lift $ loginErrorMessage (tm setpassR) "Invalid current password, please try again"
+                          else liftHandler $ loginErrorMessage (tm setpassR) "Invalid current password, please try again"
 
   where
     msgOk = Msg.PassUpdated
diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal
index 1de994a2..2adcfa49 100644
--- a/yesod-auth/yesod-auth.cabal
+++ b/yesod-auth/yesod-auth.cabal
@@ -41,6 +41,7 @@ library
                    , persistent              >= 2.1       && < 2.8
                    , persistent-template     >= 2.1       && < 2.8
                    , http-client
+                   , http-client-tls
                    , http-conduit            >= 2.1
                    , aeson                   >= 0.7
                    , lifted-base             >= 0.1
@@ -61,6 +62,7 @@ library
                    , conduit
                    , conduit-extra
                    , nonce                   >= 1.0.2     && < 1.1
+                   , unliftio-core
 
     if flag(network-uri)
       build-depends: network-uri >= 2.6
diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs
index d13d5cf4..fdcb7c43 100644
--- a/yesod-core/Yesod/Core.hs
+++ b/yesod-core/Yesod/Core.hs
@@ -76,6 +76,7 @@ module Yesod.Core
     , getApprootText
       -- * Subsites
     , MonadSubHandler (..)
+    , SubsiteData
       -- * Misc
     , yesodVersion
     , yesodRender

From 8e265f6ebc500d2eff2169ea0727c0dbb8b23404 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 18 Dec 2017 15:04:45 +0200
Subject: [PATCH 09/43] It all compiles

---
 yesod-auth-oauth/Yesod/Auth/OAuth.hs    |  33 ++++--
 yesod-auth-oauth/yesod-auth-oauth.cabal |   1 +
 yesod-auth/Yesod/Auth.hs                | 140 ++++++++++++------------
 yesod-auth/Yesod/Auth/BrowserId.hs      |  12 +-
 yesod-auth/Yesod/Auth/Dummy.hs          |   3 +-
 yesod-auth/Yesod/Auth/Email.hs          | 133 +++++++++++-----------
 yesod-auth/Yesod/Auth/GoogleEmail.hs    |  89 ---------------
 yesod-auth/Yesod/Auth/GoogleEmail2.hs   |  43 +++-----
 yesod-auth/Yesod/Auth/Hardcoded.hs      |  23 ++--
 yesod-auth/Yesod/Auth/OpenId.hs         |  26 +++--
 yesod-auth/Yesod/Auth/Rpxnow.hs         |  14 ++-
 yesod-auth/yesod-auth.cabal             |   5 +-
 yesod-static/Yesod/Static.hs            |   7 +-
 13 files changed, 228 insertions(+), 301 deletions(-)
 delete mode 100644 yesod-auth/Yesod/Auth/GoogleEmail.hs

diff --git a/yesod-auth-oauth/Yesod/Auth/OAuth.hs b/yesod-auth-oauth/Yesod/Auth/OAuth.hs
index 9a5d3a0e..6e723c08 100644
--- a/yesod-auth-oauth/Yesod/Auth/OAuth.hs
+++ b/yesod-auth-oauth/Yesod/Auth/OAuth.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE DeriveDataTypeable, OverloadedStrings, QuasiQuotes #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Yesod.Auth.OAuth
     ( authOAuth
     , oauthUrl
@@ -14,6 +17,7 @@ import           Control.Applicative      as A ((<$>), (<*>))
 import           Control.Arrow            ((***))
 import           Control.Exception.Lifted
 import           Control.Monad.IO.Class
+import           Control.Monad.IO.Unlift  (MonadUnliftIO)
 import           Data.ByteString          (ByteString)
 import           Data.Maybe
 import           Data.Text                (Text)
@@ -35,26 +39,37 @@ instance Exception YesodOAuthException
 oauthUrl :: Text -> AuthRoute
 oauthUrl name = PluginR name ["forward"]
 
-authOAuth :: YesodAuth m
+authOAuth :: forall master. YesodAuth master
           => OAuth                        -- ^ 'OAuth' data-type for signing.
-          -> (Credential -> IO (Creds m)) -- ^ How to extract ident.
-          -> AuthPlugin m
+          -> (Credential -> IO (Creds master)) -- ^ How to extract ident.
+          -> AuthPlugin master
 authOAuth oauth mkCreds = AuthPlugin name dispatch login
   where
     name = T.pack $ oauthServerName oauth
     url = PluginR name []
     lookupTokenSecret = bsToText . fromMaybe "" . lookup "oauth_token_secret" . unCredential
+
+    oauthSessionName :: Text
     oauthSessionName = "__oauth_token_secret"
 
+    dispatch
+      :: ( MonadSubHandler m
+         , master ~ HandlerSite m
+         , Auth ~ SubHandlerSite m
+         , MonadUnliftIO m
+         )
+      => Text
+      -> [Text]
+      -> m TypedContent
     dispatch "GET" ["forward"] = do
-        render <- lift getUrlRender
+        render <- getUrlRender
         tm <- getRouteToParent
         let oauth' = oauth { oauthCallback = Just $ encodeUtf8 $ render $ tm url }
-        master <- lift getYesod
-        tok <- lift $ getTemporaryCredential oauth' (authHttpManager master)
+        manager <- authHttpManager
+        tok <- getTemporaryCredential oauth' manager
         setSession oauthSessionName $ lookupTokenSecret tok
         redirect $ authorizeUrl oauth' tok
-    dispatch "GET" [] = lift $ do
+    dispatch "GET" [] = do
       Just tokSec <- lookupSession oauthSessionName
       deleteSession oauthSessionName
       reqTok <-
@@ -72,8 +87,8 @@ authOAuth oauth mkCreds = AuthPlugin name dispatch login
                                 , ("oauth_token", encodeUtf8 oaTok)
                                 , ("oauth_token_secret", encodeUtf8 tokSec)
                                 ]
-      master <- getYesod
-      accTok <- getAccessToken oauth reqTok (authHttpManager master)
+      manager <- authHttpManager
+      accTok <- getAccessToken oauth reqTok manager
       creds  <- liftIO $ mkCreds accTok
       setCredsRedirect creds
     dispatch _ _ = notFound
diff --git a/yesod-auth-oauth/yesod-auth-oauth.cabal b/yesod-auth-oauth/yesod-auth-oauth.cabal
index c21ac9e1..7c9c55a5 100644
--- a/yesod-auth-oauth/yesod-auth-oauth.cabal
+++ b/yesod-auth-oauth/yesod-auth-oauth.cabal
@@ -29,6 +29,7 @@ library
                    , yesod-form              >= 1.4       && < 1.5
                    , transformers            >= 0.2.2     && < 0.6
                    , lifted-base             >= 0.2       && < 0.3
+                   , unliftio-core
     exposed-modules: Yesod.Auth.OAuth
     ghc-options:     -Wall
 
diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs
index 8c2a4f4c..c5d137e8 100644
--- a/yesod-auth/Yesod/Auth.hs
+++ b/yesod-auth/Yesod/Auth.hs
@@ -39,6 +39,7 @@ module Yesod.Auth
       -- * Exception
     , AuthException (..)
       -- * Helper
+    , MonadAuthHandler
     , AuthHandler
       -- * Internal
     , credsKey
@@ -49,8 +50,7 @@ module Yesod.Auth
 
 import Control.Monad                 (when)
 import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.Reader    (ReaderT)
-import Control.Monad.IO.Unlift       (withRunInIO)
+import Control.Monad.IO.Unlift       (withRunInIO, MonadUnliftIO)
 
 import Yesod.Auth.Routes
 import Data.Aeson hiding (json)
@@ -78,7 +78,8 @@ import Control.Monad (void)
 
 type AuthRoute = Route Auth
 
-type AuthHandler master a = forall m. (MonadSubHandler m, YesodAuth master, master ~ HandlerSite m, Auth ~ SubHandlerSite m) => m a
+type MonadAuthHandler master m = (MonadSubHandler m, YesodAuth master, master ~ HandlerSite m, Auth ~ SubHandlerSite m, MonadUnliftIO m)
+type AuthHandler master a = forall m. MonadAuthHandler master m => m a
 
 type Method = Text
 type Piece = Text
@@ -192,8 +193,8 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     -- type. This allows backends to reuse persistent connections. If none of
     -- the backends you're using use HTTP connections, you can safely return
     -- @error \"authHttpManager\"@ here.
-    authHttpManager :: master -> IO Manager
-    authHttpManager _ = getGlobalManager
+    authHttpManager :: AuthHandler master Manager
+    authHttpManager = liftIO getGlobalManager
 
     -- | Called on a successful login. By default, calls
     -- @addMessageI "success" NowLoggedIn@.
@@ -232,13 +233,14 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     --
     --  The HTTP 'Request' is given in case it is useful to change behavior based on inspecting the request.
     --  This is an experimental API that is not broadly used throughout the yesod-auth code base
-    runHttpRequest :: (MonadSubHandler m, HandlerSite m ~ master, SubHandlerSite m ~ Auth)
-                   => Request
-                   -> (Response BodyReader -> ReaderT (SubsiteData Auth master) (HandlerFor master) a)
-                   -> m a
+    runHttpRequest
+      :: MonadAuthHandler master m
+      => Request
+      -> (Response BodyReader -> m a)
+      -> m a
     runHttpRequest req inner = do
-      man <- getYesod >>= liftIO . authHttpManager
-      lift $ withRunInIO $ \run -> withResponse req man $ run . inner
+      man <- authHttpManager
+      withRunInIO $ \run -> withResponse req man $ run . inner
 
     {-# MINIMAL loginDest, logoutDest, (authenticate | getAuthId), authPlugins, authHttpManager #-}
 
@@ -268,7 +270,8 @@ defaultMaybeAuthId = runMaybeT $ do
 
 cachedAuth
     :: (YesodAuthPersist master, Typeable (AuthEntity master))
-    => AuthId master -> AuthHandler master (Maybe (AuthEntity master))
+    => AuthId master
+    -> AuthHandler master (Maybe (AuthEntity master))
 cachedAuth
     = fmap unCachedMaybeAuth
     . cached
@@ -285,25 +288,25 @@ cachedAuth
 defaultLoginHandler :: AuthHandler master Html
 defaultLoginHandler = do
     tp <- getRouteToParent
-    liftHandler $ authLayout $ do
+    authLayout $ do
         setTitleI Msg.LoginTitle
         master <- getYesod
         mapM_ (flip apLogin tp) (authPlugins master)
 
 
-loginErrorMessageI :: (YesodAuth (HandlerSite m), MonadSubHandler m)
-                   => Route (SubHandlerSite m)
-                   -> AuthMessage
-                   -> m TypedContent
+loginErrorMessageI
+  :: Route Auth
+  -> AuthMessage
+  -> AuthHandler master TypedContent
 loginErrorMessageI dest msg = do
   toParent <- getRouteToParent
-  liftHandler $ loginErrorMessageMasterI (toParent dest) msg
+  loginErrorMessageMasterI (toParent dest) msg
 
 
-loginErrorMessageMasterI :: (YesodAuth master, RenderMessage master AuthMessage)
-         => Route master
-         -> AuthMessage
-         -> AuthHandler master TypedContent
+loginErrorMessageMasterI
+  :: Route master
+  -> AuthMessage
+  -> AuthHandler master TypedContent
 loginErrorMessageMasterI dest msg = do
   mr <- getMessageRender
   loginErrorMessage dest (mr msg)
@@ -316,19 +319,22 @@ loginErrorMessage :: YesodAuth master
          -> AuthHandler master TypedContent
 loginErrorMessage dest msg = messageJson401 msg (onErrorHtml dest msg)
 
-messageJson401 :: (MonadSubHandler m, HandlerSite m ~ master, SubHandlerSite m ~ Auth)
-               => Text
-               -> m Html
-               -> m TypedContent
+messageJson401
+  :: MonadAuthHandler master m
+  => Text
+  -> m Html
+  -> m TypedContent
 messageJson401 = messageJsonStatus unauthorized401
 
-messageJson500 :: Text -> HandlerFor master Html -> HandlerFor master TypedContent
+messageJson500 :: MonadAuthHandler master m => Text -> m Html -> m TypedContent
 messageJson500 = messageJsonStatus internalServerError500
 
-messageJsonStatus :: Status
-                  -> Text
-                  -> HandlerFor master Html
-                  -> HandlerFor master TypedContent
+messageJsonStatus
+  :: MonadAuthHandler master m
+  => Status
+  -> Text
+  -> m Html
+  -> m TypedContent
 messageJsonStatus status msg html = selectRep $ do
     provideRep html
     provideRep $ do
@@ -340,9 +346,9 @@ provideJsonMessage :: Monad m => Text -> Writer.Writer (Endo [ProvidedRep m]) ()
 provideJsonMessage msg = provideRep $ return $ object ["message" .= msg]
 
 
-setCredsRedirect :: YesodAuth master
-         => Creds master -- ^ new credentials
-         -> HandlerFor master TypedContent
+setCredsRedirect
+  :: Creds master -- ^ new credentials
+  -> AuthHandler master TypedContent
 setCredsRedirect creds = do
     y    <- getYesod
     auth <- authenticate creds
@@ -381,10 +387,9 @@ setCredsRedirect creds = do
         return $ renderAuthMessage master langs msg
 
 -- | Sets user credentials for the session after checking them with authentication backends.
-setCreds :: YesodAuth master
-         => Bool         -- ^ if HTTP redirects should be done
+setCreds :: Bool         -- ^ if HTTP redirects should be done
          -> Creds master -- ^ new credentials
-         -> HandlerFor master ()
+         -> AuthHandler master ()
 setCreds doRedirects creds =
     if doRedirects
       then void $ setCredsRedirect creds
@@ -394,10 +399,11 @@ setCreds doRedirects creds =
                   _ -> return ()
 
 -- | same as defaultLayoutJson, but uses authLayout
-authLayoutJson :: (YesodAuth site, ToJSON j)
-                  => WidgetFor site ()  -- ^ HTML
-                  -> HandlerFor site j  -- ^ JSON
-                  -> HandlerFor site TypedContent
+authLayoutJson
+  :: (ToJSON j, MonadAuthHandler master m)
+  => WidgetFor master ()  -- ^ HTML
+  -> m j  -- ^ JSON
+  -> m TypedContent
 authLayoutJson w json = selectRep $ do
     provideRep $ authLayout w
     provideRep $ fmap toJSON json
@@ -405,18 +411,17 @@ authLayoutJson w json = selectRep $ do
 -- | Clears current user credentials for the session.
 --
 -- Since 1.1.7
-clearCreds :: (MonadHandler m, YesodAuth (HandlerSite m))
-           => Bool -- ^ if HTTP redirect to 'logoutDest' should be done
-           -> m ()
+clearCreds :: Bool -- ^ if HTTP redirect to 'logoutDest' should be done
+           -> AuthHandler master ()
 clearCreds doRedirects = do
     y <- getYesod
-    liftHandler onLogout
+    onLogout
     deleteSession credsKey
     when doRedirects $ do
         redirectUltDest $ logoutDest y
 
 getCheckR :: AuthHandler master TypedContent
-getCheckR = liftHandler $ do
+getCheckR = do
     creds <- maybeAuthId
     authLayoutJson (do
         setTitle "Authentication Status"
@@ -437,7 +442,7 @@ $nothing
             ]
 
 setUltDestReferer' :: AuthHandler master ()
-setUltDestReferer' = liftHandler $ do
+setUltDestReferer' = do
     master <- getYesod
     when (redirectToReferer master) setUltDestReferer
 
@@ -471,17 +476,16 @@ maybeAuth :: ( YesodAuthPersist master
              , Key val ~ AuthId master
              , PersistEntity val
              , Typeable val
-             ) => HandlerFor master (Maybe (Entity val))
-maybeAuth = runMaybeT $ do
-    (aid, ae) <- MaybeT maybeAuthPair
-    return $ Entity aid ae
+             ) => AuthHandler master (Maybe (Entity val))
+maybeAuth = fmap (fmap (uncurry Entity)) maybeAuthPair
 
 -- | Similar to 'maybeAuth', but doesn’t assume that you are using a
 -- Persistent database.
 --
 -- Since 1.4.0
-maybeAuthPair :: (YesodAuthPersist master, Typeable (AuthEntity master))
-              => HandlerFor master (Maybe (AuthId master, AuthEntity master))
+maybeAuthPair
+  :: (YesodAuthPersist master, Typeable (AuthEntity master))
+  => AuthHandler master (Maybe (AuthId master, AuthEntity master))
 maybeAuthPair = runMaybeT $ do
     aid <- MaybeT maybeAuthId
     ae  <- MaybeT $ cachedAuth aid
@@ -512,9 +516,8 @@ class (YesodAuth master, YesodPersist master) => YesodAuthPersist master where
     type AuthEntity master :: *
     type AuthEntity master = KeyEntity (AuthId master)
 
-    getAuthEntity :: AuthId master -> HandlerFor master (Maybe (AuthEntity master))
+    getAuthEntity :: AuthId master -> AuthHandler master (Maybe (AuthEntity master))
 
-#if MIN_VERSION_persistent(2,5,0)
     default getAuthEntity
         :: ( YesodPersistBackend master ~ backend
            , PersistRecordBackend (AuthEntity master) backend
@@ -522,16 +525,6 @@ class (YesodAuth master, YesodPersist master) => YesodAuthPersist master where
            , PersistStore backend
            )
         => AuthId master -> HandlerFor master (Maybe (AuthEntity master))
-#else
-    default getAuthEntity
-        :: ( YesodPersistBackend master
-               ~ PersistEntityBackend (AuthEntity master)
-           , Key (AuthEntity master) ~ AuthId master
-           , PersistStore (YesodPersistBackend master)
-           , PersistEntity (AuthEntity master)
-           )
-        => AuthId master -> HandlerFor master (Maybe (AuthEntity master))
-#endif
     getAuthEntity = runDB . get
 
 
@@ -542,7 +535,7 @@ type instance KeyEntity (Key x) = x
 -- authenticated or responds with error 401 if this is an API client (expecting JSON).
 --
 -- Since 1.1.0
-requireAuthId :: YesodAuth master => HandlerFor master (AuthId master)
+requireAuthId :: AuthHandler master (AuthId master)
 requireAuthId = maybeAuthId >>= maybe handleAuthLack return
 
 -- | Similar to 'maybeAuth', but redirects to a login page if user is not
@@ -554,23 +547,26 @@ requireAuth :: ( YesodAuthPersist master
                , Key val ~ AuthId master
                , PersistEntity val
                , Typeable val
-               ) => HandlerFor master (Entity val)
+               ) => AuthHandler master (Entity val)
 requireAuth = maybeAuth >>= maybe handleAuthLack return
 
 -- | Similar to 'requireAuth', but not tied to Persistent's 'Entity' type.
 -- Instead, the 'AuthId' and 'AuthEntity' are returned in a tuple.
 --
 -- Since 1.4.0
-requireAuthPair :: (YesodAuthPersist master, Typeable (AuthEntity master))
-                => HandlerFor master (AuthId master, AuthEntity master)
+requireAuthPair
+  :: ( YesodAuthPersist master
+     , Typeable (AuthEntity master)
+     )
+  => AuthHandler master (AuthId master, AuthEntity master)
 requireAuthPair = maybeAuthPair >>= maybe handleAuthLack return
 
-handleAuthLack :: YesodAuth master => HandlerFor master a
+handleAuthLack :: AuthHandler master a
 handleAuthLack = do
     aj <- acceptsJson
     if aj then notAuthenticated else redirectLogin
 
-redirectLogin :: YesodAuth master => HandlerFor master a
+redirectLogin :: AuthHandler master a
 redirectLogin = do
     y <- getYesod
     when (redirectToCurrent y) setUltDestCurrent
@@ -586,7 +582,7 @@ data AuthException = InvalidFacebookResponse
 instance Exception AuthException
 
 -- FIXME HandlerSite m ~ SubHandlerSite m should be unnecessary
-instance (YesodAuth (HandlerSite m), HandlerSite m ~ SubHandlerSite m, MonadSubHandler m) => YesodSubDispatch Auth m where
+instance (YesodAuth (HandlerSite m), HandlerSite m ~ SubHandlerSite m, MonadSubHandler m, MonadUnliftIO m) => YesodSubDispatch Auth m where
     yesodSubDispatch = $(mkYesodSubDispatch resourcesAuth)
 
 asHtml :: Html -> Html
diff --git a/yesod-auth/Yesod/Auth/BrowserId.hs b/yesod-auth/Yesod/Auth/BrowserId.hs
index 802cba03..87dce2dc 100644
--- a/yesod-auth/Yesod/Auth/BrowserId.hs
+++ b/yesod-auth/Yesod/Auth/BrowserId.hs
@@ -70,7 +70,6 @@ authBrowserId bis@BrowserIdSettings {..} = AuthPlugin
     , apDispatch = \m ps ->
         case (m, ps) of
             ("GET", [assertion]) -> do
-                master <- getYesod
                 audience <-
                     case bisAudience of
                         Just a -> return a
@@ -78,13 +77,14 @@ authBrowserId bis@BrowserIdSettings {..} = AuthPlugin
                             r <- getUrlRender
                             tm <- getRouteToParent
                             return $ T.takeWhile (/= '/') $ stripScheme $ r $ tm LoginR
-                memail <- liftHandler $ checkAssertion audience assertion (authHttpManager master)
+                manager <- authHttpManager
+                memail <- liftResourceT $ checkAssertion audience assertion manager
                 case memail of
                     Nothing -> do
                       $logErrorS "yesod-auth" "BrowserID assertion failure"
                       tm <- getRouteToParent
-                      liftHandler $ loginErrorMessage (tm LoginR) "BrowserID login error."
-                    Just email -> liftHandler $ setCredsRedirect Creds
+                      loginErrorMessage (tm LoginR) "BrowserID login error."
+                    Just email -> setCredsRedirect Creds
                         { credsPlugin = pid
                         , credsIdent = email
                         , credsExtra = []
@@ -117,7 +117,7 @@ $newline never
 createOnClickOverride :: BrowserIdSettings
               -> (Route Auth -> Route master)
               -> Maybe (Route master)
-              -> WidgetT master IO Text
+              -> WidgetFor master Text
 createOnClickOverride BrowserIdSettings {..} toMaster mOnRegistration = do
     unless bisLazyLoad $ addScriptRemote browserIdJs
     onclick <- newIdent
@@ -166,5 +166,5 @@ createOnClickOverride BrowserIdSettings {..} toMaster mOnRegistration = do
 -- name.
 createOnClick :: BrowserIdSettings
               -> (Route Auth -> Route master)
-              -> WidgetT master IO Text
+              -> WidgetFor master Text
 createOnClick bidSettings toMaster = createOnClickOverride bidSettings toMaster Nothing
diff --git a/yesod-auth/Yesod/Auth/Dummy.hs b/yesod-auth/Yesod/Auth/Dummy.hs
index 4899f99d..721d6311 100644
--- a/yesod-auth/Yesod/Auth/Dummy.hs
+++ b/yesod-auth/Yesod/Auth/Dummy.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
 -- | Provides a dummy authentication module that simply lets a user specify
 -- his/her identifier. This is not intended for real world use, just for
 -- testing.
@@ -16,7 +17,7 @@ authDummy :: YesodAuth m => AuthPlugin m
 authDummy =
     AuthPlugin "dummy" dispatch login
   where
-    dispatch "POST" [] = liftHandler $ do
+    dispatch "POST" [] = do
         ident <- runInputPost $ ireq textField "ident"
         setCredsRedirect $ Creds "dummy" ident []
     dispatch _ _ = notFound
diff --git a/yesod-auth/Yesod/Auth/Email.hs b/yesod-auth/Yesod/Auth/Email.hs
index 60b65fb7..38afc51e 100644
--- a/yesod-auth/Yesod/Auth/Email.hs
+++ b/yesod-auth/Yesod/Auth/Email.hs
@@ -186,29 +186,29 @@ class ( YesodAuth site
     -- has not yet been verified.
     --
     -- @since 1.1.0
-    addUnverified :: Email -> VerKey -> HandlerT site IO (AuthEmailId site)
+    addUnverified :: Email -> VerKey -> AuthHandler site (AuthEmailId site)
 
     -- | Send an email to the given address to verify ownership.
     --
     -- @since 1.1.0
-    sendVerifyEmail :: Email -> VerKey -> VerUrl -> HandlerT site IO ()
+    sendVerifyEmail :: Email -> VerKey -> VerUrl -> AuthHandler site ()
 
     -- | Get the verification key for the given email ID.
     --
     -- @since 1.1.0
-    getVerifyKey :: AuthEmailId site -> HandlerT site IO (Maybe VerKey)
+    getVerifyKey :: AuthEmailId site -> AuthHandler site (Maybe VerKey)
 
     -- | Set the verification key for the given email ID.
     --
     -- @since 1.1.0
-    setVerifyKey :: AuthEmailId site -> VerKey -> HandlerT site IO ()
+    setVerifyKey :: AuthEmailId site -> VerKey -> AuthHandler site ()
 
     -- | Hash and salt a password
     --
     -- Default: 'saltPass'.
     --
     -- @since 1.4.20
-    hashAndSaltPassword :: Text -> HandlerT site IO SaltedPass
+    hashAndSaltPassword :: Text -> AuthHandler site SaltedPass
     hashAndSaltPassword = liftIO . saltPass
 
     -- | Verify a password matches the stored password for the given account.
@@ -216,7 +216,7 @@ class ( YesodAuth site
     -- Default: Fetch a password with 'getPassword' and match using 'Yesod.Auth.Util.PasswordStore.verifyPassword'.
     --
     -- @since 1.4.20
-    verifyPassword :: Text -> SaltedPass -> HandlerT site IO Bool
+    verifyPassword :: Text -> SaltedPass -> AuthHandler site Bool
     verifyPassword plain salted = return $ isValidPass plain salted
 
     -- | Verify the email address on the given account.
@@ -228,28 +228,28 @@ class ( YesodAuth site
     -- See <https://github.com/yesodweb/yesod/issues/1222>.
     --
     -- @since 1.1.0
-    verifyAccount :: AuthEmailId site -> HandlerT site IO (Maybe (AuthId site))
+    verifyAccount :: AuthEmailId site -> AuthHandler site (Maybe (AuthId site))
 
     -- | Get the salted password for the given account.
     --
     -- @since 1.1.0
-    getPassword :: AuthId site -> HandlerT site IO (Maybe SaltedPass)
+    getPassword :: AuthId site -> AuthHandler site (Maybe SaltedPass)
 
     -- | Set the salted password for the given account.
     --
     -- @since 1.1.0
-    setPassword :: AuthId site -> SaltedPass -> HandlerT site IO ()
+    setPassword :: AuthId site -> SaltedPass -> AuthHandler site ()
 
     -- | Get the credentials for the given @Identifier@, which may be either an
     -- email address or some other identification (e.g., username).
     --
     -- @since 1.2.0
-    getEmailCreds :: Identifier -> HandlerT site IO (Maybe (EmailCreds site))
+    getEmailCreds :: Identifier -> AuthHandler site (Maybe (EmailCreds site))
 
     -- | Get the email address for the given email ID.
     --
     -- @since 1.1.0
-    getEmail :: AuthEmailId site -> HandlerT site IO (Maybe Email)
+    getEmail :: AuthEmailId site -> AuthHandler site (Maybe Email)
 
     -- | Generate a random alphanumeric string.
     --
@@ -268,7 +268,7 @@ class ( YesodAuth site
     -- Default: if the user logged in via an email link do not require a password.
     --
     -- @since 1.2.1
-    needOldPassword :: AuthId site -> HandlerT site IO Bool
+    needOldPassword :: AuthId site -> AuthHandler site Bool
     needOldPassword aid' = do
         mkey <- lookupSession loginLinkKey
         case mkey >>= readMay . TS.unpack of
@@ -280,7 +280,7 @@ class ( YesodAuth site
     -- | Check that the given plain-text password meets minimum security standards.
     --
     -- Default: password is at least three characters.
-    checkPasswordSecurity :: AuthId site -> Text -> HandlerT site IO (Either Text ())
+    checkPasswordSecurity :: AuthId site -> Text -> AuthHandler site (Either Text ())
     checkPasswordSecurity _ x
         | TS.length x >= 3 = return $ Right ()
         | otherwise = return $ Left "Password must be at least three characters"
@@ -288,7 +288,7 @@ class ( YesodAuth site
     -- | Response after sending a confirmation email.
     --
     -- @since 1.2.2
-    confirmationEmailSentResponse :: Text -> HandlerT site IO TypedContent
+    confirmationEmailSentResponse :: Text -> AuthHandler site TypedContent
     confirmationEmailSentResponse identifier = do
         mr <- getMessageRender
         selectRep $ do
@@ -314,7 +314,7 @@ class ( YesodAuth site
     -- Default: 'defaultEmailLoginHandler'.
     --
     -- @since 1.4.17
-    emailLoginHandler :: (Route Auth -> Route site) -> WidgetT site IO ()
+    emailLoginHandler :: (Route Auth -> Route site) -> WidgetFor site ()
     emailLoginHandler = defaultEmailLoginHandler
 
 
@@ -377,9 +377,12 @@ getRegisterR = registerHandler
 -- | Default implementation of 'emailLoginHandler'.
 --
 -- @since 1.4.17
-defaultEmailLoginHandler :: YesodAuthEmail master => (Route Auth -> Route master) -> WidgetT master IO ()
+defaultEmailLoginHandler
+  :: YesodAuthEmail master
+  => (Route Auth -> Route master)
+  -> WidgetFor master ()
 defaultEmailLoginHandler toParent = do
-        (widget, enctype) <- liftWidgetT $ generateFormPost loginForm
+        (widget, enctype) <- generateFormPost loginForm
 
         [whamlet|
             <form method="post" action="@{toParent loginR}", enctype=#{enctype}>
@@ -439,9 +442,9 @@ defaultEmailLoginHandler toParent = do
 -- @since 1.2.6
 defaultRegisterHandler :: YesodAuthEmail master => AuthHandler master Html
 defaultRegisterHandler = do
-    (widget, enctype) <- lift $ generateFormPost registrationForm
+    (widget, enctype) <- generateFormPost registrationForm
     toParentRoute <- getRouteToParent
-    lift $ authLayout $ do
+    authLayout $ do
         setTitleI Msg.RegisterLong
         [whamlet|
             <p>_{Msg.EnterEmail}
@@ -482,12 +485,12 @@ registerHelper :: YesodAuthEmail master
                -> Route Auth
                -> AuthHandler master TypedContent
 registerHelper allowUsername dest = do
-    y <- lift getYesod
+    y <- getYesod
     checkCsrfHeaderOrParam defaultCsrfHeaderName defaultCsrfParamName
     pidentifier <- lookupPostParam "email"
     midentifier <- case pidentifier of
                      Nothing -> do
-                       (jidentifier :: Result Value) <- lift parseCheckJsonBody
+                       (jidentifier :: Result Value) <- parseCheckJsonBody
                        case jidentifier of
                          Error _ -> return Nothing
                          Success val -> return $ parseMaybe parseEmail val
@@ -502,28 +505,29 @@ registerHelper allowUsername dest = do
     case eidentifier of
       Left route -> loginErrorMessageI dest route
       Right identifier -> do
-            mecreds <- lift $ getEmailCreds identifier
+            mecreds <- getEmailCreds identifier
             registerCreds <-
                 case mecreds of
                     Just (EmailCreds lid _ _ (Just key) email) -> return $ Just (lid, key, email)
                     Just (EmailCreds lid _ _ Nothing email) -> do
                         key <- liftIO $ randomKey y
-                        lift $ setVerifyKey lid key
+                        setVerifyKey lid key
                         return $ Just (lid, key, email)
                     Nothing
                         | allowUsername -> return Nothing
                         | otherwise -> do
                             key <- liftIO $ randomKey y
-                            lid <- lift $ addUnverified identifier key
+                            lid <- addUnverified identifier key
                             return $ Just (lid, key, identifier)
 
             case registerCreds of
                 Nothing -> loginErrorMessageI dest (Msg.IdentifierNotFound identifier)
                 Just (lid, verKey, email) -> do
                     render <- getUrlRender
-                    let verUrl = render $ verifyR (toPathPiece lid) verKey
-                    lift $ sendVerifyEmail email verKey verUrl
-                    lift $ confirmationEmailSentResponse identifier
+                    tp <- getRouteToParent
+                    let verUrl = render $ tp $ verifyR (toPathPiece lid) verKey
+                    sendVerifyEmail email verKey verUrl
+                    confirmationEmailSentResponse identifier
 
 postRegisterR :: YesodAuthEmail master => AuthHandler master TypedContent
 postRegisterR = registerHelper False registerR
@@ -536,9 +540,9 @@ getForgotPasswordR = forgotPasswordHandler
 -- @since 1.2.6
 defaultForgotPasswordHandler :: YesodAuthEmail master => AuthHandler master Html
 defaultForgotPasswordHandler = do
-    (widget, enctype) <- lift $ generateFormPost forgotPasswordForm
+    (widget, enctype) <- generateFormPost forgotPasswordForm
     toParent <- getRouteToParent
-    lift $ authLayout $ do
+    authLayout $ do
         setTitleI Msg.PasswordResetTitle
         [whamlet|
             <p>_{Msg.PasswordResetPrompt}
@@ -577,27 +581,28 @@ getVerifyR :: YesodAuthEmail site
            -> Text
            -> AuthHandler site TypedContent
 getVerifyR lid key = do
-    realKey <- lift $ getVerifyKey lid
-    memail <- lift $ getEmail lid
-    mr <- lift getMessageRender
+    realKey <- getVerifyKey lid
+    memail <- getEmail lid
+    mr <- getMessageRender
     case (realKey == Just key, memail) of
         (True, Just email) -> do
-            muid <- lift $ verifyAccount lid
+            muid <- verifyAccount lid
             case muid of
                 Nothing -> invalidKey mr
                 Just uid -> do
-                    lift $ setCreds False $ Creds "email-verify" email [("verifiedEmail", email)] -- FIXME uid?
-                    lift $ setLoginLinkKey uid
+                    setCreds False $ Creds "email-verify" email [("verifiedEmail", email)] -- FIXME uid?
+                    setLoginLinkKey uid
                     let msgAv = Msg.AddressVerified
                     selectRep $ do
                       provideRep $ do
-                        lift $ addMessageI "success" msgAv
-                        fmap asHtml $ redirect setpassR
+                        addMessageI "success" msgAv
+                        tp <- getRouteToParent
+                        fmap asHtml $ redirect $ tp setpassR
                       provideJsonMessage $ mr msgAv
         _ -> invalidKey mr
   where
     msgIk = Msg.InvalidKey
-    invalidKey mr = messageJson401 (mr msgIk) $ lift $ authLayout $ do
+    invalidKey mr = messageJson401 (mr msgIk) $ authLayout $ do
         setTitleI msgIk
         [whamlet|
 $newline never
@@ -614,14 +619,14 @@ parseCreds = withObject "creds" (\obj -> do
 
 postLoginR :: YesodAuthEmail master => AuthHandler master TypedContent
 postLoginR = do
-    result <- lift $ runInputPostResult $ (,)
+    result <- runInputPostResult $ (,)
         <$> ireq textField "email"
         <*> ireq textField "password"
 
     midentifier <- case result of
                      FormSuccess (iden, pass) -> return $ Just (iden, pass)
                      _ -> do
-                       (creds :: Result Value) <- lift parseCheckJsonBody
+                       (creds :: Result Value) <- parseCheckJsonBody
                        case creds of
                          Error _ -> return Nothing
                          Success val -> return $ parseMaybe parseCreds val
@@ -629,18 +634,18 @@ postLoginR = do
     case midentifier of
       Nothing -> loginErrorMessageI LoginR Msg.NoIdentifierProvided
       Just (identifier, pass) -> do
-          mecreds <- lift $ getEmailCreds identifier
+          mecreds <- getEmailCreds identifier
           maid <-
               case ( mecreds >>= emailCredsAuthId
                    , emailCredsEmail <$> mecreds
                    , emailCredsStatus <$> mecreds
                    ) of
                 (Just aid, Just email', Just True) -> do
-                      mrealpass <- lift $ getPassword aid
+                      mrealpass <- getPassword aid
                       case mrealpass of
                         Nothing -> return Nothing
                         Just realpass -> do
-                            passValid <- lift $ verifyPassword pass realpass 
+                            passValid <- verifyPassword pass realpass
                             return $ if passValid
                                     then Just email'
                                     else Nothing
@@ -648,7 +653,7 @@ postLoginR = do
           let isEmail = Text.Email.Validate.isValid $ encodeUtf8 identifier
           case maid of
             Just email' ->
-                lift $ setCredsRedirect $ Creds
+                setCredsRedirect $ Creds
                          (if isEmail then "email" else "username")
                          email'
                          [("verifiedEmail", email')]
@@ -660,11 +665,11 @@ postLoginR = do
 
 getPasswordR :: YesodAuthEmail master => AuthHandler master TypedContent
 getPasswordR = do
-    maid <- lift maybeAuthId
+    maid <- maybeAuthId
     case maid of
         Nothing -> loginErrorMessageI LoginR Msg.BadSetPass
         Just _ -> do
-            needOld <- maybe (return True) (lift . needOldPassword) maid
+            needOld <- maybe (return True) needOldPassword maid
             setPasswordHandler needOld
 
 -- | Default implementation of 'setPasswordHandler'.
@@ -672,12 +677,12 @@ getPasswordR = do
 -- @since 1.2.6
 defaultSetPasswordHandler :: YesodAuthEmail master => Bool -> AuthHandler master TypedContent
 defaultSetPasswordHandler needOld = do
-    messageRender <- lift getMessageRender
+    messageRender <- getMessageRender
     toParent <- getRouteToParent
     selectRep $ do
         provideJsonMessage $ messageRender Msg.SetPass
-        provideRep $ lift $ authLayout $ do
-            (widget, enctype) <- liftWidgetT $ generateFormPost setPasswordForm
+        provideRep $ authLayout $ do
+            (widget, enctype) <- generateFormPost setPasswordForm
             setTitleI Msg.SetPassTitle
             [whamlet|
                 <h3>_{Msg.SetPass}
@@ -751,8 +756,8 @@ parsePassword = withObject "password" (\obj -> do
 
 postPasswordR :: YesodAuthEmail master => AuthHandler master TypedContent
 postPasswordR = do
-    maid <- lift maybeAuthId
-    (creds :: Result Value) <- lift parseCheckJsonBody
+    maid <- maybeAuthId
+    (creds :: Result Value) <- parseCheckJsonBody
     let jcreds = case creds of
                    Error _ -> Nothing
                    Success val -> parseMaybe parsePassword val
@@ -761,26 +766,26 @@ postPasswordR = do
         Nothing -> loginErrorMessageI LoginR Msg.BadSetPass
         Just aid -> do
             tm <- getRouteToParent
-            needOld <- lift $ needOldPassword aid
+            needOld <- needOldPassword aid
             if not needOld then confirmPassword aid tm jcreds else do
-                res <- lift $ runInputPostResult $ ireq textField "current"
+                res <- runInputPostResult $ ireq textField "current"
                 let fcurrent = case res of
                                  FormSuccess currentPass -> Just currentPass
                                  _ -> Nothing
                 let current = if doJsonParsing
                               then getThird jcreds
                               else fcurrent
-                mrealpass <- lift $ getPassword aid
+                mrealpass <- getPassword aid
                 case (mrealpass, current) of
                     (Nothing, _) ->
-                        liftHandler $ loginErrorMessage (tm setpassR) "You do not currently have a password set on your account"
+                        loginErrorMessage (tm setpassR) "You do not currently have a password set on your account"
                     (_, Nothing) ->
                         loginErrorMessageI LoginR Msg.BadSetPass
                     (Just realpass, Just current') -> do
-                        passValid <- liftHandler $ verifyPassword current' realpass
+                        passValid <- verifyPassword current' realpass
                         if passValid
                           then confirmPassword aid tm jcreds
-                          else liftHandler $ loginErrorMessage (tm setpassR) "Invalid current password, please try again"
+                          else loginErrorMessage (tm setpassR) "Invalid current password, please try again"
 
   where
     msgOk = Msg.PassUpdated
@@ -789,7 +794,7 @@ postPasswordR = do
     getNewConfirm (Just (a,b,_)) = Just (a,b)
     getNewConfirm _ = Nothing
     confirmPassword aid tm jcreds = do
-        res <- lift $ runInputPostResult $ (,)
+        res <- runInputPostResult $ (,)
             <$> ireq textField "new"
             <*> ireq textField "confirm"
         let creds = if (isJust jcreds)
@@ -803,21 +808,21 @@ postPasswordR = do
               if new /= confirm
               then loginErrorMessageI setpassR Msg.PassMismatch
               else do
-                isSecure <- lift $ checkPasswordSecurity aid new
+                isSecure <- checkPasswordSecurity aid new
                 case isSecure of
-                  Left e -> lift $ loginErrorMessage (tm setpassR) e
+                  Left e -> loginErrorMessage (tm setpassR) e
                   Right () -> do
-                     salted <- lift $ hashAndSaltPassword new
-                     y <- lift $ do
+                     salted <- hashAndSaltPassword new
+                     y <- do
                                 setPassword aid salted
                                 deleteSession loginLinkKey
                                 addMessageI "success" msgOk
                                 getYesod
 
-                     mr <- lift getMessageRender
+                     mr <- getMessageRender
                      selectRep $ do
                          provideRep $ 
-                            fmap asHtml $ lift $ redirect $ afterPasswordRoute y
+                            fmap asHtml $ redirect $ afterPasswordRoute y
                          provideJsonMessage (mr msgOk)
 
 saltLength :: Int
diff --git a/yesod-auth/Yesod/Auth/GoogleEmail.hs b/yesod-auth/Yesod/Auth/GoogleEmail.hs
deleted file mode 100644
index eb0b6cee..00000000
--- a/yesod-auth/Yesod/Auth/GoogleEmail.hs
+++ /dev/null
@@ -1,89 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE RankNTypes #-}
--- | Use an email address as an identifier via Google's OpenID login system.
---
--- This backend will not use the OpenID identifier at all. It only uses OpenID
--- as a login system. By using this plugin, you are trusting Google to validate
--- an email address, and requiring users to have a Google account. On the plus
--- side, you get to use email addresses as the identifier, many users have
--- existing Google accounts, the login system has been long tested (as opposed
--- to BrowserID), and it requires no credential managing or setup (as opposed
--- to Email).
-module Yesod.Auth.GoogleEmail
-    {-# DEPRECATED "Google no longer provides OpenID support, please use Yesod.Auth.GoogleEmail2" #-}
-    ( authGoogleEmail
-    , forwardUrl
-    ) where
-
-import Yesod.Auth
-import qualified Web.Authenticate.OpenId as OpenId
-
-import Yesod.Core
-import Data.Text (Text)
-import qualified Yesod.Auth.Message as Msg
-import qualified Data.Text as T
-import Control.Exception.Lifted (try, SomeException)
-
-pid :: Text
-pid = "googleemail"
-
-forwardUrl :: AuthRoute
-forwardUrl = PluginR pid ["forward"]
-
-googleIdent :: Text
-googleIdent = "https://www.google.com/accounts/o8/id"
-
-authGoogleEmail :: YesodAuth m => AuthPlugin m
-authGoogleEmail =
-    AuthPlugin pid dispatch login
-  where
-    complete = PluginR pid ["complete"]
-    login tm =
-        [whamlet|<a href=@{tm forwardUrl}>_{Msg.LoginGoogle}|]
-    dispatch "GET" ["forward"] = do
-        render <- getUrlRender
-        let complete' = render complete
-        master <- lift getYesod
-        eres <- lift $ try $ OpenId.getForwardUrl googleIdent complete' Nothing
-            [ ("openid.ax.type.email", "http://schema.openid.net/contact/email")
-            , ("openid.ns.ax", "http://openid.net/srv/ax/1.0")
-            , ("openid.ns.ax.required", "email")
-            , ("openid.ax.mode", "fetch_request")
-            , ("openid.ax.required", "email")
-            , ("openid.ui.icon", "true")
-            ] (authHttpManager master)
-        either
-          (\err -> do
-            tm <- getRouteToParent
-            lift $ loginErrorMessage (tm LoginR) $ T.pack $ show (err :: SomeException))
-          redirect
-          eres
-    dispatch "GET" ["complete", ""] = dispatch "GET" ["complete"] -- compatibility issues
-    dispatch "GET" ["complete"] = do
-        rr <- getRequest
-        completeHelper $ reqGetParams rr
-    dispatch "POST" ["complete", ""] = dispatch "POST" ["complete"] -- compatibility issues
-    dispatch "POST" ["complete"] = do
-        (posts, _) <- runRequestBody
-        completeHelper posts
-    dispatch _ _ = notFound
-
-completeHelper :: [(Text, Text)] -> AuthHandler master TypedContent
-completeHelper gets' = do
-      master <- lift getYesod
-      eres <- lift $ try $ OpenId.authenticateClaimed gets' (authHttpManager master)
-      tm <- getRouteToParent
-      either (onFailure tm) (onSuccess tm) eres
-    where
-      onFailure tm err =
-        lift $ loginErrorMessage (tm LoginR) $ T.pack $ show (err :: SomeException)
-      onSuccess tm oir = do
-              let OpenId.Identifier ident = OpenId.oirOpLocal oir
-              memail <- lookupGetParam "openid.ext1.value.email"
-              case (memail, "https://www.google.com/accounts/o8/id" `T.isPrefixOf` ident) of
-                  (Just email, True) -> lift $ setCredsRedirect $ Creds pid email []
-                  (_, False)   -> lift $ loginErrorMessage (tm LoginR) "Only Google login is supported"
-                  (Nothing, _) -> lift $ loginErrorMessage (tm LoginR) "No email address provided"
diff --git a/yesod-auth/Yesod/Auth/GoogleEmail2.hs b/yesod-auth/Yesod/Auth/GoogleEmail2.hs
index 577e86a7..01a00e3c 100644
--- a/yesod-auth/Yesod/Auth/GoogleEmail2.hs
+++ b/yesod-auth/Yesod/Auth/GoogleEmail2.hs
@@ -2,6 +2,8 @@
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE TypeFamilies      #-}
 -- | Use an email address as an identifier via Google's login system.
 --
 -- Note that this is a replacement for "Yesod.Auth.GoogleEmail", which depends
@@ -54,12 +56,12 @@ import           Yesod.Auth               (Auth, AuthPlugin (AuthPlugin),
                                            AuthRoute, Creds (Creds),
                                            Route (PluginR), YesodAuth,
                                            runHttpRequest, setCredsRedirect,
-                                           logoutDest)
+                                           logoutDest, AuthHandler)
 import qualified Yesod.Auth.Message       as Msg
-import           Yesod.Core               (HandlerSite, HandlerT, MonadHandler,
+import           Yesod.Core               (HandlerSite, MonadHandler,
                                            TypedContent, getRouteToParent,
                                            getUrlRender, invalidArgs,
-                                           lift, liftIO, lookupGetParam,
+                                           liftIO, lookupGetParam,
                                            lookupSession, notFound, redirect,
                                            setSession, whamlet, (.:),
                                            addMessage, getYesod,
@@ -187,10 +189,10 @@ authPlugin storeToken clientID clientSecret =
     dispatch :: YesodAuth site
              => Text
              -> [Text]
-             -> HandlerT Auth (HandlerT site IO) TypedContent
+             -> AuthHandler site TypedContent
     dispatch "GET" ["forward"] = do
         tm <- getRouteToParent
-        lift (getDest tm) >>= redirect
+        getDest tm >>= redirect
 
     dispatch "GET" ["complete"] = do
         mstate <- lookupGetParam "state"
@@ -207,30 +209,27 @@ authPlugin storeToken clientID clientSecret =
                     case merr of
                         Nothing -> invalidArgs ["Missing code paramter"]
                         Just err -> do
-                            master <- lift getYesod
+                            master <- getYesod
                             let msg =
                                     case err of
                                         "access_denied" -> "Access denied"
                                         _ -> "Unknown error occurred: " `T.append` err
                             addMessage "error" $ toHtml msg
-                            lift $ redirect $ logoutDest master
+                            redirect $ logoutDest master
                 Just c -> return c
 
         render <- getUrlRender
+        tm <- getRouteToParent
 
         req' <- liftIO $
-#if MIN_VERSION_http_client(0,4,30)
             HTTP.parseUrlThrow
-#else
-            HTTP.parseUrl
-#endif
             "https://accounts.google.com/o/oauth2/token" -- FIXME don't hardcode, use: https://accounts.google.com/.well-known/openid-configuration
         let req =
                 urlEncodedBody
                     [ ("code", encodeUtf8 code)
                     , ("client_id", encodeUtf8 clientID)
                     , ("client_secret", encodeUtf8 clientSecret)
-                    , ("redirect_uri", encodeUtf8 $ render complete)
+                    , ("redirect_uri", encodeUtf8 $ render $ tm complete)
                     , ("grant_type", "authorization_code")
                     ]
                     req'
@@ -257,15 +256,12 @@ authPlugin storeToken clientID clientSecret =
                 [e] -> return e
                 [] -> error "No account email"
                 x -> error $ "Too many account emails: " ++ show x
-        lift $ setCredsRedirect $ Creds pid email $ allPersonInfo personValue
+        setCredsRedirect $ Creds pid email $ allPersonInfo personValue
 
     dispatch _ _ = notFound
 
-makeHttpRequest
-  :: (YesodAuth site)
-  => Request
-  -> HandlerT Auth (HandlerT site IO) A.Value
-makeHttpRequest req = lift $
+makeHttpRequest :: Request -> AuthHandler site A.Value
+makeHttpRequest req =
     runHttpRequest req $ \res -> bodyReaderSource (responseBody res) $$ sinkParser json'
 
 -- | Allows to fetch information about a user from Google's API.
@@ -273,7 +269,7 @@ makeHttpRequest req = lift $
 --   Will throw 'HttpException' in case of network problems or error response code.
 --
 -- @since 1.4.3
-getPerson :: Manager -> Token -> HandlerT site IO (Maybe Person)
+getPerson :: Manager -> Token -> AuthHandler site (Maybe Person)
 getPerson manager token = parseMaybe parseJSON <$> (do
     req <- personValueRequest token
     res <- http req manager
@@ -282,13 +278,8 @@ getPerson manager token = parseMaybe parseJSON <$> (do
 
 personValueRequest :: MonadIO m => Token -> m Request
 personValueRequest token = do
-    req2' <- liftIO $
-#if MIN_VERSION_http_client(0,4,30)
-            HTTP.parseUrlThrow
-#else
-            HTTP.parseUrl
-#endif
-        "https://www.googleapis.com/plus/v1/people/me"
+    req2' <- liftIO
+           $ HTTP.parseUrlThrow "https://www.googleapis.com/plus/v1/people/me"
     return req2'
             { requestHeaders =
                 [ ("Authorization", encodeUtf8 $ "Bearer " `mappend` accessToken token)
diff --git a/yesod-auth/Yesod/Auth/Hardcoded.hs b/yesod-auth/Yesod/Auth/Hardcoded.hs
index 9421feb4..cb5ec199 100644
--- a/yesod-auth/Yesod/Auth/Hardcoded.hs
+++ b/yesod-auth/Yesod/Auth/Hardcoded.hs
@@ -131,9 +131,10 @@ module Yesod.Auth.Hardcoded
   , loginR )
   where
 
-import           Yesod.Auth          (Auth, AuthPlugin (..), AuthRoute,
+import           Yesod.Auth          (AuthPlugin (..), AuthRoute,
                                       Creds (..), Route (..), YesodAuth,
-                                      loginErrorMessageI, setCredsRedirect)
+                                      loginErrorMessageI, setCredsRedirect,
+                                      AuthHandler)
 import qualified Yesod.Auth.Message  as Msg
 import           Yesod.Core
 import           Yesod.Form          (ireq, runInputPost, textField)
@@ -148,10 +149,10 @@ loginR = PluginR "hardcoded" ["login"]
 class (YesodAuth site) => YesodAuthHardcoded site where
 
   -- | Check whether given user name exists among hardcoded names.
-  doesUserNameExist :: Text -> HandlerT site IO Bool
+  doesUserNameExist :: Text -> AuthHandler site Bool
 
   -- | Validate given user name with given password.
-  validatePassword :: Text -> Text -> HandlerT site IO Bool
+  validatePassword :: Text -> Text -> AuthHandler site Bool
 
 
 authHardcoded :: YesodAuthHardcoded m => AuthPlugin m
@@ -182,16 +183,16 @@ authHardcoded =
         |]
 
 
-postLoginR :: (YesodAuthHardcoded master)
-           => HandlerT Auth (HandlerT master IO) TypedContent
+postLoginR :: YesodAuthHardcoded site
+           => AuthHandler site TypedContent
 postLoginR =
-  do (username, password) <- lift (runInputPost
+  do (username, password) <- runInputPost
        ((,) Control.Applicative.<$> ireq textField "username"
-            Control.Applicative.<*> ireq textField "password"))
-     isValid <- lift (validatePassword username password)
+            Control.Applicative.<*> ireq textField "password")
+     isValid <- validatePassword username password
      if isValid
-        then lift (setCredsRedirect (Creds "hardcoded" username []))
-        else do isExists <- lift (doesUserNameExist username)
+        then setCredsRedirect (Creds "hardcoded" username [])
+        else do isExists <- doesUserNameExist username
                 loginErrorMessageI LoginR
                                    (if isExists
                                        then Msg.InvalidUsernamePass
diff --git a/yesod-auth/Yesod/Auth/OpenId.hs b/yesod-auth/Yesod/Auth/OpenId.hs
index f32ff747..f65bed7c 100644
--- a/yesod-auth/Yesod/Auth/OpenId.hs
+++ b/yesod-auth/Yesod/Auth/OpenId.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE GADTs #-}
 module Yesod.Auth.OpenId
     ( authOpenId
     , forwardUrl
@@ -36,7 +37,10 @@ authOpenId idType extensionFields =
     AuthPlugin "openid" dispatch login
   where
     complete = PluginR "openid" ["complete"]
+
+    name :: Text
     name = "openid_identifier"
+
     login tm = do
         ident <- newIdent
         -- FIXME this is a hack to get GHC 7.6's type checker to allow the
@@ -57,18 +61,20 @@ $newline never
     <input id="#{ident}" type="text" name="#{name}" value="http://">
     <input type="submit" value="_{Msg.LoginOpenID}">
 |]
+
+    dispatch :: Text -> [Text] -> AuthHandler master TypedContent
     dispatch "GET" ["forward"] = do
-        roid <- lift $ runInputGet $ iopt textField name
+        roid <- runInputGet $ iopt textField name
         case roid of
             Just oid -> do
+                tm <- getRouteToParent
                 render <- getUrlRender
-                let complete' = render complete
-                master <- lift getYesod
-                eres <- lift $ try $ OpenId.getForwardUrl oid complete' Nothing extensionFields (authHttpManager master)
+                let complete' = render $ tm complete
+                manager <- authHttpManager
+                eres <- liftResourceT $ try $ OpenId.getForwardUrl oid complete' Nothing extensionFields manager
                 case eres of
                     Left err -> do
-                        tm <- getRouteToParent
-                        lift $ loginErrorMessage (tm LoginR) $ T.pack $
+                        loginErrorMessage (tm LoginR) $ T.pack $
                                 show (err :: SomeException)
                     Right x -> redirect x
             Nothing -> loginErrorMessageI LoginR Msg.NoOpenID
@@ -84,13 +90,13 @@ $newline never
 
 completeHelper :: IdentifierType -> [(Text, Text)] -> AuthHandler master TypedContent
 completeHelper idType gets' = do
-    master <- lift getYesod
-    eres <- try $ OpenId.authenticateClaimed gets' (authHttpManager master)
+    manager <- authHttpManager
+    eres <- liftResourceT $ try $ OpenId.authenticateClaimed gets' manager
     either onFailure onSuccess eres
   where
     onFailure err = do
         tm <- getRouteToParent
-        lift $ loginErrorMessage (tm LoginR) $ T.pack $
+        loginErrorMessage (tm LoginR) $ T.pack $
                 show (err :: SomeException)
     onSuccess oir = do
             let claimed =
@@ -105,7 +111,7 @@ completeHelper idType gets' = do
                         case idType of
                             OPLocal -> OpenId.oirOpLocal oir
                             Claimed -> fromMaybe (OpenId.oirOpLocal oir) $ OpenId.oirClaimed oir
-            lift $ setCredsRedirect $ Creds "openid" i gets''
+            setCredsRedirect $ Creds "openid" i gets''
 
 -- | The main identifier provided by the OpenID authentication plugin is the
 -- \"OP-local identifier\". There is also sometimes a \"claimed\" identifier
diff --git a/yesod-auth/Yesod/Auth/Rpxnow.hs b/yesod-auth/Yesod/Auth/Rpxnow.hs
index 58456cda..8ff663e5 100644
--- a/yesod-auth/Yesod/Auth/Rpxnow.hs
+++ b/yesod-auth/Yesod/Auth/Rpxnow.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
 module Yesod.Auth.Rpxnow
     ( authRpxnow
     ) where
@@ -17,10 +18,10 @@ import Data.Text.Encoding.Error (lenientDecode)
 import Control.Arrow ((***))
 import Network.HTTP.Types (renderQuery)
 
-authRpxnow :: YesodAuth m
+authRpxnow :: YesodAuth master
            => String -- ^ app name
            -> String -- ^ key
-           -> AuthPlugin m
+           -> AuthPlugin master
 authRpxnow app apiKey =
     AuthPlugin "rpxnow" dispatch login
   where
@@ -32,14 +33,17 @@ authRpxnow app apiKey =
 $newline never
 <iframe src="http://#{app}.rpxnow.com/openid/embed#{queryString}" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px">
 |]
+
+    dispatch :: a -> [b] -> AuthHandler master TypedContent
     dispatch _ [] = do
         token1 <- lookupGetParams "token"
         token2 <- lookupPostParams "token"
         token <- case token1 ++ token2 of
                         [] -> invalidArgs ["token: Value not supplied"]
                         x:_ -> return $ unpack x
-        master <- lift getYesod
-        Rpxnow.Identifier ident extra <- lift $ Rpxnow.authenticate apiKey token (authHttpManager master)
+        manager <- authHttpManager
+        Rpxnow.Identifier ident extra <-
+          liftResourceT $ Rpxnow.authenticate apiKey token manager
         let creds =
                 Creds "rpxnow" ident
                 $ maybe id (\x -> (:) ("verifiedEmail", x))
@@ -47,7 +51,7 @@ $newline never
                 $ maybe id (\x -> (:) ("displayName", x))
                     (fmap pack $ getDisplayName $ map (unpack *** unpack) extra)
                   []
-        lift $ setCredsRedirect creds
+        setCredsRedirect creds
     dispatch _ _ = notFound
 
 -- | Get some form of a display name.
diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal
index 2adcfa49..d9f147ff 100644
--- a/yesod-auth/yesod-auth.cabal
+++ b/yesod-auth/yesod-auth.cabal
@@ -38,9 +38,9 @@ library
                    , unordered-containers
                    , yesod-form              >= 1.4       && < 1.5
                    , transformers            >= 0.2.2
-                   , persistent              >= 2.1       && < 2.8
+                   , persistent              >= 2.5       && < 2.8
                    , persistent-template     >= 2.1       && < 2.8
-                   , http-client
+                   , http-client             >= 0.5
                    , http-client-tls
                    , http-conduit            >= 2.1
                    , aeson                   >= 0.7
@@ -76,7 +76,6 @@ library
                      Yesod.Auth.OpenId
                      Yesod.Auth.Rpxnow
                      Yesod.Auth.Message
-                     Yesod.Auth.GoogleEmail
                      Yesod.Auth.GoogleEmail2
                      Yesod.Auth.Hardcoded
                      Yesod.Auth.Util.PasswordStore
diff --git a/yesod-static/Yesod/Static.hs b/yesod-static/Yesod/Static.hs
index 636bd333..62918ebb 100644
--- a/yesod-static/Yesod/Static.hs
+++ b/yesod-static/Yesod/Static.hs
@@ -78,7 +78,6 @@ import Language.Haskell.TH.Syntax as TH
 
 import Crypto.Hash.Conduit (hashFile, sinkHash)
 import Crypto.Hash (MD5, Digest)
-import Control.Monad.Catch (MonadThrow)
 import Control.Monad.Trans.State
 
 import qualified Data.ByteArray as ByteArray
@@ -175,12 +174,10 @@ instance RenderRoute Static where
 instance ParseRoute Static where
     parseRoute (x, y) = Just $ StaticRoute x y
 
-instance (MonadThrow m, MonadIO m, MonadBaseControl IO m)
-  => YesodSubDispatch Static (HandlerT master m) where
+instance MonadHandler m => YesodSubDispatch Static m where
     yesodSubDispatch YesodSubRunnerEnv {..} req =
-        ysreParentRunner base ysreParentEnv (fmap ysreToParentRoute route) req
+        ysreParentRunner handlert ysreParentEnv (fmap ysreToParentRoute route) req
       where
-        base = stripHandlerT handlert ysreGetSub ysreToParentRoute route
         route = Just $ StaticRoute (pathInfo req) []
 
         Static set = ysreGetSub $ yreSite $ ysreParentEnv

From 1b22e6a9085ec400fe4b5931b0bd713e752ea5a4 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 18 Dec 2017 17:06:46 +0200
Subject: [PATCH 10/43] Further transformer cleanup

---
 stack.yaml                              |  2 +
 yesod-auth-oauth/Yesod/Auth/OAuth.hs    |  2 +-
 yesod-auth-oauth/yesod-auth-oauth.cabal |  1 -
 yesod-auth/Yesod/Auth/BrowserId.hs      |  2 +-
 yesod-auth/Yesod/Auth/OpenId.hs         | 13 ++--
 yesod-auth/Yesod/Auth/Rpxnow.hs         |  3 +-
 yesod-auth/yesod-auth.cabal             |  4 +-
 yesod-bin/Build.hs                      | 22 ++++---
 yesod-bin/Devel.hs                      |  2 +-
 yesod-bin/yesod-bin.cabal               |  3 +-
 yesod-test/Yesod/Test.hs                | 79 ++++++++++++++++---------
 yesod-test/test/main.hs                 |  4 +-
 yesod-test/yesod-test.cabal             |  2 +-
 13 files changed, 78 insertions(+), 61 deletions(-)

diff --git a/stack.yaml b/stack.yaml
index b53c2b2e..2e37e9d0 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -15,3 +15,5 @@ packages:
   - ./yesod-websockets
 extra-deps:
 - unliftio-core-0.1.0.0
+- unliftio-0.2.0.0
+- ../.stable/authenticate/authenticate
diff --git a/yesod-auth-oauth/Yesod/Auth/OAuth.hs b/yesod-auth-oauth/Yesod/Auth/OAuth.hs
index 6e723c08..c45b054b 100644
--- a/yesod-auth-oauth/Yesod/Auth/OAuth.hs
+++ b/yesod-auth-oauth/Yesod/Auth/OAuth.hs
@@ -15,7 +15,7 @@ module Yesod.Auth.OAuth
     ) where
 import           Control.Applicative      as A ((<$>), (<*>))
 import           Control.Arrow            ((***))
-import           Control.Exception.Lifted
+import           Control.Exception        (Exception, throwIO)
 import           Control.Monad.IO.Class
 import           Control.Monad.IO.Unlift  (MonadUnliftIO)
 import           Data.ByteString          (ByteString)
diff --git a/yesod-auth-oauth/yesod-auth-oauth.cabal b/yesod-auth-oauth/yesod-auth-oauth.cabal
index 7c9c55a5..2775fa66 100644
--- a/yesod-auth-oauth/yesod-auth-oauth.cabal
+++ b/yesod-auth-oauth/yesod-auth-oauth.cabal
@@ -28,7 +28,6 @@ library
                    , text                    >= 0.7
                    , yesod-form              >= 1.4       && < 1.5
                    , transformers            >= 0.2.2     && < 0.6
-                   , lifted-base             >= 0.2       && < 0.3
                    , unliftio-core
     exposed-modules: Yesod.Auth.OAuth
     ghc-options:     -Wall
diff --git a/yesod-auth/Yesod/Auth/BrowserId.hs b/yesod-auth/Yesod/Auth/BrowserId.hs
index 87dce2dc..c7e08421 100644
--- a/yesod-auth/Yesod/Auth/BrowserId.hs
+++ b/yesod-auth/Yesod/Auth/BrowserId.hs
@@ -78,7 +78,7 @@ authBrowserId bis@BrowserIdSettings {..} = AuthPlugin
                             tm <- getRouteToParent
                             return $ T.takeWhile (/= '/') $ stripScheme $ r $ tm LoginR
                 manager <- authHttpManager
-                memail <- liftResourceT $ checkAssertion audience assertion manager
+                memail <- checkAssertion audience assertion manager
                 case memail of
                     Nothing -> do
                       $logErrorS "yesod-auth" "BrowserID assertion failure"
diff --git a/yesod-auth/Yesod/Auth/OpenId.hs b/yesod-auth/Yesod/Auth/OpenId.hs
index f65bed7c..ceaa312c 100644
--- a/yesod-auth/Yesod/Auth/OpenId.hs
+++ b/yesod-auth/Yesod/Auth/OpenId.hs
@@ -20,7 +20,7 @@ import Yesod.Form
 import Yesod.Core
 import Data.Text (Text, isPrefixOf)
 import qualified Yesod.Auth.Message as Msg
-import Control.Exception.Lifted (SomeException, try)
+import UnliftIO.Exception (tryAny)
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 
@@ -71,11 +71,9 @@ $newline never
                 render <- getUrlRender
                 let complete' = render $ tm complete
                 manager <- authHttpManager
-                eres <- liftResourceT $ try $ OpenId.getForwardUrl oid complete' Nothing extensionFields manager
+                eres <- tryAny $ OpenId.getForwardUrl oid complete' Nothing extensionFields manager
                 case eres of
-                    Left err -> do
-                        loginErrorMessage (tm LoginR) $ T.pack $
-                                show (err :: SomeException)
+                    Left err -> loginErrorMessage (tm LoginR) $ T.pack $ show err
                     Right x -> redirect x
             Nothing -> loginErrorMessageI LoginR Msg.NoOpenID
     dispatch "GET" ["complete", ""] = dispatch "GET" ["complete"] -- compatibility issues
@@ -91,13 +89,12 @@ $newline never
 completeHelper :: IdentifierType -> [(Text, Text)] -> AuthHandler master TypedContent
 completeHelper idType gets' = do
     manager <- authHttpManager
-    eres <- liftResourceT $ try $ OpenId.authenticateClaimed gets' manager
+    eres <- tryAny $ OpenId.authenticateClaimed gets' manager
     either onFailure onSuccess eres
   where
     onFailure err = do
         tm <- getRouteToParent
-        loginErrorMessage (tm LoginR) $ T.pack $
-                show (err :: SomeException)
+        loginErrorMessage (tm LoginR) $ T.pack $ show err
     onSuccess oir = do
             let claimed =
                     case OpenId.oirClaimed oir of
diff --git a/yesod-auth/Yesod/Auth/Rpxnow.hs b/yesod-auth/Yesod/Auth/Rpxnow.hs
index 8ff663e5..b7a96a7c 100644
--- a/yesod-auth/Yesod/Auth/Rpxnow.hs
+++ b/yesod-auth/Yesod/Auth/Rpxnow.hs
@@ -42,8 +42,7 @@ $newline never
                         [] -> invalidArgs ["token: Value not supplied"]
                         x:_ -> return $ unpack x
         manager <- authHttpManager
-        Rpxnow.Identifier ident extra <-
-          liftResourceT $ Rpxnow.authenticate apiKey token manager
+        Rpxnow.Identifier ident extra <- Rpxnow.authenticate apiKey token manager
         let creds =
                 Creds "rpxnow" ident
                 $ maybe id (\x -> (:) ("verifiedEmail", x))
diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal
index d9f147ff..6075cb6d 100644
--- a/yesod-auth/yesod-auth.cabal
+++ b/yesod-auth/yesod-auth.cabal
@@ -21,7 +21,7 @@ flag network-uri
 
 library
     build-depends:   base                    >= 4         && < 5
-                   , authenticate            >= 1.3
+                   , authenticate            >= 1.3.4
                    , bytestring              >= 0.9.1.4
                    , yesod-core              >= 1.4.31    && < 1.5
                    , wai                     >= 1.4
@@ -44,7 +44,6 @@ library
                    , http-client-tls
                    , http-conduit            >= 2.1
                    , aeson                   >= 0.7
-                   , lifted-base             >= 0.1
                    , blaze-html              >= 0.5
                    , blaze-markup            >= 0.5.1
                    , http-types
@@ -63,6 +62,7 @@ library
                    , conduit-extra
                    , nonce                   >= 1.0.2     && < 1.1
                    , unliftio-core
+                   , unliftio
 
     if flag(network-uri)
       build-depends: network-uri >= 2.6
diff --git a/yesod-bin/Build.hs b/yesod-bin/Build.hs
index 3050a1a8..eecef808 100644
--- a/yesod-bin/Build.hs
+++ b/yesod-bin/Build.hs
@@ -20,10 +20,9 @@ import           Data.Text.Encoding.Error (lenientDecode)
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as S
 
-import           Control.Exception (SomeException, try, IOException)
-import           Control.Exception.Lifted (handle)
+import           UnliftIO.Exception (tryIO, IOException, handleAny, catchAny, tryAny)
 import           Control.Monad (when, filterM, forM, forM_, (>=>))
-import           Control.Monad.Trans.State (StateT, get, put, execStateT)
+import           Control.Monad.Trans.State (StateT (StateT), get, put, execStateT)
 import           Control.Monad.Trans.Writer (WriterT, tell, execWriterT)
 import           Control.Monad.IO.Class (MonadIO, liftIO)
 import           Control.Monad.Trans.Class (lift)
@@ -45,11 +44,11 @@ import           Text.Cassius     (cassiusUsedIdentifiers)
 import           Text.Lucius      (luciusUsedIdentifiers)
 
 safeReadFile :: MonadIO m => FilePath -> m (Either IOException ByteString)
-safeReadFile = liftIO . try . S.readFile
+safeReadFile = liftIO . tryIO . S.readFile
 
 touch :: IO ()
 touch = do
-    m <- handle (\(_ :: SomeException) -> return Map.empty) $ readFile touchCache >>= readIO
+    m <- handleAny (\_ -> return Map.empty) $ readFile touchCache >>= readIO
     x <- fmap snd (getDeps [])
     m' <- execStateT (execWriterT $ touchDeps id updateFileTime x) m
     createDirectoryIfMissing True $ takeDirectory touchCache
@@ -87,8 +86,10 @@ touchDeps :: (FilePath -> FilePath) ->
              Deps -> WriterT AnyFilesTouched (StateT (Map.Map FilePath (Set.Set Deref)) IO) ()
 touchDeps f action deps = (mapM_ go . Map.toList) deps
   where
+    ignoreStateEx defRes (StateT g) = StateT $ \s0 ->
+      g s0 `catchAny` \_ -> return (defRes, s0)
     go (x, (ys, ct)) = do
-        isChanged <- handle (\(_ :: SomeException) -> return True) $ lift $
+        isChanged <- lift $ ignoreStateEx True $
             case ct of
                 AlwaysOutdated -> return True
                 CompareUsedIdentifiers getDerefs -> do
@@ -113,7 +114,7 @@ touchDeps f action deps = (mapM_ go . Map.toList) deps
 removeHi :: FilePath -> FilePath -> IO ()
 removeHi _ hs = mapM_ removeFile' hiFiles
     where
-      removeFile' file = try' (removeFile file) >> return ()
+      removeFile' file = tryAny (removeFile file) >> return ()
       hiFiles          = map (\e -> "dist/build" </> removeSrc (replaceExtension hs e))
                              ["hi", "p_hi"]
 
@@ -122,7 +123,7 @@ updateFileTime :: FilePath -> FilePath -> IO ()
 updateFileTime x hs = do
   (_     , modx) <- getFileStatus' x
   (access, _   ) <- getFileStatus' hs
-  _ <- try' (setFileTimes hs access modx)
+  _ <- tryAny (setFileTimes hs access modx)
   return ()
 
 hiFile :: FilePath -> FilePath
@@ -133,9 +134,6 @@ removeSrc f = case splitPath f of
     ("src/" : xs) -> joinPath xs
     _ -> f
 
-try' :: IO x -> IO (Either SomeException x)
-try' = try
-
 isNewerThan :: FilePath -> FilePath -> IO Bool
 isNewerThan f1 f2 = do
   (_, mod1) <- getFileStatus' f1
@@ -145,7 +143,7 @@ isNewerThan f1 f2 = do
 getFileStatus' :: FilePath ->
                   IO (System.Posix.Types.EpochTime, System.Posix.Types.EpochTime)
 getFileStatus' fp = do
-    efs <- try' $ getFileStatus fp
+    efs <- tryAny $ getFileStatus fp
     case efs of
         Left _ -> return (0, 0)
         Right fs -> return (accessTime fs, modificationTime fs)
diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs
index 18de9347..701718a4 100644
--- a/yesod-bin/Devel.hs
+++ b/yesod-bin/Devel.hs
@@ -12,7 +12,7 @@ import           Control.Applicative                   ((<|>))
 import           Control.Concurrent                    (threadDelay)
 import           Control.Concurrent.Async              (race_)
 import           Control.Concurrent.STM
-import qualified Control.Exception.Safe                as Ex
+import qualified UnliftIO.Exception                    as Ex
 import           Control.Monad                         (forever, unless, void,
                                                         when)
 import Data.ByteString (ByteString, isInfixOf)
diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal
index cb8acaa0..76781ff8 100644
--- a/yesod-bin/yesod-bin.cabal
+++ b/yesod-bin/yesod-bin.cabal
@@ -52,13 +52,12 @@ executable             yesod
                      , conduit-extra
                      , resourcet          >= 0.3          && < 1.2
                      , base64-bytestring
-                     , lifted-base
                      , http-reverse-proxy >= 0.4
                      , network            >= 2.5
                      , http-client-tls
                      , http-client        >= 0.4.7
                      , project-template   >= 0.1.1
-                     , safe-exceptions
+                     , unliftio
                      , say
                      , stm
                      , transformers
diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs
index e359896b..7c2a5be8 100644
--- a/yesod-test/Yesod/Test.hs
+++ b/yesod-test/Yesod/Test.hs
@@ -133,7 +133,7 @@ import qualified Network.Socket.Internal as Sock
 import Data.CaseInsensitive (CI)
 import Network.Wai
 import Network.Wai.Test hiding (assertHeader, assertNoHeader, request)
-import qualified Control.Monad.Trans.State as ST
+import Control.Monad.Trans.Reader (ReaderT (..))
 import Control.Monad.IO.Class
 import System.IO
 import Yesod.Core.Unsafe (runFakeHandler)
@@ -145,6 +145,7 @@ import Text.XML.Cursor hiding (element)
 import qualified Text.XML.Cursor as C
 import qualified Text.HTML.DOM as HD
 import Control.Monad.Trans.Writer
+import Data.IORef
 import qualified Data.Map as M
 import qualified Web.Cookie as Cookie
 import qualified Blaze.ByteString.Builder as Builder
@@ -176,7 +177,7 @@ data YesodExampleData site = YesodExampleData
 -- | A single test case, to be run with 'yit'.
 --
 -- Since 1.2.0
-type YesodExample site = ST.StateT (YesodExampleData site) IO
+type YesodExample site = ReaderT (IORef (YesodExampleData site)) IO
 
 -- | Mapping from cookie name to value.
 --
@@ -199,13 +200,13 @@ data YesodSpecTree site
 --
 -- Since 1.2.0
 getTestYesod :: YesodExample site site
-getTestYesod = fmap yedSite ST.get
+getTestYesod = fmap yedSite getState
 
 -- | Get the most recently provided response value, if available.
 --
 -- Since 1.2.0
 getResponse :: YesodExample site (Maybe SResponse)
-getResponse = fmap yedResponse ST.get
+getResponse = fmap yedResponse getState
 
 data RequestBuilderData site = RequestBuilderData
     { rbdPostData :: RBDPostData
@@ -228,7 +229,7 @@ data RequestPart
 -- | The 'RequestBuilder' state monad constructs a URL encoded string of arguments
 -- to send with your requests. Some of the functions that run on it use the current
 -- response to analyze the forms that the server is expecting to receive.
-type RequestBuilder site = ST.StateT (RequestBuilderData site) IO
+type RequestBuilder site = ReaderT (IORef (RequestBuilderData site)) IO
 
 -- | Start describing a Tests suite keeping cookies and a reference to the tested 'Application'
 -- and 'ConnectionPool'
@@ -245,7 +246,7 @@ yesodSpec site yspecs =
     unYesod (YesodSpecGroup x y) = Hspec.specGroup x $ map unYesod y
     unYesod (YesodSpecItem x y) = Hspec.specItem x $ do
         app <- toWaiAppPlain site
-        ST.evalStateT y YesodExampleData
+        evalStateT y YesodExampleData
             { yedApp = app
             , yedSite = site
             , yedCookies = M.empty
@@ -265,7 +266,7 @@ yesodSpecWithSiteGenerator getSiteAction yspecs =
       unYesod getSiteAction' (YesodSpecItem x y) = Hspec.specItem x $ do
         site <- getSiteAction'
         app <- toWaiAppPlain site
-        ST.evalStateT y YesodExampleData
+        evalStateT y YesodExampleData
             { yedApp = app
             , yedSite = site
             , yedCookies = M.empty
@@ -286,7 +287,7 @@ yesodSpecApp site getApp yspecs =
     unYesod (YesodSpecGroup x y) = Hspec.specGroup x $ map unYesod y
     unYesod (YesodSpecItem x y) = Hspec.specItem x $ do
         app <- getApp
-        ST.evalStateT y YesodExampleData
+        evalStateT y YesodExampleData
             { yedApp = app
             , yedSite = site
             , yedCookies = M.empty
@@ -302,9 +303,9 @@ yit label example = tell [YesodSpecItem label example]
 withResponse' :: MonadIO m
               => (state -> Maybe SResponse)
               -> [T.Text]
-              -> (SResponse -> ST.StateT state m a)
-              -> ST.StateT state m a
-withResponse' getter errTrace f = maybe err f . getter =<< ST.get
+              -> (SResponse -> ReaderT (IORef state) m a)
+              -> ReaderT (IORef state) m a
+withResponse' getter errTrace f = maybe err f . getter =<< getState
  where err = failure msg
        msg = if null errTrace
              then "There was no response, you should make a request."
@@ -327,7 +328,7 @@ htmlQuery' :: MonadIO m
            => (state -> Maybe SResponse)
            -> [T.Text]
            -> Query
-           -> ST.StateT state m [HtmlLBS]
+           -> ReaderT (IORef state) m [HtmlLBS]
 htmlQuery' getter errTrace query = withResponse' getter ("Tried to invoke htmlQuery' in order to read HTML of a previous response." : errTrace) $ \ res ->
   case findBySelector (simpleBody res) query of
     Left err -> failure $ query <> " did not parse: " <> T.pack (show err)
@@ -492,14 +493,14 @@ printMatches query = do
 -- | Add a parameter with the given name and value to the request body.
 addPostParam :: T.Text -> T.Text -> RequestBuilder site ()
 addPostParam name value =
-  ST.modify $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd)) }
+  modifyState $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd)) }
   where addPostData (BinaryPostData _) = error "Trying to add post param to binary content."
         addPostData (MultipleItemsPostData posts) =
           MultipleItemsPostData $ ReqKvPart name value : posts
 
 -- | Add a parameter with the given name and value to the query string.
 addGetParam :: T.Text -> T.Text -> RequestBuilder site ()
-addGetParam name value = ST.modify $ \rbd -> rbd
+addGetParam name value = modifyState $ \rbd -> rbd
     { rbdGets = (TE.encodeUtf8 name, Just $ TE.encodeUtf8 value)
               : rbdGets rbd
     }
@@ -518,7 +519,7 @@ addFile :: T.Text -- ^ The parameter name for the file.
         -> RequestBuilder site ()
 addFile name path mimetype = do
   contents <- liftIO $ BSL8.readFile path
-  ST.modify $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd) contents) }
+  modifyState $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd) contents) }
     where addPostData (BinaryPostData _) _ = error "Trying to add file after setting binary content."
           addPostData (MultipleItemsPostData posts) contents =
             MultipleItemsPostData $ ReqFilePart name path contents mimetype : posts
@@ -526,7 +527,7 @@ addFile name path mimetype = do
 -- This looks up the name of a field based on the contents of the label pointing to it.
 nameFromLabel :: T.Text -> RequestBuilder site T.Text
 nameFromLabel label = do
-  mres <- fmap rbdResponse ST.get
+  mres <- fmap rbdResponse getState
   res <-
     case mres of
       Nothing -> failure "nameFromLabel: No response available"
@@ -703,7 +704,7 @@ addTokenFromCookieNamedToHeaderNamed cookieName headerName = do
 -- Since 1.4.3.2
 getRequestCookies :: RequestBuilder site Cookies
 getRequestCookies = do
-  requestBuilderData <- ST.get
+  requestBuilderData <- getState
   headers <- case simpleHeaders Control.Applicative.<$> rbdResponse requestBuilderData of
                   Just h -> return h
                   Nothing -> failure "getRequestCookies: No request has been made yet; the cookies can't be looked up."
@@ -811,7 +812,7 @@ getLocation = do
 -- > request $ do
 -- >   setMethod methodPut
 setMethod :: H.Method -> RequestBuilder site ()
-setMethod m = ST.modify $ \rbd -> rbd { rbdMethod = m }
+setMethod m = modifyState $ \rbd -> rbd { rbdMethod = m }
 
 -- | Sets the URL used by the request.
 --
@@ -826,7 +827,7 @@ setUrl :: (Yesod site, RedirectUrl site url)
        => url
        -> RequestBuilder site ()
 setUrl url' = do
-    site <- fmap rbdSite ST.get
+    site <- fmap rbdSite getState
     eurl <- Yesod.Core.Unsafe.runFakeHandler
         M.empty
         (const $ error "Yesod.Test: No logger available")
@@ -834,7 +835,7 @@ setUrl url' = do
         (toTextUrl url')
     url <- either (error . show) return eurl
     let (urlPath, urlQuery) = T.break (== '?') url
-    ST.modify $ \rbd -> rbd
+    modifyState $ \rbd -> rbd
         { rbdPath =
             case DL.filter (/="") $ H.decodePathSegments $ TE.encodeUtf8 urlPath of
                 ("http:":_:rest) -> rest
@@ -873,7 +874,7 @@ clickOn query = do
 -- > request $ do
 -- >   setRequestBody $ encode $ object ["age" .= (1 :: Integer)]
 setRequestBody :: BSL8.ByteString -> RequestBuilder site ()
-setRequestBody body = ST.modify $ \rbd -> rbd { rbdPostData = BinaryPostData body }
+setRequestBody body = modifyState $ \rbd -> rbd { rbdPostData = BinaryPostData body }
 
 -- | Adds the given header to the request; see "Network.HTTP.Types.Header" for creating 'Header's.
 --
@@ -883,7 +884,7 @@ setRequestBody body = ST.modify $ \rbd -> rbd { rbdPostData = BinaryPostData bod
 -- > request $ do
 -- >   addRequestHeader (hUserAgent, "Chrome/41.0.2228.0")
 addRequestHeader :: H.Header -> RequestBuilder site ()
-addRequestHeader header = ST.modify $ \rbd -> rbd
+addRequestHeader header = modifyState $ \rbd -> rbd
     { rbdHeaders = header : rbdHeaders rbd
     }
 
@@ -903,9 +904,9 @@ addRequestHeader header = ST.modify $ \rbd -> rbd
 request :: RequestBuilder site ()
         -> YesodExample site ()
 request reqBuilder = do
-    YesodExampleData app site oldCookies mRes <- ST.get
+    YesodExampleData app site oldCookies mRes <- getState
 
-    RequestBuilderData {..} <- liftIO $ ST.execStateT reqBuilder RequestBuilderData
+    RequestBuilderData {..} <- liftIO $ execStateT reqBuilder RequestBuilderData
       { rbdPostData = MultipleItemsPostData []
       , rbdResponse = mRes
       , rbdMethod = "GET"
@@ -945,7 +946,7 @@ request reqBuilder = do
         }) app
     let newCookies = parseSetCookies $ simpleHeaders response
         cookies' = M.fromList [(Cookie.setCookieName c, c) | c <- newCookies] `M.union` cookies
-    ST.put $ YesodExampleData app site cookies' (Just response)
+    putState $ YesodExampleData app site cookies' (Just response)
   where
     isFile (ReqFilePart _ _ _ _) = True
     isFile _ = False
@@ -1049,14 +1050,14 @@ testApp :: site -> Middleware -> TestApp site
 testApp site middleware = (site, middleware)
 type YSpec site = Hspec.SpecWith (TestApp site)
 
-instance YesodDispatch site => Hspec.Example (ST.StateT (YesodExampleData site) IO a) where
-    type Arg (ST.StateT (YesodExampleData site) IO a) = TestApp site
+instance YesodDispatch site => Hspec.Example (ReaderT (IORef (YesodExampleData site)) IO a) where
+    type Arg (ReaderT (IORef (YesodExampleData site)) IO a) = TestApp site
 
     evaluateExample example params action =
         Hspec.evaluateExample
             (action $ \(site, middleware) -> do
                 app <- toWaiAppPlain site
-                _ <- ST.evalStateT example YesodExampleData
+                _ <- evalStateT example YesodExampleData
                     { yedApp = middleware app
                     , yedSite = site
                     , yedCookies = M.empty
@@ -1065,3 +1066,25 @@ instance YesodDispatch site => Hspec.Example (ST.StateT (YesodExampleData site)
                 return ())
             params
             ($ ())
+
+getState :: MonadIO m => ReaderT (IORef s) m s
+getState = ReaderT $ liftIO . readIORef
+
+putState :: MonadIO m => s -> ReaderT (IORef s) m ()
+putState x = ReaderT $ \ref -> liftIO $ writeIORef ref $! x
+
+modifyState :: MonadIO m => (s -> s) -> ReaderT (IORef s) m ()
+modifyState f = ReaderT $ \ref -> liftIO $ do
+  x <- readIORef ref
+  writeIORef ref $! f x
+
+evalStateT :: MonadIO m => ReaderT (IORef s) m a -> s -> m a
+evalStateT (ReaderT f) s = do
+  ref <- liftIO $ newIORef s
+  f ref
+
+execStateT :: MonadIO m => ReaderT (IORef s) m a -> s -> m s
+execStateT (ReaderT f) s = do
+  ref <- liftIO $ newIORef s
+  _ <- f ref
+  liftIO $ readIORef ref
diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs
index 67511ee9..d495a1bb 100644
--- a/yesod-test/test/main.hs
+++ b/yesod-test/test/main.hs
@@ -34,7 +34,7 @@ import Data.ByteString.Lazy.Char8 ()
 import qualified Data.Map as Map
 import qualified Text.HTML.DOM as HD
 import Network.HTTP.Types.Status (status301, status303, unsupportedMediaType415)
-import Control.Exception.Lifted(SomeException, try)
+import UnliftIO (tryAny)
 
 parseQuery_ :: Text -> [[SelectorGroup]]
 parseQuery_ = either error id . parseQuery
@@ -189,7 +189,7 @@ main = hspec $ do
               bodyEquals "<html><head><title>Hello</title></head><body><p>Hello World</p><p>Hello Moon</p></body></html>"
 
               get ("/htmlWithLink" :: Text)
-              (bad :: Either SomeException ()) <- try (clickOn "a#nonexistentlink")
+              bad <- tryAny (clickOn "a#nonexistentlink")
               assertEq "bad link" (isLeft bad) True
 
 
diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal
index d2df283d..dce4620b 100644
--- a/yesod-test/yesod-test.cabal
+++ b/yesod-test/yesod-test.cabal
@@ -61,8 +61,8 @@ test-suite test
                           , yesod-form >= 1.4.14
                           , text
                           , wai
-                          , lifted-base
                           , http-types
+                          , unliftio
 
 source-repository head
   type: git

From eac95935e6fff7f01634b56d41960b4b4577ae8b Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sat, 30 Dec 2017 22:47:56 +0200
Subject: [PATCH 11/43] Switch over to WIP conduit 1.3

---
 yesod-bin/yesod-bin.cabal                 | 6 +++---
 yesod-core/yesod-core.cabal               | 4 ++--
 yesod-eventsource/yesod-eventsource.cabal | 2 +-
 3 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal
index 64f9b818..3bb4f2b5 100644
--- a/yesod-bin/yesod-bin.cabal
+++ b/yesod-bin/yesod-bin.cabal
@@ -48,9 +48,9 @@ executable             yesod
                      , fsnotify           >= 0.0          && < 0.3
                      , split              >= 0.2          && < 0.3
                      , file-embed
-                     , conduit            >= 1.2
-                     , conduit-extra      >= 1.2.2
-                     , resourcet          >= 0.3          && < 1.2
+                     , conduit            >= 1.3
+                     , conduit-extra      >= 1.3
+                     , resourcet          >= 1.2
                      , base64-bytestring
                      , lifted-base
                      , http-reverse-proxy >= 0.4
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index 84ae5ab0..dd5306ec 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -51,8 +51,8 @@ library
                    , fast-logger           >= 2.2
                    , wai-logger            >= 0.2
                    , monad-logger          >= 0.3.10   && < 0.4
-                   , conduit               >= 1.2
-                   , resourcet             >= 0.4.9    && < 1.2
+                   , conduit               >= 1.3
+                   , resourcet             >= 1.2
                    , lifted-base           >= 0.1.2
                    , blaze-html            >= 0.5
                    , blaze-markup          >= 0.7.1
diff --git a/yesod-eventsource/yesod-eventsource.cabal b/yesod-eventsource/yesod-eventsource.cabal
index bb64a9e3..db77ea47 100644
--- a/yesod-eventsource/yesod-eventsource.cabal
+++ b/yesod-eventsource/yesod-eventsource.cabal
@@ -16,7 +16,7 @@ extra-source-files: README.md ChangeLog.md
 library
     build-depends:   base                  >= 4        && < 5
                    , yesod-core            == 1.4.*
-                   , conduit               >= 0.5      && < 1.3
+                   , conduit               >= 1.3
                    , wai                   >= 1.3
                    , wai-eventsource       >= 1.3
                    , wai-extra

From a16e75249a0c61359664c5b3b410802b2f28bab8 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 31 Dec 2017 09:20:02 +0200
Subject: [PATCH 12/43] More moving over to unliftio

---
 yesod-auth/Yesod/Auth/GoogleEmail.hs          | 89 -------------------
 yesod-auth/Yesod/Auth/OpenId.hs               |  2 +-
 yesod-auth/yesod-auth.cabal                   |  3 +-
 yesod-core/Yesod/Core.hs                      |  7 +-
 yesod-core/Yesod/Core/Class/Handler.hs        | 14 ++-
 yesod-core/Yesod/Core/Content.hs              |  2 +-
 yesod-core/Yesod/Core/Handler.hs              | 18 ++--
 yesod-core/Yesod/Core/Json.hs                 |  2 +-
 yesod-core/Yesod/Core/Types.hs                | 56 +-----------
 yesod-core/test/YesodCoreTest/Cache.hs        |  2 +-
 .../test/YesodCoreTest/ErrorHandling.hs       |  6 +-
 yesod-core/yesod-core.cabal                   |  7 +-
 yesod-static/Yesod/Static.hs                  |  2 +-
 yesod-websockets/Yesod/WebSockets.hs          | 49 ++--------
 yesod-websockets/yesod-websockets.cabal       |  4 +-
 15 files changed, 39 insertions(+), 224 deletions(-)
 delete mode 100644 yesod-auth/Yesod/Auth/GoogleEmail.hs

diff --git a/yesod-auth/Yesod/Auth/GoogleEmail.hs b/yesod-auth/Yesod/Auth/GoogleEmail.hs
deleted file mode 100644
index eb0b6cee..00000000
--- a/yesod-auth/Yesod/Auth/GoogleEmail.hs
+++ /dev/null
@@ -1,89 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE RankNTypes #-}
--- | Use an email address as an identifier via Google's OpenID login system.
---
--- This backend will not use the OpenID identifier at all. It only uses OpenID
--- as a login system. By using this plugin, you are trusting Google to validate
--- an email address, and requiring users to have a Google account. On the plus
--- side, you get to use email addresses as the identifier, many users have
--- existing Google accounts, the login system has been long tested (as opposed
--- to BrowserID), and it requires no credential managing or setup (as opposed
--- to Email).
-module Yesod.Auth.GoogleEmail
-    {-# DEPRECATED "Google no longer provides OpenID support, please use Yesod.Auth.GoogleEmail2" #-}
-    ( authGoogleEmail
-    , forwardUrl
-    ) where
-
-import Yesod.Auth
-import qualified Web.Authenticate.OpenId as OpenId
-
-import Yesod.Core
-import Data.Text (Text)
-import qualified Yesod.Auth.Message as Msg
-import qualified Data.Text as T
-import Control.Exception.Lifted (try, SomeException)
-
-pid :: Text
-pid = "googleemail"
-
-forwardUrl :: AuthRoute
-forwardUrl = PluginR pid ["forward"]
-
-googleIdent :: Text
-googleIdent = "https://www.google.com/accounts/o8/id"
-
-authGoogleEmail :: YesodAuth m => AuthPlugin m
-authGoogleEmail =
-    AuthPlugin pid dispatch login
-  where
-    complete = PluginR pid ["complete"]
-    login tm =
-        [whamlet|<a href=@{tm forwardUrl}>_{Msg.LoginGoogle}|]
-    dispatch "GET" ["forward"] = do
-        render <- getUrlRender
-        let complete' = render complete
-        master <- lift getYesod
-        eres <- lift $ try $ OpenId.getForwardUrl googleIdent complete' Nothing
-            [ ("openid.ax.type.email", "http://schema.openid.net/contact/email")
-            , ("openid.ns.ax", "http://openid.net/srv/ax/1.0")
-            , ("openid.ns.ax.required", "email")
-            , ("openid.ax.mode", "fetch_request")
-            , ("openid.ax.required", "email")
-            , ("openid.ui.icon", "true")
-            ] (authHttpManager master)
-        either
-          (\err -> do
-            tm <- getRouteToParent
-            lift $ loginErrorMessage (tm LoginR) $ T.pack $ show (err :: SomeException))
-          redirect
-          eres
-    dispatch "GET" ["complete", ""] = dispatch "GET" ["complete"] -- compatibility issues
-    dispatch "GET" ["complete"] = do
-        rr <- getRequest
-        completeHelper $ reqGetParams rr
-    dispatch "POST" ["complete", ""] = dispatch "POST" ["complete"] -- compatibility issues
-    dispatch "POST" ["complete"] = do
-        (posts, _) <- runRequestBody
-        completeHelper posts
-    dispatch _ _ = notFound
-
-completeHelper :: [(Text, Text)] -> AuthHandler master TypedContent
-completeHelper gets' = do
-      master <- lift getYesod
-      eres <- lift $ try $ OpenId.authenticateClaimed gets' (authHttpManager master)
-      tm <- getRouteToParent
-      either (onFailure tm) (onSuccess tm) eres
-    where
-      onFailure tm err =
-        lift $ loginErrorMessage (tm LoginR) $ T.pack $ show (err :: SomeException)
-      onSuccess tm oir = do
-              let OpenId.Identifier ident = OpenId.oirOpLocal oir
-              memail <- lookupGetParam "openid.ext1.value.email"
-              case (memail, "https://www.google.com/accounts/o8/id" `T.isPrefixOf` ident) of
-                  (Just email, True) -> lift $ setCredsRedirect $ Creds pid email []
-                  (_, False)   -> lift $ loginErrorMessage (tm LoginR) "Only Google login is supported"
-                  (Nothing, _) -> lift $ loginErrorMessage (tm LoginR) "No email address provided"
diff --git a/yesod-auth/Yesod/Auth/OpenId.hs b/yesod-auth/Yesod/Auth/OpenId.hs
index f32ff747..fce1f1bf 100644
--- a/yesod-auth/Yesod/Auth/OpenId.hs
+++ b/yesod-auth/Yesod/Auth/OpenId.hs
@@ -19,7 +19,7 @@ import Yesod.Form
 import Yesod.Core
 import Data.Text (Text, isPrefixOf)
 import qualified Yesod.Auth.Message as Msg
-import Control.Exception.Lifted (SomeException, try)
+import UnliftIO.Exception (SomeException, try)
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 
diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal
index 1de994a2..21f78a81 100644
--- a/yesod-auth/yesod-auth.cabal
+++ b/yesod-auth/yesod-auth.cabal
@@ -43,7 +43,7 @@ library
                    , http-client
                    , http-conduit            >= 2.1
                    , aeson                   >= 0.7
-                   , lifted-base             >= 0.1
+                   , unliftio
                    , blaze-html              >= 0.5
                    , blaze-markup            >= 0.5.1
                    , http-types
@@ -74,7 +74,6 @@ library
                      Yesod.Auth.OpenId
                      Yesod.Auth.Rpxnow
                      Yesod.Auth.Message
-                     Yesod.Auth.GoogleEmail
                      Yesod.Auth.GoogleEmail2
                      Yesod.Auth.Hardcoded
                      Yesod.Auth.Util.PasswordStore
diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs
index 1d5de1d1..2f81a9ba 100644
--- a/yesod-core/Yesod/Core.hs
+++ b/yesod-core/Yesod/Core.hs
@@ -95,8 +95,7 @@ module Yesod.Core
     , module Text.Blaze.Html
     , MonadTrans (..)
     , MonadIO (..)
-    , MonadBase (..)
-    , MonadBaseControl
+    , MonadUnliftIO (..)
     , MonadResource (..)
     , MonadLogger
       -- * Commonly referenced functions/datatypes
@@ -143,9 +142,7 @@ import qualified Yesod.Core.Internal.Run
 import qualified Paths_yesod_core
 import Data.Version (showVersion)
 import Yesod.Routes.Class
-import Control.Monad.IO.Class (MonadIO (..))
-import Control.Monad.Base (MonadBase (..))
-import Control.Monad.Trans.Control (MonadBaseControl (..))
+import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO (..))
 
 import Control.Monad.Trans.Resource (MonadResource (..))
 import Yesod.Core.Internal.LiteApp
diff --git a/yesod-core/Yesod/Core/Class/Handler.hs b/yesod-core/Yesod/Core/Class/Handler.hs
index 8e447eab..6e979c2e 100644
--- a/yesod-core/Yesod/Core/Class/Handler.hs
+++ b/yesod-core/Yesod/Core/Class/Handler.hs
@@ -5,15 +5,14 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- Because of ErrorT
 module Yesod.Core.Class.Handler
     ( MonadHandler (..)
     , MonadWidget (..)
     ) where
 
 import Yesod.Core.Types
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Resource (MonadResource, MonadResourceBase)
+import Control.Monad.IO.Unlift (liftIO, MonadUnliftIO, MonadIO)
+import Control.Monad.Trans.Resource (MonadResource)
 import Control.Monad.Trans.Class (lift)
 #if __GLASGOW_HASKELL__ < 710
 import Data.Monoid (Monoid)
@@ -23,7 +22,6 @@ import Data.Conduit.Internal (Pipe, ConduitM)
 import Control.Monad.Trans.Identity ( IdentityT)
 import Control.Monad.Trans.List     ( ListT    )
 import Control.Monad.Trans.Maybe    ( MaybeT   )
-import Control.Monad.Trans.Error    ( ErrorT, Error)
 import Control.Monad.Trans.Except   ( ExceptT  )
 import Control.Monad.Trans.Reader   ( ReaderT  )
 import Control.Monad.Trans.State    ( StateT   )
@@ -40,12 +38,12 @@ class MonadResource m => MonadHandler m where
 replaceToParent :: HandlerData site route -> HandlerData site ()
 replaceToParent hd = hd { handlerToParent = const () }
 
-instance MonadResourceBase m => MonadHandler (HandlerT site m) where
+instance MonadIO m => MonadHandler (HandlerT site m) where
     type HandlerSite (HandlerT site m) = site
     liftHandlerT (HandlerT f) = HandlerT $ liftIO . f . replaceToParent
 {-# RULES "liftHandlerT (HandlerT site IO)" liftHandlerT = id #-}
 
-instance MonadResourceBase m => MonadHandler (WidgetT site m) where
+instance MonadIO m => MonadHandler (WidgetT site m) where
     type HandlerSite (WidgetT site m) = site
     liftHandlerT (HandlerT f) = WidgetT $ \_ref env -> liftIO $ f $ replaceToParent env
 {-# RULES "liftHandlerT (WidgetT site IO)" forall f. liftHandlerT (HandlerT f) = WidgetT $ const f #-}
@@ -55,7 +53,6 @@ instance MonadResourceBase m => MonadHandler (WidgetT site m) where
 GO(IdentityT)
 GO(ListT)
 GO(MaybeT)
-GOX(Error e, ErrorT e)
 GO(ExceptT e)
 GO(ReaderT r)
 GO(StateT s)
@@ -71,7 +68,7 @@ GO(ConduitM i o)
 
 class MonadHandler m => MonadWidget m where
     liftWidgetT :: WidgetT (HandlerSite m) IO a -> m a
-instance MonadResourceBase m => MonadWidget (WidgetT site m) where
+instance MonadIO m => MonadWidget (WidgetT site m) where
     liftWidgetT (WidgetT f) = WidgetT $ \ref env -> liftIO $ f ref $ replaceToParent env
 
 #define GO(T) instance MonadWidget m => MonadWidget (T m) where liftWidgetT = lift . liftWidgetT
@@ -79,7 +76,6 @@ instance MonadResourceBase m => MonadWidget (WidgetT site m) where
 GO(IdentityT)
 GO(ListT)
 GO(MaybeT)
-GOX(Error e, ErrorT e)
 GO(ExceptT e)
 GO(ReaderT r)
 GO(StateT s)
diff --git a/yesod-core/Yesod/Core/Content.hs b/yesod-core/Yesod/Core/Content.hs
index d98d967e..d33d87ad 100644
--- a/yesod-core/Yesod/Core/Content.hs
+++ b/yesod-core/Yesod/Core/Content.hs
@@ -117,7 +117,7 @@ instance ToContent Javascript where
     toContent = toContent . toLazyText . unJavascript
 
 instance ToFlushBuilder builder => ToContent (CI.Pipe () () builder () (ResourceT IO) ()) where
-    toContent src = ContentSource $ CI.ConduitM (CI.mapOutput toFlushBuilder src >>=)
+    toContent src = ContentSource $ CI.ConduitT (CI.mapOutput toFlushBuilder src >>=)
 
 instance ToFlushBuilder builder => ToContent (Source (ResourceT IO) builder) where
     toContent src = ContentSource $ mapOutput toFlushBuilder src
diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs
index bfd254d0..3395b3bd 100644
--- a/yesod-core/Yesod/Core/Handler.hs
+++ b/yesod-core/Yesod/Core/Handler.hs
@@ -194,12 +194,12 @@ import           Data.Monoid                   (mempty, mappend)
 #endif
 import           Control.Applicative           ((<|>))
 import           Control.Exception             (evaluate, SomeException, throwIO)
-import           Control.Exception.Lifted      (handle)
+import           Control.Exception             (handle)
 
 import           Control.Monad                 (void, liftM, unless)
 import qualified Control.Monad.Trans.Writer    as Writer
 
-import           Control.Monad.IO.Class        (MonadIO, liftIO)
+import           Control.Monad.IO.Unlift       (MonadIO, liftIO, MonadUnliftIO, withRunInIO)
 
 import qualified Network.HTTP.Types            as H
 import qualified Network.Wai                   as W
@@ -233,7 +233,7 @@ import           Yesod.Core.Content            (ToTypedContent (..), simpleConte
 import           Yesod.Core.Internal.Util      (formatRFC1123)
 import           Text.Blaze.Html               (preEscapedToHtml, toHtml)
 
-import qualified Data.IORef.Lifted             as I
+import qualified Data.IORef                    as I
 import           Data.Maybe                    (listToMaybe, mapMaybe)
 import           Data.Typeable                 (Typeable)
 import           Web.PathPieces                (PathPiece(..))
@@ -246,7 +246,6 @@ import           Data.CaseInsensitive (CI, original)
 import qualified Data.Conduit.List as CL
 import           Control.Monad.Trans.Resource  (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO)
 import qualified System.PosixCompat.Files as PC
-import           Control.Monad.Trans.Control (control, MonadBaseControl)
 import           Data.Conduit (Source, transPipe, Flush (Flush), yield, Producer, Sink)
 import qualified Yesod.Core.TypeCache as Cache
 import qualified Data.Word8 as W8
@@ -447,7 +446,8 @@ forkHandler :: (SomeException -> HandlerT site IO ()) -- ^ error handler
               -> HandlerT site IO ()
 forkHandler onErr handler = do
     yesRunner <- handlerToIO
-    void $ liftResourceT $ resourceForkIO $ yesRunner $ handle onErr handler
+    void $ liftResourceT $ resourceForkIO $
+      liftIO $ handle (yesRunner . onErr) (yesRunner handler)
 
 -- | Redirect to the given route.
 -- HTTP status code 303 for HTTP 1.1 clients and 302 for HTTP 1.0
@@ -664,10 +664,10 @@ sendWaiApplication = handlerError . HCWaiApp
 --
 -- @since 1.2.16
 sendRawResponseNoConduit
-    :: (MonadHandler m, MonadBaseControl IO m)
+    :: (MonadHandler m, MonadUnliftIO m)
     => (IO S8.ByteString -> (S8.ByteString -> IO ()) -> m ())
     -> m a
-sendRawResponseNoConduit raw = control $ \runInIO ->
+sendRawResponseNoConduit raw = withRunInIO $ \runInIO ->
     liftIO $ throwIO $ HCWai $ flip W.responseRaw fallback
     $ \src sink -> void $ runInIO (raw src sink)
   where
@@ -679,10 +679,10 @@ sendRawResponseNoConduit raw = control $ \runInIO ->
 -- Warp).
 --
 -- @since 1.2.7
-sendRawResponse :: (MonadHandler m, MonadBaseControl IO m)
+sendRawResponse :: (MonadHandler m, MonadUnliftIO m)
                 => (Source IO S8.ByteString -> Sink S8.ByteString IO () -> m ())
                 -> m a
-sendRawResponse raw = control $ \runInIO ->
+sendRawResponse raw = withRunInIO $ \runInIO ->
     liftIO $ throwIO $ HCWai $ flip W.responseRaw fallback
     $ \src sink -> void $ runInIO $ raw (src' src) (CL.mapM_ sink)
   where
diff --git a/yesod-core/Yesod/Core/Json.hs b/yesod-core/Yesod/Core/Json.hs
index 245aad90..94c1e1b9 100644
--- a/yesod-core/Yesod/Core/Json.hs
+++ b/yesod-core/Yesod/Core/Json.hs
@@ -104,7 +104,7 @@ provideJson = provideRep . return . J.toEncoding
 -- @since 0.3.0
 parseJsonBody :: (MonadHandler m, J.FromJSON a) => m (J.Result a)
 parseJsonBody = do
-    eValue <- rawRequestBody $$ runCatchC (sinkParser JP.value')
+    eValue <- runConduit $ rawRequestBody .| runCatchC (sinkParser JP.value')
     return $ case eValue of
         Left e -> J.Error $ show e
         Right value -> J.fromJSON value
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index fd4572de..680c13b8 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -19,13 +19,10 @@ import           Data.Monoid                        (Monoid (..))
 import           Control.Arrow                      (first)
 import           Control.Exception                  (Exception)
 import           Control.Monad                      (liftM, ap)
-import           Control.Monad.Base                 (MonadBase (liftBase))
-import           Control.Monad.Catch                (MonadMask (..), MonadCatch (..))
 import           Control.Monad.IO.Class             (MonadIO (liftIO))
 import           Control.Monad.Logger               (LogLevel, LogSource,
                                                      MonadLogger (..))
-import           Control.Monad.Trans.Control        (MonadBaseControl (..))
-import           Control.Monad.Trans.Resource       (MonadResource (..), InternalState, runInternalState, MonadThrow (..), monadThrow, ResourceT)
+import           Control.Monad.Trans.Resource       (MonadResource (..), InternalState, runInternalState, MonadThrow (..), throwM, ResourceT)
 import           Data.ByteString                    (ByteString)
 import qualified Data.ByteString.Lazy               as L
 import           Data.Conduit                       (Flush, Source)
@@ -417,14 +414,6 @@ instance Monad m => Monad (WidgetT site m) where
         unWidgetT (f a) ref r
 instance MonadIO m => MonadIO (WidgetT site m) where
     liftIO = lift . liftIO
-instance MonadBase b m => MonadBase b (WidgetT site m) where
-    liftBase = WidgetT . const . const . liftBase
-instance MonadBaseControl b m => MonadBaseControl b (WidgetT site m) where
-    type StM (WidgetT site m) a = StM m a
-    liftBaseWith f = WidgetT $ \ref reader' ->
-        liftBaseWith $ \runInBase ->
-            f $ runInBase . (\(WidgetT w) -> w ref reader')
-    restoreM = WidgetT . const . const . restoreM
 -- | @since 1.4.38
 instance MonadUnliftIO m => MonadUnliftIO (WidgetT site m) where
   {-# INLINE askUnliftIO #-}
@@ -444,29 +433,8 @@ instance MonadTrans (WidgetT site) where
 instance MonadThrow m => MonadThrow (WidgetT site m) where
     throwM = lift . throwM
 
-instance MonadCatch m => MonadCatch (HandlerT site m) where
-  catch (HandlerT m) c = HandlerT $ \r -> m r `catch` \e -> unHandlerT (c e) r
-instance MonadMask m => MonadMask (HandlerT site m) where
-  mask a = HandlerT $ \e -> mask $ \u -> unHandlerT (a $ q u) e
-    where q u (HandlerT b) = HandlerT (u . b)
-  uninterruptibleMask a =
-    HandlerT $ \e -> uninterruptibleMask $ \u -> unHandlerT (a $ q u) e
-      where q u (HandlerT b) = HandlerT (u . b)
-instance MonadCatch m => MonadCatch (WidgetT site m) where
-  catch (WidgetT m) c = WidgetT $ \ref r -> m ref r `catch` \e -> unWidgetT (c e) ref r
-instance MonadMask m => MonadMask (WidgetT site m) where
-  mask a = WidgetT $ \ref e -> mask $ \u -> unWidgetT (a $ q u) ref e
-    where q u (WidgetT b) = WidgetT (\ref e -> u $ b ref e)
-  uninterruptibleMask a =
-    WidgetT $ \ref e -> uninterruptibleMask $ \u -> unWidgetT (a $ q u) ref e
-      where q u (WidgetT b) = WidgetT (\ref e -> u $ b ref e)
-
 -- CPP to avoid a redundant constraints warning
-#if MIN_VERSION_base(4,9,0)
-instance (MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (WidgetT site m) where
-#else
-instance (Applicative m, MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (WidgetT site m) where
-#endif
+instance MonadIO m => MonadResource (WidgetT site m) where
     liftResourceT f = WidgetT $ \_ hd -> liftIO $ runInternalState f (handlerResource hd)
 
 instance MonadIO m => MonadLogger (WidgetT site m) where
@@ -495,8 +463,6 @@ instance Monad m => Monad (HandlerT site m) where
     HandlerT x >>= f = HandlerT $ \r -> x r >>= \x' -> unHandlerT (f x') r
 instance MonadIO m => MonadIO (HandlerT site m) where
     liftIO = lift . liftIO
-instance MonadBase b m => MonadBase b (HandlerT site m) where
-    liftBase = lift . liftBase
 instance Monad m => MonadReader site (HandlerT site m) where
     ask = HandlerT $ return . rheSite . handlerEnv
     local f (HandlerT g) = HandlerT $ \hd -> g hd
@@ -504,20 +470,6 @@ instance Monad m => MonadReader site (HandlerT site m) where
             { rheSite = f $ rheSite $ handlerEnv hd
             }
         }
--- | Note: although we provide a @MonadBaseControl@ instance, @lifted-base@'s
--- @fork@ function is incompatible with the underlying @ResourceT@ system.
--- Instead, if you must fork a separate thread, you should use
--- @resourceForkIO@.
---
--- Using fork usually leads to an exception that says
--- \"Control.Monad.Trans.Resource.register\': The mutable state is being accessed
--- after cleanup. Please contact the maintainers.\"
-instance MonadBaseControl b m => MonadBaseControl b (HandlerT site m) where
-    type StM (HandlerT site m) a = StM m a
-    liftBaseWith f = HandlerT $ \reader' ->
-        liftBaseWith $ \runInBase ->
-            f $ runInBase . (\(HandlerT r) -> r reader')
-    restoreM = HandlerT . const . restoreM
 -- | @since 1.4.38
 instance MonadUnliftIO m => MonadUnliftIO (HandlerT site m) where
   {-# INLINE askUnliftIO #-}
@@ -526,9 +478,9 @@ instance MonadUnliftIO m => MonadUnliftIO (HandlerT site m) where
                 return (UnliftIO (unliftIO u . flip unHandlerT r))
 
 instance MonadThrow m => MonadThrow (HandlerT site m) where
-    throwM = lift . monadThrow
+    throwM = lift . throwM
 
-instance (MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (HandlerT site m) where
+instance MonadIO m => MonadResource (HandlerT site m) where
     liftResourceT f = HandlerT $ \hd -> liftIO $ runInternalState f (handlerResource hd)
 
 instance MonadIO m => MonadLogger (HandlerT site m) where
diff --git a/yesod-core/test/YesodCoreTest/Cache.hs b/yesod-core/test/YesodCoreTest/Cache.hs
index 04282f81..e1ba9204 100644
--- a/yesod-core/test/YesodCoreTest/Cache.hs
+++ b/yesod-core/test/YesodCoreTest/Cache.hs
@@ -15,7 +15,7 @@ import Network.Wai
 import Network.Wai.Test
 
 import Yesod.Core
-import Data.IORef.Lifted
+import UnliftIO.IORef
 import Data.Typeable (Typeable)
 import qualified Data.ByteString.Lazy.Char8 as L8
 
diff --git a/yesod-core/test/YesodCoreTest/ErrorHandling.hs b/yesod-core/test/YesodCoreTest/ErrorHandling.hs
index f8517b36..db8dfe1c 100644
--- a/yesod-core/test/YesodCoreTest/ErrorHandling.hs
+++ b/yesod-core/test/YesodCoreTest/ErrorHandling.hs
@@ -18,7 +18,9 @@ import Blaze.ByteString.Builder (Builder, fromByteString, toLazyByteString)
 import Data.Monoid (mconcat)
 import Data.Text (Text, pack)
 import Control.Monad (forM_)
-import qualified Control.Exception.Lifted as E
+import Control.Monad.Trans.State (StateT (..))
+import Control.Monad.Trans.Reader (ReaderT (..))
+import qualified UnliftIO.Exception as E
 
 data App = App
 
@@ -217,6 +219,6 @@ caseGoodBuilder = runner $ do
 caseError :: Int -> IO ()
 caseError i = runner $ do
     res <- request defaultRequest { pathInfo = ["error", pack $ show i] }
-    assertStatus 500 res `E.catch` \e -> do
+    ReaderT $ \r -> StateT $ \s -> runStateT (runReaderT (assertStatus 500 res) r) s `E.catch` \e -> do
         liftIO $ print res
         E.throwIO (e :: E.SomeException)
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index dd5306ec..44e35973 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -39,8 +39,6 @@ library
                    , old-locale            >= 1.0.0.2  && < 1.1
                    , containers            >= 0.2
                    , unordered-containers  >= 0.2
-                   , monad-control         >= 1.0      && < 1.1
-                   , transformers-base     >= 0.4
                    , cookie                >= 0.4.2    && < 0.5
                    , http-types            >= 0.7
                    , case-insensitive      >= 0.2
@@ -53,15 +51,14 @@ library
                    , monad-logger          >= 0.3.10   && < 0.4
                    , conduit               >= 1.3
                    , resourcet             >= 1.2
-                   , lifted-base           >= 0.1.2
                    , blaze-html            >= 0.5
                    , blaze-markup          >= 0.7.1
+                   -- FIXME remove!
                    , data-default
                    , safe
                    , warp                  >= 3.0.2
                    , unix-compat
                    , conduit-extra
-                   , exceptions            >= 0.6
                    , deepseq               >= 1.3
                    , deepseq-generics
                    , mwc-random
@@ -196,7 +193,6 @@ test-suite tests
                   ,transformers
                   , conduit
                   , containers
-                  , lifted-base
                   , resourcet
                   , network
                   , async
@@ -206,6 +202,7 @@ test-suite tests
                   , wai-extra
                   , mwc-random
                   , cookie >= 0.4.1    && < 0.5
+                  , unliftio
     ghc-options:     -Wall
     extensions: TemplateHaskell
 
diff --git a/yesod-static/Yesod/Static.hs b/yesod-static/Yesod/Static.hs
index 636bd333..883bf62e 100644
--- a/yesod-static/Yesod/Static.hs
+++ b/yesod-static/Yesod/Static.hs
@@ -175,7 +175,7 @@ instance RenderRoute Static where
 instance ParseRoute Static where
     parseRoute (x, y) = Just $ StaticRoute x y
 
-instance (MonadThrow m, MonadIO m, MonadBaseControl IO m)
+instance (MonadThrow m, MonadUnliftIO m)
   => YesodSubDispatch Static (HandlerT master m) where
     yesodSubDispatch YesodSubRunnerEnv {..} req =
         ysreParentRunner base ysreParentEnv (fmap ysreToParentRoute route) req
diff --git a/yesod-websockets/Yesod/WebSockets.hs b/yesod-websockets/Yesod/WebSockets.hs
index 243d854f..2346b03c 100644
--- a/yesod-websockets/Yesod/WebSockets.hs
+++ b/yesod-websockets/Yesod/WebSockets.hs
@@ -34,19 +34,14 @@ module Yesod.WebSockets
     , WS.ConnectionOptions (..)
     ) where
 
-import qualified Control.Concurrent.Async       as A
 import           Control.Monad                  (forever, void, when)
-import           Control.Monad.IO.Class         (MonadIO (liftIO))
-import           Control.Monad.Trans.Control    (control)
-import           Control.Monad.Trans.Control    (MonadBaseControl (liftBaseWith, restoreM))
 import           Control.Monad.Trans.Reader     (ReaderT (ReaderT, runReaderT))
 import qualified Data.Conduit                   as C
 import qualified Data.Conduit.List              as CL
 import qualified Network.Wai.Handler.WebSockets as WaiWS
 import qualified Network.WebSockets             as WS
 import qualified Yesod.Core                     as Y
-import           Control.Exception (SomeException)
-import           Control.Exception.Enclosed (tryAny)
+import           UnliftIO (SomeException, tryAny, MonadIO, liftIO, MonadUnliftIO, withRunInIO, race, race_, concurrently, concurrently_)
 
 -- | A transformer for a WebSockets handler.
 --
@@ -60,14 +55,14 @@ type WebSocketsT = ReaderT WS.Connection
 -- instead.
 --
 -- Since 0.1.0
-webSockets :: (Y.MonadBaseControl IO m, Y.MonadHandler m) => WebSocketsT m () -> m ()
+webSockets :: (Y.MonadUnliftIO m, Y.MonadHandler m) => WebSocketsT m () -> m ()
 webSockets = webSocketsOptions WS.defaultConnectionOptions
 
 -- | Varient of 'webSockets' which allows you to specify
 -- the WS.ConnectionOptions setttings when upgrading to a websocket connection.
 --
 -- Since 0.2.5
-webSocketsOptions :: (Y.MonadBaseControl IO m, Y.MonadHandler m)
+webSocketsOptions :: (Y.MonadUnliftIO m, Y.MonadHandler m)
                => WS.ConnectionOptions
                -> WebSocketsT m ()
                -> m ()
@@ -81,7 +76,7 @@ webSocketsOptions opts = webSocketsOptionsWith opts $ const $ return $ Just $ WS
 -- setttings when upgrading to a websocket connection.
 --
 -- Since 0.2.4
-webSocketsWith :: (Y.MonadBaseControl IO m, Y.MonadHandler m)
+webSocketsWith :: (Y.MonadUnliftIO m, Y.MonadHandler m)
                => (WS.RequestHead -> m (Maybe WS.AcceptRequest))
                -- ^ A Nothing indicates that the websocket upgrade request should not happen
                -- and instead the rest of the handler will be called instead.  This allows
@@ -98,7 +93,7 @@ webSocketsWith = webSocketsOptionsWith WS.defaultConnectionOptions
 -- setttings when upgrading to a websocket connection.
 --
 -- Since 0.2.5
-webSocketsOptionsWith :: (Y.MonadBaseControl IO m, Y.MonadHandler m)
+webSocketsOptionsWith :: (Y.MonadUnliftIO m, Y.MonadHandler m)
                => WS.ConnectionOptions
                -- ^ Custom websockets options
                -> (WS.RequestHead -> m (Maybe WS.AcceptRequest))
@@ -119,7 +114,7 @@ webSocketsOptionsWith wsConnOpts buildAr inner = do
             Nothing -> return ()
             Just ar ->
                 Y.sendRawResponseNoConduit
-                  $ \src sink -> control $ \runInIO -> WaiWS.runWebSockets
+                  $ \src sink -> withRunInIO $ \runInIO -> WaiWS.runWebSockets
                     wsConnOpts
                     rhead
                     (\pconn -> do
@@ -227,35 +222,3 @@ sinkWSText = CL.mapM_ sendTextData
 -- Since 0.1.0
 sinkWSBinary :: (MonadIO m, WS.WebSocketsData a) => C.Consumer a (WebSocketsT m) ()
 sinkWSBinary = CL.mapM_ sendBinaryData
-
--- | Generalized version of 'A.race'.
---
--- Since 0.1.0
-race :: MonadBaseControl IO m => m a -> m b -> m (Either a b)
-race x y = liftBaseWith (\run -> A.race (run x) (run y))
-    >>= either (fmap Left . restoreM) (fmap Right . restoreM)
-
--- | Generalized version of 'A.race_'.
---
--- Since 0.1.0
-race_ :: MonadBaseControl IO m => m a -> m b -> m ()
-race_ x y = void $ race x y
-
--- | Generalized version of 'A.concurrently'. Note that if your underlying
--- monad has some kind of mutable state, the state from the second action will
--- overwrite the state from the first.
---
--- Since 0.1.0
-concurrently :: MonadBaseControl IO m => m a -> m b -> m (a, b)
-concurrently x y = do
-    (resX, resY) <- liftBaseWith $ \run -> A.concurrently (run x) (run y)
-    x' <- restoreM resX
-    y' <- restoreM resY
-    return (x', y')
-
--- | Run two actions concurrently (like 'A.concurrently'), but discard their
--- results and any modified monadic state.
---
--- Since 0.1.0
-concurrently_ :: MonadBaseControl IO m => m a -> m b -> m ()
-concurrently_ x y = void $ liftBaseWith $ \run -> A.concurrently (run x) (run y)
diff --git a/yesod-websockets/yesod-websockets.cabal b/yesod-websockets/yesod-websockets.cabal
index 81a9f147..70bfc00b 100644
--- a/yesod-websockets/yesod-websockets.cabal
+++ b/yesod-websockets/yesod-websockets.cabal
@@ -24,10 +24,8 @@ library
                      , websockets        >= 0.9
                      , transformers      >= 0.2
                      , yesod-core        >= 1.4
-                     , monad-control     >= 0.3
+                     , unliftio
                      , conduit           >= 1.0.15.1
-                     , async             >= 2.0.1.5
-                     , enclosed-exceptions >= 1.0
 
 source-repository head
   type:     git

From 103c098cf84ac9a47f300c0ec5f1665c36f238a4 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 10 Jan 2018 12:16:31 -0800
Subject: [PATCH 13/43] Catch up with Data.Conduit.Combinators

---
 yesod-auth/yesod-auth.cabal                   |  2 +-
 yesod-bin/Devel.hs                            | 11 +++--
 yesod-bin/HsFile.hs                           | 16 ++++----
 yesod-core/Yesod/Core/Class/Yesod.hs          | 18 ++++----
 yesod-core/Yesod/Core/Content.hs              | 41 ++++++++++---------
 yesod-core/Yesod/Core/Dispatch.hs             |  7 ++--
 yesod-core/Yesod/Core/Handler.hs              | 31 +++++++-------
 yesod-core/Yesod/Core/Internal/Request.hs     |  6 +--
 yesod-core/Yesod/Core/Internal/Response.hs    |  8 ++--
 yesod-core/Yesod/Core/Internal/Run.hs         |  5 ++-
 yesod-core/Yesod/Core/Types.hs                | 21 ++++------
 yesod-core/test/YesodCoreTest/CleanPath.hs    |  4 +-
 .../test/YesodCoreTest/ErrorHandling.hs       |  4 +-
 yesod-core/test/YesodCoreTest/Links.hs        |  4 +-
 yesod-core/test/YesodCoreTest/RawResponse.hs  |  9 ++--
 yesod-core/yesod-core.cabal                   |  5 +--
 .../Yesod/EmbeddedStatic/Generators.hs        | 12 +++---
 yesod-static/Yesod/Static.hs                  | 18 ++++----
 yesod-static/yesod-static.cabal               |  4 +-
 yesod/Yesod/Default/Util.hs                   |  8 ++--
 yesod/yesod.cabal                             |  3 +-
 21 files changed, 110 insertions(+), 127 deletions(-)

diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal
index 21f78a81..194638f5 100644
--- a/yesod-auth/yesod-auth.cabal
+++ b/yesod-auth/yesod-auth.cabal
@@ -58,7 +58,7 @@ library
                    , binary
                    , http-client
                    , blaze-builder
-                   , conduit
+                   , conduit                 >= 1.3
                    , conduit-extra
                    , nonce                   >= 1.0.2     && < 1.1
 
diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs
index 4579064b..c60b17d6 100644
--- a/yesod-bin/Devel.hs
+++ b/yesod-bin/Devel.hs
@@ -17,9 +17,7 @@ import           Control.Monad                         (forever, unless, void,
                                                         when)
 import Data.ByteString (ByteString, isInfixOf)
 import qualified Data.ByteString.Lazy                  as LB
-import           Data.Conduit                          (($$), (=$))
-import qualified Data.Conduit.Binary                   as CB
-import qualified Data.Conduit.List                     as CL
+import           Conduit
 import           Data.Default.Class                    (def)
 import           Data.FileEmbed                        (embedFile)
 import qualified Data.Map                              as Map
@@ -368,9 +366,10 @@ devel opts passThroughArgs = do
         -- process is piped to the actual stdout and stderr handles.
         withProcess_ procConfig $ \p -> do
             let helper getter h =
-                      getter p
-                   $$ CL.iterM (\(str :: ByteString) -> atomically (updateAppPort str buildStarted appPortVar))
-                   =$ CB.sinkHandle h
+                      runConduit
+                    $ getter p
+                   .| iterMC (\(str :: ByteString) -> atomically (updateAppPort str buildStarted appPortVar))
+                   .| sinkHandle h
             race_ (helper getStdout stdout) (helper getStderr stderr)
 
     -- Run the inner action with a TVar which will be set to True
diff --git a/yesod-bin/HsFile.hs b/yesod-bin/HsFile.hs
index 38093a51..18868c24 100644
--- a/yesod-bin/HsFile.hs
+++ b/yesod-bin/HsFile.hs
@@ -2,20 +2,18 @@
 {-# LANGUAGE OverloadedStrings #-}
 module HsFile (mkHsFile) where
 import Text.ProjectTemplate (createTemplate)
-import Data.Conduit 
-    ( ($$), (=$), awaitForever)
-import Data.Conduit.Filesystem (sourceDirectory)
+import Conduit
 import Control.Monad.Trans.Resource (runResourceT)
-import qualified Data.Conduit.List as CL
 import qualified Data.ByteString as BS
 import Control.Monad.IO.Class (liftIO)
 import Data.String (fromString)
 
 mkHsFile :: IO ()
-mkHsFile = runResourceT $ sourceDirectory "."
-        $$ readIt
-        =$ createTemplate 
-        =$ awaitForever (liftIO . BS.putStr)
+mkHsFile = runConduitRes
+         $ sourceDirectory "."
+        .| readIt
+        .| createTemplate
+        .| mapM_C (liftIO . BS.putStr)
   where
     -- Reads a filepath from upstream and dumps a pair of (filepath, filecontents)
-    readIt = CL.map $ \i -> (fromString i, liftIO $ BS.readFile i)
+    readIt = mapC $ \i -> (fromString i, liftIO $ BS.readFile i)
diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs
index 5e169d7e..2903654c 100644
--- a/yesod-core/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/Yesod/Core/Class/Yesod.hs
@@ -10,9 +10,8 @@ import           Yesod.Core.Handler
 
 import           Yesod.Routes.Class
 
-import           Blaze.ByteString.Builder           (Builder, toByteString)
-import           Blaze.ByteString.Builder.ByteString (copyByteString)
-import           Blaze.ByteString.Builder.Char.Utf8 (fromText, fromChar)
+import           Data.ByteString.Builder            (Builder, toLazyByteString)
+import           Data.Text.Encoding                 (encodeUtf8Builder)
 import           Control.Arrow                      ((***), second)
 import           Control.Exception                  (bracket)
 #if __GLASGOW_HASKELL__ < 710
@@ -25,6 +24,7 @@ import           Control.Monad.Logger               (LogLevel (LevelInfo, LevelO
 import           Control.Monad.Trans.Resource       (InternalState, createInternalState, closeInternalState)
 import qualified Data.ByteString.Char8              as S8
 import qualified Data.ByteString.Lazy               as L
+import qualified Data.ByteString.Lazy.Char8         as BL8
 import Data.Aeson (object, (.=))
 import           Data.List                          (foldl', nub)
 import qualified Data.Map                           as Map
@@ -113,10 +113,10 @@ class RenderRoute site => Yesod site where
     -- | Override the rendering function for a particular URL and query string
     -- parameters. One use case for this is to offload static hosting to a
     -- different domain name to avoid sending cookies.
-    -- 
+    --
     -- For backward compatibility default implementation is in terms of
     -- 'urlRenderOverride', probably ineffective
-    -- 
+    --
     -- Since 1.4.23
     urlParamRenderOverride :: site
                            -> Route site
@@ -126,11 +126,11 @@ class RenderRoute site => Yesod site where
       where
         addParams [] routeBldr = routeBldr
         addParams nonEmptyParams routeBldr =
-            let routeBS = toByteString routeBldr
-                qsSeparator = fromChar $ if S8.elem '?' routeBS then '&' else '?'
+            let routeBS = toLazyByteString routeBldr
+                qsSeparator = if BL8.elem '?' routeBS then "&" else "?"
                 valueToMaybe t = if t == "" then Nothing else Just t
                 queryText = map (id *** valueToMaybe) nonEmptyParams
-            in copyByteString routeBS `mappend` qsSeparator `mappend` renderQueryText False queryText
+            in routeBldr `mappend` qsSeparator `mappend` renderQueryText False queryText
 
     -- | Determine if a request is authorized or not.
     --
@@ -192,7 +192,7 @@ class RenderRoute site => Yesod site where
              -> [(T.Text, T.Text)] -- ^ query string
              -> Builder
     joinPath _ ar pieces' qs' =
-        fromText ar `mappend` encodePath pieces qs
+        encodeUtf8Builder ar `mappend` encodePath pieces qs
       where
         pieces = if null pieces' then [""] else map addDash pieces'
         qs = map (TE.encodeUtf8 *** go) qs'
diff --git a/yesod-core/Yesod/Core/Content.hs b/yesod-core/Yesod/Core/Content.hs
index d33d87ad..8a01309a 100644
--- a/yesod-core/Yesod/Core/Content.hs
+++ b/yesod-core/Yesod/Core/Content.hs
@@ -53,20 +53,21 @@ import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import Data.Text.Lazy (Text, pack)
 import qualified Data.Text as T
-import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString)
+import Data.Text.Encoding (encodeUtf8Builder)
+import qualified Data.Text.Lazy as TL
+import Data.ByteString.Builder (Builder, byteString, lazyByteString, stringUtf8)
 #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)
+import Data.Conduit (Flush (Chunk), ResumableSource, mapOutput)
 import Control.Monad (liftM)
 import Control.Monad.Trans.Resource (ResourceT)
 import Data.Conduit.Internal (ResumableSource (ResumableSource))
 import qualified Data.Conduit.Internal as CI
 
 import qualified Data.Aeson as J
-import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
 import Data.Text.Lazy.Builder (toLazyText)
 import Yesod.Core.Types
 import Text.Lucius (Css, renderCss)
@@ -93,15 +94,15 @@ instance ToContent Content where
 instance ToContent Builder where
     toContent = flip ContentBuilder Nothing
 instance ToContent B.ByteString where
-    toContent bs = ContentBuilder (fromByteString bs) $ Just $ B.length bs
+    toContent bs = ContentBuilder (byteString bs) $ Just $ B.length bs
 instance ToContent L.ByteString where
-    toContent = flip ContentBuilder Nothing . fromLazyByteString
+    toContent = flip ContentBuilder Nothing . lazyByteString
 instance ToContent T.Text where
-    toContent = toContent . Blaze.fromText
+    toContent = toContent . encodeUtf8Builder
 instance ToContent Text where
-    toContent = toContent . Blaze.fromLazyText
+    toContent = toContent . foldMap encodeUtf8Builder . TL.toChunks
 instance ToContent String where
-    toContent = toContent . Blaze.fromString
+    toContent = toContent . stringUtf8
 instance ToContent Html where
     toContent bs = ContentBuilder (renderHtmlBuilder bs) Nothing
 instance ToContent () where
@@ -119,10 +120,10 @@ instance ToContent Javascript where
 instance ToFlushBuilder builder => ToContent (CI.Pipe () () builder () (ResourceT IO) ()) where
     toContent src = ContentSource $ CI.ConduitT (CI.mapOutput toFlushBuilder src >>=)
 
-instance ToFlushBuilder builder => ToContent (Source (ResourceT IO) builder) where
+instance ToFlushBuilder builder => ToContent (CI.ConduitT () builder (ResourceT IO) ()) where
     toContent src = ContentSource $ mapOutput toFlushBuilder src
 instance ToFlushBuilder builder => ToContent (ResumableSource (ResourceT IO) builder) where
-    toContent (ResumableSource src _) = toContent src
+    toContent (ResumableSource src) = toContent src
 
 -- | A class for all data which can be sent in a streaming response. Note that
 -- for textual data, instances must use UTF-8 encoding.
@@ -131,16 +132,16 @@ instance ToFlushBuilder builder => ToContent (ResumableSource (ResourceT IO) bui
 class ToFlushBuilder a where toFlushBuilder :: a -> Flush Builder
 instance ToFlushBuilder (Flush Builder) where toFlushBuilder = id
 instance ToFlushBuilder Builder where toFlushBuilder = Chunk
-instance ToFlushBuilder (Flush B.ByteString) where toFlushBuilder = fmap fromByteString
-instance ToFlushBuilder B.ByteString where toFlushBuilder = Chunk . fromByteString
-instance ToFlushBuilder (Flush L.ByteString) where toFlushBuilder = fmap fromLazyByteString
-instance ToFlushBuilder L.ByteString where toFlushBuilder = Chunk . fromLazyByteString
-instance ToFlushBuilder (Flush Text) where toFlushBuilder = fmap Blaze.fromLazyText
-instance ToFlushBuilder Text where toFlushBuilder = Chunk . Blaze.fromLazyText
-instance ToFlushBuilder (Flush T.Text) where toFlushBuilder = fmap Blaze.fromText
-instance ToFlushBuilder T.Text where toFlushBuilder = Chunk . Blaze.fromText
-instance ToFlushBuilder (Flush String) where toFlushBuilder = fmap Blaze.fromString
-instance ToFlushBuilder String where toFlushBuilder = Chunk . Blaze.fromString
+instance ToFlushBuilder (Flush B.ByteString) where toFlushBuilder = fmap byteString
+instance ToFlushBuilder B.ByteString where toFlushBuilder = Chunk . byteString
+instance ToFlushBuilder (Flush L.ByteString) where toFlushBuilder = fmap lazyByteString
+instance ToFlushBuilder L.ByteString where toFlushBuilder = Chunk . lazyByteString
+instance ToFlushBuilder (Flush Text) where toFlushBuilder = fmap (foldMap encodeUtf8Builder . TL.toChunks)
+instance ToFlushBuilder Text where toFlushBuilder = Chunk . foldMap encodeUtf8Builder . TL.toChunks
+instance ToFlushBuilder (Flush T.Text) where toFlushBuilder = fmap encodeUtf8Builder
+instance ToFlushBuilder T.Text where toFlushBuilder = Chunk . encodeUtf8Builder
+instance ToFlushBuilder (Flush String) where toFlushBuilder = fmap stringUtf8
+instance ToFlushBuilder String where toFlushBuilder = Chunk . stringUtf8
 instance ToFlushBuilder (Flush Html) where toFlushBuilder = fmap renderHtmlBuilder
 instance ToFlushBuilder Html where toFlushBuilder = Chunk . renderHtmlBuilder
 
diff --git a/yesod-core/Yesod/Core/Dispatch.hs b/yesod-core/Yesod/Core/Dispatch.hs
index d13a154d..e8895cee 100644
--- a/yesod-core/Yesod/Core/Dispatch.hs
+++ b/yesod-core/Yesod/Core/Dispatch.hs
@@ -53,8 +53,9 @@ import Data.Text (Text)
 import Data.Monoid (mappend)
 #endif
 import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Char8 as S8
-import qualified Blaze.ByteString.Builder
+import Data.ByteString.Builder (byteString, toLazyByteString)
 import Network.HTTP.Types (status301, status307)
 import Yesod.Routes.Parse
 import Yesod.Core.Types
@@ -115,7 +116,7 @@ toWaiAppYre yre req =
     sendRedirect y segments' env sendResponse =
          sendResponse $ W.responseLBS status
                 [ ("Content-Type", "text/plain")
-                , ("Location", Blaze.ByteString.Builder.toByteString dest')
+                , ("Location", BL.toStrict $ toLazyByteString dest')
                 ] "Redirecting"
       where
         -- Ensure that non-GET requests get redirected correctly. See:
@@ -129,7 +130,7 @@ toWaiAppYre yre req =
             if S.null (W.rawQueryString env)
                 then dest
                 else dest `mappend`
-                     Blaze.ByteString.Builder.fromByteString (W.rawQueryString env)
+                     byteString (W.rawQueryString env)
 
 -- | Same as 'toWaiAppPlain', but provides a default set of middlewares. This
 -- set may change with future releases, but currently covers:
diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs
index 3395b3bd..93bee351 100644
--- a/yesod-core/Yesod/Core/Handler.hs
+++ b/yesod-core/Yesod/Core/Handler.hs
@@ -240,13 +240,13 @@ import           Web.PathPieces                (PathPiece(..))
 import           Yesod.Core.Class.Handler
 import           Yesod.Core.Types
 import           Yesod.Routes.Class            (Route)
-import           Blaze.ByteString.Builder (Builder)
+import           Data.ByteString.Builder (Builder)
 import           Safe (headMay)
 import           Data.CaseInsensitive (CI, original)
 import qualified Data.Conduit.List as CL
 import           Control.Monad.Trans.Resource  (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO)
 import qualified System.PosixCompat.Files as PC
-import           Data.Conduit (Source, transPipe, Flush (Flush), yield, Producer, Sink)
+import           Data.Conduit (ConduitT, transPipe, Flush (Flush), yield, Void)
 import qualified Yesod.Core.TypeCache as Cache
 import qualified Data.Word8 as W8
 import qualified Data.Foldable as Fold
@@ -679,9 +679,10 @@ sendRawResponseNoConduit raw = withRunInIO $ \runInIO ->
 -- Warp).
 --
 -- @since 1.2.7
-sendRawResponse :: (MonadHandler m, MonadUnliftIO m)
-                => (Source IO S8.ByteString -> Sink S8.ByteString IO () -> m ())
-                -> m a
+sendRawResponse
+  :: (MonadHandler m, MonadUnliftIO m)
+  => (ConduitT () S8.ByteString IO () -> ConduitT S8.ByteString Void IO () -> m ())
+  -> m a
 sendRawResponse raw = withRunInIO $ \runInIO ->
     liftIO $ throwIO $ HCWai $ flip W.responseRaw fallback
     $ \src sink -> void $ runInIO $ raw (src' src) (CL.mapM_ sink)
@@ -1337,7 +1338,7 @@ provideRepType ct handler =
 -- | Stream in the raw request body without any parsing.
 --
 -- @since 1.2.0
-rawRequestBody :: MonadHandler m => Source m S.ByteString
+rawRequestBody :: MonadHandler m => ConduitT i S.ByteString m ()
 rawRequestBody = do
     req <- lift waiRequest
     let loop = do
@@ -1349,7 +1350,7 @@ rawRequestBody = do
 
 -- | Stream the data from the file. Since Yesod 1.2, this has been generalized
 -- to work in any @MonadResource@.
-fileSource :: MonadResource m => FileInfo -> Source m S.ByteString
+fileSource :: MonadResource m => FileInfo -> ConduitT () S.ByteString m ()
 fileSource = transPipe liftResourceT . fileSourceRaw
 
 -- | Provide a pure value for the response body.
@@ -1370,7 +1371,7 @@ respond ct = return . TypedContent ct . toContent
 --
 -- @since 1.2.0
 respondSource :: ContentType
-              -> Source (HandlerT site IO) (Flush Builder)
+              -> ConduitT () (Flush Builder) (HandlerT site IO) ()
               -> HandlerT site IO TypedContent
 respondSource ctype src = HandlerT $ \hd ->
     -- Note that this implementation relies on the fact that the ResourceT
@@ -1383,44 +1384,44 @@ respondSource ctype src = HandlerT $ \hd ->
 -- on most datatypes, such as @ByteString@ and @Html@.
 --
 -- @since 1.2.0
-sendChunk :: Monad m => ToFlushBuilder a => a -> Producer m (Flush Builder)
+sendChunk :: Monad m => ToFlushBuilder a => a -> ConduitT i (Flush Builder) m ()
 sendChunk = yield . toFlushBuilder
 
 -- | In a streaming response, send a flush command, causing all buffered data
 -- to be immediately sent to the client.
 --
 -- @since 1.2.0
-sendFlush :: Monad m => Producer m (Flush Builder)
+sendFlush :: Monad m => ConduitT i (Flush Builder) m ()
 sendFlush = yield Flush
 
 -- | Type-specialized version of 'sendChunk' for strict @ByteString@s.
 --
 -- @since 1.2.0
-sendChunkBS :: Monad m => S.ByteString -> Producer m (Flush Builder)
+sendChunkBS :: Monad m => S.ByteString -> ConduitT i (Flush Builder) m ()
 sendChunkBS = sendChunk
 
 -- | Type-specialized version of 'sendChunk' for lazy @ByteString@s.
 --
 -- @since 1.2.0
-sendChunkLBS :: Monad m => L.ByteString -> Producer m (Flush Builder)
+sendChunkLBS :: Monad m => L.ByteString -> ConduitT i (Flush Builder) m ()
 sendChunkLBS = sendChunk
 
 -- | Type-specialized version of 'sendChunk' for strict @Text@s.
 --
 -- @since 1.2.0
-sendChunkText :: Monad m => T.Text -> Producer m (Flush Builder)
+sendChunkText :: Monad m => T.Text -> ConduitT i (Flush Builder) m ()
 sendChunkText = sendChunk
 
 -- | Type-specialized version of 'sendChunk' for lazy @Text@s.
 --
 -- @since 1.2.0
-sendChunkLazyText :: Monad m => TL.Text -> Producer m (Flush Builder)
+sendChunkLazyText :: Monad m => TL.Text -> ConduitT i (Flush Builder) m ()
 sendChunkLazyText = sendChunk
 
 -- | Type-specialized version of 'sendChunk' for @Html@s.
 --
 -- @since 1.2.0
-sendChunkHtml :: Monad m => Html -> Producer m (Flush Builder)
+sendChunkHtml :: Monad m => Html -> ConduitT i (Flush Builder) m ()
 sendChunkHtml = sendChunk
 
 -- | Converts a child handler to a parent handler
diff --git a/yesod-core/Yesod/Core/Internal/Request.hs b/yesod-core/Yesod/Core/Internal/Request.hs
index b7e4e3ca..65201b19 100644
--- a/yesod-core/Yesod/Core/Internal/Request.hs
+++ b/yesod-core/Yesod/Core/Internal/Request.hs
@@ -33,9 +33,7 @@ import qualified Data.Set as Set
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With, decodeUtf8)
 import Data.Text.Encoding.Error (lenientDecode)
-import Data.Conduit
-import Data.Conduit.List (sourceList)
-import Data.Conduit.Binary (sourceFile, sinkFile)
+import Conduit
 import Data.Word (Word8, Word64)
 import Control.Monad.Trans.Resource (runResourceT, ResourceT)
 import Control.Exception (throwIO)
@@ -176,7 +174,7 @@ fromByteVector v =
 
 mkFileInfoLBS :: Text -> Text -> L.ByteString -> FileInfo
 mkFileInfoLBS name ct lbs =
-    FileInfo name ct (sourceList $ L.toChunks lbs) (`L.writeFile` lbs)
+    FileInfo name ct (sourceLazy lbs) (`L.writeFile` lbs)
 
 mkFileInfoFile :: Text -> Text -> FilePath -> FileInfo
 mkFileInfoFile name ct fp = FileInfo name ct (sourceFile fp) (\dst -> runResourceT $ sourceFile fp $$ sinkFile dst)
diff --git a/yesod-core/Yesod/Core/Internal/Response.hs b/yesod-core/Yesod/Core/Internal/Response.hs
index a7263b61..a4be46bd 100644
--- a/yesod-core/Yesod/Core/Internal/Response.hs
+++ b/yesod-core/Yesod/Core/Internal/Response.hs
@@ -6,6 +6,7 @@ module Yesod.Core.Internal.Response where
 import           Data.ByteString              (ByteString)
 import qualified Data.ByteString              as S
 import qualified Data.ByteString.Char8        as S8
+import qualified Data.ByteString.Lazy         as BL
 import           Data.CaseInsensitive         (CI)
 import qualified Data.CaseInsensitive         as CI
 import           Network.Wai
@@ -18,8 +19,7 @@ import           Yesod.Core.Types
 import qualified Network.HTTP.Types           as H
 import qualified Data.Text                    as T
 import           Control.Exception            (SomeException, handle)
-import           Blaze.ByteString.Builder     (fromLazyByteString,
-                                               toLazyByteString, toByteString)
+import           Data.ByteString.Builder      (lazyByteString, toLazyByteString)
 import qualified Data.ByteString.Lazy         as L
 import qualified Data.Map                     as Map
 import           Yesod.Core.Internal.Request  (tokenKey)
@@ -83,7 +83,7 @@ defaultStatus = H.mkStatus (-1) "INVALID DEFAULT STATUS"
 headerToPair :: Header
              -> (CI ByteString, ByteString)
 headerToPair (AddCookie sc) =
-    ("Set-Cookie", toByteString $ renderSetCookie sc)
+    ("Set-Cookie", BL.toStrict $ toLazyByteString $ renderSetCookie sc)
 headerToPair (DeleteCookie key path) =
     ( "Set-Cookie"
     , S.concat
@@ -100,7 +100,7 @@ evaluateContent (ContentBuilder b mlen) = handle f $ do
     let lbs = toLazyByteString b
         len = L.length lbs
         mlen' = mlen `mplus` Just (fromIntegral len)
-    len `seq` return (Right $ ContentBuilder (fromLazyByteString lbs) mlen')
+    len `seq` return (Right $ ContentBuilder (lazyByteString lbs) mlen')
   where
     f :: SomeException -> IO (Either ErrorResponse Content)
     f = return . Left . InternalError . T.pack . show
diff --git a/yesod-core/Yesod/Core/Internal/Run.hs b/yesod-core/Yesod/Core/Internal/Run.hs
index 668e8604..0989b025 100644
--- a/yesod-core/Yesod/Core/Internal/Run.hs
+++ b/yesod-core/Yesod/Core/Internal/Run.hs
@@ -14,7 +14,8 @@ import           Data.Monoid                  (Monoid, mempty)
 import           Control.Applicative          ((<$>))
 #endif
 import Yesod.Core.Internal.Response
-import           Blaze.ByteString.Builder     (toByteString)
+import           Data.ByteString.Builder      (toLazyByteString)
+import qualified Data.ByteString.Lazy         as BL
 import           Control.Exception            (fromException, evaluate)
 import qualified Control.Exception            as E
 import           Control.Monad.IO.Class       (MonadIO, liftIO)
@@ -372,7 +373,7 @@ yesodRender :: Yesod y
             -> [(Text, Text)] -- ^ url query string
             -> Text
 yesodRender y ar url params =
-    decodeUtf8With lenientDecode $ toByteString $
+    decodeUtf8With lenientDecode $ BL.toStrict $ toLazyByteString $
     fromMaybe
         (joinPath y ar ps
           $ params ++ params')
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index 680c13b8..2382f6a6 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -9,8 +9,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 module Yesod.Core.Types where
 
-import qualified Blaze.ByteString.Builder           as BBuilder
-import qualified Blaze.ByteString.Builder.Char.Utf8
+import qualified Data.ByteString.Builder            as BB
 #if __GLASGOW_HASKELL__ < 710
 import           Control.Applicative                (Applicative (..))
 import           Control.Applicative                ((<$>))
@@ -25,7 +24,7 @@ import           Control.Monad.Logger               (LogLevel, LogSource,
 import           Control.Monad.Trans.Resource       (MonadResource (..), InternalState, runInternalState, MonadThrow (..), throwM, ResourceT)
 import           Data.ByteString                    (ByteString)
 import qualified Data.ByteString.Lazy               as L
-import           Data.Conduit                       (Flush, Source)
+import           Data.Conduit                       (Flush, ConduitT)
 import           Data.IORef                         (IORef, modifyIORef')
 import           Data.Map                           (Map, unionWith)
 import qualified Data.Map                           as Map
@@ -59,7 +58,6 @@ import           Control.Monad.Reader               (MonadReader (..))
 import           Data.Monoid                        ((<>))
 import Control.DeepSeq (NFData (rnf))
 import Control.DeepSeq.Generics (genericRnf)
-import Data.Conduit.Lazy (MonadActive, monadActive)
 import Yesod.Core.TypeCache (TypeMap, KeyedTypeMap)
 import Control.Monad.Logger (MonadLoggerIO (..))
 import Data.Semigroup (Semigroup)
@@ -134,13 +132,13 @@ type RequestBodyContents =
 data FileInfo = FileInfo
     { fileName        :: !Text
     , fileContentType :: !Text
-    , fileSourceRaw   :: !(Source (ResourceT IO) ByteString)
+    , fileSourceRaw   :: !(ConduitT () ByteString (ResourceT IO) ())
     , fileMove        :: !(FilePath -> IO ())
     }
 
 data FileUpload = FileUploadMemory !(NWP.BackEnd L.ByteString)
                 | FileUploadDisk !(InternalState -> NWP.BackEnd FilePath)
-                | FileUploadSource !(NWP.BackEnd (Source (ResourceT IO) ByteString))
+                | FileUploadSource !(NWP.BackEnd (ConduitT () ByteString (ResourceT IO) ()))
 
 -- | How to determine the root of the application for constructing URLs.
 --
@@ -288,8 +286,8 @@ data PageContent url = PageContent
     , pageBody  :: HtmlUrl url
     }
 
-data Content = ContentBuilder !BBuilder.Builder !(Maybe Int) -- ^ The content and optional content length.
-             | ContentSource !(Source (ResourceT IO) (Flush BBuilder.Builder))
+data Content = ContentBuilder !BB.Builder !(Maybe Int) -- ^ The content and optional content length.
+             | ContentSource !(ConduitT () (Flush BB.Builder) (ResourceT IO) ())
              | ContentFile !FilePath !(Maybe FilePart)
              | ContentDontEvaluate !Content
 
@@ -444,11 +442,6 @@ instance MonadIO m => MonadLogger (WidgetT site m) where
 instance MonadIO m => MonadLoggerIO (WidgetT site m) where
     askLoggerIO = WidgetT $ \_ hd -> return $ rheLog $ handlerEnv hd
 
-instance MonadActive m => MonadActive (WidgetT site m) where
-    monadActive = lift monadActive
-instance MonadActive m => MonadActive (HandlerT site m) where
-    monadActive = lift monadActive
-
 instance MonadTrans (HandlerT site) where
     lift = HandlerT . const
 
@@ -496,7 +489,7 @@ instance Monoid (UniqueList x) where
 instance Semigroup (UniqueList x)
 
 instance IsString Content where
-    fromString = flip ContentBuilder Nothing . Blaze.ByteString.Builder.Char.Utf8.fromString
+    fromString = flip ContentBuilder Nothing . BB.stringUtf8
 
 instance RenderRoute WaiSubsite where
     data Route WaiSubsite = WaiSubsiteRoute [Text] [(Text, Text)]
diff --git a/yesod-core/test/YesodCoreTest/CleanPath.hs b/yesod-core/test/YesodCoreTest/CleanPath.hs
index 8decc03a..b60a3156 100644
--- a/yesod-core/test/YesodCoreTest/CleanPath.hs
+++ b/yesod-core/test/YesodCoreTest/CleanPath.hs
@@ -22,7 +22,7 @@ import qualified Data.Text.Encoding as TE
 import Control.Arrow ((***))
 import Network.HTTP.Types (encodePath)
 import Data.Monoid (mappend)
-import Blaze.ByteString.Builder.Char.Utf8 (fromText)
+import Data.Text.Encoding (encodeUtf8Builder)
 
 data Subsite = Subsite
 
@@ -64,7 +64,7 @@ instance Yesod Y where
         corrected = filter (not . TS.null) s
 
     joinPath Y ar pieces' qs' =
-        fromText ar `Data.Monoid.mappend` encodePath pieces qs
+        encodeUtf8Builder ar `Data.Monoid.mappend` encodePath pieces qs
       where
         pieces = if null pieces' then [""] else pieces'
         qs = map (TE.encodeUtf8 *** go) qs'
diff --git a/yesod-core/test/YesodCoreTest/ErrorHandling.hs b/yesod-core/test/YesodCoreTest/ErrorHandling.hs
index db8dfe1c..f6fb6bb4 100644
--- a/yesod-core/test/YesodCoreTest/ErrorHandling.hs
+++ b/yesod-core/test/YesodCoreTest/ErrorHandling.hs
@@ -14,7 +14,7 @@ import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Char8 as S8
 import Control.Exception (SomeException, try)
 import Network.HTTP.Types (Status, mkStatus)
-import Blaze.ByteString.Builder (Builder, fromByteString, toLazyByteString)
+import Data.ByteString.Builder (Builder, toLazyByteString)
 import Data.Monoid (mconcat)
 import Data.Text (Text, pack)
 import Control.Monad (forM_)
@@ -101,7 +101,7 @@ getFileBadNameR :: Handler TypedContent
 getFileBadNameR = return $ TypedContent "ignored" $ ContentFile (error "filebadname") Nothing
 
 goodBuilderContent :: Builder
-goodBuilderContent = Data.Monoid.mconcat $ replicate 100 $ fromByteString "This is a test\n"
+goodBuilderContent = Data.Monoid.mconcat $ replicate 100 $ "This is a test\n"
 
 getGoodBuilderR :: Handler TypedContent
 getGoodBuilderR = return $ TypedContent "text/plain" $ toContent goodBuilderContent
diff --git a/yesod-core/test/YesodCoreTest/Links.hs b/yesod-core/test/YesodCoreTest/Links.hs
index f195368d..d461704d 100644
--- a/yesod-core/test/YesodCoreTest/Links.hs
+++ b/yesod-core/test/YesodCoreTest/Links.hs
@@ -13,7 +13,7 @@ import Yesod.Core
 import Network.Wai
 import Network.Wai.Test
 import Data.Text (Text)
-import Blaze.ByteString.Builder (toByteString)
+import Data.ByteString.Builder (toLazyByteString)
 
 data Y = Y
 mkYesod "Y" [parseRoutes|
@@ -86,7 +86,7 @@ case_blanks = runner $ do
     liftIO $ do
         let go r =
                 let (ps, qs) = renderRoute r
-                 in toByteString $ joinPath Y "" ps qs
+                 in toLazyByteString $ joinPath Y "" ps qs
         (go $ TextR "-") `shouldBe` "/single/--"
         (go $ TextR "") `shouldBe` "/single/-"
         (go $ TextsR ["", "-", "foo", "", "bar"]) `shouldBe` "/multi/-/--/foo/-/bar"
diff --git a/yesod-core/test/YesodCoreTest/RawResponse.hs b/yesod-core/test/YesodCoreTest/RawResponse.hs
index b55688d5..79f69900 100644
--- a/yesod-core/test/YesodCoreTest/RawResponse.hs
+++ b/yesod-core/test/YesodCoreTest/RawResponse.hs
@@ -22,7 +22,6 @@ import Control.Monad.Trans.Resource (register)
 import Data.IORef
 import Data.Streaming.Network (bindPortTCP)
 import Network.HTTP.Types (status200)
-import Blaze.ByteString.Builder (fromByteString)
 
 mkYesod "App" [parseRoutes|
 / HomeR GET
@@ -46,16 +45,16 @@ getHomeR = do
 getWaiStreamR :: Handler ()
 getWaiStreamR = sendWaiResponse $ responseStream status200 [] $ \send flush -> do
     flush
-    send $ fromByteString "hello"
+    send "hello"
     flush
-    send $ fromByteString " world"
+    send " world"
 
 getWaiAppStreamR :: Handler ()
 getWaiAppStreamR = sendWaiApplication $ \_ f -> f $ responseStream status200 [] $ \send flush -> do
     flush
-    send $ fromByteString "hello"
+    send "hello"
     flush
-    send $ fromByteString " world"
+    send " world"
 
 getFreePort :: IO Int
 getFreePort = do
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index 44e35973..bf61c3d6 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -25,12 +25,11 @@ library
                    , time                  >= 1.5
                    , wai                   >= 3.0
                    , wai-extra             >= 3.0.7
-                   , bytestring            >= 0.10
+                   , bytestring            >= 0.10.2
                    , text                  >= 0.7
                    , template-haskell
                    , path-pieces           >= 0.1.2    && < 0.3
                    , shakespeare           >= 2.0
-                   , blaze-builder         >= 0.2.1.4  && < 0.5
                    , transformers          >= 0.4
                    , mtl
                    , clientsession         >= 0.9.1    && < 0.10
@@ -61,6 +60,7 @@ library
                    , conduit-extra
                    , deepseq               >= 1.3
                    , deepseq-generics
+                   -- FIXME remove
                    , mwc-random
                    , primitive
                    , word8
@@ -187,7 +187,6 @@ test-suite tests
                   ,text
                   ,http-types
                   , random
-                  , blaze-builder
                   ,HUnit
                   ,QuickCheck >= 2 && < 3
                   ,transformers
diff --git a/yesod-static/Yesod/EmbeddedStatic/Generators.hs b/yesod-static/Yesod/EmbeddedStatic/Generators.hs
index 2d8aeab1..b5c760e1 100644
--- a/yesod-static/Yesod/EmbeddedStatic/Generators.hs
+++ b/yesod-static/Yesod/EmbeddedStatic/Generators.hs
@@ -24,9 +24,9 @@ module Yesod.EmbeddedStatic.Generators (
 
   -- * Util
   , pathToName
-  
+
   -- * Custom Generators
-  
+
   -- $example
 ) where
 
@@ -34,7 +34,6 @@ import Control.Applicative as A ((<$>), (<*>))
 import Control.Exception (try, SomeException)
 import Control.Monad (forM, when)
 import Data.Char (isDigit, isLower)
-import Data.Conduit (($$))
 import Data.Default (def)
 import Data.Maybe (isNothing)
 import Language.Haskell.TH
@@ -44,8 +43,7 @@ import System.FilePath ((</>))
 import Text.Jasmine (minifym)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
-import qualified Data.Conduit.List as C
-import Data.Conduit.Binary (sourceHandle)
+import Conduit
 import qualified Data.Text as T
 import qualified System.Process as Proc
 import System.Exit (ExitCode (ExitSuccess))
@@ -208,13 +206,13 @@ compressTool f opts ct = do
                 }
     (Just hin, Just hout, _, ph) <- Proc.createProcess p
     (compressed, (), code) <- runConcurrently $ (,,)
-        A.<$> Concurrently (sourceHandle hout $$ C.consume)
+        A.<$> Concurrently (runConduit $ sourceHandle hout .| sinkLazy)
         A.<*> Concurrently (BL.hPut hin ct >> hClose hin)
         A.<*> Concurrently (Proc.waitForProcess ph)
     if code == ExitSuccess
         then do
             putStrLn $ "Compressed successfully with " ++ f
-            return $ BL.fromChunks compressed
+            return compressed
         else error $ "compressTool: compression failed with " ++ f
 
 
diff --git a/yesod-static/Yesod/Static.hs b/yesod-static/Yesod/Static.hs
index 883bf62e..fd5f8a70 100644
--- a/yesod-static/Yesod/Static.hs
+++ b/yesod-static/Yesod/Static.hs
@@ -94,10 +94,7 @@ import Data.List (foldl')
 import qualified Data.ByteString as S
 import System.PosixCompat.Files (getFileStatus, modificationTime)
 import System.Posix.Types (EpochTime)
-import Data.Conduit
-import Data.Conduit.List (sourceList, consume)
-import Data.Conduit.Binary (sourceFile)
-import qualified Data.Conduit.Text as CT
+import Conduit
 import Data.Functor.Identity (runIdentity)
 import System.FilePath ((</>), (<.>), takeDirectory)
 import qualified System.FilePath as F
@@ -425,8 +422,8 @@ base64md5File = fmap (base64 . encode) . hashFile
 base64md5 :: L.ByteString -> String
 base64md5 lbs =
             base64 $ encode
-          $ runIdentity
-          $ sourceList (L.toChunks lbs) $$ sinkHash
+          $ runConduitPure
+          $ Conduit.sourceLazy lbs .| sinkHash
   where
     encode d = ByteArray.convert (d :: Digest MD5)
 
@@ -461,8 +458,11 @@ combineStatics' :: CombineType
                 -> [Route Static] -- ^ files to combine
                 -> Q Exp
 combineStatics' combineType CombineSettings {..} routes = do
-    texts <- qRunIO $ runResourceT $ mapM_ yield fps $$ awaitForever readUTFFile =$ consume
-    ltext <- qRunIO $ preProcess $ TL.fromChunks texts
+    texts <- qRunIO $ runConduitRes
+                    $ yieldMany fps
+                   .| awaitForever readUTFFile
+                   .| sinkLazy
+    ltext <- qRunIO $ preProcess texts
     bs    <- qRunIO $ postProcess fps $ TLE.encodeUtf8 ltext
     let hash' = base64md5 bs
         suffix = csCombinedFolder </> hash' <.> extension
@@ -476,7 +476,7 @@ combineStatics' combineType CombineSettings {..} routes = do
     fps :: [FilePath]
     fps = map toFP routes
     toFP (StaticRoute pieces _) = csStaticDir </> F.joinPath (map T.unpack pieces)
-    readUTFFile fp = sourceFile fp =$= CT.decode CT.utf8
+    readUTFFile fp = sourceFile fp .| decodeUtf8C
     postProcess =
         case combineType of
             JS -> csJsPostProcess
diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal
index 2a9c8506..8ddf0dbc 100644
--- a/yesod-static/yesod-static.cabal
+++ b/yesod-static/yesod-static.cabal
@@ -42,8 +42,7 @@ library
                    , file-embed            >= 0.0.4.1  && < 0.5
                    , http-types            >= 0.7
                    , unix-compat           >= 0.2
-                   , conduit               >= 0.5
-                   , conduit-extra
+                   , conduit               >= 1.3
                    , cryptonite-conduit    >= 0.1
                    , cryptonite            >= 0.11
                    , memory
@@ -124,7 +123,6 @@ test-suite tests
                    , unordered-containers
                    , async
                    , process
-                   , conduit-extra
                    , exceptions
 
     ghc-options:     -Wall -threaded
diff --git a/yesod/Yesod/Default/Util.hs b/yesod/Yesod/Default/Util.hs
index 897031b0..4b12326c 100644
--- a/yesod/Yesod/Default/Util.hs
+++ b/yesod/Yesod/Default/Util.hs
@@ -18,9 +18,7 @@ import qualified Data.ByteString.Lazy as L
 import Data.Text (Text, pack, unpack)
 import Yesod.Core -- purposely using complete import so that Haddock will see addStaticContent
 import Control.Monad (when, unless)
-import Control.Monad.Trans.Resource (runResourceT)
-import Data.Conduit (($$))
-import Data.Conduit.Binary (sourceLbs, sinkFileCautious)
+import Conduit
 import System.Directory (doesFileExist, createDirectoryIfMissing)
 import Language.Haskell.TH.Syntax
 import Text.Lucius (luciusFile, luciusFileReload)
@@ -46,8 +44,8 @@ addStaticContentExternal
 addStaticContentExternal minify hash staticDir toRoute ext' _ content = do
     liftIO $ createDirectoryIfMissing True statictmp
     exists <- liftIO $ doesFileExist fn'
-    unless exists $
-        liftIO $ runResourceT $ sourceLbs content' $$ sinkFileCautious fn'
+    unless exists $ withSinkFileCautious fn' $ \sink ->
+        runConduit $ sourceLazy content' .| sink
     return $ Just $ Right (toRoute ["tmp", pack fn], [])
   where
     fn, statictmp, fn' :: FilePath
diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal
index fdde1f0e..5eb0f06e 100644
--- a/yesod/yesod.cabal
+++ b/yesod/yesod.cabal
@@ -38,8 +38,7 @@ library
                    , bytestring
                    , monad-logger
                    , fast-logger
-                   , conduit
-                   , conduit-extra             >= 1.1.14
+                   , conduit                   >= 1.3
                    , resourcet
                    , shakespeare
                    , streaming-commons

From 3e06942449cad0b52e218cb7e9f2c06b45b85e69 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 11 Jan 2018 23:13:32 +0200
Subject: [PATCH 14/43] Simplify YesodSubDispatch

---
 yesod-auth/Yesod/Auth.hs                          |  3 +--
 yesod-core/Yesod/Core/Class/Dispatch.hs           | 15 +++++++--------
 yesod-core/Yesod/Core/Types.hs                    |  8 ++++----
 .../test/YesodCoreTest/NoOverloadedStringsSub.hs  |  4 ++--
 yesod-static/Yesod/EmbeddedStatic.hs              |  2 +-
 yesod-static/Yesod/Static.hs                      |  2 +-
 6 files changed, 16 insertions(+), 18 deletions(-)

diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs
index 08ad2722..fe22654d 100644
--- a/yesod-auth/Yesod/Auth.hs
+++ b/yesod-auth/Yesod/Auth.hs
@@ -582,8 +582,7 @@ data AuthException = InvalidFacebookResponse
     deriving (Show, Typeable)
 instance Exception AuthException
 
--- FIXME HandlerSite m ~ SubHandlerSite m should be unnecessary
-instance (YesodAuth (HandlerSite m), HandlerSite m ~ SubHandlerSite m, MonadSubHandler m, MonadUnliftIO m) => YesodSubDispatch Auth m where
+instance YesodAuth master => YesodSubDispatch Auth master where
     yesodSubDispatch = $(mkYesodSubDispatch resourcesAuth)
 
 asHtml :: Html -> Html
diff --git a/yesod-core/Yesod/Core/Class/Dispatch.hs b/yesod-core/Yesod/Core/Class/Dispatch.hs
index 106a0517..c4c1b641 100644
--- a/yesod-core/Yesod/Core/Class/Dispatch.hs
+++ b/yesod-core/Yesod/Core/Class/Dispatch.hs
@@ -19,16 +19,15 @@ import Control.Monad.Trans.Reader (ReaderT (..), ask)
 class Yesod site => YesodDispatch site where
     yesodDispatch :: YesodRunnerEnv site -> W.Application
 
-class YesodSubDispatch sub m where
-    yesodSubDispatch :: YesodSubRunnerEnv sub (HandlerSite m) m
-                     -> W.Application
+class YesodSubDispatch sub master where
+    yesodSubDispatch :: YesodSubRunnerEnv sub master -> W.Application
 
 instance YesodSubDispatch WaiSubsite master where
     yesodSubDispatch YesodSubRunnerEnv {..} = app
       where
         WaiSubsite app = ysreGetSub $ yreSite ysreParentEnv
 
-instance MonadHandler m => YesodSubDispatch WaiSubsiteWithAuth m where
+instance YesodSubDispatch WaiSubsiteWithAuth master where
   yesodSubDispatch YesodSubRunnerEnv {..} req =
       ysreParentRunner handlert ysreParentEnv (fmap ysreToParentRoute route) req
     where
@@ -90,9 +89,9 @@ instance (MonadSubHandler m, parent ~ SubHandlerSite m) => MonadSubHandler (Read
       }
 
 subHelper
-  :: (ToTypedContent content, MonadSubHandler m, master ~ HandlerSite m, parent ~ SubHandlerSite m)
-  => ReaderT (SubsiteData child master) m content
-  -> YesodSubRunnerEnv child parent m
+  :: ToTypedContent content
+  => ReaderT (SubsiteData child master) (HandlerFor master) content
+  -> YesodSubRunnerEnv child master
   -> Maybe (Route child)
   -> W.Application
 subHelper (ReaderT f) YesodSubRunnerEnv {..} mroute =
@@ -100,7 +99,7 @@ subHelper (ReaderT f) YesodSubRunnerEnv {..} mroute =
   where
     handler = fmap toTypedContent $ do
       tm <- getRouteToParent
-      f SubsiteData
+      liftHandler $ f SubsiteData
         { sdRouteToParent = tm . ysreToParentRoute
         , sdCurrentRoute = mroute
         , sdSubsiteData = ysreGetSub $ yreSite ysreParentEnv
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index 9542ceac..a3936603 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -203,15 +203,15 @@ data YesodRunnerEnv site = YesodRunnerEnv
     , yreGetMaxExpires  :: IO Text
     }
 
-data YesodSubRunnerEnv sub parent parentMonad = YesodSubRunnerEnv
-    { ysreParentRunner  :: !(ParentRunner parent parentMonad)
+data YesodSubRunnerEnv sub parent = YesodSubRunnerEnv
+    { ysreParentRunner  :: !(ParentRunner parent)
     , ysreGetSub        :: !(parent -> sub)
     , ysreToParentRoute :: !(Route sub -> Route parent)
     , ysreParentEnv     :: !(YesodRunnerEnv parent) -- FIXME maybe get rid of this and remove YesodRunnerEnv in ParentRunner?
     }
 
-type ParentRunner parent m
-    = m TypedContent
+type ParentRunner parent
+    = HandlerFor parent TypedContent
    -> YesodRunnerEnv parent
    -> Maybe (Route parent)
    -> W.Application
diff --git a/yesod-core/test/YesodCoreTest/NoOverloadedStringsSub.hs b/yesod-core/test/YesodCoreTest/NoOverloadedStringsSub.hs
index 170fd711..c2cdc153 100644
--- a/yesod-core/test/YesodCoreTest/NoOverloadedStringsSub.hs
+++ b/yesod-core/test/YesodCoreTest/NoOverloadedStringsSub.hs
@@ -10,7 +10,7 @@ module YesodCoreTest.NoOverloadedStringsSub where
 import Yesod.Core
 import Yesod.Core.Types
 
-data Subsite = Subsite (forall master. Yesod master => YesodSubRunnerEnv Subsite master (HandlerFor master) -> Application)
+data Subsite = Subsite (forall master. Yesod master => YesodSubRunnerEnv Subsite master -> Application)
 
 mkYesodSubData "Subsite" [parseRoutes|
 /bar BarR GET
@@ -21,7 +21,7 @@ mkYesodSubData "Subsite" [parseRoutes|
 /has-three-pieces/#Int/#Int/#Int ThreePiecesR GET
 |]
 
-instance Yesod master => YesodSubDispatch Subsite (HandlerFor master) where
+instance Yesod master => YesodSubDispatch Subsite master where
     yesodSubDispatch ysre =
         f ysre
       where
diff --git a/yesod-static/Yesod/EmbeddedStatic.hs b/yesod-static/Yesod/EmbeddedStatic.hs
index 7663ad9f..7b005c80 100644
--- a/yesod-static/Yesod/EmbeddedStatic.hs
+++ b/yesod-static/Yesod/EmbeddedStatic.hs
@@ -81,7 +81,7 @@ import Yesod.EmbeddedStatic.Generators
 embeddedResourceR :: [T.Text] -> [(T.Text, T.Text)] -> Route EmbeddedStatic
 embeddedResourceR = EmbeddedResourceR
 
-instance YesodSubDispatch EmbeddedStatic (HandlerT master IO) where
+instance YesodSubDispatch EmbeddedStatic master where
     yesodSubDispatch YesodSubRunnerEnv {..} req = resp
         where
             master = yreSite ysreParentEnv
diff --git a/yesod-static/Yesod/Static.hs b/yesod-static/Yesod/Static.hs
index 80d96ba1..7c250b88 100644
--- a/yesod-static/Yesod/Static.hs
+++ b/yesod-static/Yesod/Static.hs
@@ -171,7 +171,7 @@ instance RenderRoute Static where
 instance ParseRoute Static where
     parseRoute (x, y) = Just $ StaticRoute x y
 
-instance MonadHandler m => YesodSubDispatch Static m where
+instance YesodSubDispatch Static master where
     yesodSubDispatch YesodSubRunnerEnv {..} req =
         ysreParentRunner handlert ysreParentEnv (fmap ysreToParentRoute route) req
       where

From 3bb654857c43fd4685b14f23aa9a9defc8d74407 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 12 Jan 2018 00:09:54 +0200
Subject: [PATCH 15/43] Ditch ResumableSource

---
 yesod-auth/Yesod/Auth/GoogleEmail2.hs | 2 +-
 yesod-core/Yesod/Core/Content.hs      | 7 +++----
 2 files changed, 4 insertions(+), 5 deletions(-)

diff --git a/yesod-auth/Yesod/Auth/GoogleEmail2.hs b/yesod-auth/Yesod/Auth/GoogleEmail2.hs
index 577e86a7..5b291178 100644
--- a/yesod-auth/Yesod/Auth/GoogleEmail2.hs
+++ b/yesod-auth/Yesod/Auth/GoogleEmail2.hs
@@ -277,7 +277,7 @@ getPerson :: Manager -> Token -> HandlerT site IO (Maybe Person)
 getPerson manager token = parseMaybe parseJSON <$> (do
     req <- personValueRequest token
     res <- http req manager
-    responseBody res $$+- sinkParser json'
+    responseBody res $$ sinkParser json'
   )
 
 personValueRequest :: MonadIO m => Token -> m Request
diff --git a/yesod-core/Yesod/Core/Content.hs b/yesod-core/Yesod/Core/Content.hs
index 8a01309a..51b27cd6 100644
--- a/yesod-core/Yesod/Core/Content.hs
+++ b/yesod-core/Yesod/Core/Content.hs
@@ -61,10 +61,9 @@ import Data.Monoid (mempty)
 #endif
 import Text.Hamlet (Html)
 import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)
-import Data.Conduit (Flush (Chunk), ResumableSource, mapOutput)
+import Data.Conduit (Flush (Chunk), SealedConduitT, mapOutput)
 import Control.Monad (liftM)
 import Control.Monad.Trans.Resource (ResourceT)
-import Data.Conduit.Internal (ResumableSource (ResumableSource))
 import qualified Data.Conduit.Internal as CI
 
 import qualified Data.Aeson as J
@@ -122,8 +121,8 @@ instance ToFlushBuilder builder => ToContent (CI.Pipe () () builder () (Resource
 
 instance ToFlushBuilder builder => ToContent (CI.ConduitT () builder (ResourceT IO) ()) where
     toContent src = ContentSource $ mapOutput toFlushBuilder src
-instance ToFlushBuilder builder => ToContent (ResumableSource (ResourceT IO) builder) where
-    toContent (ResumableSource src) = toContent src
+instance ToFlushBuilder builder => ToContent (SealedConduitT () builder (ResourceT IO) ()) where
+    toContent (CI.SealedConduitT src) = toContent src
 
 -- | A class for all data which can be sent in a streaming response. Note that
 -- for textual data, instances must use UTF-8 encoding.

From 1a1cb8a45fd730f731e5ebe4c2e89f8250f763fb Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 15 Jan 2018 10:18:16 +0200
Subject: [PATCH 16/43] Drop mwc-random

---
 yesod-core/Yesod/Core/Class/Yesod.hs          |  5 ++---
 yesod-core/Yesod/Core/Dispatch.hs             | 11 +++++-----
 yesod-core/Yesod/Core/Handler.hs              |  8 ++++---
 yesod-core/Yesod/Core/Internal/Request.hs     | 22 +++++++++++--------
 yesod-core/Yesod/Core/Types.hs                |  4 ++--
 .../test/YesodCoreTest/InternalRequest.hs     | 22 +++++++++----------
 yesod-core/yesod-core.cabal                   |  5 -----
 7 files changed, 39 insertions(+), 38 deletions(-)

diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs
index b113c250..f960c01c 100644
--- a/yesod-core/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/Yesod/Core/Class/Yesod.hs
@@ -39,7 +39,6 @@ import           Data.Word                          (Word64)
 import           Language.Haskell.TH.Syntax         (Loc (..))
 import           Network.HTTP.Types                 (encodePath, renderQueryText)
 import qualified Network.Wai                        as W
-import           Data.Default                       (def)
 import           Network.Wai.Parse                  (lbsBackEnd,
                                                      tempFileBackEnd)
 import           Network.Wai.Logger                 (ZonedDate, clockDateCacher)
@@ -52,7 +51,7 @@ import           Text.Hamlet
 import           Text.Julius
 import qualified Web.ClientSession                  as CS
 import           Web.Cookie                         (SetCookie (..), parseCookies, sameSiteLax,
-                                                     sameSiteStrict, SameSiteOption)
+                                                     sameSiteStrict, SameSiteOption, defaultSetCookie)
 import           Yesod.Core.Types
 import           Yesod.Core.Internal.Session
 import           Yesod.Core.Widget
@@ -865,7 +864,7 @@ loadClientSession key getCachedDate sessionName req = load
     save date sess' = do
       -- We should never cache the IV!  Be careful!
       iv <- liftIO CS.randomIV
-      return [AddCookie def
+      return [AddCookie defaultSetCookie
           { setCookieName = sessionName
           , setCookieValue = encodeClientSession key iv date host sess'
           , setCookiePath = Just "/"
diff --git a/yesod-core/Yesod/Core/Dispatch.hs b/yesod-core/Yesod/Core/Dispatch.hs
index e8895cee..1f6da4db 100644
--- a/yesod-core/Yesod/Core/Dispatch.hs
+++ b/yesod-core/Yesod/Core/Dispatch.hs
@@ -64,6 +64,7 @@ import Yesod.Core.Class.Dispatch
 import Yesod.Core.Internal.Run
 import Safe (readMay)
 import System.Environment (getEnvironment)
+import qualified System.Random as Random
 import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction, updateFreq)
 import Yesod.Core.Internal.Util (getCurrentMaxExpiresRFC1123)
 
@@ -79,7 +80,6 @@ import Control.Monad.Logger
 import Control.Monad (when)
 import qualified Paths_yesod_core
 import Data.Version (showVersion)
-import qualified System.Random.MWC as MWC
 
 -- | Convert the given argument into a WAI application, executable with any WAI
 -- handler. This function will provide no middlewares; if you want commonly
@@ -88,16 +88,18 @@ toWaiAppPlain :: YesodDispatch site => site -> IO W.Application
 toWaiAppPlain site = do
     logger <- makeLogger site
     sb <- makeSessionBackend site
-    gen <- MWC.createSystemRandom
     getMaxExpires <- getGetMaxExpires
     return $ toWaiAppYre YesodRunnerEnv
             { yreLogger = logger
             , yreSite = site
             , yreSessionBackend = sb
-            , yreGen = gen
+            , yreGen = defaultGen
             , yreGetMaxExpires = getMaxExpires
             }
 
+defaultGen :: IO Int
+defaultGen = Random.getStdRandom Random.next
+
 -- | Pure low level function to construct WAI application. Usefull
 -- when you need not standard way to run your app, or want to embed it
 -- inside another app.
@@ -152,13 +154,12 @@ toWaiApp site = do
 toWaiAppLogger :: YesodDispatch site => Logger -> site -> IO W.Application
 toWaiAppLogger logger site = do
     sb <- makeSessionBackend site
-    gen <- MWC.createSystemRandom
     getMaxExpires <- getGetMaxExpires
     let yre = YesodRunnerEnv
                 { yreLogger = logger
                 , yreSite = site
                 , yreSessionBackend = sb
-                , yreGen = gen
+                , yreGen = defaultGen
                 , yreGetMaxExpires = getMaxExpires
                 }
     messageLoggerSource
diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs
index 93bee351..7ff66627 100644
--- a/yesod-core/Yesod/Core/Handler.hs
+++ b/yesod-core/Yesod/Core/Handler.hs
@@ -228,7 +228,7 @@ import           Data.Monoid                   (Endo (..))
 import           Data.Text                     (Text)
 import qualified Network.Wai.Parse             as NWP
 import           Text.Shakespeare.I18N         (RenderMessage (..))
-import           Web.Cookie                    (SetCookie (..))
+import           Web.Cookie                    (SetCookie (..), defaultSetCookie)
 import           Yesod.Core.Content            (ToTypedContent (..), simpleContentType, contentTypeTypes, HasContentType (..), ToContent (..), ToFlushBuilder (..))
 import           Yesod.Core.Internal.Util      (formatRFC1123)
 import           Text.Blaze.Html               (preEscapedToHtml, toHtml)
@@ -250,7 +250,6 @@ import           Data.Conduit (ConduitT, transPipe, Flush (Flush), yield, Void)
 import qualified Yesod.Core.TypeCache as Cache
 import qualified Data.Word8 as W8
 import qualified Data.Foldable as Fold
-import           Data.Default
 import           Control.Monad.Logger (MonadLogger, logWarnS)
 
 get :: MonadHandler m => m GHState
@@ -1474,7 +1473,10 @@ defaultCsrfCookieName = "XSRF-TOKEN"
 --
 -- @since 1.4.14
 setCsrfCookie :: MonadHandler m => m ()
-setCsrfCookie = setCsrfCookieWithCookie def { setCookieName = defaultCsrfCookieName, setCookiePath = Just "/" }
+setCsrfCookie = setCsrfCookieWithCookie defaultSetCookie
+  { setCookieName = defaultCsrfCookieName
+  , setCookiePath = Just "/"
+  }
 
 -- | Takes a 'SetCookie' and overrides its value with a CSRF token, then sets the cookie.
 --
diff --git a/yesod-core/Yesod/Core/Internal/Request.hs b/yesod-core/Yesod/Core/Internal/Request.hs
index 65201b19..522138db 100644
--- a/yesod-core/Yesod/Core/Internal/Request.hs
+++ b/yesod-core/Yesod/Core/Internal/Request.hs
@@ -41,7 +41,6 @@ import Control.Monad ((<=<), liftM)
 import Yesod.Core.Types
 import qualified Data.Map as Map
 import Data.IORef
-import qualified System.Random.MWC as MWC
 import Control.Monad.Primitive (PrimMonad, PrimState)
 import qualified Data.Vector.Storable as V
 import Data.ByteString.Internal (ByteString (PS))
@@ -74,7 +73,7 @@ parseWaiRequest :: W.Request
                 -> SessionMap
                 -> Bool
                 -> Maybe Word64 -- ^ max body size
-                -> Either (IO YesodRequest) (MWC.GenIO -> IO YesodRequest)
+                -> Either (IO YesodRequest) (IO Int -> 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
@@ -154,16 +153,21 @@ addTwoLetters (toAdd, exist) (l:ls) =
 -- | Generate a random String of alphanumerical characters
 -- (a-z, A-Z, and 0-9) of the given length using the given
 -- random number generator.
-randomString :: PrimMonad m => Int -> MWC.Gen (PrimState m) -> m Text
+randomString :: Monad m => Int -> m Int -> m Text
 randomString len gen =
     liftM (decodeUtf8 . fromByteVector) $ V.replicateM len asciiChar
   where
-    asciiChar = liftM toAscii $ MWC.uniformR (0, 61) gen
-
-    toAscii i
-        | i < 26 = i + Word8._A
-        | i < 52 = i + Word8._a - 26
-        | otherwise = i + Word8._0 - 52
+    asciiChar =
+      let loop = do
+            x <- gen
+            let y = fromIntegral $ x `mod` 64
+            case () of
+              ()
+                | y < 26 -> return $ y + Word8._A
+                | y < 52 -> return $ y + Word8._a - 26
+                | y < 62 -> return $ y + Word8._0 - 52
+                | otherwise -> loop
+       in loop
 
 fromByteVector :: V.Vector Word8 -> ByteString
 fromByteVector v =
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index 2382f6a6..f0a8f93b 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -45,7 +45,6 @@ import           Network.Wai                        (FilePart,
 import qualified Network.Wai                        as W
 import qualified Network.Wai.Parse                  as NWP
 import           System.Log.FastLogger              (LogStr, LoggerSet, toLogStr, pushLogStr)
-import qualified System.Random.MWC                  as MWC
 import           Network.Wai.Logger                 (DateCacheGetter)
 import           Text.Blaze.Html                    (Html, toHtml)
 import           Text.Hamlet                        (HtmlUrl)
@@ -200,7 +199,8 @@ data YesodRunnerEnv site = YesodRunnerEnv
     { yreLogger         :: !Logger
     , yreSite           :: !site
     , yreSessionBackend :: !(Maybe SessionBackend)
-    , yreGen            :: !MWC.GenIO
+    , yreGen            :: !(IO Int)
+    -- ^ Generate a random number
     , yreGetMaxExpires  :: IO Text
     }
 
diff --git a/yesod-core/test/YesodCoreTest/InternalRequest.hs b/yesod-core/test/YesodCoreTest/InternalRequest.hs
index 314a08ff..f0613866 100644
--- a/yesod-core/test/YesodCoreTest/InternalRequest.hs
+++ b/yesod-core/test/YesodCoreTest/InternalRequest.hs
@@ -10,9 +10,11 @@ import Data.Map (singleton)
 import Yesod.Core
 import Data.Word (Word64)
 import System.IO.Unsafe (unsafePerformIO)
-import qualified System.Random.MWC as MWC
-import Control.Monad.ST
 import Control.Monad (replicateM)
+import System.Random
+
+gen :: IO Int
+gen = getStdRandom next
 
 randomStringSpecs :: Spec
 randomStringSpecs = describe "Yesod.Internal.Request.randomString" $ do
@@ -21,21 +23,19 @@ randomStringSpecs = describe "Yesod.Internal.Request.randomString" $ do
 
 -- NOTE: this testcase may break on other systems/architectures if
 -- mkStdGen is not identical everywhere (is it?).
-_looksRandom :: Bool
-_looksRandom = runST $ do
-    gen <- MWC.create
+_looksRandom :: IO ()
+_looksRandom = do
     s <- randomString 20 gen
-    return $ s == "VH9SkhtptqPs6GqtofVg"
+    s `shouldBe` "VH9SkhtptqPs6GqtofVg"
 
-noRepeat :: Int -> Int -> Bool
-noRepeat len n = runST $ do
-    gen <- MWC.create
+noRepeat :: Int -> Int -> IO ()
+noRepeat len n = do
     ss <- replicateM n $ randomString len gen
-    return $ length (nub ss) == n
+    length (nub ss) `shouldBe` n
 
 
 -- For convenience instead of "(undefined :: StdGen)".
-g :: MWC.GenIO
+g :: IO Int
 g = error "test/YesodCoreTest/InternalRequest.g"
 
 parseWaiRequest' :: Request
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index bf61c3d6..c9c56a6a 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -52,16 +52,12 @@ library
                    , resourcet             >= 1.2
                    , blaze-html            >= 0.5
                    , blaze-markup          >= 0.7.1
-                   -- FIXME remove!
-                   , data-default
                    , safe
                    , warp                  >= 3.0.2
                    , unix-compat
                    , conduit-extra
                    , deepseq               >= 1.3
                    , deepseq-generics
-                   -- FIXME remove
-                   , mwc-random
                    , primitive
                    , word8
                    , auto-update
@@ -199,7 +195,6 @@ test-suite tests
                   , shakespeare
                   , streaming-commons
                   , wai-extra
-                  , mwc-random
                   , cookie >= 0.4.1    && < 0.5
                   , unliftio
     ghc-options:     -Wall

From 8c96b4e36cc3622b80bc8dd919ba57dd6b1fdd85 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 15 Jan 2018 10:48:50 +0200
Subject: [PATCH 17/43] Fix benchmark compile

---
 yesod-core/bench/widget.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/yesod-core/bench/widget.hs b/yesod-core/bench/widget.hs
index fd210cbe..b49ad4a1 100644
--- a/yesod-core/bench/widget.hs
+++ b/yesod-core/bench/widget.hs
@@ -20,7 +20,7 @@ main :: IO ()
 main = defaultMain
     [ bench "bigTable html" $ nf bigTableHtml bigTableData
     , bench "bigTable hamlet" $ nf bigTableHamlet bigTableData
-    , bench "bigTable widget" $ nfIO (bigTableWidget bigTableData)
+    --, bench "bigTable widget" $ nfIO (bigTableWidget bigTableData)
     , bench "bigTable blaze" $ nf bigTableBlaze bigTableData
     ]
   where
@@ -49,6 +49,7 @@ bigTableHamlet rows = L.length $ Utf8.renderHtml $ ($ id) [hamlet|
                 <td>#{show cell}
 |]
 
+    {-
 bigTableWidget :: Show a => [[a]] -> IO Int64
 bigTableWidget rows = fmap (L.length . Utf8.renderHtml . ($ render)) (run [whamlet|
 <table>
@@ -62,6 +63,7 @@ bigTableWidget rows = fmap (L.length . Utf8.renderHtml . ($ render)) (run [whaml
   run (WidgetT w) = do
     (_, GWData { gwdBody = Body x }) <- w undefined
     return x
+    -}
 
 bigTableBlaze :: Show a => [[a]] -> Int64
 bigTableBlaze t = L.length $ Utf8.renderHtml $ table $ Data.Monoid.mconcat $ map row t

From 1f7a2a287b4d35a5616dd63b79ef5615a3dbe542 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 15 Jan 2018 11:46:38 +0200
Subject: [PATCH 18/43] Switch to gauge

---
 yesod-core/bench/widget.hs  | 2 +-
 yesod-core/yesod-core.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/yesod-core/bench/widget.hs b/yesod-core/bench/widget.hs
index b49ad4a1..93129680 100644
--- a/yesod-core/bench/widget.hs
+++ b/yesod-core/bench/widget.hs
@@ -5,7 +5,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 module Main where
 
-import Criterion.Main
+import Gauge.Main
 import Text.Hamlet
 import qualified Data.ByteString.Lazy as L
 import qualified Text.Blaze.Html.Renderer.Utf8 as Utf8
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index c9c56a6a..4c2db3ed 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -204,7 +204,7 @@ benchmark widgets
     type: exitcode-stdio-1.0
     hs-source-dirs: bench
     build-depends:  base
-                  , criterion
+                  , gauge
                   , bytestring
                   , text
                   , transformers

From 60f65ed267984f34e16994b8d68affa4065bb738 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 15 Jan 2018 15:09:07 +0200
Subject: [PATCH 19/43] Cleanup warnings

---
 yesod-auth/Yesod/Auth.hs                      | 16 ++++++-------
 yesod-auth/Yesod/Auth/GoogleEmail2.hs         |  6 ++---
 yesod-bin/AddHandler.hs                       |  9 ++++++++
 yesod-bin/HsFile.hs                           |  1 -
 yesod-core/Yesod/Core/Class/Handler.hs        |  2 +-
 yesod-core/Yesod/Core/Internal/Request.hs     |  8 +++----
 yesod-core/Yesod/Core/Internal/Response.hs    |  7 +++---
 yesod-core/bench/widget.hs                    |  2 --
 yesod-core/test/YesodCoreTest/RawResponse.hs  | 16 ++++++-------
 .../test/YesodCoreTest/RequestBodySize.hs     |  4 ++--
 yesod-eventsource/Yesod/EventSource.hs        | 23 +++++++++++--------
 yesod-persistent/Yesod/Persist/Core.hs        |  6 ++---
 yesod-persistent/test/Yesod/PersistSpec.hs    |  2 +-
 yesod-sitemap/Yesod/Sitemap.hs                |  6 ++---
 yesod-static/Yesod/Static.hs                  |  2 --
 15 files changed, 57 insertions(+), 53 deletions(-)

diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs
index b382630a..6a42f3b4 100644
--- a/yesod-auth/Yesod/Auth.hs
+++ b/yesod-auth/Yesod/Auth.hs
@@ -72,7 +72,7 @@ import Yesod.Form (FormMessage)
 import Data.Typeable (Typeable)
 import Control.Exception (Exception)
 import Network.HTTP.Types (Status, internalServerError500, unauthorized401)
-import Control.Monad.Trans.Resource (MonadResourceBase)
+import Control.Monad.Trans.Resource (MonadUnliftIO)
 import qualified Control.Monad.Trans.Writer    as Writer
 import Control.Monad (void)
 
@@ -222,7 +222,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
 
     -- | Called on login error for HTTP requests. By default, calls
     -- @addMessage@ with "error" as status and redirects to @dest@.
-    onErrorHtml :: (MonadResourceBase m) => Route master -> Text -> HandlerT master m Html
+    onErrorHtml :: (MonadUnliftIO m) => Route master -> Text -> HandlerT master m Html
     onErrorHtml dest msg = do
         addMessage "error" $ toHtml msg
         fmap asHtml $ redirect dest
@@ -288,7 +288,7 @@ defaultLoginHandler = do
         mapM_ (flip apLogin tp) (authPlugins master)
 
 
-loginErrorMessageI :: (MonadResourceBase m, YesodAuth master)
+loginErrorMessageI :: (MonadUnliftIO m, YesodAuth master)
                    => Route child
                    -> AuthMessage
                    -> HandlerT child (HandlerT master m) TypedContent
@@ -297,7 +297,7 @@ loginErrorMessageI dest msg = do
   lift $ loginErrorMessageMasterI (toParent dest) msg
 
 
-loginErrorMessageMasterI :: (YesodAuth master, MonadResourceBase m, RenderMessage master AuthMessage)
+loginErrorMessageMasterI :: (YesodAuth master, MonadUnliftIO m, RenderMessage master AuthMessage)
          => Route master
          -> AuthMessage
          -> HandlerT master m TypedContent
@@ -307,19 +307,19 @@ loginErrorMessageMasterI dest msg = do
 
 -- | For HTML, set the message and redirect to the route.
 -- For JSON, send the message and a 401 status
-loginErrorMessage :: (YesodAuth master, MonadResourceBase m)
+loginErrorMessage :: (YesodAuth master, MonadUnliftIO m)
          => Route master
          -> Text
          -> HandlerT master m TypedContent
 loginErrorMessage dest msg = messageJson401 msg (onErrorHtml dest msg)
 
-messageJson401 :: MonadResourceBase m => Text -> HandlerT master m Html -> HandlerT master m TypedContent
+messageJson401 :: MonadUnliftIO m => Text -> HandlerT master m Html -> HandlerT master m TypedContent
 messageJson401 = messageJsonStatus unauthorized401
 
-messageJson500 :: MonadResourceBase m => Text -> HandlerT master m Html -> HandlerT master m TypedContent
+messageJson500 :: MonadUnliftIO m => Text -> HandlerT master m Html -> HandlerT master m TypedContent
 messageJson500 = messageJsonStatus internalServerError500
 
-messageJsonStatus :: MonadResourceBase m
+messageJsonStatus :: MonadUnliftIO m
                   => Status
                   -> Text
                   -> HandlerT master m Html
diff --git a/yesod-auth/Yesod/Auth/GoogleEmail2.hs b/yesod-auth/Yesod/Auth/GoogleEmail2.hs
index 5b291178..1cb9d571 100644
--- a/yesod-auth/Yesod/Auth/GoogleEmail2.hs
+++ b/yesod-auth/Yesod/Auth/GoogleEmail2.hs
@@ -82,7 +82,7 @@ import qualified Data.Aeson.Encode        as A
 import           Data.Aeson.Parser        (json')
 import           Data.Aeson.Types         (FromJSON (parseJSON), parseEither,
                                            parseMaybe, withObject, withText)
-import           Data.Conduit             (($$+-), ($$))
+import           Data.Conduit
 import           Data.Conduit.Attoparsec  (sinkParser)
 import qualified Data.HashMap.Strict      as M
 import           Data.Maybe               (fromMaybe)
@@ -266,7 +266,7 @@ makeHttpRequest
   => Request
   -> HandlerT Auth (HandlerT site IO) A.Value
 makeHttpRequest req = lift $
-    runHttpRequest req $ \res -> bodyReaderSource (responseBody res) $$ sinkParser json'
+    runHttpRequest req $ \res -> runConduit $ bodyReaderSource (responseBody res) .| sinkParser json'
 
 -- | Allows to fetch information about a user from Google's API.
 --   In case of parsing error returns 'Nothing'.
@@ -277,7 +277,7 @@ getPerson :: Manager -> Token -> HandlerT site IO (Maybe Person)
 getPerson manager token = parseMaybe parseJSON <$> (do
     req <- personValueRequest token
     res <- http req manager
-    responseBody res $$ sinkParser json'
+    runConduit $ responseBody res .| sinkParser json'
   )
 
 personValueRequest :: MonadIO m => Token -> m Request
diff --git a/yesod-bin/AddHandler.hs b/yesod-bin/AddHandler.hs
index e925661f..8995a0b1 100644
--- a/yesod-bin/AddHandler.hs
+++ b/yesod-bin/AddHandler.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE PatternGuards #-}
 module AddHandler (addHandler) where
 
@@ -8,7 +9,11 @@ import Data.List  (isPrefixOf, isSuffixOf, stripPrefix)
 import Data.Maybe (fromMaybe, listToMaybe)
 import qualified Data.Text as T
 import qualified Data.Text.IO as TIO
+#if MIN_VERSION_Cabal(2, 0, 0)
+import Distribution.PackageDescription.Parse (readGenericPackageDescription)
+#else
 import Distribution.PackageDescription.Parse (readPackageDescription)
+#endif
 import Distribution.PackageDescription.Configuration (flattenPackageDescription)
 import Distribution.PackageDescription (allBuildInfo, hsSourceDirs)
 import Distribution.Verbosity (normal)
@@ -224,7 +229,11 @@ uncapitalize "" = ""
 
 getSrcDir :: FilePath -> IO FilePath
 getSrcDir cabal = do
+#if MIN_VERSION_Cabal(2, 0, 0)
+    pd <- flattenPackageDescription <$> readGenericPackageDescription normal cabal
+#else
     pd <- flattenPackageDescription <$> readPackageDescription normal cabal
+#endif
     let buildInfo = allBuildInfo pd
         srcDirs = concatMap hsSourceDirs buildInfo
     return $ fromMaybe "." $ listToMaybe srcDirs
diff --git a/yesod-bin/HsFile.hs b/yesod-bin/HsFile.hs
index 18868c24..6c73fecf 100644
--- a/yesod-bin/HsFile.hs
+++ b/yesod-bin/HsFile.hs
@@ -3,7 +3,6 @@
 module HsFile (mkHsFile) where
 import Text.ProjectTemplate (createTemplate)
 import Conduit
-import Control.Monad.Trans.Resource (runResourceT)
 import qualified Data.ByteString as BS
 import Control.Monad.IO.Class (liftIO)
 import Data.String (fromString)
diff --git a/yesod-core/Yesod/Core/Class/Handler.hs b/yesod-core/Yesod/Core/Class/Handler.hs
index 6e979c2e..44357bfd 100644
--- a/yesod-core/Yesod/Core/Class/Handler.hs
+++ b/yesod-core/Yesod/Core/Class/Handler.hs
@@ -11,7 +11,7 @@ module Yesod.Core.Class.Handler
     ) where
 
 import Yesod.Core.Types
-import Control.Monad.IO.Unlift (liftIO, MonadUnliftIO, MonadIO)
+import Control.Monad.IO.Unlift (liftIO, MonadIO)
 import Control.Monad.Trans.Resource (MonadResource)
 import Control.Monad.Trans.Class (lift)
 #if __GLASGOW_HASKELL__ < 710
diff --git a/yesod-core/Yesod/Core/Internal/Request.hs b/yesod-core/Yesod/Core/Internal/Request.hs
index 522138db..b30cf30c 100644
--- a/yesod-core/Yesod/Core/Internal/Request.hs
+++ b/yesod-core/Yesod/Core/Internal/Request.hs
@@ -35,13 +35,11 @@ import Data.Text.Encoding (decodeUtf8With, decodeUtf8)
 import Data.Text.Encoding.Error (lenientDecode)
 import Conduit
 import Data.Word (Word8, Word64)
-import Control.Monad.Trans.Resource (runResourceT, ResourceT)
 import Control.Exception (throwIO)
 import Control.Monad ((<=<), liftM)
 import Yesod.Core.Types
 import qualified Data.Map as Map
 import Data.IORef
-import Control.Monad.Primitive (PrimMonad, PrimState)
 import qualified Data.Vector.Storable as V
 import Data.ByteString.Internal (ByteString (PS))
 import qualified Data.Word8 as Word8
@@ -181,10 +179,10 @@ mkFileInfoLBS name ct lbs =
     FileInfo name ct (sourceLazy lbs) (`L.writeFile` lbs)
 
 mkFileInfoFile :: Text -> Text -> FilePath -> FileInfo
-mkFileInfoFile name ct fp = FileInfo name ct (sourceFile fp) (\dst -> runResourceT $ sourceFile fp $$ sinkFile dst)
+mkFileInfoFile name ct fp = FileInfo name ct (sourceFile fp) (\dst -> runConduitRes $ sourceFile fp .| sinkFile dst)
 
-mkFileInfoSource :: Text -> Text -> Source (ResourceT IO) ByteString -> FileInfo
-mkFileInfoSource name ct src = FileInfo name ct src (\dst -> runResourceT $ src $$ sinkFile dst)
+mkFileInfoSource :: Text -> Text -> ConduitT () ByteString (ResourceT IO) () -> FileInfo
+mkFileInfoSource name ct src = FileInfo name ct src (\dst -> runConduitRes $ src .| sinkFile dst)
 
 tokenKey :: IsString a => a
 tokenKey = "_TOKEN"
diff --git a/yesod-core/Yesod/Core/Internal/Response.hs b/yesod-core/Yesod/Core/Internal/Response.hs
index a4be46bd..7e2be331 100644
--- a/yesod-core/Yesod/Core/Internal/Response.hs
+++ b/yesod-core/Yesod/Core/Internal/Response.hs
@@ -24,8 +24,7 @@ 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 (..), ($$), transPipe)
-import qualified Data.Conduit.List            as CL
+import           Conduit
 
 yarToResponse :: YesodResponse
               -> (SessionMap -> IO [Header]) -- ^ save session
@@ -53,9 +52,9 @@ yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq _req is sendResponse
             sendResponse $ ResponseBuilder s hs' b
         go (ContentFile fp p) = sendResponse $ ResponseFile s finalHeaders fp p
         go (ContentSource body) = sendResponse $ responseStream s finalHeaders
-            $ \sendChunk flush ->
+            $ \sendChunk flush -> runConduit $
                 transPipe (`runInternalState` is) body
-                $$ CL.mapM_ (\mchunk ->
+                .| mapM_C (\mchunk ->
                     case mchunk of
                         Flush -> flush
                         Chunk builder -> sendChunk builder)
diff --git a/yesod-core/bench/widget.hs b/yesod-core/bench/widget.hs
index 93129680..51d519e8 100644
--- a/yesod-core/bench/widget.hs
+++ b/yesod-core/bench/widget.hs
@@ -12,8 +12,6 @@ import qualified Text.Blaze.Html.Renderer.Utf8 as Utf8
 import Data.Monoid (mconcat)
 import Text.Blaze.Html5 (table, tr, td)
 import Text.Blaze.Html (toHtml)
-import Yesod.Core.Widget
-import Yesod.Core.Types
 import Data.Int
 
 main :: IO ()
diff --git a/yesod-core/test/YesodCoreTest/RawResponse.hs b/yesod-core/test/YesodCoreTest/RawResponse.hs
index 79f69900..60b28807 100644
--- a/yesod-core/test/YesodCoreTest/RawResponse.hs
+++ b/yesod-core/test/YesodCoreTest/RawResponse.hs
@@ -39,8 +39,8 @@ getHomeR = do
     _ <- register $ writeIORef ref 1
     sendRawResponse $ \src sink -> liftIO $ do
         val <- readIORef ref
-        yield (S8.pack $ show val) $$ sink
-        src $$ CL.map (S8.map toUpper) =$ sink
+        runConduit $ yield (S8.pack $ show val) .| sink
+        runConduit $ src .| CL.map (S8.map toUpper) .| sink
 
 getWaiStreamR :: Handler ()
 getWaiStreamR = sendWaiResponse $ responseStream status200 [] $ \send flush -> do
@@ -76,18 +76,18 @@ specs = do
             withAsync (warp port App) $ \_ -> do
                 threadDelay 100000
                 runTCPClient (clientSettings port "127.0.0.1") $ \ad -> do
-                    yield "GET / HTTP/1.1\r\n\r\nhello" $$ appSink ad
-                    (appSource ad $$ CB.take 6) >>= (`shouldBe` "0HELLO")
-                    yield "WORLd" $$ appSink ad
-                    (appSource ad $$ await) >>= (`shouldBe` Just "WORLD")
+                    runConduit $ yield "GET / HTTP/1.1\r\n\r\nhello" .| appSink ad
+                    runConduit (appSource ad .| CB.take 6) >>= (`shouldBe` "0HELLO")
+                    runConduit $ yield "WORLd" .| appSink ad
+                    runConduit (appSource ad .| await) >>= (`shouldBe` Just "WORLD")
 
     let body req = do
             port <- getFreePort
             withAsync (warp port App) $ \_ -> do
                 threadDelay 100000
                 runTCPClient (clientSettings port "127.0.0.1") $ \ad -> do
-                    yield req $$ appSink ad
-                    appSource ad $$ CB.lines =$ do
+                    runConduit $ yield req .| appSink ad
+                    runConduit $ appSource ad .| CB.lines .| do
                         let loop = do
                                 x <- await
                                 case x of
diff --git a/yesod-core/test/YesodCoreTest/RequestBodySize.hs b/yesod-core/test/YesodCoreTest/RequestBodySize.hs
index 9926b42e..ac7c696f 100644
--- a/yesod-core/test/YesodCoreTest/RequestBodySize.hs
+++ b/yesod-core/test/YesodCoreTest/RequestBodySize.hs
@@ -42,11 +42,11 @@ postPostR = do
     return $ RepPlain $ toContent $ T.concat val
 
 postConsumeR = do
-    body <- rawRequestBody $$ consume
+    body <- runConduit $ rawRequestBody .| consume
     return $ RepPlain $ toContent $ S.concat body
 
 postPartialConsumeR = do
-    body <- rawRequestBody $$ isolate 5 =$ consume
+    body <- runConduit $ rawRequestBody .| isolate 5 .| consume
     return $ RepPlain $ toContent $ S.concat body
 
 postUnusedR = return $ RepPlain ""
diff --git a/yesod-eventsource/Yesod/EventSource.hs b/yesod-eventsource/Yesod/EventSource.hs
index f0918034..81c2b0dc 100644
--- a/yesod-eventsource/Yesod/EventSource.hs
+++ b/yesod-eventsource/Yesod/EventSource.hs
@@ -13,7 +13,7 @@ import Control.Monad (when)
 import Data.Functor ((<$>))
 import Data.Monoid (Monoid (..))
 import Yesod.Core
-import qualified Data.Conduit as C
+import Data.Conduit
 import qualified Network.Wai as W
 import qualified Network.Wai.EventSource as ES
 import qualified Network.Wai.EventSource.EventStream as ES
@@ -32,17 +32,17 @@ prepareForEventSource = do
 
 
 -- | (Internal) Source with a event stream content-type.
-respondEventStream :: C.Source (HandlerT site IO) (C.Flush Builder)
+respondEventStream :: ConduitT () (Flush Builder) (HandlerT site IO) ()
                    -> HandlerT site IO TypedContent
 respondEventStream = respondSource "text/event-stream"
 
 
--- | Returns a Server-Sent Event stream from a 'C.Source' of
+-- | Returns a Server-Sent Event stream from a 'Source' of
 -- 'ES.ServerEvent'@s@.  The HTTP socket is flushed after every
--- event.  The connection is closed either when the 'C.Source'
+-- event.  The connection is closed either when the 'Source'
 -- finishes outputting data or a 'ES.CloseEvent' is outputted,
 -- whichever comes first.
-repEventSource :: (EventSourcePolyfill -> C.Source (HandlerT site IO) ES.ServerEvent)
+repEventSource :: (EventSourcePolyfill -> ConduitT () ES.ServerEvent (HandlerT site IO) ())
                -> HandlerT site IO TypedContent
 repEventSource src =
   prepareForEventSource >>=
@@ -50,14 +50,17 @@ repEventSource 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
+  :: Monad m
+  => ConduitT () ES.ServerEvent m ()
+  -> ConduitT () (Flush Builder) m ()
 sourceToSource src =
-    src C.$= C.awaitForever eventToFlushBuilder
+    src .| awaitForever eventToFlushBuilder
   where
     eventToFlushBuilder event =
         case ES.eventToBuilder event of
             Nothing -> return ()
-            Just x -> C.yield (C.Chunk x) >> C.yield C.Flush
+            Just x -> yield (Chunk x) >> yield Flush
 
 
 -- | Return a Server-Sent Event stream given a 'HandlerT' action
@@ -79,8 +82,8 @@ pollingEventSource initial act = do
           [] -> getEvents s'
           _  -> do
             let (builder, continue) = joinEvents evs mempty
-            C.yield (C.Chunk builder)
-            C.yield C.Flush
+            yield (Chunk builder)
+            yield Flush
             when continue (getEvents s')
 
       -- Join all events in a single Builder.  Returns @False@
diff --git a/yesod-persistent/Yesod/Persist/Core.hs b/yesod-persistent/Yesod/Persist/Core.hs
index 3f99833f..e07cd7ea 100644
--- a/yesod-persistent/Yesod/Persist/Core.hs
+++ b/yesod-persistent/Yesod/Persist/Core.hs
@@ -118,8 +118,8 @@ defaultGetDBRunner getPool = do
 --
 -- Since 1.2.0
 runDBSource :: YesodPersistRunner site
-            => Source (YesodDB site) a
-            -> Source (HandlerT site IO) a
+            => ConduitT () a (YesodDB site) ()
+            -> ConduitT () a (HandlerT site IO) ()
 runDBSource src = do
     (dbrunner, cleanup) <- lift getDBRunner
     transPipe (runDBRunner dbrunner) src
@@ -128,7 +128,7 @@ runDBSource src = do
 -- | Extends 'respondSource' to create a streaming database response body.
 respondSourceDB :: YesodPersistRunner site
                 => ContentType
-                -> Source (YesodDB site) (Flush Builder)
+                -> ConduitT () (Flush Builder) (YesodDB site) ()
                 -> HandlerT site IO TypedContent
 respondSourceDB ctype = respondSource ctype . runDBSource
 
diff --git a/yesod-persistent/test/Yesod/PersistSpec.hs b/yesod-persistent/test/Yesod/PersistSpec.hs
index fa6a4986..13356553 100644
--- a/yesod-persistent/test/Yesod/PersistSpec.hs
+++ b/yesod-persistent/test/Yesod/PersistSpec.hs
@@ -45,7 +45,7 @@ getHomeR = do
         insert_ $ Person "Charlie"
         insert_ $ Person "Alice"
         insert_ $ Person "Bob"
-    respondSourceDB typePlain $ selectSource [] [Asc PersonName] $= awaitForever toBuilder
+    respondSourceDB typePlain $ selectSource [] [Asc PersonName] .| awaitForever toBuilder
   where
     toBuilder (Entity _ (Person name)) = do
         yield $ Chunk $ fromText name
diff --git a/yesod-sitemap/Yesod/Sitemap.hs b/yesod-sitemap/Yesod/Sitemap.hs
index 308164f8..9aaa068f 100644
--- a/yesod-sitemap/Yesod/Sitemap.hs
+++ b/yesod-sitemap/Yesod/Sitemap.hs
@@ -74,13 +74,13 @@ robots smurl = do
 -- | Serve a stream of @SitemapUrl@s as a sitemap.
 --
 -- Since 1.2.0
-sitemap :: Source (HandlerT site IO) (SitemapUrl (Route site))
+sitemap :: ConduitT () (SitemapUrl (Route site)) (HandlerT site IO) ()
         -> HandlerT site IO TypedContent
 sitemap urls = do
     render <- getUrlRender
     respondSource typeXml $ do
         yield Flush
-        urls $= sitemapConduit render $= renderBuilder def $= CL.map Chunk
+        urls .| sitemapConduit render .| renderBuilder def .| CL.map Chunk
 
 -- | Convenience wrapper for @sitemap@ for the case when the input is an
 -- in-memory list.
@@ -97,7 +97,7 @@ sitemapList = sitemap . mapM_ yield
 -- Since 1.2.0
 sitemapConduit :: Monad m
                => (a -> Text)
-               -> Conduit (SitemapUrl a) m Event
+               -> ConduitT (SitemapUrl a) Event m ()
 sitemapConduit render = do
     yield EventBeginDocument
     element "urlset" [] $ awaitForever goUrl
diff --git a/yesod-static/Yesod/Static.hs b/yesod-static/Yesod/Static.hs
index fd5f8a70..fdff8838 100644
--- a/yesod-static/Yesod/Static.hs
+++ b/yesod-static/Yesod/Static.hs
@@ -68,7 +68,6 @@ import qualified System.FilePath as FP
 import Control.Monad
 import Data.FileEmbed (embedDir)
 
-import Control.Monad.Trans.Resource (runResourceT)
 import Yesod.Core
 import Yesod.Core.Types
 
@@ -95,7 +94,6 @@ import qualified Data.ByteString as S
 import System.PosixCompat.Files (getFileStatus, modificationTime)
 import System.Posix.Types (EpochTime)
 import Conduit
-import Data.Functor.Identity (runIdentity)
 import System.FilePath ((</>), (<.>), takeDirectory)
 import qualified System.FilePath as F
 import qualified Data.Text.Lazy as TL

From 89be12c147ed66e4c0f5a50958fe95eaab9de18f Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 15 Jan 2018 15:18:09 +0200
Subject: [PATCH 20/43] Strictify a bunch of fields

---
 yesod-core/Yesod/Core/Types.hs | 64 ++++++++++++++++++----------------
 1 file changed, 33 insertions(+), 31 deletions(-)

diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index f0a8f93b..c7799b7c 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -73,7 +73,7 @@ newtype SessionBackend = SessionBackend
                     -> IO (SessionMap, SaveSession) -- ^ Return the session data and a function to save the session
     }
 
-data SessionCookie = SessionCookie (Either UTCTime ByteString) ByteString SessionMap
+data SessionCookie = SessionCookie !(Either UTCTime ByteString) !ByteString !SessionMap
     deriving (Show, Read)
 instance Serialize SessionCookie where
     put (SessionCookie a b c) = do
@@ -151,13 +151,13 @@ data Approot master = ApprootRelative -- ^ No application root.
 
 type ResolvedApproot = Text
 
-data AuthResult = Authorized | AuthenticationRequired | Unauthorized Text
+data AuthResult = Authorized | AuthenticationRequired | Unauthorized !Text
     deriving (Eq, Show, Read)
 
 data ScriptLoadPosition master
     = BottomOfBody
     | BottomOfHeadBlocking
-    | BottomOfHeadAsync (BottomOfHeadAsync master)
+    | BottomOfHeadAsync !(BottomOfHeadAsync master)
 
 type BottomOfHeadAsync master
        = [Text] -- ^ urls to load asynchronously
@@ -170,7 +170,7 @@ type Texts = [Text]
 newtype WaiSubsite = WaiSubsite { runWaiSubsite :: W.Application }
 
 -- | Like 'WaiSubsite', but applies parent site's middleware and isAuthorized.
--- 
+--
 -- @since 1.4.34
 newtype WaiSubsiteWithAuth = WaiSubsiteWithAuth { runWaiSubsiteWithAuth :: W.Application }
 
@@ -201,7 +201,7 @@ data YesodRunnerEnv site = YesodRunnerEnv
     , yreSessionBackend :: !(Maybe SessionBackend)
     , yreGen            :: !(IO Int)
     -- ^ Generate a random number
-    , yreGetMaxExpires  :: IO Text
+    , yreGetMaxExpires  :: !(IO Text)
     }
 
 data YesodSubRunnerEnv sub parent parentMonad = YesodSubRunnerEnv
@@ -228,12 +228,12 @@ type instance MonadRoute IO = ()
 type instance MonadRoute (HandlerT site m) = (Route site)
 
 data GHState = GHState
-    { ghsSession :: SessionMap
-    , ghsRBC     :: Maybe RequestBodyContents
-    , ghsIdent   :: Int
-    , ghsCache   :: TypeMap
-    , ghsCacheBy :: KeyedTypeMap
-    , ghsHeaders :: Endo [Header]
+    { ghsSession :: !SessionMap
+    , ghsRBC     :: !(Maybe RequestBodyContents)
+    , ghsIdent   :: !Int
+    , ghsCache   :: !TypeMap
+    , ghsCacheBy :: !KeyedTypeMap
+    , ghsHeaders :: !(Endo [Header])
     }
 
 -- | An extension of the basic WAI 'W.Application' datatype to provide extra
@@ -281,9 +281,9 @@ newtype CssBuilder = CssBuilder { unCssBuilder :: TBuilder.Builder }
 --
 -- > PageContent url -> HtmlUrl url
 data PageContent url = PageContent
-    { pageTitle :: Html
-    , pageHead  :: HtmlUrl url
-    , pageBody  :: HtmlUrl url
+    { pageTitle :: !Html
+    , pageHead  :: !(HtmlUrl url)
+    , pageBody  :: !(HtmlUrl url)
     }
 
 data Content = ContentBuilder !BB.Builder !(Maybe Int) -- ^ The content and optional content length.
@@ -310,11 +310,11 @@ newtype DontFullyEvaluate a = DontFullyEvaluate { unDontFullyEvaluate :: a }
 -- | Responses to indicate some form of an error occurred.
 data ErrorResponse =
       NotFound
-    | InternalError Text
-    | InvalidArgs [Text]
+    | InternalError !Text
+    | InvalidArgs ![Text]
     | NotAuthenticated
-    | PermissionDenied Text
-    | BadMethod H.Method
+    | PermissionDenied !Text
+    | BadMethod !H.Method
     deriving (Show, Eq, Typeable, Generic)
 instance NFData ErrorResponse where
     rnf = genericRnf
@@ -322,9 +322,11 @@ instance NFData ErrorResponse where
 ----- header stuff
 -- | Headers to be added to a 'Result'.
 data Header =
-      AddCookie SetCookie
-    | DeleteCookie ByteString ByteString
-    | Header ByteString ByteString
+      AddCookie !SetCookie
+    | DeleteCookie !ByteString !ByteString
+    -- ^ name and path
+    | Header !ByteString !ByteString
+    -- ^ key and value
     deriving (Eq, Show)
 
 -- FIXME In the next major version bump, let's just add strictness annotations
@@ -335,16 +337,16 @@ instance NFData Header where
     rnf (DeleteCookie x y) = x `seq` y `seq` ()
     rnf (Header x y) = x `seq` y `seq` ()
 
-data Location url = Local url | Remote Text
+data Location url = Local !url | Remote !Text
     deriving (Show, Eq)
 
 -- | A diff list that does not directly enforce uniqueness.
 -- When creating a widget Yesod will use nub to make it unique.
 newtype UniqueList x = UniqueList ([x] -> [x])
 
-data Script url = Script { scriptLocation :: Location url, scriptAttributes :: [(Text, Text)] }
+data Script url = Script { scriptLocation :: !(Location url), scriptAttributes :: ![(Text, Text)] }
     deriving (Show, Eq)
-data Stylesheet url = Stylesheet { styleLocation :: Location url, styleAttributes :: [(Text, Text)] }
+data Stylesheet url = Stylesheet { styleLocation :: !(Location url), styleAttributes :: ![(Text, Text)] }
     deriving (Show, Eq)
 newtype Title = Title { unTitle :: Html }
 
@@ -380,13 +382,13 @@ instance Monoid (GWData a) where
 instance Semigroup (GWData a)
 
 data HandlerContents =
-      HCContent H.Status !TypedContent
-    | HCError ErrorResponse
-    | HCSendFile ContentType FilePath (Maybe FilePart)
-    | HCRedirect H.Status Text
-    | HCCreated Text
-    | HCWai W.Response
-    | HCWaiApp W.Application
+      HCContent !H.Status !TypedContent
+    | HCError !ErrorResponse
+    | HCSendFile !ContentType !FilePath !(Maybe FilePart)
+    | HCRedirect !H.Status !Text
+    | HCCreated !Text
+    | HCWai !W.Response
+    | HCWaiApp !W.Application
     deriving Typeable
 
 instance Show HandlerContents where

From 25acc5799b4b744a18236dbe2229518a0d92fe7f Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 15 Jan 2018 15:57:36 +0200
Subject: [PATCH 21/43] Version bumps and changelog updates

---
 yesod-auth-oauth/ChangeLog.md             | 4 ++++
 yesod-auth-oauth/yesod-auth-oauth.cabal   | 9 ++++-----
 yesod-auth/ChangeLog.md                   | 4 ++++
 yesod-auth/yesod-auth.cabal               | 8 ++++----
 yesod-bin/ChangeLog.md                    | 4 ++++
 yesod-bin/yesod-bin.cabal                 | 3 +--
 yesod-core/ChangeLog.md                   | 9 +++++++--
 yesod-core/Yesod/Core/Types.hs            | 2 +-
 yesod-core/yesod-core.cabal               | 2 +-
 yesod-eventsource/ChangeLog.md            | 4 ++++
 yesod-eventsource/yesod-eventsource.cabal | 4 ++--
 yesod-form/ChangeLog.md                   | 4 ++++
 yesod-form/yesod-form.cabal               | 6 +++---
 yesod-newsfeed/ChangeLog.md               | 4 ++++
 yesod-newsfeed/yesod-newsfeed.cabal       | 4 ++--
 yesod-persistent/ChangeLog.md             | 4 ++++
 yesod-persistent/yesod-persistent.cabal   | 4 ++--
 yesod-sitemap/ChangeLog.md                | 3 +++
 yesod-sitemap/yesod-sitemap.cabal         | 4 ++--
 yesod-static/ChangeLog.md                 | 4 ++++
 yesod-static/yesod-static.cabal           | 6 +++---
 yesod-test/ChangeLog.md                   | 4 ++++
 yesod-test/yesod-test.cabal               | 8 +++-----
 yesod-websockets/ChangeLog.md             | 4 ++++
 yesod-websockets/yesod-websockets.cabal   | 6 +++---
 yesod/ChangeLog.md                        | 4 ++++
 yesod/yesod.cabal                         | 9 ++++-----
 27 files changed, 89 insertions(+), 42 deletions(-)

diff --git a/yesod-auth-oauth/ChangeLog.md b/yesod-auth-oauth/ChangeLog.md
index fb5ca395..9e1ca6ea 100644
--- a/yesod-auth-oauth/ChangeLog.md
+++ b/yesod-auth-oauth/ChangeLog.md
@@ -1,3 +1,7 @@
+## 1.6.0
+
+* Upgrade to yesod-core 1.6.0
+
 ## 1.4.2
 
 * Fix warnings
diff --git a/yesod-auth-oauth/yesod-auth-oauth.cabal b/yesod-auth-oauth/yesod-auth-oauth.cabal
index c21ac9e1..3176f6bd 100644
--- a/yesod-auth-oauth/yesod-auth-oauth.cabal
+++ b/yesod-auth-oauth/yesod-auth-oauth.cabal
@@ -1,5 +1,5 @@
 name:            yesod-auth-oauth
-version:         1.4.2
+version:         1.6.0
 license:         BSD3
 license-file:    LICENSE
 author:          Hiromi Ishii
@@ -23,12 +23,11 @@ library
         build-depends:   base                >= 4         && < 4.3
     build-depends:   authenticate-oauth      >= 1.5       && < 1.7
                    , bytestring              >= 0.9.1.4
-                   , yesod-core              >= 1.4       && < 1.5
-                   , yesod-auth              >= 1.4       && < 1.5
+                   , yesod-core              >= 1.6       && < 1.7
+                   , yesod-auth              >= 1.6       && < 1.7
                    , text                    >= 0.7
-                   , yesod-form              >= 1.4       && < 1.5
+                   , yesod-form              >= 1.6       && < 1.7
                    , transformers            >= 0.2.2     && < 0.6
-                   , lifted-base             >= 0.2       && < 0.3
     exposed-modules: Yesod.Auth.OAuth
     ghc-options:     -Wall
 
diff --git a/yesod-auth/ChangeLog.md b/yesod-auth/ChangeLog.md
index 095ccbd6..69ac6519 100644
--- a/yesod-auth/ChangeLog.md
+++ b/yesod-auth/ChangeLog.md
@@ -1,3 +1,7 @@
+## 1.6.0
+
+* Upgrade to yesod-core 1.6.0
+
 ## 1.4.21
 
 * Add redirectToCurrent to Yesod.Auth module for controlling setUltDestCurrent in redirectLogin [#1461](https://github.com/yesodweb/yesod/pull/1461)
diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal
index 194638f5..1ba37f7e 100644
--- a/yesod-auth/yesod-auth.cabal
+++ b/yesod-auth/yesod-auth.cabal
@@ -1,5 +1,5 @@
 name:            yesod-auth
-version:         1.4.21
+version:         1.6.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman, Patrick Brisbin
@@ -23,7 +23,7 @@ library
     build-depends:   base                    >= 4         && < 5
                    , authenticate            >= 1.3
                    , bytestring              >= 0.9.1.4
-                   , yesod-core              >= 1.4.31    && < 1.5
+                   , yesod-core              >= 1.6       && < 1.7
                    , wai                     >= 1.4
                    , template-haskell
                    , base16-bytestring
@@ -32,11 +32,11 @@ library
                    , random                  >= 1.0.0.2
                    , text                    >= 0.7
                    , mime-mail               >= 0.3
-                   , yesod-persistent        >= 1.4
+                   , yesod-persistent        >= 1.6
                    , shakespeare
                    , containers
                    , unordered-containers
-                   , yesod-form              >= 1.4       && < 1.5
+                   , yesod-form              >= 1.6       && < 1.7
                    , transformers            >= 0.2.2
                    , persistent              >= 2.1       && < 2.8
                    , persistent-template     >= 2.1       && < 2.8
diff --git a/yesod-bin/ChangeLog.md b/yesod-bin/ChangeLog.md
index 0020b34a..f82a8fbd 100644
--- a/yesod-bin/ChangeLog.md
+++ b/yesod-bin/ChangeLog.md
@@ -1,3 +1,7 @@
+## 1.6.0
+
+* Upgrade to conduit 1.3.0
+
 ## 1.5.3
 
 * Support typed-process-0.2.0.0
diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal
index 3bb4f2b5..df153e75 100644
--- a/yesod-bin/yesod-bin.cabal
+++ b/yesod-bin/yesod-bin.cabal
@@ -1,5 +1,5 @@
 name:            yesod-bin
-version:         1.5.3
+version:         1.6.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -52,7 +52,6 @@ executable             yesod
                      , conduit-extra      >= 1.3
                      , resourcet          >= 1.2
                      , base64-bytestring
-                     , lifted-base
                      , http-reverse-proxy >= 0.4
                      , network            >= 2.5
                      , http-client-tls
diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md
index 88a0dcb2..6d07c61e 100644
--- a/yesod-core/ChangeLog.md
+++ b/yesod-core/ChangeLog.md
@@ -1,9 +1,14 @@
-## 1.4.38
+## 1.6.0
 
+* Upgrade to conduit 1.3.0
+* Switch to `MonadUnliftIO`
+* Drop `mwc-random` and `blaze-builder` dependencies
+* Strictify some internal data structures
+* Add `CI` wrapper to first field in `Header` data constructor
+  [#1418](https://github.com/yesodweb/yesod/issues/1418)
 * Internal only change, users of stable API are unaffected: `WidgetT`
   holds its data in an `IORef` so that it is isomorphic to `ReaderT`,
   avoiding state-loss issues..
-* Instances for `MonadUnliftIO`
 
 ## 1.4.37.2
 
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index c7799b7c..78ec0fef 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -325,7 +325,7 @@ data Header =
       AddCookie !SetCookie
     | DeleteCookie !ByteString !ByteString
     -- ^ name and path
-    | Header !ByteString !ByteString
+    | Header !(CI ByteString) !ByteString
     -- ^ key and value
     deriving (Eq, Show)
 
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index 4c2db3ed..bc05c81b 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         1.4.38
+version:         1.6.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
diff --git a/yesod-eventsource/ChangeLog.md b/yesod-eventsource/ChangeLog.md
index f7658231..a5b12741 100644
--- a/yesod-eventsource/ChangeLog.md
+++ b/yesod-eventsource/ChangeLog.md
@@ -1,3 +1,7 @@
+## 1.6.0
+
+* Upgrade to yesod-core 1.6.0
+
 ## 1.4.1
 
 * Fix warnings
diff --git a/yesod-eventsource/yesod-eventsource.cabal b/yesod-eventsource/yesod-eventsource.cabal
index db77ea47..7105ca77 100644
--- a/yesod-eventsource/yesod-eventsource.cabal
+++ b/yesod-eventsource/yesod-eventsource.cabal
@@ -1,5 +1,5 @@
 name:            yesod-eventsource
-version:         1.4.1
+version:         1.6.0
 license:         MIT
 license-file:    LICENSE
 author:          Felipe Lessa <felipe.lessa@gmail.com>
@@ -15,7 +15,7 @@ extra-source-files: README.md ChangeLog.md
 
 library
     build-depends:   base                  >= 4        && < 5
-                   , yesod-core            == 1.4.*
+                   , yesod-core            == 1.6.*
                    , conduit               >= 1.3
                    , wai                   >= 1.3
                    , wai-eventsource       >= 1.3
diff --git a/yesod-form/ChangeLog.md b/yesod-form/ChangeLog.md
index a941f21a..9af79a52 100644
--- a/yesod-form/ChangeLog.md
+++ b/yesod-form/ChangeLog.md
@@ -1,3 +1,7 @@
+## 1.6.0
+
+* Upgrade to yesod-core 1.6.0
+
 ## 1.4.16
 
 * Korean translation
diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal
index 4f252938..aa54488a 100644
--- a/yesod-form/yesod-form.cabal
+++ b/yesod-form/yesod-form.cabal
@@ -1,5 +1,5 @@
 name:            yesod-form
-version:         1.4.16
+version:         1.6.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -20,8 +20,8 @@ flag network-uri
 
 library
     build-depends:   base                  >= 4        && < 5
-                   , yesod-core            >= 1.4.14   && < 1.5
-                   , yesod-persistent      >= 1.4      && < 1.5
+                   , yesod-core            >= 1.6      && < 1.7
+                   , yesod-persistent      >= 1.6      && < 1.7
                    , time                  >= 1.1.4
                    , shakespeare           >= 2.0
                    , persistent
diff --git a/yesod-newsfeed/ChangeLog.md b/yesod-newsfeed/ChangeLog.md
index eaaf8753..fb70d46b 100644
--- a/yesod-newsfeed/ChangeLog.md
+++ b/yesod-newsfeed/ChangeLog.md
@@ -1,5 +1,9 @@
 # Changelog
 
+## 1.6.1
+
+* Upgrade to yesod-core 1.6.0
+
 ## 1.6
 
 * Create new datatype `EntryEnclosure` for self-documentation of `feedEntryEnclosure`.
diff --git a/yesod-newsfeed/yesod-newsfeed.cabal b/yesod-newsfeed/yesod-newsfeed.cabal
index b8d57c7d..cc4b9e6b 100644
--- a/yesod-newsfeed/yesod-newsfeed.cabal
+++ b/yesod-newsfeed/yesod-newsfeed.cabal
@@ -1,5 +1,5 @@
 name:            yesod-newsfeed
-version:         1.6
+version:         1.6.1.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman, Patrick Brisbin
@@ -15,7 +15,7 @@ extra-source-files: README.md ChangeLog.md
 
 library
     build-depends:   base                 >= 4        && < 5
-                   , yesod-core           >= 1.4      && < 1.5
+                   , yesod-core           >= 1.6      && < 1.7
                    , time                 >= 1.1.4
                    , shakespeare          >= 2.0
                    , bytestring           >= 0.9.1.4
diff --git a/yesod-persistent/ChangeLog.md b/yesod-persistent/ChangeLog.md
index a7343ed8..1cda90f9 100644
--- a/yesod-persistent/ChangeLog.md
+++ b/yesod-persistent/ChangeLog.md
@@ -1,3 +1,7 @@
+## 1.6.0
+
+* Upgrade to yesod-core 1.6.0
+
 ## 1.4.3
 
 * Fix overly powerful constraints on get404 and getBy404.
diff --git a/yesod-persistent/yesod-persistent.cabal b/yesod-persistent/yesod-persistent.cabal
index a2c255dd..4ac6dca7 100644
--- a/yesod-persistent/yesod-persistent.cabal
+++ b/yesod-persistent/yesod-persistent.cabal
@@ -1,5 +1,5 @@
 name:            yesod-persistent
-version:         1.4.3
+version:         1.6.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -15,7 +15,7 @@ extra-source-files: README.md ChangeLog.md
 
 library
     build-depends:   base                      >= 4        && < 5
-                   , yesod-core                >= 1.4.0    && < 1.5
+                   , yesod-core                >= 1.6      && < 1.7
                    , persistent                >= 2.1      && < 2.8
                    , persistent-template       >= 2.1      && < 2.8
                    , transformers              >= 0.2.2
diff --git a/yesod-sitemap/ChangeLog.md b/yesod-sitemap/ChangeLog.md
index e69de29b..646e7378 100644
--- a/yesod-sitemap/ChangeLog.md
+++ b/yesod-sitemap/ChangeLog.md
@@ -0,0 +1,3 @@
+## 1.6.0
+
+* Upgrade to yesod-core 1.6.0
diff --git a/yesod-sitemap/yesod-sitemap.cabal b/yesod-sitemap/yesod-sitemap.cabal
index 511a21b7..b88a7546 100644
--- a/yesod-sitemap/yesod-sitemap.cabal
+++ b/yesod-sitemap/yesod-sitemap.cabal
@@ -1,5 +1,5 @@
 name:            yesod-sitemap
-version:         1.4.0.1
+version:         1.6.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -15,7 +15,7 @@ extra-source-files: README.md ChangeLog.md
 
 library
     build-depends:   base                      >= 4        && < 5
-                   , yesod-core                >= 1.4      && < 1.5
+                   , yesod-core                >= 1.6      && < 1.7
                    , time                      >= 1.1.4
                    , xml-conduit               >= 1.0
                    , text
diff --git a/yesod-static/ChangeLog.md b/yesod-static/ChangeLog.md
index fdb162a8..0e30e941 100644
--- a/yesod-static/ChangeLog.md
+++ b/yesod-static/ChangeLog.md
@@ -1,3 +1,7 @@
+## 1.6.0
+
+* Upgrade to yesod-core 1.6.0
+
 ## 1.5.3.1
 
 * Switch to cryptonite
diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal
index 8ddf0dbc..e5135d05 100644
--- a/yesod-static/yesod-static.cabal
+++ b/yesod-static/yesod-static.cabal
@@ -1,5 +1,5 @@
 name:            yesod-static
-version:         1.5.3.1
+version:         1.6.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -29,7 +29,7 @@ library
     build-depends:   base                  >= 4        && < 5
                    , containers            >= 0.2
                    , old-time              >= 1.0
-                   , yesod-core            >= 1.4      && < 1.5
+                   , yesod-core            >= 1.6      && < 1.7
                    , base64-bytestring     >= 0.1.0.1
                    , byteable              >= 0.1
                    , bytestring            >= 0.9.1.4
@@ -91,7 +91,7 @@ test-suite tests
                      YesodStaticTest
     build-depends:   base
                    , hspec >= 1.3
-                   , yesod-test >= 1.4
+                   , yesod-test >= 1.6
                    , wai-extra
                    , HUnit
 
diff --git a/yesod-test/ChangeLog.md b/yesod-test/ChangeLog.md
index 1ce26713..07c308ef 100644
--- a/yesod-test/ChangeLog.md
+++ b/yesod-test/ChangeLog.md
@@ -1,3 +1,7 @@
+## 1.6.0
+
+* Upgrade to yesod-core 1.6.0
+
 ## 1.5.9.1
 
 * Fixes a Haddock syntax error in 1.5.9 [#1473](https://github.com/yesodweb/yesod/pull/1473)
diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal
index c49e12fe..6585217c 100644
--- a/yesod-test/yesod-test.cabal
+++ b/yesod-test/yesod-test.cabal
@@ -1,5 +1,5 @@
 name:               yesod-test
-version:            1.5.9.1
+version:            1.6.0
 license:            MIT
 license-file:       LICENSE
 author:             Nubis <nubis@woobiz.com.ar>
@@ -27,7 +27,6 @@ library
                    , hspec-core                == 2.*
                    , html-conduit              >= 0.1
                    , http-types                >= 0.7
-                   , monad-control
                    , network                   >= 2.2
                    , persistent                >= 1.0
                    , pretty-show               >= 1.6
@@ -38,7 +37,7 @@ library
                    , wai-extra
                    , xml-conduit               >= 1.0
                    , xml-types                 >= 0.3
-                   , yesod-core                >= 1.4.14
+                   , yesod-core                >= 1.6
 
     exposed-modules: Yesod.Test
                      Yesod.Test.CssQuery
@@ -58,10 +57,9 @@ test-suite test
                           , containers
                           , html-conduit
                           , yesod-core
-                          , yesod-form >= 1.4.14
+                          , yesod-form >= 1.6
                           , text
                           , wai
-                          , lifted-base
                           , http-types
 
 source-repository head
diff --git a/yesod-websockets/ChangeLog.md b/yesod-websockets/ChangeLog.md
index 74ece92f..9b9a22f6 100644
--- a/yesod-websockets/ChangeLog.md
+++ b/yesod-websockets/ChangeLog.md
@@ -1,3 +1,7 @@
+## 0.3.0
+
+* Upgrade to yesod-core 1.6
+
 ## 0.2.6
 
 * Fix warnings
diff --git a/yesod-websockets/yesod-websockets.cabal b/yesod-websockets/yesod-websockets.cabal
index 70bfc00b..23f6b800 100644
--- a/yesod-websockets/yesod-websockets.cabal
+++ b/yesod-websockets/yesod-websockets.cabal
@@ -1,5 +1,5 @@
 name:                yesod-websockets
-version:             0.2.6
+version:             0.3.0
 synopsis:            WebSockets support for Yesod
 description:         WebSockets support for Yesod
 homepage:            https://github.com/yesodweb/yesod
@@ -23,9 +23,9 @@ library
                      , wai-websockets    >= 2.1
                      , websockets        >= 0.9
                      , transformers      >= 0.2
-                     , yesod-core        >= 1.4
+                     , yesod-core        >= 1.6
                      , unliftio
-                     , conduit           >= 1.0.15.1
+                     , conduit           >= 1.3
 
 source-repository head
   type:     git
diff --git a/yesod/ChangeLog.md b/yesod/ChangeLog.md
index 6799776d..db13e23b 100644
--- a/yesod/ChangeLog.md
+++ b/yesod/ChangeLog.md
@@ -1,3 +1,7 @@
+## 1.6.0
+
+* Upgrade to yesod-core 1.6
+
 ## 1.4.5
 
 * Fix warnings
diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal
index 5eb0f06e..67309efe 100644
--- a/yesod/yesod.cabal
+++ b/yesod/yesod.cabal
@@ -1,5 +1,5 @@
 name:            yesod
-version:         1.4.5
+version:         1.6.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -18,10 +18,9 @@ library
         cpp-options: -DWINDOWS
 
     build-depends:   base                      >= 4.6      && < 5
-                   , yesod-core                >= 1.4      && < 1.5
-                   , yesod-persistent          >= 1.4      && < 1.5
-                   , yesod-form                >= 1.4      && < 1.5
-                   , monad-control             >= 0.3      && < 1.1
+                   , yesod-core                >= 1.6      && < 1.7
+                   , yesod-persistent          >= 1.6      && < 1.7
+                   , yesod-form                >= 1.6      && < 1.7
                    , transformers              >= 0.2.2
                    , wai                       >= 1.3
                    , wai-extra                 >= 1.3

From 915d9e2fa667d0aabc43eadf0669b434f18bd683 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 15 Jan 2018 16:47:49 +0200
Subject: [PATCH 22/43] Finish switching header key to a CI

Fixes #1418
---
 yesod-bin/Build.hs                         | 3 +--
 yesod-core/Yesod/Core/Handler.hs           | 7 ++++---
 yesod-core/Yesod/Core/Internal/Response.hs | 3 +--
 yesod-core/Yesod/Core/Types.hs             | 1 +
 4 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/yesod-bin/Build.hs b/yesod-bin/Build.hs
index 3050a1a8..aca37e74 100644
--- a/yesod-bin/Build.hs
+++ b/yesod-bin/Build.hs
@@ -20,8 +20,7 @@ import           Data.Text.Encoding.Error (lenientDecode)
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as S
 
-import           Control.Exception (SomeException, try, IOException)
-import           Control.Exception.Lifted (handle)
+import           UnliftIO (SomeException, try, IOException, handle)
 import           Control.Monad (when, filterM, forM, forM_, (>=>))
 import           Control.Monad.Trans.State (StateT, get, put, execStateT)
 import           Control.Monad.Trans.Writer (WriterT, tell, execWriterT)
diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs
index 7ff66627..45e15a20 100644
--- a/yesod-core/Yesod/Core/Handler.hs
+++ b/yesod-core/Yesod/Core/Handler.hs
@@ -193,6 +193,7 @@ import           Control.Applicative           ((<$>))
 import           Data.Monoid                   (mempty, mappend)
 #endif
 import           Control.Applicative           ((<|>))
+import qualified Data.CaseInsensitive          as CI
 import           Control.Exception             (evaluate, SomeException, throwIO)
 import           Control.Exception             (handle)
 
@@ -779,7 +780,7 @@ setLanguage = setSession langKey
 --
 -- @since 1.2.0
 addHeader :: MonadHandler m => Text -> Text -> m ()
-addHeader a = addHeaderInternal . Header (encodeUtf8 a) . encodeUtf8
+addHeader a = addHeaderInternal . Header (CI.mk $ encodeUtf8 a) . encodeUtf8
 
 -- | Deprecated synonym for addHeader.
 setHeader :: MonadHandler m => Text -> Text -> m ()
@@ -797,10 +798,10 @@ replaceOrAddHeader :: MonadHandler m => Text -> Text -> m ()
 replaceOrAddHeader a b =
   modify $ \g -> g {ghsHeaders = replaceHeader (ghsHeaders g)}
   where
-    repHeader = Header (encodeUtf8 a) (encodeUtf8 b)
+    repHeader = Header (CI.mk $ encodeUtf8 a) (encodeUtf8 b)
 
     sameHeaderName :: Header -> Header -> Bool
-    sameHeaderName (Header n1 _) (Header n2 _) = T.toLower (decodeUtf8 n1) == T.toLower (decodeUtf8 n2)
+    sameHeaderName (Header n1 _) (Header n2 _) = n1 == n2
     sameHeaderName _ _ = False
 
     replaceIndividualHeader :: [Header] -> [Header]
diff --git a/yesod-core/Yesod/Core/Internal/Response.hs b/yesod-core/Yesod/Core/Internal/Response.hs
index 7e2be331..abf0cdfa 100644
--- a/yesod-core/Yesod/Core/Internal/Response.hs
+++ b/yesod-core/Yesod/Core/Internal/Response.hs
@@ -8,7 +8,6 @@ import qualified Data.ByteString              as S
 import qualified Data.ByteString.Char8        as S8
 import qualified Data.ByteString.Lazy         as BL
 import           Data.CaseInsensitive         (CI)
-import qualified Data.CaseInsensitive         as CI
 import           Network.Wai
 import           Control.Monad                (mplus)
 import           Control.Monad.Trans.Resource (runInternalState, InternalState)
@@ -92,7 +91,7 @@ headerToPair (DeleteCookie key path) =
         , "; expires=Thu, 01-Jan-1970 00:00:00 GMT"
         ]
     )
-headerToPair (Header key value) = (CI.mk key, value)
+headerToPair (Header key value) = (key, value)
 
 evaluateContent :: Content -> IO (Either ErrorResponse Content)
 evaluateContent (ContentBuilder b mlen) = handle f $ do
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index 78ec0fef..191ea460 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -24,6 +24,7 @@ import           Control.Monad.Logger               (LogLevel, LogSource,
 import           Control.Monad.Trans.Resource       (MonadResource (..), InternalState, runInternalState, MonadThrow (..), throwM, ResourceT)
 import           Data.ByteString                    (ByteString)
 import qualified Data.ByteString.Lazy               as L
+import           Data.CaseInsensitive               (CI)
 import           Data.Conduit                       (Flush, ConduitT)
 import           Data.IORef                         (IORef, modifyIORef')
 import           Data.Map                           (Map, unionWith)

From a210ce59d764d7190badaf0145cc3a2be6e6a484 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 15 Jan 2018 17:08:55 +0200
Subject: [PATCH 23/43] Get it all compiling again

---
 yesod-auth-oauth/Yesod/Auth/OAuth.hs    |   3 +-
 yesod-auth-oauth/yesod-auth-oauth.cabal |   1 +
 yesod-bin/Build.hs                      | 269 ------------------------
 yesod-bin/ChangeLog.md                  |   1 +
 yesod-bin/Devel.hs                      |   4 +-
 yesod-bin/main.hs                       |  65 ++----
 yesod-bin/yesod-bin.cabal               |   5 +-
 yesod-test/Yesod/Test.hs                |  83 +++++---
 yesod-test/test/main.hs                 |   2 +-
 yesod-test/yesod-test.cabal             |   1 +
 10 files changed, 79 insertions(+), 355 deletions(-)
 delete mode 100644 yesod-bin/Build.hs

diff --git a/yesod-auth-oauth/Yesod/Auth/OAuth.hs b/yesod-auth-oauth/Yesod/Auth/OAuth.hs
index 9a5d3a0e..8efefe3c 100644
--- a/yesod-auth-oauth/Yesod/Auth/OAuth.hs
+++ b/yesod-auth-oauth/Yesod/Auth/OAuth.hs
@@ -12,7 +12,7 @@ module Yesod.Auth.OAuth
     ) where
 import           Control.Applicative      as A ((<$>), (<*>))
 import           Control.Arrow            ((***))
-import           Control.Exception.Lifted
+import           UnliftIO.Exception
 import           Control.Monad.IO.Class
 import           Data.ByteString          (ByteString)
 import           Data.Maybe
@@ -20,7 +20,6 @@ import           Data.Text                (Text)
 import qualified Data.Text                as T
 import           Data.Text.Encoding       (decodeUtf8With, encodeUtf8)
 import           Data.Text.Encoding.Error (lenientDecode)
-import           Data.Typeable
 import           Web.Authenticate.OAuth
 import           Yesod.Auth
 import           Yesod.Form
diff --git a/yesod-auth-oauth/yesod-auth-oauth.cabal b/yesod-auth-oauth/yesod-auth-oauth.cabal
index 3176f6bd..38f6d047 100644
--- a/yesod-auth-oauth/yesod-auth-oauth.cabal
+++ b/yesod-auth-oauth/yesod-auth-oauth.cabal
@@ -28,6 +28,7 @@ library
                    , text                    >= 0.7
                    , yesod-form              >= 1.6       && < 1.7
                    , transformers            >= 0.2.2     && < 0.6
+                   , unliftio
     exposed-modules: Yesod.Auth.OAuth
     ghc-options:     -Wall
 
diff --git a/yesod-bin/Build.hs b/yesod-bin/Build.hs
deleted file mode 100644
index aca37e74..00000000
--- a/yesod-bin/Build.hs
+++ /dev/null
@@ -1,269 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleContexts #-}
-module Build
-    ( getDeps
-    , touchDeps
-    , touch
-    , recompDeps
-    , isNewerThan
-    , safeReadFile
-    ) where
-
-import           Control.Applicative as App ((<|>), many, (<$>))
-import qualified Data.Attoparsec.Text as A
-import           Data.Char (isSpace, isUpper)
-import qualified Data.Text as T
-import           Data.Text.Encoding (decodeUtf8With)
-import           Data.Text.Encoding.Error (lenientDecode)
-import           Data.ByteString (ByteString)
-import qualified Data.ByteString as S
-
-import           UnliftIO (SomeException, try, IOException, handle)
-import           Control.Monad (when, filterM, forM, forM_, (>=>))
-import           Control.Monad.Trans.State (StateT, get, put, execStateT)
-import           Control.Monad.Trans.Writer (WriterT, tell, execWriterT)
-import           Control.Monad.IO.Class (MonadIO, liftIO)
-import           Control.Monad.Trans.Class (lift)
-
-import           Data.Monoid (Monoid (..))
-import qualified Data.Map as Map
-import qualified Data.Set as Set
-
-import qualified System.Posix.Types
-import           System.Directory
-import           System.FilePath (takeExtension, replaceExtension, (</>), takeDirectory,
-                                    splitPath, joinPath)
-import           System.PosixCompat.Files (getFileStatus, setFileTimes,
-                                             accessTime, modificationTime)
-
-import           Text.Shakespeare (Deref)
-import           Text.Julius      (juliusUsedIdentifiers)
-import           Text.Cassius     (cassiusUsedIdentifiers)
-import           Text.Lucius      (luciusUsedIdentifiers)
-
-safeReadFile :: MonadIO m => FilePath -> m (Either IOException ByteString)
-safeReadFile = liftIO . try . S.readFile
-
-touch :: IO ()
-touch = do
-    m <- handle (\(_ :: SomeException) -> return Map.empty) $ readFile touchCache >>= readIO
-    x <- fmap snd (getDeps [])
-    m' <- execStateT (execWriterT $ touchDeps id updateFileTime x) m
-    createDirectoryIfMissing True $ takeDirectory touchCache
-    writeFile touchCache $ show m'
-  where
-    touchCache = "dist/touchCache.txt"
-
--- | Returns True if any files were touched, otherwise False
-recompDeps :: [FilePath] -> StateT (Map.Map FilePath (Set.Set Deref)) IO Bool
-recompDeps =
-    fmap toBool . execWriterT . (liftIO . getDeps >=> touchDeps hiFile removeHi . snd)
-  where
-    toBool NoFilesTouched = False
-    toBool SomeFilesTouched = True
-
-type Deps = Map.Map FilePath ([FilePath], ComparisonType)
-
-getDeps :: [FilePath] -> IO ([FilePath], Deps)
-getDeps hsSourceDirs = do
-    let defSrcDirs = case hsSourceDirs of
-                        [] -> ["."]
-                        ds -> ds
-    hss <- fmap concat $ mapM findHaskellFiles defSrcDirs
-    deps' <- mapM determineDeps hss
-    return $ (hss, fixDeps $ zip hss deps')
-
-data AnyFilesTouched = NoFilesTouched | SomeFilesTouched
-instance Data.Monoid.Monoid AnyFilesTouched where
-    mempty = NoFilesTouched
-    mappend NoFilesTouched NoFilesTouched = mempty
-    mappend _ _ = SomeFilesTouched
-
-touchDeps :: (FilePath -> FilePath) ->
-             (FilePath -> FilePath -> IO ()) ->
-             Deps -> WriterT AnyFilesTouched (StateT (Map.Map FilePath (Set.Set Deref)) IO) ()
-touchDeps f action deps = (mapM_ go . Map.toList) deps
-  where
-    go (x, (ys, ct)) = do
-        isChanged <- handle (\(_ :: SomeException) -> return True) $ lift $
-            case ct of
-                AlwaysOutdated -> return True
-                CompareUsedIdentifiers getDerefs -> do
-                    derefMap <- get
-                    ebs <- safeReadFile x
-                    let newDerefs =
-                            case ebs of
-                                Left _ -> Set.empty
-                                Right bs -> Set.fromList $ getDerefs $ T.unpack $ decodeUtf8With lenientDecode bs
-                    put $ Map.insert x newDerefs derefMap
-                    case Map.lookup x derefMap of
-                        Just oldDerefs | oldDerefs == newDerefs -> return False
-                        _ -> return True
-        when isChanged $ forM_ ys $ \y -> do
-            n <- liftIO $ x `isNewerThan` f y
-            when n $ do
-                liftIO $ putStrLn ("Forcing recompile for " ++ y ++ " because of " ++ x)
-                liftIO $ action x y
-                tell SomeFilesTouched
-
--- | remove the .hi files for a .hs file, thereby forcing a recompile
-removeHi :: FilePath -> FilePath -> IO ()
-removeHi _ hs = mapM_ removeFile' hiFiles
-    where
-      removeFile' file = try' (removeFile file) >> return ()
-      hiFiles          = map (\e -> "dist/build" </> removeSrc (replaceExtension hs e))
-                             ["hi", "p_hi"]
-
--- | change file mtime of .hs file to that of the dependency
-updateFileTime :: FilePath -> FilePath -> IO ()
-updateFileTime x hs = do
-  (_     , modx) <- getFileStatus' x
-  (access, _   ) <- getFileStatus' hs
-  _ <- try' (setFileTimes hs access modx)
-  return ()
-
-hiFile :: FilePath -> FilePath
-hiFile hs = "dist/build" </> removeSrc (replaceExtension hs "hi")
-
-removeSrc :: FilePath -> FilePath
-removeSrc f = case splitPath f of
-    ("src/" : xs) -> joinPath xs
-    _ -> f
-
-try' :: IO x -> IO (Either SomeException x)
-try' = try
-
-isNewerThan :: FilePath -> FilePath -> IO Bool
-isNewerThan f1 f2 = do
-  (_, mod1) <- getFileStatus' f1
-  (_, mod2) <- getFileStatus' f2
-  return (mod1 > mod2)
-
-getFileStatus' :: FilePath ->
-                  IO (System.Posix.Types.EpochTime, System.Posix.Types.EpochTime)
-getFileStatus' fp = do
-    efs <- try' $ getFileStatus fp
-    case efs of
-        Left _ -> return (0, 0)
-        Right fs -> return (accessTime fs, modificationTime fs)
-
-fixDeps :: [(FilePath, [(ComparisonType, FilePath)])] -> Deps
-fixDeps =
-    Map.unionsWith combine . map go
-  where
-    go :: (FilePath, [(ComparisonType, FilePath)]) -> Deps
-    go (x, ys) = Map.fromList $ map (\(ct, y) -> (y, ([x], ct))) ys
-
-    combine (ys1, ct) (ys2, _) = (ys1 `mappend` ys2, ct)
-
-findHaskellFiles :: FilePath -> IO [FilePath]
-findHaskellFiles path = do
-    contents <- getDirectoryContents path
-    fmap concat $ mapM go contents
-  where
-    go ('.':_)          = return []
-    go filename = do
-        d <- doesDirectoryExist full
-        if not d
-          then if isHaskellFile
-                  then return [full]
-                  else return []
-          else if isHaskellDir
-                 then findHaskellFiles full
-                 else return []
-      where
-        -- this could fail on unicode
-        isHaskellDir  = isUpper (head filename)
-        isHaskellFile = takeExtension filename `elem` watch_files
-        full = path </> filename
-        watch_files = [".hs", ".lhs"]
-
-data TempType = StaticFiles FilePath
-              | Verbatim | Messages FilePath | Hamlet | Widget | Julius | Cassius | Lucius
-    deriving Show
-
--- | How to tell if a file is outdated.
-data ComparisonType = AlwaysOutdated
-                    | CompareUsedIdentifiers (String -> [Deref])
-
-determineDeps :: FilePath -> IO [(ComparisonType, FilePath)]
-determineDeps x = do
-    y <- safeReadFile x
-    case y of
-        Left _ -> return []
-        Right bs -> do
-            let z = A.parseOnly (many $ (parser <|> (A.anyChar >> return Nothing)))
-                  $ decodeUtf8With lenientDecode bs
-            case z of
-                Left _ -> return []
-                Right r -> mapM go r >>= filterM (doesFileExist . snd) . concat
-  where
-    go (Just (StaticFiles fp, _)) = map ((,) AlwaysOutdated) App.<$> getFolderContents fp
-    go (Just (Hamlet, f)) = return [(AlwaysOutdated, f)]
-    go (Just (Widget, f)) = return
-        [ (AlwaysOutdated, "templates/" ++ f ++ ".hamlet")
-        , (CompareUsedIdentifiers $ map fst . juliusUsedIdentifiers, "templates/" ++ f ++ ".julius")
-        , (CompareUsedIdentifiers $ map fst . luciusUsedIdentifiers, "templates/" ++ f ++ ".lucius")
-        , (CompareUsedIdentifiers $ map fst . cassiusUsedIdentifiers, "templates/" ++ f ++ ".cassius")
-        ]
-    go (Just (Julius, f)) = return [(CompareUsedIdentifiers $ map fst . juliusUsedIdentifiers, f)]
-    go (Just (Cassius, f)) = return [(CompareUsedIdentifiers $ map fst . cassiusUsedIdentifiers, f)]
-    go (Just (Lucius, f)) = return [(CompareUsedIdentifiers $ map fst . luciusUsedIdentifiers, f)]
-    go (Just (Verbatim, f)) = return [(AlwaysOutdated, f)]
-    go (Just (Messages f, _)) = map ((,) AlwaysOutdated) <$> getFolderContents f
-    go Nothing = return []
-
-    parser = do
-        ty <- (do _ <- A.string "\nstaticFiles \""
-                  x' <- A.many1 $ A.satisfy (/= '"')
-                  return $ StaticFiles x')
-           <|> (A.string "$(parseRoutesFile " >> return Verbatim)
-           <|> (A.string "$(hamletFile " >> return Hamlet)
-           <|> (A.string "$(ihamletFile " >> return Hamlet)
-           <|> (A.string "$(whamletFile " >> return Hamlet)
-           <|> (A.string "$(html " >> return Hamlet)
-           <|> (A.string "$(widgetFile " >> return Widget)
-           <|> (A.string "$(Settings.hamletFile " >> return Hamlet)
-           <|> (A.string "$(Settings.widgetFile " >> return Widget)
-           <|> (A.string "$(juliusFile " >> return Julius)
-           <|> (A.string "$(cassiusFile " >> return Cassius)
-           <|> (A.string "$(luciusFile " >> return Lucius)
-           <|> (A.string "$(persistFile " >> return Verbatim)
-           <|> (
-                   A.string "$(persistFileWith " >>
-                   A.many1 (A.satisfy (/= '"')) >>
-                   return Verbatim)
-           <|> (do
-                    _ <- A.string "\nmkMessage \""
-                    A.skipWhile (/= '"')
-                    _ <- A.string "\" \""
-                    x' <- A.many1 $ A.satisfy (/= '"')
-                    _ <- A.string "\" \""
-                    _y <- A.many1 $ A.satisfy (/= '"')
-                    _ <- A.string "\""
-                    return $ Messages x')
-        case ty of
-            Messages{} -> return $ Just (ty, "")
-            StaticFiles{} -> return $ Just (ty, "")
-            _ -> do
-                A.skipWhile isSpace
-                _ <- A.char '"'
-                y <- A.many1 $ A.satisfy (/= '"')
-                _ <- A.char '"'
-                A.skipWhile isSpace
-                _ <- A.char ')'
-                return $ Just (ty, y)
-
-    getFolderContents :: FilePath -> IO [FilePath]
-    getFolderContents fp = do
-        cs <- getDirectoryContents fp
-        let notHidden ('.':_) = False
-            notHidden ('t':"mp") = False
-            notHidden ('f':"ay") = False
-            notHidden _ = True
-        fmap concat $ forM (filter notHidden cs) $ \c -> do
-            let f = fp ++ '/' : c
-            isFile <- doesFileExist f
-            if isFile then return [f] else getFolderContents f
diff --git a/yesod-bin/ChangeLog.md b/yesod-bin/ChangeLog.md
index f82a8fbd..04daaf82 100644
--- a/yesod-bin/ChangeLog.md
+++ b/yesod-bin/ChangeLog.md
@@ -1,6 +1,7 @@
 ## 1.6.0
 
 * Upgrade to conduit 1.3.0
+* Remove configure, build, touch, and test commands
 
 ## 1.5.3
 
diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs
index c60b17d6..4daa9cca 100644
--- a/yesod-bin/Devel.hs
+++ b/yesod-bin/Devel.hs
@@ -9,10 +9,10 @@ module Devel
     ) where
 
 import           Control.Applicative                   ((<|>))
+import           UnliftIO                              (race_)
 import           Control.Concurrent                    (threadDelay)
-import           Control.Concurrent.Async              (race_)
 import           Control.Concurrent.STM
-import qualified Control.Exception.Safe                as Ex
+import qualified UnliftIO.Exception                    as Ex
 import           Control.Monad                         (forever, unless, void,
                                                         when)
 import Data.ByteString (ByteString, isInfixOf)
diff --git a/yesod-bin/main.hs b/yesod-bin/main.hs
index 566f8cf9..3f3a071b 100755
--- a/yesod-bin/main.hs
+++ b/yesod-bin/main.hs
@@ -2,37 +2,18 @@
 {-# LANGUAGE RecordWildCards             #-}
 module Main (main) where
 
-import           Control.Monad          (unless)
 import           Data.Monoid
 import           Data.Version           (showVersion)
 import           Options.Applicative
-import           System.Environment     (getEnvironment)
-import           System.Exit            (ExitCode (ExitSuccess), exitWith, exitFailure)
-import           System.Process         (rawSystem)
+import           System.Exit            (exitFailure)
 
 import           AddHandler             (addHandler)
 import           Devel                  (DevelOpts (..), devel, develSignal)
 import           Keter                  (keter)
 import           Options                (injectDefaults)
 import qualified Paths_yesod_bin
-import           System.IO              (hPutStrLn, stderr)
 
 import           HsFile                 (mkHsFile)
-#ifndef WINDOWS
-import           Build                  (touch)
-
-touch' :: IO ()
-touch' = touch
-
-windowsWarning :: String
-windowsWarning = ""
-#else
-touch' :: IO ()
-touch'  = return ()
-
-windowsWarning :: String
-windowsWarning = " (does not work on Windows)"
-#endif
 
 data CabalPgm = Cabal | CabalDev deriving (Show, Eq)
 
@@ -91,17 +72,16 @@ main = do
                     c -> c
                 })
          ] optParser'
-  let cabal = rawSystem' (cabalCommand o)
   case optCommand o of
     Init _          -> initErrorMsg
     HsFiles         -> mkHsFile
-    Configure       -> cabal ["configure"]
-    Build es        -> touch' >> cabal ("build":es)
-    Touch           -> touch'
+    Configure       -> cabalErrorMsg
+    Build _         -> cabalErrorMsg
+    Touch           -> cabalErrorMsg
     Keter{..}       -> keter (cabalCommand o) _keterNoRebuild _keterNoCopyTo _keterBuildArgs
     Version         -> putStrLn ("yesod-bin version: " ++ showVersion Paths_yesod_bin.version)
     AddHandler{..}  -> addHandler addHandlerRoute addHandlerPattern addHandlerMethods
-    Test            -> cabalTest cabal
+    Test            -> cabalErrorMsg
     Devel{..}       -> devel DevelOpts
                              { verbose      = optVerbose o
                              , successHook  = develSuccessHook
@@ -113,19 +93,6 @@ main = do
                              } develExtraArgs
     DevelSignal     -> develSignal
   where
-    cabalTest cabal = do
-        env <- getEnvironment
-        case lookup "STACK_EXE" env of
-            Nothing -> do
-                touch'
-                _ <- cabal ["configure", "--enable-tests", "-flibrary-only"]
-                _ <- cabal ["build"]
-                cabal ["test"]
-            Just _ -> do
-                hPutStrLn stderr "'yesod test' is no longer needed with Stack"
-                hPutStrLn stderr "Instead, please just run 'stack test'"
-                exitFailure
-
     initErrorMsg = do
         mapM_ putStrLn
             [ "The init command has been removed."
@@ -136,6 +103,13 @@ main = do
             ]
         exitFailure
 
+    cabalErrorMsg = do
+        mapM_ putStrLn
+            [ "The configure, build, touch, and test commands have been removed."
+            , "Please use 'stack' for building your project."
+            ]
+        exitFailure
+
 optParser' :: ParserInfo Options
 optParser' = info (helper <*> optParser) ( fullDesc <> header "Yesod Web Framework command line utility" )
 
@@ -148,17 +122,17 @@ optParser = Options
                       <> command "hsfiles" (info (pure HsFiles)
                             (progDesc "Create a hsfiles file for the current folder"))
                       <> command "configure" (info (pure Configure)
-                            (progDesc "Configure a project for building"))
+                            (progDesc "DEPRECATED"))
                       <> command "build"     (info (helper <*> (Build <$> extraCabalArgs))
-                            (progDesc $ "Build project (performs TH dependency analysis)" ++ windowsWarning))
+                            (progDesc "DEPRECATED"))
                       <> command "touch"     (info (pure Touch)
-                            (progDesc $ "Touch any files with altered TH dependencies but do not build" ++ windowsWarning))
+                            (progDesc "DEPRECATED"))
                       <> command "devel"     (info (helper <*> develOptions)
                             (progDesc "Run project with the devel server"))
                       <> command "devel-signal"     (info (helper <*> pure DevelSignal)
                             (progDesc "Used internally by the devel command"))
                       <> command "test"      (info (pure Test)
-                            (progDesc "Build and run the integration tests"))
+                            (progDesc "DEPRECATED"))
                       <> command "add-handler" (info (helper <*> addHandlerOptions)
                             (progDesc ("Add a new handler and module to the project."
                             ++ " Interactively asks for input if you do not specify arguments.")))
@@ -217,10 +191,3 @@ addHandlerOptions = AddHandler
 -- | Optional @String@ argument
 optStr :: Mod OptionFields (Maybe String) -> Parser (Maybe String)
 optStr m = option (Just <$> str) $ value Nothing <> m
-
--- | Like @rawSystem@, but exits if it receives a non-success result.
-rawSystem' :: String -> [String] -> IO ()
-rawSystem' x y = do
-    res <- rawSystem x y
-    unless (res == ExitSuccess) $ exitWith res
-
diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal
index df153e75..f1333a39 100644
--- a/yesod-bin/yesod-bin.cabal
+++ b/yesod-bin/yesod-bin.cabal
@@ -57,7 +57,6 @@ executable             yesod
                      , http-client-tls
                      , http-client        >= 0.4.7
                      , project-template   >= 0.1.1
-                     , safe-exceptions
                      , say
                      , stm
                      , transformers
@@ -68,13 +67,11 @@ executable             yesod
                      , data-default-class
                      , streaming-commons
                      , warp-tls           >= 3.0.1
-                     , async
-                     , deepseq
+                     , unliftio
 
     ghc-options:       -Wall -threaded -rtsopts
     main-is:           main.hs
     other-modules:     Devel
-                       Build
                        Keter
                        AddHandler
                        Paths_yesod_bin
diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs
index 307619cc..b15dab4b 100644
--- a/yesod-test/Yesod/Test.hs
+++ b/yesod-test/Yesod/Test.hs
@@ -135,7 +135,8 @@ import qualified Network.Socket.Internal as Sock
 import Data.CaseInsensitive (CI)
 import Network.Wai
 import Network.Wai.Test hiding (assertHeader, assertNoHeader, request)
-import qualified Control.Monad.Trans.State as ST
+import Control.Monad.Trans.Reader
+import Data.IORef
 import Control.Monad.IO.Class
 import System.IO
 import Yesod.Core.Unsafe (runFakeHandler)
@@ -180,7 +181,7 @@ data YesodExampleData site = YesodExampleData
 -- | A single test case, to be run with 'yit'.
 --
 -- Since 1.2.0
-type YesodExample site = ST.StateT (YesodExampleData site) IO
+type YesodExample site = ReaderT (IORef (YesodExampleData site)) IO
 
 -- | Mapping from cookie name to value.
 --
@@ -203,13 +204,13 @@ data YesodSpecTree site
 --
 -- Since 1.2.0
 getTestYesod :: YesodExample site site
-getTestYesod = fmap yedSite ST.get
+getTestYesod = fmap yedSite rsget
 
 -- | Get the most recently provided response value, if available.
 --
 -- Since 1.2.0
 getResponse :: YesodExample site (Maybe SResponse)
-getResponse = fmap yedResponse ST.get
+getResponse = fmap yedResponse rsget
 
 data RequestBuilderData site = RequestBuilderData
     { rbdPostData :: RBDPostData
@@ -232,7 +233,7 @@ data RequestPart
 -- | The 'RequestBuilder' state monad constructs a URL encoded string of arguments
 -- to send with your requests. Some of the functions that run on it use the current
 -- response to analyze the forms that the server is expecting to receive.
-type RequestBuilder site = ST.StateT (RequestBuilderData site) IO
+type RequestBuilder site = ReaderT (IORef (RequestBuilderData site)) IO
 
 -- | Start describing a Tests suite keeping cookies and a reference to the tested 'Application'
 -- and 'ConnectionPool'
@@ -249,7 +250,7 @@ yesodSpec site yspecs =
     unYesod (YesodSpecGroup x y) = Hspec.specGroup x $ map unYesod y
     unYesod (YesodSpecItem x y) = Hspec.specItem x $ do
         app <- toWaiAppPlain site
-        ST.evalStateT y YesodExampleData
+        rsevalStateT y YesodExampleData
             { yedApp = app
             , yedSite = site
             , yedCookies = M.empty
@@ -269,7 +270,7 @@ yesodSpecWithSiteGenerator getSiteAction yspecs =
       unYesod getSiteAction' (YesodSpecItem x y) = Hspec.specItem x $ do
         site <- getSiteAction'
         app <- toWaiAppPlain site
-        ST.evalStateT y YesodExampleData
+        rsevalStateT y YesodExampleData
             { yedApp = app
             , yedSite = site
             , yedCookies = M.empty
@@ -290,7 +291,7 @@ yesodSpecApp site getApp yspecs =
     unYesod (YesodSpecGroup x y) = Hspec.specGroup x $ map unYesod y
     unYesod (YesodSpecItem x y) = Hspec.specItem x $ do
         app <- getApp
-        ST.evalStateT y YesodExampleData
+        rsevalStateT y YesodExampleData
             { yedApp = app
             , yedSite = site
             , yedCookies = M.empty
@@ -306,9 +307,9 @@ yit label example = tell [YesodSpecItem label example]
 withResponse' :: MonadIO m
               => (state -> Maybe SResponse)
               -> [T.Text]
-              -> (SResponse -> ST.StateT state m a)
-              -> ST.StateT state m a
-withResponse' getter errTrace f = maybe err f . getter =<< ST.get
+              -> (SResponse -> ReaderT (IORef state) m a)
+              -> ReaderT (IORef state) m a
+withResponse' getter errTrace f = maybe err f . getter =<< rsget
  where err = failure msg
        msg = if null errTrace
              then "There was no response, you should make a request."
@@ -331,7 +332,7 @@ htmlQuery' :: MonadIO m
            => (state -> Maybe SResponse)
            -> [T.Text]
            -> Query
-           -> ST.StateT state m [HtmlLBS]
+           -> ReaderT (IORef state) m [HtmlLBS]
 htmlQuery' getter errTrace query = withResponse' getter ("Tried to invoke htmlQuery' in order to read HTML of a previous response." : errTrace) $ \ res ->
   case findBySelector (simpleBody res) query of
     Left err -> failure $ query <> " did not parse: " <> T.pack (show err)
@@ -496,14 +497,14 @@ printMatches query = do
 -- | Add a parameter with the given name and value to the request body.
 addPostParam :: T.Text -> T.Text -> RequestBuilder site ()
 addPostParam name value =
-  ST.modify $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd)) }
+  rsmodify $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd)) }
   where addPostData (BinaryPostData _) = error "Trying to add post param to binary content."
         addPostData (MultipleItemsPostData posts) =
           MultipleItemsPostData $ ReqKvPart name value : posts
 
 -- | Add a parameter with the given name and value to the query string.
 addGetParam :: T.Text -> T.Text -> RequestBuilder site ()
-addGetParam name value = ST.modify $ \rbd -> rbd
+addGetParam name value = rsmodify $ \rbd -> rbd
     { rbdGets = (TE.encodeUtf8 name, Just $ TE.encodeUtf8 value)
               : rbdGets rbd
     }
@@ -522,7 +523,7 @@ addFile :: T.Text -- ^ The parameter name for the file.
         -> RequestBuilder site ()
 addFile name path mimetype = do
   contents <- liftIO $ BSL8.readFile path
-  ST.modify $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd) contents) }
+  rsmodify $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd) contents) }
     where addPostData (BinaryPostData _) _ = error "Trying to add file after setting binary content."
           addPostData (MultipleItemsPostData posts) contents =
             MultipleItemsPostData $ ReqFilePart name path contents mimetype : posts
@@ -531,7 +532,7 @@ addFile name path mimetype = do
 -- This looks up the name of a field based on the contents of the label pointing to it.
 genericNameFromLabel :: (T.Text -> T.Text -> Bool) -> T.Text -> RequestBuilder site T.Text
 genericNameFromLabel match label = do
-  mres <- fmap rbdResponse ST.get
+  mres <- fmap rbdResponse rsget
   res <-
     case mres of
       Nothing -> failure "genericNameFromLabel: No response available"
@@ -798,7 +799,7 @@ addTokenFromCookieNamedToHeaderNamed cookieName headerName = do
 -- Since 1.4.3.2
 getRequestCookies :: RequestBuilder site Cookies
 getRequestCookies = do
-  requestBuilderData <- ST.get
+  requestBuilderData <- rsget
   headers <- case simpleHeaders Control.Applicative.<$> rbdResponse requestBuilderData of
                   Just h -> return h
                   Nothing -> failure "getRequestCookies: No request has been made yet; the cookies can't be looked up."
@@ -906,7 +907,7 @@ getLocation = do
 -- > request $ do
 -- >   setMethod methodPut
 setMethod :: H.Method -> RequestBuilder site ()
-setMethod m = ST.modify $ \rbd -> rbd { rbdMethod = m }
+setMethod m = rsmodify $ \rbd -> rbd { rbdMethod = m }
 
 -- | Sets the URL used by the request.
 --
@@ -921,7 +922,7 @@ setUrl :: (Yesod site, RedirectUrl site url)
        => url
        -> RequestBuilder site ()
 setUrl url' = do
-    site <- fmap rbdSite ST.get
+    site <- fmap rbdSite rsget
     eurl <- Yesod.Core.Unsafe.runFakeHandler
         M.empty
         (const $ error "Yesod.Test: No logger available")
@@ -929,7 +930,7 @@ setUrl url' = do
         (toTextUrl url')
     url <- either (error . show) return eurl
     let (urlPath, urlQuery) = T.break (== '?') url
-    ST.modify $ \rbd -> rbd
+    rsmodify $ \rbd -> rbd
         { rbdPath =
             case DL.filter (/="") $ H.decodePathSegments $ TE.encodeUtf8 urlPath of
                 ("http:":_:rest) -> rest
@@ -968,7 +969,7 @@ clickOn query = do
 -- > request $ do
 -- >   setRequestBody $ encode $ object ["age" .= (1 :: Integer)]
 setRequestBody :: BSL8.ByteString -> RequestBuilder site ()
-setRequestBody body = ST.modify $ \rbd -> rbd { rbdPostData = BinaryPostData body }
+setRequestBody body = rsmodify $ \rbd -> rbd { rbdPostData = BinaryPostData body }
 
 -- | Adds the given header to the request; see "Network.HTTP.Types.Header" for creating 'Header's.
 --
@@ -978,7 +979,7 @@ setRequestBody body = ST.modify $ \rbd -> rbd { rbdPostData = BinaryPostData bod
 -- > request $ do
 -- >   addRequestHeader (hUserAgent, "Chrome/41.0.2228.0")
 addRequestHeader :: H.Header -> RequestBuilder site ()
-addRequestHeader header = ST.modify $ \rbd -> rbd
+addRequestHeader header = rsmodify $ \rbd -> rbd
     { rbdHeaders = header : rbdHeaders rbd
     }
 
@@ -998,9 +999,9 @@ addRequestHeader header = ST.modify $ \rbd -> rbd
 request :: RequestBuilder site ()
         -> YesodExample site ()
 request reqBuilder = do
-    YesodExampleData app site oldCookies mRes <- ST.get
+    YesodExampleData app site oldCookies mRes <- rsget
 
-    RequestBuilderData {..} <- liftIO $ ST.execStateT reqBuilder RequestBuilderData
+    RequestBuilderData {..} <- liftIO $ rsexecStateT reqBuilder RequestBuilderData
       { rbdPostData = MultipleItemsPostData []
       , rbdResponse = mRes
       , rbdMethod = "GET"
@@ -1040,7 +1041,7 @@ request reqBuilder = do
         }) app
     let newCookies = parseSetCookies $ simpleHeaders response
         cookies' = M.fromList [(Cookie.setCookieName c, c) | c <- newCookies] `M.union` cookies
-    ST.put $ YesodExampleData app site cookies' (Just response)
+    rsput $ YesodExampleData app site cookies' (Just response)
   where
     isFile (ReqFilePart _ _ _ _) = True
     isFile _ = False
@@ -1144,14 +1145,14 @@ testApp :: site -> Middleware -> TestApp site
 testApp site middleware = (site, middleware)
 type YSpec site = Hspec.SpecWith (TestApp site)
 
-instance YesodDispatch site => Hspec.Example (ST.StateT (YesodExampleData site) IO a) where
-    type Arg (ST.StateT (YesodExampleData site) IO a) = TestApp site
+instance YesodDispatch site => Hspec.Example (ReaderT (IORef (YesodExampleData site)) IO a) where
+    type Arg (ReaderT (IORef (YesodExampleData site)) IO a) = TestApp site
 
     evaluateExample example params action =
         Hspec.evaluateExample
             (action $ \(site, middleware) -> do
                 app <- toWaiAppPlain site
-                _ <- ST.evalStateT example YesodExampleData
+                _ <- rsevalStateT example YesodExampleData
                     { yedApp = middleware app
                     , yedSite = site
                     , yedCookies = M.empty
@@ -1160,3 +1161,29 @@ instance YesodDispatch site => Hspec.Example (ST.StateT (YesodExampleData site)
                 return ())
             params
             ($ ())
+
+rsget :: MonadIO m => ReaderT (IORef s) m s
+rsget = ReaderT $ liftIO . readIORef
+
+rsput :: MonadIO m => s -> ReaderT (IORef s) m ()
+rsput s = ReaderT $ \ref -> liftIO $ writeIORef ref $! s
+
+rsmodify :: MonadIO m => (s -> s) -> ReaderT (IORef s) m ()
+rsmodify f = ReaderT $ \ref -> liftIO $ modifyIORef' ref f
+
+rsevalStateT
+  :: MonadIO m
+  => ReaderT (IORef s) m a
+  -> s
+  -> m a
+rsevalStateT (ReaderT f) s = liftIO (newIORef s) >>= f
+
+rsexecStateT
+  :: MonadIO m
+  => ReaderT (IORef s) m ()
+  -> s
+  -> m s
+rsexecStateT (ReaderT f) s = do
+  ref <- liftIO $ newIORef s
+  f ref
+  liftIO $ readIORef ref
diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs
index e6756d7d..a08c102a 100644
--- a/yesod-test/test/main.hs
+++ b/yesod-test/test/main.hs
@@ -37,7 +37,7 @@ import Data.ByteString.Lazy.Char8 ()
 import qualified Data.Map as Map
 import qualified Text.HTML.DOM as HD
 import Network.HTTP.Types.Status (status301, status303, unsupportedMediaType415)
-import Control.Exception.Lifted(SomeException, try)
+import UnliftIO.Exception (SomeException, try)
 
 parseQuery_ :: Text -> [[SelectorGroup]]
 parseQuery_ = either error id . parseQuery
diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal
index 6585217c..3c930575 100644
--- a/yesod-test/yesod-test.cabal
+++ b/yesod-test/yesod-test.cabal
@@ -61,6 +61,7 @@ test-suite test
                           , text
                           , wai
                           , http-types
+                          , unliftio
 
 source-repository head
   type: git

From dff7f2372e74a00901b554eacd5f8aa1024ff3eb Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 15 Jan 2018 17:38:36 +0200
Subject: [PATCH 24/43] Switch to SIO

---
 yesod-test/Yesod/Test.hs | 102 +++++++++++++++++++--------------------
 1 file changed, 50 insertions(+), 52 deletions(-)

diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs
index b15dab4b..73ec49e6 100644
--- a/yesod-test/Yesod/Test.hs
+++ b/yesod-test/Yesod/Test.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ImplicitParams #-}
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 {-|
 Yesod.Test is a pragmatic framework for testing web applications built
@@ -63,6 +64,7 @@ module Yesod.Test
     , addFile
     , setRequestBody
     , RequestBuilder
+    , SIO
     , setUrl
     , clickOn
 
@@ -135,7 +137,7 @@ import qualified Network.Socket.Internal as Sock
 import Data.CaseInsensitive (CI)
 import Network.Wai
 import Network.Wai.Test hiding (assertHeader, assertNoHeader, request)
-import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Reader (ReaderT (..))
 import Data.IORef
 import Control.Monad.IO.Class
 import System.IO
@@ -181,7 +183,7 @@ data YesodExampleData site = YesodExampleData
 -- | A single test case, to be run with 'yit'.
 --
 -- Since 1.2.0
-type YesodExample site = ReaderT (IORef (YesodExampleData site)) IO
+type YesodExample site = SIO (YesodExampleData site)
 
 -- | Mapping from cookie name to value.
 --
@@ -204,13 +206,13 @@ data YesodSpecTree site
 --
 -- Since 1.2.0
 getTestYesod :: YesodExample site site
-getTestYesod = fmap yedSite rsget
+getTestYesod = fmap yedSite getSIO
 
 -- | Get the most recently provided response value, if available.
 --
 -- Since 1.2.0
 getResponse :: YesodExample site (Maybe SResponse)
-getResponse = fmap yedResponse rsget
+getResponse = fmap yedResponse getSIO
 
 data RequestBuilderData site = RequestBuilderData
     { rbdPostData :: RBDPostData
@@ -233,7 +235,7 @@ data RequestPart
 -- | The 'RequestBuilder' state monad constructs a URL encoded string of arguments
 -- to send with your requests. Some of the functions that run on it use the current
 -- response to analyze the forms that the server is expecting to receive.
-type RequestBuilder site = ReaderT (IORef (RequestBuilderData site)) IO
+type RequestBuilder site = SIO (RequestBuilderData site)
 
 -- | Start describing a Tests suite keeping cookies and a reference to the tested 'Application'
 -- and 'ConnectionPool'
@@ -250,7 +252,7 @@ yesodSpec site yspecs =
     unYesod (YesodSpecGroup x y) = Hspec.specGroup x $ map unYesod y
     unYesod (YesodSpecItem x y) = Hspec.specItem x $ do
         app <- toWaiAppPlain site
-        rsevalStateT y YesodExampleData
+        evalSIO y YesodExampleData
             { yedApp = app
             , yedSite = site
             , yedCookies = M.empty
@@ -270,7 +272,7 @@ yesodSpecWithSiteGenerator getSiteAction yspecs =
       unYesod getSiteAction' (YesodSpecItem x y) = Hspec.specItem x $ do
         site <- getSiteAction'
         app <- toWaiAppPlain site
-        rsevalStateT y YesodExampleData
+        evalSIO y YesodExampleData
             { yedApp = app
             , yedSite = site
             , yedCookies = M.empty
@@ -291,7 +293,7 @@ yesodSpecApp site getApp yspecs =
     unYesod (YesodSpecGroup x y) = Hspec.specGroup x $ map unYesod y
     unYesod (YesodSpecItem x y) = Hspec.specItem x $ do
         app <- getApp
-        rsevalStateT y YesodExampleData
+        evalSIO y YesodExampleData
             { yedApp = app
             , yedSite = site
             , yedCookies = M.empty
@@ -304,12 +306,11 @@ yit label example = tell [YesodSpecItem label example]
 
 -- Performs a given action using the last response. Use this to create
 -- response-level assertions
-withResponse' :: MonadIO m
-              => (state -> Maybe SResponse)
+withResponse' :: (state -> Maybe SResponse)
               -> [T.Text]
-              -> (SResponse -> ReaderT (IORef state) m a)
-              -> ReaderT (IORef state) m a
-withResponse' getter errTrace f = maybe err f . getter =<< rsget
+              -> (SResponse -> SIO state a)
+              -> SIO state a
+withResponse' getter errTrace f = maybe err f . getter =<< getSIO
  where err = failure msg
        msg = if null errTrace
              then "There was no response, you should make a request."
@@ -328,11 +329,10 @@ parseHTML :: HtmlLBS -> Cursor
 parseHTML html = fromDocument $ HD.parseLBS html
 
 -- | Query the last response using CSS selectors, returns a list of matched fragments
-htmlQuery' :: MonadIO m
-           => (state -> Maybe SResponse)
+htmlQuery' :: (state -> Maybe SResponse)
            -> [T.Text]
            -> Query
-           -> ReaderT (IORef state) m [HtmlLBS]
+           -> SIO state [HtmlLBS]
 htmlQuery' getter errTrace query = withResponse' getter ("Tried to invoke htmlQuery' in order to read HTML of a previous response." : errTrace) $ \ res ->
   case findBySelector (simpleBody res) query of
     Left err -> failure $ query <> " did not parse: " <> T.pack (show err)
@@ -497,14 +497,14 @@ printMatches query = do
 -- | Add a parameter with the given name and value to the request body.
 addPostParam :: T.Text -> T.Text -> RequestBuilder site ()
 addPostParam name value =
-  rsmodify $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd)) }
+  modifySIO $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd)) }
   where addPostData (BinaryPostData _) = error "Trying to add post param to binary content."
         addPostData (MultipleItemsPostData posts) =
           MultipleItemsPostData $ ReqKvPart name value : posts
 
 -- | Add a parameter with the given name and value to the query string.
 addGetParam :: T.Text -> T.Text -> RequestBuilder site ()
-addGetParam name value = rsmodify $ \rbd -> rbd
+addGetParam name value = modifySIO $ \rbd -> rbd
     { rbdGets = (TE.encodeUtf8 name, Just $ TE.encodeUtf8 value)
               : rbdGets rbd
     }
@@ -523,7 +523,7 @@ addFile :: T.Text -- ^ The parameter name for the file.
         -> RequestBuilder site ()
 addFile name path mimetype = do
   contents <- liftIO $ BSL8.readFile path
-  rsmodify $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd) contents) }
+  modifySIO $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd) contents) }
     where addPostData (BinaryPostData _) _ = error "Trying to add file after setting binary content."
           addPostData (MultipleItemsPostData posts) contents =
             MultipleItemsPostData $ ReqFilePart name path contents mimetype : posts
@@ -532,7 +532,7 @@ addFile name path mimetype = do
 -- This looks up the name of a field based on the contents of the label pointing to it.
 genericNameFromLabel :: (T.Text -> T.Text -> Bool) -> T.Text -> RequestBuilder site T.Text
 genericNameFromLabel match label = do
-  mres <- fmap rbdResponse rsget
+  mres <- fmap rbdResponse getSIO
   res <-
     case mres of
       Nothing -> failure "genericNameFromLabel: No response available"
@@ -799,7 +799,7 @@ addTokenFromCookieNamedToHeaderNamed cookieName headerName = do
 -- Since 1.4.3.2
 getRequestCookies :: RequestBuilder site Cookies
 getRequestCookies = do
-  requestBuilderData <- rsget
+  requestBuilderData <- getSIO
   headers <- case simpleHeaders Control.Applicative.<$> rbdResponse requestBuilderData of
                   Just h -> return h
                   Nothing -> failure "getRequestCookies: No request has been made yet; the cookies can't be looked up."
@@ -907,7 +907,7 @@ getLocation = do
 -- > request $ do
 -- >   setMethod methodPut
 setMethod :: H.Method -> RequestBuilder site ()
-setMethod m = rsmodify $ \rbd -> rbd { rbdMethod = m }
+setMethod m = modifySIO $ \rbd -> rbd { rbdMethod = m }
 
 -- | Sets the URL used by the request.
 --
@@ -922,7 +922,7 @@ setUrl :: (Yesod site, RedirectUrl site url)
        => url
        -> RequestBuilder site ()
 setUrl url' = do
-    site <- fmap rbdSite rsget
+    site <- fmap rbdSite getSIO
     eurl <- Yesod.Core.Unsafe.runFakeHandler
         M.empty
         (const $ error "Yesod.Test: No logger available")
@@ -930,7 +930,7 @@ setUrl url' = do
         (toTextUrl url')
     url <- either (error . show) return eurl
     let (urlPath, urlQuery) = T.break (== '?') url
-    rsmodify $ \rbd -> rbd
+    modifySIO $ \rbd -> rbd
         { rbdPath =
             case DL.filter (/="") $ H.decodePathSegments $ TE.encodeUtf8 urlPath of
                 ("http:":_:rest) -> rest
@@ -969,7 +969,7 @@ clickOn query = do
 -- > request $ do
 -- >   setRequestBody $ encode $ object ["age" .= (1 :: Integer)]
 setRequestBody :: BSL8.ByteString -> RequestBuilder site ()
-setRequestBody body = rsmodify $ \rbd -> rbd { rbdPostData = BinaryPostData body }
+setRequestBody body = modifySIO $ \rbd -> rbd { rbdPostData = BinaryPostData body }
 
 -- | Adds the given header to the request; see "Network.HTTP.Types.Header" for creating 'Header's.
 --
@@ -979,7 +979,7 @@ setRequestBody body = rsmodify $ \rbd -> rbd { rbdPostData = BinaryPostData body
 -- > request $ do
 -- >   addRequestHeader (hUserAgent, "Chrome/41.0.2228.0")
 addRequestHeader :: H.Header -> RequestBuilder site ()
-addRequestHeader header = rsmodify $ \rbd -> rbd
+addRequestHeader header = modifySIO $ \rbd -> rbd
     { rbdHeaders = header : rbdHeaders rbd
     }
 
@@ -999,9 +999,9 @@ addRequestHeader header = rsmodify $ \rbd -> rbd
 request :: RequestBuilder site ()
         -> YesodExample site ()
 request reqBuilder = do
-    YesodExampleData app site oldCookies mRes <- rsget
+    YesodExampleData app site oldCookies mRes <- getSIO
 
-    RequestBuilderData {..} <- liftIO $ rsexecStateT reqBuilder RequestBuilderData
+    RequestBuilderData {..} <- liftIO $ execSIO reqBuilder RequestBuilderData
       { rbdPostData = MultipleItemsPostData []
       , rbdResponse = mRes
       , rbdMethod = "GET"
@@ -1041,7 +1041,7 @@ request reqBuilder = do
         }) app
     let newCookies = parseSetCookies $ simpleHeaders response
         cookies' = M.fromList [(Cookie.setCookieName c, c) | c <- newCookies] `M.union` cookies
-    rsput $ YesodExampleData app site cookies' (Just response)
+    putSIO $ YesodExampleData app site cookies' (Just response)
   where
     isFile (ReqFilePart _ _ _ _) = True
     isFile _ = False
@@ -1145,14 +1145,14 @@ testApp :: site -> Middleware -> TestApp site
 testApp site middleware = (site, middleware)
 type YSpec site = Hspec.SpecWith (TestApp site)
 
-instance YesodDispatch site => Hspec.Example (ReaderT (IORef (YesodExampleData site)) IO a) where
-    type Arg (ReaderT (IORef (YesodExampleData site)) IO a) = TestApp site
+instance YesodDispatch site => Hspec.Example (SIO (YesodExampleData site) a) where
+    type Arg (SIO (YesodExampleData site) a) = TestApp site
 
     evaluateExample example params action =
         Hspec.evaluateExample
             (action $ \(site, middleware) -> do
                 app <- toWaiAppPlain site
-                _ <- rsevalStateT example YesodExampleData
+                _ <- evalSIO example YesodExampleData
                     { yedApp = middleware app
                     , yedSite = site
                     , yedCookies = M.empty
@@ -1162,28 +1162,26 @@ instance YesodDispatch site => Hspec.Example (ReaderT (IORef (YesodExampleData s
             params
             ($ ())
 
-rsget :: MonadIO m => ReaderT (IORef s) m s
-rsget = ReaderT $ liftIO . readIORef
+-- | State + IO
+--
+-- @since 1.6.0
+newtype SIO s a = SIO (ReaderT (IORef s) IO a)
+  deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadUnliftIO)
 
-rsput :: MonadIO m => s -> ReaderT (IORef s) m ()
-rsput s = ReaderT $ \ref -> liftIO $ writeIORef ref $! s
+getSIO :: SIO s s
+getSIO = SIO $ ReaderT readIORef
 
-rsmodify :: MonadIO m => (s -> s) -> ReaderT (IORef s) m ()
-rsmodify f = ReaderT $ \ref -> liftIO $ modifyIORef' ref f
+putSIO :: s -> SIO s ()
+putSIO s = SIO $ ReaderT $ \ref -> writeIORef ref $! s
 
-rsevalStateT
-  :: MonadIO m
-  => ReaderT (IORef s) m a
-  -> s
-  -> m a
-rsevalStateT (ReaderT f) s = liftIO (newIORef s) >>= f
+modifySIO :: (s -> s) -> SIO s ()
+modifySIO f = SIO $ ReaderT $ \ref -> modifyIORef' ref f
 
-rsexecStateT
-  :: MonadIO m
-  => ReaderT (IORef s) m ()
-  -> s
-  -> m s
-rsexecStateT (ReaderT f) s = do
-  ref <- liftIO $ newIORef s
+evalSIO :: SIO s a -> s -> IO a
+evalSIO (SIO (ReaderT f)) s = newIORef s >>= f
+
+execSIO :: SIO s () -> s -> IO s
+execSIO (SIO (ReaderT f)) s = do
+  ref <- newIORef s
   f ref
-  liftIO $ readIORef ref
+  readIORef ref

From e3bb03f9afac8e5321c696b02e7a95fb91d67fb4 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 15 Jan 2018 17:56:20 +0200
Subject: [PATCH 25/43] Missing import

---
 yesod-test/Yesod/Test.hs    | 1 +
 yesod-test/yesod-test.cabal | 1 +
 2 files changed, 2 insertions(+)

diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs
index 73ec49e6..07eaeb8e 100644
--- a/yesod-test/Yesod/Test.hs
+++ b/yesod-test/Yesod/Test.hs
@@ -138,6 +138,7 @@ import Data.CaseInsensitive (CI)
 import Network.Wai
 import Network.Wai.Test hiding (assertHeader, assertNoHeader, request)
 import Control.Monad.Trans.Reader (ReaderT (..))
+import Conduit (MonadThrow)
 import Data.IORef
 import Control.Monad.IO.Class
 import System.IO
diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal
index 3c930575..4e4a61db 100644
--- a/yesod-test/yesod-test.cabal
+++ b/yesod-test/yesod-test.cabal
@@ -38,6 +38,7 @@ library
                    , xml-conduit               >= 1.0
                    , xml-types                 >= 0.3
                    , yesod-core                >= 1.6
+                   , conduit
 
     exposed-modules: Yesod.Test
                      Yesod.Test.CssQuery

From f2926e60f0664c7c268b64d6c3d255606eb4dedf Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 15 Jan 2018 19:48:42 +0200
Subject: [PATCH 26/43] Remove some deprecated methods from the Yesod class

---
 yesod-core/Yesod/Core.hs             |  1 -
 yesod-core/Yesod/Core/Class/Yesod.hs | 46 ++++------------------------
 2 files changed, 6 insertions(+), 41 deletions(-)

diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs
index 2f81a9ba..0b625582 100644
--- a/yesod-core/Yesod/Core.hs
+++ b/yesod-core/Yesod/Core.hs
@@ -31,7 +31,6 @@ module Yesod.Core
       -- * Logging
     , defaultMakeLogger
     , defaultMessageLoggerSource
-    , defaultShouldLog
     , defaultShouldLogIO
     , formatLogMessage
     , LogLevel (..)
diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs
index f960c01c..6e619ca2 100644
--- a/yesod-core/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/Yesod/Core/Class/Yesod.hs
@@ -10,7 +10,7 @@ import           Yesod.Core.Handler
 
 import           Yesod.Routes.Class
 
-import           Data.ByteString.Builder            (Builder, toLazyByteString)
+import           Data.ByteString.Builder            (Builder)
 import           Data.Text.Encoding                 (encodeUtf8Builder)
 import           Control.Arrow                      ((***), second)
 import           Control.Exception                  (bracket)
@@ -24,7 +24,6 @@ import           Control.Monad.Logger               (LogLevel (LevelInfo, LevelO
 import           Control.Monad.Trans.Resource       (InternalState, createInternalState, closeInternalState)
 import qualified Data.ByteString.Char8              as S8
 import qualified Data.ByteString.Lazy               as L
-import qualified Data.ByteString.Lazy.Char8         as BL8
 import Data.Aeson (object, (.=))
 import           Data.List                          (foldl', nub)
 import qualified Data.Map                           as Map
@@ -37,7 +36,7 @@ import           Data.Text.Lazy.Builder             (toLazyText)
 import           Data.Text.Lazy.Encoding            (encodeUtf8)
 import           Data.Word                          (Word64)
 import           Language.Haskell.TH.Syntax         (Loc (..))
-import           Network.HTTP.Types                 (encodePath, renderQueryText)
+import           Network.HTTP.Types                 (encodePath)
 import qualified Network.Wai                        as W
 import           Network.Wai.Parse                  (lbsBackEnd,
                                                      tempFileBackEnd)
@@ -99,12 +98,6 @@ class RenderRoute site => Yesod site where
                     ^{pageBody p}
             |]
 
-    -- | Override the rendering function for a particular URL. One use case for
-    -- this is to offload static hosting to a different domain name to avoid
-    -- sending cookies.
-    urlRenderOverride :: site -> Route site -> Maybe Builder
-    urlRenderOverride _ _ = Nothing
-
     -- | Override the rendering function for a particular URL and query string
     -- parameters. One use case for this is to offload static hosting to a
     -- different domain name to avoid sending cookies.
@@ -117,15 +110,7 @@ class RenderRoute site => Yesod site where
                            -> Route site
                            -> [(T.Text, T.Text)] -- ^ query string
                            -> Maybe Builder
-    urlParamRenderOverride y route params = addParams params <$> urlRenderOverride y route
-      where
-        addParams [] routeBldr = routeBldr
-        addParams nonEmptyParams routeBldr =
-            let routeBS = toLazyByteString routeBldr
-                qsSeparator = if BL8.elem '?' routeBS then "&" else "?"
-                valueToMaybe t = if t == "" then Nothing else Just t
-                queryText = map (id *** valueToMaybe) nonEmptyParams
-            in routeBldr `mappend` qsSeparator `mappend` renderQueryText False queryText
+    urlParamRenderOverride _ _ _ = Nothing
 
     -- | Determine if a request is authorized or not.
     --
@@ -276,22 +261,11 @@ class RenderRoute site => Yesod site where
 
     -- | Should we log the given log source/level combination.
     --
-    -- Default: the 'defaultShouldLog' function.
-    shouldLog :: site -> LogSource -> LogLevel -> Bool
-    shouldLog _ = defaultShouldLog
-
-    -- | Should we log the given log source/level combination.
-    --
-    -- Note that this is almost identical to @shouldLog@, except the result
-    -- lives in @IO@. This allows you to dynamically alter the logging level of
-    -- your application by having this result depend on, e.g., an @IORef@.
-    --
-    -- The default implementation simply uses @shouldLog@. Future versions of
-    -- Yesod will remove @shouldLog@ and use this method exclusively.
+    -- Default: the 'defaultShouldLogIO' function.
     --
     -- Since 1.2.4
     shouldLogIO :: site -> LogSource -> LogLevel -> IO Bool
-    shouldLogIO a b c = return (shouldLog a b c)
+    shouldLogIO _ = defaultShouldLogIO
 
     -- | A Yesod middleware, which will wrap every handler function. This
     -- allows you to run code before and after a normal handler.
@@ -328,7 +302,6 @@ class RenderRoute site => Yesod site where
                 <h1>#{title}
                 ^{body}
             |]
-{-# DEPRECATED urlRenderOverride "Use urlParamRenderOverride instead" #-}
 
 -- | Default implementation of 'makeLogger'. Sends to stdout and
 -- automatically flushes on each write.
@@ -365,15 +338,8 @@ defaultMessageLoggerSource ckLoggable logger loc source level msg = do
 -- above 'LevelInfo'.
 --
 -- Since 1.4.10
-defaultShouldLog :: LogSource -> LogLevel -> Bool
-defaultShouldLog _ level = level >= LevelInfo
-
--- | A default implementation of 'shouldLogIO' that can be used with
--- 'defaultMessageLoggerSource'. Just uses 'defaultShouldLog'.
---
--- Since 1.4.10
 defaultShouldLogIO :: LogSource -> LogLevel -> IO Bool
-defaultShouldLogIO a b = return $ defaultShouldLog a b
+defaultShouldLogIO _ level = return $ level >= LevelInfo
 
 -- | Default implementation of 'yesodMiddleware'. Adds the response header
 -- \"Vary: Accept, Accept-Language\" and performs authorization checks.

From 3956110876c94d7d6d8fafaa44e1989551509db0 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 15 Jan 2018 21:07:54 +0200
Subject: [PATCH 27/43] Fix yesod-websockets

---
 yesod-websockets/Yesod/WebSockets.hs    | 151 ++++++++++++++++--------
 yesod-websockets/yesod-websockets.cabal |   3 +-
 2 files changed, 105 insertions(+), 49 deletions(-)

diff --git a/yesod-websockets/Yesod/WebSockets.hs b/yesod-websockets/Yesod/WebSockets.hs
index 2346b03c..5a54c553 100644
--- a/yesod-websockets/Yesod/WebSockets.hs
+++ b/yesod-websockets/Yesod/WebSockets.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 module Yesod.WebSockets
@@ -34,10 +33,9 @@ module Yesod.WebSockets
     , WS.ConnectionOptions (..)
     ) where
 
-import           Control.Monad                  (forever, void, when)
-import           Control.Monad.Trans.Reader     (ReaderT (ReaderT, runReaderT))
-import qualified Data.Conduit                   as C
-import qualified Data.Conduit.List              as CL
+import           Control.Monad                  (forever, when)
+import           Control.Monad.Reader           (ReaderT, runReaderT, MonadReader, ask)
+import           Conduit
 import qualified Network.Wai.Handler.WebSockets as WaiWS
 import qualified Network.WebSockets             as WS
 import qualified Yesod.Core                     as Y
@@ -55,28 +53,28 @@ type WebSocketsT = ReaderT WS.Connection
 -- instead.
 --
 -- Since 0.1.0
-webSockets :: (Y.MonadUnliftIO m, Y.MonadHandler m) => WebSocketsT m () -> m ()
+webSockets
+  :: (MonadUnliftIO m, Y.MonadHandler m)
+  => WebSocketsT m ()
+  -> m ()
 webSockets = webSocketsOptions WS.defaultConnectionOptions
 
 -- | Varient of 'webSockets' which allows you to specify
 -- the WS.ConnectionOptions setttings when upgrading to a websocket connection.
 --
 -- Since 0.2.5
-webSocketsOptions :: (Y.MonadUnliftIO m, Y.MonadHandler m)
-               => WS.ConnectionOptions
-               -> WebSocketsT m ()
-               -> m ()
-#if MIN_VERSION_websockets(0,10,0)
+webSocketsOptions
+  :: (MonadUnliftIO m, Y.MonadHandler m)
+  => WS.ConnectionOptions
+  -> WebSocketsT m ()
+  -> m ()
 webSocketsOptions opts = webSocketsOptionsWith opts $ const $ return $ Just $ WS.AcceptRequest Nothing []
-#else
-webSocketsOptions opts = webSocketsOptionsWith opts $ const $ return $ Just $ WS.AcceptRequest Nothing
-#endif
 
 -- | Varient of 'webSockets' which allows you to specify the 'WS.AcceptRequest'
 -- setttings when upgrading to a websocket connection.
 --
 -- Since 0.2.4
-webSocketsWith :: (Y.MonadUnliftIO m, Y.MonadHandler m)
+webSocketsWith :: (MonadUnliftIO m, Y.MonadHandler m)
                => (WS.RequestHead -> m (Maybe WS.AcceptRequest))
                -- ^ A Nothing indicates that the websocket upgrade request should not happen
                -- and instead the rest of the handler will be called instead.  This allows
@@ -93,7 +91,7 @@ webSocketsWith = webSocketsOptionsWith WS.defaultConnectionOptions
 -- setttings when upgrading to a websocket connection.
 --
 -- Since 0.2.5
-webSocketsOptionsWith :: (Y.MonadUnliftIO m, Y.MonadHandler m)
+webSocketsOptionsWith :: (MonadUnliftIO m, Y.MonadHandler m)
                => WS.ConnectionOptions
                -- ^ Custom websockets options
                -> (WS.RequestHead -> m (Maybe WS.AcceptRequest))
@@ -125,100 +123,157 @@ webSocketsOptionsWith wsConnOpts buildAr inner = do
                     sink
 
 -- | Wrapper for capturing exceptions
-wrapWSE :: MonadIO m => (WS.Connection -> a -> IO ())-> a -> WebSocketsT m (Either SomeException ())
-wrapWSE ws x = ReaderT $ liftIO . tryAny . flip ws x
+wrapWSE :: (MonadIO m, MonadReader WS.Connection m)
+        => (WS.Connection -> a -> IO ())
+        -> a
+        -> m (Either SomeException ())
+wrapWSE ws x = do
+  conn <- ask
+  liftIO $ tryAny $ ws conn x
 
-wrapWS :: MonadIO m => (WS.Connection -> a -> IO ()) -> a -> WebSocketsT m ()
-wrapWS ws x = ReaderT $ liftIO . flip ws x
+wrapWS :: (MonadIO m, MonadReader WS.Connection m)
+       => (WS.Connection -> a -> IO ())
+       -> a
+       -> m ()
+wrapWS ws x = do
+  conn <- ask
+  liftIO $ ws conn x
 
 -- | Receive a piece of data from the client.
 --
 -- Since 0.1.0
-receiveData :: (MonadIO m, WS.WebSocketsData a) => WebSocketsT m a
-receiveData = ReaderT $ liftIO . WS.receiveData
+receiveData
+  :: (MonadIO m, MonadReader WS.Connection m, WS.WebSocketsData a)
+  => m a
+receiveData = do
+  conn <- ask
+  liftIO $ WS.receiveData conn
 
 -- | Receive a piece of data from the client.
 -- Capture SomeException as the result or operation
 -- Since 0.2.2
-receiveDataE :: (MonadIO m, WS.WebSocketsData a) => WebSocketsT m (Either SomeException a)
-receiveDataE = ReaderT $ liftIO . tryAny . WS.receiveData
+receiveDataE
+  :: (MonadIO m, MonadReader WS.Connection m, WS.WebSocketsData a)
+  => m (Either SomeException a)
+receiveDataE = do
+  conn <- ask
+  liftIO $ tryAny $ WS.receiveData conn
 
 -- | Receive an application message.
 -- Capture SomeException as the result or operation
 -- Since 0.2.3
-receiveDataMessageE :: (MonadIO m) => WebSocketsT m (Either SomeException WS.DataMessage)
-receiveDataMessageE = ReaderT $ liftIO . tryAny . WS.receiveDataMessage
+receiveDataMessageE
+  :: (MonadIO m, MonadReader WS.Connection m)
+  => m (Either SomeException WS.DataMessage)
+receiveDataMessageE = do
+  conn <- ask
+  liftIO $ tryAny $ WS.receiveDataMessage conn
 
 -- | Send a textual message to the client.
 --
 -- Since 0.1.0
-sendTextData :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m ()
+sendTextData
+  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  => a
+  -> m ()
 sendTextData = wrapWS WS.sendTextData
 
 -- | Send a textual message to the client.
 -- Capture SomeException as the result or operation
--- and can be used like 
+-- and can be used like
 -- `either handle_exception return =<< sendTextDataE ("Welcome" :: Text)`
 -- Since 0.2.2
-sendTextDataE :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m (Either SomeException ())
+sendTextDataE
+  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  => a
+  -> m (Either SomeException ())
 sendTextDataE = wrapWSE WS.sendTextData
 
 -- | Send a binary message to the client.
 --
 -- Since 0.1.0
-sendBinaryData :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m ()
+sendBinaryData
+  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  => a
+  -> m ()
 sendBinaryData = wrapWS WS.sendBinaryData
 
 -- | Send a binary message to the client.
 -- Capture SomeException as the result of operation
 -- Since 0.2.2
-sendBinaryDataE :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m (Either SomeException ())
+sendBinaryDataE
+  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  => a
+  -> m (Either SomeException ())
 sendBinaryDataE = wrapWSE WS.sendBinaryData
 
 -- | Send a ping message to the client.
 --
 -- Since 0.2.2
-sendPing :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m ()
+sendPing
+  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  => a
+  -> WebSocketsT m ()
 sendPing = wrapWS WS.sendPing
 
--- | Send a ping message to the client. 
+-- | Send a ping message to the client.
 -- Capture SomeException as the result of operation
 -- Since 0.2.2
-sendPingE :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m (Either SomeException ())
+sendPingE
+  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  => a
+  -> m (Either SomeException ())
 sendPingE = wrapWSE WS.sendPing
 
--- | Send a DataMessage to the client. 
+-- | Send a DataMessage to the client.
 -- Capture SomeException as the result of operation
 -- Since 0.2.3
-sendDataMessageE :: (MonadIO m) => WS.DataMessage -> WebSocketsT m (Either SomeException ())
-sendDataMessageE x = ReaderT $ liftIO . tryAny . (`WS.sendDataMessage` x)
+sendDataMessageE
+  :: (MonadIO m, MonadReader WS.Connection m)
+  => WS.DataMessage
+  -> m (Either SomeException ())
+sendDataMessageE x = do
+  conn <- ask
+  liftIO $ tryAny $ WS.sendDataMessage conn x
 
--- | Send a close request to the client. 
--- 
+-- | Send a close request to the client.
+--
 -- Since 0.2.2
-sendClose :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m ()
+sendClose
+  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  => a
+  -> WebSocketsT m ()
 sendClose = wrapWS WS.sendClose
 
--- | Send a close request to the client. 
+-- | Send a close request to the client.
 -- Capture SomeException as the result of operation
 -- Since 0.2.2
-sendCloseE :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m (Either SomeException ())
+sendCloseE
+  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  => a
+  -> m (Either SomeException ())
 sendCloseE = wrapWSE WS.sendClose
 
 -- | A @Source@ of WebSockets data from the user.
 --
 -- Since 0.1.0
-sourceWS :: (MonadIO m, WS.WebSocketsData a) => C.Producer (WebSocketsT m) a
-sourceWS = forever $ Y.lift receiveData >>= C.yield
+sourceWS
+  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  => ConduitT i a m ()
+sourceWS = forever $ lift receiveData >>= yield
 
 -- | A @Sink@ for sending textual data to the user.
 --
 -- Since 0.1.0
-sinkWSText :: (MonadIO m, WS.WebSocketsData a) => C.Consumer a (WebSocketsT m) ()
-sinkWSText = CL.mapM_ sendTextData
+sinkWSText
+  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  => ConduitT a o m ()
+sinkWSText = mapM_C sendTextData
 
 -- | A @Sink@ for sending binary data to the user.
 --
 -- Since 0.1.0
-sinkWSBinary :: (MonadIO m, WS.WebSocketsData a) => C.Consumer a (WebSocketsT m) ()
-sinkWSBinary = CL.mapM_ sendBinaryData
+sinkWSBinary
+  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  => ConduitT a o m ()
+sinkWSBinary = mapM_C sendBinaryData
diff --git a/yesod-websockets/yesod-websockets.cabal b/yesod-websockets/yesod-websockets.cabal
index 23f6b800..3734b307 100644
--- a/yesod-websockets/yesod-websockets.cabal
+++ b/yesod-websockets/yesod-websockets.cabal
@@ -21,11 +21,12 @@ library
                      , wai
 
                      , wai-websockets    >= 2.1
-                     , websockets        >= 0.9
+                     , websockets        >= 0.10
                      , transformers      >= 0.2
                      , yesod-core        >= 1.6
                      , unliftio
                      , conduit           >= 1.3
+                     , mtl
 
 source-repository head
   type:     git

From ad35ef9431df143de2b9b1bde5ce82ba2d595cc1 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 16 Jan 2018 16:10:23 +0200
Subject: [PATCH 28/43] Deal with another sneaky exception

---
 yesod-core/Yesod/Core.hs               |  2 +-
 yesod-core/Yesod/Core/Class/Handler.hs |  2 +-
 yesod-core/Yesod/Core/Handler.hs       |  2 +-
 yesod-core/Yesod/Core/Internal/Run.hs  | 48 ++++++++------------------
 yesod-core/Yesod/Core/Types.hs         |  2 +-
 yesod-core/yesod-core.cabal            |  2 +-
 6 files changed, 20 insertions(+), 38 deletions(-)

diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs
index 0b625582..19fdf361 100644
--- a/yesod-core/Yesod/Core.hs
+++ b/yesod-core/Yesod/Core.hs
@@ -141,7 +141,7 @@ import qualified Yesod.Core.Internal.Run
 import qualified Paths_yesod_core
 import Data.Version (showVersion)
 import Yesod.Routes.Class
-import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO (..))
+import UnliftIO (MonadIO (..), MonadUnliftIO (..))
 
 import Control.Monad.Trans.Resource (MonadResource (..))
 import Yesod.Core.Internal.LiteApp
diff --git a/yesod-core/Yesod/Core/Class/Handler.hs b/yesod-core/Yesod/Core/Class/Handler.hs
index 44357bfd..eccc7f25 100644
--- a/yesod-core/Yesod/Core/Class/Handler.hs
+++ b/yesod-core/Yesod/Core/Class/Handler.hs
@@ -11,7 +11,7 @@ module Yesod.Core.Class.Handler
     ) where
 
 import Yesod.Core.Types
-import Control.Monad.IO.Unlift (liftIO, MonadIO)
+import UnliftIO (liftIO, MonadIO)
 import Control.Monad.Trans.Resource (MonadResource)
 import Control.Monad.Trans.Class (lift)
 #if __GLASGOW_HASKELL__ < 710
diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs
index 45e15a20..dc132cb4 100644
--- a/yesod-core/Yesod/Core/Handler.hs
+++ b/yesod-core/Yesod/Core/Handler.hs
@@ -200,7 +200,7 @@ import           Control.Exception             (handle)
 import           Control.Monad                 (void, liftM, unless)
 import qualified Control.Monad.Trans.Writer    as Writer
 
-import           Control.Monad.IO.Unlift       (MonadIO, liftIO, MonadUnliftIO, withRunInIO)
+import           UnliftIO                      (MonadIO, liftIO, MonadUnliftIO, withRunInIO)
 
 import qualified Network.HTTP.Types            as H
 import qualified Network.Wai                   as W
diff --git a/yesod-core/Yesod/Core/Internal/Run.hs b/yesod-core/Yesod/Core/Internal/Run.hs
index 0989b025..8a156e27 100644
--- a/yesod-core/Yesod/Core/Internal/Run.hs
+++ b/yesod-core/Yesod/Core/Internal/Run.hs
@@ -16,8 +16,6 @@ import           Control.Applicative          ((<$>))
 import Yesod.Core.Internal.Response
 import           Data.ByteString.Builder      (toLazyByteString)
 import qualified Data.ByteString.Lazy         as BL
-import           Control.Exception            (fromException, evaluate)
-import qualified Control.Exception            as E
 import           Control.Monad.IO.Class       (MonadIO, liftIO)
 import           Control.Monad.Logger         (LogLevel (LevelError), LogSource,
                                                liftLoc)
@@ -45,38 +43,21 @@ import           Yesod.Core.Internal.Request  (parseWaiRequest,
 import           Yesod.Core.Internal.Util     (getCurrentMaxExpiresRFC1123)
 import           Yesod.Routes.Class           (Route, renderRoute)
 import           Control.DeepSeq              (($!!), NFData)
+import           UnliftIO.Exception
 
--- | Catch all synchronous exceptions, ignoring asynchronous
--- exceptions.
---
--- Ideally we'd use this from a different library
-catchSync :: IO a -> (E.SomeException -> IO a) -> IO a
-catchSync thing after = thing `E.catch` \e ->
-    if isAsyncException e
-        then E.throwIO e
-        else after e
-
--- | Determine if an exception is asynchronous
---
--- Also worth being upstream
-isAsyncException :: E.SomeException -> Bool
-isAsyncException e =
-    case fromException e of
-        Just E.SomeAsyncException{} -> True
-        Nothing -> False
-
--- | Convert an exception into an ErrorResponse
-toErrorHandler :: E.SomeException -> IO ErrorResponse
-toErrorHandler e0 = flip catchSync errFromShow $
+-- | Convert a synchronous exception into an ErrorResponse
+toErrorHandler :: SomeException -> IO ErrorResponse
+toErrorHandler e0 = handleAny errFromShow $
     case fromException e0 of
         Just (HCError x) -> evaluate $!! x
-        _
-            | isAsyncException e0 -> E.throwIO e0
-            | otherwise -> errFromShow e0
+        _ -> errFromShow e0
 
 -- | Generate an @ErrorResponse@ based on the shown version of the exception
-errFromShow :: E.SomeException -> IO ErrorResponse
-errFromShow x = evaluate $!! InternalError $! T.pack $! show x
+errFromShow :: SomeException -> IO ErrorResponse
+errFromShow x = do
+  text <- evaluate (T.pack $ show x) `catchAny` \_ ->
+          return (T.pack "Yesod.Core.Internal.Run.errFromShow: show of an exception threw an exception")
+  return $ InternalError text
 
 -- | Do a basic run of a handler, getting some contents and the final
 -- @GHState@. The @GHState@ unfortunately may contain some impure
@@ -95,7 +76,7 @@ basicRunHandler rhe handler yreq resState = do
 
     -- Run the handler itself, capturing any runtime exceptions and
     -- converting them into a @HandlerContents@
-    contents' <- catchSync
+    contents' <- catchAny
         (do
             res <- unHandlerT handler (hd istate)
             tc <- evaluate (toTypedContent res)
@@ -136,7 +117,7 @@ handleError :: RunHandlerEnv site
             -> IO YesodResponse
 handleError rhe yreq resState finalSession headers e0 = do
     -- Find any evil hidden impure exceptions
-    e <- (evaluate $!! e0) `catchSync` errFromShow
+    e <- (evaluate $!! e0) `catchAny` errFromShow
 
     -- Generate a response, leveraging the updated session and
     -- response headers
@@ -201,7 +182,7 @@ evalFallback :: (Monoid w, NFData w)
              => HandlerContents
              -> w
              -> IO (w, HandlerContents)
-evalFallback contents val = catchSync
+evalFallback contents val = catchAny
     (fmap (, contents) (evaluate $!! val))
     (fmap ((mempty, ) . HCError) . toErrorHandler)
 
@@ -219,13 +200,14 @@ runHandler rhe@RunHandlerEnv {..} handler yreq = withInternalState $ \resState -
     -- propagating exceptions into the contents
     (finalSession, contents1) <- evalFallback contents0 (ghsSession state)
     (headers, contents2) <- evalFallback contents1 (appEndo (ghsHeaders state) [])
+    contents3 <- (evaluate contents2) `catchAny` (fmap HCError . toErrorHandler)
 
     -- Convert the HandlerContents into the final YesodResponse
     handleContents
         (handleError rhe yreq resState finalSession headers)
         finalSession
         headers
-        contents2
+        contents3
 
 safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
        -> ErrorResponse
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index 191ea460..8ae66f28 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -61,7 +61,7 @@ import Control.DeepSeq.Generics (genericRnf)
 import Yesod.Core.TypeCache (TypeMap, KeyedTypeMap)
 import Control.Monad.Logger (MonadLoggerIO (..))
 import Data.Semigroup (Semigroup)
-import Control.Monad.IO.Unlift (MonadUnliftIO (..), UnliftIO (..), withUnliftIO)
+import UnliftIO (MonadUnliftIO (..), UnliftIO (..), withUnliftIO)
 
 -- Sessions
 type SessionMap = Map Text ByteString
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index bc05c81b..e4bec214 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -63,7 +63,7 @@ library
                    , auto-update
                    , semigroups
                    , byteable
-                   , unliftio-core
+                   , unliftio
 
     exposed-modules: Yesod.Core
                      Yesod.Core.Content

From 2047efd00a93ac5eb583e30cd15ebd9ea1035f8f Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 16 Jan 2018 20:21:48 +0200
Subject: [PATCH 29/43] Bump persistent version

---
 yesod-auth/yesod-auth.cabal             | 2 +-
 yesod-persistent/yesod-persistent.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal
index 1ba37f7e..498d5c34 100644
--- a/yesod-auth/yesod-auth.cabal
+++ b/yesod-auth/yesod-auth.cabal
@@ -38,7 +38,7 @@ library
                    , unordered-containers
                    , yesod-form              >= 1.6       && < 1.7
                    , transformers            >= 0.2.2
-                   , persistent              >= 2.1       && < 2.8
+                   , persistent              >= 2.8       && < 2.9
                    , persistent-template     >= 2.1       && < 2.8
                    , http-client
                    , http-conduit            >= 2.1
diff --git a/yesod-persistent/yesod-persistent.cabal b/yesod-persistent/yesod-persistent.cabal
index 4ac6dca7..353fac6e 100644
--- a/yesod-persistent/yesod-persistent.cabal
+++ b/yesod-persistent/yesod-persistent.cabal
@@ -16,7 +16,7 @@ extra-source-files: README.md ChangeLog.md
 library
     build-depends:   base                      >= 4        && < 5
                    , yesod-core                >= 1.6      && < 1.7
-                   , persistent                >= 2.1      && < 2.8
+                   , persistent                >= 2.8      && < 2.9
                    , persistent-template       >= 2.1      && < 2.8
                    , transformers              >= 0.2.2
                    , blaze-builder

From 7f6f1821e825281e8187c3d3cc06d469bf13c101 Mon Sep 17 00:00:00 2001
From: Janek Spaderna <janek@spaderna.eu>
Date: Thu, 18 Jan 2018 12:00:46 +0100
Subject: [PATCH 30/43] [yesod] Fix comment for contentTypeTypes & simpler
 implementation

In the implementation of contentTypeTypes make use of simpleContentType.
---
 yesod-core/Yesod/Core/Content.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/yesod-core/Yesod/Core/Content.hs b/yesod-core/Yesod/Core/Content.hs
index 1313a1ea..0695cd50 100644
--- a/yesod-core/Yesod/Core/Content.hs
+++ b/yesod-core/Yesod/Core/Content.hs
@@ -78,6 +78,7 @@ import Yesod.Core.Types
 import Text.Lucius (Css, renderCss)
 import Text.Julius (Javascript, unJavascript)
 import Data.Word8 (_semicolon, _slash)
+import Control.Arrow (second)
 
 -- | Zero-length enumerator.
 emptyContent :: Content
@@ -228,13 +229,13 @@ typeOctet = "application/octet-stream"
 simpleContentType :: ContentType -> ContentType
 simpleContentType = fst . B.break (== _semicolon)
 
--- Give just the media types as a pair.
+-- | 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.break (== _semicolon) (tailEmpty sub))
+contentTypeTypes = second tailEmpty . B.break (== _slash) . simpleContentType
   where
     tailEmpty x = if B.null x then "" else B.tail x
-    (main, sub) = B.break (== _slash) ct
 
 instance HasContentType a => HasContentType (DontFullyEvaluate a) where
     getContentType = getContentType . liftM unDontFullyEvaluate

From 492102537fdc2057b8865776a2ff55af344d366a Mon Sep 17 00:00:00 2001
From: Janek Spaderna <janek@spaderna.eu>
Date: Thu, 18 Jan 2018 12:11:43 +0100
Subject: [PATCH 31/43] [yesod] Bump version & add changelog entry

---
 yesod-core/ChangeLog.md     | 4 ++++
 yesod-core/yesod-core.cabal | 2 +-
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md
index 43266e77..cef7c582 100644
--- a/yesod-core/ChangeLog.md
+++ b/yesod-core/ChangeLog.md
@@ -1,3 +1,7 @@
+## 1.4.37.3
+
+* Fix Haddock comment & simplify implementation for `contentTypeTypes` [#1476](https://github.com/yesodweb/yesod/issues/1476)
+
 ## 1.4.37.2
 
 * Improve error messages for the CSRF checking functions [#1455](https://github.com/yesodweb/yesod/issues/1455)
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index c1d6f8a8..c808eab0 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         1.4.37.2
+version:         1.4.37.3
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>

From 18910b516bbbc33854ea505c31df9615eebefeb9 Mon Sep 17 00:00:00 2001
From: James Parker <dev@jamesparker.me>
Date: Mon, 22 Jan 2018 00:19:04 -0500
Subject: [PATCH 32/43] Change mkYesodWith to accept separate lists for
 contexts and type arguments

---
 yesod-core/Yesod/Core/Internal/TH.hs      | 43 ++++++++---------------
 yesod-core/Yesod/Routes/TH/ParseRoute.hs  |  8 ++---
 yesod-core/Yesod/Routes/TH/RenderRoute.hs | 11 ++----
 yesod-core/Yesod/Routes/TH/RouteAttrs.hs  |  8 ++---
 yesod-core/test/Hierarchy.hs              |  6 ++--
 yesod-core/test/RouteSpec.hs              |  6 ++--
 6 files changed, 27 insertions(+), 55 deletions(-)

diff --git a/yesod-core/Yesod/Core/Internal/TH.hs b/yesod-core/Yesod/Core/Internal/TH.hs
index 8ee5b4e0..2b285746 100644
--- a/yesod-core/Yesod/Core/Internal/TH.hs
+++ b/yesod-core/Yesod/Core/Internal/TH.hs
@@ -44,11 +44,13 @@ mkYesod :: String -- ^ name of the argument datatype
         -> Q [Dec]
 mkYesod name = fmap (uncurry (++)) . mkYesodGeneral name [] False return
 
-mkYesodWith :: String
-            -> [Either String [String]]
+{-# DEPRECATED mkYesodWith "Contexts and type variables are now parsed from the name. (https://github.com/yesodweb/yesod/pull/1366)" #-}
+mkYesodWith :: [[String]]
+            -> String
+            -> [String]
             -> [ResourceTree String]
             -> Q [Dec]
-mkYesodWith name args = fmap (uncurry (++)) . mkYesodGeneral name args False return
+mkYesodWith cxts name args = fmap (uncurry (++)) . mkYesodGeneral' cxts name args False return
 
 -- | Sometimes, you will want to declare your routes in one file and define
 -- your handlers elsewhere. For example, this is the only way to break up a
@@ -65,7 +67,7 @@ mkYesodDataGeneral name isSub res = do
     let (name', rest, cxt) = case parse parseName "" name of
             Left err -> error $ show err
             Right a -> a
-    fst <$> mkYesodGeneral' cxt name' (fmap Left rest) isSub return res
+    fst <$> mkYesodGeneral' cxt name' rest isSub return res
 
     where
         parseName = do
@@ -114,7 +116,7 @@ masterTypeSyns vs site =
 --   indicates a polymorphic type, and provides the list of classes
 --   the type must be instance of.
 mkYesodGeneral :: String                    -- ^ foundation type
-               -> [Either String [String]]  -- ^ arguments for the type
+               -> [String]                  -- ^ arguments for the type
                -> Bool                      -- ^ is this a subsite
                -> (Exp -> Q Exp)            -- ^ unwrap handler
                -> [ResourceTree String]
@@ -123,12 +125,12 @@ mkYesodGeneral = mkYesodGeneral' []
 
 mkYesodGeneral' :: [[String]]               -- ^ Appliction context. Used in RenderRoute, RouteAttrs, and ParseRoute instances.
                -> String                    -- ^ foundation type
-               -> [Either String [String]]  -- ^ arguments for the type
+               -> [String]                  -- ^ arguments for the type
                -> Bool                      -- ^ is this a subsite
                -> (Exp -> Q Exp)            -- ^ unwrap handler
                -> [ResourceTree String]
                -> Q([Dec],[Dec])
-mkYesodGeneral' appCxt' namestr args isSub f resS = do
+mkYesodGeneral' appCxt' namestr mtys isSub f resS = do
     let appCxt = fmap (\(c:rest) -> 
 #if MIN_VERSION_template_haskell(2,10,0)
             foldl' (\acc v -> acc `AppT` nameToType v) (ConT $ mkName c) rest
@@ -151,36 +153,21 @@ mkYesodGeneral' appCxt' namestr args isSub f resS = do
                          DataD _ _ vs _ _ -> length vs
                          NewtypeD _ _ vs _ _ -> length vs
 #endif
+                         TySynD _ vs _ -> length vs
                          _ -> 0
                      _ -> 0
                _ -> return 0
     let name = mkName namestr
-        (mtys,_) = partitionEithers args
     -- Generate as many variable names as the arity indicates
     vns <- replicateM (arity - length mtys) $ newName "t"
         -- Base type (site type with variables)
-    let (argtypes,cxt) = (\(ns,r,cs) -> (ns ++ fmap VarT r, cs)) $
-          foldr (\arg (xs,vns',cs) ->
-                   case arg of
-                     Left  t  -> 
-                                 ( nameToType t:xs, vns', cs )
-                     Right ts -> 
-                                 let (n, ns) = maybe (error "mkYesodGeneral: Should be unreachable.") id $ uncons vns' in
-                                 ( VarT n : xs, ns
-                                 , fmap (\t ->
-#if MIN_VERSION_template_haskell(2,10,0)
-                                               AppT (ConT $ mkName t) (VarT n)
-#else
-                                               ClassP (mkName t) [VarT n]
-#endif
-                                          ) ts ++ cs )
-                 ) ([],vns,[]) args
+    let argtypes = fmap nameToType mtys ++ fmap VarT vns
         site = foldl' AppT (ConT name) argtypes
         res = map (fmap (parseType . dropBracket)) resS
-    renderRouteDec <- mkRenderRouteInstance' appCxt site res
-    routeAttrsDec  <- mkRouteAttrsInstance' appCxt site res
-    dispatchDec    <- mkDispatchInstance site cxt f res
-    parseRoute <- mkParseRouteInstance' appCxt site res
+    renderRouteDec <- mkRenderRouteInstance appCxt site res
+    routeAttrsDec  <- mkRouteAttrsInstance appCxt site res
+    dispatchDec    <- mkDispatchInstance site appCxt f res
+    parseRoute <- mkParseRouteInstance appCxt site res
     let rname = mkName $ "resources" ++ namestr
     eres <- lift resS
     let resourcesDec =
diff --git a/yesod-core/Yesod/Routes/TH/ParseRoute.hs b/yesod-core/Yesod/Routes/TH/ParseRoute.hs
index f5ee972a..fc5535a7 100644
--- a/yesod-core/Yesod/Routes/TH/ParseRoute.hs
+++ b/yesod-core/Yesod/Routes/TH/ParseRoute.hs
@@ -3,7 +3,6 @@
 module Yesod.Routes.TH.ParseRoute
     ( -- ** ParseRoute
       mkParseRouteInstance
-    , mkParseRouteInstance'
     ) where
 
 import Yesod.Routes.TH.Types
@@ -12,11 +11,8 @@ import Data.Text (Text)
 import Yesod.Routes.Class
 import Yesod.Routes.TH.Dispatch
 
-mkParseRouteInstance :: Type -> [ResourceTree a] -> Q Dec
-mkParseRouteInstance = mkParseRouteInstance' []
-
-mkParseRouteInstance' :: Cxt -> Type -> [ResourceTree a] -> Q Dec
-mkParseRouteInstance' cxt typ ress = do
+mkParseRouteInstance :: Cxt -> Type -> [ResourceTree a] -> Q Dec
+mkParseRouteInstance cxt typ ress = do
     cls <- mkDispatchClause
         MkDispatchSettings
             { mdsRunHandler = [|\_ _ x _ -> x|]
diff --git a/yesod-core/Yesod/Routes/TH/RenderRoute.hs b/yesod-core/Yesod/Routes/TH/RenderRoute.hs
index 5177ef20..4da02e08 100644
--- a/yesod-core/Yesod/Routes/TH/RenderRoute.hs
+++ b/yesod-core/Yesod/Routes/TH/RenderRoute.hs
@@ -2,7 +2,6 @@
 module Yesod.Routes.TH.RenderRoute
     ( -- ** RenderRoute
       mkRenderRouteInstance
-    , mkRenderRouteInstance'
     , mkRouteCons
     , mkRenderRouteClauses
     ) where
@@ -148,14 +147,8 @@ mkRenderRouteClauses =
 -- This includes both the 'Route' associated type and the
 -- 'renderRoute' method.  This function uses both 'mkRouteCons' and
 -- 'mkRenderRouteClasses'.
-mkRenderRouteInstance :: Type -> [ResourceTree Type] -> Q [Dec]
-mkRenderRouteInstance = mkRenderRouteInstance' []
-
--- | A more general version of 'mkRenderRouteInstance' which takes an
--- additional context.
-
-mkRenderRouteInstance' :: Cxt -> Type -> [ResourceTree Type] -> Q [Dec]
-mkRenderRouteInstance' cxt typ ress = do
+mkRenderRouteInstance :: Cxt -> Type -> [ResourceTree Type] -> Q [Dec]
+mkRenderRouteInstance cxt typ ress = do
     cls <- mkRenderRouteClauses ress
     (cons, decs) <- mkRouteCons ress
 #if MIN_VERSION_template_haskell(2,12,0)
diff --git a/yesod-core/Yesod/Routes/TH/RouteAttrs.hs b/yesod-core/Yesod/Routes/TH/RouteAttrs.hs
index 0348206a..1b94af95 100644
--- a/yesod-core/Yesod/Routes/TH/RouteAttrs.hs
+++ b/yesod-core/Yesod/Routes/TH/RouteAttrs.hs
@@ -3,7 +3,6 @@
 {-# LANGUAGE RecordWildCards #-}
 module Yesod.Routes.TH.RouteAttrs
     ( mkRouteAttrsInstance
-    , mkRouteAttrsInstance'
     ) where
 
 import Yesod.Routes.TH.Types
@@ -15,11 +14,8 @@ import Data.Text (pack)
 import Control.Applicative ((<$>))
 #endif
 
-mkRouteAttrsInstance :: Type -> [ResourceTree a] -> Q Dec
-mkRouteAttrsInstance = mkRouteAttrsInstance' []
-
-mkRouteAttrsInstance' :: Cxt -> Type -> [ResourceTree a] -> Q Dec
-mkRouteAttrsInstance' cxt typ ress = do
+mkRouteAttrsInstance :: Cxt -> Type -> [ResourceTree a] -> Q Dec
+mkRouteAttrsInstance cxt typ ress = do
     clauses <- mapM (goTree id) ress
     return $ instanceD cxt (ConT ''RouteAttrs `AppT` typ)
         [ FunD 'routeAttrs $ concat clauses
diff --git a/yesod-core/test/Hierarchy.hs b/yesod-core/test/Hierarchy.hs
index c6994f46..1cb0817c 100644
--- a/yesod-core/test/Hierarchy.hs
+++ b/yesod-core/test/Hierarchy.hs
@@ -113,9 +113,9 @@ do
 --  /#Int TrailingIntR GET
 |]
 
-    rrinst <- mkRenderRouteInstance (ConT ''Hierarchy) $ map (fmap parseType) resources
-    rainst <- mkRouteAttrsInstance (ConT ''Hierarchy) $ map (fmap parseType) resources
-    prinst <- mkParseRouteInstance (ConT ''Hierarchy) $ map (fmap parseType) resources
+    rrinst <- mkRenderRouteInstance [] (ConT ''Hierarchy) $ map (fmap parseType) resources
+    rainst <- mkRouteAttrsInstance [] (ConT ''Hierarchy) $ map (fmap parseType) resources
+    prinst <- mkParseRouteInstance [] (ConT ''Hierarchy) $ map (fmap parseType) resources
     dispatch <- mkDispatchClause MkDispatchSettings
         { mdsRunHandler = [|runHandler|]
         , mdsSubDispatcher = [|subDispatch|]
diff --git a/yesod-core/test/RouteSpec.hs b/yesod-core/test/RouteSpec.hs
index 283119e2..973adec2 100644
--- a/yesod-core/test/RouteSpec.hs
+++ b/yesod-core/test/RouteSpec.hs
@@ -80,9 +80,9 @@ do
             [ ResourceLeaf $ Resource "ChildR" [] (Methods Nothing ["GET"]) ["child"] True
             ]
         ress = resParent : resLeaves
-    rrinst <- mkRenderRouteInstance (ConT ''MyApp) ress
-    rainst <- mkRouteAttrsInstance (ConT ''MyApp) ress
-    prinst <- mkParseRouteInstance (ConT ''MyApp) ress
+    rrinst <- mkRenderRouteInstance [] (ConT ''MyApp) ress
+    rainst <- mkRouteAttrsInstance [] (ConT ''MyApp) ress
+    prinst <- mkParseRouteInstance [] (ConT ''MyApp) ress
     dispatch <- mkDispatchClause MkDispatchSettings
         { mdsRunHandler = [|runHandler|]
         , mdsSubDispatcher = [|subDispatch dispatcher|]

From b71bfae261dc912ea58afcbba9c3768637b096e2 Mon Sep 17 00:00:00 2001
From: James Parker <dev@jamesparker.me>
Date: Mon, 22 Jan 2018 00:45:44 -0500
Subject: [PATCH 33/43] Refactor so that mkYesod and mkYesodDispatch use the
 context parser

---
 yesod-core/Yesod/Core/Internal/TH.hs | 47 +++++++++-------------------
 1 file changed, 15 insertions(+), 32 deletions(-)

diff --git a/yesod-core/Yesod/Core/Internal/TH.hs b/yesod-core/Yesod/Core/Internal/TH.hs
index 2b285746..5e0121c8 100644
--- a/yesod-core/Yesod/Core/Internal/TH.hs
+++ b/yesod-core/Yesod/Core/Internal/TH.hs
@@ -16,16 +16,11 @@ import Language.Haskell.TH.Syntax
 import qualified Network.Wai as W
 
 import Data.ByteString.Lazy.Char8 ()
-#if MIN_VERSION_base(4,8,0)
-import Data.List (foldl', uncons)
-#else
 import Data.List (foldl')
-#endif
 #if __GLASGOW_HASKELL__ < 710
 import Control.Applicative ((<$>))
 #endif
 import Control.Monad (replicateM, void)
-import Data.Either (partitionEithers)
 import Text.Parsec (parse, many1, many, eof, try, option, sepBy1)
 import Text.ParserCombinators.Parsec.Char (alphaNum, spaces, string, char)
 
@@ -42,7 +37,7 @@ import Yesod.Core.Internal.Run
 mkYesod :: String -- ^ name of the argument datatype
         -> [ResourceTree String]
         -> Q [Dec]
-mkYesod name = fmap (uncurry (++)) . mkYesodGeneral name [] False return
+mkYesod name = fmap (uncurry (++)) . mkYesodWithParser name False return
 
 {-# DEPRECATED mkYesodWith "Contexts and type variables are now parsed from the name. (https://github.com/yesodweb/yesod/pull/1366)" #-}
 mkYesodWith :: [[String]]
@@ -50,24 +45,29 @@ mkYesodWith :: [[String]]
             -> [String]
             -> [ResourceTree String]
             -> Q [Dec]
-mkYesodWith cxts name args = fmap (uncurry (++)) . mkYesodGeneral' cxts name args False return
+mkYesodWith cxts name args = fmap (uncurry (++)) . mkYesodGeneral cxts name args False return
 
 -- | Sometimes, you will want to declare your routes in one file and define
 -- your handlers elsewhere. For example, this is the only way to break up a
 -- monolithic file into smaller parts. Use this function, paired with
 -- 'mkYesodDispatch', to do just that.
 mkYesodData :: String -> [ResourceTree String] -> Q [Dec]
-mkYesodData name = mkYesodDataGeneral name False
+mkYesodData name resS = fst <$> mkYesodWithParser name False return resS
 
 mkYesodSubData :: String -> [ResourceTree String] -> Q [Dec]
-mkYesodSubData name = mkYesodDataGeneral name True
+mkYesodSubData name resS = fst <$> mkYesodWithParser name True return resS
 
-mkYesodDataGeneral :: String -> Bool -> [ResourceTree String] -> Q [Dec]
-mkYesodDataGeneral name isSub res = do
+-- | Parses contexts and type arguments out of name before generating TH.
+mkYesodWithParser :: String                    -- ^ foundation type
+                  -> Bool                      -- ^ is this a subsite
+                  -> (Exp -> Q Exp)            -- ^ unwrap handler
+                  -> [ResourceTree String]
+                  -> Q([Dec],[Dec])
+mkYesodWithParser name isSub f resS = do
     let (name', rest, cxt) = case parse parseName "" name of
             Left err -> error $ show err
             Right a -> a
-    fst <$> mkYesodGeneral' cxt name' rest isSub return res
+    mkYesodGeneral cxt name' rest isSub f resS
 
     where
         parseName = do
@@ -101,7 +101,7 @@ mkYesodDataGeneral name isSub res = do
 
 -- | See 'mkYesodData'.
 mkYesodDispatch :: String -> [ResourceTree String] -> Q [Dec]
-mkYesodDispatch name = fmap snd . mkYesodGeneral name [] False return
+mkYesodDispatch name = fmap snd . mkYesodWithParser name False return
 
 -- | Get the Handler and Widget type synonyms for the given site.
 masterTypeSyns :: [Name] -> Type -> [Dec]
@@ -112,25 +112,14 @@ masterTypeSyns vs site =
       $ ConT ''WidgetT `AppT` site `AppT` ConT ''IO `AppT` ConT ''()
     ]
 
--- | 'Left' arguments indicate a monomorphic type, a 'Right' argument
---   indicates a polymorphic type, and provides the list of classes
---   the type must be instance of.
-mkYesodGeneral :: String                    -- ^ foundation type
-               -> [String]                  -- ^ arguments for the type
-               -> Bool                      -- ^ is this a subsite
-               -> (Exp -> Q Exp)            -- ^ unwrap handler
-               -> [ResourceTree String]
-               -> Q([Dec],[Dec])
-mkYesodGeneral = mkYesodGeneral' []
-
-mkYesodGeneral' :: [[String]]               -- ^ Appliction context. Used in RenderRoute, RouteAttrs, and ParseRoute instances.
+mkYesodGeneral :: [[String]]                -- ^ Appliction context. Used in RenderRoute, RouteAttrs, and ParseRoute instances.
                -> String                    -- ^ foundation type
                -> [String]                  -- ^ arguments for the type
                -> Bool                      -- ^ is this a subsite
                -> (Exp -> Q Exp)            -- ^ unwrap handler
                -> [ResourceTree String]
                -> Q([Dec],[Dec])
-mkYesodGeneral' appCxt' namestr mtys isSub f resS = do
+mkYesodGeneral appCxt' namestr mtys isSub f resS = do
     let appCxt = fmap (\(c:rest) -> 
 #if MIN_VERSION_template_haskell(2,10,0)
             foldl' (\acc v -> acc `AppT` nameToType v) (ConT $ mkName c) rest
@@ -183,12 +172,6 @@ mkYesodGeneral' appCxt' namestr mtys isSub f resS = do
             ]
     return (dataDec, dispatchDec)
 
-#if !MIN_VERSION_base(4,8,0)
-    where
-        uncons (h:t) = Just (h,t)
-        uncons _ = Nothing
-#endif
-
 mkMDS :: (Exp -> Q Exp) -> Q Exp -> MkDispatchSettings a site b
 mkMDS f rh = MkDispatchSettings
     { mdsRunHandler = rh

From fa8e1ac00f34b371c911e656290cc372da186f63 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 24 Jan 2018 13:01:26 +0200
Subject: [PATCH 34/43] Switch to SubHandlerFor

This is much more consistent than suddenly using a ReaderT for subsites.
Thanks to @jprider63 for the inspiration for this, I think it cleans
things up a lot!
---
 yesod-auth-oauth/Yesod/Auth/OAuth.hs          |  2 +-
 yesod-auth/Yesod/Auth.hs                      |  2 +-
 yesod-core/Yesod/Core.hs                      |  6 --
 yesod-core/Yesod/Core/Class/Dispatch.hs       | 76 +++----------------
 yesod-core/Yesod/Core/Class/Handler.hs        | 28 ++++++-
 yesod-core/Yesod/Core/Handler.hs              | 15 +++-
 yesod-core/Yesod/Core/Internal/Run.hs         | 10 ++-
 yesod-core/Yesod/Core/Types.hs                | 55 ++++++++++++--
 .../test/YesodCoreTest/NoOverloadedStrings.hs |  6 +-
 9 files changed, 111 insertions(+), 89 deletions(-)

diff --git a/yesod-auth-oauth/Yesod/Auth/OAuth.hs b/yesod-auth-oauth/Yesod/Auth/OAuth.hs
index 11e691c8..1a2d1852 100644
--- a/yesod-auth-oauth/Yesod/Auth/OAuth.hs
+++ b/yesod-auth-oauth/Yesod/Auth/OAuth.hs
@@ -52,7 +52,7 @@ authOAuth oauth mkCreds = AuthPlugin name dispatch login
     oauthSessionName = "__oauth_token_secret"
 
     dispatch
-      :: ( MonadSubHandler m
+      :: ( MonadHandler m
          , master ~ HandlerSite m
          , Auth ~ SubHandlerSite m
          , MonadUnliftIO m
diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs
index ae89dd12..baae2e9e 100644
--- a/yesod-auth/Yesod/Auth.hs
+++ b/yesod-auth/Yesod/Auth.hs
@@ -78,7 +78,7 @@ import Control.Monad (void)
 
 type AuthRoute = Route Auth
 
-type MonadAuthHandler master m = (MonadSubHandler m, YesodAuth master, master ~ HandlerSite m, Auth ~ SubHandlerSite m, MonadUnliftIO m)
+type MonadAuthHandler master m = (MonadHandler m, YesodAuth master, master ~ HandlerSite m, Auth ~ SubHandlerSite m, MonadUnliftIO m)
 type AuthHandler master a = forall m. MonadAuthHandler master m => m a
 
 type Method = Text
diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs
index 2aa04b10..13ed2136 100644
--- a/yesod-core/Yesod/Core.hs
+++ b/yesod-core/Yesod/Core.hs
@@ -73,12 +73,6 @@ module Yesod.Core
     , guessApproot
     , guessApprootOr
     , getApprootText
-      -- * Subsites
-    , MonadSubHandler (..)
-    , getSubYesod
-    , getRouteToParent
-    , getSubCurrentRoute
-    , SubsiteData
       -- * Misc
     , yesodVersion
     , yesodRender
diff --git a/yesod-core/Yesod/Core/Class/Dispatch.hs b/yesod-core/Yesod/Core/Class/Dispatch.hs
index be9db709..4abe179c 100644
--- a/yesod-core/Yesod/Core/Class/Dispatch.hs
+++ b/yesod-core/Yesod/Core/Class/Dispatch.hs
@@ -9,10 +9,8 @@ module Yesod.Core.Class.Dispatch where
 import qualified Network.Wai as W
 import Yesod.Core.Types
 import Yesod.Core.Content (ToTypedContent (..))
-import Yesod.Core.Handler (sendWaiApplication, getYesod, getCurrentRoute)
-import Yesod.Core.Class.Handler
+import Yesod.Core.Handler (sendWaiApplication)
 import Yesod.Core.Class.Yesod
-import Control.Monad.Trans.Reader (ReaderT (..))
 
 -- | This class is automatically instantiated when you use the template haskell
 -- mkYesod function. You should never need to deal with it directly.
@@ -35,72 +33,20 @@ instance YesodSubDispatch WaiSubsiteWithAuth master where
       WaiSubsiteWithAuth set = ysreGetSub $ yreSite $ ysreParentEnv
       handlert = sendWaiApplication set
 
-data SubsiteData child parent = SubsiteData
-  { sdRouteToParent :: !(Route child -> Route parent)
-  , sdCurrentRoute :: !(Maybe (Route child))
-  , sdSubsiteData :: !child
-  }
-
-class MonadHandler m => MonadSubHandler m where
-  type SubHandlerSite m
-
-  liftSubHandler :: ReaderT (SubsiteData (SubHandlerSite m) (HandlerSite m)) (HandlerFor (HandlerSite m)) a -> m a
-
-getSubYesod :: MonadSubHandler m => m (SubHandlerSite m)
-getSubYesod = liftSubHandler $ ReaderT $ return . sdSubsiteData
-
-getRouteToParent :: MonadSubHandler m => m (Route (SubHandlerSite m) -> Route (HandlerSite m))
-getRouteToParent = liftSubHandler $ ReaderT $ return . sdRouteToParent
-
-getSubCurrentRoute :: MonadSubHandler m => m (Maybe (Route (SubHandlerSite m)))
-getSubCurrentRoute = liftSubHandler $ ReaderT $ return . sdCurrentRoute
-
-instance MonadSubHandler (HandlerFor site) where
-  type SubHandlerSite (HandlerFor site) = site
-
-  liftSubHandler (ReaderT x) = do
-    parent <- getYesod
-    currentRoute <- getCurrentRoute
-    x SubsiteData
-      { sdRouteToParent = id
-      , sdCurrentRoute = currentRoute
-      , sdSubsiteData = parent
-      }
-
-instance MonadSubHandler (WidgetFor site) where
-  type SubHandlerSite (WidgetFor site) = site
-
-  liftSubHandler (ReaderT x) = do
-    parent <- getYesod
-    currentRoute <- getCurrentRoute
-    liftHandler $ x SubsiteData
-      { sdRouteToParent = id
-      , sdCurrentRoute = currentRoute
-      , sdSubsiteData = parent
-      }
-
-instance (MonadSubHandler m, parent ~ SubHandlerSite m) => MonadSubHandler (ReaderT (SubsiteData child parent) m) where
-  type SubHandlerSite (ReaderT (SubsiteData child parent) m) = child
-
-  liftSubHandler (ReaderT f) = ReaderT $ \env -> do
-    toParent' <- getRouteToParent
-    liftHandler $ f env
-      { sdRouteToParent = toParent' . sdRouteToParent env
-      }
-
 subHelper
   :: ToTypedContent content
-  => ReaderT (SubsiteData child master) (HandlerFor master) content
+  => SubHandlerFor child master content
   -> YesodSubRunnerEnv child master
   -> Maybe (Route child)
   -> W.Application
-subHelper (ReaderT f) YesodSubRunnerEnv {..} mroute =
+subHelper (SubHandlerFor f) YesodSubRunnerEnv {..} mroute =
     ysreParentRunner handler ysreParentEnv (fmap ysreToParentRoute mroute)
   where
-    handler = fmap toTypedContent $ do
-      tm <- getRouteToParent
-      liftHandler $ f SubsiteData
-        { sdRouteToParent = tm . ysreToParentRoute
-        , sdCurrentRoute = mroute
-        , sdSubsiteData = ysreGetSub $ yreSite ysreParentEnv
-        }
+    handler = fmap toTypedContent $ HandlerFor $ \hd ->
+      let rhe = handlerEnv hd
+          rhe' = rhe
+            { rheRoute = mroute
+            , rheChild = ysreGetSub $ yreSite ysreParentEnv
+            , rheRouteToMaster = ysreToParentRoute
+            }
+       in f hd { handlerEnv = rhe' }
diff --git a/yesod-core/Yesod/Core/Class/Handler.hs b/yesod-core/Yesod/Core/Class/Handler.hs
index 97cf1aa7..a67f6b72 100644
--- a/yesod-core/Yesod/Core/Class/Handler.hs
+++ b/yesod-core/Yesod/Core/Class/Handler.hs
@@ -36,7 +36,9 @@ import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )
 -- FIXME should we just use MonadReader instances instead?
 class (MonadResource m, MonadLogger m) => MonadHandler m where
     type HandlerSite m
+    type SubHandlerSite m
     liftHandler :: HandlerFor (HandlerSite m) a -> m a
+    liftSubHandler :: SubHandlerFor (SubHandlerSite m) (HandlerSite m) a -> m a
 
 liftHandlerT :: MonadHandler m => HandlerFor (HandlerSite m) a -> m a
 liftHandlerT = liftHandler
@@ -44,16 +46,38 @@ liftHandlerT = liftHandler
 
 instance MonadHandler (HandlerFor site) where
     type HandlerSite (HandlerFor site) = site
+    type SubHandlerSite (HandlerFor site) = site
     liftHandler = id
     {-# INLINE liftHandler #-}
+    liftSubHandler (SubHandlerFor f) = HandlerFor f
+    {-# INLINE liftSubHandler #-}
+
+instance MonadHandler (SubHandlerFor sub master) where
+    type HandlerSite (SubHandlerFor sub master) = master
+    type SubHandlerSite (SubHandlerFor sub master) = sub
+    liftHandler (HandlerFor f) = SubHandlerFor $ \hd -> f hd
+      { handlerEnv =
+          let rhe = handlerEnv hd
+           in rhe
+                { rheRoute = fmap (rheRouteToMaster rhe) (rheRoute rhe)
+                , rheRouteToMaster = id
+                , rheChild = rheSite rhe
+                }
+      }
+    {-# INLINE liftHandler #-}
+    liftSubHandler = id
+    {-# INLINE liftSubHandler #-}
 
 instance MonadHandler (WidgetFor site) where
     type HandlerSite (WidgetFor site) = site
+    type SubHandlerSite (WidgetFor site) = site
     liftHandler (HandlerFor f) = WidgetFor $ f . wdHandler
     {-# INLINE liftHandler #-}
+    liftSubHandler (SubHandlerFor f) = WidgetFor $ f . wdHandler
+    {-# INLINE liftSubHandler #-}
 
-#define GO(T) instance MonadHandler m => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandler = lift . liftHandler
-#define GOX(X, T) instance (X, MonadHandler m) => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandler = lift . liftHandler
+#define GO(T) instance MonadHandler m => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; type SubHandlerSite (T m) = SubHandlerSite m; liftHandler = lift . liftHandler; liftSubHandler = lift . liftSubHandler
+#define GOX(X, T) instance (X, MonadHandler m) => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; type SubHandlerSite (T m) = SubHandlerSite m; liftHandler = lift . liftHandler; liftSubHandler = lift . liftSubHandler
 GO(IdentityT)
 GO(ListT)
 GO(MaybeT)
diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs
index 67f99216..4673a82e 100644
--- a/yesod-core/Yesod/Core/Handler.hs
+++ b/yesod-core/Yesod/Core/Handler.hs
@@ -147,6 +147,10 @@ module Yesod.Core.Handler
     , setMessage
     , setMessageI
     , getMessage
+      -- * Subsites
+    , getSubYesod
+    , getRouteToParent
+    , getSubCurrentRoute
       -- * Helpers for specific content
       -- ** Hamlet
     , hamletToRepHtml
@@ -321,7 +325,7 @@ rbHelper' backend mkFI req =
             | otherwise = a'
     go = decodeUtf8With lenientDecode
 
-askHandlerEnv :: MonadHandler m => m (RunHandlerEnv (HandlerSite m))
+askHandlerEnv :: MonadHandler m => m (RunHandlerEnv (HandlerSite m) (HandlerSite m))
 askHandlerEnv = liftHandler $ HandlerFor $ return . handlerEnv
 
 -- | Get the master site application argument.
@@ -1593,3 +1597,12 @@ csrfErrorMessage expectedLocations = T.intercalate "\n"
         formatValue maybeText = case maybeText of
           Nothing -> "(which is not currently set)"
           Just t -> T.concat ["(which has the current, incorrect value: '", t, "')"]
+
+getSubYesod :: MonadHandler m => m (SubHandlerSite m)
+getSubYesod = liftSubHandler $ SubHandlerFor $ return . rheChild . handlerEnv
+
+getRouteToParent :: MonadHandler m => m (Route (SubHandlerSite m) -> Route (HandlerSite m))
+getRouteToParent = liftSubHandler $ SubHandlerFor $ return . rheRouteToMaster . handlerEnv
+
+getSubCurrentRoute :: MonadHandler m => m (Maybe (Route (SubHandlerSite m)))
+getSubCurrentRoute = liftSubHandler $ SubHandlerFor $ return . rheRoute . handlerEnv
diff --git a/yesod-core/Yesod/Core/Internal/Run.hs b/yesod-core/Yesod/Core/Internal/Run.hs
index 0fdcaf5c..5d9aa475 100644
--- a/yesod-core/Yesod/Core/Internal/Run.hs
+++ b/yesod-core/Yesod/Core/Internal/Run.hs
@@ -64,7 +64,7 @@ errFromShow x = do
 -- exceptions, but all other synchronous exceptions will be caught and
 -- represented by the @HandlerContents@.
 basicRunHandler :: ToTypedContent c
-                => RunHandlerEnv site
+                => RunHandlerEnv site site
                 -> HandlerFor site c
                 -> YesodRequest
                 -> InternalState
@@ -107,7 +107,7 @@ basicRunHandler rhe handler yreq resState = do
         }
 
 -- | Convert an @ErrorResponse@ into a @YesodResponse@
-handleError :: RunHandlerEnv site
+handleError :: RunHandlerEnv sub site
             -> YesodRequest
             -> InternalState
             -> Map.Map Text S8.ByteString
@@ -188,7 +188,7 @@ evalFallback contents val = catchAny
 -- | Function used internally by Yesod in the process of converting a
 -- 'HandlerT' into an 'Application'. Should not be needed by users.
 runHandler :: ToTypedContent c
-           => RunHandlerEnv site
+           => RunHandlerEnv site site
            -> HandlerFor site c
            -> YesodApp
 runHandler rhe@RunHandlerEnv {..} handler yreq = withInternalState $ \resState -> do
@@ -255,6 +255,8 @@ runFakeHandler fakeSessionMap logger site handler = liftIO $ do
          RunHandlerEnv
             { rheRender = yesodRender site $ resolveApproot site fakeWaiRequest
             , rheRoute = Nothing
+            , rheRouteToMaster = id
+            , rheChild = site
             , rheSite = site
             , rheUpload = fileUpload site
             , rheLog = messageLoggerSource site $ logger site
@@ -329,6 +331,8 @@ yesodRunner handler' YesodRunnerEnv {..} route req sendResponse
         rheSafe = RunHandlerEnv
             { rheRender = yesodRender yreSite ra
             , rheRoute = route
+            , rheRouteToMaster = id
+            , rheChild = yreSite
             , rheSite = yreSite
             , rheUpload = fileUpload yreSite
             , rheLog = log'
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index 51d9bbe8..2bdf4072 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -175,10 +175,12 @@ newtype WaiSubsite = WaiSubsite { runWaiSubsite :: W.Application }
 -- @since 1.4.34
 newtype WaiSubsiteWithAuth = WaiSubsiteWithAuth { runWaiSubsiteWithAuth :: W.Application }
 
-data RunHandlerEnv site = RunHandlerEnv
+data RunHandlerEnv child site = RunHandlerEnv
     { rheRender   :: !(Route site -> [(Text, Text)] -> Text)
-    , rheRoute    :: !(Maybe (Route site))
+    , rheRoute    :: !(Maybe (Route child))
+    , rheRouteToMaster :: !(Route child -> Route site)
     , rheSite     :: !site
+    , rheChild    :: !child
     , rheUpload   :: !(RequestBodyLength -> FileUpload)
     , rheLog      :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ())
     , rheOnError  :: !(ErrorResponse -> YesodApp)
@@ -188,9 +190,9 @@ data RunHandlerEnv site = RunHandlerEnv
     , rheMaxExpires :: !Text
     }
 
-data HandlerData site = HandlerData
+data HandlerData child site = HandlerData
     { handlerRequest  :: !YesodRequest
-    , handlerEnv      :: !(RunHandlerEnv site)
+    , handlerEnv      :: !(RunHandlerEnv child site)
     , handlerState    :: !(IORef GHState)
     , handlerResource :: !InternalState
     }
@@ -220,7 +222,7 @@ type ParentRunner parent
 -- | A generic handler monad, which can have a different subsite and master
 -- site. We define a newtype for better error message.
 newtype HandlerFor site a = HandlerFor
-    { unHandlerFor :: HandlerData site -> IO a
+    { unHandlerFor :: HandlerData site site -> IO a
     }
     deriving Functor
 
@@ -248,7 +250,7 @@ newtype WidgetFor site a = WidgetFor
 
 data WidgetData site = WidgetData
   { wdRef :: {-# UNPACK #-} !(IORef (GWData (Route site)))
-  , wdHandler :: {-# UNPACK #-} !(HandlerData site)
+  , wdHandler :: {-# UNPACK #-} !(HandlerData site site)
   }
 
 instance a ~ () => Monoid (WidgetFor site a) where
@@ -446,7 +448,7 @@ instance Monad (HandlerFor site) where
     HandlerFor x >>= f = HandlerFor $ \r -> x r >>= \x' -> unHandlerFor (f x') r
 instance MonadIO (HandlerFor site) where
     liftIO = HandlerFor . const
-instance MonadReader (HandlerData site) (HandlerFor site) where
+instance MonadReader (HandlerData site site) (HandlerFor site) where
     ask = HandlerFor return
     local f (HandlerFor g) = HandlerFor $ g . f
 
@@ -499,3 +501,42 @@ data Logger = Logger
 
 loggerPutStr :: Logger -> LogStr -> IO ()
 loggerPutStr (Logger ls _) = pushLogStr ls
+
+-- | A handler monad for subsite
+--
+-- @since 1.6.0
+newtype SubHandlerFor sub master a = SubHandlerFor
+    { unSubHandlerFor :: HandlerData sub master -> IO a
+    }
+    deriving Functor
+
+instance Applicative (SubHandlerFor child master) where
+    pure = SubHandlerFor . const . return
+    (<*>) = ap
+instance Monad (SubHandlerFor child master) where
+    return = pure
+    SubHandlerFor x >>= f = SubHandlerFor $ \r -> x r >>= \x' -> unSubHandlerFor (f x') r
+instance MonadIO (SubHandlerFor child master) where
+    liftIO = SubHandlerFor . const
+instance MonadReader (HandlerData child master) (SubHandlerFor child master) where
+    ask = SubHandlerFor return
+    local f (SubHandlerFor g) = SubHandlerFor $ g . f
+
+-- | @since 1.4.38
+instance MonadUnliftIO (SubHandlerFor child master) where
+  {-# INLINE askUnliftIO #-}
+  askUnliftIO = SubHandlerFor $ \r ->
+                return (UnliftIO (flip unSubHandlerFor r))
+
+instance MonadThrow (SubHandlerFor child master) where
+    throwM = liftIO . throwM
+
+instance MonadResource (SubHandlerFor child master) where
+    liftResourceT f = SubHandlerFor $ runInternalState f . handlerResource
+
+instance MonadLogger (SubHandlerFor child master) where
+    monadLoggerLog a b c d = SubHandlerFor $ \sd ->
+        rheLog (handlerEnv sd) a b c (toLogStr d)
+
+instance MonadLoggerIO (SubHandlerFor child master) where
+    askLoggerIO = SubHandlerFor $ return . rheLog . handlerEnv
diff --git a/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs b/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs
index 11d3a145..0a980c87 100644
--- a/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs
+++ b/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs
@@ -21,13 +21,13 @@ import qualified Data.ByteString.Lazy.Char8 as L8
 getSubsite :: a -> Subsite
 getSubsite _ = Subsite $(mkYesodSubDispatch resourcesSubsite)
 
-getBarR :: MonadSubHandler m => m T.Text
+getBarR :: MonadHandler m => m T.Text
 getBarR = return $ T.pack "BarR"
 
-getBazR :: (MonadSubHandler m, Yesod (HandlerSite m)) => m Html
+getBazR :: (MonadHandler m, Yesod (HandlerSite m)) => m Html
 getBazR = liftHandler $ defaultLayout [whamlet|Used Default Layout|]
 
-getBinR :: (MonadSubHandler m, Yesod (HandlerSite m), SubHandlerSite m ~ Subsite) => m Html
+getBinR :: (MonadHandler m, Yesod (HandlerSite m), SubHandlerSite m ~ Subsite) => m Html
 getBinR = do
     routeToParent <- getRouteToParent
     liftHandler $ defaultLayout [whamlet|

From 8796310eef8d827fc275cd5a334a1010b3462be3 Mon Sep 17 00:00:00 2001
From: James Parker <dev@jamesparker.me>
Date: Wed, 24 Jan 2018 23:55:57 -0500
Subject: [PATCH 35/43] More documentation for `mkYesod` and `mkYesodWith`

---
 yesod-core/Yesod/Core/Internal/TH.hs | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

diff --git a/yesod-core/Yesod/Core/Internal/TH.hs b/yesod-core/Yesod/Core/Internal/TH.hs
index 5e0121c8..08d144c6 100644
--- a/yesod-core/Yesod/Core/Internal/TH.hs
+++ b/yesod-core/Yesod/Core/Internal/TH.hs
@@ -32,17 +32,23 @@ import Yesod.Core.Class.Dispatch
 import Yesod.Core.Internal.Run
 
 -- | Generates URL datatype and site function for the given 'Resource's. This
--- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter.
+-- is used for creating sites, /not/ subsites. See 'mkYesodSubData' and 'mkYesodSubDispatch' for the latter.
 -- Use 'parseRoutes' to create the 'Resource's.
+--
+-- Contexts and type variables in the name of the datatype are parsed. 
+-- For example, a datatype @App a@ with typeclass constraint @MyClass a@ can be written as @\"(MyClass a) => App a\"@.
 mkYesod :: String -- ^ name of the argument datatype
         -> [ResourceTree String]
         -> Q [Dec]
 mkYesod name = fmap (uncurry (++)) . mkYesodWithParser name False return
 
-{-# DEPRECATED mkYesodWith "Contexts and type variables are now parsed from the name. (https://github.com/yesodweb/yesod/pull/1366)" #-}
-mkYesodWith :: [[String]]
-            -> String
-            -> [String]
+{-# DEPRECATED mkYesodWith "Contexts and type variables are now parsed from the name in `mkYesod`. <https://github.com/yesodweb/yesod/pull/1366>" #-}
+-- | Similar to 'mkYesod', except contexts and type variables are not parsed. 
+-- Instead, they are explicitly provided. 
+-- You can write @(MyClass a) => App a@ with @mkYesodWith [[\"MyClass\",\"a\"]] \"App\" [\"a\"] ...@.
+mkYesodWith :: [[String]] -- ^ list of contexts
+            -> String -- ^ name of the argument datatype
+            -> [String] -- ^ list of type variables
             -> [ResourceTree String]
             -> Q [Dec]
 mkYesodWith cxts name args = fmap (uncurry (++)) . mkYesodGeneral cxts name args False return

From 70d606c820272bd540008d8dc0b14144eda18952 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 2 Feb 2018 00:04:15 +0200
Subject: [PATCH 36/43] Updated stack.yaml

---
 stack.yaml | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/stack.yaml b/stack.yaml
index 469cf4cd..e7c28619 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -14,8 +14,19 @@ packages:
   - ./yesod-eventsource
   - ./yesod-websockets
 extra-deps:
-- conduit-extra-1.2.2
 - unliftio-core-0.1.1.0
 - unliftio-0.2.4.0
 - authenticate-1.3.4
-- typed-process-0.2.0.0
+- typed-process-0.2.1.0
+- conduit-1.3.0
+- conduit-extra-1.3.0
+- persistent-2.8.0
+- resourcet-1.2.0
+- mono-traversable-1.0.8.1
+- yaml-0.8.28
+- project-template-0.2.0.1
+- xml-conduit-1.8.0
+- wai-extra-3.0.22.0
+- monad-logger-0.3.28.1
+- html-conduit-1.3.0
+- http-conduit-2.3.0

From 7f78e81cc155e47fec852a51a3fa4a60e0b7ce6b Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 2 Feb 2018 00:15:24 +0200
Subject: [PATCH 37/43] Lower bounds and missing extra-deps

---
 stack.yaml                              | 2 ++
 yesod-core/yesod-core.cabal             | 2 +-
 yesod-persistent/yesod-persistent.cabal | 2 +-
 3 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/stack.yaml b/stack.yaml
index e7c28619..9bf51834 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -30,3 +30,5 @@ extra-deps:
 - monad-logger-0.3.28.1
 - html-conduit-1.3.0
 - http-conduit-2.3.0
+- persistent-sqlite-2.8.0
+- cookie-0.4.3
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index e4bec214..9e825435 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -38,7 +38,7 @@ library
                    , old-locale            >= 1.0.0.2  && < 1.1
                    , containers            >= 0.2
                    , unordered-containers  >= 0.2
-                   , cookie                >= 0.4.2    && < 0.5
+                   , cookie                >= 0.4.3    && < 0.5
                    , http-types            >= 0.7
                    , case-insensitive      >= 0.2
                    , parsec                >= 2        && < 3.2
diff --git a/yesod-persistent/yesod-persistent.cabal b/yesod-persistent/yesod-persistent.cabal
index 353fac6e..daf5ae4b 100644
--- a/yesod-persistent/yesod-persistent.cabal
+++ b/yesod-persistent/yesod-persistent.cabal
@@ -36,7 +36,7 @@ test-suite test
                  , hspec
                  , wai-extra
                  , yesod-core
-                 , persistent-sqlite
+                 , persistent-sqlite >= 2.8
                  , yesod-persistent
                  , conduit
                  , blaze-builder

From 5d49a85f40b44b5fb9b4136924edd71615948f7c Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 2 Feb 2018 00:35:21 +0200
Subject: [PATCH 38/43] Travis update

---
 .travis.yml | 100 +++++++++++++++++++++++-----------------------------
 1 file changed, 44 insertions(+), 56 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index ab790d0b..224aeb3c 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -11,7 +11,7 @@
 # Use new container infrastructure to enable caching
 sudo: false
 
-# Choose a lightweight base image; we provide our own build tools.
+# Do not choose a language; we provide our own build tools.
 language: generic
 
 # Caching so the next build will be fast too.
@@ -35,27 +35,12 @@ matrix:
   include:
   # We grab the appropriate GHC and cabal-install versions from hvr's PPA. See:
   # https://github.com/hvr/multi-ghc-travis
-  #- env: BUILD=cabal GHCVER=7.0.4 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7
-  #  compiler: ": #GHC 7.0.4"
-  #  addons: {apt: {packages: [cabal-install-1.16,ghc-7.0.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
-  #- env: BUILD=cabal GHCVER=7.2.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7
-  #  compiler: ": #GHC 7.2.2"
-  #  addons: {apt: {packages: [cabal-install-1.16,ghc-7.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
-  #- env: BUILD=cabal GHCVER=7.4.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7
-  #  compiler: ": #GHC 7.4.2"
-  #  addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
-  #- env: BUILD=cabal GHCVER=7.6.3 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7
-  #  compiler: ": #GHC 7.6.3"
-  #  addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
-  - env: BUILD=cabal GHCVER=7.8.4 CABALVER=1.18 HAPPYVER=1.19.5 ALEXVER=3.1.7
-    compiler: ": #GHC 7.8.4"
-    addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
-  - env: BUILD=cabal GHCVER=7.10.3 CABALVER=1.22 HAPPYVER=1.19.5 ALEXVER=3.1.7
-    compiler: ": #GHC 7.10.3"
-    addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
   - env: BUILD=cabal GHCVER=8.0.2 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7
     compiler: ": #GHC 8.0.2"
     addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
+  - env: BUILD=cabal GHCVER=8.2.2 CABALVER=2.0 HAPPYVER=1.19.5 ALEXVER=3.1.7
+    compiler: ": #GHC 8.2.2"
+    addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
 
   # Build with the newest GHC and cabal-install. This is an accepted failure,
   # see below.
@@ -69,32 +54,40 @@ matrix:
     compiler: ": #stack default"
     addons: {apt: {packages: [libgmp-dev]}}
 
-  - env: BUILD=stack ARGS="--resolver lts-6"
-    compiler: ": #stack 7.10.3"
+  - env: BUILD=stack ARGS="--resolver lts-7"
+    compiler: ": #stack 8.0.1"
     addons: {apt: {packages: [libgmp-dev]}}
 
-  - env: BUILD=stack ARGS="--resolver lts-8"
+  - env: BUILD=stack ARGS="--resolver lts-9"
     compiler: ": #stack 8.0.2"
     addons: {apt: {packages: [libgmp-dev]}}
 
+  - env: BUILD=stack ARGS="--resolver lts-10"
+    compiler: ": #stack 8.2.2"
+    addons: {apt: {packages: [libgmp-dev]}}
+
   # Nightly builds are allowed to fail
   - env: BUILD=stack ARGS="--resolver nightly"
     compiler: ": #stack nightly"
     addons: {apt: {packages: [libgmp-dev]}}
 
-  # Build on OS X in addition to Linux
+  # Build on macOS in addition to Linux
   - env: BUILD=stack ARGS=""
     compiler: ": #stack default osx"
     os: osx
 
-  - env: BUILD=stack ARGS="--resolver lts-6"
-    compiler: ": #stack 7.10.3 osx"
+  - env: BUILD=stack ARGS="--resolver lts-7"
+    compiler: ": #stack 8.0.1 osx"
     os: osx
 
-  - env: BUILD=stack ARGS="--resolver lts-8"
+  - env: BUILD=stack ARGS="--resolver lts-9"
     compiler: ": #stack 8.0.2 osx"
     os: osx
 
+  - env: BUILD=stack ARGS="--resolver lts-10"
+    compiler: ": #stack 8.2.2 osx"
+    os: osx
+
   - env: BUILD=stack ARGS="--resolver nightly"
     compiler: ": #stack nightly osx"
     os: osx
@@ -102,8 +95,6 @@ matrix:
   allow_failures:
   - env: BUILD=cabal GHCVER=head  CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7
   - env: BUILD=stack ARGS="--resolver nightly"
-  - env: BUILD=cabal GHCVER=7.8.4 CABALVER=1.18 HAPPYVER=1.19.5 ALEXVER=3.1.7
-  - env: BUILD=cabal GHCVER=7.10.3 CABALVER=1.22 HAPPYVER=1.19.5 ALEXVER=3.1.7
 
 before_install:
 # Using compiler above sets CC to an invalid value, so unset it
@@ -139,11 +130,28 @@ install:
 - if [ -f configure.ac ]; then autoreconf -i; fi
 - |
   set -ex
-  if [ "$ARGS" = "--resolver nightly" ]
-  then
-    stack --install-ghc $ARGS build cabal-install
-    stack --install-ghc $ARGS solver --update-config
-  fi
+  case "$BUILD" in
+    stack)
+      # Add in extra-deps for older snapshots, as necessary
+      stack --no-terminal --install-ghc $ARGS test --bench --dry-run || ( \
+        stack --no-terminal $ARGS build cabal-install && \
+        stack --no-terminal $ARGS solver --update-config)
+
+      # Build the dependencies
+      stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies
+      ;;
+    cabal)
+      cabal --version
+      travis_retry cabal update
+
+      # Get the list of packages from the stack.yaml file. Note that
+      # this will also implicitly run hpack as necessary to generate
+      # the .cabal files needed by cabal-install.
+      PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@')
+
+      cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES
+      ;;
+  esac
   set +ex
 
 script:
@@ -151,30 +159,9 @@ script:
   set -ex
   case "$BUILD" in
     stack)
-      if [ `uname` = "Darwin" ]
-      then
-        # Build dependencies with -O0 as well
-        echo "apply-ghc-options: everything" >> stack.yaml
-
-        # Avoid OOM for building Cabal
-        stack --install-ghc --no-terminal $ARGS build Cabal --fast
-
-        # Use slightly less intensive options on OS X due to Travis timeouts
-        stack --install-ghc --no-terminal $ARGS test --fast
-      else
-        # Avoid OOM for building Cabal
-        stack --install-ghc --no-terminal $ARGS build Cabal --fast
-
-        stack --install-ghc --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps --pedantic
-      fi
+      stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps
       ;;
     cabal)
-      cabal --version
-      travis_retry cabal update
-
-      # Get the list of packages from the stack.yaml file
-      PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@')
-
       cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES
 
       ORIGDIR=$(pwd)
@@ -188,8 +175,9 @@ script:
         cd dist
         tar zxfv "$SRC_TGZ"
         cd "$PKGVER"
-        cabal configure --enable-tests
+        cabal configure --enable-tests --ghc-options -O0
         cabal build
+        cabal test
         cd $ORIGDIR
       done
       ;;

From c2f9dec1e68656c287b08db9bdbf5cca118725ff Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 2 Feb 2018 00:35:28 +0200
Subject: [PATCH 39/43] Tighten base lower bound

Technically unnecessary since it's inherited from conduit, but this is
more explicit.
---
 yesod-core/yesod-core.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index 9e825435..abefefcf 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -21,7 +21,7 @@ extra-source-files:
   README.md
 
 library
-    build-depends:   base                  >= 4.7      && < 5
+    build-depends:   base                  >= 4.9      && < 5
                    , time                  >= 1.5
                    , wai                   >= 3.0
                    , wai-extra             >= 3.0.7

From 42e73e0bfd4c4ac223e03437834941ccd03d3b4b Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 2 Feb 2018 00:36:57 +0200
Subject: [PATCH 40/43] Add gauge and basement to extra-deps

---
 stack.yaml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/stack.yaml b/stack.yaml
index 9bf51834..50e2fbaa 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -32,3 +32,5 @@ extra-deps:
 - http-conduit-2.3.0
 - persistent-sqlite-2.8.0
 - cookie-0.4.3
+- gauge-0.2.1
+- basement-0.0.6

From 3ff2f17b2c1731b4ea9af23e35a1c38718827f79 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 2 Feb 2018 09:41:08 +0200
Subject: [PATCH 41/43] cabal builds: comment out longer test part

---
 .travis.yml | 33 +++++++++++++++++----------------
 1 file changed, 17 insertions(+), 16 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index 224aeb3c..e9e0b6d7 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -164,22 +164,23 @@ script:
     cabal)
       cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES
 
-      ORIGDIR=$(pwd)
-      for dir in $PACKAGES
-      do
-        cd $dir
-        cabal check || [ "$CABALVER" == "1.16" ]
-        cabal sdist
-        PKGVER=$(cabal info . | awk '{print $2;exit}')
-        SRC_TGZ=$PKGVER.tar.gz
-        cd dist
-        tar zxfv "$SRC_TGZ"
-        cd "$PKGVER"
-        cabal configure --enable-tests --ghc-options -O0
-        cabal build
-        cabal test
-        cd $ORIGDIR
-      done
+      # Times out
+      #ORIGDIR=$(pwd)
+      #for dir in $PACKAGES
+      #do
+      #  cd $dir
+      #  cabal check || [ "$CABALVER" == "1.16" ]
+      #  cabal sdist
+      #  PKGVER=$(cabal info . | awk '{print $2;exit}')
+      #  SRC_TGZ=$PKGVER.tar.gz
+      #  cd dist
+      #  tar zxfv "$SRC_TGZ"
+      #  cd "$PKGVER"
+      #  cabal configure --enable-tests --ghc-options -O0
+      #  cabal build
+      #  cabal test
+      #  cd $ORIGDIR
+      #done
       ;;
   esac
   set +ex

From 2317e078512be5497910c720142d3f4ef5b6ed0a Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 2 Feb 2018 09:45:00 +0200
Subject: [PATCH 42/43] Add foundation as an extra-dep

---
 stack.yaml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/stack.yaml b/stack.yaml
index 50e2fbaa..1ef50427 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -34,3 +34,4 @@ extra-deps:
 - cookie-0.4.3
 - gauge-0.2.1
 - basement-0.0.6
+- foundation-0.0.19

From 6b660412e93d8678d50172958b0f541a6f6258db Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 2 Feb 2018 10:07:45 +0200
Subject: [PATCH 43/43] memory extra-dep

---
 stack.yaml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/stack.yaml b/stack.yaml
index 1ef50427..c97d7cb5 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -35,3 +35,4 @@ extra-deps:
 - gauge-0.2.1
 - basement-0.0.6
 - foundation-0.0.19
+- memory-0.14.14