module Hasura.Server.ResourceChecker
  ( getServerResources,
    ComputeResourcesResponse (..),
    ResourceCheckerError (..),

    -- * Exposed for testing
    getMaxPhysicalMemory,
    getPhysicalCpuResource,
    getPhysicalResources,
    getServerResources_,
    getCGroupV1Resources,
    getCGroupV2Resources,
  )
where

import Data.Aeson (ToJSON (toJSON))
import Data.Aeson qualified as J
import Data.Bifunctor (Bifunctor (bimap))
import Data.Int (Int64)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Text.Read qualified as T
import GHC.Conc (getNumProcessors)
import Hasura.Prelude
import System.Directory (doesFileExist)
import System.FilePath (takeDirectory, (</>))
import System.IO.Error (catchIOError)

-- | The response data of cpu and memory resources
data ComputeResourcesResponse = ComputeResourcesResponse
  { ComputeResourcesResponse -> Maybe Int
_rcrCpu :: Maybe Int,
    ComputeResourcesResponse -> Maybe Int64
_rcrMemory :: Maybe Int64,
    ComputeResourcesResponse -> Maybe ResourceCheckerError
_rcrErrorCode :: Maybe ResourceCheckerError
  }
  deriving ((forall x.
 ComputeResourcesResponse -> Rep ComputeResourcesResponse x)
-> (forall x.
    Rep ComputeResourcesResponse x -> ComputeResourcesResponse)
-> Generic ComputeResourcesResponse
forall x.
Rep ComputeResourcesResponse x -> ComputeResourcesResponse
forall x.
ComputeResourcesResponse -> Rep ComputeResourcesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ComputeResourcesResponse -> Rep ComputeResourcesResponse x
from :: forall x.
ComputeResourcesResponse -> Rep ComputeResourcesResponse x
$cto :: forall x.
Rep ComputeResourcesResponse x -> ComputeResourcesResponse
to :: forall x.
Rep ComputeResourcesResponse x -> ComputeResourcesResponse
Generic, ComputeResourcesResponse -> ComputeResourcesResponse -> Bool
(ComputeResourcesResponse -> ComputeResourcesResponse -> Bool)
-> (ComputeResourcesResponse -> ComputeResourcesResponse -> Bool)
-> Eq ComputeResourcesResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComputeResourcesResponse -> ComputeResourcesResponse -> Bool
== :: ComputeResourcesResponse -> ComputeResourcesResponse -> Bool
$c/= :: ComputeResourcesResponse -> ComputeResourcesResponse -> Bool
/= :: ComputeResourcesResponse -> ComputeResourcesResponse -> Bool
Eq, Int -> ComputeResourcesResponse -> ShowS
[ComputeResourcesResponse] -> ShowS
ComputeResourcesResponse -> String
(Int -> ComputeResourcesResponse -> ShowS)
-> (ComputeResourcesResponse -> String)
-> ([ComputeResourcesResponse] -> ShowS)
-> Show ComputeResourcesResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComputeResourcesResponse -> ShowS
showsPrec :: Int -> ComputeResourcesResponse -> ShowS
$cshow :: ComputeResourcesResponse -> String
show :: ComputeResourcesResponse -> String
$cshowList :: [ComputeResourcesResponse] -> ShowS
showList :: [ComputeResourcesResponse] -> ShowS
Show)

instance J.ToJSON ComputeResourcesResponse where
  toJSON :: ComputeResourcesResponse -> J.Value
  toJSON :: ComputeResourcesResponse -> Value
toJSON = Options -> ComputeResourcesResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}

data CGroupMode
  = CGUnavailable
  | CGroupV1
  | CGroupV2
  deriving (CGroupMode -> CGroupMode -> Bool
(CGroupMode -> CGroupMode -> Bool)
-> (CGroupMode -> CGroupMode -> Bool) -> Eq CGroupMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CGroupMode -> CGroupMode -> Bool
== :: CGroupMode -> CGroupMode -> Bool
$c/= :: CGroupMode -> CGroupMode -> Bool
/= :: CGroupMode -> CGroupMode -> Bool
Eq, Int -> CGroupMode -> ShowS
[CGroupMode] -> ShowS
CGroupMode -> String
(Int -> CGroupMode -> ShowS)
-> (CGroupMode -> String)
-> ([CGroupMode] -> ShowS)
-> Show CGroupMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CGroupMode -> ShowS
showsPrec :: Int -> CGroupMode -> ShowS
$cshow :: CGroupMode -> String
show :: CGroupMode -> String
$cshowList :: [CGroupMode] -> ShowS
showList :: [CGroupMode] -> ShowS
Show)

data ResourceCheckerError
  = CGroupUnavailable
  | CpuInconclusive
  | MemoryInconclusive
  | CpuMemoryInconclusive
  | RCInternalError String
  deriving (ResourceCheckerError -> ResourceCheckerError -> Bool
(ResourceCheckerError -> ResourceCheckerError -> Bool)
-> (ResourceCheckerError -> ResourceCheckerError -> Bool)
-> Eq ResourceCheckerError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceCheckerError -> ResourceCheckerError -> Bool
== :: ResourceCheckerError -> ResourceCheckerError -> Bool
$c/= :: ResourceCheckerError -> ResourceCheckerError -> Bool
/= :: ResourceCheckerError -> ResourceCheckerError -> Bool
Eq)

instance Show ResourceCheckerError where
  show :: ResourceCheckerError -> String
show = \case
    ResourceCheckerError
CGroupUnavailable -> String
"CGROUP_UNAVAILABLE"
    ResourceCheckerError
CpuInconclusive -> String
"CPU_INCONCLUSIVE"
    ResourceCheckerError
MemoryInconclusive -> String
"MEMORY_INCONCLUSIVE"
    ResourceCheckerError
CpuMemoryInconclusive -> String
"CPU_MEMORY_INCONCLUSIVE"
    RCInternalError String
err -> String
err

instance J.ToJSON ResourceCheckerError where
  toJSON :: ResourceCheckerError -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
J.toJSON (String -> Value)
-> (ResourceCheckerError -> String)
-> ResourceCheckerError
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceCheckerError -> String
forall a. Show a => a -> String
show

perCpuShares :: Int
perCpuShares :: Int
perCpuShares = Int
1024

-- | Limit the maximum memory capacity of the physical server
-- The resource checker will returns the inconclusive memory error if the value exceeds this limit
-- according to Red Hat limits https://access.redhat.com/articles/rhel-limits
maximumMemoryLimitBytes :: Int64
maximumMemoryLimitBytes :: Int64
maximumMemoryLimitBytes = Int64
256 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* (Int64
1024 Int64 -> Int64 -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int64
4 :: Int64)) -- 256 TiBs

-- | Determine allocated cpu and memory resources of the host server or Container Runtime.
-- because HGE mainly runs in the container runtime
-- we need to determine the max cpu and memory limit constraints
-- that are managed by cgroups or fallback to physical cpu and memory information of the server
-- https://hasurahq.atlassian.net/browse/INFRA-772
--
-- Those information are stored in many files of cgroup folders,
-- the logic is simply to read them and parse number values
--
-- In cgroup v1 systems there are several ways in which the amount of allocated cpu resources could be presented.
-- We first try reading requests (quota & period); if that fails, we fallback to reading limits (shares);
-- if that fails, we fallback to reading the physical cpu count, which should always succeed.

-- Some cgroup v2 systems still use the cgroup v1 file structure (hybrid mode). To account for those systems,
-- we fallback to the above cgroup v1 logic if we fail to read the allocated cpu resources in the expected way.
getServerResources :: (MonadIO m) => m ComputeResourcesResponse
getServerResources :: forall (m :: * -> *). MonadIO m => m ComputeResourcesResponse
getServerResources = String -> m ComputeResourcesResponse
forall (m :: * -> *).
MonadIO m =>
String -> m ComputeResourcesResponse
getServerResources_ String
"/proc/self/mountinfo"

getServerResources_ :: (MonadIO m) => FilePath -> m ComputeResourcesResponse
getServerResources_ :: forall (m :: * -> *).
MonadIO m =>
String -> m ComputeResourcesResponse
getServerResources_ String
mountPath =
  m (CGroupMode, String)
getCGroupMode m (CGroupMode, String)
-> ((CGroupMode, String) -> m ComputeResourcesResponse)
-> m ComputeResourcesResponse
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (CGroupMode
CGUnavailable, String
_) -> Maybe ResourceCheckerError -> m ComputeResourcesResponse
forall (m :: * -> *).
MonadIO m =>
Maybe ResourceCheckerError -> m ComputeResourcesResponse
getPhysicalResources (ResourceCheckerError -> Maybe ResourceCheckerError
forall a. a -> Maybe a
Just ResourceCheckerError
CGroupUnavailable)
    (CGroupMode
CGroupV1, String
cgroupRoot) -> String -> m ComputeResourcesResponse
forall (m :: * -> *).
MonadIO m =>
String -> m ComputeResourcesResponse
getCGroupV1Resources String
cgroupRoot
    (CGroupMode
CGroupV2, String
cgroupRoot) -> String -> m ComputeResourcesResponse
forall (m :: * -> *).
MonadIO m =>
String -> m ComputeResourcesResponse
getCGroupV2Resources String
cgroupRoot
  where
    -- find the line that contains the cgroup folder path in the mount info file
    -- the line should have from 9 words, for example:
    -- 29 21 0:25 / /sys/fs/cgroup rw,nosuid,nodev,noexec,relatime shared:9 - cgroup2 cgroup2
    --
    -- in cgroup v1 there can be many cgroup lines with child paths
    -- we need to find the root cgroup folder
    -- 1269 1263 0:31 /kubepods/burstable/pod37349393 /sys/fs/cgroup/blkio ro,nosuid,nodev,noexec,relatime master:14 - cgroup cgroup rw,blkio
    getCGroupMode :: m (CGroupMode, String)
getCGroupMode =
      IO (CGroupMode, String) -> m (CGroupMode, String)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO (CGroupMode, String) -> m (CGroupMode, String))
-> IO (CGroupMode, String) -> m (CGroupMode, String)
forall a b. (a -> b) -> a -> b
$ IO (CGroupMode, String)
-> (IOError -> IO (CGroupMode, String)) -> IO (CGroupMode, String)
forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError
          ( String -> IO Text
T.readFile String
mountPath
              IO Text
-> (Text -> IO (CGroupMode, String)) -> IO (CGroupMode, String)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( \[[Text]]
contentLines ->
                      case ([Text] -> Bool) -> [[Text]] -> Maybe [Text]
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\[Text]
ls -> (Text
"cgroup" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
ls Bool -> Bool -> Bool
|| Text
"cgroup2" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
ls) Bool -> Bool -> Bool
&& [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
9) [[Text]]
contentLines of
                        Maybe [Text]
Nothing -> (CGroupMode, String) -> IO (CGroupMode, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CGroupMode
CGUnavailable, String
"")
                        Just [Text]
ls ->
                          let cgroupPath :: String
cgroupPath = Text -> String
T.unpack ([Text]
ls [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
4)
                              cgroupRoot :: String
cgroupRoot = String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool (ShowS
takeDirectory String
cgroupPath) String
cgroupPath (Text
"cgroup2" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
ls)
                           in IO Bool -> IO Bool
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Bool
doesFileExist (String
cgroupRoot String -> ShowS
</> String
"cgroup.controllers"))
                                IO Bool -> (Bool -> CGroupMode) -> IO CGroupMode
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CGroupMode -> CGroupMode -> Bool -> CGroupMode
forall a. a -> a -> Bool -> a
bool CGroupMode
CGroupV1 CGroupMode
CGroupV2
                                IO CGroupMode
-> (CGroupMode -> (CGroupMode, String)) -> IO (CGroupMode, String)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,String
cgroupRoot)
                  )
              ([[Text]] -> IO (CGroupMode, String))
-> (Text -> [[Text]]) -> Text -> IO (CGroupMode, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Text]
T.words
              ([Text] -> [[Text]]) -> (Text -> [Text]) -> Text -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
          )
          ((CGroupMode, String) -> IO (CGroupMode, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CGroupMode, String) -> IO (CGroupMode, String))
-> (IOError -> (CGroupMode, String))
-> IOError
-> IO (CGroupMode, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CGroupMode, String) -> IOError -> (CGroupMode, String)
forall a b. a -> b -> a
const (CGroupMode
CGUnavailable, String
""))

-- | Compute the cpu share allocations from the number of physical CPU cores
getPhysicalCpuResource :: (MonadIO m) => m Int
getPhysicalCpuResource :: forall (m :: * -> *). MonadIO m => m Int
getPhysicalCpuResource = IO Int -> m Int
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
getNumProcessors m Int -> (Int -> Int) -> m Int
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
perCpuShares)

-- | Compute the max physical memory size of the server
getMaxPhysicalMemory :: (MonadIO m) => m (Maybe Int64)
getMaxPhysicalMemory :: forall (m :: * -> *). MonadIO m => m (Maybe Int64)
getMaxPhysicalMemory = IO (Maybe Int64) -> m (Maybe Int64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Int64) -> m (Maybe Int64))
-> IO (Maybe Int64) -> m (Maybe Int64)
forall a b. (a -> b) -> a -> b
$ IO (Maybe Int64)
-> (IOError -> IO (Maybe Int64)) -> IO (Maybe Int64)
forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError IO (Maybe Int64)
readMemory (Maybe Int64 -> IO (Maybe Int64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int64 -> IO (Maybe Int64))
-> (IOError -> Maybe Int64) -> IOError -> IO (Maybe Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int64 -> IOError -> Maybe Int64
forall a b. a -> b -> a
const Maybe Int64
forall a. Maybe a
Nothing)
  where
    -- the value of meminfo is in KB
    parseMemoryBytes :: Text -> Maybe Int64
parseMemoryBytes Text
l =
      if [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Text -> [Text]
T.words Text
l) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
        then Maybe Int64
forall a. Maybe a
Nothing
        else (ResourceCheckerError -> Maybe Int64)
-> (Int64 -> Maybe Int64)
-> Either ResourceCheckerError Int64
-> Maybe Int64
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Int64 -> ResourceCheckerError -> Maybe Int64
forall a b. a -> b -> a
const Maybe Int64
forall a. Maybe a
Nothing) (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> (Int64 -> Int64) -> Int64 -> Maybe Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1024)) (forall a. Integral a => Text -> Either ResourceCheckerError a
parseUint @Int64 (Text -> [Text]
T.words Text
l [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
1))

    readMemory :: IO (Maybe Int64)
readMemory =
      String -> IO Text
T.readFile String
"/proc/meminfo" IO Text -> (Text -> IO (Maybe Int64)) -> IO (Maybe Int64)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
c ->
        let l :: Maybe Text
l = (Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text
"MemTotal:" Text -> Text -> Bool
`T.isPrefixOf`) ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip (Text -> [Text]
T.lines Text
c))
         in Maybe Int64 -> IO (Maybe Int64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int64 -> IO (Maybe Int64))
-> Maybe Int64 -> IO (Maybe Int64)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Int64
parseMemoryBytes (Text -> Maybe Int64) -> Maybe Text -> Maybe Int64
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
l

getPhysicalResources :: (MonadIO m) => Maybe ResourceCheckerError -> m ComputeResourcesResponse
getPhysicalResources :: forall (m :: * -> *).
MonadIO m =>
Maybe ResourceCheckerError -> m ComputeResourcesResponse
getPhysicalResources Maybe ResourceCheckerError
err = do
  Int
cpu <- m Int
forall (m :: * -> *). MonadIO m => m Int
getPhysicalCpuResource
  Maybe Int64
maxMem <- m (Maybe Int64)
forall (m :: * -> *). MonadIO m => m (Maybe Int64)
getMaxPhysicalMemory
  ComputeResourcesResponse -> m ComputeResourcesResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ComputeResourcesResponse -> m ComputeResourcesResponse)
-> ComputeResourcesResponse -> m ComputeResourcesResponse
forall a b. (a -> b) -> a -> b
$ Maybe Int
-> Maybe Int64
-> Maybe ResourceCheckerError
-> ComputeResourcesResponse
ComputeResourcesResponse (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
cpu) Maybe Int64
maxMem Maybe ResourceCheckerError
err

-- | Determine cpu and memory resource allocations
-- if the OCI Container Runtime supports cgroup v1
getCGroupV1Resources :: (MonadIO m) => FilePath -> m ComputeResourcesResponse
getCGroupV1Resources :: forall (m :: * -> *).
MonadIO m =>
String -> m ComputeResourcesResponse
getCGroupV1Resources String
cgroupRoot = do
  (Int
cpu, Maybe ResourceCheckerError
cpuErr) <- ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
-> m (Int, Maybe ResourceCheckerError)
forall (m :: * -> *) e.
MonadIO m =>
ExceptT e m (Int, Maybe ResourceCheckerError)
-> m (Int, Maybe ResourceCheckerError)
catchCpuAllocation (ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
 -> m (Int, Maybe ResourceCheckerError))
-> ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
-> m (Int, Maybe ResourceCheckerError)
forall a b. (a -> b) -> a -> b
$ String
-> ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
forall (m :: * -> *).
(MonadIO m, MonadError ResourceCheckerError m) =>
String -> m (Int, Maybe ResourceCheckerError)
getCGroupV1CpuAllocation String
cgroupRoot
  (Maybe Int64
memMax, Maybe ResourceCheckerError
memErr) <- ExceptT
  ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
-> m (Maybe Int64, Maybe ResourceCheckerError)
forall (m :: * -> *).
MonadIO m =>
ExceptT
  ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
-> m (Maybe Int64, Maybe ResourceCheckerError)
catchMemoryAllocation (ExceptT
   ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
 -> m (Maybe Int64, Maybe ResourceCheckerError))
-> ExceptT
     ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
-> m (Maybe Int64, Maybe ResourceCheckerError)
forall a b. (a -> b) -> a -> b
$ String
-> ExceptT
     ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
forall (m :: * -> *).
(MonadIO m, MonadError ResourceCheckerError m) =>
String -> m (Maybe Int64, Maybe ResourceCheckerError)
getCGroupV1MemoryAllocation String
cgroupRoot
  ComputeResourcesResponse -> m ComputeResourcesResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ComputeResourcesResponse -> m ComputeResourcesResponse)
-> ComputeResourcesResponse -> m ComputeResourcesResponse
forall a b. (a -> b) -> a -> b
$ Maybe Int
-> Maybe Int64
-> Maybe ResourceCheckerError
-> ComputeResourcesResponse
ComputeResourcesResponse (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
cpu) Maybe Int64
memMax (Maybe ResourceCheckerError
-> Maybe ResourceCheckerError -> Maybe ResourceCheckerError
mergeCpuMemoryErrors Maybe ResourceCheckerError
cpuErr Maybe ResourceCheckerError
memErr)

getCGroupV1CpuAllocation ::
  (MonadIO m, MonadError ResourceCheckerError m) =>
  FilePath ->
  m (Int, Maybe ResourceCheckerError)
getCGroupV1CpuAllocation :: forall (m :: * -> *).
(MonadIO m, MonadError ResourceCheckerError m) =>
String -> m (Int, Maybe ResourceCheckerError)
getCGroupV1CpuAllocation String
cgroupRoot = m (Int, Maybe ResourceCheckerError)
cpuLimits m (Int, Maybe ResourceCheckerError)
-> (ResourceCheckerError -> m (Int, Maybe ResourceCheckerError))
-> m (Int, Maybe ResourceCheckerError)
forall a. m a -> (ResourceCheckerError -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` m (Int, Maybe ResourceCheckerError)
-> ResourceCheckerError -> m (Int, Maybe ResourceCheckerError)
forall a b. a -> b -> a
const m (Int, Maybe ResourceCheckerError)
cpuShares
  where
    readCpuValue :: String -> m Int
readCpuValue String
name = (String -> ResourceCheckerError) -> String -> m Int
forall (m :: * -> *) a.
(MonadIO m, MonadError ResourceCheckerError m, Integral a) =>
(String -> ResourceCheckerError) -> String -> m a
readFileUint (ResourceCheckerError -> String -> ResourceCheckerError
forall a b. a -> b -> a
const ResourceCheckerError
CpuInconclusive) (String
cgroupRoot String -> ShowS
</> String
"cpu" String -> ShowS
</> String
name)

    cpuShares :: m (Int, Maybe ResourceCheckerError)
cpuShares = do
      Int
shares <- String -> m Int
readCpuValue String
"cpu.shares"
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
shares Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2 Bool -> Bool -> Bool
|| Int
shares Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1024) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ResourceCheckerError -> m ()
forall a. ResourceCheckerError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ResourceCheckerError
RCInternalError String
"INVALID_CPU_SHARES")
      (Int, Maybe ResourceCheckerError)
-> m (Int, Maybe ResourceCheckerError)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
shares, Maybe ResourceCheckerError
forall a. Maybe a
Nothing)

    cpuLimits :: m (Int, Maybe ResourceCheckerError)
cpuLimits = do
      Int
cq <- String -> m Int
readCpuValue String
"cpu.cfs_quota_us"
      Int
cp <- String -> m Int
readCpuValue String
"cpu.cfs_period_us"
      Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
-> m (Int, Maybe ResourceCheckerError)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
 -> m (Int, Maybe ResourceCheckerError))
-> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
-> m (Int, Maybe ResourceCheckerError)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
deduceCpuLimits Int
cq Int
cp

getCGroupV1MemoryAllocation ::
  (MonadIO m, MonadError ResourceCheckerError m) =>
  FilePath ->
  m (Maybe Int64, Maybe ResourceCheckerError)
getCGroupV1MemoryAllocation :: forall (m :: * -> *).
(MonadIO m, MonadError ResourceCheckerError m) =>
String -> m (Maybe Int64, Maybe ResourceCheckerError)
getCGroupV1MemoryAllocation String
cgroupRoot =
  String -> m (Maybe Int64, Maybe ResourceCheckerError)
forall (m :: * -> *).
(MonadIO m, MonadError ResourceCheckerError m) =>
String -> m (Maybe Int64, Maybe ResourceCheckerError)
getMemoryAllocation (String
cgroupRoot String -> ShowS
</> String
"memory" String -> ShowS
</> String
"memory.limit_in_bytes")

-- | Determine cpu and memory resource allocations
-- if the OCI Container Runtime supports cgroup v2
getCGroupV2Resources :: (MonadIO m) => FilePath -> m ComputeResourcesResponse
getCGroupV2Resources :: forall (m :: * -> *).
MonadIO m =>
String -> m ComputeResourcesResponse
getCGroupV2Resources String
cgroupRoot = do
  (Int
cpu, Maybe ResourceCheckerError
cpuErr) <- m (Int, Maybe ResourceCheckerError)
getCpuAllocationCGroupV2
  (Maybe Int64
memMax, Maybe ResourceCheckerError
memErr) <- m (Maybe Int64, Maybe ResourceCheckerError)
getMemoryAllocationCGroupV2
  ComputeResourcesResponse -> m ComputeResourcesResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ComputeResourcesResponse -> m ComputeResourcesResponse)
-> ComputeResourcesResponse -> m ComputeResourcesResponse
forall a b. (a -> b) -> a -> b
$ Maybe Int
-> Maybe Int64
-> Maybe ResourceCheckerError
-> ComputeResourcesResponse
ComputeResourcesResponse (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
cpu) Maybe Int64
memMax (Maybe ResourceCheckerError
-> Maybe ResourceCheckerError -> Maybe ResourceCheckerError
mergeCpuMemoryErrors Maybe ResourceCheckerError
cpuErr Maybe ResourceCheckerError
memErr)
  where
    -- CPU shares (OCI) value needs to get translated into
    -- a proper CGroups v2 value. See:
    -- https://github.com/containers/crun/blob/master/crun.1.md#cpu-controller
    --
    -- Use the inverse of (x == OCI value, y == cgroupsv2 value):
    -- ((262142 * y - 1)/9999) + 2 = x
    cpuShares :: ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
cpuShares = do
      Int
shares' <- (String -> ResourceCheckerError)
-> String -> ExceptT ResourceCheckerError m Int
forall (m :: * -> *) a.
(MonadIO m, MonadError ResourceCheckerError m, Integral a) =>
(String -> ResourceCheckerError) -> String -> m a
readFileUint (ResourceCheckerError -> String -> ResourceCheckerError
forall a b. a -> b -> a
const ResourceCheckerError
CpuInconclusive) (String
cgroupRoot String -> ShowS
</> String
"cpu.weight")
      Bool
-> ExceptT ResourceCheckerError m ()
-> ExceptT ResourceCheckerError m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
shares' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2 Bool -> Bool -> Bool
|| Int
shares' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
100) (ExceptT ResourceCheckerError m ()
 -> ExceptT ResourceCheckerError m ())
-> ExceptT ResourceCheckerError m ()
-> ExceptT ResourceCheckerError m ()
forall a b. (a -> b) -> a -> b
$ ResourceCheckerError -> ExceptT ResourceCheckerError m ()
forall a. ResourceCheckerError -> ExceptT ResourceCheckerError m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ResourceCheckerError
RCInternalError String
"INVALID_CPU_SHARES")
      (Int, Maybe ResourceCheckerError)
-> ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
forall a. a -> ExceptT ResourceCheckerError m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
262142 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
shares' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
9999) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2, Maybe ResourceCheckerError
forall a. Maybe a
Nothing)

    parsePeriod :: Text -> Either ResourceCheckerError Int
parsePeriod = (ResourceCheckerError -> ResourceCheckerError)
-> Either ResourceCheckerError Int
-> Either ResourceCheckerError Int
forall e1 e2 a. (e1 -> e2) -> Either e1 a -> Either e2 a
mapLeft (ResourceCheckerError
-> ResourceCheckerError -> ResourceCheckerError
forall a b. a -> b -> a
const (ResourceCheckerError
 -> ResourceCheckerError -> ResourceCheckerError)
-> ResourceCheckerError
-> ResourceCheckerError
-> ResourceCheckerError
forall a b. (a -> b) -> a -> b
$ String -> ResourceCheckerError
RCInternalError String
"INVALID_CPU_PERIOD") (Either ResourceCheckerError Int
 -> Either ResourceCheckerError Int)
-> (Text -> Either ResourceCheckerError Int)
-> Text
-> Either ResourceCheckerError Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ResourceCheckerError Int
forall a. Integral a => Text -> Either ResourceCheckerError a
parseUint
    parseQuota :: Text -> Either ResourceCheckerError Int
parseQuota = (ResourceCheckerError -> ResourceCheckerError)
-> Either ResourceCheckerError Int
-> Either ResourceCheckerError Int
forall e1 e2 a. (e1 -> e2) -> Either e1 a -> Either e2 a
mapLeft (ResourceCheckerError
-> ResourceCheckerError -> ResourceCheckerError
forall a b. a -> b -> a
const (ResourceCheckerError
 -> ResourceCheckerError -> ResourceCheckerError)
-> ResourceCheckerError
-> ResourceCheckerError
-> ResourceCheckerError
forall a b. (a -> b) -> a -> b
$ String -> ResourceCheckerError
RCInternalError String
"INVALID_CPU_QUOTA") (Either ResourceCheckerError Int
 -> Either ResourceCheckerError Int)
-> (Text -> Either ResourceCheckerError Int)
-> Text
-> Either ResourceCheckerError Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ResourceCheckerError Int
forall a. Integral a => Text -> Either ResourceCheckerError a
parseUint

    cpuLimits :: ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
cpuLimits = do
      Text
content <- (String -> ResourceCheckerError)
-> String -> ExceptT ResourceCheckerError m Text
forall (m :: * -> *).
(MonadIO m, MonadError ResourceCheckerError m) =>
(String -> ResourceCheckerError) -> String -> m Text
readFileT (ResourceCheckerError -> String -> ResourceCheckerError
forall a b. a -> b -> a
const ResourceCheckerError
CpuInconclusive) (String
cgroupRoot String -> ShowS
</> String
"cpu.max")
      Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
-> ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
 -> ExceptT
      ResourceCheckerError m (Int, Maybe ResourceCheckerError))
-> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
-> ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
forall a b. (a -> b) -> a -> b
$ case (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip (Text -> [Text]
T.words Text
content) of
        [Text
quota, Text
period] -> (Int
 -> Int
 -> Either ResourceCheckerError (Int, Maybe ResourceCheckerError))
-> (Int, Int)
-> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int
-> Int
-> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
deduceCpuLimits ((Int, Int)
 -> Either ResourceCheckerError (Int, Maybe ResourceCheckerError))
-> Either ResourceCheckerError (Int, Int)
-> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (,) (Int -> Int -> (Int, Int))
-> Either ResourceCheckerError Int
-> Either ResourceCheckerError (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either ResourceCheckerError Int
parseQuota Text
quota Either ResourceCheckerError (Int -> (Int, Int))
-> Either ResourceCheckerError Int
-> Either ResourceCheckerError (Int, Int)
forall a b.
Either ResourceCheckerError (a -> b)
-> Either ResourceCheckerError a -> Either ResourceCheckerError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Either ResourceCheckerError Int
parsePeriod Text
period
        [Text]
_ -> ResourceCheckerError
-> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
forall a b. a -> Either a b
Left (ResourceCheckerError
 -> Either ResourceCheckerError (Int, Maybe ResourceCheckerError))
-> ResourceCheckerError
-> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
forall a b. (a -> b) -> a -> b
$ String -> ResourceCheckerError
RCInternalError String
"INVALID_CPU_PERIOD_AND_QUOTA"

    getCpuAllocationCGroupV2 :: m (Int, Maybe ResourceCheckerError)
getCpuAllocationCGroupV2 =
      ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
-> m (Int, Maybe ResourceCheckerError)
forall (m :: * -> *) e.
MonadIO m =>
ExceptT e m (Int, Maybe ResourceCheckerError)
-> m (Int, Maybe ResourceCheckerError)
catchCpuAllocation
        (ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
 -> m (Int, Maybe ResourceCheckerError))
-> ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
-> m (Int, Maybe ResourceCheckerError)
forall a b. (a -> b) -> a -> b
$ ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
cpuLimits
        ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
-> (ResourceCheckerError
    -> ExceptT
         ResourceCheckerError m (Int, Maybe ResourceCheckerError))
-> ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
forall a.
ExceptT ResourceCheckerError m a
-> (ResourceCheckerError -> ExceptT ResourceCheckerError m a)
-> ExceptT ResourceCheckerError m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
-> ResourceCheckerError
-> ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
forall a b. a -> b -> a
const ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
cpuShares
        ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
-> (ResourceCheckerError
    -> ExceptT
         ResourceCheckerError m (Int, Maybe ResourceCheckerError))
-> ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
forall a.
ExceptT ResourceCheckerError m a
-> (ResourceCheckerError -> ExceptT ResourceCheckerError m a)
-> ExceptT ResourceCheckerError m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
-> ResourceCheckerError
-> ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
forall a b. a -> b -> a
const (String
-> ExceptT ResourceCheckerError m (Int, Maybe ResourceCheckerError)
forall (m :: * -> *).
(MonadIO m, MonadError ResourceCheckerError m) =>
String -> m (Int, Maybe ResourceCheckerError)
getCGroupV1CpuAllocation String
cgroupRoot)

    getMemoryAllocationCGroupV2 :: m (Maybe Int64, Maybe ResourceCheckerError)
getMemoryAllocationCGroupV2 =
      ExceptT
  ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
-> m (Maybe Int64, Maybe ResourceCheckerError)
forall (m :: * -> *).
MonadIO m =>
ExceptT
  ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
-> m (Maybe Int64, Maybe ResourceCheckerError)
catchMemoryAllocation
        (ExceptT
   ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
 -> m (Maybe Int64, Maybe ResourceCheckerError))
-> ExceptT
     ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
-> m (Maybe Int64, Maybe ResourceCheckerError)
forall a b. (a -> b) -> a -> b
$ String
-> ExceptT
     ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
forall (m :: * -> *).
(MonadIO m, MonadError ResourceCheckerError m) =>
String -> m (Maybe Int64, Maybe ResourceCheckerError)
getMemoryAllocation (String
cgroupRoot String -> ShowS
</> String
"memory.max")
        ExceptT
  ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
-> (ResourceCheckerError
    -> ExceptT
         ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError))
-> ExceptT
     ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
forall a.
ExceptT ResourceCheckerError m a
-> (ResourceCheckerError -> ExceptT ResourceCheckerError m a)
-> ExceptT ResourceCheckerError m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` ExceptT
  ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
-> ResourceCheckerError
-> ExceptT
     ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
forall a b. a -> b -> a
const (String
-> ExceptT
     ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
forall (m :: * -> *).
(MonadIO m, MonadError ResourceCheckerError m) =>
String -> m (Maybe Int64, Maybe ResourceCheckerError)
getCGroupV1MemoryAllocation String
cgroupRoot)

deduceCpuLimits :: Int -> Int -> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
deduceCpuLimits :: Int
-> Int
-> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
deduceCpuLimits Int
quota Int
period
  | Int
quota Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ResourceCheckerError
-> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
forall a b. a -> Either a b
Left (ResourceCheckerError
 -> Either ResourceCheckerError (Int, Maybe ResourceCheckerError))
-> ResourceCheckerError
-> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
forall a b. (a -> b) -> a -> b
$ String -> ResourceCheckerError
RCInternalError String
"INVALID_CPU_QUOTA"
  | Int
period Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ResourceCheckerError
-> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
forall a b. a -> Either a b
Left (ResourceCheckerError
 -> Either ResourceCheckerError (Int, Maybe ResourceCheckerError))
-> ResourceCheckerError
-> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
forall a b. (a -> b) -> a -> b
$ String -> ResourceCheckerError
RCInternalError String
"INVALID_CPU_PERIOD"
  | Bool
otherwise = (Int, Maybe ResourceCheckerError)
-> Either ResourceCheckerError (Int, Maybe ResourceCheckerError)
forall a b. b -> Either a b
Right (Rational -> Int
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Int -> Rational
forall a. Real a => a -> Rational
toRational Int
quota Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Int -> Rational
forall a. Real a => a -> Rational
toRational Int
period Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Int -> Rational
forall a. Real a => a -> Rational
toRational Int
perCpuShares), Maybe ResourceCheckerError
forall a. Maybe a
Nothing)

getMemoryAllocation ::
  (MonadIO m, MonadError ResourceCheckerError m) =>
  FilePath ->
  m (Maybe Int64, Maybe ResourceCheckerError)
getMemoryAllocation :: forall (m :: * -> *).
(MonadIO m, MonadError ResourceCheckerError m) =>
String -> m (Maybe Int64, Maybe ResourceCheckerError)
getMemoryAllocation String
path = do
  Text
content <- (String -> ResourceCheckerError) -> String -> m Text
forall (m :: * -> *).
(MonadIO m, MonadError ResourceCheckerError m) =>
(String -> ResourceCheckerError) -> String -> m Text
readFileT (ResourceCheckerError -> String -> ResourceCheckerError
forall a b. a -> b -> a
const ResourceCheckerError
MemoryInconclusive) String
path m Text -> (Text -> Text) -> m Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
T.strip
  Maybe Int64
mMaxPhysicalMemory <- m (Maybe Int64)
forall (m :: * -> *). MonadIO m => m (Maybe Int64)
getMaxPhysicalMemory
  (Maybe Int64, Maybe ResourceCheckerError)
-> m (Maybe Int64, Maybe ResourceCheckerError)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    ((Maybe Int64, Maybe ResourceCheckerError)
 -> m (Maybe Int64, Maybe ResourceCheckerError))
-> (Maybe Int64, Maybe ResourceCheckerError)
-> m (Maybe Int64, Maybe ResourceCheckerError)
forall a b. (a -> b) -> a -> b
$ if Text
content Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"max"
      then (Maybe Int64
mMaxPhysicalMemory, Maybe ResourceCheckerError
forall a. Maybe a
Nothing)
      else case Text -> Either ResourceCheckerError Int64
forall a. Integral a => Text -> Either ResourceCheckerError a
parseUint Text
content of
        Left ResourceCheckerError
e -> (Maybe Int64
mMaxPhysicalMemory, ResourceCheckerError -> Maybe ResourceCheckerError
forall a. a -> Maybe a
Just ResourceCheckerError
e)
        -- the cgroup memory limit config should be smaller or equal the max physical memory
        Right Int64
mem ->
          if Int64
mem Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe Int64
maximumMemoryLimitBytes Maybe Int64
mMaxPhysicalMemory
            then (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
mem, Maybe ResourceCheckerError
forall a. Maybe a
Nothing)
            else (Maybe Int64
mMaxPhysicalMemory, ResourceCheckerError -> Maybe ResourceCheckerError
forall a. a -> Maybe a
Just ResourceCheckerError
MemoryInconclusive)

-- catch cpu allocation error with default physical cpu resource
catchCpuAllocation ::
  (MonadIO m) =>
  ExceptT e m (Int, Maybe ResourceCheckerError) ->
  m (Int, Maybe ResourceCheckerError)
catchCpuAllocation :: forall (m :: * -> *) e.
MonadIO m =>
ExceptT e m (Int, Maybe ResourceCheckerError)
-> m (Int, Maybe ResourceCheckerError)
catchCpuAllocation ExceptT e m (Int, Maybe ResourceCheckerError)
m =
  ExceptT e m (Int, Maybe ResourceCheckerError)
-> m (Either e (Int, Maybe ResourceCheckerError))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m (Int, Maybe ResourceCheckerError)
m
    m (Either e (Int, Maybe ResourceCheckerError))
-> (Either e (Int, Maybe ResourceCheckerError)
    -> m (Int, Maybe ResourceCheckerError))
-> m (Int, Maybe ResourceCheckerError)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either e (Int, Maybe ResourceCheckerError)
 -> (e -> m (Int, Maybe ResourceCheckerError))
 -> m (Int, Maybe ResourceCheckerError))
-> (e -> m (Int, Maybe ResourceCheckerError))
-> Either e (Int, Maybe ResourceCheckerError)
-> m (Int, Maybe ResourceCheckerError)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Either e (Int, Maybe ResourceCheckerError)
-> (e -> m (Int, Maybe ResourceCheckerError))
-> m (Int, Maybe ResourceCheckerError)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft (\e
_ -> m Int
forall (m :: * -> *). MonadIO m => m Int
getPhysicalCpuResource m Int
-> (Int -> (Int, Maybe ResourceCheckerError))
-> m (Int, Maybe ResourceCheckerError)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,ResourceCheckerError -> Maybe ResourceCheckerError
forall a. a -> Maybe a
Just ResourceCheckerError
CpuInconclusive))

-- catch memory allocation error with default physical memory resource
catchMemoryAllocation ::
  (MonadIO m) =>
  ExceptT ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError) ->
  m (Maybe Int64, Maybe ResourceCheckerError)
catchMemoryAllocation :: forall (m :: * -> *).
MonadIO m =>
ExceptT
  ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
-> m (Maybe Int64, Maybe ResourceCheckerError)
catchMemoryAllocation ExceptT
  ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
m =
  ExceptT
  ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
-> m (Either
        ResourceCheckerError (Maybe Int64, Maybe ResourceCheckerError))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT
  ResourceCheckerError m (Maybe Int64, Maybe ResourceCheckerError)
m
    m (Either
     ResourceCheckerError (Maybe Int64, Maybe ResourceCheckerError))
-> (Either
      ResourceCheckerError (Maybe Int64, Maybe ResourceCheckerError)
    -> m (Maybe Int64, Maybe ResourceCheckerError))
-> m (Maybe Int64, Maybe ResourceCheckerError)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either
   ResourceCheckerError (Maybe Int64, Maybe ResourceCheckerError)
 -> (ResourceCheckerError
     -> m (Maybe Int64, Maybe ResourceCheckerError))
 -> m (Maybe Int64, Maybe ResourceCheckerError))
-> (ResourceCheckerError
    -> m (Maybe Int64, Maybe ResourceCheckerError))
-> Either
     ResourceCheckerError (Maybe Int64, Maybe ResourceCheckerError)
-> m (Maybe Int64, Maybe ResourceCheckerError)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Either
  ResourceCheckerError (Maybe Int64, Maybe ResourceCheckerError)
-> (ResourceCheckerError
    -> m (Maybe Int64, Maybe ResourceCheckerError))
-> m (Maybe Int64, Maybe ResourceCheckerError)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft (\ResourceCheckerError
e -> m (Maybe Int64)
forall (m :: * -> *). MonadIO m => m (Maybe Int64)
getMaxPhysicalMemory m (Maybe Int64)
-> (Maybe Int64 -> (Maybe Int64, Maybe ResourceCheckerError))
-> m (Maybe Int64, Maybe ResourceCheckerError)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,ResourceCheckerError -> Maybe ResourceCheckerError
forall a. a -> Maybe a
Just ResourceCheckerError
e))

mergeCpuMemoryErrors :: Maybe ResourceCheckerError -> Maybe ResourceCheckerError -> Maybe ResourceCheckerError
mergeCpuMemoryErrors :: Maybe ResourceCheckerError
-> Maybe ResourceCheckerError -> Maybe ResourceCheckerError
mergeCpuMemoryErrors Maybe ResourceCheckerError
cpuErr Maybe ResourceCheckerError
memErr = case (Maybe ResourceCheckerError
cpuErr, Maybe ResourceCheckerError
memErr) of
  (Maybe ResourceCheckerError
Nothing, Maybe ResourceCheckerError
Nothing) -> Maybe ResourceCheckerError
forall a. Maybe a
Nothing
  (Just ResourceCheckerError
e1, Maybe ResourceCheckerError
Nothing) -> ResourceCheckerError -> Maybe ResourceCheckerError
forall a. a -> Maybe a
Just ResourceCheckerError
e1
  (Maybe ResourceCheckerError
Nothing, Just ResourceCheckerError
e2) -> ResourceCheckerError -> Maybe ResourceCheckerError
forall a. a -> Maybe a
Just ResourceCheckerError
e2
  (Just ResourceCheckerError
CpuInconclusive, Just ResourceCheckerError
MemoryInconclusive) -> ResourceCheckerError -> Maybe ResourceCheckerError
forall a. a -> Maybe a
Just ResourceCheckerError
CpuMemoryInconclusive
  (Just ResourceCheckerError
e1, Just ResourceCheckerError
e2) -> ResourceCheckerError -> Maybe ResourceCheckerError
forall a. a -> Maybe a
Just (ResourceCheckerError -> Maybe ResourceCheckerError)
-> ResourceCheckerError -> Maybe ResourceCheckerError
forall a b. (a -> b) -> a -> b
$ String -> ResourceCheckerError
RCInternalError (ResourceCheckerError -> String
forall a. Show a => a -> String
show ResourceCheckerError
e1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"|" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ResourceCheckerError -> String
forall a. Show a => a -> String
show ResourceCheckerError
e2)

readFileT :: (MonadIO m, MonadError ResourceCheckerError m) => (String -> ResourceCheckerError) -> FilePath -> m T.Text
readFileT :: forall (m :: * -> *).
(MonadIO m, MonadError ResourceCheckerError m) =>
(String -> ResourceCheckerError) -> String -> m Text
readFileT String -> ResourceCheckerError
mapError String
path = do
  Either String Text
eContent <- IO (Either String Text) -> m (Either String Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String Text) -> m (Either String Text))
-> IO (Either String Text) -> m (Either String Text)
forall a b. (a -> b) -> a -> b
$ IO (Either String Text)
-> (IOError -> IO (Either String Text)) -> IO (Either String Text)
forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError (Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> IO Text -> IO (Either String Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
path) (Either String Text -> IO (Either String Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Text -> IO (Either String Text))
-> (IOError -> Either String Text)
-> IOError
-> IO (Either String Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text)
-> (IOError -> String) -> IOError -> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> String
forall a. Show a => a -> String
show)
  Either ResourceCheckerError Text -> m Text
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ResourceCheckerError Text -> m Text)
-> Either ResourceCheckerError Text -> m Text
forall a b. (a -> b) -> a -> b
$ (String -> ResourceCheckerError)
-> Either String Text -> Either ResourceCheckerError Text
forall e1 e2 a. (e1 -> e2) -> Either e1 a -> Either e2 a
mapLeft String -> ResourceCheckerError
mapError Either String Text
eContent

parseUint :: (Integral a) => T.Text -> Either ResourceCheckerError a
parseUint :: forall a. Integral a => Text -> Either ResourceCheckerError a
parseUint = (String -> ResourceCheckerError)
-> ((a, Text) -> a)
-> Either String (a, Text)
-> Either ResourceCheckerError a
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> ResourceCheckerError
RCInternalError (a, Text) -> a
forall a b. (a, b) -> a
fst (Either String (a, Text) -> Either ResourceCheckerError a)
-> (Text -> Either String (a, Text))
-> Text
-> Either ResourceCheckerError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (a, Text)
forall a. Integral a => Reader a
T.decimal

readFileUint ::
  (MonadIO m, MonadError ResourceCheckerError m, Integral a) =>
  (String -> ResourceCheckerError) ->
  FilePath ->
  m a
readFileUint :: forall (m :: * -> *) a.
(MonadIO m, MonadError ResourceCheckerError m, Integral a) =>
(String -> ResourceCheckerError) -> String -> m a
readFileUint String -> ResourceCheckerError
mapError String
p = (Either ResourceCheckerError a -> m a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ResourceCheckerError a -> m a)
-> (Text -> Either ResourceCheckerError a) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ResourceCheckerError a
forall a. Integral a => Text -> Either ResourceCheckerError a
parseUint) (Text -> m a) -> m Text -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> ResourceCheckerError) -> String -> m Text
forall (m :: * -> *).
(MonadIO m, MonadError ResourceCheckerError m) =>
(String -> ResourceCheckerError) -> String -> m Text
readFileT String -> ResourceCheckerError
mapError String
p