module IHP.IDE.ToolServer 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.Schema ()
import IHP.IDE.SchemaDesigner.Controller.Tables ()
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 Control.Concurrent.Async
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

startToolServer :: (?context :: Context) => IO ()
startToolServer :: IO ()
startToolServer = do
    let port :: Int
port = ?context::Context
Context
?context
            Context -> (Context -> PortConfig) -> PortConfig
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "portConfig" -> Context -> PortConfig
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "portConfig" (Proxy "portConfig")
Proxy "portConfig"
#portConfig
            PortConfig -> (PortConfig -> PortNumber) -> PortNumber
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "toolServerPort" -> PortConfig -> PortNumber
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "toolServerPort" (Proxy "toolServerPort")
Proxy "toolServerPort"
#toolServerPort
            PortNumber -> (PortNumber -> Int) -> Int
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    let isDebugMode :: Bool
isDebugMode = ?context::Context
Context
?context Context -> (Context -> Bool) -> Bool
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "isDebugMode" -> Context -> Bool
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "isDebugMode" (Proxy "isDebugMode")
Proxy "isDebugMode"
#isDebugMode

    Async ()
thread <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async ((?context::Context) => Int -> Bool -> IO ()
Int -> Bool -> IO ()
startToolServer' Int
port Bool
isDebugMode)

    (?context::Context) => Action -> IO ()
Action -> IO ()
dispatch (ToolServerState -> Action
UpdateToolServerState (ToolServerStarted :: Async () -> ToolServerState
ToolServerStarted { Async ()
$sel:thread:ToolServerNotStarted :: Async ()
thread :: Async ()
thread }))

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

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

        Maybe String
ihpIdeBaseUrlEnvVar <- IO (Maybe String) -> StateT TMap IO (Maybe String)
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 -> BaseUrl -> ConfigBuilder
forall option. Typeable option => option -> ConfigBuilder
Config.option (BaseUrl -> ConfigBuilder) -> BaseUrl -> ConfigBuilder
forall a b. (a -> b) -> a -> b
$ Text -> BaseUrl
Config.BaseUrl (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
baseUrl)
            Maybe String
Nothing -> () -> ConfigBuilder
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

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

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

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

    LiveReloadNotificationServerState
liveReloadNotificationServerState <- ?context::Context
Context
?context
            Context -> (Context -> IORef AppState) -> IORef AppState
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "appStateRef" -> Context -> IORef AppState
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "appStateRef" (Proxy "appStateRef")
Proxy "appStateRef"
#appStateRef
            IORef AppState -> (IORef AppState -> IO AppState) -> IO AppState
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> IORef AppState -> IO AppState
forall a. IORef a -> IO a
readIORef
            IO AppState
-> (AppState -> IO LiveReloadNotificationServerState)
-> IO LiveReloadNotificationServerState
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LiveReloadNotificationServerState
-> IO LiveReloadNotificationServerState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LiveReloadNotificationServerState
 -> IO LiveReloadNotificationServerState)
-> (AppState -> LiveReloadNotificationServerState)
-> AppState
-> IO LiveReloadNotificationServerState
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy "liveReloadNotificationServerState"
-> AppState -> LiveReloadNotificationServerState
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel
  "liveReloadNotificationServerState"
  (Proxy "liveReloadNotificationServerState")
Proxy "liveReloadNotificationServerState"
#liveReloadNotificationServerState

    Settings -> Application -> IO ()
Warp.runSettings Settings
warpSettings (Application -> IO ()) -> Application -> IO ()
forall a b. (a -> b) -> a -> b
$
            Middleware
staticMiddleware Middleware -> Middleware
forall a b. (a -> b) -> a -> b
$ Middleware
logMiddleware Middleware -> Middleware
forall a b. (a -> b) -> a -> b
$ Middleware
methodOverridePost Middleware -> Middleware
forall a b. (a -> b) -> a -> b
$ Middleware
sessionMiddleware
                Middleware -> Middleware
forall a b. (a -> b) -> a -> b
$ ConnectionOptions -> ServerApp -> Middleware
Websocket.websocketsOr
                    ConnectionOptions
Websocket.defaultConnectionOptions
                    (LiveReloadNotificationServerState -> ServerApp
LiveReloadNotificationServer.app LiveReloadNotificationServerState
liveReloadNotificationServerState)
                    Application
application

stopToolServer :: ToolServerState -> IO ()
stopToolServer ToolServerStarted { Async ()
thread :: Async ()
$sel:thread:ToolServerNotStarted :: ToolServerState -> Async ()
thread } = Async () -> IO ()
forall a. Async a -> IO ()
uninterruptibleCancel Async ()
thread
stopToolServer ToolServerState
ToolServerNotStarted = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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 Maybe String -> (Maybe String -> String) -> String
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defaultOSBrowser
    IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ String -> IO ()
Process.callCommand (String
browser String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
url)
    () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

instance ControllerSupport.InitControllerContext ToolServerApplication where
    initContext :: IO ()
initContext = do
        AvailableApps
availableApps <- [Text] -> AvailableApps
AvailableApps ([Text] -> AvailableApps) -> IO [Text] -> IO AvailableApps
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Text]
findApplications
        WebControllers
webControllers <- [Text] -> WebControllers
WebControllers ([Text] -> WebControllers) -> IO [Text] -> IO WebControllers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Text]
findWebControllers

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

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