mirror of
https://github.com/Start9Labs/start-os.git
synced 2026-03-26 10:21:52 +00:00
82 lines
3.0 KiB
Haskell
82 lines
3.0 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
module Handler.Status where
|
|
|
|
import Startlude
|
|
|
|
import Control.Carrier.Error.Either
|
|
import Data.Aeson.Encoding
|
|
import Git.Embed
|
|
import Yesod.Core.Handler
|
|
import Yesod.Core.Json
|
|
import Yesod.Core.Types
|
|
|
|
import Constants
|
|
import Daemon.ZeroConf
|
|
import Foundation
|
|
import Handler.Types.Metrics
|
|
import Handler.Types.V0.Specs
|
|
import Handler.Types.V0.Base
|
|
import Lib.Algebra.State.RegistryUrl
|
|
import Lib.Error
|
|
import Lib.External.Metrics.Df
|
|
import qualified Lib.External.Registry as Reg
|
|
import Lib.External.Specs.CPU
|
|
import Lib.External.Specs.Memory
|
|
import Lib.Metrics
|
|
import Lib.SystemPaths hiding ( (</>) )
|
|
import Lib.Tor
|
|
import Settings
|
|
import Control.Carrier.Lift ( runM )
|
|
import System.Process
|
|
import qualified UnliftIO
|
|
import System.FileLock
|
|
|
|
getVersionR :: Handler AppVersionRes
|
|
getVersionR = pure . AppVersionRes $ agentVersion
|
|
|
|
getVersionLatestR :: Handler VersionLatestRes
|
|
getVersionLatestR = handleS9ErrT $ do
|
|
s <- getsYesod appSettings
|
|
uncurry VersionLatestRes <$> interp s Reg.getLatestAgentVersion
|
|
where interp s = ExceptT . liftIO . runError . injectFilesystemBaseFromContext s . runRegistryUrlIOC
|
|
|
|
|
|
getSpecsR :: Handler Encoding -- deprecated in 0.2.0
|
|
getSpecsR = handleS9ErrT $ do
|
|
settings <- getsYesod appSettings
|
|
specsCPU <- liftIO getCpuInfo
|
|
specsMem <- liftIO getMem
|
|
specsDisk <- fmap show . metricDiskSize <$> getDfMetrics
|
|
specsNetworkId <- lift . runM . injectFilesystemBaseFromContext settings $ getStart9AgentHostname
|
|
specsTorAddress <- lift . runM . injectFilesystemBaseFromContext settings $ getAgentHiddenServiceUrl
|
|
specsLanAddress <-
|
|
fmap (<> ".local") . lift . runM . injectFilesystemBaseFromContext settings $ getStart9AgentHostname
|
|
|
|
let specsAgentVersion = agentVersion
|
|
returnJsonEncoding SpecsRes { .. }
|
|
|
|
getMetricsR :: Handler (JSONResponse MetricsRes)
|
|
getMetricsR = do
|
|
app <- getYesod
|
|
fmap (JSONResponse . MetricsRes) . handleS9ErrT . getServerMetrics $ app
|
|
|
|
embassyNamePath :: SystemPath
|
|
embassyNamePath = "/root/agent/name.txt"
|
|
|
|
patchServerR :: Handler ()
|
|
patchServerR = do
|
|
PatchServerReq { patchServerReqName } <- requireCheckJsonBody @_ @PatchServerReq
|
|
base <- getsYesod $ appFilesystemBase . appSettings
|
|
liftIO $ writeFile (toS $ embassyNamePath `relativeTo` base) patchServerReqName
|
|
|
|
getGitR :: Handler Text
|
|
getGitR = pure $embedGitRevision
|
|
|
|
getLogsR :: Handler (JSONResponse [Text])
|
|
getLogsR = do
|
|
let debugLock = "/root/agent/tmp/debug.lock"
|
|
UnliftIO.bracket (liftIO $ lockFile debugLock Exclusive) (liftIO . unlockFile) $ const $ do
|
|
liftIO $ callCommand "journalctl -u agent --since \"1 hour ago\" > /root/agent/tmp/debug.log"
|
|
liftIO $ JSONResponse . lines <$> readFile "/root/agent/tmp/debug.log"
|