content: {-# OPTIONS_GHC -fno-warn-orphans #-}
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE ViewPatterns #-}
  {-# LANGUAGE BlockArguments #-}
  
  module Application
      ( App
      , withApplicationDev
      , withFoundationDev
      , makeApplication
      , appMain
      , develMain
      , withFoundation
      , makeLogWare
      -- * for DevelMain
      , withApplicationRepl
      -- * for GHCI
      , handler
      ) where
  
  import Control.AutoUpdate
  import Control.Concurrent (threadDelay)
  import Control.Monad.Logger (liftLoc)
  import Data.WebsiteContent
  import Import hiding (catch)
  import Language.Haskell.TH.Syntax (qLocation)
  import Network.Wai (Middleware, rawPathInfo, pathInfo, responseBuilder)
  import Network.Wai.Handler.Warp (Settings, defaultSettings,
                                   defaultShouldDisplayException, getPort,
                                   runSettings, setHost, setOnException, setPort)
  import Network.Wai.Middleware.ForceSSL (forceSSL)
  import Network.Wai.Middleware.RequestLogger (Destination(Logger),
                                               IPAddrSource(..), OutputFormat(..),
                                               destination, mkRequestLogger,
                                               outputFormat)
  import RIO (LogFunc, LogOptions, logOptionsHandle, withLogFunc, runRIO, logError, displayShow)
  import RIO.Prelude.Simple (runSimpleApp)
  import Stackage.Database (withStackageDatabase)
  import Stackage.Database.Cron (newHoogleLocker, singleRun)
  import Stackage.Database.Github (getStackageContentDir)
  import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr)
  import Yesod.Core.Types (loggerSet)
  import Yesod.Default.Config2
  import Yesod.Default.Handlers
  import Yesod.GitRepo
  import Yesod.GitRev (GitRev(..))
  
  -- Import all relevant handler modules here.
  import Handler.Blog
  import Handler.BuildPlan
  import Handler.Download
  import Handler.DownloadStack
  import Handler.Feed
  import Handler.Haddock
  import Handler.Home
  import Handler.Hoogle
  import Handler.MirrorStatus
  import Handler.OldLinks
  import Handler.Package
  import Handler.PackageDeps
  import Handler.PackageList
  import Handler.Sitemap
  import Handler.Snapshots
  import Handler.StackageHome
  import Handler.StackageIndex
  import Handler.StackageSdist
  import Handler.Stats
  import Handler.System
  
  --import Network.Wai.Middleware.Prometheus (prometheus)
  --import Prometheus (register)
  --import Prometheus.Metric.GHC (ghcMetrics)
  
  -- This line actually creates our YesodDispatch instance. It is the second half
  -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
  -- comments there for more details.
  mkYesodDispatch "App" resourcesApp
  
  -- This function allocates resources (such as a database connection pool),
  -- performs initialization and creates a WAI application. This is also the
  -- place to put your migrate statements to have automatic database
  -- migrations handled by Yesod.
  makeApplication :: App -> IO Application
  makeApplication foundation = do
      logWare <- makeLogWare foundation
      -- Create the WAI application and apply middlewares
      appPlain <- toWaiAppPlain foundation
  
      let middleware = id -- prometheus def
                     . healthz
  #if !DEVELOPMENT
                     . forceSSL' (appSettings foundation)
  #endif
                     . logWare
                     . defaultMiddlewaresNoLogging
  
      -- FIXME prometheus void (register ghcMetrics)
  
      return (middleware appPlain)
  
  -- | Bypass any overhead from Yesod
  healthz :: Middleware
  healthz app req send =
    case pathInfo req of
      ["healthz"] -> send $ responseBuilder status200 [("content-type", "text/plain; charset=utf-8")] "OK"
      _ -> app req send
  
  forceSSL' :: AppSettings -> Middleware
  forceSSL' settings app
      | appForceSsl settings = \req send ->
          -- Don't force SSL for tarballs, to provide 00-index.tar.gz and package
          -- tarball access for cabal-install
          if ".tar.gz" `isSuffixOf` rawPathInfo req
              then app req send
              else forceSSL app req send
      | otherwise = app
  
  -- | Loads up any necessary settings, creates your foundation datatype, and
  -- performs some initialization.
  --
  -- Some basic initializations: HTTP connection manager, logger, and static
  -- subsite.
  withFoundation :: LogFunc -> AppSettings -> (App -> IO a) -> IO a
  withFoundation appLogFunc appSettings inner = do
      appHttpManager <- newManager
      appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
      appStatic <-
          (if appMutableStatic appSettings
               then staticDevel
               else static)
              (appStaticDir appSettings)
      appWebsiteContent <-
          if appDevDownload appSettings
              then do
                  fp <- runSimpleApp $ getStackageContentDir "."
                  gitRepoDev fp loadWebsiteContent
              else gitRepo "https://github.com/commercialhaskell/stackage-content.git" "master" loadWebsiteContent
      let runContentUpdates =
              Concurrently $
              forever $
              void $ do
                  threadDelay $ 1000 * 1000 * 60 * 5
                  handleAny (runRIO appLogFunc . RIO.logError . fromString . displayException) $
                      grRefresh appWebsiteContent
      withStackageDatabase (appShouldLogAll appSettings) (appDatabase appSettings) $ \appStackageDatabase -> do
          appLatestStackMatcher <-
              mkAutoUpdateWithModify
                  defaultUpdateSettings
                      { updateFreq = 1000 * 1000 * 60 * 30 -- update every thirty minutes
                      , updateAction = getLatestMatcher appHttpManager
                      }
                  \oldMatcher -> getLatestMatcher appHttpManager `catchAny` \e -> do
                    runRIO appLogFunc $ RIO.logError $ "Couldn't get Stack matcher: " <> displayShow e
                    pure oldMatcher
          appMirrorStatus <- mkUpdateMirrorStatus
          hoogleLocker <- newHoogleLocker appLogFunc appHttpManager (appDownloadBucketUrl appSettings)
          let appGetHoogleDB = singleRun hoogleLocker
          let appGitRev = GitRev
                  { gitRevHash = "invalid"
                  , gitRevBranch = "invalid"
                  , gitRevDirty = False
                  , gitRevCommitDate = "2024-12-31"
                  , gitRevCommitCount = 0
                  , gitRevCommitMessage = "This page has been deprecated. Comment on https://github.com/commercialhaskell/stackage-server/issues/339 if this broke your workflow!"
                  }
          runConcurrently $ runContentUpdates *> Concurrently (inner App {..})
  
  getLogOpts :: AppSettings -> IO LogOptions
  getLogOpts settings = logOptionsHandle stdout (appShouldLogAll settings)
  
  
  makeLogWare :: App -> IO Middleware
  makeLogWare foundation =
      mkRequestLogger def
          { outputFormat =
              if appDetailedRequestLogging $ appSettings foundation
                  then Detailed True
                  else Apache
                          (if appIpFromHeader $ appSettings foundation
                              then FromFallback
                              else FromSocket)
          , destination = Logger $ loggerSet $ appLogger foundation
          }
  
  
  -- | Warp settings for the given foundation value.
  warpSettings :: App -> Settings
  warpSettings foundation =
        setPort (appPort $ appSettings foundation)
      $ setHost (appHost $ appSettings foundation)
      $ setOnException (\_req e ->
          when (defaultShouldDisplayException e) $ messageLoggerSource
              foundation
              (appLogger foundation)
              $(qLocation >>= liftLoc)
              "yesod"
              LevelError
              (toLogStr $ "Exception from Warp: " ++ show e))
        defaultSettings
  
  -- | For yesod devel, apply an action to Warp settings, RIO's LogFunc and Foundation.
  withFoundationDev :: (Settings -> App -> IO a) -> IO a
  withFoundationDev inner = do
      appSettings <- getAppSettings
      logOpts <- getLogOpts appSettings
      withLogFunc logOpts $ \logFunc ->
          withFoundation logFunc appSettings $ \foundation -> do
              settings <- getDevSettings $ warpSettings foundation
              inner settings foundation
  
  
  withApplicationDev :: (Settings -> Application -> IO a) -> IO a
  withApplicationDev inner =
      withFoundationDev $ \ settings foundation -> do
          application <- makeApplication foundation
          inner settings application
  
  -- | main function for use by yesod devel
  develMain :: IO ()
  develMain = withApplicationDev $ \settings app -> develMainHelper (pure (settings, app))
  
  -- | The @main@ function for an executable running this site.
  appMain :: IO ()
  appMain = do
      -- Get the settings from all relevant sources
      settings <- loadYamlSettingsArgs
          -- fall back to compile-time values, set to [] to require values at runtime
          [configSettingsYmlValue]
  
          -- allow environment variables to override
          useEnv
      logOpts <- getLogOpts settings
      withLogFunc logOpts $ \ logFunc -> do
          -- Generate the foundation from the settings
          withFoundation logFunc settings $ \ foundation -> do
  
              -- Generate a WAI Application from the foundation
              app <- makeApplication foundation
  
              -- Run the application with Warp
              runSettings (warpSettings foundation) app
  
  
  --------------------------------------------------------------
  -- Functions for DevelMain.hs (a way to run the app from GHCi)
  --------------------------------------------------------------
  withApplicationRepl :: (Int -> App -> Application -> IO ()) -> IO ()
  withApplicationRepl inner = do
      settings <- getAppSettings
      logOpts <- getLogOpts settings
      withLogFunc logOpts $ \ logFunc ->
          withFoundation logFunc settings $ \foundation -> do
              wsettings <- getDevSettings $ warpSettings foundation
              app1 <- makeApplication foundation
              inner (getPort wsettings) foundation app1
  
  
  ---------------------------------------------
  -- Functions for use in development with GHCi
  ---------------------------------------------
  
  -- | Run a handler
  handler :: Handler a -> IO a
  handler h = do
      logOpts <- logOptionsHandle stdout True
      withLogFunc logOpts $ \ logFunc -> do
          settings <- getAppSettings
          withFoundation logFunc settings (`unsafeHandler` h)
  