diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs
index 2f442db..b13e2af 100644
--- a/src/Vervis/Federation.hs
+++ b/src/Vervis/Federation.hs
@@ -1903,7 +1903,7 @@ retryOutboxDelivery = do
         = map (second $ groupWithExtractBy1 ((==) `on` fst) fst snd)
         . groupWithExtractBy ((==) `on` fst) fst snd
     fork action = do
-        wait <- asyncSite action
+        wait <- asyncWorker action
         return $ do
             result <- wait
             case result of
diff --git a/src/Yesod/MonadSite.hs b/src/Yesod/MonadSite.hs
index 867a665..a1b1062 100644
--- a/src/Yesod/MonadSite.hs
+++ b/src/Yesod/MonadSite.hs
@@ -26,6 +26,7 @@ module Yesod.MonadSite
     , WorkerFor
     , runWorker
     , forkWorker
+    , asyncWorker
     )
 where
 
@@ -37,6 +38,7 @@ import Control.Monad.IO.Class
 import Control.Monad.IO.Unlift
 import Control.Monad.Logger.CallStack
 import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except
 import Control.Monad.Trans.Reader
 import Data.Functor
 import Data.Text (Text)
@@ -47,6 +49,7 @@ import Yesod.Core hiding (logError)
 import Yesod.Core.Types
 import Yesod.Persist.Core
 
+import qualified Control.Monad.Trans.RWS.Lazy as RWSL
 import qualified Data.Text as T
 
 class PersistConfig (SitePersistConfig site) => Site site where
@@ -56,18 +59,35 @@ class PersistConfig (SitePersistConfig site) => Site site where
     sitePersistPool   :: site -> PersistConfigPool (SitePersistConfig site)
     siteLogger        :: site -> Logger
 
-class (MonadUnliftIO m, MonadLogger m) => MonadSite m where
+class (MonadIO m, MonadLogger m) => MonadSite m where
     type SiteEnv m
     askSite      :: m (SiteEnv m)
     askUrlRender :: m (Route (SiteEnv m) -> Text)
+    {-
     forkSite     :: (SomeException -> m ()) -> m () -> m ()
     asyncSite    :: m a -> m (m (Either SomeException a))
+    -}
+
+instance MonadSite m => MonadSite (ReaderT r m) where
+    type SiteEnv (ReaderT r m) = SiteEnv m
+    askSite                    = lift askSite
+    askUrlRender               = lift askUrlRender
+
+instance MonadSite m => MonadSite (ExceptT e m) where
+    type SiteEnv (ExceptT e m) = SiteEnv m
+    askSite                    = lift askSite
+    askUrlRender               = lift askUrlRender
+
+instance (Monoid w, MonadSite m) => MonadSite (RWSL.RWST r w s m) where
+    type SiteEnv (RWSL.RWST r w s m) = SiteEnv m
+    askSite                          = lift askSite
+    askUrlRender                     = lift askUrlRender
 
 asksSite :: MonadSite m => (SiteEnv m -> a) -> m a
 asksSite f = f <$> askSite
 
 runSiteDB
-    :: (MonadSite m, Site (SiteEnv m))
+    :: (MonadUnliftIO m, MonadSite m, Site (SiteEnv m))
     => PersistConfigBackend (SitePersistConfig (SiteEnv m)) m a
     -> m a
 runSiteDB action = do
@@ -78,6 +98,7 @@ instance MonadSite (HandlerFor site) where
     type SiteEnv (HandlerFor site) = site
     askSite = getYesod
     askUrlRender = getUrlRender
+    {-
     forkSite = forkHandler
     asyncSite action = do
         mvar <- newEmptyMVar
@@ -86,6 +107,12 @@ instance MonadSite (HandlerFor site) where
             result <- action
             putMVar mvar $ Right result
         return $ liftIO $ readMVar mvar
+    -}
+
+instance MonadSite (WidgetFor site) where
+    type SiteEnv (WidgetFor site) = site
+    askSite = getYesod
+    askUrlRender = getUrlRender
 
 newtype WorkerT site m a = WorkerT
     { unWorkerT :: LoggingT (ReaderT site m) a
@@ -111,11 +138,13 @@ instance (MonadUnliftIO m, Yesod site, Site site) => MonadSite (WorkerT site m)
     askUrlRender = do
         site <- askSite
         return $ \ route -> yesodRender site (siteApproot site) route []
+    {-
     forkSite handler action = void $ forkFinally action handler'
         where
         handler' (Left e)  = handler e
         handler' (Right _) = pure ()
     asyncSite action = waitCatch <$> async action
+    -}
 
 runWorkerT :: (Yesod site, Site site) => WorkerT site m a -> site -> m a
 runWorkerT (WorkerT action) site = runReaderT (runLoggingT action logFunc) site
@@ -143,3 +172,11 @@ forkWorker err worker = do
                     "Worker thread threw exception: " <> err <> ": " <>
                     T.pack (displayException e)
             Right _ -> return ()
+
+asyncWorker
+    :: (MonadSite m, SiteEnv m ~ site, Yesod site, Site site)
+    => WorkerFor site a
+    -> m (m (Either SomeException a))
+asyncWorker worker = do
+    site <- askSite
+    liftIO $ waitCatch <$> async (runWorker worker site)