module IHP.IDE.ToolServer (withToolServer) 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 qualified IHP.ErrorController as ErrorController
import IHP.ApplicationContext
import IHP.ModelSupport
import IHP.RouterSupport hiding (get)
import Network.Wai.Session.ClientSession (clientsessionStore)
import qualified Web.ClientSession as ClientSession
import qualified Data.Vault.Lazy as Vault
import Network.Wai.Middleware.MethodOverridePost (methodOverridePost)
import Network.Wai.Middleware.Static hiding ((<|>))
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 System.Environment as Env
import qualified IHP.AutoRefresh.Types as AutoRefresh
import IHP.Controller.Context
import qualified IHP.IDE.ToolServer.Layout as Layout
import IHP.Controller.Layout
import qualified IHP.LibDir as LibDir
import qualified IHP.IDE.LiveReloadNotificationServer as LiveReloadNotificationServer
import qualified IHP.Version as Version
import qualified IHP.IDE.Types
import qualified IHP.PGListener as PGListener

withToolServer :: (?context :: Context) => IO () -> IO ()
withToolServer :: (?context::Context) => IO () -> IO ()
withToolServer IO ()
inner = forall a b. IO a -> (Async a -> IO b) -> IO b
withAsyncBound IO ()
async (\Async ()
_ -> IO ()
inner)
    where
        async :: IO ()
async = do
            let port :: Int
port = ?context::Context
?context.portConfig.toolServerPort forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall a b. (Integral a, Num b) => a -> b
fromIntegral
            let isDebugMode :: Bool
isDebugMode = ?context::Context
?context.isDebugMode

            (?context::Context) => Int -> Bool -> IO ()
startToolServer' Int
port Bool
isDebugMode

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

    FrameworkConfig
frameworkConfig <- ConfigBuilder -> IO FrameworkConfig
Config.buildFrameworkConfig do
        forall option. Typeable option => option -> ConfigBuilder
Config.option forall a b. (a -> b) -> a -> b
$ Text -> AppHostname
Config.AppHostname Text
"localhost"
        forall option. Typeable option => option -> ConfigBuilder
Config.option forall a b. (a -> b) -> a -> b
$ Int -> AppPort
Config.AppPort Int
port
        forall option. Typeable option => option -> ConfigBuilder
Config.option forall a b. (a -> b) -> a -> b
$ Text -> AssetVersion
Config.AssetVersion Text
Version.ihpVersion

        Maybe String
ihpIdeBaseUrlEnvVar <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe String)
Env.lookupEnv String
"IHP_IDE_BASEURL")
        case Maybe String
ihpIdeBaseUrlEnvVar of
            Just String
baseUrl -> forall option. Typeable option => option -> ConfigBuilder
Config.option forall a b. (a -> b) -> a -> b
$ Text -> BaseUrl
Config.BaseUrl (forall a b. ConvertibleStrings a b => a -> b
cs String
baseUrl)
            Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    Key (Session IO ByteString ByteString)
session <- forall a. IO (Key a)
Vault.newKey
    SessionStore IO ByteString ByteString
store <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k v (m :: * -> *).
(Serialize k, Serialize v, Eq k, MonadIO m) =>
Key -> SessionStore m k v
clientsessionStore (String -> IO Key
ClientSession.getKey String
"Config/client_session_key.aes")
    let Application -> Application
sessionMiddleware :: Wai.Middleware = forall (m :: * -> *) k v.
SessionStore m k v
-> ByteString
-> SetCookie
-> Key (Session m k v)
-> Application
-> Application
withSession SessionStore IO ByteString ByteString
store ByteString
"SESSION" (forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "sessionCookie" a => a
#sessionCookie FrameworkConfig
frameworkConfig) Key (Session IO ByteString ByteString)
session
    let modelContext :: ModelContext
modelContext = Logger -> ModelContext
notConnectedModelContext forall a. HasCallStack => a
undefined
    PGListener
pgListener <- ModelContext -> IO PGListener
PGListener.init ModelContext
modelContext
    IORef AutoRefreshServer
autoRefreshServer <- forall a. a -> IO (IORef a)
newIORef (PGListener -> AutoRefreshServer
AutoRefresh.newAutoRefreshServer PGListener
pgListener)
    let applicationContext :: ApplicationContext
applicationContext = ApplicationContext { ModelContext
$sel:modelContext:ApplicationContext :: ModelContext
modelContext :: ModelContext
modelContext, Key (Session IO ByteString ByteString)
$sel:session:ApplicationContext :: Key (Session IO ByteString ByteString)
session :: Key (Session IO ByteString ByteString)
session, IORef AutoRefreshServer
$sel:autoRefreshServer:ApplicationContext :: IORef AutoRefreshServer
autoRefreshServer :: IORef AutoRefreshServer
autoRefreshServer, FrameworkConfig
$sel:frameworkConfig:ApplicationContext :: FrameworkConfig
frameworkConfig :: FrameworkConfig
frameworkConfig, PGListener
$sel:pgListener:ApplicationContext :: PGListener
pgListener :: PGListener
pgListener }
    let toolServerApplication :: ToolServerApplication
toolServerApplication = ToolServerApplication { $sel:devServerContext:ToolServerApplication :: Context
devServerContext = ?context::Context
?context }
    let Application
application :: Wai.Application = \Request
request Response -> IO ResponseReceived
respond -> do
            let ?applicationContext = ApplicationContext
applicationContext
            RequestContext
requestContext <- ApplicationContext
-> Request
-> (Response -> IO ResponseReceived)
-> IO RequestContext
ControllerSupport.createRequestContext ApplicationContext
applicationContext Request
request Response -> IO ResponseReceived
respond
            let ?context = RequestContext
requestContext
            forall app.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 FrontController app) =>
app -> [RouteParser] -> IO ResponseReceived -> IO ResponseReceived
frontControllerToWAIApp ToolServerApplication
toolServerApplication [] (?context::RequestContext) => IO ResponseReceived
ErrorController.handleNotFound

    String
libDirectory <- forall a b. ConvertibleStrings a b => a -> b
cs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
LibDir.findLibDirectory
    let Application -> Application
staticMiddleware :: Wai.Middleware = Policy -> Application -> Application
staticPolicy (String -> Policy
addBase (String
libDirectory forall a. Semigroup a => a -> a -> a
<> String
"static/"))

    let openAppUrl :: IO ()
openAppUrl = Text -> IO ()
openUrl (Text
"http://localhost:" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
port forall a. Semigroup a => a -> a -> a
<> Text
"/")
    let warpSettings :: Settings
warpSettings = Settings
Warp.defaultSettings
            forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Int -> Settings -> Settings
Warp.setPort Int
port
            forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> IO () -> Settings -> Settings
Warp.setBeforeMainLoop IO ()
openAppUrl

    let logMiddleware :: Application -> Application
logMiddleware = if Bool
isDebugMode then forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "requestLoggerMiddleware" a => a
#requestLoggerMiddleware FrameworkConfig
frameworkConfig else forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
IHP.Prelude.id

    Settings -> Application -> IO ()
Warp.runSettings Settings
warpSettings forall a b. (a -> b) -> a -> b
$
            Application -> Application
staticMiddleware forall a b. (a -> b) -> a -> b
$ Application -> Application
logMiddleware forall a b. (a -> b) -> a -> b
$ Application -> Application
methodOverridePost forall a b. (a -> b) -> a -> b
$ Application -> Application
sessionMiddleware
                forall a b. (a -> b) -> a -> b
$ ConnectionOptions -> ServerApp -> Application -> Application
Websocket.websocketsOr
                    ConnectionOptions
Websocket.defaultConnectionOptions
                    (?context::Context) => ServerApp
LiveReloadNotificationServer.app
                    Application
application

openUrl :: Text -> IO ()
openUrl :: Text -> IO ()
openUrl Text
url = do
    Maybe String
selectedBrowser <- String -> IO (Maybe String)
Env.lookupEnv String
"IHP_BROWSER"
    let defaultOSBrowser :: String
defaultOSBrowser = case String
os of
            String
"linux" -> String
"xdg-open"
            String
"darwin" -> String
"open"
    let browser :: String
browser = Maybe String
selectedBrowser forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall a. a -> Maybe a -> a
fromMaybe String
defaultOSBrowser
    forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ String -> IO ()
Process.callCommand (String
browser forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs Text
url)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance FrontController ToolServerApplication where
    controllers :: forall {k} (controller :: k).
(?applicationContext::ApplicationContext,
 ?application::ToolServerApplication, ?context::RequestContext) =>
[RouteParser]
controllers =
        [ forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Data controller) =>
RouteParser
parseRoute @SchemaController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Data controller) =>
RouteParser
parseRoute @TablesController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Data controller) =>
RouteParser
parseRoute @ColumnsController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Data controller) =>
RouteParser
parseRoute @PoliciesController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Data controller) =>
RouteParser
parseRoute @EnumsController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Data controller) =>
RouteParser
parseRoute @EnumValuesController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Data controller) =>
RouteParser
parseRoute @LogsController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Data controller) =>
RouteParser
parseRoute @DataController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Data controller) =>
RouteParser
parseRoute @CodeGenController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Data controller) =>
RouteParser
parseRoute @MigrationsController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Data controller) =>
RouteParser
parseRoute @IndexesController
        , forall {k} action application (controller :: k).
(Controller action, InitControllerContext application,
 ?application::application, ?applicationContext::ApplicationContext,
 ?context::RequestContext, Typeable application, Typeable action) =>
action -> RouteParser
startPage TablesController
TablesAction
        ]

instance ControllerSupport.InitControllerContext ToolServerApplication where
    initContext :: (?modelContext::ModelContext, ?requestContext::RequestContext,
 ?applicationContext::ApplicationContext,
 ?context::ControllerContext) =>
IO ()
initContext = do
        AvailableApps
availableApps <- [Text] -> AvailableApps
AvailableApps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Text]
findApplications
        WebControllers
webControllers <- [Text] -> WebControllers
WebControllers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Text]
findWebControllers

        let defaultAppUrl :: Text
defaultAppUrl = Text
"http://localhost:" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (?context::ControllerContext) => PortNumber
Helper.appPort
        Text
appUrl :: Text <- forall a. a -> Maybe a -> a
fromMaybe Text
defaultAppUrl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. ConvertibleStrings a b => a -> b
cs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
Env.lookupEnv String
"IHP_BASEURL"

        forall value.
(?context::ControllerContext, Typeable value) =>
value -> IO ()
putContext AvailableApps
availableApps
        forall value.
(?context::ControllerContext, Typeable value) =>
value -> IO ()
putContext WebControllers
webControllers
        forall value.
(?context::ControllerContext, Typeable value) =>
value -> IO ()
putContext (Text -> AppUrl
AppUrl Text
appUrl)
        (?context::ControllerContext) =>
((?context::ControllerContext) => Layout) -> IO ()
setLayout Html -> Html
Layout.toolServerLayout

        Bool
databaseNeedsMigration <- (?context::ControllerContext) => IO Bool
readDatabaseNeedsMigration
        forall value.
(?context::ControllerContext, Typeable value) =>
value -> IO ()
putContext (Bool -> DatabaseNeedsMigration
DatabaseNeedsMigration Bool
databaseNeedsMigration)


readDatabaseNeedsMigration :: (?context :: ControllerContext) => IO Bool
readDatabaseNeedsMigration :: (?context::ControllerContext) => IO Bool
readDatabaseNeedsMigration = do
    Context
context <- (?context::ControllerContext) => IO Context
theDevServerContext
    AppState
state <- forall a. IORef a -> IO a
readIORef (forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "appStateRef" a => a
#appStateRef Context
context)
    forall a. IORef a -> IO a
readIORef (forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "databaseNeedsMigration" a => a
#databaseNeedsMigration AppState
state)