{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Application
    ( getApplicationDev
    , appMain
    , develMain
    , makeFoundation
    , makeLogWare
    -- * for DevelMain
    , getApplicationRepl
    , shutdownApp
    -- * for GHCI
    , handler
    , db
    ) where

import Import.App

import Control.Monad.Logger (liftLoc, runLoggingT)
import Database.Persist.Postgresql
import Language.Haskell.TH.Syntax (qLocation)
import Network.Wai (Middleware)
import Network.Wai.Handler.Warp
       (Settings, defaultSettings, defaultShouldDisplayException, getPort,
        runSettings, setHost, setOnException, setPort)
import Network.Wai.Middleware.RequestLogger
       (Destination(Logger), IPAddrSource(..), OutputFormat(..),
        destination, mkRequestLogger, outputFormat)
import System.Log.FastLogger
       (defaultBufSize, newStdoutLoggerSet, toLogStr)

import Database.Migrate

import LoadEnv (loadEnv)
import System.Environment (getEnv)

-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
import Handler.Common
import Handler.Home
import Handler.Library
import Handler.Module
import Handler.Profile
import Handler.Recent
import Handler.Repo
import Handler.RepoVersion
import Handler.Sitemap

import System.Exit (die)

-- 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 returns a foundation datatype value. This is also
-- the place to put your migrate statements to have automatic database
-- migrations handled by Yesod.
makeFoundation :: AppSettings -> IO App
makeFoundation appSettings = do
    schemaValidation <- validateSchema $ pgConnStr $ appDatabaseConf appSettings
    case schemaValidation of
        MigrationError err -> die err
        MigrationSuccess -> do
            appHttpManager <- newManager
            appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
            appStatic <-
                (if appMutableStatic appSettings
                     then staticDevel
                     else static)
                    (appStaticDir appSettings)
            appGithubOAuthKeys <- getGithubOAuthKeys
            appGitlabOAuthKeys <- getGitlabOAuthKeys
            -- We need a log function to create a connection pool. We need a connection
            -- pool to create our foundation. And we need our foundation to get a
            -- logging function. To get out of this loop, we initially create a
            -- temporary foundation without a real connection pool, get a log function
            -- from there, and then create the real foundation.
            let mkFoundation appConnPool = App {..}
                -- The App {..} syntax is an example of record wild cards. For more
                -- information, see:
                -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
                tempFoundation =
                    mkFoundation $ error "connPool forced in tempFoundation"
                logFunc = messageLoggerSource tempFoundation appLogger
            -- Create the database connection pool
            fmap mkFoundation $
                flip runLoggingT logFunc $
                createPostgresqlPool
                    (pgConnStr $ appDatabaseConf appSettings)
                    (pgPoolSize $ appDatabaseConf appSettings)

getGithubOAuthKeys :: IO OAuthKeys
getGithubOAuthKeys =
    OAuthKeys <$> (pack <$> getEnv "GITHUB_OAUTH_CLIENT_ID") <*>
    (pack <$> getEnv "GITHUB_OAUTH_CLIENT_SECRET")

getGitlabOAuthKeys :: IO OAuthKeys
getGitlabOAuthKeys =
    OAuthKeys <$> (pack <$> getEnv "GITLAB_OAUTH_CLIENT_ID") <*>
    (pack <$> getEnv "GITLAB_OAUTH_CLIENT_SECRET")

-- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
-- applying some additional middlewares.
makeApplication :: App -> IO Application
makeApplication foundation = do
    logWare <- makeLogWare foundation
    -- Create the WAI application and apply middlewares
    appPlain <- toWaiAppPlain foundation
    return $ logWare $ defaultMiddlewaresNoLogging appPlain

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, return the Warp settings and WAI Application.
getApplicationDev :: IO (Settings, Application)
getApplicationDev = do
    loadEnv
    foundation <- getAppSettings >>= makeFoundation
    wsettings <- getDevSettings $ warpSettings foundation
    app <- makeApplication foundation
    return (wsettings, app)

getAppSettings :: IO AppSettings
getAppSettings = loadYamlSettings [configSettingsYml] [] useEnv

-- | main function for use by yesod devel
develMain :: IO ()
develMain = develMainHelper getApplicationDev

-- | The @main@ function for an executable running this site.
appMain :: IO ()
appMain = do
    loadEnv
    -- Get the settings from all relevant sources
    settings <- loadYamlSettings [] [configSettingsYmlValue] useEnv
    -- Generate the foundation from the settings
    foundation <- makeFoundation settings
    -- 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)
--------------------------------------------------------------
getApplicationRepl :: IO (Int, App, Application)
getApplicationRepl = do
    settings <- getAppSettings
    foundation <- makeFoundation settings
    wsettings <- getDevSettings $ warpSettings foundation
    app1 <- makeApplication foundation
    return (getPort wsettings, foundation, app1)

shutdownApp :: App -> IO ()
shutdownApp _ = return ()

---------------------------------------------
-- Functions for use in development with GHCi
---------------------------------------------
-- | Run a handler
handler :: Handler a -> IO a
handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h

-- | Run DB queries
db :: ReaderT SqlBackend (HandlerT App IO) a -> IO a
db = handler . runDB
