{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} module Keter.SharedData.App ( App(..) , AppStartConfig(..) , RunningBackgroundApp(..) , RunningWebApp(..) , showApp ) where import Control.Concurrent.STM (STM, TVar, readTVar) import Data.Set (Set) import Data.Text (Text, pack) import Keter.Common (AppId, Host, Plugins, Port) import Keter.Conduit.Process.Unix ( MonitoredProcess , ProcessTracker ) import Keter.Config (KeterConfig) import Keter.HostManager (HostManager) import Keter.Logger (Logger) import Keter.PortPool (PortPool) import Keter.TempTarball (TempFolder) import System.Posix.Types (EpochTime, GroupID, UserID) data RunningWebApp = RunningWebApp { rwaProcess :: !MonitoredProcess , rwaPort :: !Port , rwaEnsureAliveTimeOut :: !Int } instance Show RunningWebApp where show (RunningWebApp {..}) = "RunningWebApp{rwaPort=" <> show rwaPort <> ", rwaEnsureAliveTimeOut=" <> show rwaEnsureAliveTimeOut <> ",..}" newtype RunningBackgroundApp = RunningBackgroundApp { rbaProcess :: MonitoredProcess } data AppStartConfig = AppStartConfig { ascTempFolder :: !TempFolder , ascSetuid :: !(Maybe (Text, (UserID, GroupID))) , ascProcessTracker :: !ProcessTracker , ascHostManager :: !HostManager , ascPortPool :: !PortPool , ascPlugins :: !Plugins , ascKeterConfig :: !KeterConfig } data App = App { appModTime :: !(TVar (Maybe EpochTime)) , appRunningWebApps :: !(TVar [RunningWebApp]) , appBackgroundApps :: !(TVar [RunningBackgroundApp]) , appId :: !AppId , appHosts :: !(TVar (Set Host)) , appDir :: !(TVar (Maybe FilePath)) , appAsc :: !AppStartConfig , appLog :: !(TVar (Maybe Logger)) } instance Show App where show App {appId} = "App{appId=" <> show appId <> "}" -- | within an stm context we can show a lot more then the show instance can do showApp :: App -> STM Text showApp App{..} = do appModTime' <- readTVar appModTime appRunning' <- readTVar appRunningWebApps appHosts' <- readTVar appHosts pure $ pack $ show appId <> " modtime: " <> show appModTime' <> ", webappsRunning: " <> show appRunning' <> ", hosts: " <> show appHosts'