{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}

-- |
-- Module: Censor.Meter
-- Copyright: (c) 2026 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Measurement abstraction.
--
-- A t'Meter' wraps an @IO@ action and returns a 'Word64' reading.
-- 'wallClock' is available everywhere. On Linux, 'withCounter'
-- provides performance-counter meters via @perf_event_open@: the
-- retired-instruction and retired-branch counts are deterministic
-- properties of the executed code, immune to the frequency, cache,
-- and scheduling noise that limits the wall clock on fast targets,
-- while the other counters help attribute a difference to a channel
-- (see t'Counter'). 'withSplitMeter' reads the cycle counter and the
-- wall clock over the same execution, splitting wall time into the
-- cycles the code took and the clock period they ran at.

module Censor.Meter (
    -- * Meter type
    Meter(..)

    -- * Implementations
  , wallClock

    -- * Hardware performance-counter meters (Linux)
  , Counter(..)
  , MeterError(..)
  , withCounter

    -- * Wall time split into cycles and period (Linux)
  , SplitMeter(..)
  , withSplitMeter
  ) where

import Control.Exception (Exception, throwIO)
import Data.Word (Word64)
#if !defined(darwin_HOST_OS)
import GHC.Clock (getMonotonicTimeNSec)
#endif
#if defined(linux_HOST_OS)
import Control.Concurrent (runInBoundThread, rtsSupportsBoundThreads)
import Control.Exception (finally)
import Foreign.C.Types (CInt(..))
#endif

-- | A measurement device. @'measure' m k act@ runs @act@ @k@ times
--   back to back and returns one reading for the batch: nanoseconds
--   for 'wallClock', counted events for a 'withCounter' meter. Each
--   meter owns its inner loop, reading the clock or arming the
--   counter once per batch.
newtype Meter = Meter
  { Meter -> Int -> IO () -> IO Word64
measure :: Int -> IO () -> IO Word64
  }

-- | A meter reading two quantities over one execution of the batch:
--   @'measureSplit' m k act@ returns @(cycles, nanoseconds)@. Wall
--   time is cycles times the clock period, and a secret can move it
--   through either factor: through cycles when the code's execution
--   depends on it, through the period when the core's frequency
--   does (data-dependent power under frequency scaling). Reading
--   both on the same execution tells the two apart.
newtype SplitMeter = SplitMeter
  { SplitMeter -> Int -> IO () -> IO (Word64, Word64)
measureSplit :: Int -> IO () -> IO (Word64, Word64)
  }

-- | Wall-clock meter: elapsed nanoseconds over the batch.
--
--   On Darwin, backed by @clock_gettime_nsec_np(CLOCK_UPTIME_RAW)@,
--   which resolves the hardware tick (~42 ns on Apple Silicon, so
--   sub-microsecond targets need batching; see 'Censor.cfgBatch').
--   Not @GHC.Clock.getMonotonicTimeNSec@, which macOS quantises to
--   microseconds, putting CDF cut points on quantisation boundaries
--   (see @issues\/handled\/ISSUE2.md@). Elsewhere, backed by
--   @GHC.Clock.getMonotonicTimeNSec@.
wallClock :: Meter
wallClock :: Meter
wallClock = (Int -> IO () -> IO Word64) -> Meter
Meter Int -> IO () -> IO Word64
measureWall

#if defined(darwin_HOST_OS)
foreign import ccall unsafe "censor_monotonic_ns"
  monotonicNS :: IO Word64
#else
monotonicNS :: IO Word64
monotonicNS :: IO Word64
monotonicNS = IO Word64
getMonotonicTimeNSec
{-# INLINE monotonicNS #-}
#endif

measureWall :: Int -> IO () -> IO Word64
measureWall :: Int -> IO () -> IO Word64
measureWall !Int
k !IO ()
act = do
  !t0 <- IO Word64
monotonicNS
  rep k act
  !t1 <- monotonicNS
  pure $! t1 - t0
{-# INLINE measureWall #-}

-- shared inner loop. INLINE so it specialises at each meter call site
-- and the recursion compiles to a join-point with no per-iteration
-- closure allocation.
rep :: Int -> IO () -> IO ()
rep :: Int -> IO () -> IO ()
rep !Int
k !IO ()
act = Int -> IO ()
forall {t}. (Eq t, Num t) => t -> IO ()
go Int
k
  where
    go :: t -> IO ()
go t
0 = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    go t
i = IO ()
act IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> IO ()
go (t
i t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
{-# INLINE rep #-}

-- | A hardware (or, for 'TaskClock', software) event to count.
--
--   With 'wallClock' the counters form a ladder in which each
--   adjacent gap isolates one cause of a class difference:
--   instructions (code path) -> cycles (microarchitectural latency)
--   -> ref-cycles (frequency) -> task-clock (kernel and interrupt
--   time) -> wall (scheduling gaps).
data Counter =
    InstructionsRetired  -- ^ @PERF_COUNT_HW_INSTRUCTIONS@; deterministic.
  | BranchesRetired      -- ^ @PERF_COUNT_HW_BRANCH_INSTRUCTIONS@;
                         --   deterministic.
  | Cycles               -- ^ @PERF_COUNT_HW_CPU_CYCLES@; also sensitive
                         --   to data-dependent latency.
  | RefCycles            -- ^ @PERF_COUNT_HW_REF_CPU_CYCLES@: cycles at
                         --   the constant reference rate, so a
                         --   difference here with clean 'Cycles' is a
                         --   frequency effect. Not available on every
                         --   microarchitecture.
  | TaskClock            -- ^ @PERF_COUNT_SW_TASK_CLOCK@: on-CPU
                         --   nanoseconds, including kernel time on the
                         --   task's behalf. A software counter, so
                         --   available in VMs, but counting kernel time
                         --   needs @kernel.perf_event_paranoid@ at most
                         --   @1@.
  | BranchMisses         -- ^ @PERF_COUNT_HW_BRANCH_MISSES@: catches a
                         --   secret-dependent branch direction when
                         --   retired branch counts balance.
  | CacheMisses          -- ^ @PERF_COUNT_HW_CACHE_MISSES@: attributes a
                         --   cycles-level difference to memory access
                         --   patterns.
  deriving (Counter -> Counter -> Bool
(Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool) -> Eq Counter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Counter -> Counter -> Bool
== :: Counter -> Counter -> Bool
$c/= :: Counter -> Counter -> Bool
/= :: Counter -> Counter -> Bool
Eq, Int -> Counter -> ShowS
[Counter] -> ShowS
Counter -> String
(Int -> Counter -> ShowS)
-> (Counter -> String) -> ([Counter] -> ShowS) -> Show Counter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Counter -> ShowS
showsPrec :: Int -> Counter -> ShowS
$cshow :: Counter -> String
show :: Counter -> String
$cshowList :: [Counter] -> ShowS
showList :: [Counter] -> ShowS
Show)

-- | Why a 'withCounter' meter could not be opened.
data MeterError =
    Unsupported     -- ^ not a Linux build; no hardware-counter support
  | OpenFailed !Int -- ^ @perf_event_open@ failed with this @errno@
                    --   (commonly @EACCES@\/@EPERM@ when
                    --   @kernel.perf_event_paranoid@ is too high)
  deriving (MeterError -> MeterError -> Bool
(MeterError -> MeterError -> Bool)
-> (MeterError -> MeterError -> Bool) -> Eq MeterError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MeterError -> MeterError -> Bool
== :: MeterError -> MeterError -> Bool
$c/= :: MeterError -> MeterError -> Bool
/= :: MeterError -> MeterError -> Bool
Eq, Int -> MeterError -> ShowS
[MeterError] -> ShowS
MeterError -> String
(Int -> MeterError -> ShowS)
-> (MeterError -> String)
-> ([MeterError] -> ShowS)
-> Show MeterError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MeterError -> ShowS
showsPrec :: Int -> MeterError -> ShowS
$cshow :: MeterError -> String
show :: MeterError -> String
$cshowList :: [MeterError] -> ShowS
showList :: [MeterError] -> ShowS
Show)

instance Exception MeterError

#if defined(linux_HOST_OS)

foreign import ccall unsafe "censor_perf_open"
  c_perf_open :: CInt -> IO CInt
foreign import ccall unsafe "censor_perf_begin"
  c_perf_begin :: CInt -> IO ()
foreign import ccall unsafe "censor_perf_end"
  c_perf_end :: CInt -> IO Word64
foreign import ccall unsafe "censor_perf_close"
  c_perf_close :: CInt -> IO ()

counterCode :: Counter -> CInt
counterCode :: Counter -> CInt
counterCode Counter
InstructionsRetired = CInt
0
counterCode Counter
BranchesRetired     = CInt
1
counterCode Counter
Cycles              = CInt
2
counterCode Counter
RefCycles           = CInt
3
counterCode Counter
TaskClock           = CInt
4
counterCode Counter
BranchMisses        = CInt
5
counterCode Counter
CacheMisses         = CInt
6

-- | Acquire a performance-counter t'Meter' for the duration of the
--   callback, then release it. Throws 'MeterError' if the counter
--   cannot be opened.
--
--   Counters count user space only, which unprivileged processes may
--   open at @kernel.perf_event_paranoid@ @2@ or lower; 'TaskClock'
--   deliberately includes kernel time and needs @1@ or lower, failing
--   with @'OpenFailed' 13@ otherwise rather than silently degrading
--   to a user-only clock. A counter is bound to the thread that
--   opened it, so the callback runs on one OS thread.
withCounter :: Counter -> (Meter -> IO a) -> IO a
withCounter :: forall a. Counter -> (Meter -> IO a) -> IO a
withCounter Counter
counter Meter -> IO a
k = Counter -> (CInt -> IO a) -> IO a
forall a. Counter -> (CInt -> IO a) -> IO a
withPerf Counter
counter (Meter -> IO a
k (Meter -> IO a) -> (CInt -> Meter) -> CInt -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Meter
meterFor)

-- | Acquire a t'SplitMeter' for the duration of the callback, then
--   release it. Throws 'MeterError' if the cycle counter cannot be
--   opened.
--
--   The wall clock is read inside the counted region, so both
--   readings cover the batch and the clock reads; the overhead is
--   the same in both classes. As with 'withCounter', the callback
--   runs on one OS thread.
withSplitMeter :: (SplitMeter -> IO a) -> IO a
withSplitMeter :: forall a. (SplitMeter -> IO a) -> IO a
withSplitMeter SplitMeter -> IO a
k = Counter -> (CInt -> IO a) -> IO a
forall a. Counter -> (CInt -> IO a) -> IO a
withPerf Counter
Cycles (SplitMeter -> IO a
k (SplitMeter -> IO a) -> (CInt -> SplitMeter) -> CInt -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> SplitMeter
splitFor)

-- open a counter on one OS thread for the callback, closing it after.
withPerf :: Counter -> (CInt -> IO a) -> IO a
withPerf :: forall a. Counter -> (CInt -> IO a) -> IO a
withPerf Counter
counter CInt -> IO a
k = IO a -> IO a
forall {a}. IO a -> IO a
onOneThread (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
  fd <- CInt -> IO CInt
c_perf_open (Counter -> CInt
counterCode Counter
counter)
  if fd < 0
    then throwIO (OpenFailed (negate (fromIntegral fd)))
    else k fd `finally` c_perf_close fd
  where
    -- the perf fd is thread-affine; keep open + measures on one OS
    -- thread. runInBoundThread requires the threaded RTS, so fall back
    -- to running inline when there is only the single OS thread anyway.
    onOneThread :: IO a -> IO a
onOneThread
      | Bool
rtsSupportsBoundThreads = IO a -> IO a
forall {a}. IO a -> IO a
runInBoundThread
      | Bool
otherwise               = IO a -> IO a
forall a. a -> a
id

meterFor :: CInt -> Meter
meterFor :: CInt -> Meter
meterFor !CInt
fd = (Int -> IO () -> IO Word64) -> Meter
Meter ((Int -> IO () -> IO Word64) -> Meter)
-> (Int -> IO () -> IO Word64) -> Meter
forall a b. (a -> b) -> a -> b
$ \Int
k IO ()
act -> do
  CInt -> IO ()
c_perf_begin CInt
fd
  Int -> IO () -> IO ()
rep Int
k IO ()
act
  CInt -> IO Word64
c_perf_end CInt
fd
{-# INLINE meterFor #-}

splitFor :: CInt -> SplitMeter
splitFor :: CInt -> SplitMeter
splitFor !CInt
fd = (Int -> IO () -> IO (Word64, Word64)) -> SplitMeter
SplitMeter ((Int -> IO () -> IO (Word64, Word64)) -> SplitMeter)
-> (Int -> IO () -> IO (Word64, Word64)) -> SplitMeter
forall a b. (a -> b) -> a -> b
$ \Int
k IO ()
act -> do
  CInt -> IO ()
c_perf_begin CInt
fd
  !t0 <- IO Word64
monotonicNS
  rep k act
  !t1 <- monotonicNS
  !cy <- c_perf_end fd
  pure (cy, t1 - t0)
{-# INLINE splitFor #-}

#else

-- | Hardware performance-counter meters are only available on Linux;
--   on other platforms this always throws 'Unsupported'.
withCounter :: Counter -> (Meter -> IO a) -> IO a
withCounter _ _ = throwIO Unsupported

-- | The split meter needs the cycle counter, so it is only available
--   on Linux; on other platforms this always throws 'Unsupported'.
withSplitMeter :: (SplitMeter -> IO a) -> IO a
withSplitMeter _ = throwIO Unsupported

#endif