{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      : System.MemInfo.SysInfo
Copyright   : (c) 2022 Tim Emiola
Maintainer  : Tim Emiola <adetokunbo@emio.la>
SPDX-License-Identifier: BSD3

This module provides data types that

- define memory reports (cf @'ReportBud'@) and

- provide info about the system where the report will run (cf @'KernelVersion'@,
@'SwapFlaw'@ and @'RamFlaw'@).

along with functions that use these types.
-}
module System.MemInfo.SysInfo (
  -- * define reports
  ReportBud (..),
  mkReportBud,

  -- * indicate calculation flaws
  RamFlaw (..),
  SwapFlaw (..),
  checkForFlaws,
  fmtRamFlaws,
  fmtSwapFlaws,

  -- * system kernel version
  KernelVersion,
  parseKernelVersion,
  readKernelVersion,
  fickleSharing,
) where

import Control.Monad ((>=>))
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Read as Text
import Fmt ((+|), (|+))
import System.MemInfo.Prelude


-- | Represents a version of @Linux@ kernel
type KernelVersion = (Natural, Natural, Natural)


{- | On linux kernels before smaps became available, there was no reliable way to
determine how much of a processes memory was shared

http://lkml.org/lkml/2005/7/6/250
-}
fickleSharing :: KernelVersion -> Bool
fickleSharing :: KernelVersion -> Bool
fickleSharing KernelVersion
k = KernelVersion
k KernelVersion -> KernelVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= (Natural
2, Natural
6, Natural
1) Bool -> Bool -> Bool
&& KernelVersion
k KernelVersion -> KernelVersion -> Bool
forall a. Ord a => a -> a -> Bool
<= (Natural
2, Natural
6, Natural
9)


-- | Determines the version of the Linux kernel on the current system.
readKernelVersion :: FilePath -> IO (Maybe KernelVersion)
readKernelVersion :: FilePath -> IO (Maybe KernelVersion)
readKernelVersion = (Text -> Maybe KernelVersion)
-> IO Text -> IO (Maybe KernelVersion)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe KernelVersion
parseKernelVersion (IO Text -> IO (Maybe KernelVersion))
-> (FilePath -> IO Text) -> FilePath -> IO (Maybe KernelVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Text
Text.readFile (FilePath -> IO Text)
-> (FilePath -> FilePath) -> FilePath -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
kernelVersionPath


kernelVersionPath :: FilePath -> FilePath
kernelVersionPath :: FilePath -> FilePath
kernelVersionPath FilePath
root = Builder
"" Builder -> Builder -> FilePath
forall b. FromBuilder b => Builder -> Builder -> b
+| FilePath
root FilePath -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"/sys/kernel/osrelease"


-- | Parses @Text@ into a @'KernelVersion'@
parseKernelVersion :: Text -> Maybe KernelVersion
parseKernelVersion :: Text -> Maybe KernelVersion
parseKernelVersion =
  let unrecognized :: Maybe a
unrecognized = Maybe a
forall a. Maybe a
Nothing
      dec' :: Either a (a, Text) -> Maybe a
dec' (Right (a
x, Text
extra)) | Text -> Bool
Text.null Text
extra = a -> Maybe a
forall a. a -> Maybe a
Just a
x
      dec' Either a (a, Text)
_ = Maybe a
forall a. Maybe a
unrecognized
      dec1st' :: Either a (a, b) -> Maybe a
dec1st' (Right (a
x, b
_)) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
      dec1st' Either a (a, b)
_ = Maybe a
forall a. Maybe a
unrecognized

      dec :: Text -> Maybe Natural
dec = Either FilePath (Natural, Text) -> Maybe Natural
forall {a} {a}. Either a (a, Text) -> Maybe a
dec' (Either FilePath (Natural, Text) -> Maybe Natural)
-> (Text -> Either FilePath (Natural, Text))
-> Text
-> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath (Natural, Text)
forall a. Integral a => Reader a
Text.decimal
      dec1st :: Text -> Maybe Natural
dec1st = Either FilePath (Natural, Text) -> Maybe Natural
forall {a} {a} {b}. Either a (a, b) -> Maybe a
dec1st' (Either FilePath (Natural, Text) -> Maybe Natural)
-> (Text -> Either FilePath (Natural, Text))
-> Text
-> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath (Natural, Text)
forall a. Integral a => Reader a
Text.decimal
      fromSplit :: [Text] -> Maybe KernelVersion
fromSplit [Text
x] = (,,) (Natural -> Natural -> Natural -> KernelVersion)
-> Maybe Natural -> Maybe (Natural -> Natural -> KernelVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Natural
dec Text
x Maybe (Natural -> Natural -> KernelVersion)
-> Maybe Natural -> Maybe (Natural -> KernelVersion)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> Maybe Natural
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
0 Maybe (Natural -> KernelVersion)
-> Maybe Natural -> Maybe KernelVersion
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> Maybe Natural
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
0
      fromSplit [Text
x, Text
y] = (,,) (Natural -> Natural -> Natural -> KernelVersion)
-> Maybe Natural -> Maybe (Natural -> Natural -> KernelVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Natural
dec Text
x Maybe (Natural -> Natural -> KernelVersion)
-> Maybe Natural -> Maybe (Natural -> KernelVersion)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe Natural
dec1st Text
y Maybe (Natural -> KernelVersion)
-> Maybe Natural -> Maybe KernelVersion
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> Maybe Natural
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
0
      fromSplit [Text
x, Text
y, Text
z] = (,,) (Natural -> Natural -> Natural -> KernelVersion)
-> Maybe Natural -> Maybe (Natural -> Natural -> KernelVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Natural
dec Text
x Maybe (Natural -> Natural -> KernelVersion)
-> Maybe Natural -> Maybe (Natural -> KernelVersion)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe Natural
dec Text
y Maybe (Natural -> KernelVersion)
-> Maybe Natural -> Maybe KernelVersion
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe Natural
dec1st Text
z
      fromSplit [Text]
_ = Maybe KernelVersion
forall a. Maybe a
unrecognized
   in [Text] -> Maybe KernelVersion
fromSplit ([Text] -> Maybe KernelVersion)
-> (Text -> [Text]) -> Text -> Maybe KernelVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')


-- | Gathers the inputs needed to generate a memory usage report
data ReportBud = ReportBud
  { ReportBud -> NonEmpty ProcessID
rbPids :: !(NonEmpty ProcessID)
  , ReportBud -> KernelVersion
rbKernel :: !KernelVersion
  , ReportBud -> Bool
rbHasPss :: !Bool
  , ReportBud -> Bool
rbHasSwapPss :: !Bool
  , ReportBud -> Bool
rbHasSmaps :: !Bool
  , ReportBud -> Maybe RamFlaw
rbRamFlaws :: !(Maybe RamFlaw)
  , ReportBud -> Maybe SwapFlaw
rbSwapFlaws :: !(Maybe SwapFlaw)
  , ReportBud -> FilePath
rbProcRoot :: !FilePath
  }
  deriving (ReportBud -> ReportBud -> Bool
(ReportBud -> ReportBud -> Bool)
-> (ReportBud -> ReportBud -> Bool) -> Eq ReportBud
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReportBud -> ReportBud -> Bool
== :: ReportBud -> ReportBud -> Bool
$c/= :: ReportBud -> ReportBud -> Bool
/= :: ReportBud -> ReportBud -> Bool
Eq, Int -> ReportBud -> FilePath -> FilePath
[ReportBud] -> FilePath -> FilePath
ReportBud -> FilePath
(Int -> ReportBud -> FilePath -> FilePath)
-> (ReportBud -> FilePath)
-> ([ReportBud] -> FilePath -> FilePath)
-> Show ReportBud
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> ReportBud -> FilePath -> FilePath
showsPrec :: Int -> ReportBud -> FilePath -> FilePath
$cshow :: ReportBud -> FilePath
show :: ReportBud -> FilePath
$cshowList :: [ReportBud] -> FilePath -> FilePath
showList :: [ReportBud] -> FilePath -> FilePath
Show)


-- | Describes inaccuracies in the RAM calculation
data RamFlaw
  = -- | no shared mem is reported
    NoSharedMem
  | -- | some shared mem not reported
    SomeSharedMem
  | -- | accurate only considering each process in isolation
    ExactForIsolatedMem
  deriving (RamFlaw -> RamFlaw -> Bool
(RamFlaw -> RamFlaw -> Bool)
-> (RamFlaw -> RamFlaw -> Bool) -> Eq RamFlaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RamFlaw -> RamFlaw -> Bool
== :: RamFlaw -> RamFlaw -> Bool
$c/= :: RamFlaw -> RamFlaw -> Bool
/= :: RamFlaw -> RamFlaw -> Bool
Eq, Int -> RamFlaw -> FilePath -> FilePath
[RamFlaw] -> FilePath -> FilePath
RamFlaw -> FilePath
(Int -> RamFlaw -> FilePath -> FilePath)
-> (RamFlaw -> FilePath)
-> ([RamFlaw] -> FilePath -> FilePath)
-> Show RamFlaw
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> RamFlaw -> FilePath -> FilePath
showsPrec :: Int -> RamFlaw -> FilePath -> FilePath
$cshow :: RamFlaw -> FilePath
show :: RamFlaw -> FilePath
$cshowList :: [RamFlaw] -> FilePath -> FilePath
showList :: [RamFlaw] -> FilePath -> FilePath
Show, Eq RamFlaw
Eq RamFlaw =>
(RamFlaw -> RamFlaw -> Ordering)
-> (RamFlaw -> RamFlaw -> Bool)
-> (RamFlaw -> RamFlaw -> Bool)
-> (RamFlaw -> RamFlaw -> Bool)
-> (RamFlaw -> RamFlaw -> Bool)
-> (RamFlaw -> RamFlaw -> RamFlaw)
-> (RamFlaw -> RamFlaw -> RamFlaw)
-> Ord RamFlaw
RamFlaw -> RamFlaw -> Bool
RamFlaw -> RamFlaw -> Ordering
RamFlaw -> RamFlaw -> RamFlaw
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RamFlaw -> RamFlaw -> Ordering
compare :: RamFlaw -> RamFlaw -> Ordering
$c< :: RamFlaw -> RamFlaw -> Bool
< :: RamFlaw -> RamFlaw -> Bool
$c<= :: RamFlaw -> RamFlaw -> Bool
<= :: RamFlaw -> RamFlaw -> Bool
$c> :: RamFlaw -> RamFlaw -> Bool
> :: RamFlaw -> RamFlaw -> Bool
$c>= :: RamFlaw -> RamFlaw -> Bool
>= :: RamFlaw -> RamFlaw -> Bool
$cmax :: RamFlaw -> RamFlaw -> RamFlaw
max :: RamFlaw -> RamFlaw -> RamFlaw
$cmin :: RamFlaw -> RamFlaw -> RamFlaw
min :: RamFlaw -> RamFlaw -> RamFlaw
Ord)


-- | Provide @Text@ that explains the 'RamFlaw'
fmtRamFlaws :: RamFlaw -> Text
fmtRamFlaws :: RamFlaw -> Text
fmtRamFlaws RamFlaw
NoSharedMem =
  [Text] -> Text
Text.unlines
    [ Text
"shared memory is not reported by this system."
    , Text
"Values reported will be too large, and totals are not reported"
    ]
fmtRamFlaws RamFlaw
SomeSharedMem =
  [Text] -> Text
Text.unlines
    [ Text
"shared memory is not reported accurately by this system."
    , Text
"Values reported could be too large, and totals are not reported"
    ]
fmtRamFlaws RamFlaw
ExactForIsolatedMem =
  [Text] -> Text
Text.unlines
    [ Text
"shared memory is slightly over-estimated by this system"
    , Text
"for each program, so totals are not reported."
    ]


-- | Describes inaccuracies in the swap measurement
data SwapFlaw
  = -- | not available
    NoSwap
  | -- | accurate only considering each process in isolation
    ExactForIsolatedSwap
  deriving (SwapFlaw -> SwapFlaw -> Bool
(SwapFlaw -> SwapFlaw -> Bool)
-> (SwapFlaw -> SwapFlaw -> Bool) -> Eq SwapFlaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SwapFlaw -> SwapFlaw -> Bool
== :: SwapFlaw -> SwapFlaw -> Bool
$c/= :: SwapFlaw -> SwapFlaw -> Bool
/= :: SwapFlaw -> SwapFlaw -> Bool
Eq, Int -> SwapFlaw -> FilePath -> FilePath
[SwapFlaw] -> FilePath -> FilePath
SwapFlaw -> FilePath
(Int -> SwapFlaw -> FilePath -> FilePath)
-> (SwapFlaw -> FilePath)
-> ([SwapFlaw] -> FilePath -> FilePath)
-> Show SwapFlaw
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> SwapFlaw -> FilePath -> FilePath
showsPrec :: Int -> SwapFlaw -> FilePath -> FilePath
$cshow :: SwapFlaw -> FilePath
show :: SwapFlaw -> FilePath
$cshowList :: [SwapFlaw] -> FilePath -> FilePath
showList :: [SwapFlaw] -> FilePath -> FilePath
Show, Eq SwapFlaw
Eq SwapFlaw =>
(SwapFlaw -> SwapFlaw -> Ordering)
-> (SwapFlaw -> SwapFlaw -> Bool)
-> (SwapFlaw -> SwapFlaw -> Bool)
-> (SwapFlaw -> SwapFlaw -> Bool)
-> (SwapFlaw -> SwapFlaw -> Bool)
-> (SwapFlaw -> SwapFlaw -> SwapFlaw)
-> (SwapFlaw -> SwapFlaw -> SwapFlaw)
-> Ord SwapFlaw
SwapFlaw -> SwapFlaw -> Bool
SwapFlaw -> SwapFlaw -> Ordering
SwapFlaw -> SwapFlaw -> SwapFlaw
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SwapFlaw -> SwapFlaw -> Ordering
compare :: SwapFlaw -> SwapFlaw -> Ordering
$c< :: SwapFlaw -> SwapFlaw -> Bool
< :: SwapFlaw -> SwapFlaw -> Bool
$c<= :: SwapFlaw -> SwapFlaw -> Bool
<= :: SwapFlaw -> SwapFlaw -> Bool
$c> :: SwapFlaw -> SwapFlaw -> Bool
> :: SwapFlaw -> SwapFlaw -> Bool
$c>= :: SwapFlaw -> SwapFlaw -> Bool
>= :: SwapFlaw -> SwapFlaw -> Bool
$cmax :: SwapFlaw -> SwapFlaw -> SwapFlaw
max :: SwapFlaw -> SwapFlaw -> SwapFlaw
$cmin :: SwapFlaw -> SwapFlaw -> SwapFlaw
min :: SwapFlaw -> SwapFlaw -> SwapFlaw
Ord)


-- | Provide @Text@ that explains the 'SwapFlaw'
fmtSwapFlaws :: SwapFlaw -> Text
fmtSwapFlaws :: SwapFlaw -> Text
fmtSwapFlaws SwapFlaw
NoSwap = Text
"swap is not reported by this system."
fmtSwapFlaws SwapFlaw
ExactForIsolatedSwap =
  [Text] -> Text
Text.unlines
    [ Text
"swap is over-estimated by this system"
    , Text
"for each program, so totals are not reported."
    ]


{- | Examine the target system for @'RamFlaw's@ and @'SwapFlaw's@, and update
@bud@ reflect the findings.
-}
checkForFlaws :: ReportBud -> IO ReportBud
checkForFlaws :: ReportBud -> IO ReportBud
checkForFlaws ReportBud
bud = do
  let memInfoPath :: FilePath
memInfoPath = FilePath -> FilePath
meminfoPathOf (ReportBud -> FilePath
rbProcRoot ReportBud
bud)
      ReportBud
        { rbHasPss :: ReportBud -> Bool
rbHasPss = Bool
hasPss
        , rbHasSmaps :: ReportBud -> Bool
rbHasSmaps = Bool
hasSmaps
        , rbHasSwapPss :: ReportBud -> Bool
rbHasSwapPss = Bool
hasSwapPss
        , rbKernel :: ReportBud -> KernelVersion
rbKernel = KernelVersion
version
        } = ReportBud
bud
  (Maybe RamFlaw
rbRamFlaws, Maybe SwapFlaw
rbSwapFlaws) <- case KernelVersion
version of
    (Natural
2, Natural
4, Natural
_patch) -> do
      let hasInact :: IO Bool
hasInact = Text -> Text -> Bool
Text.isInfixOf Text
"Inact_" (Text -> Bool) -> IO Text -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
readUtf8Text FilePath
memInfoPath
          andHasInact :: Bool -> IO Bool
andHasInact Bool
x = if Bool
x then IO Bool
hasInact else Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
          memInfoMem :: Bool -> RamFlaw
memInfoMem Bool
x = if Bool
x then RamFlaw
SomeSharedMem else RamFlaw
ExactForIsolatedMem
          mkFlawPair :: Bool -> (Maybe RamFlaw, Maybe SwapFlaw)
mkFlawPair Bool
x = (RamFlaw -> Maybe RamFlaw
forall a. a -> Maybe a
Just (RamFlaw -> Maybe RamFlaw) -> RamFlaw -> Maybe RamFlaw
forall a b. (a -> b) -> a -> b
$ Bool -> RamFlaw
memInfoMem Bool
x, SwapFlaw -> Maybe SwapFlaw
forall a. a -> Maybe a
Just SwapFlaw
NoSwap)
          isInactPresent :: FilePath -> IO Bool
isInactPresent = FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> (Bool -> IO Bool) -> FilePath -> IO Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Bool -> IO Bool
andHasInact
      Bool -> (Maybe RamFlaw, Maybe SwapFlaw)
mkFlawPair (Bool -> (Maybe RamFlaw, Maybe SwapFlaw))
-> IO Bool -> IO (Maybe RamFlaw, Maybe SwapFlaw)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
isInactPresent FilePath
memInfoPath
    (Natural
2, Natural
6, Natural
_patch) -> do
      (Maybe RamFlaw, Maybe SwapFlaw)
-> IO (Maybe RamFlaw, Maybe SwapFlaw)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe RamFlaw, Maybe SwapFlaw)
 -> IO (Maybe RamFlaw, Maybe SwapFlaw))
-> (Maybe RamFlaw, Maybe SwapFlaw)
-> IO (Maybe RamFlaw, Maybe SwapFlaw)
forall a b. (a -> b) -> a -> b
$
        if
          | Bool
hasSmaps Bool -> Bool -> Bool
&& Bool
hasPss -> (Maybe RamFlaw
forall a. Maybe a
Nothing, SwapFlaw -> Maybe SwapFlaw
forall a. a -> Maybe a
Just SwapFlaw
ExactForIsolatedSwap)
          | Bool
hasSmaps -> (RamFlaw -> Maybe RamFlaw
forall a. a -> Maybe a
Just RamFlaw
ExactForIsolatedMem, SwapFlaw -> Maybe SwapFlaw
forall a. a -> Maybe a
Just SwapFlaw
ExactForIsolatedSwap)
          | KernelVersion -> Bool
fickleSharing KernelVersion
version -> (RamFlaw -> Maybe RamFlaw
forall a. a -> Maybe a
Just RamFlaw
NoSharedMem, SwapFlaw -> Maybe SwapFlaw
forall a. a -> Maybe a
Just SwapFlaw
NoSwap)
          | Bool
otherwise -> (RamFlaw -> Maybe RamFlaw
forall a. a -> Maybe a
Just RamFlaw
SomeSharedMem, SwapFlaw -> Maybe SwapFlaw
forall a. a -> Maybe a
Just SwapFlaw
NoSwap)
    (Natural
major, Natural
_minor, Natural
_patch) | Natural
major Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
2 Bool -> Bool -> Bool
&& Bool
hasSmaps -> do
      (Maybe RamFlaw, Maybe SwapFlaw)
-> IO (Maybe RamFlaw, Maybe SwapFlaw)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe RamFlaw
forall a. Maybe a
Nothing, if Bool
hasSwapPss then Maybe SwapFlaw
forall a. Maybe a
Nothing else SwapFlaw -> Maybe SwapFlaw
forall a. a -> Maybe a
Just SwapFlaw
ExactForIsolatedSwap)
    KernelVersion
_other -> (Maybe RamFlaw, Maybe SwapFlaw)
-> IO (Maybe RamFlaw, Maybe SwapFlaw)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RamFlaw -> Maybe RamFlaw
forall a. a -> Maybe a
Just RamFlaw
ExactForIsolatedMem, SwapFlaw -> Maybe SwapFlaw
forall a. a -> Maybe a
Just SwapFlaw
NoSwap)
  ReportBud -> IO ReportBud
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReportBud -> IO ReportBud) -> ReportBud -> IO ReportBud
forall a b. (a -> b) -> a -> b
$ ReportBud
bud {rbRamFlaws, rbSwapFlaws}


{- | Construct a @ReportBud@ from some @ProcessIDs@

Generates values for the other fields by inspecting the system

The result is @Nothing@ when either

- the process root is not accessible
- the @KernelVersion@ cannot be determined
-}
mkReportBud :: FilePath -> NonEmpty ProcessID -> IO (Maybe ReportBud)
mkReportBud :: FilePath -> NonEmpty ProcessID -> IO (Maybe ReportBud)
mkReportBud FilePath
rbProcRoot NonEmpty ProcessID
rbPids = do
  let firstPid :: ProcessID
firstPid = NonEmpty ProcessID -> ProcessID
forall a. NonEmpty a -> a
NE.head NonEmpty ProcessID
rbPids
      smapsPath :: FilePath
smapsPath = FilePath -> FilePath -> ProcessID -> FilePath
pidPath FilePath
rbProcRoot FilePath
"smaps" ProcessID
firstPid
      hasPss :: Text -> Bool
hasPss = Text -> Text -> Bool
Text.isInfixOf Text
"Pss:"
      hasSwapPss :: Text -> Bool
hasSwapPss = Text -> Text -> Bool
Text.isInfixOf Text
"SwapPss:"
      memtypes :: Text -> (Bool, Bool)
memtypes Text
x = (Text -> Bool
hasPss Text
x, Text -> Bool
hasSwapPss Text
x)
  Bool
rootAccessible <- FilePath -> IO Bool
canAccessRoot FilePath
rbProcRoot
  if Bool -> Bool
not Bool
rootAccessible
    then Maybe ReportBud -> IO (Maybe ReportBud)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ReportBud
forall a. Maybe a
Nothing
    else do
      Bool
rbHasSmaps <- FilePath -> IO Bool
doesFileExist FilePath
smapsPath
      (Bool
rbHasPss, Bool
rbHasSwapPss) <-
        if Bool
rbHasSmaps
          then Text -> (Bool, Bool)
memtypes (Text -> (Bool, Bool)) -> IO Text -> IO (Bool, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
readUtf8Text FilePath
smapsPath
          else (Bool, Bool) -> IO (Bool, Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, Bool
False)
      FilePath -> IO (Maybe KernelVersion)
readKernelVersion FilePath
rbProcRoot IO (Maybe KernelVersion)
-> (Maybe KernelVersion -> IO (Maybe ReportBud))
-> IO (Maybe ReportBud)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe KernelVersion
Nothing -> Maybe ReportBud -> IO (Maybe ReportBud)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ReportBud
forall a. Maybe a
Nothing
        Just KernelVersion
rbKernel ->
          (ReportBud -> Maybe ReportBud)
-> IO ReportBud -> IO (Maybe ReportBud)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ReportBud -> Maybe ReportBud
forall a. a -> Maybe a
Just (IO ReportBud -> IO (Maybe ReportBud))
-> IO ReportBud -> IO (Maybe ReportBud)
forall a b. (a -> b) -> a -> b
$
            ReportBud -> IO ReportBud
checkForFlaws (ReportBud -> IO ReportBud) -> ReportBud -> IO ReportBud
forall a b. (a -> b) -> a -> b
$
              ReportBud
                { NonEmpty ProcessID
rbPids :: NonEmpty ProcessID
rbPids :: NonEmpty ProcessID
rbPids
                , KernelVersion
rbKernel :: KernelVersion
rbKernel :: KernelVersion
rbKernel
                , Bool
rbHasPss :: Bool
rbHasPss :: Bool
rbHasPss
                , Bool
rbHasSwapPss :: Bool
rbHasSwapPss :: Bool
rbHasSwapPss
                , Bool
rbHasSmaps :: Bool
rbHasSmaps :: Bool
rbHasSmaps
                , rbRamFlaws :: Maybe RamFlaw
rbRamFlaws = Maybe RamFlaw
forall a. Maybe a
Nothing
                , rbSwapFlaws :: Maybe SwapFlaw
rbSwapFlaws = Maybe SwapFlaw
forall a. Maybe a
Nothing
                , FilePath
rbProcRoot :: FilePath
rbProcRoot :: FilePath
rbProcRoot
                }


pidPath :: FilePath -> FilePath -> ProcessID -> FilePath
pidPath :: FilePath -> FilePath -> ProcessID -> FilePath
pidPath FilePath
root FilePath
base ProcessID
pid = Builder
"" Builder -> Builder -> FilePath
forall b. FromBuilder b => Builder -> Builder -> b
+| FilePath
root FilePath -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"/" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ProcessID -> Integer
forall a. Integral a => a -> Integer
toInteger ProcessID
pid Integer -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"/" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| FilePath
base FilePath -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""


meminfoPathOf :: FilePath -> FilePath
meminfoPathOf :: FilePath -> FilePath
meminfoPathOf FilePath
root = Builder
"" Builder -> Builder -> FilePath
forall b. FromBuilder b => Builder -> Builder -> b
+| FilePath
root FilePath -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"/meminfo"


canAccessRoot :: FilePath -> IO Bool
canAccessRoot :: FilePath -> IO Bool
canAccessRoot FilePath
root = do
  Bool
doesRootExist <- FilePath -> IO Bool
doesDirectoryExist FilePath
root
  if Bool -> Bool
not Bool
doesRootExist
    then Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    else do
      Permissions
p <- FilePath -> IO Permissions
getPermissions FilePath
root
      Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Permissions -> Bool
readable Permissions
p Bool -> Bool -> Bool
&& Permissions -> Bool
searchable Permissions
p