    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TupleSections #-}

    module Yesod.Core.Internal.Run
      ( toErrorHandler
      , errFromShow
      , basicRunHandler
      , handleError
      , handleContents
      , evalFallback
      , runHandler
      , safeEh
      , runFakeHandler
      , yesodRunner
      , yesodRender
      , resolveApproot
      )
      where

    import           Yesod.Core.Internal.Response
    import           Data.ByteString.Builder      (toLazyByteString)
    import qualified Data.ByteString.Lazy         as BL
    import           Control.Monad.IO.Class       (MonadIO, liftIO)
    import           Control.Monad.Logger         (LogLevel (LevelError), LogSource,
                                                   liftLoc)
    import           Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, InternalState)
    import qualified Data.ByteString              as S
    import qualified Data.ByteString.Char8        as S8
    import qualified Data.IORef                   as I
    import qualified Data.Map                     as Map
    import           Data.Maybe                   (isJust, fromMaybe)
    import           Data.Monoid                  (appEndo)
    import           Data.Text                    (Text)
    import qualified Data.Text                    as T
    import           Data.Text.Encoding           (encodeUtf8, decodeUtf8With)
    import           Data.Text.Encoding.Error     (lenientDecode)
    import           Language.Haskell.TH.Syntax   (Loc, qLocation)
    import qualified Network.HTTP.Types           as H
    import           Network.Wai
    import           System.Log.FastLogger        (LogStr, toLogStr)
    import           Yesod.Core.Content
    import           Yesod.Core.Class.Yesod
    import           Yesod.Core.Types
    import           Yesod.Core.Internal.Request  (parseWaiRequest,
                                                   tooLargeResponse)
    import           Yesod.Core.Internal.Util     (getCurrentMaxExpiresRFC1123)
    import           Yesod.Routes.Class           (RenderRoute (..))
    import           Control.DeepSeq              (($!!), NFData)
    import           UnliftIO.Exception

    -- | Convert a synchronous exception into an ErrorResponse
    toErrorHandler :: SomeException -> IO ErrorResponse
    toErrorHandler :: SomeException -> IO ErrorResponse
    toErrorHandler SomeException
    e0 = (SomeException -> IO ErrorResponse)
    -> IO ErrorResponse -> IO ErrorResponse
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    (SomeException -> m a) -> m a -> m a
    handleAny SomeException -> IO ErrorResponse
    errFromShow (IO ErrorResponse -> IO ErrorResponse)
    -> IO ErrorResponse -> IO ErrorResponse
    forall a b. (a -> b) -> a -> b
    $
        case SomeException -> Maybe HandlerContents
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e0 of
            Just (HCError ErrorResponse
    x) -> ErrorResponse -> IO ErrorResponse
    forall (m :: * -> *) a. MonadIO m => a -> m a
    evaluate (ErrorResponse -> IO ErrorResponse)
    -> ErrorResponse -> IO ErrorResponse
    forall a b. NFData a => (a -> b) -> a -> b
    $!! ErrorResponse
    x
            Maybe HandlerContents
    _ -> SomeException -> IO ErrorResponse
    errFromShow SomeException
    e0

    -- | Generate an @ErrorResponse@ based on the shown version of the exception
    errFromShow :: SomeException -> IO ErrorResponse
    errFromShow :: SomeException -> IO ErrorResponse
    errFromShow SomeException
    x = do
      text <- LogSource -> IO LogSource
    forall (m :: * -> *) a. MonadIO m => a -> m a
    evaluate ([Char] -> LogSource
    T.pack ([Char] -> LogSource) -> [Char] -> LogSource
    forall a b. (a -> b) -> a -> b
    $ SomeException -> [Char]
    forall a. Show a => a -> [Char]
    show SomeException
    x) IO LogSource -> (SomeException -> IO LogSource) -> IO LogSource
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    m a -> (SomeException -> m a) -> m a
    `catchAny` \SomeException
    _ ->
              LogSource -> IO LogSource
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> LogSource
    T.pack [Char]
    "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
    -- exceptions, but all other synchronous exceptions will be caught and
    -- represented by the @HandlerContents@.
    basicRunHandler :: ToTypedContent c
                    => RunHandlerEnv site site
                    -> HandlerFor site c
                    -> YesodRequest
                    -> InternalState
                    -> IO (GHState, HandlerContents)
    basicRunHandler :: forall c site.
    ToTypedContent c =>
    RunHandlerEnv site site
    -> HandlerFor site c
    -> YesodRequest
    -> InternalState
    -> IO (GHState, HandlerContents)
    basicRunHandler RunHandlerEnv site site
    rhe HandlerFor site c
    handler YesodRequest
    yreq InternalState
    resState = do
        -- Create a mutable ref to hold the state. We use mutable refs so
        -- that the updates will survive runtime exceptions.
        istate <- GHState -> IO (IORef GHState)
    forall a. a -> IO (IORef a)
    I.newIORef GHState
    defState

        -- Run the handler itself, capturing any runtime exceptions and
        -- converting them into a @HandlerContents@
        contents' <- rheCatchHandlerExceptions rhe
            (do
                res <- unHandlerFor handler (hd istate)
                tc <- evaluate (toTypedContent res)
                -- Success! Wrap it up in an @HCContent@
                return (HCContent defaultStatus tc))
            (\SomeException
    e ->
                case SomeException -> Maybe HandlerContents
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e of
                    Just HandlerContents
    e' -> HandlerContents -> IO HandlerContents
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return HandlerContents
    e'
                    Maybe HandlerContents
    Nothing -> ErrorResponse -> HandlerContents
    HCError (ErrorResponse -> HandlerContents)
    -> IO ErrorResponse -> IO HandlerContents
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SomeException -> IO ErrorResponse
    toErrorHandler SomeException
    e)

        -- Get the raw state and return
        state <- I.readIORef istate
        return (state, contents')
      where
        defState :: GHState
    defState = GHState
            { ghsSession :: SessionMap
    ghsSession = YesodRequest -> SessionMap
    reqSession YesodRequest
    yreq
            , ghsRBC :: Maybe RequestBodyContents
    ghsRBC = Maybe RequestBodyContents
    forall a. Maybe a
    Nothing
            , ghsIdent :: Int
    ghsIdent = Int
    1
            , ghsCache :: TypeMap
    ghsCache = TypeMap
    forall a. Monoid a => a
    mempty
            , ghsCacheBy :: KeyedTypeMap
    ghsCacheBy = KeyedTypeMap
    forall a. Monoid a => a
    mempty
            , ghsHeaders :: Endo [Header]
    ghsHeaders = Endo [Header]
    forall a. Monoid a => a
    mempty
            }
        hd :: IORef GHState -> HandlerData site site
    hd IORef GHState
    istate = HandlerData
            { handlerRequest :: YesodRequest
    handlerRequest = YesodRequest
    yreq
            , handlerEnv :: RunHandlerEnv site site
    handlerEnv     = RunHandlerEnv site site
    rhe
            , handlerState :: IORef GHState
    handlerState   = IORef GHState
    istate
            , handlerResource :: InternalState
    handlerResource = InternalState
    resState
            }

    -- | Convert an @ErrorResponse@ into a @YesodResponse@
    handleError :: RunHandlerEnv sub site
                -> YesodRequest
                -> InternalState
                -> Map.Map Text S8.ByteString
                -> [Header]
                -> ErrorResponse
                -> IO YesodResponse
    handleError :: forall sub site.
    RunHandlerEnv sub site
    -> YesodRequest
    -> InternalState
    -> SessionMap
    -> [Header]
    -> ErrorResponse
    -> IO YesodResponse
    handleError RunHandlerEnv sub site
    rhe YesodRequest
    yreq InternalState
    resState SessionMap
    finalSession [Header]
    headers ErrorResponse
    e0 = do
        -- Find any evil hidden impure exceptions
        e <- (ErrorResponse -> IO ErrorResponse
    forall (m :: * -> *) a. MonadIO m => a -> m a
    evaluate (ErrorResponse -> IO ErrorResponse)
    -> ErrorResponse -> IO ErrorResponse
    forall a b. NFData a => (a -> b) -> a -> b
    $!! ErrorResponse
    e0) IO ErrorResponse
    -> (SomeException -> IO ErrorResponse) -> IO ErrorResponse
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    m a -> (SomeException -> m a) -> m a
    `catchAny` SomeException -> IO ErrorResponse
    errFromShow

        -- Generate a response, leveraging the updated session and
        -- response headers
        flip runInternalState resState $ do
            yar <- rheOnError rhe e yreq
                { reqSession = finalSession
                }
            case yar of
                YRPlain Status
    status' [Header]
    hs ByteString
    ct Content
    c SessionMap
    sess ->
                    let hs' :: [Header]
    hs' = [Header]
    headers [Header] -> [Header] -> [Header]
    forall a. [a] -> [a] -> [a]
    ++ [Header]
    hs
                        status :: Status
    status
                            | Status
    status' Status -> Status -> Bool
    forall a. Eq a => a -> a -> Bool
    == Status
    defaultStatus = ErrorResponse -> Status
    getStatus ErrorResponse
    e
                            | Bool
    otherwise = Status
    status'
                    in YesodResponse -> ResourceT IO YesodResponse
    forall a. a -> ResourceT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (YesodResponse -> ResourceT IO YesodResponse)
    -> YesodResponse -> ResourceT IO YesodResponse
    forall a b. (a -> b) -> a -> b
    $ Status
    -> [Header] -> ByteString -> Content -> SessionMap -> YesodResponse
    YRPlain Status
    status [Header]
    hs' ByteString
    ct Content
    c SessionMap
    sess
                YRWai Response
    _ -> YesodResponse -> ResourceT IO YesodResponse
    forall a. a -> ResourceT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return YesodResponse
    yar
                YRWaiApp Application
    _ -> YesodResponse -> ResourceT IO YesodResponse
    forall a. a -> ResourceT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return YesodResponse
    yar

    -- | Convert a @HandlerContents@ into a @YesodResponse@
    handleContents :: (ErrorResponse -> IO YesodResponse)
                   -> Map.Map Text S8.ByteString
                   -> [Header]
                   -> HandlerContents
                   -> IO YesodResponse
    handleContents :: (ErrorResponse -> IO YesodResponse)
    -> SessionMap -> [Header] -> HandlerContents -> IO YesodResponse
    handleContents ErrorResponse -> IO YesodResponse
    handleError' SessionMap
    finalSession [Header]
    headers HandlerContents
    contents =
        case HandlerContents
    contents of
            HCContent Status
    status (TypedContent ByteString
    ct Content
    c) -> do
                -- Check for impure exceptions hiding in the contents
                ec' <- Content -> IO (Either ErrorResponse Content)
    evaluateContent Content
    c
                case ec' of
                    Left ErrorResponse
    e -> ErrorResponse -> IO YesodResponse
    handleError' ErrorResponse
    e
                    Right Content
    c' -> YesodResponse -> IO YesodResponse
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (YesodResponse -> IO YesodResponse)
    -> YesodResponse -> IO YesodResponse
    forall a b. (a -> b) -> a -> b
    $ Status
    -> [Header] -> ByteString -> Content -> SessionMap -> YesodResponse
    YRPlain Status
    status [Header]
    headers ByteString
    ct Content
    c' SessionMap
    finalSession
            HCError ErrorResponse
    e -> ErrorResponse -> IO YesodResponse
    handleError' ErrorResponse
    e
            HCRedirect Status
    status LogSource
    loc -> do
                let disable_caching :: [Header] -> [Header]
    disable_caching [Header]
    x =
                          CI ByteString -> ByteString -> Header
    Header CI ByteString
    "Cache-Control" ByteString
    "no-cache, must-revalidate"
                        Header -> [Header] -> [Header]
    forall a. a -> [a] -> [a]
    : CI ByteString -> ByteString -> Header
    Header CI ByteString
    "Expires" ByteString
    "Thu, 01 Jan 1970 05:05:05 GMT"
                        Header -> [Header] -> [Header]
    forall a. a -> [a] -> [a]
    : [Header]
    x
                    hs :: [Header]
    hs = (if Status
    status Status -> Status -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Status
    H.movedPermanently301 then [Header] -> [Header]
    disable_caching else [Header] -> [Header]
    forall a. a -> a
    id)
                          ([Header] -> [Header]) -> [Header] -> [Header]
    forall a b. (a -> b) -> a -> b
    $ CI ByteString -> ByteString -> Header
    Header CI ByteString
    "Location" (LogSource -> ByteString
    encodeUtf8 LogSource
    loc) Header -> [Header] -> [Header]
    forall a. a -> [a] -> [a]
    : [Header]
    headers
                YesodResponse -> IO YesodResponse
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (YesodResponse -> IO YesodResponse)
    -> YesodResponse -> IO YesodResponse
    forall a b. (a -> b) -> a -> b
    $ Status
    -> [Header] -> ByteString -> Content -> SessionMap -> YesodResponse
    YRPlain
                    Status
    status [Header]
    hs ByteString
    typePlain Content
    emptyContent
                    SessionMap
    finalSession
            HCSendFile ByteString
    ct [Char]
    fp Maybe FilePart
    p -> YesodResponse -> IO YesodResponse
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (YesodResponse -> IO YesodResponse)
    -> YesodResponse -> IO YesodResponse
    forall a b. (a -> b) -> a -> b
    $ Status
    -> [Header] -> ByteString -> Content -> SessionMap -> YesodResponse
    YRPlain
                Status
    H.status200
                [Header]
    headers
                ByteString
    ct
                ([Char] -> Maybe FilePart -> Content
    ContentFile [Char]
    fp Maybe FilePart
    p)
                SessionMap
    finalSession
            HCCreated LogSource
    loc -> YesodResponse -> IO YesodResponse
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (YesodResponse -> IO YesodResponse)
    -> YesodResponse -> IO YesodResponse
    forall a b. (a -> b) -> a -> b
    $ Status
    -> [Header] -> ByteString -> Content -> SessionMap -> YesodResponse
    YRPlain
                Status
    H.status201
                (CI ByteString -> ByteString -> Header
    Header CI ByteString
    "Location" (LogSource -> ByteString
    encodeUtf8 LogSource
    loc) Header -> [Header] -> [Header]
    forall a. a -> [a] -> [a]
    : [Header]
    headers)
                ByteString
    typePlain
                Content
    emptyContent
                SessionMap
    finalSession
            HCWai Response
    r -> YesodResponse -> IO YesodResponse
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (YesodResponse -> IO YesodResponse)
    -> YesodResponse -> IO YesodResponse
    forall a b. (a -> b) -> a -> b
    $ Response -> YesodResponse
    YRWai Response
    r
            HCWaiApp Application
    a -> YesodResponse -> IO YesodResponse
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (YesodResponse -> IO YesodResponse)
    -> YesodResponse -> IO YesodResponse
    forall a b. (a -> b) -> a -> b
    $ Application -> YesodResponse
    YRWaiApp Application
    a

    -- | Evaluate the given value. If an exception is thrown, use it to
    -- replace the provided contents and then return @mempty@ in place of the
    -- evaluated value.
    --
    -- Note that this also catches async exceptions.
    evalFallback :: (Monoid w, NFData w)
                 => (forall a. IO a -> (SomeException -> IO a) -> IO a)
                 -> HandlerContents
                 -> w
                 -> IO (w, HandlerContents)
    evalFallback :: forall w.
    (Monoid w, NFData w) =>
    (forall a. IO a -> (SomeException -> IO a) -> IO a)
    -> HandlerContents -> w -> IO (w, HandlerContents)
    evalFallback forall a. IO a -> (SomeException -> IO a) -> IO a
    catcher HandlerContents
    contents w
    val = IO (w, HandlerContents)
    -> (SomeException -> IO (w, HandlerContents))
    -> IO (w, HandlerContents)
    forall a. IO a -> (SomeException -> IO a) -> IO a
    catcher
        ((w -> (w, HandlerContents)) -> IO w -> IO (w, HandlerContents)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (, HandlerContents
    contents) (w -> IO w
    forall (m :: * -> *) a. MonadIO m => a -> m a
    evaluate (w -> IO w) -> w -> IO w
    forall a b. NFData a => (a -> b) -> a -> b
    $!! w
    val))
        ((ErrorResponse -> (w, HandlerContents))
    -> IO ErrorResponse -> IO (w, HandlerContents)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((w
    forall a. Monoid a => a
    mempty, ) (HandlerContents -> (w, HandlerContents))
    -> (ErrorResponse -> HandlerContents)
    -> ErrorResponse
    -> (w, HandlerContents)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ErrorResponse -> HandlerContents
    HCError) (IO ErrorResponse -> IO (w, HandlerContents))
    -> (SomeException -> IO ErrorResponse)
    -> SomeException
    -> IO (w, HandlerContents)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SomeException -> IO ErrorResponse
    toErrorHandler)

    -- | Function used internally by Yesod in the process of converting a
    -- 'HandlerFor' into an 'Application'. Should not be needed by users.
    runHandler :: ToTypedContent c
               => RunHandlerEnv site site
               -> HandlerFor site c
               -> YesodApp
    runHandler :: forall c site.
    ToTypedContent c =>
    RunHandlerEnv site site -> HandlerFor site c -> YesodApp
    runHandler rhe :: RunHandlerEnv site site
    rhe@RunHandlerEnv {site
    Maybe (Route site)
    LogSource
    Loc -> LogSource -> LogLevel -> LogStr -> IO ()
    RequestBodyLength -> FileUpload
    Route site -> Route site
    Route site -> [(LogSource, LogSource)] -> LogSource
    ErrorResponse -> YesodApp
    forall a (m :: * -> *).
    MonadUnliftIO m =>
    m a -> (SomeException -> m a) -> m a
    rheCatchHandlerExceptions :: forall child site.
    RunHandlerEnv child site
    -> forall a (m :: * -> *).
       MonadUnliftIO m =>
       m a -> (SomeException -> m a) -> m a
    rheOnError :: forall child site.
    RunHandlerEnv child site -> ErrorResponse -> YesodApp
    rheRender :: Route site -> [(LogSource, LogSource)] -> LogSource
    rheRoute :: Maybe (Route site)
    rheRouteToMaster :: Route site -> Route site
    rheSite :: site
    rheChild :: site
    rheUpload :: RequestBodyLength -> FileUpload
    rheLog :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
    rheOnError :: ErrorResponse -> YesodApp
    rheMaxExpires :: LogSource
    rheCatchHandlerExceptions :: forall a (m :: * -> *).
    MonadUnliftIO m =>
    m a -> (SomeException -> m a) -> m a
    rheMaxExpires :: forall child site. RunHandlerEnv child site -> LogSource
    rheLog :: forall child site.
    RunHandlerEnv child site
    -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
    rheUpload :: forall child site.
    RunHandlerEnv child site -> RequestBodyLength -> FileUpload
    rheChild :: forall child site. RunHandlerEnv child site -> child
    rheSite :: forall child site. RunHandlerEnv child site -> site
    rheRouteToMaster :: forall child site.
    RunHandlerEnv child site -> Route child -> Route site
    rheRoute :: forall child site. RunHandlerEnv child site -> Maybe (Route child)
    rheRender :: forall child site.
    RunHandlerEnv child site
    -> Route site -> [(LogSource, LogSource)] -> LogSource
    ..} HandlerFor site c
    handler YesodRequest
    yreq = (InternalState -> IO YesodResponse) -> ResourceT IO YesodResponse
    forall (m :: * -> *) a. (InternalState -> m a) -> ResourceT m a
    withInternalState ((InternalState -> IO YesodResponse) -> ResourceT IO YesodResponse)
    -> (InternalState -> IO YesodResponse)
    -> ResourceT IO YesodResponse
    forall a b. (a -> b) -> a -> b
    $ \InternalState
    resState -> do
        -- Get the raw state and original contents
        (state, contents0) <- RunHandlerEnv site site
    -> HandlerFor site c
    -> YesodRequest
    -> InternalState
    -> IO (GHState, HandlerContents)
    forall c site.
    ToTypedContent c =>
    RunHandlerEnv site site
    -> HandlerFor site c
    -> YesodRequest
    -> InternalState
    -> IO (GHState, HandlerContents)
    basicRunHandler RunHandlerEnv site site
    rhe HandlerFor site c
    handler YesodRequest
    yreq InternalState
    resState

        -- Evaluate the unfortunately-lazy session and headers,
        -- propagating exceptions into the contents
        (finalSession, contents1) <- evalFallback rheCatchHandlerExceptions contents0 (ghsSession state)
        (headers, contents2) <- evalFallback rheCatchHandlerExceptions 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
            contents3

    safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
           -> ErrorResponse
           -> YesodApp
    safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
    -> ErrorResponse -> YesodApp
    safeEh Loc -> LogSource -> LogLevel -> LogStr -> IO ()
    log' ErrorResponse
    er YesodRequest
    req = do
        IO () -> ResourceT IO ()
    forall a. IO a -> ResourceT IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
    forall a b. (a -> b) -> a -> b
    $ Loc -> LogSource -> LogLevel -> LogStr -> IO ()
    log' $(qLocation >>= liftLoc) LogSource
    "yesod-core" LogLevel
    LevelError
               (LogStr -> IO ()) -> LogStr -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr ([Char] -> LogStr) -> [Char] -> LogStr
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Error handler errored out: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ErrorResponse -> [Char]
    forall a. Show a => a -> [Char]
    show ErrorResponse
    er
        YesodResponse -> ResourceT IO YesodResponse
    forall a. a -> ResourceT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (YesodResponse -> ResourceT IO YesodResponse)
    -> YesodResponse -> ResourceT IO YesodResponse
    forall a b. (a -> b) -> a -> b
    $ Status
    -> [Header] -> ByteString -> Content -> SessionMap -> YesodResponse
    YRPlain
            Status
    H.status500
            []
            ByteString
    typePlain
            (ByteString -> Content
    forall a. ToContent a => a -> Content
    toContent (ByteString
    "Internal Server Error" :: S.ByteString))
            (YesodRequest -> SessionMap
    reqSession YesodRequest
    req)

    -- | Run a 'HandlerFor' completely outside of Yesod.  This
    -- function comes with many caveats and you shouldn't use it
    -- unless you fully understand what it's doing and how it works.
    --
    -- As of now, there's only one reason to use this function at
    -- all: in order to run unit tests of functions inside 'HandlerFor'
    -- but that aren't easily testable with a full HTTP request.
    -- Even so, it's better to use @wai-test@ or @yesod-test@ instead
    -- of using this function.
    --
    -- This function will create a fake HTTP request (both @wai@'s
    -- 'Request' and @yesod@'s 'Request') and feed it to the
    -- @HandlerFor@.  The only useful information the @HandlerFor@ may
    -- get from the request is the session map, which you must supply
    -- as argument to @runFakeHandler@.  All other fields contain
    -- fake information, which means that they can be accessed but
    -- won't have any useful information.  The response of the
    -- @HandlerFor@ is completely ignored, including changes to the
    -- session, cookies or headers.  We only return you the
    -- @HandlerFor@'s return value.
    runFakeHandler :: forall site m a . (Yesod site, MonadIO m) =>
                      SessionMap
                   -> (site -> Logger)
                   -> site
                   -> HandlerFor site a
                   -> m (Either ErrorResponse a)
    runFakeHandler :: forall site (m :: * -> *) a.
    (Yesod site, MonadIO m) =>
    SessionMap
    -> (site -> Logger)
    -> site
    -> HandlerFor site a
    -> m (Either ErrorResponse a)
    runFakeHandler SessionMap
    fakeSessionMap site -> Logger
    logger site
    site HandlerFor site a
    handler = IO (Either ErrorResponse a) -> m (Either ErrorResponse a)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either ErrorResponse a) -> m (Either ErrorResponse a))
    -> IO (Either ErrorResponse a) -> m (Either ErrorResponse a)
    forall a b. (a -> b) -> a -> b
    $ do
      ret <- Either ErrorResponse a -> IO (IORef (Either ErrorResponse a))
    forall a. a -> IO (IORef a)
    I.newIORef (ErrorResponse -> Either ErrorResponse a
    forall a b. a -> Either a b
    Left (ErrorResponse -> Either ErrorResponse a)
    -> ErrorResponse -> Either ErrorResponse a
    forall a b. (a -> b) -> a -> b
    $ LogSource -> ErrorResponse
    InternalError LogSource
    "runFakeHandler: no result")
      maxExpires <- getCurrentMaxExpiresRFC1123
      let handler' = IO () -> HandlerFor site ()
    forall a. IO a -> HandlerFor site a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> HandlerFor site ())
    -> (a -> IO ()) -> a -> HandlerFor site ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IORef (Either ErrorResponse a) -> Either ErrorResponse a -> IO ()
    forall a. IORef a -> a -> IO ()
    I.writeIORef IORef (Either ErrorResponse a)
    ret (Either ErrorResponse a -> IO ())
    -> (a -> Either ErrorResponse a) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Either ErrorResponse a
    forall a b. b -> Either a b
    Right (a -> HandlerFor site ())
    -> HandlerFor site a -> HandlerFor site ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< HandlerFor site a
    handler
      let yapp = RunHandlerEnv site site -> HandlerFor site () -> YesodApp
    forall c site.
    ToTypedContent c =>
    RunHandlerEnv site site -> HandlerFor site c -> YesodApp
    runHandler
             RunHandlerEnv
                { rheRender :: Route site -> [(LogSource, LogSource)] -> LogSource
    rheRender = site
    -> LogSource -> Route site -> [(LogSource, LogSource)] -> LogSource
    forall y.
    Yesod y =>
    y -> LogSource -> Route y -> [(LogSource, LogSource)] -> LogSource
    yesodRender site
    site (LogSource -> Route site -> [(LogSource, LogSource)] -> LogSource)
    -> LogSource -> Route site -> [(LogSource, LogSource)] -> LogSource
    forall a b. (a -> b) -> a -> b
    $ site -> Request -> LogSource
    forall master. Yesod master => master -> Request -> LogSource
    resolveApproot site
    site Request
    fakeWaiRequest
                , rheRoute :: Maybe (Route site)
    rheRoute = Maybe (Route site)
    forall a. Maybe a
    Nothing
                , rheRouteToMaster :: Route site -> Route site
    rheRouteToMaster = Route site -> Route site
    forall a. a -> a
    id
                , rheChild :: site
    rheChild = site
    site
                , rheSite :: site
    rheSite = site
    site
                , rheUpload :: RequestBodyLength -> FileUpload
    rheUpload = site -> RequestBodyLength -> FileUpload
    forall site. Yesod site => site -> RequestBodyLength -> FileUpload
    fileUpload site
    site
                , rheLog :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
    rheLog = site -> Logger -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
    forall site.
    Yesod site =>
    site -> Logger -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
    messageLoggerSource site
    site (Logger -> Loc -> LogSource -> LogLevel -> LogStr -> IO ())
    -> Logger -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
    forall a b. (a -> b) -> a -> b
    $ site -> Logger
    logger site
    site
                , rheOnError :: ErrorResponse -> YesodApp
    rheOnError = ErrorResponse -> YesodApp
    forall {m :: * -> *}.
    MonadIO m =>
    ErrorResponse -> YesodRequest -> m YesodResponse
    errHandler
                , rheMaxExpires :: LogSource
    rheMaxExpires = LogSource
    maxExpires
                , rheCatchHandlerExceptions :: forall a (m :: * -> *).
    MonadUnliftIO m =>
    m a -> (SomeException -> m a) -> m a
    rheCatchHandlerExceptions = site -> m a -> (SomeException -> m a) -> m a
    forall site (m :: * -> *) a.
    (Yesod site, MonadUnliftIO m) =>
    site -> m a -> (SomeException -> m a) -> m a
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    site -> m a -> (SomeException -> m a) -> m a
    catchHandlerExceptions site
    site
                }
            HandlerFor site ()
    handler'
          errHandler ErrorResponse
    err YesodRequest
    req = do
              IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ IORef (Either ErrorResponse a) -> Either ErrorResponse a -> IO ()
    forall a. IORef a -> a -> IO ()
    I.writeIORef IORef (Either ErrorResponse a)
    ret (ErrorResponse -> Either ErrorResponse a
    forall a b. a -> Either a b
    Left ErrorResponse
    err)
              YesodResponse -> m YesodResponse
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (YesodResponse -> m YesodResponse)
    -> YesodResponse -> m YesodResponse
    forall a b. (a -> b) -> a -> b
    $ Status
    -> [Header] -> ByteString -> Content -> SessionMap -> YesodResponse
    YRPlain
                         Status
    H.status500
                         []
                         ByteString
    typePlain
                         (ByteString -> Content
    forall a. ToContent a => a -> Content
    toContent (ByteString
    "runFakeHandler: errHandler" :: S8.ByteString))
                         (YesodRequest -> SessionMap
    reqSession YesodRequest
    req)
          fakeWaiRequest = Request
    defaultRequest
              { requestMethod  = "POST"
              , httpVersion    = H.http11
              , rawPathInfo    = "/runFakeHandler/pathInfo"
              , remoteHost     = error "runFakeHandler-remoteHost"
              , pathInfo       = ["runFakeHandler", "pathInfo"]
              }
          fakeRequest =
            YesodRequest
              { reqGetParams :: [(LogSource, LogSource)]
    reqGetParams  = []
              , reqCookies :: [(LogSource, LogSource)]
    reqCookies    = []
              , reqWaiRequest :: Request
    reqWaiRequest = Request
    fakeWaiRequest
              , reqLangs :: [LogSource]
    reqLangs      = []
              , reqToken :: Maybe LogSource
    reqToken      = LogSource -> Maybe LogSource
    forall a. a -> Maybe a
    Just LogSource
    "NaN" -- not a nonce =)
              , reqAccept :: [ByteString]
    reqAccept     = []
              , reqSession :: SessionMap
    reqSession    = SessionMap
    fakeSessionMap
              }
      _ <- runResourceT $ yapp fakeRequest
      I.readIORef ret

    yesodRunner :: forall res site . (ToTypedContent res, Yesod site)
                => HandlerFor site res
                -> YesodRunnerEnv site
                -> Maybe (Route site)
                -> Application
    yesodRunner :: forall res site.
    (ToTypedContent res, Yesod site) =>
    HandlerFor site res
    -> YesodRunnerEnv site -> Maybe (Route site) -> Application
    yesodRunner HandlerFor site res
    handler' YesodRunnerEnv {site
    Maybe SessionBackend
    IO Int
    IO LogSource
    Logger
    yreLogger :: Logger
    yreSite :: site
    yreSessionBackend :: Maybe SessionBackend
    yreGen :: IO Int
    yreGetMaxExpires :: IO LogSource
    yreGetMaxExpires :: forall site. YesodRunnerEnv site -> IO LogSource
    yreGen :: forall site. YesodRunnerEnv site -> IO Int
    yreSessionBackend :: forall site. YesodRunnerEnv site -> Maybe SessionBackend
    yreSite :: forall site. YesodRunnerEnv site -> site
    yreLogger :: forall site. YesodRunnerEnv site -> Logger
    ..} Maybe (Route site)
    route Request
    req Response -> IO ResponseReceived
    sendResponse = do
      mmaxLen <- site -> Maybe (Route site) -> IO (Maybe Word64)
    forall site.
    Yesod site =>
    site -> Maybe (Route site) -> IO (Maybe Word64)
    maximumContentLengthIO site
    yreSite Maybe (Route site)
    route
      case (mmaxLen, requestBodyLength req) of
        (Just Word64
    maxLen, KnownLength Word64
    len) | Word64
    maxLen Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word64
    len -> Response -> IO ResponseReceived
    sendResponse (Word64 -> Word64 -> Response
    tooLargeResponse Word64
    maxLen Word64
    len)
        (Maybe Word64, RequestBodyLength)
    _ -> do
          let dontSaveSession :: p -> m [a]
    dontSaveSession p
    _ = [a] -> m [a]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
          (session, saveSession) <- IO (SessionMap, SessionMap -> IO [Header])
    -> IO (SessionMap, SessionMap -> IO [Header])
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (SessionMap, SessionMap -> IO [Header])
     -> IO (SessionMap, SessionMap -> IO [Header]))
    -> IO (SessionMap, SessionMap -> IO [Header])
    -> IO (SessionMap, SessionMap -> IO [Header])
    forall a b. (a -> b) -> a -> b
    $
              IO (SessionMap, SessionMap -> IO [Header])
    -> (SessionBackend -> IO (SessionMap, SessionMap -> IO [Header]))
    -> Maybe SessionBackend
    -> IO (SessionMap, SessionMap -> IO [Header])
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ((SessionMap, SessionMap -> IO [Header])
    -> IO (SessionMap, SessionMap -> IO [Header])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SessionMap
    forall k a. Map k a
    Map.empty, SessionMap -> IO [Header]
    forall {m :: * -> *} {p} {a}. Monad m => p -> m [a]
    dontSaveSession)) (SessionBackend
    -> Request -> IO (SessionMap, SessionMap -> IO [Header])
    `sbLoadSession` Request
    req) Maybe SessionBackend
    yreSessionBackend
          maxExpires <- yreGetMaxExpires
          let mkYesodReq = Request
    -> SessionMap
    -> Bool
    -> Maybe Word64
    -> Either (IO YesodRequest) (IO Int -> IO YesodRequest)
    parseWaiRequest Request
    req SessionMap
    session (Maybe SessionBackend -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe SessionBackend
    yreSessionBackend) Maybe Word64
    mmaxLen
          let yreq =
                  case Either (IO YesodRequest) (IO Int -> IO YesodRequest)
    mkYesodReq of
                      Left IO YesodRequest
    yreq' -> IO YesodRequest
    yreq'
                      Right IO Int -> IO YesodRequest
    needGen -> IO Int -> IO YesodRequest
    needGen IO Int
    yreGen
          let ra = site -> Request -> LogSource
    forall master. Yesod master => master -> Request -> LogSource
    resolveApproot site
    yreSite Request
    req
          let log' = site -> Logger -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
    forall site.
    Yesod site =>
    site -> Logger -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
    messageLoggerSource site
    yreSite Logger
    yreLogger
              -- We set up two environments: the first one has a "safe" error handler
              -- which will never throw an exception. The second one uses the
              -- user-provided errorHandler function. If that errorHandler function
              -- errors out, it will use the safeEh below to recover.
              rheSafe = RunHandlerEnv
                  { rheRender :: Route site -> [(LogSource, LogSource)] -> LogSource
    rheRender = site
    -> LogSource -> Route site -> [(LogSource, LogSource)] -> LogSource
    forall y.
    Yesod y =>
    y -> LogSource -> Route y -> [(LogSource, LogSource)] -> LogSource
    yesodRender site
    yreSite LogSource
    ra
                  , rheRoute :: Maybe (Route site)
    rheRoute = Maybe (Route site)
    route
                  , rheRouteToMaster :: Route site -> Route site
    rheRouteToMaster = Route site -> Route site
    forall a. a -> a
    id
                  , rheChild :: site
    rheChild = site
    yreSite
                  , rheSite :: site
    rheSite = site
    yreSite
                  , rheUpload :: RequestBodyLength -> FileUpload
    rheUpload = site -> RequestBodyLength -> FileUpload
    forall site. Yesod site => site -> RequestBodyLength -> FileUpload
    fileUpload site
    yreSite
                  , rheLog :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
    rheLog = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
    log'
                  , rheOnError :: ErrorResponse -> YesodApp
    rheOnError = (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
    -> ErrorResponse -> YesodApp
    safeEh Loc -> LogSource -> LogLevel -> LogStr -> IO ()
    log'
                  , rheMaxExpires :: LogSource
    rheMaxExpires = LogSource
    maxExpires
                  , rheCatchHandlerExceptions :: forall a (m :: * -> *).
    MonadUnliftIO m =>
    m a -> (SomeException -> m a) -> m a
    rheCatchHandlerExceptions = site -> m a -> (SomeException -> m a) -> m a
    forall site (m :: * -> *) a.
    (Yesod site, MonadUnliftIO m) =>
    site -> m a -> (SomeException -> m a) -> m a
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    site -> m a -> (SomeException -> m a) -> m a
    catchHandlerExceptions site
    yreSite
                  }
              rhe = RunHandlerEnv site site
    rheSafe
                  { rheOnError = runHandler rheSafe . errorHandler
                  }

          yesodWithInternalState yreSite route $ \InternalState
    is -> do
              yreq' <- IO YesodRequest
    yreq
              yar <- runInternalState (runHandler rhe handler yreq') is
              yarToResponse yar saveSession yreq' req is sendResponse
      where
        handler :: HandlerFor site res
    handler = HandlerFor site res -> HandlerFor site res
    forall res.
    ToTypedContent res =>
    HandlerFor site res -> HandlerFor site res
    forall site res.
    (Yesod site, ToTypedContent res) =>
    HandlerFor site res -> HandlerFor site res
    yesodMiddleware HandlerFor site res
    handler'

    yesodRender :: Yesod y
                => y
                -> ResolvedApproot
                -> Route y
                -> [(Text, Text)] -- ^ url query string
                -> Text
    yesodRender :: forall y.
    Yesod y =>
    y -> LogSource -> Route y -> [(LogSource, LogSource)] -> LogSource
    yesodRender y
    y LogSource
    ar Route y
    url [(LogSource, LogSource)]
    params =
        OnDecodeError -> ByteString -> LogSource
    decodeUtf8With OnDecodeError
    lenientDecode (ByteString -> LogSource) -> ByteString -> LogSource
    forall a b. (a -> b) -> a -> b
    $ LazyByteString -> ByteString
    BL.toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Builder -> LazyByteString
    toLazyByteString (Builder -> LazyByteString) -> Builder -> LazyByteString
    forall a b. (a -> b) -> a -> b
    $
        Builder -> Maybe Builder -> Builder
    forall a. a -> Maybe a -> a
    fromMaybe
            (y
    -> LogSource -> [LogSource] -> [(LogSource, LogSource)] -> Builder
    forall site.
    Yesod site =>
    site
    -> LogSource -> [LogSource] -> [(LogSource, LogSource)] -> Builder
    joinPath y
    y LogSource
    ar [LogSource]
    ps
              ([(LogSource, LogSource)] -> Builder)
    -> [(LogSource, LogSource)] -> Builder
    forall a b. (a -> b) -> a -> b
    $ [(LogSource, LogSource)]
    params [(LogSource, LogSource)]
    -> [(LogSource, LogSource)] -> [(LogSource, LogSource)]
    forall a. [a] -> [a] -> [a]
    ++ [(LogSource, LogSource)]
    params')
            (y -> Route y -> [(LogSource, LogSource)] -> Maybe Builder
    forall site.
    Yesod site =>
    site -> Route site -> [(LogSource, LogSource)] -> Maybe Builder
    urlParamRenderOverride y
    y Route y
    url [(LogSource, LogSource)]
    params)
      where
        ([LogSource]
    ps, [(LogSource, LogSource)]
    params') = Route y -> ([LogSource], [(LogSource, LogSource)])
    forall a.
    RenderRoute a =>
    Route a -> ([LogSource], [(LogSource, LogSource)])
    renderRoute Route y
    url

    resolveApproot :: Yesod master => master -> Request -> ResolvedApproot
    resolveApproot :: forall master. Yesod master => master -> Request -> LogSource
    resolveApproot master
    master Request
    req =
        case Approot master
    forall site. Yesod site => Approot site
    approot of
            Approot master
    ApprootRelative -> LogSource
    ""
            ApprootStatic LogSource
    t -> LogSource
    t
            ApprootMaster master -> LogSource
    f -> master -> LogSource
    f master
    master
            ApprootRequest master -> Request -> LogSource
    f -> master -> Request -> LogSource
    f master
    master Request
    req