ToolServer.hs

module IHP.IDE.ToolServer (runToolServer) where

import IHP.Prelude
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import IHP.IDE.Types
import IHP.IDE.PortConfig
import qualified IHP.ControllerSupport as ControllerSupport
import IHP.ApplicationContext
import IHP.ModelSupport
import IHP.RouterSupport hiding (get)
import Network.Wai.Session.ClientSession (clientsessionStore)
import qualified Web.ClientSession as ClientSession
import Network.Wai.Middleware.MethodOverridePost (methodOverridePost)
import Network.Wai.Session (withSession)
import qualified Network.WebSockets as Websocket
import qualified Network.Wai.Handler.WebSockets as Websocket

import qualified IHP.FrameworkConfig as Config
import IHP.IDE.SchemaDesigner.Controller.EnumValues ()
import IHP.IDE.SchemaDesigner.Controller.Enums ()
import IHP.IDE.SchemaDesigner.Controller.Columns ()
import IHP.IDE.SchemaDesigner.Controller.Policies ()
import IHP.IDE.SchemaDesigner.Controller.Schema ()
import IHP.IDE.SchemaDesigner.Controller.Tables ()
import IHP.IDE.SchemaDesigner.Controller.Migrations ()
import IHP.IDE.SchemaDesigner.Controller.Indexes ()
import IHP.IDE.Data.Controller ()
import IHP.IDE.Logs.Controller ()
import IHP.IDE.CodeGen.Controller ()
import IHP.IDE.ToolServer.Types
import IHP.IDE.ToolServer.Helper.Controller as Helper
import IHP.IDE.ToolServer.Routes ()
import qualified System.Process as Process
import System.Info
import qualified IHP.EnvVar as EnvVar
import qualified IHP.AutoRefresh.Types as AutoRefresh
import qualified IHP.AutoRefresh as AutoRefresh
import IHP.Controller.Context
import qualified IHP.IDE.ToolServer.Layout as Layout
import IHP.Controller.Layout
import qualified IHP.IDE.LiveReloadNotificationServer as LiveReloadNotificationServer
import qualified IHP.Version as Version
import qualified IHP.PGListener as PGListener

import qualified Network.Wai.Application.Static as Static
import qualified Network.Wai.Middleware.Approot as Approot
import qualified WaiAppStatic.Types as Static
import IHP.Controller.NotFound (handleNotFound)
import IHP.Controller.Session (sessionVaultKey)
import Paths_ihp_ide (getDataFileName)

runToolServer :: (?context :: Context) => ToolServerApplication -> _ -> IO ()
runToolServer toolServerApplication liveReloadClients = do
    let port = ?context.portConfig.toolServerPort |> fromIntegral
    let isDebugMode = ?context.isDebugMode

    startToolServer' toolServerApplication port isDebugMode liveReloadClients

startToolServer' :: (?context :: Context) => ToolServerApplication -> Int -> Bool -> _ -> IO ()
startToolServer' toolServerApplication port isDebugMode liveReloadClients = do

    frameworkConfig <- Config.buildFrameworkConfig do
        Config.option $ Config.AppHostname "localhost"
        Config.option $ Config.AppPort port
        Config.option $ Config.AssetVersion Version.ihpVersion

        ihpIdeBaseUrlEnvVar <- EnvVar.envOrNothing "IHP_IDE_BASEURL"
        case ihpIdeBaseUrlEnvVar of
            Just baseUrl -> Config.option $ Config.BaseUrl baseUrl
            Nothing -> pure ()

    store <- fmap clientsessionStore (ClientSession.getKey "Config/client_session_key.aes")
    let sessionMiddleware :: Wai.Middleware = withSession store "SESSION" (frameworkConfig.sessionCookie) sessionVaultKey
    let modelContext = notConnectedModelContext undefined

    approotMiddleware <- Approot.envFallback
    
    PGListener.withPGListener modelContext \pgListener -> do
        autoRefreshServer <- newIORef (AutoRefresh.newAutoRefreshServer pgListener)
        staticApp <- initStaticApp

        let applicationContext = ApplicationContext { modelContext, autoRefreshServer, frameworkConfig, pgListener }
        let application :: Wai.Application = \request respond -> do
                let ?applicationContext = applicationContext
                frontControllerToWAIApp @ToolServerApplication @AutoRefresh.AutoRefreshWSApp (\app -> app) toolServerApplication staticApp request respond

        let openAppUrl = openUrl ("http://localhost:" <> tshow port <> "/")
        let warpSettings = Warp.defaultSettings
                |> Warp.setPort port
                |> Warp.setBeforeMainLoop openAppUrl

        let logMiddleware = if isDebugMode then frameworkConfig.requestLoggerMiddleware else IHP.Prelude.id

        Warp.runSettings warpSettings $
                logMiddleware $ methodOverridePost $ sessionMiddleware $ approotMiddleware
                    $ Websocket.websocketsOr
                        Websocket.defaultConnectionOptions
                        (LiveReloadNotificationServer.app liveReloadClients)
                        application

initStaticApp :: IO Wai.Application
initStaticApp = do
    toolServerStatic <- getDataFileName "static"
    ihpStatic <- EnvVar.env "IHP_STATIC"

    let ssMaxAge = Static.MaxAgeSeconds (60 * 60 * 24 * 30) -- 30 days
    let ihpStaticSettings = (Static.defaultWebAppSettings ihpStatic)
            { Static.ss404Handler = Just handleNotFound
            , Static.ssMaxAge = ssMaxAge
            }
    let toolServerStaticSettings = (Static.defaultWebAppSettings toolServerStatic)
            { Static.ss404Handler = Just (Static.staticApp ihpStaticSettings)
            , Static.ssMaxAge = ssMaxAge
            }
    pure (Static.staticApp toolServerStaticSettings)

openUrl :: Text -> IO ()
openUrl url = do
    selectedBrowser <- EnvVar.envOrNothing "IHP_BROWSER"
    let defaultOSBrowser = case os of
            "linux" -> "xdg-open"
            "darwin" -> "open"
    let browser = selectedBrowser |> fromMaybe defaultOSBrowser
    async $ Process.callCommand (browser <> " " <> cs url)
    pure ()

instance FrontController ToolServerApplication where
    controllers =
        [ parseRoute @SchemaController
        , parseRoute @TablesController
        , parseRoute @ColumnsController
        , parseRoute @PoliciesController
        , parseRoute @EnumsController
        , parseRoute @EnumValuesController
        , parseRoute @LogsController
        , parseRoute @DataController
        , parseRoute @CodeGenController
        , parseRoute @MigrationsController
        , parseRoute @IndexesController
        , startPage TablesAction
        ]

instance ControllerSupport.InitControllerContext ToolServerApplication where
    initContext = do
        availableApps <- AvailableApps <$> findApplications
        webControllers <- WebControllers <$> findWebControllers

        appPort <- Helper.theAppPort
        let defaultAppUrl = "http://localhost:" <> tshow appPort
        appUrl :: Text <- EnvVar.envOrDefault "IHP_BASEURL" defaultAppUrl

        putContext availableApps
        putContext webControllers
        putContext (AppUrl appUrl)
        setLayout Layout.toolServerLayout

        databaseNeedsMigration <- readDatabaseNeedsMigration
        putContext (DatabaseNeedsMigration databaseNeedsMigration)


readDatabaseNeedsMigration :: (?context :: ControllerContext) => IO Bool
readDatabaseNeedsMigration = do
    context <- fromContext @ToolServerApplication
    readIORef context.databaseNeedsMigration