{-# 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
    { RunningWebApp -> MonitoredProcess
rwaProcess            :: !MonitoredProcess
    , RunningWebApp -> Port
rwaPort               :: !Port
    , RunningWebApp -> Port
rwaEnsureAliveTimeOut :: !Int
    }

instance Show RunningWebApp where
  show :: RunningWebApp -> String
show (RunningWebApp {Port
MonitoredProcess
rwaProcess :: RunningWebApp -> MonitoredProcess
rwaPort :: RunningWebApp -> Port
rwaEnsureAliveTimeOut :: RunningWebApp -> Port
rwaProcess :: MonitoredProcess
rwaPort :: Port
rwaEnsureAliveTimeOut :: Port
..})  = String
"RunningWebApp{rwaPort=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Port -> String
forall a. Show a => a -> String
show Port
rwaPort String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", rwaEnsureAliveTimeOut=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Port -> String
forall a. Show a => a -> String
show Port
rwaEnsureAliveTimeOut String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
",..}"

newtype RunningBackgroundApp = RunningBackgroundApp
    { RunningBackgroundApp -> MonitoredProcess
rbaProcess :: MonitoredProcess
    }

data AppStartConfig = AppStartConfig
    { AppStartConfig -> TempFolder
ascTempFolder     :: !TempFolder
    , AppStartConfig -> Maybe (Text, (UserID, GroupID))
ascSetuid         :: !(Maybe (Text, (UserID, GroupID)))
    , AppStartConfig -> ProcessTracker
ascProcessTracker :: !ProcessTracker
    , AppStartConfig -> HostManager
ascHostManager    :: !HostManager
    , AppStartConfig -> PortPool
ascPortPool       :: !PortPool
    , AppStartConfig -> Plugins
ascPlugins        :: !Plugins
    , AppStartConfig -> KeterConfig
ascKeterConfig    :: !KeterConfig
    }

data App = App
    { App -> TVar (Maybe EpochTime)
appModTime        :: !(TVar (Maybe EpochTime))
    , App -> TVar [RunningWebApp]
appRunningWebApps :: !(TVar [RunningWebApp])
    , App -> TVar [RunningBackgroundApp]
appBackgroundApps :: !(TVar [RunningBackgroundApp])
    , App -> AppId
appId             :: !AppId
    , App -> TVar (Set Host)
appHosts          :: !(TVar (Set Host))
    , App -> TVar (Maybe String)
appDir            :: !(TVar (Maybe FilePath))
    , App -> AppStartConfig
appAsc            :: !AppStartConfig
    , App -> TVar (Maybe Logger)
appLog           :: !(TVar (Maybe Logger))
    }

instance Show App where
  show :: App -> String
show App {AppId
appId :: App -> AppId
appId :: AppId
appId} = String
"App{appId=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> AppId -> String
forall a. Show a => a -> String
show AppId
appId String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"}"

-- | within an stm context we can show a lot more then the show instance can do
showApp :: App -> STM Text
showApp :: App -> STM Text
showApp App{TVar [RunningBackgroundApp]
TVar [RunningWebApp]
TVar (Maybe String)
TVar (Maybe EpochTime)
TVar (Maybe Logger)
TVar (Set Host)
AppId
AppStartConfig
appModTime :: App -> TVar (Maybe EpochTime)
appRunningWebApps :: App -> TVar [RunningWebApp]
appBackgroundApps :: App -> TVar [RunningBackgroundApp]
appId :: App -> AppId
appHosts :: App -> TVar (Set Host)
appDir :: App -> TVar (Maybe String)
appAsc :: App -> AppStartConfig
appLog :: App -> TVar (Maybe Logger)
appModTime :: TVar (Maybe EpochTime)
appRunningWebApps :: TVar [RunningWebApp]
appBackgroundApps :: TVar [RunningBackgroundApp]
appId :: AppId
appHosts :: TVar (Set Host)
appDir :: TVar (Maybe String)
appAsc :: AppStartConfig
appLog :: TVar (Maybe Logger)
..} = do
  Maybe EpochTime
appModTime' <- TVar (Maybe EpochTime) -> STM (Maybe EpochTime)
forall a. TVar a -> STM a
readTVar TVar (Maybe EpochTime)
appModTime
  [RunningWebApp]
appRunning' <- TVar [RunningWebApp] -> STM [RunningWebApp]
forall a. TVar a -> STM a
readTVar TVar [RunningWebApp]
appRunningWebApps
  Set Host
appHosts'   <- TVar (Set Host) -> STM (Set Host)
forall a. TVar a -> STM a
readTVar TVar (Set Host)
appHosts
  Text -> STM Text
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> STM Text) -> Text -> STM Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
    AppId -> String
forall a. Show a => a -> String
show AppId
appId String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
    String
" modtime: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe EpochTime -> String
forall a. Show a => a -> String
show Maybe EpochTime
appModTime' String -> ShowS
forall a. Semigroup a => a -> a -> a
<>  String
", webappsRunning: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>  [RunningWebApp] -> String
forall a. Show a => a -> String
show [RunningWebApp]
appRunning' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", hosts: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Set Host -> String
forall a. Show a => a -> String
show Set Host
appHosts'