{-# language ForeignFunctionInterface #-}
{-# language NamedFieldPuns #-}
{-# language OverloadedStrings #-}
{-# language RecordWildCards #-}
{-# language ViewPatterns #-}
module Prometheus.Metric.Proc ( ProcMetrics(..), procMetrics ) where
import Data.Char ( isSpace )
import Data.Int ( Int64 )
import Data.List ( isPrefixOf )
import Data.Maybe ( catMaybes, maybeToList )
import Data.String ( fromString )
import Data.Text ( Text, unpack )
import Data.Text.IO ( readFile )
import Foreign.C
import Prelude hiding ( readFile )
import Prometheus
import System.Directory ( listDirectory )
import System.FilePath
import System.IO.Unsafe
import System.Posix.Memory ( sysconfPageSize )
import System.Posix.Process ( getProcessID )
import System.Posix.Types ( ProcessID )
import qualified Text.Regex.Applicative as RE
import qualified Text.Regex.Applicative.Common as RE
data ProcMetrics =
ProcMetrics
procMetrics :: Prometheus.Metric ProcMetrics
procMetrics :: Metric ProcMetrics
procMetrics =
forall s. IO (s, IO [SampleGroup]) -> Metric s
Metric ( forall (m :: * -> *) a. Monad m => a -> m a
return ( ProcMetrics
ProcMetrics, IO [SampleGroup]
collect ) )
foreign import ccall unsafe
clk_tck :: CLong
collect :: IO [ SampleGroup ]
collect :: IO [SampleGroup]
collect = do
ProcessID
pid <-
IO ProcessID
getProcessID
Maybe ProcStat
mprocStat <-
forall s a. RE s a -> [s] -> Maybe a
RE.match RE Char ProcStat
parseProcStat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
readFile ( ProcessID -> String
procPidDir ProcessID
pid String -> String -> String
</> String
"stat" )
SampleGroup
processOpenFds <-
ProcessID -> IO SampleGroup
collectProcessOpenFds ProcessID
pid
Maybe SampleGroup
processMaxFds <-
ProcessID -> IO (Maybe SampleGroup)
collectProcessMaxFds ProcessID
pid
forall (m :: * -> *) a. Monad m => a -> m a
return
( [ SampleGroup
processOpenFds ]
forall a. Semigroup a => a -> a -> a
<> forall a. Maybe a -> [a]
maybeToList Maybe SampleGroup
processMaxFds
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ( ProcStat -> [SampleGroup]
procStatToMetrics ) Maybe ProcStat
mprocStat
)
collectProcessOpenFds :: ProcessID -> IO SampleGroup
collectProcessOpenFds :: ProcessID -> IO SampleGroup
collectProcessOpenFds ProcessID
pid = do
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
( forall a. Show a => Text -> Text -> SampleType -> a -> SampleGroup
metric Text
"process_open_fds" Text
"Number of open file descriptors." SampleType
GaugeType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length )
( String -> IO [String]
listDirectory ( ProcessID -> String
procPidDir ProcessID
pid String -> String -> String
</> String
"fd" ) )
collectProcessMaxFds :: ProcessID -> IO ( Maybe SampleGroup )
collectProcessMaxFds :: ProcessID -> IO (Maybe SampleGroup)
collectProcessMaxFds ProcessID
pid = do
[String]
limitLines <-
String -> [String]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
readFile ( ProcessID -> String
procPidDir ProcessID
pid String -> String -> String
</> String
"limits" )
case forall a. (a -> Bool) -> [a] -> [a]
filter ( String
"Max open files" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ) [String]
limitLines of
( String -> [String]
words -> String
_max : String
_open : String
_files : String
n : [String]
_ ) : [String]
_ ->
forall (m :: * -> *) a. Monad m => a -> m a
return
( forall a. a -> Maybe a
Just
( forall a. Show a => Text -> Text -> SampleType -> a -> SampleGroup
metric
Text
"process_max_fds"
Text
"Maximum number of open file descriptors."
SampleType
GaugeType
( forall a. Read a => String -> a
read String
n :: Int )
)
)
[String]
_ ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
procPidDir :: ProcessID -> FilePath
procPidDir :: ProcessID -> String
procPidDir ProcessID
pid =
String
"/" String -> String -> String
</> String
"proc" String -> String -> String
</> forall a. Show a => a -> String
show ProcessID
pid
procStatToMetrics :: ProcStat -> [ SampleGroup ]
procStatToMetrics :: ProcStat -> [SampleGroup]
procStatToMetrics ProcStat{ Int64
utime :: ProcStat -> Int64
utime :: Int64
utime, Int64
stime :: ProcStat -> Int64
stime :: Int64
stime, Int64
starttime :: ProcStat -> Int64
starttime :: Int64
starttime, Int64
vsize :: ProcStat -> Int64
vsize :: Int64
vsize, Int64
rss :: ProcStat -> Int64
rss :: Int64
rss } =
forall a. [Maybe a] -> [a]
catMaybes
[ forall a. a -> Maybe a
Just SampleGroup
process_cpu_seconds_total
, Maybe SampleGroup
process_start_time_seconds
, forall a. a -> Maybe a
Just SampleGroup
process_virtual_memory_bytes
, forall a. a -> Maybe a
Just SampleGroup
process_resident_memory_bytes
]
where
process_cpu_seconds_total :: SampleGroup
process_cpu_seconds_total =
forall a. Show a => Text -> Text -> SampleType -> a -> SampleGroup
metric
Text
"process_cpu_seconds_total"
Text
"Total user and system CPU time spent in seconds."
SampleType
CounterType
( Int64 -> Double
fromTicks ( Int64
utime forall a. Num a => a -> a -> a
+ Int64
stime ) )
process_start_time_seconds :: Maybe SampleGroup
process_start_time_seconds = do
Int64
btime <-
Maybe Int64
mbtime
forall (m :: * -> *) a. Monad m => a -> m a
return
( forall a. Show a => Text -> Text -> SampleType -> a -> SampleGroup
metric
Text
"process_start_time_seconds"
Text
"Start time of the process since unix epoch in seconds."
SampleType
GaugeType
( forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
btime forall a. Num a => a -> a -> a
+ Int64 -> Double
fromTicks Int64
starttime )
)
process_virtual_memory_bytes :: SampleGroup
process_virtual_memory_bytes =
forall a. Show a => Text -> Text -> SampleType -> a -> SampleGroup
metric
Text
"process_virtual_memory_bytes"
Text
"Virtual memory size in bytes."
SampleType
GaugeType
Int64
vsize
process_resident_memory_bytes :: SampleGroup
process_resident_memory_bytes =
forall a. Show a => Text -> Text -> SampleType -> a -> SampleGroup
metric
Text
"process_resident_memory_bytes"
Text
"Resident memory size in bytes."
SampleType
GaugeType
( Int64
rss forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sysconfPageSize )
metric :: Show a => Text -> Text -> SampleType -> a -> SampleGroup
metric :: forall a. Show a => Text -> Text -> SampleType -> a -> SampleGroup
metric Text
metricName Text
metricHelp SampleType
metricType a
value =
Info -> SampleType -> [Sample] -> SampleGroup
SampleGroup
Info{Text
metricName :: Text
metricHelp :: Text
metricHelp :: Text
metricName :: Text
..}
SampleType
metricType
[ Text -> LabelPairs -> ByteString -> Sample
Sample
Text
metricName
[]
( forall a. IsString a => String -> a
fromString ( forall a. Show a => a -> String
show a
value ) )
]
fromTicks :: Int64 -> Double
fromTicks :: Int64 -> Double
fromTicks Int64
ticks =
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
ticks forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
clk_tck
{-# NOINLINE mbtime #-}
mbtime :: Maybe Int64
mbtime :: Maybe Int64
mbtime = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( \( String
_, Int64
a, String
_ ) -> Int64
a ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. RE s a -> [s] -> Maybe ([s], a, [s])
RE.findFirstInfix ( RE Char String
"btime " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Num a => RE Char a
RE.decimal ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
readFile String
"/proc/stat"
data ProcStat = ProcStat
{ ProcStat -> Int64
utime :: Int64
, ProcStat -> Int64
stime :: Int64
, ProcStat -> Int64
starttime :: Int64
, ProcStat -> Int64
vsize :: Int64
, :: Int64
}
deriving
( Int -> ProcStat -> String -> String
[ProcStat] -> String -> String
ProcStat -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ProcStat] -> String -> String
$cshowList :: [ProcStat] -> String -> String
show :: ProcStat -> String
$cshow :: ProcStat -> String
showsPrec :: Int -> ProcStat -> String -> String
$cshowsPrec :: Int -> ProcStat -> String -> String
Show )
parseProcStat :: RE.RE Char ProcStat
parseProcStat :: RE Char ProcStat
parseProcStat =
Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> ProcStat
ProcStat
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall {a}. RE Char a -> RE Char a
token ( forall s. Eq s => s -> RE s s
RE.sym Char
'(' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
RE.some forall s. RE s s
RE.anySym forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s. Eq s => s -> RE s s
RE.sym Char
')' )
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. RE Char a -> RE Char a
token forall a. Num a => RE Char a
RE.decimal
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. RE Char a -> RE Char a
token forall a. Num a => RE Char a
RE.decimal
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. RE Char a -> RE Char a
token forall a. Num a => RE Char a
RE.decimal
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. RE Char a -> RE Char a
token forall a. Num a => RE Char a
RE.decimal
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. RE Char a -> RE Char a
token forall a. Num a => RE Char a
RE.decimal
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char String
any
where
token :: RE Char a -> RE Char a
token RE Char a
a =
RE Char a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s. (s -> Bool) -> RE s s
RE.psym Char -> Bool
isSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s a. RE s a -> RE s [a]
RE.few ( forall s. (s -> Bool) -> RE s s
RE.psym Char -> Bool
isSpace )
any :: RE Char String
any =
forall {a}. RE Char a -> RE Char a
token ( forall s a. RE s a -> RE s [a]
RE.few forall s. RE s s
RE.anySym )