{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# LANGUAGE NoImplicitPrelude           #-}
{-# LANGUAGE TemplateHaskell             #-}
{-# LANGUAGE RecordWildCards             #-}

-- |
-- Module:      SwiftNav.SBP.Linux
-- Copyright:   Copyright (C) 2015-2021 Swift Navigation, Inc.
-- License:     MIT
-- Contact:     https://support.swiftnav.com
-- Stability:   experimental
-- Portability: portable
--
-- \< Linux state monitoring. \>

module SwiftNav.SBP.Linux
  ( module SwiftNav.SBP.Linux
  ) where

import BasicPrelude
import Control.Lens
import Control.Monad.Loops
import Data.Binary
import Data.Binary.Get
import Data.Binary.IEEE754
import Data.Binary.Put
import Data.ByteString.Lazy    hiding (ByteString)
import Data.Int
import Data.Word
import SwiftNav.SBP.TH
import SwiftNav.SBP.Types

{-# ANN module ("HLint: ignore Use camelCase"::String) #-}
{-# ANN module ("HLint: ignore Redundant do"::String) #-}
{-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-}


msgLinuxCpuStateDepA :: Word16
msgLinuxCpuStateDepA :: Word16
msgLinuxCpuStateDepA = Word16
0x7F00

-- | SBP class for message MSG_LINUX_CPU_STATE_DEP_A (0x7F00).
--
-- This message indicates the process state of the top 10 heaviest consumers
-- of CPU on the system.
data MsgLinuxCpuStateDepA = MsgLinuxCpuStateDepA
  { MsgLinuxCpuStateDepA -> Word8
_msgLinuxCpuStateDepA_index :: !Word8
    -- ^ sequence of this status message, values from 0-9
  , MsgLinuxCpuStateDepA -> Word16
_msgLinuxCpuStateDepA_pid   :: !Word16
    -- ^ the PID of the process
  , MsgLinuxCpuStateDepA -> Word8
_msgLinuxCpuStateDepA_pcpu  :: !Word8
    -- ^ percent of cpu used, expressed as a fraction of 256
  , MsgLinuxCpuStateDepA -> Text
_msgLinuxCpuStateDepA_tname :: !Text
    -- ^ fixed length string representing the thread name
  , MsgLinuxCpuStateDepA -> Text
_msgLinuxCpuStateDepA_cmdline :: !Text
    -- ^ the command line (as much as it fits in the remaining packet)
  } deriving ( Int -> MsgLinuxCpuStateDepA -> ShowS
[MsgLinuxCpuStateDepA] -> ShowS
MsgLinuxCpuStateDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgLinuxCpuStateDepA] -> ShowS
$cshowList :: [MsgLinuxCpuStateDepA] -> ShowS
show :: MsgLinuxCpuStateDepA -> String
$cshow :: MsgLinuxCpuStateDepA -> String
showsPrec :: Int -> MsgLinuxCpuStateDepA -> ShowS
$cshowsPrec :: Int -> MsgLinuxCpuStateDepA -> ShowS
Show, ReadPrec [MsgLinuxCpuStateDepA]
ReadPrec MsgLinuxCpuStateDepA
Int -> ReadS MsgLinuxCpuStateDepA
ReadS [MsgLinuxCpuStateDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgLinuxCpuStateDepA]
$creadListPrec :: ReadPrec [MsgLinuxCpuStateDepA]
readPrec :: ReadPrec MsgLinuxCpuStateDepA
$creadPrec :: ReadPrec MsgLinuxCpuStateDepA
readList :: ReadS [MsgLinuxCpuStateDepA]
$creadList :: ReadS [MsgLinuxCpuStateDepA]
readsPrec :: Int -> ReadS MsgLinuxCpuStateDepA
$creadsPrec :: Int -> ReadS MsgLinuxCpuStateDepA
Read, MsgLinuxCpuStateDepA -> MsgLinuxCpuStateDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgLinuxCpuStateDepA -> MsgLinuxCpuStateDepA -> Bool
$c/= :: MsgLinuxCpuStateDepA -> MsgLinuxCpuStateDepA -> Bool
== :: MsgLinuxCpuStateDepA -> MsgLinuxCpuStateDepA -> Bool
$c== :: MsgLinuxCpuStateDepA -> MsgLinuxCpuStateDepA -> Bool
Eq )

instance Binary MsgLinuxCpuStateDepA where
  get :: Get MsgLinuxCpuStateDepA
get = do
    Word8
_msgLinuxCpuStateDepA_index <- Get Word8
getWord8
    Word16
_msgLinuxCpuStateDepA_pid <- Get Word16
getWord16le
    Word8
_msgLinuxCpuStateDepA_pcpu <- Get Word8
getWord8
    Text
_msgLinuxCpuStateDepA_tname <- ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
15
    Text
_msgLinuxCpuStateDepA_cmdline <- ByteString -> Text
decodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgLinuxCpuStateDepA {Word8
Word16
Text
_msgLinuxCpuStateDepA_cmdline :: Text
_msgLinuxCpuStateDepA_tname :: Text
_msgLinuxCpuStateDepA_pcpu :: Word8
_msgLinuxCpuStateDepA_pid :: Word16
_msgLinuxCpuStateDepA_index :: Word8
_msgLinuxCpuStateDepA_cmdline :: Text
_msgLinuxCpuStateDepA_tname :: Text
_msgLinuxCpuStateDepA_pcpu :: Word8
_msgLinuxCpuStateDepA_pid :: Word16
_msgLinuxCpuStateDepA_index :: Word8
..}

  put :: MsgLinuxCpuStateDepA -> Put
put MsgLinuxCpuStateDepA {Word8
Word16
Text
_msgLinuxCpuStateDepA_cmdline :: Text
_msgLinuxCpuStateDepA_tname :: Text
_msgLinuxCpuStateDepA_pcpu :: Word8
_msgLinuxCpuStateDepA_pid :: Word16
_msgLinuxCpuStateDepA_index :: Word8
_msgLinuxCpuStateDepA_cmdline :: MsgLinuxCpuStateDepA -> Text
_msgLinuxCpuStateDepA_tname :: MsgLinuxCpuStateDepA -> Text
_msgLinuxCpuStateDepA_pcpu :: MsgLinuxCpuStateDepA -> Word8
_msgLinuxCpuStateDepA_pid :: MsgLinuxCpuStateDepA -> Word16
_msgLinuxCpuStateDepA_index :: MsgLinuxCpuStateDepA -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgLinuxCpuStateDepA_index
    Word16 -> Put
putWord16le Word16
_msgLinuxCpuStateDepA_pid
    Word8 -> Put
putWord8 Word8
_msgLinuxCpuStateDepA_pcpu
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgLinuxCpuStateDepA_tname
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgLinuxCpuStateDepA_cmdline

$(makeSBP 'msgLinuxCpuStateDepA ''MsgLinuxCpuStateDepA)
$(makeJSON "_msgLinuxCpuStateDepA_" ''MsgLinuxCpuStateDepA)
$(makeLenses ''MsgLinuxCpuStateDepA)

msgLinuxMemStateDepA :: Word16
msgLinuxMemStateDepA :: Word16
msgLinuxMemStateDepA = Word16
0x7F01

-- | SBP class for message MSG_LINUX_MEM_STATE_DEP_A (0x7F01).
--
-- This message indicates the process state of the top 10 heaviest consumers
-- of memory on the system.
data MsgLinuxMemStateDepA = MsgLinuxMemStateDepA
  { MsgLinuxMemStateDepA -> Word8
_msgLinuxMemStateDepA_index :: !Word8
    -- ^ sequence of this status message, values from 0-9
  , MsgLinuxMemStateDepA -> Word16
_msgLinuxMemStateDepA_pid   :: !Word16
    -- ^ the PID of the process
  , MsgLinuxMemStateDepA -> Word8
_msgLinuxMemStateDepA_pmem  :: !Word8
    -- ^ percent of memory used, expressed as a fraction of 256
  , MsgLinuxMemStateDepA -> Text
_msgLinuxMemStateDepA_tname :: !Text
    -- ^ fixed length string representing the thread name
  , MsgLinuxMemStateDepA -> Text
_msgLinuxMemStateDepA_cmdline :: !Text
    -- ^ the command line (as much as it fits in the remaining packet)
  } deriving ( Int -> MsgLinuxMemStateDepA -> ShowS
[MsgLinuxMemStateDepA] -> ShowS
MsgLinuxMemStateDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgLinuxMemStateDepA] -> ShowS
$cshowList :: [MsgLinuxMemStateDepA] -> ShowS
show :: MsgLinuxMemStateDepA -> String
$cshow :: MsgLinuxMemStateDepA -> String
showsPrec :: Int -> MsgLinuxMemStateDepA -> ShowS
$cshowsPrec :: Int -> MsgLinuxMemStateDepA -> ShowS
Show, ReadPrec [MsgLinuxMemStateDepA]
ReadPrec MsgLinuxMemStateDepA
Int -> ReadS MsgLinuxMemStateDepA
ReadS [MsgLinuxMemStateDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgLinuxMemStateDepA]
$creadListPrec :: ReadPrec [MsgLinuxMemStateDepA]
readPrec :: ReadPrec MsgLinuxMemStateDepA
$creadPrec :: ReadPrec MsgLinuxMemStateDepA
readList :: ReadS [MsgLinuxMemStateDepA]
$creadList :: ReadS [MsgLinuxMemStateDepA]
readsPrec :: Int -> ReadS MsgLinuxMemStateDepA
$creadsPrec :: Int -> ReadS MsgLinuxMemStateDepA
Read, MsgLinuxMemStateDepA -> MsgLinuxMemStateDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgLinuxMemStateDepA -> MsgLinuxMemStateDepA -> Bool
$c/= :: MsgLinuxMemStateDepA -> MsgLinuxMemStateDepA -> Bool
== :: MsgLinuxMemStateDepA -> MsgLinuxMemStateDepA -> Bool
$c== :: MsgLinuxMemStateDepA -> MsgLinuxMemStateDepA -> Bool
Eq )

instance Binary MsgLinuxMemStateDepA where
  get :: Get MsgLinuxMemStateDepA
get = do
    Word8
_msgLinuxMemStateDepA_index <- Get Word8
getWord8
    Word16
_msgLinuxMemStateDepA_pid <- Get Word16
getWord16le
    Word8
_msgLinuxMemStateDepA_pmem <- Get Word8
getWord8
    Text
_msgLinuxMemStateDepA_tname <- ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
15
    Text
_msgLinuxMemStateDepA_cmdline <- ByteString -> Text
decodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgLinuxMemStateDepA {Word8
Word16
Text
_msgLinuxMemStateDepA_cmdline :: Text
_msgLinuxMemStateDepA_tname :: Text
_msgLinuxMemStateDepA_pmem :: Word8
_msgLinuxMemStateDepA_pid :: Word16
_msgLinuxMemStateDepA_index :: Word8
_msgLinuxMemStateDepA_cmdline :: Text
_msgLinuxMemStateDepA_tname :: Text
_msgLinuxMemStateDepA_pmem :: Word8
_msgLinuxMemStateDepA_pid :: Word16
_msgLinuxMemStateDepA_index :: Word8
..}

  put :: MsgLinuxMemStateDepA -> Put
put MsgLinuxMemStateDepA {Word8
Word16
Text
_msgLinuxMemStateDepA_cmdline :: Text
_msgLinuxMemStateDepA_tname :: Text
_msgLinuxMemStateDepA_pmem :: Word8
_msgLinuxMemStateDepA_pid :: Word16
_msgLinuxMemStateDepA_index :: Word8
_msgLinuxMemStateDepA_cmdline :: MsgLinuxMemStateDepA -> Text
_msgLinuxMemStateDepA_tname :: MsgLinuxMemStateDepA -> Text
_msgLinuxMemStateDepA_pmem :: MsgLinuxMemStateDepA -> Word8
_msgLinuxMemStateDepA_pid :: MsgLinuxMemStateDepA -> Word16
_msgLinuxMemStateDepA_index :: MsgLinuxMemStateDepA -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgLinuxMemStateDepA_index
    Word16 -> Put
putWord16le Word16
_msgLinuxMemStateDepA_pid
    Word8 -> Put
putWord8 Word8
_msgLinuxMemStateDepA_pmem
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgLinuxMemStateDepA_tname
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgLinuxMemStateDepA_cmdline

$(makeSBP 'msgLinuxMemStateDepA ''MsgLinuxMemStateDepA)
$(makeJSON "_msgLinuxMemStateDepA_" ''MsgLinuxMemStateDepA)
$(makeLenses ''MsgLinuxMemStateDepA)

msgLinuxSysStateDepA :: Word16
msgLinuxSysStateDepA :: Word16
msgLinuxSysStateDepA = Word16
0x7F02

-- | SBP class for message MSG_LINUX_SYS_STATE_DEP_A (0x7F02).
--
-- This presents a summary of CPU and memory utilization.
data MsgLinuxSysStateDepA = MsgLinuxSysStateDepA
  { MsgLinuxSysStateDepA -> Word16
_msgLinuxSysStateDepA_mem_total    :: !Word16
    -- ^ total system memory
  , MsgLinuxSysStateDepA -> Word8
_msgLinuxSysStateDepA_pcpu         :: !Word8
    -- ^ percent of total cpu currently utilized
  , MsgLinuxSysStateDepA -> Word8
_msgLinuxSysStateDepA_pmem         :: !Word8
    -- ^ percent of total memory currently utilized
  , MsgLinuxSysStateDepA -> Word16
_msgLinuxSysStateDepA_procs_starting :: !Word16
    -- ^ number of processes that started during collection phase
  , MsgLinuxSysStateDepA -> Word16
_msgLinuxSysStateDepA_procs_stopping :: !Word16
    -- ^ number of processes that stopped during collection phase
  , MsgLinuxSysStateDepA -> Word16
_msgLinuxSysStateDepA_pid_count    :: !Word16
    -- ^ the count of processes on the system
  } deriving ( Int -> MsgLinuxSysStateDepA -> ShowS
[MsgLinuxSysStateDepA] -> ShowS
MsgLinuxSysStateDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgLinuxSysStateDepA] -> ShowS
$cshowList :: [MsgLinuxSysStateDepA] -> ShowS
show :: MsgLinuxSysStateDepA -> String
$cshow :: MsgLinuxSysStateDepA -> String
showsPrec :: Int -> MsgLinuxSysStateDepA -> ShowS
$cshowsPrec :: Int -> MsgLinuxSysStateDepA -> ShowS
Show, ReadPrec [MsgLinuxSysStateDepA]
ReadPrec MsgLinuxSysStateDepA
Int -> ReadS MsgLinuxSysStateDepA
ReadS [MsgLinuxSysStateDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgLinuxSysStateDepA]
$creadListPrec :: ReadPrec [MsgLinuxSysStateDepA]
readPrec :: ReadPrec MsgLinuxSysStateDepA
$creadPrec :: ReadPrec MsgLinuxSysStateDepA
readList :: ReadS [MsgLinuxSysStateDepA]
$creadList :: ReadS [MsgLinuxSysStateDepA]
readsPrec :: Int -> ReadS MsgLinuxSysStateDepA
$creadsPrec :: Int -> ReadS MsgLinuxSysStateDepA
Read, MsgLinuxSysStateDepA -> MsgLinuxSysStateDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgLinuxSysStateDepA -> MsgLinuxSysStateDepA -> Bool
$c/= :: MsgLinuxSysStateDepA -> MsgLinuxSysStateDepA -> Bool
== :: MsgLinuxSysStateDepA -> MsgLinuxSysStateDepA -> Bool
$c== :: MsgLinuxSysStateDepA -> MsgLinuxSysStateDepA -> Bool
Eq )

instance Binary MsgLinuxSysStateDepA where
  get :: Get MsgLinuxSysStateDepA
get = do
    Word16
_msgLinuxSysStateDepA_mem_total <- Get Word16
getWord16le
    Word8
_msgLinuxSysStateDepA_pcpu <- Get Word8
getWord8
    Word8
_msgLinuxSysStateDepA_pmem <- Get Word8
getWord8
    Word16
_msgLinuxSysStateDepA_procs_starting <- Get Word16
getWord16le
    Word16
_msgLinuxSysStateDepA_procs_stopping <- Get Word16
getWord16le
    Word16
_msgLinuxSysStateDepA_pid_count <- Get Word16
getWord16le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgLinuxSysStateDepA {Word8
Word16
_msgLinuxSysStateDepA_pid_count :: Word16
_msgLinuxSysStateDepA_procs_stopping :: Word16
_msgLinuxSysStateDepA_procs_starting :: Word16
_msgLinuxSysStateDepA_pmem :: Word8
_msgLinuxSysStateDepA_pcpu :: Word8
_msgLinuxSysStateDepA_mem_total :: Word16
_msgLinuxSysStateDepA_pid_count :: Word16
_msgLinuxSysStateDepA_procs_stopping :: Word16
_msgLinuxSysStateDepA_procs_starting :: Word16
_msgLinuxSysStateDepA_pmem :: Word8
_msgLinuxSysStateDepA_pcpu :: Word8
_msgLinuxSysStateDepA_mem_total :: Word16
..}

  put :: MsgLinuxSysStateDepA -> Put
put MsgLinuxSysStateDepA {Word8
Word16
_msgLinuxSysStateDepA_pid_count :: Word16
_msgLinuxSysStateDepA_procs_stopping :: Word16
_msgLinuxSysStateDepA_procs_starting :: Word16
_msgLinuxSysStateDepA_pmem :: Word8
_msgLinuxSysStateDepA_pcpu :: Word8
_msgLinuxSysStateDepA_mem_total :: Word16
_msgLinuxSysStateDepA_pid_count :: MsgLinuxSysStateDepA -> Word16
_msgLinuxSysStateDepA_procs_stopping :: MsgLinuxSysStateDepA -> Word16
_msgLinuxSysStateDepA_procs_starting :: MsgLinuxSysStateDepA -> Word16
_msgLinuxSysStateDepA_pmem :: MsgLinuxSysStateDepA -> Word8
_msgLinuxSysStateDepA_pcpu :: MsgLinuxSysStateDepA -> Word8
_msgLinuxSysStateDepA_mem_total :: MsgLinuxSysStateDepA -> Word16
..} = do
    Word16 -> Put
putWord16le Word16
_msgLinuxSysStateDepA_mem_total
    Word8 -> Put
putWord8 Word8
_msgLinuxSysStateDepA_pcpu
    Word8 -> Put
putWord8 Word8
_msgLinuxSysStateDepA_pmem
    Word16 -> Put
putWord16le Word16
_msgLinuxSysStateDepA_procs_starting
    Word16 -> Put
putWord16le Word16
_msgLinuxSysStateDepA_procs_stopping
    Word16 -> Put
putWord16le Word16
_msgLinuxSysStateDepA_pid_count

$(makeSBP 'msgLinuxSysStateDepA ''MsgLinuxSysStateDepA)
$(makeJSON "_msgLinuxSysStateDepA_" ''MsgLinuxSysStateDepA)
$(makeLenses ''MsgLinuxSysStateDepA)

msgLinuxProcessSocketCounts :: Word16
msgLinuxProcessSocketCounts :: Word16
msgLinuxProcessSocketCounts = Word16
0x7F03

-- | SBP class for message MSG_LINUX_PROCESS_SOCKET_COUNTS (0x7F03).
--
-- Top 10 list of processes with high socket counts.
data MsgLinuxProcessSocketCounts = MsgLinuxProcessSocketCounts
  { MsgLinuxProcessSocketCounts -> Word8
_msgLinuxProcessSocketCounts_index       :: !Word8
    -- ^ sequence of this status message, values from 0-9
  , MsgLinuxProcessSocketCounts -> Word16
_msgLinuxProcessSocketCounts_pid         :: !Word16
    -- ^ the PID of the process in question
  , MsgLinuxProcessSocketCounts -> Word16
_msgLinuxProcessSocketCounts_socket_count :: !Word16
    -- ^ the number of sockets the process is using
  , MsgLinuxProcessSocketCounts -> Word16
_msgLinuxProcessSocketCounts_socket_types :: !Word16
    -- ^ A bitfield indicating the socket types used: 0x1 (tcp), 0x2 (udp), 0x4
    -- (unix stream), 0x8 (unix dgram), 0x10 (netlink), and 0x8000 (unknown)
  , MsgLinuxProcessSocketCounts -> Word16
_msgLinuxProcessSocketCounts_socket_states :: !Word16
    -- ^ A bitfield indicating the socket states: 0x1 (established), 0x2 (syn-
    -- sent), 0x4 (syn-recv), 0x8 (fin-wait-1), 0x10 (fin-wait-2), 0x20 (time-
    -- wait), 0x40 (closed), 0x80 (close-wait), 0x100 (last-ack), 0x200
    -- (listen), 0x400 (closing), 0x800 (unconnected), and 0x8000 (unknown)
  , MsgLinuxProcessSocketCounts -> Text
_msgLinuxProcessSocketCounts_cmdline     :: !Text
    -- ^ the command line of the process in question
  } deriving ( Int -> MsgLinuxProcessSocketCounts -> ShowS
[MsgLinuxProcessSocketCounts] -> ShowS
MsgLinuxProcessSocketCounts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgLinuxProcessSocketCounts] -> ShowS
$cshowList :: [MsgLinuxProcessSocketCounts] -> ShowS
show :: MsgLinuxProcessSocketCounts -> String
$cshow :: MsgLinuxProcessSocketCounts -> String
showsPrec :: Int -> MsgLinuxProcessSocketCounts -> ShowS
$cshowsPrec :: Int -> MsgLinuxProcessSocketCounts -> ShowS
Show, ReadPrec [MsgLinuxProcessSocketCounts]
ReadPrec MsgLinuxProcessSocketCounts
Int -> ReadS MsgLinuxProcessSocketCounts
ReadS [MsgLinuxProcessSocketCounts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgLinuxProcessSocketCounts]
$creadListPrec :: ReadPrec [MsgLinuxProcessSocketCounts]
readPrec :: ReadPrec MsgLinuxProcessSocketCounts
$creadPrec :: ReadPrec MsgLinuxProcessSocketCounts
readList :: ReadS [MsgLinuxProcessSocketCounts]
$creadList :: ReadS [MsgLinuxProcessSocketCounts]
readsPrec :: Int -> ReadS MsgLinuxProcessSocketCounts
$creadsPrec :: Int -> ReadS MsgLinuxProcessSocketCounts
Read, MsgLinuxProcessSocketCounts -> MsgLinuxProcessSocketCounts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgLinuxProcessSocketCounts -> MsgLinuxProcessSocketCounts -> Bool
$c/= :: MsgLinuxProcessSocketCounts -> MsgLinuxProcessSocketCounts -> Bool
== :: MsgLinuxProcessSocketCounts -> MsgLinuxProcessSocketCounts -> Bool
$c== :: MsgLinuxProcessSocketCounts -> MsgLinuxProcessSocketCounts -> Bool
Eq )

instance Binary MsgLinuxProcessSocketCounts where
  get :: Get MsgLinuxProcessSocketCounts
get = do
    Word8
_msgLinuxProcessSocketCounts_index <- Get Word8
getWord8
    Word16
_msgLinuxProcessSocketCounts_pid <- Get Word16
getWord16le
    Word16
_msgLinuxProcessSocketCounts_socket_count <- Get Word16
getWord16le
    Word16
_msgLinuxProcessSocketCounts_socket_types <- Get Word16
getWord16le
    Word16
_msgLinuxProcessSocketCounts_socket_states <- Get Word16
getWord16le
    Text
_msgLinuxProcessSocketCounts_cmdline <- ByteString -> Text
decodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgLinuxProcessSocketCounts {Word8
Word16
Text
_msgLinuxProcessSocketCounts_cmdline :: Text
_msgLinuxProcessSocketCounts_socket_states :: Word16
_msgLinuxProcessSocketCounts_socket_types :: Word16
_msgLinuxProcessSocketCounts_socket_count :: Word16
_msgLinuxProcessSocketCounts_pid :: Word16
_msgLinuxProcessSocketCounts_index :: Word8
_msgLinuxProcessSocketCounts_cmdline :: Text
_msgLinuxProcessSocketCounts_socket_states :: Word16
_msgLinuxProcessSocketCounts_socket_types :: Word16
_msgLinuxProcessSocketCounts_socket_count :: Word16
_msgLinuxProcessSocketCounts_pid :: Word16
_msgLinuxProcessSocketCounts_index :: Word8
..}

  put :: MsgLinuxProcessSocketCounts -> Put
put MsgLinuxProcessSocketCounts {Word8
Word16
Text
_msgLinuxProcessSocketCounts_cmdline :: Text
_msgLinuxProcessSocketCounts_socket_states :: Word16
_msgLinuxProcessSocketCounts_socket_types :: Word16
_msgLinuxProcessSocketCounts_socket_count :: Word16
_msgLinuxProcessSocketCounts_pid :: Word16
_msgLinuxProcessSocketCounts_index :: Word8
_msgLinuxProcessSocketCounts_cmdline :: MsgLinuxProcessSocketCounts -> Text
_msgLinuxProcessSocketCounts_socket_states :: MsgLinuxProcessSocketCounts -> Word16
_msgLinuxProcessSocketCounts_socket_types :: MsgLinuxProcessSocketCounts -> Word16
_msgLinuxProcessSocketCounts_socket_count :: MsgLinuxProcessSocketCounts -> Word16
_msgLinuxProcessSocketCounts_pid :: MsgLinuxProcessSocketCounts -> Word16
_msgLinuxProcessSocketCounts_index :: MsgLinuxProcessSocketCounts -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgLinuxProcessSocketCounts_index
    Word16 -> Put
putWord16le Word16
_msgLinuxProcessSocketCounts_pid
    Word16 -> Put
putWord16le Word16
_msgLinuxProcessSocketCounts_socket_count
    Word16 -> Put
putWord16le Word16
_msgLinuxProcessSocketCounts_socket_types
    Word16 -> Put
putWord16le Word16
_msgLinuxProcessSocketCounts_socket_states
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgLinuxProcessSocketCounts_cmdline

$(makeSBP 'msgLinuxProcessSocketCounts ''MsgLinuxProcessSocketCounts)
$(makeJSON "_msgLinuxProcessSocketCounts_" ''MsgLinuxProcessSocketCounts)
$(makeLenses ''MsgLinuxProcessSocketCounts)

msgLinuxProcessSocketQueues :: Word16
msgLinuxProcessSocketQueues :: Word16
msgLinuxProcessSocketQueues = Word16
0x7F04

-- | SBP class for message MSG_LINUX_PROCESS_SOCKET_QUEUES (0x7F04).
--
-- Top 10 list of sockets with deep queues.
data MsgLinuxProcessSocketQueues = MsgLinuxProcessSocketQueues
  { MsgLinuxProcessSocketQueues -> Word8
_msgLinuxProcessSocketQueues_index            :: !Word8
    -- ^ sequence of this status message, values from 0-9
  , MsgLinuxProcessSocketQueues -> Word16
_msgLinuxProcessSocketQueues_pid              :: !Word16
    -- ^ the PID of the process in question
  , MsgLinuxProcessSocketQueues -> Word16
_msgLinuxProcessSocketQueues_recv_queued      :: !Word16
    -- ^ the total amount of receive data queued for this process
  , MsgLinuxProcessSocketQueues -> Word16
_msgLinuxProcessSocketQueues_send_queued      :: !Word16
    -- ^ the total amount of send data queued for this process
  , MsgLinuxProcessSocketQueues -> Word16
_msgLinuxProcessSocketQueues_socket_types     :: !Word16
    -- ^ A bitfield indicating the socket types used: 0x1 (tcp), 0x2 (udp), 0x4
    -- (unix stream), 0x8 (unix dgram), 0x10 (netlink), and 0x8000 (unknown)
  , MsgLinuxProcessSocketQueues -> Word16
_msgLinuxProcessSocketQueues_socket_states    :: !Word16
    -- ^ A bitfield indicating the socket states: 0x1 (established), 0x2 (syn-
    -- sent), 0x4 (syn-recv), 0x8 (fin-wait-1), 0x10 (fin-wait-2), 0x20 (time-
    -- wait), 0x40 (closed), 0x80 (close-wait), 0x100 (last-ack), 0x200
    -- (listen), 0x400 (closing), 0x800 (unconnected), and 0x8000 (unknown)
  , MsgLinuxProcessSocketQueues -> Text
_msgLinuxProcessSocketQueues_address_of_largest :: !Text
    -- ^ Address of the largest queue, remote or local depending on the
    -- directionality of the connection.
  , MsgLinuxProcessSocketQueues -> Text
_msgLinuxProcessSocketQueues_cmdline          :: !Text
    -- ^ the command line of the process in question
  } deriving ( Int -> MsgLinuxProcessSocketQueues -> ShowS
[MsgLinuxProcessSocketQueues] -> ShowS
MsgLinuxProcessSocketQueues -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgLinuxProcessSocketQueues] -> ShowS
$cshowList :: [MsgLinuxProcessSocketQueues] -> ShowS
show :: MsgLinuxProcessSocketQueues -> String
$cshow :: MsgLinuxProcessSocketQueues -> String
showsPrec :: Int -> MsgLinuxProcessSocketQueues -> ShowS
$cshowsPrec :: Int -> MsgLinuxProcessSocketQueues -> ShowS
Show, ReadPrec [MsgLinuxProcessSocketQueues]
ReadPrec MsgLinuxProcessSocketQueues
Int -> ReadS MsgLinuxProcessSocketQueues
ReadS [MsgLinuxProcessSocketQueues]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgLinuxProcessSocketQueues]
$creadListPrec :: ReadPrec [MsgLinuxProcessSocketQueues]
readPrec :: ReadPrec MsgLinuxProcessSocketQueues
$creadPrec :: ReadPrec MsgLinuxProcessSocketQueues
readList :: ReadS [MsgLinuxProcessSocketQueues]
$creadList :: ReadS [MsgLinuxProcessSocketQueues]
readsPrec :: Int -> ReadS MsgLinuxProcessSocketQueues
$creadsPrec :: Int -> ReadS MsgLinuxProcessSocketQueues
Read, MsgLinuxProcessSocketQueues -> MsgLinuxProcessSocketQueues -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgLinuxProcessSocketQueues -> MsgLinuxProcessSocketQueues -> Bool
$c/= :: MsgLinuxProcessSocketQueues -> MsgLinuxProcessSocketQueues -> Bool
== :: MsgLinuxProcessSocketQueues -> MsgLinuxProcessSocketQueues -> Bool
$c== :: MsgLinuxProcessSocketQueues -> MsgLinuxProcessSocketQueues -> Bool
Eq )

instance Binary MsgLinuxProcessSocketQueues where
  get :: Get MsgLinuxProcessSocketQueues
get = do
    Word8
_msgLinuxProcessSocketQueues_index <- Get Word8
getWord8
    Word16
_msgLinuxProcessSocketQueues_pid <- Get Word16
getWord16le
    Word16
_msgLinuxProcessSocketQueues_recv_queued <- Get Word16
getWord16le
    Word16
_msgLinuxProcessSocketQueues_send_queued <- Get Word16
getWord16le
    Word16
_msgLinuxProcessSocketQueues_socket_types <- Get Word16
getWord16le
    Word16
_msgLinuxProcessSocketQueues_socket_states <- Get Word16
getWord16le
    Text
_msgLinuxProcessSocketQueues_address_of_largest <- ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
64
    Text
_msgLinuxProcessSocketQueues_cmdline <- ByteString -> Text
decodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgLinuxProcessSocketQueues {Word8
Word16
Text
_msgLinuxProcessSocketQueues_cmdline :: Text
_msgLinuxProcessSocketQueues_address_of_largest :: Text
_msgLinuxProcessSocketQueues_socket_states :: Word16
_msgLinuxProcessSocketQueues_socket_types :: Word16
_msgLinuxProcessSocketQueues_send_queued :: Word16
_msgLinuxProcessSocketQueues_recv_queued :: Word16
_msgLinuxProcessSocketQueues_pid :: Word16
_msgLinuxProcessSocketQueues_index :: Word8
_msgLinuxProcessSocketQueues_cmdline :: Text
_msgLinuxProcessSocketQueues_address_of_largest :: Text
_msgLinuxProcessSocketQueues_socket_states :: Word16
_msgLinuxProcessSocketQueues_socket_types :: Word16
_msgLinuxProcessSocketQueues_send_queued :: Word16
_msgLinuxProcessSocketQueues_recv_queued :: Word16
_msgLinuxProcessSocketQueues_pid :: Word16
_msgLinuxProcessSocketQueues_index :: Word8
..}

  put :: MsgLinuxProcessSocketQueues -> Put
put MsgLinuxProcessSocketQueues {Word8
Word16
Text
_msgLinuxProcessSocketQueues_cmdline :: Text
_msgLinuxProcessSocketQueues_address_of_largest :: Text
_msgLinuxProcessSocketQueues_socket_states :: Word16
_msgLinuxProcessSocketQueues_socket_types :: Word16
_msgLinuxProcessSocketQueues_send_queued :: Word16
_msgLinuxProcessSocketQueues_recv_queued :: Word16
_msgLinuxProcessSocketQueues_pid :: Word16
_msgLinuxProcessSocketQueues_index :: Word8
_msgLinuxProcessSocketQueues_cmdline :: MsgLinuxProcessSocketQueues -> Text
_msgLinuxProcessSocketQueues_address_of_largest :: MsgLinuxProcessSocketQueues -> Text
_msgLinuxProcessSocketQueues_socket_states :: MsgLinuxProcessSocketQueues -> Word16
_msgLinuxProcessSocketQueues_socket_types :: MsgLinuxProcessSocketQueues -> Word16
_msgLinuxProcessSocketQueues_send_queued :: MsgLinuxProcessSocketQueues -> Word16
_msgLinuxProcessSocketQueues_recv_queued :: MsgLinuxProcessSocketQueues -> Word16
_msgLinuxProcessSocketQueues_pid :: MsgLinuxProcessSocketQueues -> Word16
_msgLinuxProcessSocketQueues_index :: MsgLinuxProcessSocketQueues -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgLinuxProcessSocketQueues_index
    Word16 -> Put
putWord16le Word16
_msgLinuxProcessSocketQueues_pid
    Word16 -> Put
putWord16le Word16
_msgLinuxProcessSocketQueues_recv_queued
    Word16 -> Put
putWord16le Word16
_msgLinuxProcessSocketQueues_send_queued
    Word16 -> Put
putWord16le Word16
_msgLinuxProcessSocketQueues_socket_types
    Word16 -> Put
putWord16le Word16
_msgLinuxProcessSocketQueues_socket_states
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgLinuxProcessSocketQueues_address_of_largest
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgLinuxProcessSocketQueues_cmdline

$(makeSBP 'msgLinuxProcessSocketQueues ''MsgLinuxProcessSocketQueues)
$(makeJSON "_msgLinuxProcessSocketQueues_" ''MsgLinuxProcessSocketQueues)
$(makeLenses ''MsgLinuxProcessSocketQueues)

msgLinuxSocketUsage :: Word16
msgLinuxSocketUsage :: Word16
msgLinuxSocketUsage = Word16
0x7F05

-- | SBP class for message MSG_LINUX_SOCKET_USAGE (0x7F05).
--
-- Summaries the socket usage across the system.
data MsgLinuxSocketUsage = MsgLinuxSocketUsage
  { MsgLinuxSocketUsage -> Word32
_msgLinuxSocketUsage_avg_queue_depth   :: !Word32
    -- ^ average socket queue depths across all sockets on the system
  , MsgLinuxSocketUsage -> Word32
_msgLinuxSocketUsage_max_queue_depth   :: !Word32
    -- ^ the max queue depth seen within the reporting period
  , MsgLinuxSocketUsage -> [Word16]
_msgLinuxSocketUsage_socket_state_counts :: ![Word16]
    -- ^ A count for each socket type reported in the `socket_types_reported`
    -- field, the first entry corresponds to the first enabled bit in
    -- `types_reported`.
  , MsgLinuxSocketUsage -> [Word16]
_msgLinuxSocketUsage_socket_type_counts :: ![Word16]
    -- ^ A count for each socket type reported in the `socket_types_reported`
    -- field, the first entry corresponds to the first enabled bit in
    -- `types_reported`.
  } deriving ( Int -> MsgLinuxSocketUsage -> ShowS
[MsgLinuxSocketUsage] -> ShowS
MsgLinuxSocketUsage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgLinuxSocketUsage] -> ShowS
$cshowList :: [MsgLinuxSocketUsage] -> ShowS
show :: MsgLinuxSocketUsage -> String
$cshow :: MsgLinuxSocketUsage -> String
showsPrec :: Int -> MsgLinuxSocketUsage -> ShowS
$cshowsPrec :: Int -> MsgLinuxSocketUsage -> ShowS
Show, ReadPrec [MsgLinuxSocketUsage]
ReadPrec MsgLinuxSocketUsage
Int -> ReadS MsgLinuxSocketUsage
ReadS [MsgLinuxSocketUsage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgLinuxSocketUsage]
$creadListPrec :: ReadPrec [MsgLinuxSocketUsage]
readPrec :: ReadPrec MsgLinuxSocketUsage
$creadPrec :: ReadPrec MsgLinuxSocketUsage
readList :: ReadS [MsgLinuxSocketUsage]
$creadList :: ReadS [MsgLinuxSocketUsage]
readsPrec :: Int -> ReadS MsgLinuxSocketUsage
$creadsPrec :: Int -> ReadS MsgLinuxSocketUsage
Read, MsgLinuxSocketUsage -> MsgLinuxSocketUsage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgLinuxSocketUsage -> MsgLinuxSocketUsage -> Bool
$c/= :: MsgLinuxSocketUsage -> MsgLinuxSocketUsage -> Bool
== :: MsgLinuxSocketUsage -> MsgLinuxSocketUsage -> Bool
$c== :: MsgLinuxSocketUsage -> MsgLinuxSocketUsage -> Bool
Eq )

instance Binary MsgLinuxSocketUsage where
  get :: Get MsgLinuxSocketUsage
get = do
    Word32
_msgLinuxSocketUsage_avg_queue_depth <- Get Word32
getWord32le
    Word32
_msgLinuxSocketUsage_max_queue_depth <- Get Word32
getWord32le
    [Word16]
_msgLinuxSocketUsage_socket_state_counts <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
16 Get Word16
getWord16le
    [Word16]
_msgLinuxSocketUsage_socket_type_counts <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
16 Get Word16
getWord16le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgLinuxSocketUsage {[Word16]
Word32
_msgLinuxSocketUsage_socket_type_counts :: [Word16]
_msgLinuxSocketUsage_socket_state_counts :: [Word16]
_msgLinuxSocketUsage_max_queue_depth :: Word32
_msgLinuxSocketUsage_avg_queue_depth :: Word32
_msgLinuxSocketUsage_socket_type_counts :: [Word16]
_msgLinuxSocketUsage_socket_state_counts :: [Word16]
_msgLinuxSocketUsage_max_queue_depth :: Word32
_msgLinuxSocketUsage_avg_queue_depth :: Word32
..}

  put :: MsgLinuxSocketUsage -> Put
put MsgLinuxSocketUsage {[Word16]
Word32
_msgLinuxSocketUsage_socket_type_counts :: [Word16]
_msgLinuxSocketUsage_socket_state_counts :: [Word16]
_msgLinuxSocketUsage_max_queue_depth :: Word32
_msgLinuxSocketUsage_avg_queue_depth :: Word32
_msgLinuxSocketUsage_socket_type_counts :: MsgLinuxSocketUsage -> [Word16]
_msgLinuxSocketUsage_socket_state_counts :: MsgLinuxSocketUsage -> [Word16]
_msgLinuxSocketUsage_max_queue_depth :: MsgLinuxSocketUsage -> Word32
_msgLinuxSocketUsage_avg_queue_depth :: MsgLinuxSocketUsage -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgLinuxSocketUsage_avg_queue_depth
    Word32 -> Put
putWord32le Word32
_msgLinuxSocketUsage_max_queue_depth
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word16 -> Put
putWord16le [Word16]
_msgLinuxSocketUsage_socket_state_counts
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word16 -> Put
putWord16le [Word16]
_msgLinuxSocketUsage_socket_type_counts

$(makeSBP 'msgLinuxSocketUsage ''MsgLinuxSocketUsage)
$(makeJSON "_msgLinuxSocketUsage_" ''MsgLinuxSocketUsage)
$(makeLenses ''MsgLinuxSocketUsage)

msgLinuxProcessFdCount :: Word16
msgLinuxProcessFdCount :: Word16
msgLinuxProcessFdCount = Word16
0x7F06

-- | SBP class for message MSG_LINUX_PROCESS_FD_COUNT (0x7F06).
--
-- Top 10 list of processes with a large number of open file descriptors.
data MsgLinuxProcessFdCount = MsgLinuxProcessFdCount
  { MsgLinuxProcessFdCount -> Word8
_msgLinuxProcessFdCount_index  :: !Word8
    -- ^ sequence of this status message, values from 0-9
  , MsgLinuxProcessFdCount -> Word16
_msgLinuxProcessFdCount_pid    :: !Word16
    -- ^ the PID of the process in question
  , MsgLinuxProcessFdCount -> Word16
_msgLinuxProcessFdCount_fd_count :: !Word16
    -- ^ a count of the number of file descriptors opened by the process
  , MsgLinuxProcessFdCount -> Text
_msgLinuxProcessFdCount_cmdline :: !Text
    -- ^ the command line of the process in question
  } deriving ( Int -> MsgLinuxProcessFdCount -> ShowS
[MsgLinuxProcessFdCount] -> ShowS
MsgLinuxProcessFdCount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgLinuxProcessFdCount] -> ShowS
$cshowList :: [MsgLinuxProcessFdCount] -> ShowS
show :: MsgLinuxProcessFdCount -> String
$cshow :: MsgLinuxProcessFdCount -> String
showsPrec :: Int -> MsgLinuxProcessFdCount -> ShowS
$cshowsPrec :: Int -> MsgLinuxProcessFdCount -> ShowS
Show, ReadPrec [MsgLinuxProcessFdCount]
ReadPrec MsgLinuxProcessFdCount
Int -> ReadS MsgLinuxProcessFdCount
ReadS [MsgLinuxProcessFdCount]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgLinuxProcessFdCount]
$creadListPrec :: ReadPrec [MsgLinuxProcessFdCount]
readPrec :: ReadPrec MsgLinuxProcessFdCount
$creadPrec :: ReadPrec MsgLinuxProcessFdCount
readList :: ReadS [MsgLinuxProcessFdCount]
$creadList :: ReadS [MsgLinuxProcessFdCount]
readsPrec :: Int -> ReadS MsgLinuxProcessFdCount
$creadsPrec :: Int -> ReadS MsgLinuxProcessFdCount
Read, MsgLinuxProcessFdCount -> MsgLinuxProcessFdCount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgLinuxProcessFdCount -> MsgLinuxProcessFdCount -> Bool
$c/= :: MsgLinuxProcessFdCount -> MsgLinuxProcessFdCount -> Bool
== :: MsgLinuxProcessFdCount -> MsgLinuxProcessFdCount -> Bool
$c== :: MsgLinuxProcessFdCount -> MsgLinuxProcessFdCount -> Bool
Eq )

instance Binary MsgLinuxProcessFdCount where
  get :: Get MsgLinuxProcessFdCount
get = do
    Word8
_msgLinuxProcessFdCount_index <- Get Word8
getWord8
    Word16
_msgLinuxProcessFdCount_pid <- Get Word16
getWord16le
    Word16
_msgLinuxProcessFdCount_fd_count <- Get Word16
getWord16le
    Text
_msgLinuxProcessFdCount_cmdline <- ByteString -> Text
decodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgLinuxProcessFdCount {Word8
Word16
Text
_msgLinuxProcessFdCount_cmdline :: Text
_msgLinuxProcessFdCount_fd_count :: Word16
_msgLinuxProcessFdCount_pid :: Word16
_msgLinuxProcessFdCount_index :: Word8
_msgLinuxProcessFdCount_cmdline :: Text
_msgLinuxProcessFdCount_fd_count :: Word16
_msgLinuxProcessFdCount_pid :: Word16
_msgLinuxProcessFdCount_index :: Word8
..}

  put :: MsgLinuxProcessFdCount -> Put
put MsgLinuxProcessFdCount {Word8
Word16
Text
_msgLinuxProcessFdCount_cmdline :: Text
_msgLinuxProcessFdCount_fd_count :: Word16
_msgLinuxProcessFdCount_pid :: Word16
_msgLinuxProcessFdCount_index :: Word8
_msgLinuxProcessFdCount_cmdline :: MsgLinuxProcessFdCount -> Text
_msgLinuxProcessFdCount_fd_count :: MsgLinuxProcessFdCount -> Word16
_msgLinuxProcessFdCount_pid :: MsgLinuxProcessFdCount -> Word16
_msgLinuxProcessFdCount_index :: MsgLinuxProcessFdCount -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgLinuxProcessFdCount_index
    Word16 -> Put
putWord16le Word16
_msgLinuxProcessFdCount_pid
    Word16 -> Put
putWord16le Word16
_msgLinuxProcessFdCount_fd_count
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgLinuxProcessFdCount_cmdline

$(makeSBP 'msgLinuxProcessFdCount ''MsgLinuxProcessFdCount)
$(makeJSON "_msgLinuxProcessFdCount_" ''MsgLinuxProcessFdCount)
$(makeLenses ''MsgLinuxProcessFdCount)

msgLinuxProcessFdSummary :: Word16
msgLinuxProcessFdSummary :: Word16
msgLinuxProcessFdSummary = Word16
0x7F07

-- | SBP class for message MSG_LINUX_PROCESS_FD_SUMMARY (0x7F07).
--
-- Summary of open file descriptors on the system.
data MsgLinuxProcessFdSummary = MsgLinuxProcessFdSummary
  { MsgLinuxProcessFdSummary -> Word32
_msgLinuxProcessFdSummary_sys_fd_count :: !Word32
    -- ^ count of total FDs open on the system
  , MsgLinuxProcessFdSummary -> Text
_msgLinuxProcessFdSummary_most_opened :: !Text
    -- ^ A null delimited list of strings which alternates between a string
    -- representation of the process count and the file name whose count it
    -- being reported.  That is, in C string syntax
    -- "32\0/var/log/syslog\012\0/tmp/foo\0" with the end of the list being 2
    -- NULL terminators in a row.
  } deriving ( Int -> MsgLinuxProcessFdSummary -> ShowS
[MsgLinuxProcessFdSummary] -> ShowS
MsgLinuxProcessFdSummary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgLinuxProcessFdSummary] -> ShowS
$cshowList :: [MsgLinuxProcessFdSummary] -> ShowS
show :: MsgLinuxProcessFdSummary -> String
$cshow :: MsgLinuxProcessFdSummary -> String
showsPrec :: Int -> MsgLinuxProcessFdSummary -> ShowS
$cshowsPrec :: Int -> MsgLinuxProcessFdSummary -> ShowS
Show, ReadPrec [MsgLinuxProcessFdSummary]
ReadPrec MsgLinuxProcessFdSummary
Int -> ReadS MsgLinuxProcessFdSummary
ReadS [MsgLinuxProcessFdSummary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgLinuxProcessFdSummary]
$creadListPrec :: ReadPrec [MsgLinuxProcessFdSummary]
readPrec :: ReadPrec MsgLinuxProcessFdSummary
$creadPrec :: ReadPrec MsgLinuxProcessFdSummary
readList :: ReadS [MsgLinuxProcessFdSummary]
$creadList :: ReadS [MsgLinuxProcessFdSummary]
readsPrec :: Int -> ReadS MsgLinuxProcessFdSummary
$creadsPrec :: Int -> ReadS MsgLinuxProcessFdSummary
Read, MsgLinuxProcessFdSummary -> MsgLinuxProcessFdSummary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgLinuxProcessFdSummary -> MsgLinuxProcessFdSummary -> Bool
$c/= :: MsgLinuxProcessFdSummary -> MsgLinuxProcessFdSummary -> Bool
== :: MsgLinuxProcessFdSummary -> MsgLinuxProcessFdSummary -> Bool
$c== :: MsgLinuxProcessFdSummary -> MsgLinuxProcessFdSummary -> Bool
Eq )

instance Binary MsgLinuxProcessFdSummary where
  get :: Get MsgLinuxProcessFdSummary
get = do
    Word32
_msgLinuxProcessFdSummary_sys_fd_count <- Get Word32
getWord32le
    Text
_msgLinuxProcessFdSummary_most_opened <- ByteString -> Text
decodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgLinuxProcessFdSummary {Word32
Text
_msgLinuxProcessFdSummary_most_opened :: Text
_msgLinuxProcessFdSummary_sys_fd_count :: Word32
_msgLinuxProcessFdSummary_most_opened :: Text
_msgLinuxProcessFdSummary_sys_fd_count :: Word32
..}

  put :: MsgLinuxProcessFdSummary -> Put
put MsgLinuxProcessFdSummary {Word32
Text
_msgLinuxProcessFdSummary_most_opened :: Text
_msgLinuxProcessFdSummary_sys_fd_count :: Word32
_msgLinuxProcessFdSummary_most_opened :: MsgLinuxProcessFdSummary -> Text
_msgLinuxProcessFdSummary_sys_fd_count :: MsgLinuxProcessFdSummary -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgLinuxProcessFdSummary_sys_fd_count
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgLinuxProcessFdSummary_most_opened

$(makeSBP 'msgLinuxProcessFdSummary ''MsgLinuxProcessFdSummary)
$(makeJSON "_msgLinuxProcessFdSummary_" ''MsgLinuxProcessFdSummary)
$(makeLenses ''MsgLinuxProcessFdSummary)

msgLinuxCpuState :: Word16
msgLinuxCpuState :: Word16
msgLinuxCpuState = Word16
0x7F08

-- | SBP class for message MSG_LINUX_CPU_STATE (0x7F08).
--
-- This message indicates the process state of the top 10 heaviest consumers
-- of CPU on the system, including a timestamp.
data MsgLinuxCpuState = MsgLinuxCpuState
  { MsgLinuxCpuState -> Word8
_msgLinuxCpuState_index :: !Word8
    -- ^ sequence of this status message, values from 0-9
  , MsgLinuxCpuState -> Word16
_msgLinuxCpuState_pid   :: !Word16
    -- ^ the PID of the process
  , MsgLinuxCpuState -> Word8
_msgLinuxCpuState_pcpu  :: !Word8
    -- ^ percent of CPU used, expressed as a fraction of 256
  , MsgLinuxCpuState -> Word32
_msgLinuxCpuState_time  :: !Word32
    -- ^ timestamp of message, refer to flags field for how to interpret
  , MsgLinuxCpuState -> Word8
_msgLinuxCpuState_flags :: !Word8
    -- ^ flags
  , MsgLinuxCpuState -> Text
_msgLinuxCpuState_tname :: !Text
    -- ^ fixed length string representing the thread name
  , MsgLinuxCpuState -> Text
_msgLinuxCpuState_cmdline :: !Text
    -- ^ the command line (as much as it fits in the remaining packet)
  } deriving ( Int -> MsgLinuxCpuState -> ShowS
[MsgLinuxCpuState] -> ShowS
MsgLinuxCpuState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgLinuxCpuState] -> ShowS
$cshowList :: [MsgLinuxCpuState] -> ShowS
show :: MsgLinuxCpuState -> String
$cshow :: MsgLinuxCpuState -> String
showsPrec :: Int -> MsgLinuxCpuState -> ShowS
$cshowsPrec :: Int -> MsgLinuxCpuState -> ShowS
Show, ReadPrec [MsgLinuxCpuState]
ReadPrec MsgLinuxCpuState
Int -> ReadS MsgLinuxCpuState
ReadS [MsgLinuxCpuState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgLinuxCpuState]
$creadListPrec :: ReadPrec [MsgLinuxCpuState]
readPrec :: ReadPrec MsgLinuxCpuState
$creadPrec :: ReadPrec MsgLinuxCpuState
readList :: ReadS [MsgLinuxCpuState]
$creadList :: ReadS [MsgLinuxCpuState]
readsPrec :: Int -> ReadS MsgLinuxCpuState
$creadsPrec :: Int -> ReadS MsgLinuxCpuState
Read, MsgLinuxCpuState -> MsgLinuxCpuState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgLinuxCpuState -> MsgLinuxCpuState -> Bool
$c/= :: MsgLinuxCpuState -> MsgLinuxCpuState -> Bool
== :: MsgLinuxCpuState -> MsgLinuxCpuState -> Bool
$c== :: MsgLinuxCpuState -> MsgLinuxCpuState -> Bool
Eq )

instance Binary MsgLinuxCpuState where
  get :: Get MsgLinuxCpuState
get = do
    Word8
_msgLinuxCpuState_index <- Get Word8
getWord8
    Word16
_msgLinuxCpuState_pid <- Get Word16
getWord16le
    Word8
_msgLinuxCpuState_pcpu <- Get Word8
getWord8
    Word32
_msgLinuxCpuState_time <- Get Word32
getWord32le
    Word8
_msgLinuxCpuState_flags <- Get Word8
getWord8
    Text
_msgLinuxCpuState_tname <- ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
15
    Text
_msgLinuxCpuState_cmdline <- ByteString -> Text
decodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgLinuxCpuState {Word8
Word16
Word32
Text
_msgLinuxCpuState_cmdline :: Text
_msgLinuxCpuState_tname :: Text
_msgLinuxCpuState_flags :: Word8
_msgLinuxCpuState_time :: Word32
_msgLinuxCpuState_pcpu :: Word8
_msgLinuxCpuState_pid :: Word16
_msgLinuxCpuState_index :: Word8
_msgLinuxCpuState_cmdline :: Text
_msgLinuxCpuState_tname :: Text
_msgLinuxCpuState_flags :: Word8
_msgLinuxCpuState_time :: Word32
_msgLinuxCpuState_pcpu :: Word8
_msgLinuxCpuState_pid :: Word16
_msgLinuxCpuState_index :: Word8
..}

  put :: MsgLinuxCpuState -> Put
put MsgLinuxCpuState {Word8
Word16
Word32
Text
_msgLinuxCpuState_cmdline :: Text
_msgLinuxCpuState_tname :: Text
_msgLinuxCpuState_flags :: Word8
_msgLinuxCpuState_time :: Word32
_msgLinuxCpuState_pcpu :: Word8
_msgLinuxCpuState_pid :: Word16
_msgLinuxCpuState_index :: Word8
_msgLinuxCpuState_cmdline :: MsgLinuxCpuState -> Text
_msgLinuxCpuState_tname :: MsgLinuxCpuState -> Text
_msgLinuxCpuState_flags :: MsgLinuxCpuState -> Word8
_msgLinuxCpuState_time :: MsgLinuxCpuState -> Word32
_msgLinuxCpuState_pcpu :: MsgLinuxCpuState -> Word8
_msgLinuxCpuState_pid :: MsgLinuxCpuState -> Word16
_msgLinuxCpuState_index :: MsgLinuxCpuState -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgLinuxCpuState_index
    Word16 -> Put
putWord16le Word16
_msgLinuxCpuState_pid
    Word8 -> Put
putWord8 Word8
_msgLinuxCpuState_pcpu
    Word32 -> Put
putWord32le Word32
_msgLinuxCpuState_time
    Word8 -> Put
putWord8 Word8
_msgLinuxCpuState_flags
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgLinuxCpuState_tname
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgLinuxCpuState_cmdline

$(makeSBP 'msgLinuxCpuState ''MsgLinuxCpuState)
$(makeJSON "_msgLinuxCpuState_" ''MsgLinuxCpuState)
$(makeLenses ''MsgLinuxCpuState)

msgLinuxMemState :: Word16
msgLinuxMemState :: Word16
msgLinuxMemState = Word16
0x7F09

-- | SBP class for message MSG_LINUX_MEM_STATE (0x7F09).
--
-- This message indicates the process state of the top 10 heaviest consumers
-- of memory on the system, including a timestamp.
data MsgLinuxMemState = MsgLinuxMemState
  { MsgLinuxMemState -> Word8
_msgLinuxMemState_index :: !Word8
    -- ^ sequence of this status message, values from 0-9
  , MsgLinuxMemState -> Word16
_msgLinuxMemState_pid   :: !Word16
    -- ^ the PID of the process
  , MsgLinuxMemState -> Word8
_msgLinuxMemState_pmem  :: !Word8
    -- ^ percent of memory used, expressed as a fraction of 256
  , MsgLinuxMemState -> Word32
_msgLinuxMemState_time  :: !Word32
    -- ^ timestamp of message, refer to flags field for how to interpret
  , MsgLinuxMemState -> Word8
_msgLinuxMemState_flags :: !Word8
    -- ^ flags
  , MsgLinuxMemState -> Text
_msgLinuxMemState_tname :: !Text
    -- ^ fixed length string representing the thread name
  , MsgLinuxMemState -> Text
_msgLinuxMemState_cmdline :: !Text
    -- ^ the command line (as much as it fits in the remaining packet)
  } deriving ( Int -> MsgLinuxMemState -> ShowS
[MsgLinuxMemState] -> ShowS
MsgLinuxMemState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgLinuxMemState] -> ShowS
$cshowList :: [MsgLinuxMemState] -> ShowS
show :: MsgLinuxMemState -> String
$cshow :: MsgLinuxMemState -> String
showsPrec :: Int -> MsgLinuxMemState -> ShowS
$cshowsPrec :: Int -> MsgLinuxMemState -> ShowS
Show, ReadPrec [MsgLinuxMemState]
ReadPrec MsgLinuxMemState
Int -> ReadS MsgLinuxMemState
ReadS [MsgLinuxMemState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgLinuxMemState]
$creadListPrec :: ReadPrec [MsgLinuxMemState]
readPrec :: ReadPrec MsgLinuxMemState
$creadPrec :: ReadPrec MsgLinuxMemState
readList :: ReadS [MsgLinuxMemState]
$creadList :: ReadS [MsgLinuxMemState]
readsPrec :: Int -> ReadS MsgLinuxMemState
$creadsPrec :: Int -> ReadS MsgLinuxMemState
Read, MsgLinuxMemState -> MsgLinuxMemState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgLinuxMemState -> MsgLinuxMemState -> Bool
$c/= :: MsgLinuxMemState -> MsgLinuxMemState -> Bool
== :: MsgLinuxMemState -> MsgLinuxMemState -> Bool
$c== :: MsgLinuxMemState -> MsgLinuxMemState -> Bool
Eq )

instance Binary MsgLinuxMemState where
  get :: Get MsgLinuxMemState
get = do
    Word8
_msgLinuxMemState_index <- Get Word8
getWord8
    Word16
_msgLinuxMemState_pid <- Get Word16
getWord16le
    Word8
_msgLinuxMemState_pmem <- Get Word8
getWord8
    Word32
_msgLinuxMemState_time <- Get Word32
getWord32le
    Word8
_msgLinuxMemState_flags <- Get Word8
getWord8
    Text
_msgLinuxMemState_tname <- ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
15
    Text
_msgLinuxMemState_cmdline <- ByteString -> Text
decodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgLinuxMemState {Word8
Word16
Word32
Text
_msgLinuxMemState_cmdline :: Text
_msgLinuxMemState_tname :: Text
_msgLinuxMemState_flags :: Word8
_msgLinuxMemState_time :: Word32
_msgLinuxMemState_pmem :: Word8
_msgLinuxMemState_pid :: Word16
_msgLinuxMemState_index :: Word8
_msgLinuxMemState_cmdline :: Text
_msgLinuxMemState_tname :: Text
_msgLinuxMemState_flags :: Word8
_msgLinuxMemState_time :: Word32
_msgLinuxMemState_pmem :: Word8
_msgLinuxMemState_pid :: Word16
_msgLinuxMemState_index :: Word8
..}

  put :: MsgLinuxMemState -> Put
put MsgLinuxMemState {Word8
Word16
Word32
Text
_msgLinuxMemState_cmdline :: Text
_msgLinuxMemState_tname :: Text
_msgLinuxMemState_flags :: Word8
_msgLinuxMemState_time :: Word32
_msgLinuxMemState_pmem :: Word8
_msgLinuxMemState_pid :: Word16
_msgLinuxMemState_index :: Word8
_msgLinuxMemState_cmdline :: MsgLinuxMemState -> Text
_msgLinuxMemState_tname :: MsgLinuxMemState -> Text
_msgLinuxMemState_flags :: MsgLinuxMemState -> Word8
_msgLinuxMemState_time :: MsgLinuxMemState -> Word32
_msgLinuxMemState_pmem :: MsgLinuxMemState -> Word8
_msgLinuxMemState_pid :: MsgLinuxMemState -> Word16
_msgLinuxMemState_index :: MsgLinuxMemState -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgLinuxMemState_index
    Word16 -> Put
putWord16le Word16
_msgLinuxMemState_pid
    Word8 -> Put
putWord8 Word8
_msgLinuxMemState_pmem
    Word32 -> Put
putWord32le Word32
_msgLinuxMemState_time
    Word8 -> Put
putWord8 Word8
_msgLinuxMemState_flags
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgLinuxMemState_tname
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgLinuxMemState_cmdline

$(makeSBP 'msgLinuxMemState ''MsgLinuxMemState)
$(makeJSON "_msgLinuxMemState_" ''MsgLinuxMemState)
$(makeLenses ''MsgLinuxMemState)

msgLinuxSysState :: Word16
msgLinuxSysState :: Word16
msgLinuxSysState = Word16
0x7F0A

-- | SBP class for message MSG_LINUX_SYS_STATE (0x7F0A).
--
-- This presents a summary of CPU and memory utilization, including a
-- timestamp.
data MsgLinuxSysState = MsgLinuxSysState
  { MsgLinuxSysState -> Word16
_msgLinuxSysState_mem_total    :: !Word16
    -- ^ total system memory, in MiB
  , MsgLinuxSysState -> Word8
_msgLinuxSysState_pcpu         :: !Word8
    -- ^ percent of CPU used, expressed as a fraction of 256
  , MsgLinuxSysState -> Word8
_msgLinuxSysState_pmem         :: !Word8
    -- ^ percent of memory used, expressed as a fraction of 256
  , MsgLinuxSysState -> Word16
_msgLinuxSysState_procs_starting :: !Word16
    -- ^ number of processes that started during collection phase
  , MsgLinuxSysState -> Word16
_msgLinuxSysState_procs_stopping :: !Word16
    -- ^ number of processes that stopped during collection phase
  , MsgLinuxSysState -> Word16
_msgLinuxSysState_pid_count    :: !Word16
    -- ^ the count of processes on the system
  , MsgLinuxSysState -> Word32
_msgLinuxSysState_time         :: !Word32
    -- ^ timestamp of message, refer to flags field for how to interpret
  , MsgLinuxSysState -> Word8
_msgLinuxSysState_flags        :: !Word8
    -- ^ flags
  } deriving ( Int -> MsgLinuxSysState -> ShowS
[MsgLinuxSysState] -> ShowS
MsgLinuxSysState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgLinuxSysState] -> ShowS
$cshowList :: [MsgLinuxSysState] -> ShowS
show :: MsgLinuxSysState -> String
$cshow :: MsgLinuxSysState -> String
showsPrec :: Int -> MsgLinuxSysState -> ShowS
$cshowsPrec :: Int -> MsgLinuxSysState -> ShowS
Show, ReadPrec [MsgLinuxSysState]
ReadPrec MsgLinuxSysState
Int -> ReadS MsgLinuxSysState
ReadS [MsgLinuxSysState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgLinuxSysState]
$creadListPrec :: ReadPrec [MsgLinuxSysState]
readPrec :: ReadPrec MsgLinuxSysState
$creadPrec :: ReadPrec MsgLinuxSysState
readList :: ReadS [MsgLinuxSysState]
$creadList :: ReadS [MsgLinuxSysState]
readsPrec :: Int -> ReadS MsgLinuxSysState
$creadsPrec :: Int -> ReadS MsgLinuxSysState
Read, MsgLinuxSysState -> MsgLinuxSysState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgLinuxSysState -> MsgLinuxSysState -> Bool
$c/= :: MsgLinuxSysState -> MsgLinuxSysState -> Bool
== :: MsgLinuxSysState -> MsgLinuxSysState -> Bool
$c== :: MsgLinuxSysState -> MsgLinuxSysState -> Bool
Eq )

instance Binary MsgLinuxSysState where
  get :: Get MsgLinuxSysState
get = do
    Word16
_msgLinuxSysState_mem_total <- Get Word16
getWord16le
    Word8
_msgLinuxSysState_pcpu <- Get Word8
getWord8
    Word8
_msgLinuxSysState_pmem <- Get Word8
getWord8
    Word16
_msgLinuxSysState_procs_starting <- Get Word16
getWord16le
    Word16
_msgLinuxSysState_procs_stopping <- Get Word16
getWord16le
    Word16
_msgLinuxSysState_pid_count <- Get Word16
getWord16le
    Word32
_msgLinuxSysState_time <- Get Word32
getWord32le
    Word8
_msgLinuxSysState_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgLinuxSysState {Word8
Word16
Word32
_msgLinuxSysState_flags :: Word8
_msgLinuxSysState_time :: Word32
_msgLinuxSysState_pid_count :: Word16
_msgLinuxSysState_procs_stopping :: Word16
_msgLinuxSysState_procs_starting :: Word16
_msgLinuxSysState_pmem :: Word8
_msgLinuxSysState_pcpu :: Word8
_msgLinuxSysState_mem_total :: Word16
_msgLinuxSysState_flags :: Word8
_msgLinuxSysState_time :: Word32
_msgLinuxSysState_pid_count :: Word16
_msgLinuxSysState_procs_stopping :: Word16
_msgLinuxSysState_procs_starting :: Word16
_msgLinuxSysState_pmem :: Word8
_msgLinuxSysState_pcpu :: Word8
_msgLinuxSysState_mem_total :: Word16
..}

  put :: MsgLinuxSysState -> Put
put MsgLinuxSysState {Word8
Word16
Word32
_msgLinuxSysState_flags :: Word8
_msgLinuxSysState_time :: Word32
_msgLinuxSysState_pid_count :: Word16
_msgLinuxSysState_procs_stopping :: Word16
_msgLinuxSysState_procs_starting :: Word16
_msgLinuxSysState_pmem :: Word8
_msgLinuxSysState_pcpu :: Word8
_msgLinuxSysState_mem_total :: Word16
_msgLinuxSysState_flags :: MsgLinuxSysState -> Word8
_msgLinuxSysState_time :: MsgLinuxSysState -> Word32
_msgLinuxSysState_pid_count :: MsgLinuxSysState -> Word16
_msgLinuxSysState_procs_stopping :: MsgLinuxSysState -> Word16
_msgLinuxSysState_procs_starting :: MsgLinuxSysState -> Word16
_msgLinuxSysState_pmem :: MsgLinuxSysState -> Word8
_msgLinuxSysState_pcpu :: MsgLinuxSysState -> Word8
_msgLinuxSysState_mem_total :: MsgLinuxSysState -> Word16
..} = do
    Word16 -> Put
putWord16le Word16
_msgLinuxSysState_mem_total
    Word8 -> Put
putWord8 Word8
_msgLinuxSysState_pcpu
    Word8 -> Put
putWord8 Word8
_msgLinuxSysState_pmem
    Word16 -> Put
putWord16le Word16
_msgLinuxSysState_procs_starting
    Word16 -> Put
putWord16le Word16
_msgLinuxSysState_procs_stopping
    Word16 -> Put
putWord16le Word16
_msgLinuxSysState_pid_count
    Word32 -> Put
putWord32le Word32
_msgLinuxSysState_time
    Word8 -> Put
putWord8 Word8
_msgLinuxSysState_flags

$(makeSBP 'msgLinuxSysState ''MsgLinuxSysState)
$(makeJSON "_msgLinuxSysState_" ''MsgLinuxSysState)
$(makeLenses ''MsgLinuxSysState)