diff --git a/ridley-extras.cabal b/ridley-extras.cabal --- a/ridley-extras.cabal +++ b/ridley-extras.cabal @@ -1,5 +1,5 @@ name: ridley-extras -version: 0.1.2.0 +version: 0.1.3.0 synopsis: Handy metrics that don't belong to ridley. description: See README.md homepage: https://github.com/iconnect/ridley/ridley-extras#readme @@ -7,7 +7,7 @@ license-file: LICENSE author: Alfredo Di Napoli maintainer: chrisd@irisconnect.co.uk -copyright: 2017 Alfredo Di Napoli & IRIS Connect Engineering Team +copyright: 2017-2022 Alfredo Di Napoli & IRIS Connect Engineering Team category: Web build-type: Simple extra-source-files: README.md @@ -20,13 +20,16 @@ library hs-source-dirs: src - exposed-modules: System.Metrics.Prometheus.Ridley.Metrics.FD + exposed-modules: + System.Metrics.Prometheus.Ridley.Metrics.FD + System.Metrics.Prometheus.Ridley.Metrics.VirtualMemory + System.Metrics.Prometheus.Ridley.Metrics.PhysicalMemory build-depends: base >= 4.7 && < 5, text, prometheus < 3, shelly < 1.9.0.0, microlens, - ekg-prometheus-adapter < 0.2.0.0, + ekg-prometheus-adapter < 0.3.0.0, mtl, transformers, ridley >= 0.3.3.0 && < 0.4.0.0 diff --git a/src/System/Metrics/Prometheus/Ridley/Metrics/PhysicalMemory.hs b/src/System/Metrics/Prometheus/Ridley/Metrics/PhysicalMemory.hs new file mode 100644 --- /dev/null +++ b/src/System/Metrics/Prometheus/Ridley/Metrics/PhysicalMemory.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} +module System.Metrics.Prometheus.Ridley.Metrics.PhysicalMemory where + +import Control.Monad.IO.Class +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Monoid +import Data.Word +import qualified Data.Text as T +import Lens.Micro +import Shelly +import qualified System.Metrics.Prometheus.Metric.Gauge as P +import qualified System.Metrics.Prometheus.RegistryT as P +import System.Metrics.Prometheus.Ridley.Types +import System.Posix.Types (ProcessID) +import System.Remote.Monitoring.Prometheus (labels) +import Text.Read (readMaybe) + +{- Calling 'free' will report +[service-runner@hermes-devel ~]$ free -k + total used free shared buff/cache available +Mem: 962 377 251 36 333 377 +Swap: 4095 0 4095 +-} + +-------------------------------------------------------------------------------- +getFreeStats :: IO FreeReport +getFreeStats = do + rawOutput <- shelly $ silently $ escaping False $ + mapMaybe (readMaybe @Word64 . T.unpack) . T.words . T.strip <$> run "free" ["-m" ,"|" , "tail", "-n", "-2" , "|", "awk", "-F", "\" \"", "'{printf \"%s %s %s %s %s %s %s\", $2, $3, $4, $5, $6, $7, $8}'"] + case rawOutput of + [ free_mem_total_mb + , free_mem_used_mb + , free_mem_free_mb + , free_mem_shared_mb + , free_mem_buff_cache_mb + , free_mem_available_mb + , free_swap_total_mb + , free_swap_used_mb + , free_swap_free_mb + ] -> pure $ FreeReport{..} + _ -> pure emptyFreeReport + +-------------------------------------------------------------------------------- +updateFreeStats :: FreeGauges -> Bool -> IO () +updateFreeStats FreeGauges{..} _ = do +#ifdef darwin_HOST_OS + let FreeReport{..} = emptyFreeReport-- "free" is not available on Darwin. +#else + FreeReport{..} <- getFreeStats +#endif + P.set (realToFrac free_mem_total_mb ) free_mem_total_mb_g + P.set (realToFrac free_mem_used_mb ) free_mem_used_mb_g + P.set (realToFrac free_mem_free_mb ) free_mem_free_mb_g + P.set (realToFrac free_mem_shared_mb ) free_mem_shared_mb_g + P.set (realToFrac free_mem_buff_cache_mb ) free_mem_buff_cache_mb_g + P.set (realToFrac free_mem_available_mb ) free_mem_available_mb_g + P.set (realToFrac free_swap_total_mb ) free_swap_total_mb_g + P.set (realToFrac free_swap_used_mb ) free_swap_used_mb_g + P.set (realToFrac free_swap_free_mb ) free_swap_free_mb_g + +data FreeReport = + FreeReport { + free_mem_total_mb :: !Word64 + , free_mem_used_mb :: !Word64 + , free_mem_free_mb :: !Word64 + , free_mem_shared_mb :: !Word64 + , free_mem_buff_cache_mb :: !Word64 + , free_mem_available_mb :: !Word64 + , free_swap_total_mb :: !Word64 + , free_swap_used_mb :: !Word64 + , free_swap_free_mb :: !Word64 + } deriving (Show, Eq) + +emptyFreeReport :: FreeReport +emptyFreeReport = FreeReport + { free_mem_total_mb = 0 + , free_mem_used_mb = 0 + , free_mem_free_mb = 0 + , free_mem_shared_mb = 0 + , free_mem_buff_cache_mb = 0 + , free_mem_available_mb = 0 + , free_swap_total_mb = 0 + , free_swap_used_mb = 0 + , free_swap_free_mb = 0 + } + + +data FreeGauges = + FreeGauges { + free_mem_total_mb_g :: !P.Gauge + , free_mem_used_mb_g :: !P.Gauge + , free_mem_free_mb_g :: !P.Gauge + , free_mem_shared_mb_g :: !P.Gauge + , free_mem_buff_cache_mb_g :: !P.Gauge + , free_mem_available_mb_g :: !P.Gauge + , free_swap_total_mb_g :: !P.Gauge + , free_swap_used_mb_g :: !P.Gauge + , free_swap_free_mb_g :: !P.Gauge + } + +-------------------------------------------------------------------------------- +-- | Returns the physical memory total and free as sampled from 'free'. +systemPhysicalMemory :: MonadIO m + => RidleyOptions + -> P.RegistryT m RidleyMetricHandler +systemPhysicalMemory opts = do + let popts = opts ^. prometheusOptions + gauges <- FreeGauges <$> P.registerGauge "free_mem_total_mb" (popts ^. labels) + <*> P.registerGauge "free_mem_used_mb" (popts ^. labels) + <*> P.registerGauge "free_mem_free_mb" (popts ^. labels) + <*> P.registerGauge "free_mem_shared_mb" (popts ^. labels) + <*> P.registerGauge "free_mem_buff_cache_mb" (popts ^. labels) + <*> P.registerGauge "free_mem_available_mb" (popts ^. labels) + <*> P.registerGauge "free_swap_total_mb" (popts ^. labels) + <*> P.registerGauge "free_swap_used_mb" (popts ^. labels) + <*> P.registerGauge "free_swap_free_mb" (popts ^. labels) + return $ mkRidleyMetricHandler "ridley-physical-memory-statistics" gauges updateFreeStats False diff --git a/src/System/Metrics/Prometheus/Ridley/Metrics/VirtualMemory.hs b/src/System/Metrics/Prometheus/Ridley/Metrics/VirtualMemory.hs new file mode 100644 --- /dev/null +++ b/src/System/Metrics/Prometheus/Ridley/Metrics/VirtualMemory.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} +module System.Metrics.Prometheus.Ridley.Metrics.VirtualMemory where + +import Control.Monad.IO.Class +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Monoid +import Data.Word +import qualified Data.Text as T +import Lens.Micro +import Shelly +import qualified System.Metrics.Prometheus.Metric.Gauge as P +import qualified System.Metrics.Prometheus.RegistryT as P +import System.Metrics.Prometheus.Ridley.Types +import System.Posix.Types (ProcessID) +import System.Remote.Monitoring.Prometheus (labels) +import Text.Read (readMaybe) + +{- Calling 'vmstat' will report + +[centos@atlas-eu ~]$ vmstat -S M -s + 130701440 M total memory + 52971728 M used memory + 92670416 M active memory + 33348008 M inactive memory + 852768 M free memory + 0 M buffer memory + 76876944 M swap cache + 0 M total swap + 0 M used swap + 0 M free swap + ... +-} + +-------------------------------------------------------------------------------- +getVmStats :: IO VmStatReport +getVmStats = do + rawOutput <- shelly $ silently $ escaping False $ + mapMaybe (readMaybe @Word64 . T.unpack) . T.words . T.strip + <$> run "vmstat" ["-S", "M", "-s" ,"|" , "head", "-n", "10" , "|" , "awk", "-F", "\" \"" , "'{print $1}'" ] + case rawOutput of + [ vmstat_total_memory_mb + , vmstat_used_memory_mb + , vmstat_active_memory_mb + , vmstat_inactive_memory_mb + , vmstat_free_memory_mb + , vmstat_buffer_memory_mb + , vmstat_swap_cache_mb + , vmstat_total_swap_mb + , vmstat_used_swap_mb + , vmstat_free_swap_mb + ] -> pure $ VmStatReport{..} + _ -> pure emptyVmStatReport + +-------------------------------------------------------------------------------- +updateVmStat :: VmStatGauges -> Bool -> IO () +updateVmStat VmStatGauges{..} _ = do +#ifdef darwin_HOST_OS + let VmStatReport{..} = emptyVmStatReport-- "vmstat" is not available on Darwin. +#else + VmStatReport{..} <- getVmStats +#endif + P.set (realToFrac vmstat_total_memory_mb ) vmstat_total_memory_mb_g + P.set (realToFrac vmstat_used_memory_mb ) vmstat_used_memory_mb_g + P.set (realToFrac vmstat_active_memory_mb ) vmstat_active_memory_mb_g + P.set (realToFrac vmstat_inactive_memory_mb ) vmstat_inactive_memory_mb_g + P.set (realToFrac vmstat_free_memory_mb ) vmstat_free_memory_mb_g + P.set (realToFrac vmstat_buffer_memory_mb ) vmstat_buffer_memory_mb_g + P.set (realToFrac vmstat_swap_cache_mb ) vmstat_swap_cache_mb_g + P.set (realToFrac vmstat_total_swap_mb ) vmstat_total_swap_mb_g + P.set (realToFrac vmstat_used_swap_mb ) vmstat_used_swap_mb_g + P.set (realToFrac vmstat_free_swap_mb ) vmstat_free_swap_mb_g + +data VmStatReport = + VmStatReport { + vmstat_total_memory_mb :: !Word64 + , vmstat_used_memory_mb :: !Word64 + , vmstat_active_memory_mb :: !Word64 + , vmstat_inactive_memory_mb :: !Word64 + , vmstat_free_memory_mb :: !Word64 + , vmstat_buffer_memory_mb :: !Word64 + , vmstat_swap_cache_mb :: !Word64 + , vmstat_total_swap_mb :: !Word64 + , vmstat_used_swap_mb :: !Word64 + , vmstat_free_swap_mb :: !Word64 + } deriving (Show, Eq) + +emptyVmStatReport :: VmStatReport +emptyVmStatReport = VmStatReport + { vmstat_total_memory_mb = 0 + , vmstat_used_memory_mb = 0 + , vmstat_active_memory_mb = 0 + , vmstat_inactive_memory_mb = 0 + , vmstat_free_memory_mb = 0 + , vmstat_buffer_memory_mb = 0 + , vmstat_swap_cache_mb = 0 + , vmstat_total_swap_mb = 0 + , vmstat_used_swap_mb = 0 + , vmstat_free_swap_mb = 0 + } + + +data VmStatGauges = + VmStatGauges { + vmstat_total_memory_mb_g :: !P.Gauge + , vmstat_used_memory_mb_g :: !P.Gauge + , vmstat_active_memory_mb_g :: !P.Gauge + , vmstat_inactive_memory_mb_g :: !P.Gauge + , vmstat_free_memory_mb_g :: !P.Gauge + , vmstat_buffer_memory_mb_g :: !P.Gauge + , vmstat_swap_cache_mb_g :: !P.Gauge + , vmstat_total_swap_mb_g :: !P.Gauge + , vmstat_used_swap_mb_g :: !P.Gauge + , vmstat_free_swap_mb_g :: !P.Gauge + } + +-------------------------------------------------------------------------------- +-- | Returns the virtual memory total and free as sampled from 'vmstat'. +systemVirtualMemory :: MonadIO m + => RidleyOptions + -> P.RegistryT m RidleyMetricHandler +systemVirtualMemory opts = do + let popts = opts ^. prometheusOptions + gauges <- VmStatGauges <$> P.registerGauge "vmstat_total_memory_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_used_memory_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_active_memory_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_inactive_memory_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_free_memory_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_buffer_memory_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_swap_cache_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_total_swap_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_used_swap_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_free_swap_mb" (popts ^. labels) + return $ mkRidleyMetricHandler "ridley-virtual-memory-statistics" gauges updateVmStat False