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.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.PGListener as PGListener

import qualified Network.Wai.Application.Static as Static
import qualified WaiAppStatic.Types as Static

withToolServer :: (?context :: Context) => IO () -> IO ()
withToolServer :: (?context::Context) => IO () -> IO ()
withToolServer IO ()
inner = IO () -> (Async () -> IO ()) -> IO ()
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
?context.portConfig.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.isDebugMode

            (?context::Context) => Int -> Bool -> IO ()
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
        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
        AssetVersion -> ConfigBuilder
forall option. Typeable option => option -> ConfigBuilder
Config.option (AssetVersion -> ConfigBuilder) -> AssetVersion -> ConfigBuilder
forall a b. (a -> b) -> a -> b
$ Text -> AssetVersion
Config.AssetVersion Text
Version.ihpVersion

        Maybe String
ihpIdeBaseUrlEnvVar <- IO (Maybe String) -> StateT TMap IO (Maybe String)
forall a. IO a -> StateT TMap IO a
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 a. a -> StateT TMap IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    Key (Session IO ByteString ByteString)
session <- IO (Key (Session IO ByteString ByteString))
forall a. IO (Key a)
Vault.newKey
    SessionStore IO ByteString ByteString
store <- (Key -> SessionStore IO ByteString ByteString)
-> IO Key -> IO (SessionStore IO ByteString ByteString)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Key -> SessionStore IO ByteString ByteString
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 (Request
 -> (Response -> IO ResponseReceived) -> IO ResponseReceived)
-> Request
-> (Response -> IO ResponseReceived)
-> IO ResponseReceived
sessionMiddleware :: Wai.Middleware = SessionStore IO ByteString ByteString
-> ByteString
-> SetCookie
-> Key (Session IO ByteString ByteString)
-> (Request
    -> (Response -> IO ResponseReceived) -> IO ResponseReceived)
-> Request
-> (Response -> IO ResponseReceived)
-> IO ResponseReceived
forall (m :: * -> *) k v.
SessionStore m k v
-> ByteString
-> SetCookie
-> Key (Session m k v)
-> (Request
    -> (Response -> IO ResponseReceived) -> IO ResponseReceived)
-> Request
-> (Response -> IO ResponseReceived)
-> IO ResponseReceived
withSession SessionStore IO ByteString ByteString
store ByteString
"SESSION" (FrameworkConfig
frameworkConfig.sessionCookie) Key (Session IO ByteString ByteString)
session
    let modelContext :: ModelContext
modelContext = Logger -> ModelContext
notConnectedModelContext Logger
forall a. HasCallStack => a
undefined
    PGListener
pgListener <- ModelContext -> IO PGListener
PGListener.init ModelContext
modelContext
    IORef AutoRefreshServer
autoRefreshServer <- AutoRefreshServer -> IO (IORef AutoRefreshServer)
forall a. a -> IO (IORef a)
newIORef (PGListener -> AutoRefreshServer
AutoRefresh.newAutoRefreshServer PGListener
pgListener)
    Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
staticApp <- IO
  (Request
   -> (Response -> IO ResponseReceived) -> IO ResponseReceived)
initStaticApp

    let applicationContext :: ApplicationContext
applicationContext = ApplicationContext { ModelContext
modelContext :: ModelContext
$sel:modelContext:ApplicationContext :: ModelContext
modelContext, Key (Session IO ByteString ByteString)
session :: Key (Session IO ByteString ByteString)
$sel:session:ApplicationContext :: Key (Session IO ByteString ByteString)
session, IORef AutoRefreshServer
autoRefreshServer :: IORef AutoRefreshServer
$sel:autoRefreshServer:ApplicationContext :: IORef AutoRefreshServer
autoRefreshServer, FrameworkConfig
frameworkConfig :: FrameworkConfig
$sel:frameworkConfig:ApplicationContext :: FrameworkConfig
frameworkConfig, PGListener
pgListener :: PGListener
$sel:pgListener:ApplicationContext :: PGListener
pgListener }
    let toolServerApplication :: ToolServerApplication
toolServerApplication = ToolServerApplication { $sel:devServerContext:ToolServerApplication :: Context
devServerContext = ?context::Context
Context
?context }
    let Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
application :: Wai.Application = \Request
request Response -> IO ResponseReceived
respond -> do
            let ?applicationContext = ?applicationContext::ApplicationContext
ApplicationContext
applicationContext
            RequestContext
requestContext <- ApplicationContext
-> Request
-> (Response -> IO ResponseReceived)
-> IO RequestContext
ControllerSupport.createRequestContext ApplicationContext
applicationContext Request
request Response -> IO ResponseReceived
respond
            let ?context = ?context::RequestContext
RequestContext
requestContext
            ToolServerApplication
-> [RouteParser] -> IO ResponseReceived -> IO ResponseReceived
forall app.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 FrontController app) =>
app -> [RouteParser] -> IO ResponseReceived -> IO ResponseReceived
frontControllerToWAIApp ToolServerApplication
toolServerApplication [] (Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
staticApp Request
request Response -> IO ResponseReceived
respond)

    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 :: (Request
 -> (Response -> IO ResponseReceived) -> IO ResponseReceived)
-> Request
-> (Response -> IO ResponseReceived)
-> IO ResponseReceived
logMiddleware = if Bool
isDebugMode then FrameworkConfig
frameworkConfig.requestLoggerMiddleware else (Request
 -> (Response -> IO ResponseReceived) -> IO ResponseReceived)
-> Request
-> (Response -> IO ResponseReceived)
-> IO ResponseReceived
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
IHP.Prelude.id

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

initStaticApp :: IO Wai.Application
initStaticApp :: IO
  (Request
   -> (Response -> IO ResponseReceived) -> IO ResponseReceived)
initStaticApp = do
    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 staticSettings :: StaticSettings
staticSettings = (String -> StaticSettings
Static.defaultWebAppSettings (String
libDirectory String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"static/"))
            { ss404Handler :: Maybe
  (Request
   -> (Response -> IO ResponseReceived) -> IO ResponseReceived)
Static.ss404Handler = (Request
 -> (Response -> IO ResponseReceived) -> IO ResponseReceived)
-> Maybe
     (Request
      -> (Response -> IO ResponseReceived) -> IO ResponseReceived)
forall a. a -> Maybe a
Just Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
ErrorController.handleNotFound
            , ssMaxAge :: MaxAge
Static.ssMaxAge = Int -> MaxAge
Static.MaxAgeSeconds (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
30) -- 30 days
            }
    (Request
 -> (Response -> IO ResponseReceived) -> IO ResponseReceived)
-> IO
     (Request
      -> (Response -> IO ResponseReceived) -> IO ResponseReceived)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StaticSettings
-> Request
-> (Response -> IO ResponseReceived)
-> IO ResponseReceived
Static.staticApp StaticSettings
staticSettings)

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 a. a -> IO a
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, Typeable controller) =>
RouteParser
parseRoute @SchemaController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Typeable controller) =>
RouteParser
parseRoute @TablesController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Typeable controller) =>
RouteParser
parseRoute @ColumnsController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Typeable controller) =>
RouteParser
parseRoute @PoliciesController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Typeable controller) =>
RouteParser
parseRoute @EnumsController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Typeable controller) =>
RouteParser
parseRoute @EnumValuesController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Typeable controller) =>
RouteParser
parseRoute @LogsController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Typeable controller) =>
RouteParser
parseRoute @DataController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Typeable controller) =>
RouteParser
parseRoute @CodeGenController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Typeable controller) =>
RouteParser
parseRoute @MigrationsController
        , forall controller application.
(?applicationContext::ApplicationContext, ?context::RequestContext,
 Controller controller, CanRoute controller,
 InitControllerContext application, ?application::application,
 Typeable application, Typeable controller) =>
RouteParser
parseRoute @IndexesController
        , TablesController -> RouteParser
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 ([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 a b. (a -> b) -> Maybe a -> Maybe b
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
Layout
Html -> Html
Layout.toolServerLayout

        Bool
databaseNeedsMigration <- IO Bool
(?context::ControllerContext) => IO Bool
readDatabaseNeedsMigration
        DatabaseNeedsMigration -> IO ()
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 <- IO Context
(?context::ControllerContext) => IO Context
theDevServerContext
    AppState
state <- IORef AppState -> IO AppState
forall a. IORef a -> IO a
readIORef (Context
context.appStateRef)
    IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (AppState
state.databaseNeedsMigration)