{-# LINE 1 "Z/IO/UV/FFI_Env.hsc" #-}
{-|
Module      : Z.IO.UV.FFI_Env
Description : libuv operations
Copyright   : (c) Winterland, 2020
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

INTERNAL MODULE, split from "Z.IO.UV.FFI" to make it buildable under constrained memory.

-}

module Z.IO.UV.FFI_Env where

import           Control.Monad
import           Data.Int
import           Data.Word
import           Data.Primitive.Types   (Prim)
import           Foreign.C.Types
import           Foreign.Ptr
import           Foreign.Storable
import           Z.Data.Array.Unaligned
import           Z.Data.Text.Print   (Print(..))
import           Z.Data.JSON         (JSON)
import           Z.Data.CBytes as CBytes
import           Z.Foreign
import           Z.IO.Exception (throwUVIfMinus_, bracket, HasCallStack)
import           GHC.Generics
import           Z.IO.UV.FFI



{-# LINE 34 "Z/IO/UV/FFI_Env.hsc" #-}


{-# LINE 36 "Z/IO/UV/FFI_Env.hsc" #-}

foreign import ccall unsafe uv_resident_set_memory :: MBA# CSize -> IO CInt
foreign import ccall unsafe uv_uptime :: MBA# Double -> IO CInt
foreign import ccall unsafe uv_getrusage :: MBA# a -> IO CInt

foreign import ccall unsafe uv_get_free_memory :: IO Word64
foreign import ccall unsafe uv_get_total_memory :: IO Word64
foreign import ccall unsafe uv_get_constrained_memory :: IO Word64

-- | Data type for storing times.
-- typedef struct { long tv_sec; long tv_usec; } uv_timeval_t;
data TimeVal = TimeVal
    { tv_sec  :: {-# UNPACK #-} !CLong
    , tv_usec :: {-# UNPACK #-} !CLong
    }   deriving (Show, Read, Eq, Ord, Generic)
        deriving anyclass (Print, JSON)

-- | Data type for resource usage results.
--
-- Members marked with (X) are unsupported on Windows.
-- See <https://man7.org/linux/man-pages/man2/getrusage.2.html getrusage(2)> for supported fields on Unix
data ResUsage = ResUsage
    { ru_utime    :: {-# UNPACK #-} !TimeVal   -- ^  user CPU time used, in microseconds
    , ru_stime    :: {-# UNPACK #-} !TimeVal   -- ^  system CPU time used, in microseconds
    , ru_maxrss   :: {-# UNPACK #-} !Word64    -- ^  maximum resident set size
    , ru_ixrss    :: {-# UNPACK #-} !Word64    -- ^  integral shared memory size (X)
    , ru_idrss    :: {-# UNPACK #-} !Word64    -- ^  integral unshared data size (X)
    , ru_isrss    :: {-# UNPACK #-} !Word64    -- ^  integral unshared stack size (X)
    , ru_minflt   :: {-# UNPACK #-} !Word64    -- ^  page reclaims (soft page faults) (X)
    , ru_majflt   :: {-# UNPACK #-} !Word64    -- ^  page faults (hard page faults)
    , ru_nswap    :: {-# UNPACK #-} !Word64    -- ^  swaps (X)
    , ru_inblock  :: {-# UNPACK #-} !Word64    -- ^  block input operations
    , ru_oublock  :: {-# UNPACK #-} !Word64    -- ^  block output operations
    , ru_msgsnd   :: {-# UNPACK #-} !Word64    -- ^  IPC messages sent (X)
    , ru_msgrcv   :: {-# UNPACK #-} !Word64    -- ^  IPC messages received (X)
    , ru_nsignals :: {-# UNPACK #-} !Word64    -- ^  signals received (X)
    , ru_nvcsw    :: {-# UNPACK #-} !Word64    -- ^  voluntary context switches (X)
    , ru_nivcsw   :: {-# UNPACK #-} !Word64    -- ^  involuntary context switches (X)
    }   deriving (Show, Read, Eq, Ord, Generic)
        deriving anyclass (Print, JSON)

sizeOfResUsage :: Int
sizeOfResUsage = (144)
{-# LINE 79 "Z/IO/UV/FFI_Env.hsc" #-}

peekResUsage :: MBA# a -> IO ResUsage
peekResUsage mba = do
    utime_sec :: CLong <- peekMBA mba ((0))
{-# LINE 83 "Z/IO/UV/FFI_Env.hsc" #-}
    utime_usec :: CLong <- peekMBA mba (((0)) + sizeOf (undefined :: CLong))
{-# LINE 84 "Z/IO/UV/FFI_Env.hsc" #-}
    stime_sec :: CLong <- peekMBA mba ((16))
{-# LINE 85 "Z/IO/UV/FFI_Env.hsc" #-}
    stime_usec :: CLong <- peekMBA mba (((16)) + sizeOf (undefined :: CLong))
{-# LINE 86 "Z/IO/UV/FFI_Env.hsc" #-}
    maxrss   <- peekMBA mba ((32))
{-# LINE 87 "Z/IO/UV/FFI_Env.hsc" #-}
    ixrss    <- peekMBA mba ((40))
{-# LINE 88 "Z/IO/UV/FFI_Env.hsc" #-}
    idrss    <- peekMBA mba ((48))
{-# LINE 89 "Z/IO/UV/FFI_Env.hsc" #-}
    isrss    <- peekMBA mba ((56))
{-# LINE 90 "Z/IO/UV/FFI_Env.hsc" #-}
    minflt   <- peekMBA mba ((64))
{-# LINE 91 "Z/IO/UV/FFI_Env.hsc" #-}
    majflt   <- peekMBA mba ((72))
{-# LINE 92 "Z/IO/UV/FFI_Env.hsc" #-}
    nswap    <- peekMBA mba ((80))
{-# LINE 93 "Z/IO/UV/FFI_Env.hsc" #-}
    inblock  <- peekMBA mba ((88))
{-# LINE 94 "Z/IO/UV/FFI_Env.hsc" #-}
    oublock  <- peekMBA mba ((96))
{-# LINE 95 "Z/IO/UV/FFI_Env.hsc" #-}
    msgsnd   <- peekMBA mba ((104))
{-# LINE 96 "Z/IO/UV/FFI_Env.hsc" #-}
    msgrcv   <- peekMBA mba ((112))
{-# LINE 97 "Z/IO/UV/FFI_Env.hsc" #-}
    nsignals <- peekMBA mba ((120))
{-# LINE 98 "Z/IO/UV/FFI_Env.hsc" #-}
    nvcsw    <- peekMBA mba ((128))
{-# LINE 99 "Z/IO/UV/FFI_Env.hsc" #-}
    nivcsw   <- peekMBA mba ((136))
{-# LINE 100 "Z/IO/UV/FFI_Env.hsc" #-}
    return (ResUsage (TimeVal utime_sec utime_usec) (TimeVal stime_sec stime_usec)
                    maxrss ixrss idrss isrss minflt majflt nswap inblock
                    oublock msgsnd msgrcv nsignals nvcsw nivcsw)

foreign import ccall unsafe uv_os_getpid :: IO PID
foreign import ccall unsafe uv_os_getppid :: IO PID
foreign import ccall unsafe uv_os_getpriority :: PID -> MBA# CInt -> IO CInt
foreign import ccall unsafe uv_os_setpriority :: PID -> CInt -> IO CInt

newtype PID = PID CInt
    deriving (Eq, Ord, Show, Read, Generic)
    deriving newtype (Storable, Prim, Unaligned, JSON)
    deriving anyclass Print

type Priority = CInt
pattern PRIORITY_LOW          :: Priority
pattern PRIORITY_BELOW_NORMAL :: Priority
pattern PRIORITY_NORMAL       :: Priority
pattern PRIORITY_ABOVE_NORMAL :: Priority
pattern PRIORITY_HIGH         :: Priority
pattern PRIORITY_HIGHEST      :: Priority
pattern PRIORITY_LOW           = 19
{-# LINE 122 "Z/IO/UV/FFI_Env.hsc" #-}
pattern PRIORITY_BELOW_NORMAL  = 10
{-# LINE 123 "Z/IO/UV/FFI_Env.hsc" #-}
pattern PRIORITY_NORMAL        = 0
{-# LINE 124 "Z/IO/UV/FFI_Env.hsc" #-}
pattern PRIORITY_ABOVE_NORMAL  = -7
{-# LINE 125 "Z/IO/UV/FFI_Env.hsc" #-}
pattern PRIORITY_HIGH          = -14
{-# LINE 126 "Z/IO/UV/FFI_Env.hsc" #-}
pattern PRIORITY_HIGHEST       = -20
{-# LINE 127 "Z/IO/UV/FFI_Env.hsc" #-}

foreign import ccall unsafe uv_hrtime :: IO Word64

foreign import ccall unsafe uv_os_environ :: MBA# (Ptr a) -> MBA# CInt -> IO CInt
foreign import ccall unsafe uv_os_free_environ :: Ptr a -> CInt -> IO ()
foreign import ccall unsafe uv_os_getenv :: BA# Word8 -> MBA# Word8 -> MBA# CSize -> IO CInt
foreign import ccall unsafe uv_os_setenv :: BA# Word8 -> BA# Word8 -> IO CInt
foreign import ccall unsafe uv_os_unsetenv :: BA# Word8 -> IO CInt

pattern UV_MAXHOSTNAMESIZE :: CSize
pattern UV_MAXHOSTNAMESIZE = 65
{-# LINE 138 "Z/IO/UV/FFI_Env.hsc" #-}
foreign import ccall unsafe uv_os_gethostname :: MBA# Word8 -> MBA# CSize -> IO CInt

-- | Data type for operating system name and version information.
data OSName = OSName
    { os_sysname :: CBytes
    , os_release :: CBytes
    , os_version :: CBytes
    , os_machine :: CBytes
    }   deriving (Eq, Ord, Show, Read, Generic)
        deriving anyclass (Print, JSON)

getOSName :: HasCallStack => IO OSName
getOSName = do
    (MutableByteArray mba#) <- newByteArray ((1024))
{-# LINE 152 "Z/IO/UV/FFI_Env.hsc" #-}
    throwUVIfMinus_ (uv_os_uname mba#)
    sn <- peekMBACBytes mba# ((0))
{-# LINE 154 "Z/IO/UV/FFI_Env.hsc" #-}
    re <- peekMBACBytes mba# ((256))
{-# LINE 155 "Z/IO/UV/FFI_Env.hsc" #-}
    ve <- peekMBACBytes mba# ((512))
{-# LINE 156 "Z/IO/UV/FFI_Env.hsc" #-}
    ma <- peekMBACBytes mba#  ((768))
{-# LINE 157 "Z/IO/UV/FFI_Env.hsc" #-}
    return (OSName sn re ve ma)

foreign import ccall unsafe uv_os_uname :: MBA# OSName -> IO CInt

foreign import ccall unsafe hs_uv_random :: MBA# Word8 -> CSize -> CInt -> IO CInt
foreign import ccall unsafe hs_uv_random_threaded :: Ptr Word8 -> CSize -> CInt -> Ptr UVLoop -> IO UVSlotUnsafe

-- | Data type for password file information.
data PassWD = PassWD
    { passwd_username :: CBytes
    , passwd_uid :: UID
    , passwd_gid :: GID
    , passwd_shell :: CBytes
    , passwd_homedir :: CBytes
    }   deriving (Eq, Ord, Show, Read, Generic)
        deriving anyclass (Print, JSON)

foreign import ccall unsafe uv_os_get_passwd :: MBA# PassWD -> IO CInt
foreign import ccall unsafe uv_os_free_passwd :: MBA# PassWD -> IO ()

-- | Gets a subset of the password file entry for the current effective uid (not the real uid).
--
-- The populated data includes the username, euid, gid, shell, and home directory.
-- On non-Windows systems, all data comes from getpwuid_r(3).
-- On Windows, uid and gid are set to -1 and have no meaning, and shell is empty.
getPassWD :: HasCallStack => IO PassWD
getPassWD =  bracket
    (do mpa@(MutableByteArray mba#) <- newByteArray ((40))
{-# LINE 185 "Z/IO/UV/FFI_Env.hsc" #-}
        throwUVIfMinus_ (uv_os_get_passwd mba#)
        return mpa)
    (\ (MutableByteArray mba#) -> uv_os_free_passwd mba#)
    (\ (MutableByteArray mba#) -> do
        username <- fromCString =<< peekMBA mba# ((0))
{-# LINE 190 "Z/IO/UV/FFI_Env.hsc" #-}
        uid <- fromIntegral <$> (peekMBA mba# ((8)) :: IO CLong)
{-# LINE 191 "Z/IO/UV/FFI_Env.hsc" #-}
        gid <- fromIntegral <$> (peekMBA mba# ((16)) :: IO CLong)
{-# LINE 192 "Z/IO/UV/FFI_Env.hsc" #-}
        shell <- fromCString =<< peekMBA mba# ((24))
{-# LINE 193 "Z/IO/UV/FFI_Env.hsc" #-}
        homedir <- fromCString =<< peekMBA mba# ((32))
{-# LINE 194 "Z/IO/UV/FFI_Env.hsc" #-}
        return (PassWD username uid gid shell homedir))

foreign import ccall unsafe uv_cwd :: MBA# Word8 -> MBA# CSize -> IO CInt
foreign import ccall unsafe uv_chdir :: BA# Word8 -> IO CInt
foreign import ccall unsafe uv_os_homedir :: MBA# Word8 -> MBA# CSize -> IO CInt
foreign import ccall unsafe uv_os_tmpdir :: MBA# Word8 -> MBA# CSize -> IO CInt

foreign import ccall unsafe uv_cpu_info      :: MBA# (Ptr CPUInfo) -> MBA# CInt -> IO CInt
foreign import ccall unsafe uv_free_cpu_info :: Ptr CPUInfo -> CInt -> IO ()

-- | Data type for CPU information.
data CPUInfo = CPUInfo
    { cpu_model :: CBytes
    , cpu_speed :: CInt
    , cpu_times_user :: Word64  -- ^ milliseconds
    , cpu_times_nice :: Word64  -- ^ milliseconds
    , cpu_times_sys  :: Word64  -- ^ milliseconds
    , cpu_times_idle :: Word64  -- ^ milliseconds
    , cpu_times_irq  :: Word64  -- ^ milliseconds
    }   deriving (Eq, Ord, Show, Read, Generic)
        deriving anyclass (Print, JSON)

-- | Gets information about the CPUs on the system.
getCPUInfo :: HasCallStack => IO [CPUInfo]
getCPUInfo = bracket
    (do (p, (len, _)) <-  allocPrimUnsafe $ \ pp ->
            allocPrimUnsafe $ \ plen ->
                throwUVIfMinus_ (uv_cpu_info pp plen)
        return (p, len))
    (\ (p, len) -> uv_free_cpu_info p len)
    (\ (p, len) -> forM [0..fromIntegral len-1] (peekCPUInfoOff p))

peekCPUInfoOff :: Ptr CPUInfo -> Int -> IO CPUInfo
peekCPUInfoOff p off = do
    let p' = p `plusPtr` (off * ((56)))
{-# LINE 229 "Z/IO/UV/FFI_Env.hsc" #-}
    model <- fromCString =<< ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 230 "Z/IO/UV/FFI_Env.hsc" #-}
    speed <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p'
{-# LINE 231 "Z/IO/UV/FFI_Env.hsc" #-}
    user <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p'
{-# LINE 232 "Z/IO/UV/FFI_Env.hsc" #-}
    nice <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p'
{-# LINE 233 "Z/IO/UV/FFI_Env.hsc" #-}
    sys <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p'
{-# LINE 234 "Z/IO/UV/FFI_Env.hsc" #-}
    idle <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) p'
{-# LINE 235 "Z/IO/UV/FFI_Env.hsc" #-}
    irq <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) p'
{-# LINE 236 "Z/IO/UV/FFI_Env.hsc" #-}
    return (CPUInfo model speed user nice sys idle irq)

foreign import ccall unsafe uv_loadavg :: MBA# (Double, Double, Double) -> IO ()

-- | Gets the load average. See: <https://en.wikipedia.org/wiki/Load_(computing)>
getLoadAvg :: IO (Double, Double, Double)
getLoadAvg = do
    (arr, _) <- allocPrimArrayUnsafe 3 uv_loadavg
    return ( indexPrimArray arr 0
           , indexPrimArray arr 1
           , indexPrimArray arr 2)

-- | Alternative data type for storing times.
-- typedef struct { int64_t tv_sec; int32_t tv_usec; } uv_timeval64_t;
data TimeVal64 = TimeVal64
    { tv64_sec  :: {-# UNPACK #-} !Int64
    , tv64_usec :: {-# UNPACK #-} !Int32
    }   deriving (Show, Read, Eq, Ord, Generic)
        deriving anyclass (Print, JSON)

foreign import ccall unsafe uv_gettimeofday :: MBA# TimeVal64 -> IO CInt

-- | Cross-platform implementation of <https://man7.org/linux/man-pages/man2/gettimeofday.2.html gettimeofday(2)>.
-- The timezone argument to gettimeofday() is not supported, as it is considered obsolete.
getTimeOfDay :: HasCallStack => IO TimeVal64
getTimeOfDay = do
    (MutableByteArray mba#) <- newByteArray ((16))
{-# LINE 263 "Z/IO/UV/FFI_Env.hsc" #-}
    throwUVIfMinus_ (uv_gettimeofday mba#)
    s <- peekMBA mba# ((0))
{-# LINE 265 "Z/IO/UV/FFI_Env.hsc" #-}
    us <- peekMBA mba# ((8))
{-# LINE 266 "Z/IO/UV/FFI_Env.hsc" #-}
    return (TimeVal64 s us)