    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TypeFamilies #-}

    module Yesod.Core.Dispatch
        ( -- * Quasi-quoted routing
          parseRoutes
        , parseRoutesNoCheck
        , parseRoutesFile
        , parseRoutesFileNoCheck
        , mkYesod
        , mkYesodOpts
        , mkYesodWith
          -- ** More fine-grained
        , mkYesodData
        , mkYesodDataOpts
        , mkYesodSubData
        , mkYesodSubDataOpts
        , mkYesodDispatch
        , mkYesodDispatchOpts
        , mkYesodSubDispatch
          -- *** Route generation options
        , RouteOpts
        , defaultOpts
        , setEqDerived
        , setShowDerived
        , setReadDerived
        , setCreateResources
        , setParameterizedSubroute
          -- *** Helpers
        , defaultGen
        , getGetMaxExpires
          -- ** Path pieces
        , PathPiece (..)
        , PathMultiPiece (..)
        , Texts
          -- * Convert to WAI
        , toWaiApp
        , toWaiAppPlain
        , toWaiAppYre
        , warp
        , warpDebug
        , warpEnv
        , mkDefaultMiddlewares
        , defaultMiddlewaresNoLogging
          -- * WAI subsites
        , WaiSubsite (..)
        , WaiSubsiteWithAuth (..)
        ) where

    import Prelude hiding (exp)
    import Yesod.Core.Internal.TH
    import Language.Haskell.TH.Syntax (qLocation)

    import Web.PathPieces

    import qualified Network.Wai as W

    import Data.ByteString.Lazy.Char8 ()

    import Data.Bits ((.|.), finiteBitSize, shiftL)
    import Data.Text (Text)
    import qualified Data.ByteString as S
    import qualified Data.ByteString.Lazy as BL
    import qualified Data.ByteString.Char8 as S8
    import Data.ByteString.Builder (byteString, toLazyByteString)
    #if !MIN_VERSION_wai_extra(3,1,14)
    import Data.Default (def)
    #endif
    import Network.HTTP.Types (status301, status307)
    import Yesod.Routes.Parse
    import Yesod.Core.Types
    import Yesod.Core.Class.Yesod
    import Yesod.Core.Class.Dispatch
    import Yesod.Core.Internal.Run
    import Text.Read (readMaybe)
    import System.Environment (getEnvironment)
    import System.Entropy (getEntropy)
    import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction, updateFreq)
    import Yesod.Core.Internal.Util (getCurrentMaxExpiresRFC1123)

    import Network.Wai.Middleware.Autohead
    import Network.Wai.Middleware.AcceptOverride
    import Network.Wai.Middleware.RequestLogger
    import Network.Wai.Middleware.Gzip (
        gzip,
    #if MIN_VERSION_wai_extra(3,1,14)
        defaultGzipSettings,
    #endif
     )
    import Network.Wai.Middleware.MethodOverride

    import qualified Network.Wai.Handler.Warp
    import System.Log.FastLogger
    import Control.Monad.Logger
    import Control.Monad (when)
    import qualified Paths_yesod_core
    import Data.Version (showVersion)

    -- | Convert the given argument into a WAI application, executable with any WAI
    -- handler. This function will provide no middlewares; if you want commonly
    -- used middlewares, please use 'toWaiApp'.
    toWaiAppPlain :: YesodDispatch site => site -> IO W.Application
    toWaiAppPlain :: forall site. YesodDispatch site => site -> IO Application
    toWaiAppPlain site
    site = do
        logger <- site -> IO Logger
    forall site. Yesod site => site -> IO Logger
    makeLogger site
    site
        sb <- makeSessionBackend site
        getMaxExpires <- getGetMaxExpires
        return $ toWaiAppYre YesodRunnerEnv
                { yreLogger = logger
                , yreSite = site
                , yreSessionBackend = sb
                , yreGen = defaultGen
                , yreGetMaxExpires = getMaxExpires
                }

    -- | Generate a random number uniformly distributed in the full range
    -- of 'Int'.
    --
    -- Note: Before 1.6.20, this generates pseudo-random number in an
    -- unspecified range. The range size may not be a power of 2. Since
    -- 1.6.20, this uses a secure entropy source and generates in the full
    -- range of 'Int'.
    --
    -- @since 1.6.21.0
    defaultGen :: IO Int
    defaultGen :: IO Int
    defaultGen = ByteString -> Int
    bsToInt (ByteString -> Int) -> IO ByteString -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> IO ByteString
    getEntropy Int
    bytes
      where
        bits :: Int
    bits = Int -> Int
    forall b. FiniteBits b => b -> Int
    finiteBitSize (Int
    forall a. HasCallStack => a
    undefined :: Int)
        bytes :: Int
    bytes = Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    div (Int
    bits Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    7) Int
    8
        bsToInt :: ByteString -> Int
    bsToInt = (Int -> Word8 -> Int) -> Int -> ByteString -> Int
    forall a. (a -> Word8 -> a) -> a -> ByteString -> a
    S.foldl' (\Int
    v Word8
    i -> Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    shiftL Int
    v Int
    8 Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .|. Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    i) Int
    0

    -- | Pure low level function to construct WAI application. Usefull
    -- when you need not standard way to run your app, or want to embed it
    -- inside another app.
    --
    -- @since 1.4.29
    toWaiAppYre :: YesodDispatch site => YesodRunnerEnv site -> W.Application
    toWaiAppYre :: forall site.
    YesodDispatch site =>
    YesodRunnerEnv site -> Application
    toWaiAppYre YesodRunnerEnv site
    yre Request
    req =
        case site -> [Text] -> Either [Text] [Text]
    forall site. Yesod site => site -> [Text] -> Either [Text] [Text]
    cleanPath site
    site ([Text] -> Either [Text] [Text]) -> [Text] -> Either [Text] [Text]
    forall a b. (a -> b) -> a -> b
    $ Request -> [Text]
    W.pathInfo Request
    req of
            Left [Text]
    pieces -> site -> [Text] -> Application
    forall master. Yesod master => master -> [Text] -> Application
    sendRedirect site
    site [Text]
    pieces Request
    req
            Right [Text]
    pieces -> YesodRunnerEnv site -> Application
    forall site.
    YesodDispatch site =>
    YesodRunnerEnv site -> Application
    yesodDispatch YesodRunnerEnv site
    yre Request
    req
                { W.pathInfo = pieces
                }
      where
        site :: site
    site = YesodRunnerEnv site -> site
    forall site. YesodRunnerEnv site -> site
    yreSite YesodRunnerEnv site
    yre
        sendRedirect :: Yesod master => master -> [Text] -> W.Application
        sendRedirect :: forall master. Yesod master => master -> [Text] -> Application
    sendRedirect master
    y [Text]
    segments' Request
    env Response -> IO ResponseReceived
    sendResponse =
             Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> ByteString -> Response
    W.responseLBS Status
    status
                    [ (HeaderName
    "Content-Type", ByteString
    "text/plain")
                    , (HeaderName
    "Location", ByteString -> ByteString
    BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Builder -> ByteString
    toLazyByteString Builder
    dest')
                    ] ByteString
    "Redirecting"
          where
            -- Ensure that non-GET requests get redirected correctly. See:
            -- https://github.com/yesodweb/yesod/issues/951
            status :: Status
    status
                | Request -> ByteString
    W.requestMethod Request
    env ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "GET" = Status
    status301
                | Bool
    otherwise                    = Status
    status307

            dest :: Builder
    dest = master -> Text -> [Text] -> [(Text, Text)] -> Builder
    forall site.
    Yesod site =>
    site -> Text -> [Text] -> [(Text, Text)] -> Builder
    joinPath master
    y (master -> Request -> Text
    forall master. Yesod master => master -> Request -> Text
    resolveApproot master
    y Request
    env) [Text]
    segments' []
            dest' :: Builder
    dest' =
                if ByteString -> Bool
    S.null (Request -> ByteString
    W.rawQueryString Request
    env)
                    then Builder
    dest
                    else Builder
    dest Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend`
                         ByteString -> Builder
    byteString (Request -> ByteString
    W.rawQueryString Request
    env)

    -- | Same as 'toWaiAppPlain', but provides a default set of middlewares. This
    -- set may change with future releases, but currently covers:
    --
    -- * Logging
    --
    -- * GZIP compression
    --
    -- * Automatic HEAD method handling
    --
    -- * Request method override with the _method query string parameter
    --
    -- * Accept header override with the _accept query string parameter
    toWaiApp :: YesodDispatch site => site -> IO W.Application
    toWaiApp :: forall site. YesodDispatch site => site -> IO Application
    toWaiApp site
    site = do
        logger <- site -> IO Logger
    forall site. Yesod site => site -> IO Logger
    makeLogger site
    site
        toWaiAppLogger logger site

    toWaiAppLogger :: YesodDispatch site => Logger -> site -> IO W.Application
    toWaiAppLogger :: forall site. YesodDispatch site => Logger -> site -> IO Application
    toWaiAppLogger Logger
    logger site
    site = do
        sb <- site -> IO (Maybe SessionBackend)
    forall site. Yesod site => site -> IO (Maybe SessionBackend)
    makeSessionBackend site
    site
        getMaxExpires <- getGetMaxExpires
        let yre = YesodRunnerEnv
                    { yreLogger :: Logger
    yreLogger = Logger
    logger
                    , yreSite :: site
    yreSite = site
    site
                    , yreSessionBackend :: Maybe SessionBackend
    yreSessionBackend = Maybe SessionBackend
    sb
                    , yreGen :: IO Int
    yreGen = IO Int
    defaultGen
                    , yreGetMaxExpires :: IO Text
    yreGetMaxExpires = IO Text
    getMaxExpires
                    }
        messageLoggerSource
            site
            logger
            $(qLocation >>= liftLoc)
            "yesod-core"
            LevelInfo
            (toLogStr ("Application launched" :: S.ByteString))
        middleware <- mkDefaultMiddlewares logger
        return $ middleware $ toWaiAppYre yre

    -- | A convenience method to run an application using the Warp webserver on the
    -- specified port. Automatically calls 'toWaiApp'. Provides a default set of
    -- middlewares. This set may change at any point without a breaking version
    -- number. Currently, it includes:
    --
    -- * Logging
    --
    -- * GZIP compression
    --
    -- * Automatic HEAD method handling
    --
    -- * Request method override with the _method query string parameter
    --
    -- * Accept header override with the _accept query string parameter
    --
    -- If you need more fine-grained control of middlewares, please use 'toWaiApp'
    -- directly.
    --
    -- Since 1.2.0
    warp :: YesodDispatch site => Int -> site -> IO ()
    warp :: forall site. YesodDispatch site => Int -> site -> IO ()
    warp Int
    port site
    site = do
        logger <- site -> IO Logger
    forall site. Yesod site => site -> IO Logger
    makeLogger site
    site
        toWaiAppLogger logger site >>= Network.Wai.Handler.Warp.runSettings (
            Network.Wai.Handler.Warp.setPort port $
            Network.Wai.Handler.Warp.setServerName serverValue $
            Network.Wai.Handler.Warp.setOnException (\Maybe Request
    _ SomeException
    e ->
                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SomeException -> Bool
    shouldLog' SomeException
    e) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                    site -> Logger -> Loc -> Text -> LogLevel -> LogStr -> IO ()
    forall site.
    Yesod site =>
    site -> Logger -> Loc -> Text -> LogLevel -> LogStr -> IO ()
    messageLoggerSource
                        site
    site
                        Logger
    logger
                        $(qLocation >>= liftLoc)
                        Text
    "yesod-core"
                        LogLevel
    LevelError
                        ([Char] -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr ([Char] -> LogStr) -> [Char] -> LogStr
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Exception from Warp: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SomeException -> [Char]
    forall a. Show a => a -> [Char]
    show SomeException
    e))
            Network.Wai.Handler.Warp.defaultSettings)
      where
        shouldLog' :: SomeException -> Bool
    shouldLog' = SomeException -> Bool
    Network.Wai.Handler.Warp.defaultShouldDisplayException

    serverValue :: S8.ByteString
    serverValue :: ByteString
    serverValue = [Char] -> ByteString
    S8.pack ([Char] -> ByteString) -> [Char] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        [ [Char]
    "Warp/"
        , [Char]
    Network.Wai.Handler.Warp.warpVersion
        , [Char]
    " + Yesod/"
        , Version -> [Char]
    showVersion Version
    Paths_yesod_core.version
        , [Char]
    " (core)"
        ]

    -- | A default set of middlewares.
    --
    -- Since 1.2.0
    mkDefaultMiddlewares :: Logger -> IO W.Middleware
    mkDefaultMiddlewares :: Logger -> IO Middleware
    mkDefaultMiddlewares Logger
    logger = do
        logWare <- RequestLoggerSettings -> IO Middleware
    mkRequestLogger
    #if MIN_VERSION_wai_extra(3,1,8)
            RequestLoggerSettings
    defaultRequestLoggerSettings
    #else
            def
    #endif
            { destination = Network.Wai.Middleware.RequestLogger.Logger $ loggerSet logger
            , outputFormat = Apache FromSocket
            }
        return $ logWare . defaultMiddlewaresNoLogging

    -- | All of the default middlewares, excluding logging.
    --
    -- Since 1.2.12
    defaultMiddlewaresNoLogging :: W.Middleware
    defaultMiddlewaresNoLogging :: Middleware
    defaultMiddlewaresNoLogging = Middleware
    acceptOverride Middleware -> Middleware -> Middleware
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Middleware
    autohead Middleware -> Middleware -> Middleware
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GzipSettings -> Middleware
    gzip GzipSettings
    gzipSettings Middleware -> Middleware -> Middleware
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Middleware
    methodOverride
      where
        gzipSettings :: GzipSettings
    gzipSettings =
    #if MIN_VERSION_wai_extra(3,1,14)
            GzipSettings
    defaultGzipSettings
    #else
            def
    #endif

    -- | Deprecated synonym for 'warp'.
    warpDebug :: YesodDispatch site => Int -> site -> IO ()
    warpDebug :: forall site. YesodDispatch site => Int -> site -> IO ()
    warpDebug = Int -> site -> IO ()
    forall site. YesodDispatch site => Int -> site -> IO ()
    warp
    {-# DEPRECATED warpDebug "Please use warp instead" #-}

    -- | Runs your application using default middlewares (i.e., via 'toWaiApp'). It
    -- reads port information from the PORT environment variable, as used by tools
    -- such as Keter and the FP Complete School of Haskell.
    --
    -- Note that the exact behavior of this function may be modified slightly over
    -- time to work correctly with external tools, without a change to the type
    -- signature.
    warpEnv :: YesodDispatch site => site -> IO ()
    warpEnv :: forall site. YesodDispatch site => site -> IO ()
    warpEnv site
    site = do
        env <- IO [([Char], [Char])]
    getEnvironment
        case lookup "PORT" env of
            Maybe [Char]
    Nothing -> [Char] -> IO ()
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "warpEnv: no PORT environment variable found"
            Just [Char]
    portS ->
                case [Char] -> Maybe Int
    forall a. Read a => [Char] -> Maybe a
    readMaybe [Char]
    portS of
                    Maybe Int
    Nothing -> [Char] -> IO ()
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "warpEnv: invalid PORT environment variable: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    portS
                    Just Int
    port -> Int -> site -> IO ()
    forall site. YesodDispatch site => Int -> site -> IO ()
    warp Int
    port site
    site

    -- | Default constructor for 'yreGetMaxExpires' field. Low level
    -- function for simple manual construction of 'YesodRunnerEnv'.
    --
    -- @since 1.4.29
    getGetMaxExpires :: IO (IO Text)
    getGetMaxExpires :: IO (IO Text)
    getGetMaxExpires = UpdateSettings Text -> IO (IO Text)
    forall a. UpdateSettings a -> IO (IO a)
    mkAutoUpdate UpdateSettings ()
    defaultUpdateSettings
      { updateAction = getCurrentMaxExpiresRFC1123
      , updateFreq = 24 * 60 * 60 * 1000000 -- Update once per day
      }