{-# OPTIONS_HADDOCK prune #-}

-- |
-- Module: Censor.Runner.Env
-- Copyright: (c) 2026 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Host-environment capture.
--
-- An t'Env' is a point-in-time snapshot of the machine a censor run
-- executed on: platform identity (OS, architecture, kernel release,
-- CPU model, core count), the timing-relevant tuning knobs visible
-- under Linux sysfs (cpufreq governor, turbo\/boost state, SMT
-- control, @perf_event_paranoid@), the load average, and a UTC
-- timestamp.
--
-- Capture is best-effort: fields whose sources are absent on the
-- host (e.g. the sysfs knobs on Darwin) are 'Nothing'. Conditions
-- affect the /power/ of a run, not its validity — the paired,
-- order-randomised design cancels common-mode drift — so the
-- snapshot exists to make reports interpretable and provenanced,
-- not to gate execution.

module Censor.Runner.Env (
    -- * Environment snapshot
    Env(..)
  , captureEnv
  ) where

import Control.Exception (try, IOException)
import qualified Data.ByteString.Char8 as B8
import Data.Char (isSpace)
import Data.List (dropWhileEnd, isPrefixOf)
import Foreign.C.String (peekCString)
import Foreign.C.Types (CChar, CDouble, CInt(..), CSize(..))
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Array (allocaArray, peekArray)
import Foreign.Ptr (Ptr)
import GHC.Conc (getNumProcessors)
import qualified System.Info as Info

foreign import ccall unsafe "censor_env_loadavg"
  c_env_loadavg :: Ptr CDouble -> IO CInt

foreign import ccall unsafe "censor_env_kernel"
  c_env_kernel :: Ptr CChar -> CSize -> IO CInt

foreign import ccall unsafe "censor_env_time"
  c_env_time :: Ptr CChar -> CSize -> IO CInt

foreign import ccall unsafe "censor_env_cpu"
  c_env_cpu :: Ptr CChar -> CSize -> IO CInt

foreign import ccall unsafe "censor_env_cores"
  c_env_cores :: IO CInt

-- | A host-environment snapshot, taken once at run start.
--
--   The Linux knob fields ('envGovernor', 'envBoost', 'envSmt',
--   'envParanoid') hold the raw sysfs\/procfs file contents; they
--   are 'Nothing' wherever the file does not exist (in particular,
--   everywhere but Linux).
data Env = Env
  { Env -> String
envOs       :: !String
    -- ^ operating system, per @System.Info.os@.
  , Env -> String
envArch     :: !String
    -- ^ architecture, per @System.Info.arch@.
  , Env -> Maybe String
envKernel   :: !(Maybe String)
    -- ^ kernel release, per @uname(2)@.
  , Env -> Maybe String
envCpu      :: !(Maybe String)
    -- ^ CPU model string (Darwin @sysctl@, or the first @model name@
    --   row of Linux @\/proc\/cpuinfo@; absent on most aarch64 Linux
    --   kernels).
  , Env -> Int
envCores    :: !Int
    -- ^ logical core count.
  , Env -> Maybe String
envGovernor :: !(Maybe String)
    -- ^ Linux cpufreq scaling governor of cpu0.
  , Env -> Maybe String
envBoost    :: !(Maybe String)
    -- ^ Linux turbo\/boost state, recorded verbatim as @key=value@
    --   (@boost=1@ is boost-enabled; @no_turbo=1@ is boost-disabled)
    --   to avoid interpreting the two opposing conventions.
  , Env -> Maybe String
envSmt      :: !(Maybe String)
    -- ^ Linux SMT control state (@on@ \/ @off@ \/ ...).
  , Env -> Maybe String
envParanoid :: !(Maybe String)
    -- ^ Linux @kernel.perf_event_paranoid@ level.
  , Env -> Maybe (Double, Double, Double)
envLoad     :: !(Maybe (Double, Double, Double))
    -- ^ 1\/5\/15-minute load averages at capture time.
  , Env -> Maybe String
envTime     :: !(Maybe String)
    -- ^ capture time, UTC ISO-8601.
  } deriving (Env -> Env -> Bool
(Env -> Env -> Bool) -> (Env -> Env -> Bool) -> Eq Env
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Env -> Env -> Bool
== :: Env -> Env -> Bool
$c/= :: Env -> Env -> Bool
/= :: Env -> Env -> Bool
Eq, Int -> Env -> ShowS
[Env] -> ShowS
Env -> String
(Int -> Env -> ShowS)
-> (Env -> String) -> ([Env] -> ShowS) -> Show Env
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Env -> ShowS
showsPrec :: Int -> Env -> ShowS
$cshow :: Env -> String
show :: Env -> String
$cshowList :: [Env] -> ShowS
showList :: [Env] -> ShowS
Show)

-- | Snapshot the host environment. Cheap (a few syscalls and file
--   reads); call once at run start.
captureEnv :: IO Env
captureEnv :: IO Env
captureEnv = do
  cores <- IO Int
captureCores
  kern  <- cString 256 c_env_kernel
  cpu   <- captureCpu
  gov   <- readKnob
    "/sys/devices/system/cpu/cpu0/cpufreq/scaling_governor"
  boost <- captureBoost
  smt   <- readKnob "/sys/devices/system/cpu/smt/control"
  para  <- readKnob "/proc/sys/kernel/perf_event_paranoid"
  load  <- captureLoad
  time  <- cString 64 c_env_time
  pure Env
    { envOs       = Info.os
    , envArch     = Info.arch
    , envKernel   = kern
    , envCpu      = cpu
    , envCores    = cores
    , envGovernor = gov
    , envBoost    = boost
    , envSmt      = smt
    , envParanoid = para
    , envLoad     = load
    , envTime     = time
    }

-- run a C fill-buffer shim, returning the trimmed NUL-terminated
-- contents on success and Nothing on failure.
cString :: Int -> (Ptr CChar -> CSize -> IO CInt) -> IO (Maybe String)
cString :: Int -> (Ptr CChar -> CSize -> IO CInt) -> IO (Maybe String)
cString Int
n Ptr CChar -> CSize -> IO CInt
fill = Int -> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
n ((Ptr CChar -> IO (Maybe String)) -> IO (Maybe String))
-> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> do
  rc <- Ptr CChar -> CSize -> IO CInt
fill Ptr CChar
buf (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
  if rc == 0
    then fmap nonEmpty (peekCString buf)
    else pure Nothing

-- sysconf via the shim, because GHC's getNumProcessors reports 1 on
-- the non-threaded RTS; that stays as the fallback.
captureCores :: IO Int
captureCores :: IO Int
captureCores = do
  rc <- IO CInt
c_env_cores
  if rc >= 1
    then pure (fromIntegral rc)
    else getNumProcessors

captureLoad :: IO (Maybe (Double, Double, Double))
captureLoad :: IO (Maybe (Double, Double, Double))
captureLoad = Int
-> (Ptr CDouble -> IO (Maybe (Double, Double, Double)))
-> IO (Maybe (Double, Double, Double))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
3 ((Ptr CDouble -> IO (Maybe (Double, Double, Double)))
 -> IO (Maybe (Double, Double, Double)))
-> (Ptr CDouble -> IO (Maybe (Double, Double, Double)))
-> IO (Maybe (Double, Double, Double))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
p -> do
  rc <- Ptr CDouble -> IO CInt
c_env_loadavg Ptr CDouble
p
  if rc == 3
    then do
      vals <- peekArray 3 p
      case map realToFrac vals of
        [Double
l1, Double
l5, Double
l15] -> Maybe (Double, Double, Double)
-> IO (Maybe (Double, Double, Double))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Double, Double, Double) -> Maybe (Double, Double, Double)
forall a. a -> Maybe a
Just (Double
l1, Double
l5, Double
l15))
        [Double]
_             -> Maybe (Double, Double, Double)
-> IO (Maybe (Double, Double, Double))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Double, Double, Double)
forall a. Maybe a
Nothing
    else pure Nothing

captureCpu :: IO (Maybe String)
captureCpu :: IO (Maybe String)
captureCpu = do
  s <- Int -> (Ptr CChar -> CSize -> IO CInt) -> IO (Maybe String)
cString Int
256 Ptr CChar -> CSize -> IO CInt
c_env_cpu
  case s of
    Just String
_  -> Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
s
    Maybe String
Nothing -> IO (Maybe String)
cpuFromProcinfo

-- first "model name" row of /proc/cpuinfo (x86 Linux; most aarch64
-- kernels have no such row and the field stays Nothing).
cpuFromProcinfo :: IO (Maybe String)
cpuFromProcinfo :: IO (Maybe String)
cpuFromProcinfo = do
  mc <- String -> IO (Maybe String)
readKnob String
"/proc/cpuinfo"
  pure $ case mc of
    Maybe String
Nothing -> Maybe String
forall a. Maybe a
Nothing
    Just String
s  ->
      case (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"model name" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) (String -> [String]
lines String
s) of
        (String
l : [String]
_) -> String -> Maybe String
nonEmpty (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') String
l))
        []      -> Maybe String
forall a. Maybe a
Nothing

captureBoost :: IO (Maybe String)
captureBoost :: IO (Maybe String)
captureBoost = do
  b <- String -> IO (Maybe String)
readKnob String
"/sys/devices/system/cpu/cpufreq/boost"
  case b of
    Just String
v  -> Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe String
forall a. a -> Maybe a
Just (String
"boost=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
v))
    Maybe String
Nothing -> do
      t <- String -> IO (Maybe String)
readKnob String
"/sys/devices/system/cpu/intel_pstate/no_turbo"
      pure (fmap ("no_turbo=" ++) t)

-- read a small sysfs/procfs file, trimmed; Nothing when absent,
-- unreadable, or empty. Strict read so no handle outlives the call.
readKnob :: FilePath -> IO (Maybe String)
readKnob :: String -> IO (Maybe String)
readKnob String
p = do
  er <- IO ByteString -> IO (Either IOException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO ByteString
B8.readFile String
p) :: IO (Either IOException B8.ByteString)
  pure $ case er of
    Left IOException
_  -> Maybe String
forall a. Maybe a
Nothing
    Right ByteString
b -> String -> Maybe String
nonEmpty (ByteString -> String
B8.unpack ByteString
b)

nonEmpty :: String -> Maybe String
nonEmpty :: String -> Maybe String
nonEmpty String
s =
  let t :: String
t = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
s)
  in  if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
t then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
t