    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE QuasiQuotes #-}
    {-# LANGUAGE TemplateHaskell #-}

    module Yesod.Core.Class.Yesod where

    import           Yesod.Core.Content
    import           Yesod.Core.Handler

    import           Yesod.Routes.Class

    import           Data.ByteString.Builder            (Builder)
    import           Data.Text.Encoding                 (encodeUtf8Builder)
    import           Control.Arrow                      ((***), second)
    import           Control.Exception                  (bracket)
    import           Control.Monad                      (forM, when, void)
    import           Control.Monad.IO.Class             (MonadIO (liftIO))
    import           Control.Monad.Logger               (LogLevel (LevelInfo, LevelOther),
                                                         LogSource, logErrorS)
    import           Control.Monad.Trans.Resource       (InternalState, createInternalState, closeInternalState)
    import qualified Data.ByteString.Char8              as S8
    import qualified Data.ByteString.Lazy               as L
    import Data.Aeson (object, (.=))
    import           Data.List                          (foldl', nub)
    import qualified Data.Map                           as Map
    import           Data.Maybe                         (catMaybes)
    import           Data.Monoid                        (Last (..))
    import           Data.Text                          (Text)
    import qualified Data.Text                          as T
    import qualified Data.Text.Encoding                 as TE
    import qualified Data.Text.Encoding.Error           as TEE
    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)
    import qualified Network.Wai                        as W
    import           Network.Wai.Parse                  (lbsBackEnd,
                                                         tempFileBackEnd)
    import           Network.Wai.Logger                 (ZonedDate, clockDateCacher)
    import           System.Log.FastLogger
    import           Text.Blaze                         (customAttribute, textTag,
                                                         toValue, (!),
                                                         preEscapedToMarkup)
    import qualified Text.Blaze.Html5                   as TBH
    import           Text.Hamlet
    import           Text.Julius
    import qualified Web.ClientSession                  as CS
    import           Web.Cookie                         (SetCookie (..), parseCookies, sameSiteLax,
                                                         sameSiteStrict, SameSiteOption, defaultSetCookie)
    import           Yesod.Core.Types
    import           Yesod.Core.Internal.Session
    import           Yesod.Core.Widget
    import Data.CaseInsensitive (CI)
    import qualified Network.Wai.Request
    import Data.IORef
    import UnliftIO (SomeException, catch, MonadUnliftIO)

    -- | Define settings for a Yesod applications. All methods have intelligent
    -- defaults, and therefore no implementation is required.
    class RenderRoute site => Yesod site where
        -- | An absolute URL to the root of the application. Do not include
        -- trailing slash.
        --
        -- 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.
        --
        -- Note: Prior to yesod-core 1.5, the default value was 'ApprootRelative'.
        approot :: Approot site
        approot = Approot site
    forall site. Approot site
    guessApproot

        -- | @since 1.6.24.0
        --  allows the user to specify how exceptions are cought.
        --  by default all async exceptions are thrown and synchronous
        --  exceptions render a 500 page.
        -- To catch all exceptions (even async) to render a 500 page,
        -- set this to 'UnliftIO.Exception.catchSyncOrAsync'. Beware
        -- this may have negative effects with functions like 'timeout'.
        catchHandlerExceptions :: MonadUnliftIO m => site -> m a -> (SomeException -> m a) -> m a
        catchHandlerExceptions site
    _ = m a -> (SomeException -> m a) -> m a
    forall (m :: * -> *) e a.
    (MonadUnliftIO m, Exception e) =>
    m a -> (e -> m a) -> m a
    catch

        -- | Output error response pages.
        --
        -- Default value: 'defaultErrorHandler'.
        errorHandler :: ErrorResponse -> HandlerFor site TypedContent
        errorHandler = ErrorResponse -> HandlerFor site TypedContent
    forall site.
    Yesod site =>
    ErrorResponse -> HandlerFor site TypedContent
    defaultErrorHandler

        -- | Applies some form of layout to the contents of a page.
        defaultLayout :: WidgetFor site () -> HandlerFor site Html
        defaultLayout WidgetFor site ()
    w = do
            p <- WidgetFor site () -> HandlerFor site (PageContent (Route site))
    forall site.
    Yesod site =>
    WidgetFor site () -> HandlerFor site (PageContent (Route site))
    widgetToPageContent WidgetFor site ()
    w
            msgs <- getMessages
            withUrlRenderer [hamlet|
                $newline never
                $doctype 5
                <html>
                    <head>
                        <title>#{pageTitle p}
                        $maybe description <- pageDescription p
                          <meta name="description" content="#{description}">
                        ^{pageHead p}
                    <body>
                        $forall (status, msg) <- msgs
                            <p class="message #{status}">#{msg}
                        ^{pageBody p}
                |]

        -- | 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
                               -> [(T.Text, T.Text)] -- ^ query string
                               -> Maybe Builder
        urlParamRenderOverride site
    _ Route site
    _ [(Text, Text)]
    _ = Maybe Builder
    forall a. Maybe a
    Nothing

        -- | Determine if a request is authorized or not.
        --
        -- Return 'Authorized' if the request is authorized,
        -- 'Unauthorized' a message if unauthorized.
        -- If authentication is required, return 'AuthenticationRequired'.
        isAuthorized :: Route site
                     -> Bool -- ^ is this a write request?
                     -> HandlerFor site AuthResult
        isAuthorized Route site
    _ Bool
    _ = AuthResult -> HandlerFor site AuthResult
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return AuthResult
    Authorized

        -- | Determines whether the current request is a write request. By default,
        -- this assumes you are following RESTful principles, and determines this
        -- from request method. In particular, all except the following request
        -- methods are considered write: GET HEAD OPTIONS TRACE.
        --
        -- This function is used to determine if a request is authorized; see
        -- 'isAuthorized'.
        isWriteRequest :: Route site -> HandlerFor site Bool
        isWriteRequest Route site
    _ = do
            wai <- HandlerFor site Request
    forall (m :: * -> *). MonadHandler m => m Request
    waiRequest
            return $ W.requestMethod wai `notElem`
                ["GET", "HEAD", "OPTIONS", "TRACE"]

        -- | The default route for authentication.
        --
        -- Used in particular by 'isAuthorized', but library users can do whatever
        -- they want with it.
        authRoute :: site -> Maybe (Route site)
        authRoute site
    _ = Maybe (Route site)
    forall a. Maybe a
    Nothing

        -- | A function used to clean up path segments. It returns 'Right' with a
        -- clean path or 'Left' with a new set of pieces the user should be
        -- redirected to. The default implementation enforces:
        --
        -- * No double slashes
        --
        -- * There is no trailing slash.
        --
        -- Note that versions of Yesod prior to 0.7 used a different set of rules
        -- involing trailing slashes.
        cleanPath :: site -> [Text] -> Either [Text] [Text]
        cleanPath site
    _ [Text]
    s =
            if [Text]
    corrected [Text] -> [Text] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Text]
    s
                then [Text] -> Either [Text] [Text]
    forall a b. b -> Either a b
    Right ([Text] -> Either [Text] [Text]) -> [Text] -> Either [Text] [Text]
    forall a b. (a -> b) -> a -> b
    $ (Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Text
    dropDash [Text]
    s
                else [Text] -> Either [Text] [Text]
    forall a b. a -> Either a b
    Left [Text]
    corrected
          where
            corrected :: [Text]
    corrected = (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Bool
    T.null) [Text]
    s
            dropDash :: Text -> Text
    dropDash Text
    t
                | (Char -> Bool) -> Text -> Bool
    T.all (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-') Text
    t = Int -> Text -> Text
    T.drop Int
    1 Text
    t
                | Bool
    otherwise = Text
    t

        -- | Builds an absolute URL by concatenating the application root with the
        -- pieces of a path and a query string, if any.
        -- Note that the pieces of the path have been previously cleaned up by 'cleanPath'.
        joinPath :: site
                 -> T.Text -- ^ application root
                 -> [T.Text] -- ^ path pieces
                 -> [(T.Text, T.Text)] -- ^ query string
                 -> Builder
        joinPath site
    _ Text
    ar [Text]
    pieces' [(Text, Text)]
    qs' =
            Text -> Builder
    encodeUtf8Builder Text
    ar Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` [Text] -> Query -> Builder
    encodePath [Text]
    pieces Query
    qs
          where
            pieces :: [Text]
    pieces = if [Text] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Text]
    pieces' then [Text
    ""] else (Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Text
    addDash [Text]
    pieces'
            qs :: Query
    qs = ((Text, Text) -> (ByteString, Maybe ByteString))
    -> [(Text, Text)] -> Query
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> ByteString
    TE.encodeUtf8 (Text -> ByteString)
    -> (Text -> Maybe ByteString)
    -> (Text, Text)
    -> (ByteString, Maybe ByteString)
    forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** Text -> Maybe ByteString
    go) [(Text, Text)]
    qs'
            go :: Text -> Maybe ByteString
    go Text
    "" = Maybe ByteString
    forall a. Maybe a
    Nothing
            go Text
    x = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Text -> ByteString
    TE.encodeUtf8 Text
    x
            addDash :: Text -> Text
    addDash Text
    t
                | (Char -> Bool) -> Text -> Bool
    T.all (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-') Text
    t = Char -> Text -> Text
    T.cons Char
    '-' Text
    t
                | Bool
    otherwise = Text
    t

        -- | This function is used to store some static content to be served as an
        -- external file. The most common case of this is stashing CSS and
        -- JavaScript content in an external file; the "Yesod.Widget" module uses
        -- this feature.
        --
        -- The return value is 'Nothing' if no storing was performed; this is the
        -- default implementation. A 'Just' 'Left' gives the absolute URL of the
        -- file, whereas a 'Just' 'Right' gives the type-safe URL. The former is
        -- necessary when you are serving the content outside the context of a
        -- Yesod application, such as via memcached.
        addStaticContent :: Text -- ^ filename extension
                         -> Text -- ^ mime-type
                         -> L.ByteString -- ^ content
                         -> HandlerFor site (Maybe (Either Text (Route site, [(Text, Text)])))
        addStaticContent Text
    _ Text
    _ ByteString
    _ = Maybe (Either Text (Route site, [(Text, Text)]))
    -> HandlerFor
         site (Maybe (Either Text (Route site, [(Text, Text)])))
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Either Text (Route site, [(Text, Text)]))
    forall a. Maybe a
    Nothing

        -- | Maximum allowed length of the request body, in bytes.
        -- This method may be ignored if 'maximumContentLengthIO' is overridden.
        --
        -- If @Nothing@, no maximum is applied.
        --
        -- Default: 2 megabytes.
        maximumContentLength :: site -> Maybe (Route site) -> Maybe Word64
        maximumContentLength site
    _ Maybe (Route site)
    _ = Word64 -> Maybe Word64
    forall a. a -> Maybe a
    Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
    forall a b. (a -> b) -> a -> b
    $ Word64
    2 Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    * Word64
    1024 Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    * Word64
    1024 -- 2 megabytes

        -- | Maximum allowed length of the request body, in bytes. This is similar
        -- to 'maximumContentLength', but the result lives in @IO@. This allows
        -- you to dynamically change the maximum file size based on some external
        -- source like a database or an @IORef@.
        --
        -- The default implementation uses 'maximumContentLength'. Future version of yesod will
        -- remove 'maximumContentLength' and use this method exclusively.
        --
        -- @since 1.6.13
        maximumContentLengthIO :: site -> Maybe (Route site) -> IO (Maybe Word64)
        maximumContentLengthIO site
    a Maybe (Route site)
    b = Maybe Word64 -> IO (Maybe Word64)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe Word64 -> IO (Maybe Word64))
    -> Maybe Word64 -> IO (Maybe Word64)
    forall a b. (a -> b) -> a -> b
    $ site -> Maybe (Route site) -> Maybe Word64
    forall site.
    Yesod site =>
    site -> Maybe (Route site) -> Maybe Word64
    maximumContentLength site
    a Maybe (Route site)
    b

        -- | Creates a @Logger@ to use for log messages.
        --
        -- Note that a common technique (endorsed by the scaffolding) is to create
        -- a @Logger@ value and place it in your foundation datatype, and have this
        -- method return that already created value. That way, you can use that
        -- same @Logger@ for printing messages during app initialization.
        --
        -- Default: the 'defaultMakeLogger' function.
        makeLogger :: site -> IO Logger
        makeLogger site
    _ = IO Logger
    defaultMakeLogger

        -- | Send a message to the @Logger@ provided by @getLogger@.
        --
        -- Default: the 'defaultMessageLoggerSource' function, using
        -- 'shouldLogIO' to check whether we should log.
        messageLoggerSource :: site
                            -> Logger
                            -> Loc -- ^ position in source code
                            -> LogSource
                            -> LogLevel
                            -> LogStr -- ^ message
                            -> IO ()
        messageLoggerSource site
    site = (Text -> LogLevel -> IO Bool)
    -> Logger -> Loc -> Text -> LogLevel -> LogStr -> IO ()
    defaultMessageLoggerSource ((Text -> LogLevel -> IO Bool)
     -> Logger -> Loc -> Text -> LogLevel -> LogStr -> IO ())
    -> (Text -> LogLevel -> IO Bool)
    -> Logger
    -> Loc
    -> Text
    -> LogLevel
    -> LogStr
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ site -> Text -> LogLevel -> IO Bool
    forall site. Yesod site => site -> Text -> LogLevel -> IO Bool
    shouldLogIO site
    site

        -- | Where to Load sripts from. We recommend the default value,
        -- 'BottomOfBody'.
        jsLoader :: site -> ScriptLoadPosition site
        jsLoader site
    _ = ScriptLoadPosition site
    forall master. ScriptLoadPosition master
    BottomOfBody

        -- | Default attributes to put on the JavaScript <script> tag
        -- generated for julius files
        jsAttributes :: site -> [(Text, Text)]
        jsAttributes site
    _ = []

        -- | Same as @jsAttributes@ but allows you to run arbitrary Handler code
        --
        -- This is useful if you need to add a randomised nonce value to the script
        -- tag generated by @widgetFile@. If this function is overridden then
        -- @jsAttributes@ is ignored.
        --
        -- @since 1.6.16
        jsAttributesHandler :: HandlerFor site [(Text, Text)]
        jsAttributesHandler = site -> [(Text, Text)]
    forall site. Yesod site => site -> [(Text, Text)]
    jsAttributes (site -> [(Text, Text)])
    -> HandlerFor site site -> HandlerFor site [(Text, Text)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HandlerFor site site
    HandlerFor site (HandlerSite (HandlerFor site))
    forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
    getYesod

        -- | Create a session backend. Returning 'Nothing' disables
        -- sessions. If you'd like to change the way that the session
        -- cookies are created, take a look at
        -- 'customizeSessionCookies'.
        --
        -- Default: Uses clientsession with a 2 hour timeout.
        makeSessionBackend :: site -> IO (Maybe SessionBackend)
        makeSessionBackend site
    _ = SessionBackend -> Maybe SessionBackend
    forall a. a -> Maybe a
    Just (SessionBackend -> Maybe SessionBackend)
    -> IO SessionBackend -> IO (Maybe SessionBackend)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> [Char] -> IO SessionBackend
    defaultClientSessionBackend Int
    120 [Char]
    CS.defaultKeyFile

        -- | How to store uploaded files.
        --
        -- Default: When the request body is greater than 50kb, store in a temp
        -- file. For chunked request bodies, store in a temp file. Otherwise, store
        -- in memory.
        fileUpload :: site -> W.RequestBodyLength -> FileUpload
        fileUpload site
    _ (W.KnownLength Word64
    size)
            | Word64
    size Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word64
    50000 = BackEnd ByteString -> FileUpload
    FileUploadMemory BackEnd ByteString
    forall (m :: * -> *) ignored1 ignored2.
    Monad m =>
    ignored1 -> ignored2 -> m ByteString -> m ByteString
    lbsBackEnd
        fileUpload site
    _ RequestBodyLength
    _ = (InternalState -> BackEnd [Char]) -> FileUpload
    FileUploadDisk InternalState -> BackEnd [Char]
    forall ignored1 ignored2.
    InternalState -> ignored1 -> ignored2 -> IO ByteString -> IO [Char]
    tempFileBackEnd

        -- | Should we log the given log source/level combination.
        --
        -- Default: the 'defaultShouldLogIO' function.
        --
        -- Since 1.2.4
        shouldLogIO :: site -> LogSource -> LogLevel -> IO Bool
        shouldLogIO site
    _ = Text -> LogLevel -> IO Bool
    defaultShouldLogIO

        -- | A Yesod middleware, which will wrap every handler function. This
        -- allows you to run code before and after a normal handler.
        --
        -- Default: the 'defaultYesodMiddleware' function.
        --
        -- Since: 1.1.6
        yesodMiddleware :: ToTypedContent res => HandlerFor site res -> HandlerFor site res
        yesodMiddleware = HandlerFor site res -> HandlerFor site res
    forall site res.
    Yesod site =>
    HandlerFor site res -> HandlerFor site res
    defaultYesodMiddleware

        -- | How to allocate an @InternalState@ for each request.
        --
        -- The default implementation is almost always what you want. However, if
        -- you know that you are never taking advantage of the @MonadResource@
        -- instance in your handler functions, setting this to a dummy
        -- implementation can provide a small optimization. Only do this if you
        -- really know what you're doing, otherwise you can turn safe code into a
        -- runtime error!
        --
        -- Since 1.4.2
        yesodWithInternalState :: site -> Maybe (Route site) -> (InternalState -> IO a) -> IO a
        yesodWithInternalState site
    _ Maybe (Route site)
    _ = IO InternalState
    -> (InternalState -> IO ()) -> (InternalState -> IO a) -> IO a
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket IO InternalState
    forall (m :: * -> *). MonadIO m => m InternalState
    createInternalState InternalState -> IO ()
    forall (m :: * -> *). MonadIO m => InternalState -> m ()
    closeInternalState
        {-# INLINE yesodWithInternalState #-}

        -- | Convert a title and HTML snippet into a 'Widget'. Used
        -- primarily for wrapping up error messages for better display.
        --
        -- @since 1.4.30
        defaultMessageWidget :: Html -> HtmlUrl (Route site) -> WidgetFor site ()
        defaultMessageWidget Html
    title HtmlUrl (Route site)
    body = do
            Html -> WidgetFor site ()
    forall (m :: * -> *). MonadWidget m => Html -> m ()
    setTitle Html
    title
            HtmlUrl (Route site) -> WidgetFor site ()
    forall site a (m :: * -> *).
    (ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
    a -> m ()
    forall (m :: * -> *).
    (MonadWidget m, HandlerSite m ~ site) =>
    HtmlUrl (Route site) -> m ()
    toWidget
                HtmlUrl (Route site)
    [hamlet|
                    <h1>#{title}
                    ^{body}
                |]

    -- | Default implementation of 'makeLogger'. Sends to stdout and
    -- automatically flushes on each write.
    --
    -- Since 1.4.10
    defaultMakeLogger :: IO Logger
    defaultMakeLogger :: IO Logger
    defaultMakeLogger = do
        loggerSet' <- Int -> IO LoggerSet
    newStdoutLoggerSet Int
    defaultBufSize
        (getter, _) <- clockDateCacher
        return $! Logger loggerSet' getter

    -- | Default implementation of 'messageLoggerSource'. Checks if the
    -- message should be logged using the provided function, and if so,
    -- formats using 'formatLogMessage'. You can use 'defaultShouldLogIO'
    -- as the provided function.
    --
    -- Since 1.4.10
    defaultMessageLoggerSource ::
           (LogSource -> LogLevel -> IO Bool) -- ^ Check whether we should
                                              -- log this
        -> Logger
        -> Loc -- ^ position in source code
        -> LogSource
        -> LogLevel
        -> LogStr -- ^ message
        -> IO ()
    defaultMessageLoggerSource :: (Text -> LogLevel -> IO Bool)
    -> Logger -> Loc -> Text -> LogLevel -> LogStr -> IO ()
    defaultMessageLoggerSource Text -> LogLevel -> IO Bool
    ckLoggable Logger
    logger Loc
    loc Text
    source LogLevel
    level LogStr
    msg = do
        loggable <- Text -> LogLevel -> IO Bool
    ckLoggable Text
    source LogLevel
    level
        when loggable $
            formatLogMessage (loggerDate logger) loc source level msg >>=
            loggerPutStr logger

    -- | Default implementation of 'shouldLog'. Logs everything at or
    -- above 'LevelInfo'.
    --
    -- Since 1.4.10
    defaultShouldLogIO :: LogSource -> LogLevel -> IO Bool
    defaultShouldLogIO :: Text -> LogLevel -> IO Bool
    defaultShouldLogIO Text
    _ LogLevel
    level = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ LogLevel
    level LogLevel -> LogLevel -> Bool
    forall a. Ord a => a -> a -> Bool
    >= LogLevel
    LevelInfo

    -- | Default implementation of 'yesodMiddleware'. Adds the response header
    -- \"Vary: Accept, Accept-Language\", \"X-XSS-Protection: 1; mode=block\", and
    -- performs authorization checks.
    --
    -- Since 1.2.0
    defaultYesodMiddleware :: Yesod site => HandlerFor site res -> HandlerFor site res
    defaultYesodMiddleware :: forall site res.
    Yesod site =>
    HandlerFor site res -> HandlerFor site res
    defaultYesodMiddleware HandlerFor site res
    handler = do
        Text -> Text -> HandlerFor site ()
    forall (m :: * -> *). MonadHandler m => Text -> Text -> m ()
    addHeader Text
    "Vary" Text
    "Accept, Accept-Language"
        Text -> Text -> HandlerFor site ()
    forall (m :: * -> *). MonadHandler m => Text -> Text -> m ()
    addHeader Text
    "X-XSS-Protection" Text
    "1; mode=block"
        HandlerFor site ()
    forall site. Yesod site => HandlerFor site ()
    authorizationCheck
        HandlerFor site res
    handler

    -- | Defends against session hijacking by setting the secure bit on session
    -- cookies so that browsers will not transmit them over http. With this
    -- setting on, it follows that the server will regard requests made over
    -- http as sessionless, because the session cookie will not be included in
    -- the request. Use this as part of a total security measure which also
    -- includes disabling HTTP traffic to the site or issuing redirects from
    -- HTTP urls, and composing 'sslOnlyMiddleware' with the site's
    -- 'yesodMiddleware'.
    --
    -- Since 1.4.7
    sslOnlySessions :: IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
    sslOnlySessions :: IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
    sslOnlySessions = ((Maybe SessionBackend -> Maybe SessionBackend)
    -> IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Maybe SessionBackend -> Maybe SessionBackend)
     -> IO (Maybe SessionBackend) -> IO (Maybe SessionBackend))
    -> ((SessionBackend -> SessionBackend)
        -> Maybe SessionBackend -> Maybe SessionBackend)
    -> (SessionBackend -> SessionBackend)
    -> IO (Maybe SessionBackend)
    -> IO (Maybe SessionBackend)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SessionBackend -> SessionBackend)
    -> Maybe SessionBackend -> Maybe SessionBackend
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) SessionBackend -> SessionBackend
    secureSessionCookies
      where
        setSecureBit :: SetCookie -> SetCookie
    setSecureBit SetCookie
    cookie = SetCookie
    cookie { setCookieSecure = True }
        secureSessionCookies :: SessionBackend -> SessionBackend
    secureSessionCookies = (SetCookie -> SetCookie) -> SessionBackend -> SessionBackend
    customizeSessionCookies SetCookie -> SetCookie
    setSecureBit

    -- | Helps defend against CSRF attacks by setting the SameSite attribute on
    -- session cookies to Lax. With the Lax setting, the cookie will be sent with same-site
    -- requests, and with cross-site top-level navigations.
    --
    -- This option is liable to change in future versions of Yesod as the spec evolves.
    -- View more information <https://datatracker.ietf.org/doc/draft-west-first-party-cookies/ here>.
    --
    -- @since 1.4.23
    laxSameSiteSessions :: IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
    laxSameSiteSessions :: IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
    laxSameSiteSessions = SameSiteOption
    -> IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
    sameSiteSession SameSiteOption
    sameSiteLax

    -- | Helps defend against CSRF attacks by setting the SameSite attribute on
    -- session cookies to Strict. With the Strict setting, the cookie will only be
    -- sent with same-site requests.
    --
    -- This option is liable to change in future versions of Yesod as the spec evolves.
    -- View more information <https://datatracker.ietf.org/doc/draft-west-first-party-cookies/ here>.
    --
    -- @since 1.4.23
    strictSameSiteSessions :: IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
    strictSameSiteSessions :: IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
    strictSameSiteSessions = SameSiteOption
    -> IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
    sameSiteSession SameSiteOption
    sameSiteStrict

    sameSiteSession :: SameSiteOption -> IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
    sameSiteSession :: SameSiteOption
    -> IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
    sameSiteSession SameSiteOption
    s = ((Maybe SessionBackend -> Maybe SessionBackend)
    -> IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Maybe SessionBackend -> Maybe SessionBackend)
     -> IO (Maybe SessionBackend) -> IO (Maybe SessionBackend))
    -> ((SessionBackend -> SessionBackend)
        -> Maybe SessionBackend -> Maybe SessionBackend)
    -> (SessionBackend -> SessionBackend)
    -> IO (Maybe SessionBackend)
    -> IO (Maybe SessionBackend)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SessionBackend -> SessionBackend)
    -> Maybe SessionBackend -> Maybe SessionBackend
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) SessionBackend -> SessionBackend
    secureSessionCookies
      where
        sameSite :: SetCookie -> SetCookie
    sameSite SetCookie
    cookie = SetCookie
    cookie { setCookieSameSite = Just s }
        secureSessionCookies :: SessionBackend -> SessionBackend
    secureSessionCookies = (SetCookie -> SetCookie) -> SessionBackend -> SessionBackend
    customizeSessionCookies SetCookie -> SetCookie
    sameSite

    -- | Apply a Strict-Transport-Security header with the specified timeout to
    -- all responses so that browsers will rewrite all http links to https
    -- until the timeout expires. For security, the max-age of the STS header
    -- should always equal or exceed the client sessions timeout. This defends
    -- against SSL-stripping man-in-the-middle attacks. It is only effective if
    -- a secure connection has already been made; Strict-Transport-Security
    -- headers are ignored over HTTP.
    --
    -- Since 1.4.7
    sslOnlyMiddleware :: Int -- ^ minutes
                      -> HandlerFor site res
                      -> HandlerFor site res
    sslOnlyMiddleware :: forall site res. Int -> HandlerFor site res -> HandlerFor site res
    sslOnlyMiddleware Int
    timeout HandlerFor site res
    handler = do
        Text -> Text -> HandlerFor site ()
    forall (m :: * -> *). MonadHandler m => Text -> Text -> m ()
    addHeader Text
    "Strict-Transport-Security"
                  (Text -> HandlerFor site ()) -> Text -> HandlerFor site ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ [Char]
    "max-age="
                                    , Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int -> [Char]) -> Int -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Int
    timeout Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    60
                                    , [Char]
    "; includeSubDomains"
                                    ]
        HandlerFor site res
    handler

    -- | Check if a given request is authorized via 'isAuthorized' and
    -- 'isWriteRequest'.
    --
    -- Since 1.2.0
    authorizationCheck :: Yesod site => HandlerFor site ()
    authorizationCheck :: forall site. Yesod site => HandlerFor site ()
    authorizationCheck = HandlerFor site (Maybe (Route site))
    HandlerFor site (Maybe (Route (HandlerSite (HandlerFor site))))
    forall (m :: * -> *).
    MonadHandler m =>
    m (Maybe (Route (HandlerSite m)))
    getCurrentRoute HandlerFor site (Maybe (Route site))
    -> (Maybe (Route site) -> HandlerFor site ()) -> HandlerFor site ()
    forall a b.
    HandlerFor site a -> (a -> HandlerFor site b) -> HandlerFor site b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= HandlerFor site ()
    -> (Route site -> HandlerFor site ())
    -> Maybe (Route site)
    -> HandlerFor site ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> HandlerFor site ()
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) Route site -> HandlerFor site ()
    forall {site}. Yesod site => Route site -> HandlerFor site ()
    checkUrl
      where
        checkUrl :: Route site -> HandlerFor site ()
    checkUrl Route site
    url = do
            isWrite <- Route site -> HandlerFor site Bool
    forall site. Yesod site => Route site -> HandlerFor site Bool
    isWriteRequest Route site
    url
            ar <- isAuthorized url isWrite
            case ar of
                AuthResult
    Authorized -> () -> HandlerFor site ()
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                AuthResult
    AuthenticationRequired -> do
                    master <- HandlerFor site site
    HandlerFor site (HandlerSite (HandlerFor site))
    forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
    getYesod
                    case authRoute master of
                        Maybe (Route site)
    Nothing -> HandlerFor site (ZonkAny 0) -> HandlerFor site ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void HandlerFor site (ZonkAny 0)
    forall (m :: * -> *) a. MonadHandler m => m a
    notAuthenticated
                        Just Route site
    url' ->
                          HandlerFor site TypedContent -> HandlerFor site ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (HandlerFor site TypedContent -> HandlerFor site ())
    -> HandlerFor site TypedContent -> HandlerFor site ()
    forall a b. (a -> b) -> a -> b
    $ Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall (m :: * -> *).
    MonadHandler m =>
    Writer (Endo [ProvidedRep m]) () -> m TypedContent
    selectRep (Writer (Endo [ProvidedRep (HandlerFor site)]) ()
     -> HandlerFor site TypedContent)
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall a b. (a -> b) -> a -> b
    $ do
                              ByteString
    -> HandlerFor site ()
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, ToContent a) =>
    ByteString -> m a -> Writer (Endo [ProvidedRep m]) ()
    provideRepType ByteString
    typeHtml (HandlerFor site ()
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site ()
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ do
                                  HandlerFor site ()
    forall (m :: * -> *). MonadHandler m => m ()
    setUltDestCurrent
                                  HandlerFor site (ZonkAny 1) -> HandlerFor site ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (HandlerFor site (ZonkAny 1) -> HandlerFor site ())
    -> HandlerFor site (ZonkAny 1) -> HandlerFor site ()
    forall a b. (a -> b) -> a -> b
    $ Route site -> HandlerFor site (ZonkAny 1)
    forall (m :: * -> *) url a.
    (MonadHandler m, RedirectUrl (HandlerSite m) url) =>
    url -> m a
    redirect Route site
    url'
                              ByteString
    -> HandlerFor site ()
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, ToContent a) =>
    ByteString -> m a -> Writer (Endo [ProvidedRep m]) ()
    provideRepType ByteString
    typeJson (HandlerFor site ()
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site ()
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $
                                  HandlerFor site (ZonkAny 2) -> HandlerFor site ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void HandlerFor site (ZonkAny 2)
    forall (m :: * -> *) a. MonadHandler m => m a
    notAuthenticated
                Unauthorized Text
    s' -> Text -> HandlerFor site ()
    forall (m :: * -> *) a. MonadHandler m => Text -> m a
    permissionDenied Text
    s'

    -- | Calls 'csrfCheckMiddleware' with 'isWriteRequest', 'defaultCsrfHeaderName', and 'defaultCsrfParamName' as parameters.
    --
    -- Since 1.4.14
    defaultCsrfCheckMiddleware :: Yesod site => HandlerFor site res -> HandlerFor site res
    defaultCsrfCheckMiddleware :: forall site res.
    Yesod site =>
    HandlerFor site res -> HandlerFor site res
    defaultCsrfCheckMiddleware HandlerFor site res
    handler =
        HandlerFor site res
    -> HandlerFor site Bool
    -> CI ByteString
    -> Text
    -> HandlerFor site res
    forall site res.
    HandlerFor site res
    -> HandlerFor site Bool
    -> CI ByteString
    -> Text
    -> HandlerFor site res
    csrfCheckMiddleware
            HandlerFor site res
    handler
            (HandlerFor site (Maybe (Route site))
    HandlerFor site (Maybe (Route (HandlerSite (HandlerFor site))))
    forall (m :: * -> *).
    MonadHandler m =>
    m (Maybe (Route (HandlerSite m)))
    getCurrentRoute HandlerFor site (Maybe (Route site))
    -> (Maybe (Route site) -> HandlerFor site Bool)
    -> HandlerFor site Bool
    forall a b.
    HandlerFor site a -> (a -> HandlerFor site b) -> HandlerFor site b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= HandlerFor site Bool
    -> (Route site -> HandlerFor site Bool)
    -> Maybe (Route site)
    -> HandlerFor site Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Bool -> HandlerFor site Bool
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False) Route site -> HandlerFor site Bool
    forall site. Yesod site => Route site -> HandlerFor site Bool
    isWriteRequest)
            CI ByteString
    defaultCsrfHeaderName
            Text
    defaultCsrfParamName

    -- | Looks up the CSRF token from the request headers or POST parameters. If the value doesn't match the token stored in the session,
    -- this function throws a 'PermissionDenied' error.
    --
    -- For details, see the "AJAX CSRF protection" section of "Yesod.Core.Handler".
    --
    -- Since 1.4.14
    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.
                        -> HandlerFor site res
    csrfCheckMiddleware :: forall site res.
    HandlerFor site res
    -> HandlerFor site Bool
    -> CI ByteString
    -> Text
    -> HandlerFor site res
    csrfCheckMiddleware HandlerFor site res
    handler HandlerFor site Bool
    shouldCheckFn CI ByteString
    headerName Text
    paramName = do
        shouldCheck <- HandlerFor site Bool
    shouldCheckFn
        when shouldCheck (checkCsrfHeaderOrParam headerName paramName)
        handler

    -- | Calls 'csrfSetCookieMiddleware' with the 'defaultCsrfCookieName'.
    --
    -- The cookie's path is set to @/@, making it valid for your whole website.
    --
    -- Since 1.4.14
    defaultCsrfSetCookieMiddleware :: HandlerFor site res -> HandlerFor site res
    defaultCsrfSetCookieMiddleware :: forall site res. HandlerFor site res -> HandlerFor site res
    defaultCsrfSetCookieMiddleware HandlerFor site res
    handler = HandlerFor site ()
    forall (m :: * -> *). MonadHandler m => m ()
    setCsrfCookie HandlerFor site () -> HandlerFor site res -> HandlerFor site res
    forall a b.
    HandlerFor site a -> HandlerFor site b -> HandlerFor site b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> HandlerFor site res
    handler

    -- | Takes a 'SetCookie' and overrides its value with a CSRF token, then sets the cookie. See 'setCsrfCookieWithCookie'.
    --
    -- For details, see the "AJAX CSRF protection" section of "Yesod.Core.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 :: HandlerFor site res -> SetCookie -> HandlerFor site res
    csrfSetCookieMiddleware :: forall site res.
    HandlerFor site res -> SetCookie -> HandlerFor site res
    csrfSetCookieMiddleware HandlerFor site res
    handler SetCookie
    cookie = SetCookie -> HandlerFor site ()
    forall (m :: * -> *). MonadHandler m => SetCookie -> m ()
    setCsrfCookieWithCookie SetCookie
    cookie HandlerFor site () -> HandlerFor site res -> HandlerFor site res
    forall a b.
    HandlerFor site a -> HandlerFor site b -> HandlerFor site b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> HandlerFor site res
    handler

    -- | Calls 'defaultCsrfSetCookieMiddleware' and 'defaultCsrfCheckMiddleware'.
    --
    -- For details, see the "AJAX CSRF protection" section of "Yesod.Core.Handler".
    --
    -- You can chain this middleware together with other middleware like so:
    --
    -- @
    -- 'yesodMiddleware' = 'defaultYesodMiddleware' . 'defaultCsrfMiddleware'
    -- @
    --
    -- or:
    --
    -- @
    -- 'yesodMiddleware' app = 'defaultYesodMiddleware' $ 'defaultCsrfMiddleware' $ app
    -- @
    --
    -- Since 1.4.14
    defaultCsrfMiddleware :: Yesod site => HandlerFor site res -> HandlerFor site res
    defaultCsrfMiddleware :: forall site res.
    Yesod site =>
    HandlerFor site res -> HandlerFor site res
    defaultCsrfMiddleware = HandlerFor site res -> HandlerFor site res
    forall site res. HandlerFor site res -> HandlerFor site res
    defaultCsrfSetCookieMiddleware (HandlerFor site res -> HandlerFor site res)
    -> (HandlerFor site res -> HandlerFor site res)
    -> HandlerFor site res
    -> HandlerFor site res
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HandlerFor site res -> HandlerFor site res
    forall site res.
    Yesod site =>
    HandlerFor site res -> HandlerFor site res
    defaultCsrfCheckMiddleware

    -- | Convert a widget to a 'PageContent'.
    widgetToPageContent :: Yesod site
                        => WidgetFor site ()
                        -> HandlerFor site (PageContent (Route site))
    widgetToPageContent :: forall site.
    Yesod site =>
    WidgetFor site () -> HandlerFor site (PageContent (Route site))
    widgetToPageContent WidgetFor site ()
    w = do
     jsAttrs <- HandlerFor site [(Text, Text)]
    forall site. Yesod site => HandlerFor site [(Text, Text)]
    jsAttributesHandler
     HandlerFor $ \HandlerData site site
    hd -> do
      master <- HandlerFor site site -> HandlerData site site -> IO site
    forall site a. HandlerFor site a -> HandlerData site site -> IO a
    unHandlerFor HandlerFor site site
    HandlerFor site (HandlerSite (HandlerFor site))
    forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
    getYesod HandlerData site site
    hd
      ref <- newIORef mempty
      unWidgetFor w WidgetData
        { wdRef = ref
        , wdHandler = hd
        }
      GWData (Body body) (Last mTitle) (Last mDescription) scripts' stylesheets' style jscript (Head head') <- readIORef ref
      let title = Html -> (Title -> Html) -> Maybe Title -> Html
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Html
    forall a. Monoid a => a
    mempty Title -> Html
    unTitle Maybe Title
    mTitle
          description = Description -> Text
    unDescription (Description -> Text) -> Maybe Description -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Description
    mDescription
          scripts = UniqueList (Script (Route site)) -> [Script (Route site)]
    forall x. Eq x => UniqueList x -> [x]
    runUniqueList UniqueList (Script (Route site))
    scripts'
          stylesheets = UniqueList (Stylesheet (Route site)) -> [Stylesheet (Route site)]
    forall x. Eq x => UniqueList x -> [x]
    runUniqueList UniqueList (Stylesheet (Route site))
    stylesheets'

      flip unHandlerFor hd $ do
        render <- getUrlRenderParams
        let renderLoc Maybe (Either Text (Route site, [(Text, Text)]))
    x =
                case Maybe (Either Text (Route site, [(Text, Text)]))
    x of
                    Maybe (Either Text (Route site, [(Text, Text)]))
    Nothing -> Maybe Text
    forall a. Maybe a
    Nothing
                    Just (Left Text
    s) -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    s
                    Just (Right (Route site
    u, [(Text, Text)]
    p)) -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Route site -> [(Text, Text)] -> Text
    render Route site
    u [(Text, Text)]
    p
        css <- forM (Map.toList style) $ \(Maybe Text
    mmedia, CssBuilderUrl (Route site)
    content) -> do
            let rendered :: Text
    rendered = Builder -> Text
    toLazyText (Builder -> Text) -> Builder -> Text
    forall a b. (a -> b) -> a -> b
    $ CssBuilderUrl (Route site)
    content Route site -> [(Text, Text)] -> Text
    render
            x <- Text
    -> Text
    -> ByteString
    -> HandlerFor
         site (Maybe (Either Text (Route site, [(Text, Text)])))
    forall site.
    Yesod site =>
    Text
    -> Text
    -> ByteString
    -> HandlerFor
         site (Maybe (Either Text (Route site, [(Text, Text)])))
    addStaticContent Text
    "css" Text
    "text/css; charset=utf-8"
               (ByteString
     -> HandlerFor
          site (Maybe (Either Text (Route site, [(Text, Text)]))))
    -> ByteString
    -> HandlerFor
         site (Maybe (Either Text (Route site, [(Text, Text)])))
    forall a b. (a -> b) -> a -> b
    $ Text -> ByteString
    encodeUtf8 Text
    rendered
            return (mmedia,
                case x of
                    Maybe (Either Text (Route site, [(Text, Text)]))
    Nothing -> Html -> Either Html Text
    forall a b. a -> Either a b
    Left (Html -> Either Html Text) -> Html -> Either Html Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Html
    forall a. ToMarkup a => a -> Html
    preEscapedToMarkup Text
    rendered
                    Just Either Text (Route site, [(Text, Text)])
    y -> Text -> Either Html Text
    forall a b. b -> Either a b
    Right (Text -> Either Html Text) -> Text -> Either Html Text
    forall a b. (a -> b) -> a -> b
    $ (Text -> Text)
    -> ((Route site, [(Text, Text)]) -> Text)
    -> Either Text (Route site, [(Text, Text)])
    -> Text
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Text -> Text
    forall a. a -> a
    id ((Route site -> [(Text, Text)] -> Text)
    -> (Route site, [(Text, Text)]) -> Text
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Route site -> [(Text, Text)] -> Text
    render) Either Text (Route site, [(Text, Text)])
    y)
        jsLoc <-
            case jscript of
                Maybe (JavascriptUrl (Route site))
    Nothing -> Maybe Text -> HandlerFor site (Maybe Text)
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Text
    forall a. Maybe a
    Nothing
                Just JavascriptUrl (Route site)
    s -> do
                    x <- Text
    -> Text
    -> ByteString
    -> HandlerFor
         site (Maybe (Either Text (Route site, [(Text, Text)])))
    forall site.
    Yesod site =>
    Text
    -> Text
    -> ByteString
    -> HandlerFor
         site (Maybe (Either Text (Route site, [(Text, Text)])))
    addStaticContent Text
    "js" Text
    "text/javascript; charset=utf-8"
                       (ByteString
     -> HandlerFor
          site (Maybe (Either Text (Route site, [(Text, Text)]))))
    -> ByteString
    -> HandlerFor
         site (Maybe (Either Text (Route site, [(Text, Text)])))
    forall a b. (a -> b) -> a -> b
    $ Text -> ByteString
    encodeUtf8 (Text -> ByteString) -> Text -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Route site -> [(Text, Text)] -> Text)
    -> JavascriptUrl (Route site) -> Text
    forall url.
    (url -> [(Text, Text)] -> Text) -> JavascriptUrl url -> Text
    renderJavascriptUrl Route site -> [(Text, Text)] -> Text
    render JavascriptUrl (Route site)
    s
                    return $ renderLoc x

        -- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing
        -- the asynchronous loader means your page doesn't have to wait for all the js to load
        let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
            regularScriptLoad = HtmlUrl (Route site)
    [hamlet|
                $newline never
                $forall s <- scripts
                    ^{mkScriptTag s}
                $maybe j <- jscript
                    $maybe s <- jsLoc
                        <script src="#{s}" *{jsAttrs}>
                    $nothing
                        <script *{jsAttrs}>^{jelper j}
            |]

            headAll = HtmlUrl (Route site)
    [hamlet|
                $newline never
                \^{head'}
                $forall s <- stylesheets
                    ^{mkLinkTag s}
                $forall s <- css
                    $maybe t <- right $ snd s
                        $maybe media <- fst s
                            <link rel=stylesheet media=#{media} href=#{t}>
                        $nothing
                            <link rel=stylesheet href=#{t}>
                    $maybe content <- left $ snd s
                        $maybe media <- fst s
                            <style media=#{media}>#{content}
                        $nothing
                            <style>#{content}
                $case jsLoader master
                  $of BottomOfBody
                  $of BottomOfHeadAsync asyncJsLoader
                      ^{asyncJsLoader asyncScripts mcomplete}
                  $of BottomOfHeadBlocking
                      ^{regularScriptLoad}
            |]
        let bodyScript = HtmlUrl (Route site)
    [hamlet|
                $newline never
                ^{body}
                ^{regularScriptLoad}
            |]

        return $ PageContent title description headAll $
            case jsLoader master of
                ScriptLoadPosition site
    BottomOfBody -> HtmlUrl (Route site)
    bodyScript
                ScriptLoadPosition site
    _ -> HtmlUrl (Route site)
    body
      where
        renderLoc' :: (t -> [a] -> Text) -> Location t -> Text
    renderLoc' t -> [a] -> Text
    render' (Local t
    url) = t -> [a] -> Text
    render' t
    url []
        renderLoc' t -> [a] -> Text
    _ (Remote Text
    s) = Text
    s

        addAttr :: h -> (Text, a) -> h
    addAttr h
    x (Text
    y, a
    z) = h
    x h -> Attribute -> h
    forall h. Attributable h => h -> Attribute -> h
    ! Tag -> AttributeValue -> Attribute
    customAttribute (Text -> Tag
    textTag Text
    y) (a -> AttributeValue
    forall a. ToValue a => a -> AttributeValue
    toValue a
    z)
        mkScriptTag :: Script t -> (t -> [a] -> Text) -> Html
    mkScriptTag (Script Location t
    loc [(Text, Text)]
    attrs) t -> [a] -> Text
    render' =
            ((Html -> Html) -> (Text, Text) -> Html -> Html)
    -> (Html -> Html) -> [(Text, Text)] -> Html -> Html
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (Html -> Html) -> (Text, Text) -> Html -> Html
    forall {h} {a}. (Attributable h, ToValue a) => h -> (Text, a) -> h
    addAttr Html -> Html
    TBH.script ((Text
    "src", (t -> [a] -> Text) -> Location t -> Text
    forall {t} {a}. (t -> [a] -> Text) -> Location t -> Text
    renderLoc' t -> [a] -> Text
    render' Location t
    loc) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
    forall a. a -> [a] -> [a]
    : [(Text, Text)]
    attrs) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ () -> Html
    forall a. a -> MarkupM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        mkLinkTag :: Stylesheet t -> (t -> [a] -> Text) -> Html
    mkLinkTag (Stylesheet Location t
    loc [(Text, Text)]
    attrs) t -> [a] -> Text
    render' =
            (Html -> (Text, Text) -> Html) -> Html -> [(Text, Text)] -> Html
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Html -> (Text, Text) -> Html
    forall {h} {a}. (Attributable h, ToValue a) => h -> (Text, a) -> h
    addAttr Html
    TBH.link
                ( (Text
    "rel", Text
    "stylesheet")
                (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
    forall a. a -> [a] -> [a]
    : (Text
    "href", (t -> [a] -> Text) -> Location t -> Text
    forall {t} {a}. (t -> [a] -> Text) -> Location t -> Text
    renderLoc' t -> [a] -> Text
    render' Location t
    loc)
                (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
    forall a. a -> [a] -> [a]
    : [(Text, Text)]
    attrs
                )

        runUniqueList :: Eq x => UniqueList x -> [x]
        runUniqueList :: forall x. Eq x => UniqueList x -> [x]
    runUniqueList (UniqueList [x] -> [x]
    x) = [x] -> [x]
    forall a. Eq a => [a] -> [a]
    nub ([x] -> [x]) -> [x] -> [x]
    forall a b. (a -> b) -> a -> b
    $ [x] -> [x]
    x []

    -- | The default error handler for 'errorHandler'.
    defaultErrorHandler :: Yesod site => ErrorResponse -> HandlerFor site TypedContent
    defaultErrorHandler :: forall site.
    Yesod site =>
    ErrorResponse -> HandlerFor site TypedContent
    defaultErrorHandler ErrorResponse
    NotFound = Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall (m :: * -> *).
    MonadHandler m =>
    Writer (Endo [ProvidedRep m]) () -> m TypedContent
    selectRep (Writer (Endo [ProvidedRep (HandlerFor site)]) ()
     -> HandlerFor site TypedContent)
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall a b. (a -> b) -> a -> b
    $ do
        HandlerFor site Html
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Html
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Html
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ WidgetFor site () -> HandlerFor site Html
    forall site.
    Yesod site =>
    WidgetFor site () -> HandlerFor site Html
    defaultLayout (WidgetFor site () -> HandlerFor site Html)
    -> WidgetFor site () -> HandlerFor site Html
    forall a b. (a -> b) -> a -> b
    $ do
            r <- WidgetFor site Request
    forall (m :: * -> *). MonadHandler m => m Request
    waiRequest
            let path' = OnDecodeError -> ByteString -> Text
    TE.decodeUtf8With OnDecodeError
    TEE.lenientDecode (ByteString -> Text) -> ByteString -> Text
    forall a b. (a -> b) -> a -> b
    $ Request -> ByteString
    W.rawPathInfo Request
    r
            defaultMessageWidget "Not Found" [hamlet|<p>#{path'}|]
        HandlerFor site Value
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Value
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Value
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ Value -> HandlerFor site Value
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> HandlerFor site Value) -> Value -> HandlerFor site Value
    forall a b. (a -> b) -> a -> b
    $ [Pair] -> Value
    object [Key
    "message" Key -> Text -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= (Text
    "Not Found" :: Text)]
        HandlerFor site Text
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Text
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Text
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ Text -> HandlerFor site Text
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text
    "Not Found" :: Text)

    -- For API requests.
    -- For a user with a browser,
    -- if you specify an authRoute the user will be redirected there and
    -- this page will not be shown.
    defaultErrorHandler ErrorResponse
    NotAuthenticated = Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall (m :: * -> *).
    MonadHandler m =>
    Writer (Endo [ProvidedRep m]) () -> m TypedContent
    selectRep (Writer (Endo [ProvidedRep (HandlerFor site)]) ()
     -> HandlerFor site TypedContent)
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall a b. (a -> b) -> a -> b
    $ do
        HandlerFor site Html
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Html
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Html
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ WidgetFor site () -> HandlerFor site Html
    forall site.
    Yesod site =>
    WidgetFor site () -> HandlerFor site Html
    defaultLayout (WidgetFor site () -> HandlerFor site Html)
    -> WidgetFor site () -> HandlerFor site Html
    forall a b. (a -> b) -> a -> b
    $ Html -> HtmlUrl (Route site) -> WidgetFor site ()
    forall site.
    Yesod site =>
    Html -> HtmlUrl (Route site) -> WidgetFor site ()
    defaultMessageWidget
            Html
    "Not logged in"
            HtmlUrl (Route site)
    [hamlet|<p style="display:none;">Set the authRoute and the user will be redirected there.|]

        HandlerFor site Value
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Value
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Value
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ do
            -- 401 *MUST* include a WWW-Authenticate header
            -- however, there is no standard to indicate a redirection
            --
            -- change this to Basic or Digest if you allow those forms of authentications
            Text -> Text -> HandlerFor site ()
    forall (m :: * -> *). MonadHandler m => Text -> Text -> m ()
    addHeader Text
    "WWW-Authenticate" Text
    "RedirectJSON realm=\"application\", param=\"authentication_url\""

            -- The client will just use the authentication_url in the JSON
            site <- HandlerFor site site
    HandlerFor site (HandlerSite (HandlerFor site))
    forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
    getYesod
            rend <- getUrlRender
            let apair Route site
    u = [Key
    "authentication_url" Key -> Text -> a
    forall v. ToJSON v => Key -> v -> a
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Route site -> Text
    rend Route site
    u]
                content = [Pair] -> (Route site -> [Pair]) -> Maybe (Route site) -> [Pair]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] Route site -> [Pair]
    forall {e} {a}. KeyValue e a => Route site -> [a]
    apair (site -> Maybe (Route site)
    forall site. Yesod site => site -> Maybe (Route site)
    authRoute site
    site)
            return $ object $ ("message" .= ("Not logged in"::Text)):content
        HandlerFor site Text
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Text
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Text
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ Text -> HandlerFor site Text
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text
    "Not logged in" :: Text)

    defaultErrorHandler (PermissionDenied Text
    msg) = Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall (m :: * -> *).
    MonadHandler m =>
    Writer (Endo [ProvidedRep m]) () -> m TypedContent
    selectRep (Writer (Endo [ProvidedRep (HandlerFor site)]) ()
     -> HandlerFor site TypedContent)
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall a b. (a -> b) -> a -> b
    $ do
        HandlerFor site Html
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Html
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Html
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ WidgetFor site () -> HandlerFor site Html
    forall site.
    Yesod site =>
    WidgetFor site () -> HandlerFor site Html
    defaultLayout (WidgetFor site () -> HandlerFor site Html)
    -> WidgetFor site () -> HandlerFor site Html
    forall a b. (a -> b) -> a -> b
    $ Html -> HtmlUrl (Route site) -> WidgetFor site ()
    forall site.
    Yesod site =>
    Html -> HtmlUrl (Route site) -> WidgetFor site ()
    defaultMessageWidget
            Html
    "Permission Denied"
            HtmlUrl (Route site)
    [hamlet|<p>#{msg}|]
        HandlerFor site Value
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Value
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Value
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $
            Value -> HandlerFor site Value
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> HandlerFor site Value) -> Value -> HandlerFor site Value
    forall a b. (a -> b) -> a -> b
    $ [Pair] -> Value
    object [Key
    "message" Key -> Text -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= (Text
    "Permission Denied. " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    msg)]
        HandlerFor site Text
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Text
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Text
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ Text -> HandlerFor site Text
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> HandlerFor site Text) -> Text -> HandlerFor site Text
    forall a b. (a -> b) -> a -> b
    $ Text
    "Permission Denied. " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    msg

    defaultErrorHandler (InvalidArgs [Text]
    ia) = Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall (m :: * -> *).
    MonadHandler m =>
    Writer (Endo [ProvidedRep m]) () -> m TypedContent
    selectRep (Writer (Endo [ProvidedRep (HandlerFor site)]) ()
     -> HandlerFor site TypedContent)
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall a b. (a -> b) -> a -> b
    $ do
        HandlerFor site Html
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Html
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Html
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ WidgetFor site () -> HandlerFor site Html
    forall site.
    Yesod site =>
    WidgetFor site () -> HandlerFor site Html
    defaultLayout (WidgetFor site () -> HandlerFor site Html)
    -> WidgetFor site () -> HandlerFor site Html
    forall a b. (a -> b) -> a -> b
    $ Html -> HtmlUrl (Route site) -> WidgetFor site ()
    forall site.
    Yesod site =>
    Html -> HtmlUrl (Route site) -> WidgetFor site ()
    defaultMessageWidget
            Html
    "Invalid Arguments"
            HtmlUrl (Route site)
    [hamlet|
                <ul>
                    $forall msg <- ia
                        <li>#{msg}
            |]
        HandlerFor site Value
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Value
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Value
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ Value -> HandlerFor site Value
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> HandlerFor site Value) -> Value -> HandlerFor site Value
    forall a b. (a -> b) -> a -> b
    $ [Pair] -> Value
    object [Key
    "message" Key -> Text -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= (Text
    "Invalid Arguments" :: Text), Key
    "errors" Key -> [Text] -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= [Text]
    ia]
        HandlerFor site Text
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Text
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Text
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ Text -> HandlerFor site Text
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text
    "Invalid Arguments: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> [Text] -> Text
    T.intercalate Text
    " " [Text]
    ia)

    defaultErrorHandler (InternalError Text
    e) = do
        $Text -> Text -> HandlerFor site ()
    logErrorS Text
    "yesod-core" Text
    e
        Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall (m :: * -> *).
    MonadHandler m =>
    Writer (Endo [ProvidedRep m]) () -> m TypedContent
    selectRep (Writer (Endo [ProvidedRep (HandlerFor site)]) ()
     -> HandlerFor site TypedContent)
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall a b. (a -> b) -> a -> b
    $ do
            HandlerFor site Html
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Html
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Html
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ WidgetFor site () -> HandlerFor site Html
    forall site.
    Yesod site =>
    WidgetFor site () -> HandlerFor site Html
    defaultLayout (WidgetFor site () -> HandlerFor site Html)
    -> WidgetFor site () -> HandlerFor site Html
    forall a b. (a -> b) -> a -> b
    $ Html -> HtmlUrl (Route site) -> WidgetFor site ()
    forall site.
    Yesod site =>
    Html -> HtmlUrl (Route site) -> WidgetFor site ()
    defaultMessageWidget
                Html
    "Internal Server Error"
                HtmlUrl (Route site)
    [hamlet|<pre>#{e}|]
            HandlerFor site Value
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Value
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Value
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ Value -> HandlerFor site Value
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> HandlerFor site Value) -> Value -> HandlerFor site Value
    forall a b. (a -> b) -> a -> b
    $ [Pair] -> Value
    object [Key
    "message" Key -> Text -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= (Text
    "Internal Server Error" :: Text), Key
    "error" Key -> Text -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Text
    e]
            HandlerFor site Text
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Text
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Text
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ Text -> HandlerFor site Text
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> HandlerFor site Text) -> Text -> HandlerFor site Text
    forall a b. (a -> b) -> a -> b
    $ Text
    "Internal Server Error: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    e

    defaultErrorHandler (BadMethod ByteString
    m) = Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall (m :: * -> *).
    MonadHandler m =>
    Writer (Endo [ProvidedRep m]) () -> m TypedContent
    selectRep (Writer (Endo [ProvidedRep (HandlerFor site)]) ()
     -> HandlerFor site TypedContent)
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall a b. (a -> b) -> a -> b
    $ do
        HandlerFor site Html
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Html
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Html
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ WidgetFor site () -> HandlerFor site Html
    forall site.
    Yesod site =>
    WidgetFor site () -> HandlerFor site Html
    defaultLayout (WidgetFor site () -> HandlerFor site Html)
    -> WidgetFor site () -> HandlerFor site Html
    forall a b. (a -> b) -> a -> b
    $ Html -> HtmlUrl (Route site) -> WidgetFor site ()
    forall site.
    Yesod site =>
    Html -> HtmlUrl (Route site) -> WidgetFor site ()
    defaultMessageWidget
            Html
    "Method Not Supported"
            HtmlUrl (Route site)
    [hamlet|<p>Method <code>#{S8.unpack m}</code> not supported|]
        HandlerFor site Value
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Value
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Value
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ Value -> HandlerFor site Value
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> HandlerFor site Value) -> Value -> HandlerFor site Value
    forall a b. (a -> b) -> a -> b
    $ [Pair] -> Value
    object [Key
    "message" Key -> Text -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= (Text
    "Bad method" :: Text), Key
    "method" Key -> Text -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= OnDecodeError -> ByteString -> Text
    TE.decodeUtf8With OnDecodeError
    TEE.lenientDecode ByteString
    m]
        HandlerFor site Text
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Text
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Text
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ Text -> HandlerFor site Text
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> HandlerFor site Text) -> Text -> HandlerFor site Text
    forall a b. (a -> b) -> a -> b
    $ Text
    "Bad Method " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> OnDecodeError -> ByteString -> Text
    TE.decodeUtf8With OnDecodeError
    TEE.lenientDecode ByteString
    m

    asyncHelper :: (url -> [x] -> Text)
             -> [Script url]
             -> Maybe (JavascriptUrl url)
             -> Maybe Text
             -> (Maybe (HtmlUrl url), [Text])
    asyncHelper :: forall url x.
    (url -> [x] -> Text)
    -> [Script url]
    -> Maybe (JavascriptUrl url)
    -> Maybe Text
    -> (Maybe (HtmlUrl url), [Text])
    asyncHelper url -> [x] -> Text
    render [Script url]
    scripts Maybe (JavascriptUrl url)
    jscript Maybe Text
    jsLoc =
        (Maybe (HtmlUrl url)
    mcomplete, [Text]
    scripts'')
      where
        scripts' :: [Text]
    scripts' = (Script url -> Text) -> [Script url] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Script url -> Text
    goScript [Script url]
    scripts
        scripts'' :: [Text]
    scripts'' =
            case Maybe Text
    jsLoc of
                Just Text
    s -> [Text]
    scripts' [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++ [Text
    s]
                Maybe Text
    Nothing -> [Text]
    scripts'
        goScript :: Script url -> Text
    goScript (Script (Local url
    url) [(Text, Text)]
    _) = url -> [x] -> Text
    render url
    url []
        goScript (Script (Remote Text
    s) [(Text, Text)]
    _) = Text
    s
        mcomplete :: Maybe (HtmlUrl url)
    mcomplete =
            case Maybe Text
    jsLoc of
                Just{} -> Maybe (HtmlUrl url)
    forall a. Maybe a
    Nothing
                Maybe Text
    Nothing ->
                    case Maybe (JavascriptUrl url)
    jscript of
                        Maybe (JavascriptUrl url)
    Nothing -> Maybe (HtmlUrl url)
    forall a. Maybe a
    Nothing
                        Just JavascriptUrl url
    j -> HtmlUrl url -> Maybe (HtmlUrl url)
    forall a. a -> Maybe a
    Just (HtmlUrl url -> Maybe (HtmlUrl url))
    -> HtmlUrl url -> Maybe (HtmlUrl url)
    forall a b. (a -> b) -> a -> b
    $ JavascriptUrl url -> HtmlUrl url
    forall url. JavascriptUrl url -> HtmlUrl url
    jelper JavascriptUrl url
    j

    -- | Default formatting for log messages. When you use
    -- the template haskell logging functions for to log with information
    -- about the source location, that information will be appended to
    -- the end of the log. When you use the non-TH logging functions,
    -- like 'logDebugN', this function does not include source
    -- information. This currently works by checking to see if the
    -- package name is the string \"\<unknown\>\". This is a hack,
    -- but it removes some of the visual clutter from non-TH logs.
    --
    -- Since 1.4.10
    formatLogMessage :: IO ZonedDate
                     -> Loc
                     -> LogSource
                     -> LogLevel
                     -> LogStr -- ^ message
                     -> IO LogStr
    formatLogMessage :: IO ByteString -> Loc -> Text -> LogLevel -> LogStr -> IO LogStr
    formatLogMessage IO ByteString
    getdate Loc
    loc Text
    src LogLevel
    level LogStr
    msg = do
        now <- IO ByteString
    getdate
        return $ mempty
            `mappend` toLogStr now
            `mappend` " ["
            `mappend` (case level of
                LevelOther Text
    t -> Text -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr Text
    t
                LogLevel
    _ -> [Char] -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr ([Char] -> LogStr) -> [Char] -> LogStr
    forall a b. (a -> b) -> a -> b
    $ Int -> [Char] -> [Char]
    forall a. Int -> [a] -> [a]
    drop Int
    5 ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ LogLevel -> [Char]
    forall a. Show a => a -> [Char]
    show LogLevel
    level)
            `mappend` (if T.null src
                then mempty
                else "#" `mappend` toLogStr src)
            `mappend` "] "
            `mappend` msg
            `mappend` sourceSuffix
            `mappend` "\n"
        where
        sourceSuffix :: LogStr
    sourceSuffix = if Loc -> [Char]
    loc_package Loc
    loc [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "<unknown>" then LogStr
    "" else LogStr
    forall a. Monoid a => a
    mempty
            LogStr -> LogStr -> LogStr
    forall a. Monoid a => a -> a -> a
    `mappend` LogStr
    " @("
            LogStr -> LogStr -> LogStr
    forall a. Monoid a => a -> a -> a
    `mappend` [Char] -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr (Loc -> [Char]
    fileLocationToString Loc
    loc)
            LogStr -> LogStr -> LogStr
    forall a. Monoid a => a -> a -> a
    `mappend` LogStr
    ")"

    -- | Customize the cookies used by the session backend.  You may
    -- use this function on your definition of 'makeSessionBackend'.
    --
    -- For example, you could set the cookie domain so that it
    -- would work across many subdomains:
    --
    -- @
    -- makeSessionBackend site =
    --     (fmap . fmap) (customizeSessionCookies addDomain) ...
    --   where
    --     addDomain cookie = cookie { 'setCookieDomain' = Just \".example.com\" }
    -- @
    --
    -- Default: Do not customize anything ('id').
    customizeSessionCookies :: (SetCookie -> SetCookie) -> (SessionBackend -> SessionBackend)
    customizeSessionCookies :: (SetCookie -> SetCookie) -> SessionBackend -> SessionBackend
    customizeSessionCookies SetCookie -> SetCookie
    customizeCookie SessionBackend
    backend = SessionBackend
    backend'
      where
        customizeHeader :: Header -> Header
    customizeHeader (AddCookie SetCookie
    cookie) = SetCookie -> Header
    AddCookie (SetCookie -> SetCookie
    customizeCookie SetCookie
    cookie)
        customizeHeader Header
    other              = Header
    other
        customizeSaveSession :: (SessionMap -> IO [Header]) -> SessionMap -> IO [Header]
    customizeSaveSession = ((IO [Header] -> IO [Header])
    -> (SessionMap -> IO [Header]) -> SessionMap -> IO [Header]
    forall a b. (a -> b) -> (SessionMap -> a) -> SessionMap -> b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((IO [Header] -> IO [Header])
     -> (SessionMap -> IO [Header]) -> SessionMap -> IO [Header])
    -> ((Header -> Header) -> IO [Header] -> IO [Header])
    -> (Header -> Header)
    -> (SessionMap -> IO [Header])
    -> SessionMap
    -> IO [Header]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Header] -> [Header]) -> IO [Header] -> IO [Header]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (([Header] -> [Header]) -> IO [Header] -> IO [Header])
    -> ((Header -> Header) -> [Header] -> [Header])
    -> (Header -> Header)
    -> IO [Header]
    -> IO [Header]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Header -> Header) -> [Header] -> [Header]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) Header -> Header
    customizeHeader
        backend' :: SessionBackend
    backend' =
          SessionBackend
    backend {
            sbLoadSession = \Request
    req ->
              ((SessionMap -> IO [Header]) -> SessionMap -> IO [Header])
    -> (SessionMap, SessionMap -> IO [Header])
    -> (SessionMap, SessionMap -> IO [Header])
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (SessionMap -> IO [Header]) -> SessionMap -> IO [Header]
    customizeSaveSession ((SessionMap, SessionMap -> IO [Header])
     -> (SessionMap, SessionMap -> IO [Header]))
    -> IO (SessionMap, SessionMap -> IO [Header])
    -> IO (SessionMap, SessionMap -> IO [Header])
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` SessionBackend
    -> Request -> IO (SessionMap, SessionMap -> IO [Header])
    sbLoadSession SessionBackend
    backend Request
    req
          }

    defaultClientSessionBackend :: Int -- ^ minutes
                                -> FilePath -- ^ key file
                                -> IO SessionBackend
    defaultClientSessionBackend :: Int -> [Char] -> IO SessionBackend
    defaultClientSessionBackend Int
    minutes [Char]
    fp = do
      key <- [Char] -> IO Key
    CS.getKey [Char]
    fp
      (getCachedDate, _closeDateCacher) <- clientSessionDateCacher (minToSec minutes)
      return $ clientSessionBackend key getCachedDate

    -- | Create a @SessionBackend@ which reads the session key from the named
    -- environment variable.
    --
    -- This can be useful if:
    --
    -- 1. You can't rely on a persistent file system (e.g. Heroku)
    -- 2. Your application is open source (e.g. you can't commit the key)
    --
    -- By keeping a consistent value in the environment variable, your users will
    -- have consistent sessions without relying on the file system.
    --
    -- Note: A suitable value should only be obtained in one of two ways:
    --
    -- 1. Run this code without the variable set, a value will be generated and
    --    printed on @/dev/stdout/@
    -- 2. Use @clientsession-generate@
    --
    -- Since 1.4.5
    envClientSessionBackend :: Int -- ^ minutes
                            -> String -- ^ environment variable name
                            -> IO SessionBackend
    envClientSessionBackend :: Int -> [Char] -> IO SessionBackend
    envClientSessionBackend Int
    minutes [Char]
    name = do
        key <- [Char] -> IO Key
    CS.getKeyEnv [Char]
    name
        (getCachedDate, _closeDateCacher) <- clientSessionDateCacher $ minToSec minutes
        return $ clientSessionBackend key getCachedDate

    minToSec :: (Integral a, Num b) => a -> b
    minToSec :: forall a b. (Integral a, Num b) => a -> b
    minToSec a
    minutes = a -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a
    minutes a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    60)

    jsToHtml :: Javascript -> Html
    jsToHtml :: Javascript -> Html
    jsToHtml (Javascript Builder
    b) = Text -> Html
    forall a. ToMarkup a => a -> Html
    preEscapedToMarkup (Text -> Html) -> Text -> Html
    forall a b. (a -> b) -> a -> b
    $ Builder -> Text
    toLazyText Builder
    b

    jelper :: JavascriptUrl url -> HtmlUrl url
    jelper :: forall url. JavascriptUrl url -> HtmlUrl url
    jelper = (Javascript -> Html)
    -> ((url -> [(Text, Text)] -> Text) -> Javascript)
    -> (url -> [(Text, Text)] -> Text)
    -> Html
    forall a b.
    (a -> b)
    -> ((url -> [(Text, Text)] -> Text) -> a)
    -> (url -> [(Text, Text)] -> Text)
    -> b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Javascript -> Html
    jsToHtml

    left :: Either a b -> Maybe a
    left :: forall a b. Either a b -> Maybe a
    left (Left a
    x) = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x
    left Either a b
    _ = Maybe a
    forall a. Maybe a
    Nothing

    right :: Either a b -> Maybe b
    right :: forall a b. Either a b -> Maybe b
    right (Right b
    x) = b -> Maybe b
    forall a. a -> Maybe a
    Just b
    x
    right Either a b
    _ = Maybe b
    forall a. Maybe a
    Nothing

    clientSessionBackend :: CS.Key  -- ^ The encryption key
                         -> IO ClientSessionDateCache -- ^ See 'clientSessionDateCacher'
                         -> SessionBackend
    clientSessionBackend :: Key -> IO ClientSessionDateCache -> SessionBackend
    clientSessionBackend Key
    key IO ClientSessionDateCache
    getCachedDate =
      SessionBackend {
        sbLoadSession :: Request -> IO (SessionMap, SessionMap -> IO [Header])
    sbLoadSession = Key
    -> IO ClientSessionDateCache
    -> ByteString
    -> Request
    -> IO (SessionMap, SessionMap -> IO [Header])
    loadClientSession Key
    key IO ClientSessionDateCache
    getCachedDate ByteString
    "_SESSION"
      }

    justSingleton :: a -> [Maybe a] -> a
    justSingleton :: forall a. a -> [Maybe a] -> a
    justSingleton a
    d = [a] -> a
    just ([a] -> a) -> ([Maybe a] -> [a]) -> [Maybe a] -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe a] -> [a]
    forall a. [Maybe a] -> [a]
    catMaybes
      where
        just :: [a] -> a
    just [a
    s] = a
    s
        just [a]
    _   = a
    d

    loadClientSession :: CS.Key
                      -> IO ClientSessionDateCache -- ^ See 'clientSessionDateCacher'
                      -> S8.ByteString -- ^ session name
                      -> W.Request
                      -> IO (SessionMap, SaveSession)
    loadClientSession :: Key
    -> IO ClientSessionDateCache
    -> ByteString
    -> Request
    -> IO (SessionMap, SessionMap -> IO [Header])
    loadClientSession Key
    key IO ClientSessionDateCache
    getCachedDate ByteString
    sessionName Request
    req = IO (SessionMap, SessionMap -> IO [Header])
    load
      where
        load :: IO (SessionMap, SessionMap -> IO [Header])
    load = do
          date <- IO ClientSessionDateCache
    getCachedDate
          return (sess date, save date)
        sess :: ClientSessionDateCache -> SessionMap
    sess ClientSessionDateCache
    date = SessionMap -> [Maybe SessionMap] -> SessionMap
    forall a. a -> [Maybe a] -> a
    justSingleton SessionMap
    forall k a. Map k a
    Map.empty ([Maybe SessionMap] -> SessionMap)
    -> [Maybe SessionMap] -> SessionMap
    forall a b. (a -> b) -> a -> b
    $ do
          raw <- [ByteString
    v | (CI ByteString
    k, ByteString
    v) <- Request -> RequestHeaders
    W.requestHeaders Request
    req, CI ByteString
    k CI ByteString -> CI ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == CI ByteString
    "Cookie"]
          val <- [v | (k, v) <- parseCookies raw, k == sessionName]
          let host = ByteString
    "" -- fixme, properly lock sessions to client address
          return $ decodeClientSession key date host val
        save :: ClientSessionDateCache -> SessionMap -> m [Header]
    save ClientSessionDateCache
    date SessionMap
    sess' = do
          -- We should never cache the IV!  Be careful!
          iv <- IO IV -> m IV
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO IV
    CS.randomIV
          return [AddCookie defaultSetCookie
              { setCookieName = sessionName
              , setCookieValue = encodeClientSession key iv date host sess'
              , setCookiePath = Just "/"
              , setCookieExpires = Just (csdcExpires date)
              , setCookieDomain = Nothing
              , setCookieHttpOnly = True
              }]
            where
              host :: ByteString
    host = ByteString
    "" -- fixme, properly lock sessions to client address

    -- taken from file-location package
    -- turn the TH Loc loaction information into a human readable string
    -- leaving out the loc_end parameter
    fileLocationToString :: Loc -> String
    fileLocationToString :: Loc -> [Char]
    fileLocationToString Loc
    loc =
        [[Char]] -> [Char]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
          [ Loc -> [Char]
    loc_package Loc
    loc
          , Char
    ':' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : Loc -> [Char]
    loc_module Loc
    loc
          , Char
    ' ' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : Loc -> [Char]
    loc_filename Loc
    loc
          , Char
    ':' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : Loc -> [Char]
    line Loc
    loc
          , Char
    ':' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : Loc -> [Char]
    char Loc
    loc
          ]
      where
        line :: Loc -> [Char]
    line = Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int -> [Char]) -> (Loc -> Int) -> Loc -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CharPos -> Int
    forall a b. (a, b) -> a
    fst (CharPos -> Int) -> (Loc -> CharPos) -> Loc -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Loc -> CharPos
    loc_start
        char :: Loc -> [Char]
    char = Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int -> [Char]) -> (Loc -> Int) -> Loc -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CharPos -> Int
    forall a b. (a, b) -> b
    snd (CharPos -> Int) -> (Loc -> CharPos) -> Loc -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Loc -> CharPos
    loc_start

    -- | Guess the approot based on request headers. For more information, see
    -- "Network.Wai.Middleware.Approot"
    --
    -- In the case of headers being unavailable, it falls back to 'ApprootRelative'
    --
    -- Since 1.4.16
    guessApproot :: Approot site
    guessApproot :: forall site. Approot site
    guessApproot = Approot site -> Approot site
    forall site. Approot site -> Approot site
    guessApprootOr Approot site
    forall site. Approot site
    ApprootRelative

    -- | Guess the approot based on request headers, with fall back to the
    -- specified 'AppRoot'.
    --
    -- Since 1.4.16
    guessApprootOr :: Approot site -> Approot site
    guessApprootOr :: forall site. Approot site -> Approot site
    guessApprootOr Approot site
    fallback = (site -> Request -> Text) -> Approot site
    forall master. (master -> Request -> Text) -> Approot master
    ApprootRequest ((site -> Request -> Text) -> Approot site)
    -> (site -> Request -> Text) -> Approot site
    forall a b. (a -> b) -> a -> b
    $ \site
    master Request
    req ->
        case Request -> Maybe ByteString
    W.requestHeaderHost Request
    req of
            Maybe ByteString
    Nothing -> Approot site -> site -> Request -> Text
    forall site. Approot site -> site -> Request -> Text
    getApprootText Approot site
    fallback site
    master Request
    req
            Just ByteString
    host ->
                (if Request -> Bool
    Network.Wai.Request.appearsSecure Request
    req
                    then Text
    "https://"
                    else Text
    "http://")
                Text -> Text -> Text
    `T.append` OnDecodeError -> ByteString -> Text
    TE.decodeUtf8With OnDecodeError
    TEE.lenientDecode ByteString
    host

    -- | Get the textual application root from an 'Approot' value.
    --
    -- Since 1.4.17
    getApprootText :: Approot site -> site -> W.Request -> Text
    getApprootText :: forall site. Approot site -> site -> Request -> Text
    getApprootText Approot site
    ar site
    site Request
    req =
        case Approot site
    ar of
            Approot site
    ApprootRelative -> Text
    ""
            ApprootStatic Text
    t -> Text
    t
            ApprootMaster site -> Text
    f -> site -> Text
    f site
    site
            ApprootRequest site -> Request -> Text
    f -> site -> Request -> Text
    f site
    site Request
    req