{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}

module Hermod.Tracing.Resources.Linux
    (
      readResourceStatsInternal
    ) where

import           Hermod.Tracing.Resources.Types
import           Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.IO as T (readFile)
import qualified Data.Text.Read as T (decimal)
import           Data.Word
import qualified GHC.Stats as GhcStats
import           System.Posix.Files (fileMode, getFileStatus, intersectFileModes, ownerReadMode)

-- * Disk IO stats:
-- /proc/[pid]/io (since kernel 2.6.20)
--        This file contains I/O statistics for the process, for example:
--
--               # cat /proc/3828/io
--               rchar: 323934931
--               wchar: 323929600
--               syscr: 632687
--               syscw: 632675
--               read_bytes: 0
--               write_bytes: 323932160
--               cancelled_write_bytes: 0
--
--        The fields are as follows:
--
--        rchar: characters read
--               The number of bytes which this task has caused to be read from storage.  This is simply the  sum
--               of bytes which this process passed to read(2) and similar system calls.  It includes things such
--               as terminal I/O and is unaffected by whether or not actual physical disk I/O was  required  (the
--               read might have been satisfied from pagecache).
--
--        wchar: characters written
--               The  number  of bytes which this task has caused, or shall cause to be written to disk.  Similar
--               caveats apply here as with rchar.
--
--        syscr: read syscalls
--               Attempt to count the number of read I/O operations-that is, system calls  such  as  read(2)  and
--               pread(2).
--
--        syscw: write syscalls
--               Attempt  to  count the number of write I/O operations-that is, system calls such as write(2) and
--               pwrite(2).
--
--        read_bytes: bytes read
--               Attempt to count the number of bytes which this process really did cause to be fetched from  the
--               storage layer.  This is accurate for block-backed filesystems.
--
--        write_bytes: bytes written
--               Attempt to count the number of bytes which this process caused to be sent to the storage layer.
--
--        cancelled_write_bytes:
--               The  big  inaccuracy  here  is truncate.  If a process writes 1MB to a file and then deletes the
--               file, it will in fact perform no writeout.  But it will have been accounted as having caused 1MB
--               of  write.   In other words: this field represents the number of bytes which this process caused
--               to not happen, by truncating pagecache.  A task can cause "negative"  I/O  too.   If  this  task
--               truncates  some  dirty  pagecache,  some  I/O  which another task has been accounted for (in its
--               write\_bytes) will not be happening.
--
--        Note: In the current implementation, things are a bit racy  on  32-bit  systems:  if  process  A  reads
--        process  B's  /proc/[pid]/io  while process B is updating one of these 64-bit counters, process A could
--        see an intermediate result.
--
--        Permission to access this file is governed by a ptrace access mode PTRACE\_MODE\_READ\_FSCREDS check;  see
--        ptrace(2).
--
readProcBlockInOut :: IO (Word64, Word64)
readProcBlockInOut :: IO (Word64, Word64)
readProcBlockInOut = do
    [Integer]
fields <- FilePath -> IO [Integer]
readProcList FilePath
"/proc/self/io"
    case -- We're only interested in 'read_bytes' & 'write_bytes':
      (Integer -> Word64) -> [Integer] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Word64
forall a. Num a => Integer -> a
fromInteger ([Integer] -> [Word64])
-> ([Integer] -> [Integer]) -> [Integer] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take Int
3 ([Integer] -> [Integer])
-> ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
drop Int
9 ([Integer] -> [Word64]) -> [Integer] -> [Word64]
forall a b. (a -> b) -> a -> b
$ [Integer]
fields of
      [Word64
fsRd, Word64
_, Word64
fsWr] -> (Word64, Word64) -> IO (Word64, Word64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64
fsRd, Word64
fsWr)
      [Word64]
_ -> (Word64, Word64) -> IO (Word64, Word64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64
0, Word64
0)

-- * Network stats:
--   grep IpExt /proc/<pid>/net/netstat
--   IpExt: InNoRoutes InTruncatedPkts InMcastPkts OutMcastPkts InBcastPkts OutBcastPkts InOctets OutOctets InMcastOctets OutMcastOctets InBcastOctets OutBcastOctets InCsumErrors InNoECTPkts InECT1Pkts InECT0Pkts InCEPkts
--   IpExt: 0 0 20053 8977 2437 23 3163525943 196480057 2426648 1491754 394285 5523 0 3513269 0 217426 0
--
readProcNetInOut :: IO (Word64, Word64)
#ifdef WITH_NETSTAT
readProcNetInOut = do
  fields <- T.words . fourthLine . T.lines <$> T.readFile "/proc/self/net/netstat"
  case -- We're only interested in 'InOctets' & 'OutOctets':
    fmap readMaybeText . take 2 . drop 7 $ fields of
      [Just netIn, Just netOut] -> pure (netIn, netOut)
      _ -> pure (0, 0)
  where
    -- Assumption: 'IpExt:' values are on the fourth line of how the kernel displays the buffer
    fourthLine ls = case drop 3 ls of
      l:_ -> l
      _   -> T.empty
#else
readProcNetInOut :: IO (Word64, Word64)
readProcNetInOut = (Word64, Word64) -> IO (Word64, Word64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64
0, Word64
0)
#endif

-- | TODO we have to expand the |readMemStats| function
-- to read full data from |proc|
readResourceStatsInternal :: IO (Maybe ResourceStats)
readResourceStatsInternal :: IO (Maybe ResourceStats)
readResourceStatsInternal = do
  RTSStats
rts <- IO RTSStats
GhcStats.getRTSStats
  (Word64, Word64)
net <- IO (Word64, Word64)
readProcNetInOut
  (Word64, Word64)
fs  <- IO (Word64, Word64)
readProcBlockInOut
  RTSStats
-> (Word64, Word64)
-> (Word64, Word64)
-> [Word64]
-> Maybe ResourceStats
mkProcStats RTSStats
rts (Word64, Word64)
net (Word64, Word64)
fs ([Word64] -> Maybe ResourceStats)
-> ([Integer] -> [Word64]) -> [Integer] -> Maybe ResourceStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word64) -> [Integer] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> Maybe ResourceStats)
-> IO [Integer] -> IO (Maybe ResourceStats)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [Integer]
readProcList FilePath
"/proc/self/stat"
 where
   mkProcStats :: GhcStats.RTSStats -> (Word64, Word64) -> (Word64, Word64) -> [Word64] -> Maybe ResourceStats
   mkProcStats :: RTSStats
-> (Word64, Word64)
-> (Word64, Word64)
-> [Word64]
-> Maybe ResourceStats
mkProcStats RTSStats
rts
               (Word64
rNetRd, Word64
rNetWr)
               (Word64
rFsRd,  Word64
rFsWr)
               (Word64
_:Word64
_:Word64
_:Word64
_:Word64
_:Word64
_:Word64
_:Word64
_:Word64
_:Word64
_             -- 00-09
               :Word64
_:Word64
_:Word64
_:Word64
user:Word64
sys:Word64
_:Word64
_:Word64
_:Word64
_:Word64
rThreads -- 10-19
               :Word64
_:Word64
_:Word64
_:Word64
rss:Word64
_:Word64
_:Word64
_:Word64
_:Word64
_:Word64
_           -- 20-29
               :Word64
_:Word64
_:Word64
_:Word64
_:Word64
_:Word64
_:Word64
_:Word64
_:Word64
_:Word64
_             -- 30-39
               :Word64
_:Word64
rCentiBlkIO:[Word64]
_rest) =          -- 40-42
     ResourceStats -> Maybe ResourceStats
forall a. a -> Maybe a
Just (ResourceStats -> Maybe ResourceStats)
-> ResourceStats -> Maybe ResourceStats
forall a b. (a -> b) -> a -> b
$ Resources
       { rCentiCpu :: Word64
rCentiCpu   = Word64
user Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
sys
       , rCentiGC :: Word64
rCentiGC    = RtsTime -> Word64
nsToCenti (RtsTime -> Word64) -> RtsTime -> Word64
forall a b. (a -> b) -> a -> b
$ RTSStats -> RtsTime
GhcStats.gc_cpu_ns RTSStats
rts
       , rCentiMut :: Word64
rCentiMut   = RtsTime -> Word64
nsToCenti (RtsTime -> Word64) -> RtsTime -> Word64
forall a b. (a -> b) -> a -> b
$ RTSStats -> RtsTime
GhcStats.mutator_cpu_ns RTSStats
rts
       , rGcsMajor :: Word64
rGcsMajor   = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Word32 -> Word64
forall a b. (a -> b) -> a -> b
$ RTSStats -> Word32
GhcStats.major_gcs RTSStats
rts
       , rGcsMinor :: Word64
rGcsMinor   = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Word32 -> Word64
forall a b. (a -> b) -> a -> b
$ RTSStats -> Word32
GhcStats.gcs RTSStats
rts Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- RTSStats -> Word32
GhcStats.major_gcs RTSStats
rts
       , rAlloc :: Word64
rAlloc      = RTSStats -> Word64
GhcStats.allocated_bytes RTSStats
rts
       , rLive :: Word64
rLive       = GCDetails -> Word64
GhcStats.gcdetails_live_bytes (GCDetails -> Word64) -> GCDetails -> Word64
forall a b. (a -> b) -> a -> b
$ RTSStats -> GCDetails
GhcStats.gc RTSStats
rts
       , rHeap :: Word64
rHeap       = GCDetails -> Word64
GhcStats.gcdetails_mem_in_use_bytes (GCDetails -> Word64) -> GCDetails -> Word64
forall a b. (a -> b) -> a -> b
$ RTSStats -> GCDetails
GhcStats.gc RTSStats
rts
       , rRSS :: Word64
rRSS        = Word64
rss Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
4096 -- TODO:  this is really PAGE_SIZE.
       , Word64
rNetRd :: Word64
rNetWr :: Word64
rFsRd :: Word64
rFsWr :: Word64
rThreads :: Word64
rCentiBlkIO :: Word64
rCentiBlkIO :: Word64
rNetRd :: Word64
rNetWr :: Word64
rFsRd :: Word64
rFsWr :: Word64
rThreads :: Word64
..
       }
   mkProcStats RTSStats
_ (Word64, Word64)
_ (Word64, Word64)
_ [Word64]
_ = Maybe ResourceStats
forall a. Maybe a
Nothing
   nsToCenti :: GhcStats.RtsTime -> Word64
   nsToCenti :: RtsTime -> Word64
nsToCenti = Double -> Word64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Word64) -> (RtsTime -> Double) -> RtsTime -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
10000000 :: Double)) (Double -> Double) -> (RtsTime -> Double) -> RtsTime -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

readProcList :: FilePath -> IO [Integer]
readProcList :: FilePath -> IO [Integer]
readProcList FilePath
fp = do
    FileStatus
fs <- FilePath -> IO FileStatus
getFileStatus FilePath
fp
    if FileStatus -> Bool
readable FileStatus
fs
    then do
        Text
cs <- FilePath -> IO Text
T.readFile FilePath
fp
        [Integer] -> IO [Integer]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Integer] -> IO [Integer]) -> [Integer] -> IO [Integer]
forall a b. (a -> b) -> a -> b
$ (Text -> Integer) -> [Text] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 (Maybe Integer -> Integer)
-> (Text -> Maybe Integer) -> Text -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Integer
forall a. Integral a => Text -> Maybe a
readMaybeText) (Text -> [Text]
T.words Text
cs)
    else
        [Integer] -> IO [Integer]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  where
    readable :: FileStatus -> Bool
readable FileStatus
fs = FileMode -> FileMode -> FileMode
intersectFileModes (FileStatus -> FileMode
fileMode FileStatus
fs) FileMode
ownerReadMode FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
== FileMode
ownerReadMode

readMaybeText :: Integral a => T.Text -> Maybe a
readMaybeText :: forall a. Integral a => Text -> Maybe a
readMaybeText Text
t =
  case Reader a
forall a. Integral a => Reader a
T.decimal Text
t of
    Right (a
v, Text
_)  -> a -> Maybe a
forall a. a -> Maybe a
Just a
v
    Either FilePath (a, Text)
_             -> Maybe a
forall a. Maybe a
Nothing