{-# LANGUAGE TemplateHaskell #-}

-- | Types and operations for the CPU CGroup controller.
module System.CGroup.CPU (
  -- * The CPU cgroup controller
  CPU,
  resolveCPUController,

  -- * Operations on the CPU controller
  CPUQuota (..),
  getCPUQuota,
) where

import Control.Monad ((<=<))
import Path
import System.CGroup.Controller (Controller (..), resolveCGroupController)

-- | The "cpu" cgroup controller
data CPU

-- | Resolve the CPU cgroup controller for the current process
--
-- Throws an Exception if the CPU controller is not able to be found, or when
-- running outside of a cgroup
resolveCPUController :: IO (Controller CPU)
resolveCPUController :: IO (Controller CPU)
resolveCPUController = Text -> IO (Controller CPU)
forall a. Text -> IO (Controller a)
resolveCGroupController Text
"cpu"

-- | A CPU quota is the amount of CPU time our process can use relative to the
-- scheduler period
--
-- For example:
--
-- @
-- | cpu.cfs_quota_us | cpu.cfs_period_us | description |
-- | ---------------- | ----------------- | ----------- |
-- |           100000 |            100000 | (1)         |
-- |           200000 |            100000 | (2)         |
-- |            50000 |            100000 | (3)         |
-- |               -1 |            100000 | (4)         |
-- @
--
-- (1): we can use up to a single CPU core
--
-- (2): we can use up to two CPU cores
--
-- (3): the scheduler will give us a single CPU core for up to 50% of the time
--
-- (4): we can use all available CPU resources (there is no quota)
data CPUQuota
  = NoQuota
  | -- | cpu.cfs_quota_us, cpu.cfs_period_us
    CPUQuota Int Int
  deriving (CPUQuota -> CPUQuota -> Bool
(CPUQuota -> CPUQuota -> Bool)
-> (CPUQuota -> CPUQuota -> Bool) -> Eq CPUQuota
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CPUQuota -> CPUQuota -> Bool
$c/= :: CPUQuota -> CPUQuota -> Bool
== :: CPUQuota -> CPUQuota -> Bool
$c== :: CPUQuota -> CPUQuota -> Bool
Eq, Eq CPUQuota
Eq CPUQuota
-> (CPUQuota -> CPUQuota -> Ordering)
-> (CPUQuota -> CPUQuota -> Bool)
-> (CPUQuota -> CPUQuota -> Bool)
-> (CPUQuota -> CPUQuota -> Bool)
-> (CPUQuota -> CPUQuota -> Bool)
-> (CPUQuota -> CPUQuota -> CPUQuota)
-> (CPUQuota -> CPUQuota -> CPUQuota)
-> Ord CPUQuota
CPUQuota -> CPUQuota -> Bool
CPUQuota -> CPUQuota -> Ordering
CPUQuota -> CPUQuota -> CPUQuota
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
min :: CPUQuota -> CPUQuota -> CPUQuota
$cmin :: CPUQuota -> CPUQuota -> CPUQuota
max :: CPUQuota -> CPUQuota -> CPUQuota
$cmax :: CPUQuota -> CPUQuota -> CPUQuota
>= :: CPUQuota -> CPUQuota -> Bool
$c>= :: CPUQuota -> CPUQuota -> Bool
> :: CPUQuota -> CPUQuota -> Bool
$c> :: CPUQuota -> CPUQuota -> Bool
<= :: CPUQuota -> CPUQuota -> Bool
$c<= :: CPUQuota -> CPUQuota -> Bool
< :: CPUQuota -> CPUQuota -> Bool
$c< :: CPUQuota -> CPUQuota -> Bool
compare :: CPUQuota -> CPUQuota -> Ordering
$ccompare :: CPUQuota -> CPUQuota -> Ordering
$cp1Ord :: Eq CPUQuota
Ord, Int -> CPUQuota -> ShowS
[CPUQuota] -> ShowS
CPUQuota -> String
(Int -> CPUQuota -> ShowS)
-> (CPUQuota -> String) -> ([CPUQuota] -> ShowS) -> Show CPUQuota
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CPUQuota] -> ShowS
$cshowList :: [CPUQuota] -> ShowS
show :: CPUQuota -> String
$cshow :: CPUQuota -> String
showsPrec :: Int -> CPUQuota -> ShowS
$cshowsPrec :: Int -> CPUQuota -> ShowS
Show)

-- | Read a CGroup configuration value from its file
readCGroupInt :: Path b File -> IO Int
readCGroupInt :: Path b File -> IO Int
readCGroupInt = String -> IO Int
forall a. Read a => String -> IO a
readIO (String -> IO Int)
-> (Path b File -> IO String) -> Path b File -> IO Int
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (String -> IO String
readFile (String -> IO String)
-> (Path b File -> String) -> Path b File -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b File -> String
forall b t. Path b t -> String
toFilePath)

-- | Get the CPU quota within the given cgroup CPU controller
getCPUQuota :: Controller CPU -> IO CPUQuota
getCPUQuota :: Controller CPU -> IO CPUQuota
getCPUQuota (Controller Path Abs Dir
root) = do
  Int
quota <- Path Abs File -> IO Int
forall b. Path b File -> IO Int
readCGroupInt (Path Abs Dir
root Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
cpuQuotaPath)
  case Int
quota of
    (-1) -> CPUQuota -> IO CPUQuota
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPUQuota
NoQuota
    Int
_ -> Int -> Int -> CPUQuota
CPUQuota Int
quota (Int -> CPUQuota) -> IO Int -> IO CPUQuota
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs File -> IO Int
forall b. Path b File -> IO Int
readCGroupInt (Path Abs Dir
root Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
cpuPeriodPath)

-- Path to the "cpu quota" file
--
-- When this file contains "-1", there is no quota set
cpuQuotaPath :: Path Rel File
cpuQuotaPath :: Path Rel File
cpuQuotaPath = $(mkRelFile "cpu.cfs_quota_us")

-- Path to the "cpu period" file
cpuPeriodPath :: Path Rel File
cpuPeriodPath :: Path Rel File
cpuPeriodPath = $(mkRelFile "cpu.cfs_period_us")