{-# LANGUAGE CPP #-}
module System.Linux.Netlink.GeNetlink.NL80211.StaInfo
( StaInfo (..)
, SignalWidth (..)
, Signal (..)
, StaRate (..)
, signalFromAttributes
, staRateFromAttributes
, staInfoFromAttributes
, getStaInfo
, staInfoFromPacket
)
where
import Data.ByteString (ByteString)
import Data.Serialize.Get (Get, runGet)
import Data.Maybe (fromMaybe)
import qualified Data.Map as M
import Control.Applicative ((<|>))
import System.Linux.Netlink
import System.Linux.Netlink.GeNetlink.NL80211.WifiEI
import System.Linux.Netlink.GeNetlink.NL80211.Constants
import Data.Word
import Data.Serialize.Get
#if MIN_VERSION_base(4,8,0)
#else
import Control.Applicative ((<$>))
#endif
newtype Signal = Signal [Word8] deriving (Int -> Signal -> ShowS
[Signal] -> ShowS
Signal -> String
(Int -> Signal -> ShowS)
-> (Signal -> String) -> ([Signal] -> ShowS) -> Show Signal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signal -> ShowS
showsPrec :: Int -> Signal -> ShowS
$cshow :: Signal -> String
show :: Signal -> String
$cshowList :: [Signal] -> ShowS
showList :: [Signal] -> ShowS
Show, Signal -> Signal -> Bool
(Signal -> Signal -> Bool)
-> (Signal -> Signal -> Bool) -> Eq Signal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signal -> Signal -> Bool
== :: Signal -> Signal -> Bool
$c/= :: Signal -> Signal -> Bool
/= :: Signal -> Signal -> Bool
Eq, ReadPrec [Signal]
ReadPrec Signal
Int -> ReadS Signal
ReadS [Signal]
(Int -> ReadS Signal)
-> ReadS [Signal]
-> ReadPrec Signal
-> ReadPrec [Signal]
-> Read Signal
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Signal
readsPrec :: Int -> ReadS Signal
$creadList :: ReadS [Signal]
readList :: ReadS [Signal]
$creadPrec :: ReadPrec Signal
readPrec :: ReadPrec Signal
$creadListPrec :: ReadPrec [Signal]
readListPrec :: ReadPrec [Signal]
Read)
signalFromAttributes :: Attributes -> Signal
signalFromAttributes :: Attributes -> Signal
signalFromAttributes Attributes
attrs =
let bss :: [ByteString]
bss = ((Int, ByteString) -> ByteString)
-> [(Int, ByteString)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ([(Int, ByteString)] -> [ByteString])
-> (Attributes -> [(Int, ByteString)])
-> Attributes
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> [(Int, ByteString)]
forall k a. Map k a -> [(k, a)]
M.toList (Attributes -> [ByteString]) -> Attributes -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Attributes
attrs
eth :: [Either String Word8]
eth = (ByteString -> Either String Word8)
-> [ByteString] -> [Either String Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Get Word8 -> ByteString -> Either String Word8
forall a. Get a -> ByteString -> Either String a
runGet Get Word8
getWord8) [ByteString]
bss
in [Word8] -> Signal
Signal ([Word8] -> Signal)
-> ([Either String Word8] -> [Word8])
-> [Either String Word8]
-> Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either String Word8 -> Word8) -> [Either String Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Either String Word8 -> Word8
forall {b}. Either String b -> b
getRight ([Either String Word8] -> Signal)
-> [Either String Word8] -> Signal
forall a b. (a -> b) -> a -> b
$ [Either String Word8]
eth
where getRight :: Either String b -> b
getRight (Right b
x) = b
x
getRight (Left String
x) = String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
"Failed to decode signal: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
data SignalWidth
= Width5MHz
| Width10MHz
| Width20MHz
| Width40MHz
| Width80MHz
| Width160MHz
deriving (Int -> SignalWidth -> ShowS
[SignalWidth] -> ShowS
SignalWidth -> String
(Int -> SignalWidth -> ShowS)
-> (SignalWidth -> String)
-> ([SignalWidth] -> ShowS)
-> Show SignalWidth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignalWidth -> ShowS
showsPrec :: Int -> SignalWidth -> ShowS
$cshow :: SignalWidth -> String
show :: SignalWidth -> String
$cshowList :: [SignalWidth] -> ShowS
showList :: [SignalWidth] -> ShowS
Show, SignalWidth -> SignalWidth -> Bool
(SignalWidth -> SignalWidth -> Bool)
-> (SignalWidth -> SignalWidth -> Bool) -> Eq SignalWidth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignalWidth -> SignalWidth -> Bool
== :: SignalWidth -> SignalWidth -> Bool
$c/= :: SignalWidth -> SignalWidth -> Bool
/= :: SignalWidth -> SignalWidth -> Bool
Eq, ReadPrec [SignalWidth]
ReadPrec SignalWidth
Int -> ReadS SignalWidth
ReadS [SignalWidth]
(Int -> ReadS SignalWidth)
-> ReadS [SignalWidth]
-> ReadPrec SignalWidth
-> ReadPrec [SignalWidth]
-> Read SignalWidth
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SignalWidth
readsPrec :: Int -> ReadS SignalWidth
$creadList :: ReadS [SignalWidth]
readList :: ReadS [SignalWidth]
$creadPrec :: ReadPrec SignalWidth
readPrec :: ReadPrec SignalWidth
$creadListPrec :: ReadPrec [SignalWidth]
readListPrec :: ReadPrec [SignalWidth]
Read)
widthFromAttributes :: Attributes -> SignalWidth
widthFromAttributes :: Attributes -> SignalWidth
widthFromAttributes Attributes
attrs =
let five :: Maybe SignalWidth
five = SignalWidth -> Int -> Maybe SignalWidth
opt SignalWidth
Width5MHz Int
forall a. Num a => a
eNL80211_RATE_INFO_5_MHZ_WIDTH
ten :: Maybe SignalWidth
ten = SignalWidth -> Int -> Maybe SignalWidth
opt SignalWidth
Width10MHz Int
forall a. Num a => a
eNL80211_RATE_INFO_10_MHZ_WIDTH
forty :: Maybe SignalWidth
forty = SignalWidth -> Int -> Maybe SignalWidth
opt SignalWidth
Width40MHz Int
forall a. Num a => a
eNL80211_RATE_INFO_40_MHZ_WIDTH
eighty :: Maybe SignalWidth
eighty = SignalWidth -> Int -> Maybe SignalWidth
opt SignalWidth
Width80MHz Int
forall a. Num a => a
eNL80211_RATE_INFO_80_MHZ_WIDTH
osixty :: Maybe SignalWidth
osixty = SignalWidth -> Int -> Maybe SignalWidth
opt SignalWidth
Width160MHz Int
forall a. Num a => a
eNL80211_RATE_INFO_160_MHZ_WIDTH
alls :: [Maybe SignalWidth]
alls = [Maybe SignalWidth
five, Maybe SignalWidth
ten, Maybe SignalWidth
forty, Maybe SignalWidth
eighty, Maybe SignalWidth
osixty]
in SignalWidth -> Maybe SignalWidth -> SignalWidth
forall a. a -> Maybe a -> a
fromMaybe SignalWidth
Width20MHz (Maybe SignalWidth -> SignalWidth)
-> Maybe SignalWidth -> SignalWidth
forall a b. (a -> b) -> a -> b
$ (Maybe SignalWidth -> Maybe SignalWidth -> Maybe SignalWidth)
-> [Maybe SignalWidth] -> Maybe SignalWidth
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Maybe SignalWidth -> Maybe SignalWidth -> Maybe SignalWidth
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) [Maybe SignalWidth]
alls
where opt :: SignalWidth -> Int -> Maybe SignalWidth
opt :: SignalWidth -> Int -> Maybe SignalWidth
opt SignalWidth
c Int
e = (ByteString -> SignalWidth)
-> Maybe ByteString -> Maybe SignalWidth
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SignalWidth -> ByteString -> SignalWidth
forall a b. a -> b -> a
const SignalWidth
c) (Maybe ByteString -> Maybe SignalWidth)
-> (Attributes -> Maybe ByteString)
-> Attributes
-> Maybe SignalWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Attributes -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
e (Attributes -> Maybe SignalWidth)
-> Attributes -> Maybe SignalWidth
forall a b. (a -> b) -> a -> b
$ Attributes
attrs
data StaRate = StaRate
{
StaRate -> Maybe Word32
rateBitrate :: Maybe Word32
, StaRate -> SignalWidth
rateWidthFlag :: SignalWidth
, StaRate -> Maybe Word8
rateMCS :: Maybe Word8
, StaRate -> Bool
rateShortGI :: Bool
, StaRate -> Maybe Word8
rateVHTMCS :: Maybe Word8
, StaRate -> Maybe Word8
rateVHTNSS :: Maybe Word8
, StaRate -> Attributes
rateSelf :: Attributes
} deriving (Int -> StaRate -> ShowS
[StaRate] -> ShowS
StaRate -> String
(Int -> StaRate -> ShowS)
-> (StaRate -> String) -> ([StaRate] -> ShowS) -> Show StaRate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StaRate -> ShowS
showsPrec :: Int -> StaRate -> ShowS
$cshow :: StaRate -> String
show :: StaRate -> String
$cshowList :: [StaRate] -> ShowS
showList :: [StaRate] -> ShowS
Show, StaRate -> StaRate -> Bool
(StaRate -> StaRate -> Bool)
-> (StaRate -> StaRate -> Bool) -> Eq StaRate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StaRate -> StaRate -> Bool
== :: StaRate -> StaRate -> Bool
$c/= :: StaRate -> StaRate -> Bool
/= :: StaRate -> StaRate -> Bool
Eq, ReadPrec [StaRate]
ReadPrec StaRate
Int -> ReadS StaRate
ReadS [StaRate]
(Int -> ReadS StaRate)
-> ReadS [StaRate]
-> ReadPrec StaRate
-> ReadPrec [StaRate]
-> Read StaRate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StaRate
readsPrec :: Int -> ReadS StaRate
$creadList :: ReadS [StaRate]
readList :: ReadS [StaRate]
$creadPrec :: ReadPrec StaRate
readPrec :: ReadPrec StaRate
$creadListPrec :: ReadPrec [StaRate]
readListPrec :: ReadPrec [StaRate]
Read)
staRateFromAttributes :: Attributes -> StaRate
staRateFromAttributes :: Attributes -> StaRate
staRateFromAttributes Attributes
attrs =
let rate16 :: Maybe Word16
rate16 = Get Word16 -> Int -> Maybe Word16
forall a. Get a -> Int -> Maybe a
getField Get Word16
getWord16host Int
forall a. Num a => a
eNL80211_RATE_INFO_BITRATE
rate32 :: Maybe Word32
rate32 = Get Word32 -> Int -> Maybe Word32
forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host Int
forall a. Num a => a
eNL80211_RATE_INFO_BITRATE32
rate :: Maybe Word32
rate = Maybe Word32
rate32 Maybe Word32 -> Maybe Word32 -> Maybe Word32
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word16 -> Word32) -> Maybe Word16 -> Maybe Word32
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word16
rate16
width :: SignalWidth
width = Attributes -> SignalWidth
widthFromAttributes Attributes
attrs
mcs :: Maybe Word8
mcs = Get Word8 -> Int -> Maybe Word8
forall a. Get a -> Int -> Maybe a
getField Get Word8
getWord8 Int
forall a. Num a => a
eNL80211_RATE_INFO_MCS
shortGI :: Bool
shortGI = Int -> Attributes -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Int
forall a. Num a => a
eNL80211_RATE_INFO_SHORT_GI Attributes
attrs
vhtmcs :: Maybe Word8
vhtmcs = Get Word8 -> Int -> Maybe Word8
forall a. Get a -> Int -> Maybe a
getField Get Word8
getWord8 Int
forall a. Num a => a
eNL80211_RATE_INFO_VHT_MCS
vhtnss :: Maybe Word8
vhtnss = Get Word8 -> Int -> Maybe Word8
forall a. Get a -> Int -> Maybe a
getField Get Word8
getWord8 Int
forall a. Num a => a
eNL80211_RATE_INFO_VHT_NSS
in Maybe Word32
-> SignalWidth
-> Maybe Word8
-> Bool
-> Maybe Word8
-> Maybe Word8
-> Attributes
-> StaRate
StaRate Maybe Word32
rate SignalWidth
width Maybe Word8
mcs Bool
shortGI Maybe Word8
vhtmcs Maybe Word8
vhtnss Attributes
attrs
where getField :: Get a -> Int -> Maybe a
getField :: forall a. Get a -> Int -> Maybe a
getField Get a
g Int
e = (ByteString -> a) -> Maybe ByteString -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either String a -> a
forall {b}. Either String b -> b
getRight (Either String a -> a)
-> (ByteString -> Either String a) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGet Get a
g) (Maybe ByteString -> Maybe a)
-> (Attributes -> Maybe ByteString) -> Attributes -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Attributes -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
e (Attributes -> Maybe a) -> Attributes -> Maybe a
forall a b. (a -> b) -> a -> b
$ Attributes
attrs
getRight :: Either String a -> a
getRight :: forall {b}. Either String b -> b
getRight (Right a
x) = a
x
getRight (Left String
x) = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse something in StaRate: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
data StaInfo = StaInfo
{
StaInfo -> Maybe Word32
staConTime :: Maybe Word32
, StaInfo -> Maybe Word32
staInaTime :: Maybe Word32
, StaInfo -> Maybe Word64
staRXBytes :: Maybe Word64
, StaInfo -> Maybe Word64
staTXBytes :: Maybe Word64
, StaInfo -> Maybe Word16
staLLID :: Maybe Word16
, StaInfo -> Maybe Word16
staPLID :: Maybe Word16
, StaInfo -> Maybe Word8
staPLState :: Maybe Word8
, StaInfo -> Maybe Word64
staRXDur :: Maybe Word64
, StaInfo -> Maybe Word8
staSignalMBM :: Maybe Word8
, StaInfo -> Maybe Word8
staSignalMBMA :: Maybe Word8
, StaInfo -> Maybe Signal
staSignal :: Maybe Signal
, StaInfo -> Maybe Signal
staSignalAvg :: Maybe Signal
, StaInfo -> Maybe StaRate
staTXRate :: Maybe StaRate
, StaInfo -> Maybe StaRate
staRXRate :: Maybe StaRate
, StaInfo -> Maybe Word32
staRXPackets :: Maybe Word32
, StaInfo -> Maybe Word32
staTXPackets :: Maybe Word32
, StaInfo -> Maybe Word32
staTXRetries :: Maybe Word32
, StaInfo -> Maybe Word32
staTXFailed :: Maybe Word32
, StaInfo -> Maybe Word32
staExpectTP :: Maybe Word32
, StaInfo -> Maybe Word32
staBeaconLoss :: Maybe Word32
, StaInfo -> Maybe Word32
staLocalPM :: Maybe Word32
, StaInfo -> Maybe Word32
staPeerPM :: Maybe Word32
, StaInfo -> Maybe Word32
staNonPeerPM :: Maybe Word32
, StaInfo -> Maybe Attributes
staBssAttrs :: Maybe Attributes
, StaInfo -> Maybe ByteString
staInfoFlags :: Maybe ByteString
, StaInfo -> Maybe Word64
staTOffset :: Maybe Word64
, StaInfo -> Maybe Word64
staRXDropMisc :: Maybe Word64
, StaInfo -> Maybe Word64
staBeaconRX :: Maybe Word64
, StaInfo -> Maybe Word8
staBSignalAvg :: Maybe Word8
, StaInfo -> Maybe Attributes
staTidStats :: Maybe Attributes
, StaInfo -> Maybe Attributes
staAssocIES :: Maybe Attributes
, StaInfo -> Attributes
staSelf :: Attributes
} deriving (Int -> StaInfo -> ShowS
[StaInfo] -> ShowS
StaInfo -> String
(Int -> StaInfo -> ShowS)
-> (StaInfo -> String) -> ([StaInfo] -> ShowS) -> Show StaInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StaInfo -> ShowS
showsPrec :: Int -> StaInfo -> ShowS
$cshow :: StaInfo -> String
show :: StaInfo -> String
$cshowList :: [StaInfo] -> ShowS
showList :: [StaInfo] -> ShowS
Show, StaInfo -> StaInfo -> Bool
(StaInfo -> StaInfo -> Bool)
-> (StaInfo -> StaInfo -> Bool) -> Eq StaInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StaInfo -> StaInfo -> Bool
== :: StaInfo -> StaInfo -> Bool
$c/= :: StaInfo -> StaInfo -> Bool
/= :: StaInfo -> StaInfo -> Bool
Eq, ReadPrec [StaInfo]
ReadPrec StaInfo
Int -> ReadS StaInfo
ReadS [StaInfo]
(Int -> ReadS StaInfo)
-> ReadS [StaInfo]
-> ReadPrec StaInfo
-> ReadPrec [StaInfo]
-> Read StaInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StaInfo
readsPrec :: Int -> ReadS StaInfo
$creadList :: ReadS [StaInfo]
readList :: ReadS [StaInfo]
$creadPrec :: ReadPrec StaInfo
readPrec :: ReadPrec StaInfo
$creadListPrec :: ReadPrec [StaInfo]
readListPrec :: ReadPrec [StaInfo]
Read)
staInfoFromAttributes :: Attributes -> StaInfo
staInfoFromAttributes :: Attributes -> StaInfo
staInfoFromAttributes Attributes
attrs =
let conTime :: Maybe Word32
conTime = Get Word32 -> Int -> Maybe Word32
forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host Int
forall a. Num a => a
eNL80211_STA_INFO_CONNECTED_TIME
inaTime :: Maybe Word32
inaTime = Get Word32 -> Int -> Maybe Word32
forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host Int
forall a. Num a => a
eNL80211_STA_INFO_INACTIVE_TIME
rxB32 :: Maybe Word32
rxB32 = Get Word32 -> Int -> Maybe Word32
forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host Int
forall a. Num a => a
eNL80211_STA_INFO_RX_BYTES
txB32 :: Maybe Word32
txB32 = Get Word32 -> Int -> Maybe Word32
forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host Int
forall a. Num a => a
eNL80211_STA_INFO_TX_BYTES
rxB64 :: Maybe Word64
rxB64 = Get Word64 -> Int -> Maybe Word64
forall a. Get a -> Int -> Maybe a
getField Get Word64
getWord64host Int
forall a. Num a => a
eNL80211_STA_INFO_RX_BYTES64
txB64 :: Maybe Word64
txB64 = Get Word64 -> Int -> Maybe Word64
forall a. Get a -> Int -> Maybe a
getField Get Word64
getWord64host Int
forall a. Num a => a
eNL80211_STA_INFO_TX_BYTES64
rxBytes :: Maybe Word64
rxBytes = Maybe Word64
rxB64 Maybe Word64 -> Maybe Word64 -> Maybe Word64
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word32 -> Word64) -> Maybe Word32 -> Maybe Word64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word32
rxB32
txBytes :: Maybe Word64
txBytes = Maybe Word64
txB64 Maybe Word64 -> Maybe Word64 -> Maybe Word64
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word32 -> Word64) -> Maybe Word32 -> Maybe Word64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word32
txB32
llid :: Maybe Word16
llid = Get Word16 -> Int -> Maybe Word16
forall a. Get a -> Int -> Maybe a
getField Get Word16
getWord16host Int
forall a. Num a => a
eNL80211_STA_INFO_LLID
plid :: Maybe Word16
plid = Get Word16 -> Int -> Maybe Word16
forall a. Get a -> Int -> Maybe a
getField Get Word16
getWord16host Int
forall a. Num a => a
eNL80211_STA_INFO_PLID
lstate :: Maybe Word8
lstate = Get Word8 -> Int -> Maybe Word8
forall a. Get a -> Int -> Maybe a
getField Get Word8
getWord8 Int
forall a. Num a => a
eNL80211_STA_INFO_PLINK_STATE
rxDur :: Maybe Word64
rxDur = Get Word64 -> Int -> Maybe Word64
forall a. Get a -> Int -> Maybe a
getField Get Word64
getWord64host Int
forall a. Num a => a
eNL80211_STA_INFO_RX_DURATION
sigMBM :: Maybe Word8
sigMBM = Get Word8 -> Int -> Maybe Word8
forall a. Get a -> Int -> Maybe a
getField Get Word8
getWord8 Int
forall a. Num a => a
eNL80211_STA_INFO_SIGNAL
sigMBMA :: Maybe Word8
sigMBMA = Get Word8 -> Int -> Maybe Word8
forall a. Get a -> Int -> Maybe a
getField Get Word8
getWord8 Int
forall a. Num a => a
eNL80211_STA_INFO_SIGNAL_AVG
sigBS :: Maybe Attributes
sigBS = Get Attributes -> Int -> Maybe Attributes
forall a. Get a -> Int -> Maybe a
getField Get Attributes
getAttributes Int
forall a. Num a => a
eNL80211_STA_INFO_CHAIN_SIGNAL
sigBSA :: Maybe Attributes
sigBSA = Get Attributes -> Int -> Maybe Attributes
forall a. Get a -> Int -> Maybe a
getField Get Attributes
getAttributes Int
forall a. Num a => a
eNL80211_STA_INFO_CHAIN_SIGNAL_AVG
txr :: Maybe Attributes
txr = Get Attributes -> Int -> Maybe Attributes
forall a. Get a -> Int -> Maybe a
getField Get Attributes
getAttributes Int
forall a. Num a => a
eNL80211_STA_INFO_TX_BITRATE
rxr :: Maybe Attributes
rxr = Get Attributes -> Int -> Maybe Attributes
forall a. Get a -> Int -> Maybe a
getField Get Attributes
getAttributes Int
forall a. Num a => a
eNL80211_STA_INFO_RX_BITRATE
rxpack :: Maybe Word32
rxpack = Get Word32 -> Int -> Maybe Word32
forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host Int
forall a. Num a => a
eNL80211_STA_INFO_RX_PACKETS
txpack :: Maybe Word32
txpack = Get Word32 -> Int -> Maybe Word32
forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host Int
forall a. Num a => a
eNL80211_STA_INFO_TX_PACKETS
txretr :: Maybe Word32
txretr = Get Word32 -> Int -> Maybe Word32
forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host Int
forall a. Num a => a
eNL80211_STA_INFO_TX_RETRIES
txfail :: Maybe Word32
txfail = Get Word32 -> Int -> Maybe Word32
forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host Int
forall a. Num a => a
eNL80211_STA_INFO_TX_FAILED
exptp :: Maybe Word32
exptp = Get Word32 -> Int -> Maybe Word32
forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host Int
forall a. Num a => a
eNL80211_STA_INFO_EXPECTED_THROUGHPUT
beloss :: Maybe Word32
beloss = Get Word32 -> Int -> Maybe Word32
forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host Int
forall a. Num a => a
eNL80211_STA_INFO_BEACON_LOSS
localpm :: Maybe Word32
localpm = Get Word32 -> Int -> Maybe Word32
forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host Int
forall a. Num a => a
eNL80211_STA_INFO_LOCAL_PM
peerpm :: Maybe Word32
peerpm = Get Word32 -> Int -> Maybe Word32
forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host Int
forall a. Num a => a
eNL80211_STA_INFO_PEER_PM
npeerpm :: Maybe Word32
npeerpm = Get Word32 -> Int -> Maybe Word32
forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host Int
forall a. Num a => a
eNL80211_STA_INFO_NONPEER_PM
bsspar :: Maybe Attributes
bsspar = Get Attributes -> Int -> Maybe Attributes
forall a. Get a -> Int -> Maybe a
getField Get Attributes
getAttributes Int
forall a. Num a => a
eNL80211_STA_INFO_BSS_PARAM
flags :: Maybe ByteString
flags = Int -> Attributes -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
forall a. Num a => a
eNL80211_STA_INFO_STA_FLAGS Attributes
attrs
toff :: Maybe Word64
toff = Get Word64 -> Int -> Maybe Word64
forall a. Get a -> Int -> Maybe a
getField Get Word64
getWord64host Int
forall a. Num a => a
eNL80211_STA_INFO_T_OFFSET
rxdrop :: Maybe Word64
rxdrop = Get Word64 -> Int -> Maybe Word64
forall a. Get a -> Int -> Maybe a
getField Get Word64
getWord64host Int
forall a. Num a => a
eNL80211_STA_INFO_RX_DROP_MISC
beacr :: Maybe Word64
beacr = Get Word64 -> Int -> Maybe Word64
forall a. Get a -> Int -> Maybe a
getField Get Word64
getWord64host Int
forall a. Num a => a
eNL80211_STA_INFO_BEACON_RX
beacsa :: Maybe Word8
beacsa = Get Word8 -> Int -> Maybe Word8
forall a. Get a -> Int -> Maybe a
getField Get Word8
getWord8 Int
forall a. Num a => a
eNL80211_STA_INFO_BEACON_SIGNAL_AVG
tidStat :: Maybe Attributes
tidStat = Get Attributes -> Int -> Maybe Attributes
forall a. Get a -> Int -> Maybe a
getField Get Attributes
getAttributes Int
forall a. Num a => a
eNL80211_STA_INFO_TID_STATS
associe :: Maybe Attributes
associe = Get Attributes -> Int -> Maybe Attributes
forall a. Get a -> Int -> Maybe a
getField Get Attributes
getWifiEIDs Int
forall a. Num a => a
eNL80211_ATTR_IE
in Maybe Word32
-> Maybe Word32
-> Maybe Word64
-> Maybe Word64
-> Maybe Word16
-> Maybe Word16
-> Maybe Word8
-> Maybe Word64
-> Maybe Word8
-> Maybe Word8
-> Maybe Signal
-> Maybe Signal
-> Maybe StaRate
-> Maybe StaRate
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Attributes
-> Maybe ByteString
-> Maybe Word64
-> Maybe Word64
-> Maybe Word64
-> Maybe Word8
-> Maybe Attributes
-> Maybe Attributes
-> Attributes
-> StaInfo
StaInfo
Maybe Word32
conTime Maybe Word32
inaTime Maybe Word64
rxBytes Maybe Word64
txBytes Maybe Word16
llid Maybe Word16
plid
Maybe Word8
lstate Maybe Word64
rxDur Maybe Word8
sigMBM Maybe Word8
sigMBMA
(Attributes -> Signal
signalFromAttributes (Attributes -> Signal) -> Maybe Attributes -> Maybe Signal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Attributes
sigBS)
(Attributes -> Signal
signalFromAttributes (Attributes -> Signal) -> Maybe Attributes -> Maybe Signal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Attributes
sigBSA)
(Attributes -> StaRate
staRateFromAttributes (Attributes -> StaRate) -> Maybe Attributes -> Maybe StaRate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Attributes
txr)
(Attributes -> StaRate
staRateFromAttributes (Attributes -> StaRate) -> Maybe Attributes -> Maybe StaRate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Attributes
rxr)
Maybe Word32
rxpack Maybe Word32
txpack Maybe Word32
txretr Maybe Word32
txfail Maybe Word32
exptp Maybe Word32
beloss Maybe Word32
localpm Maybe Word32
peerpm
Maybe Word32
npeerpm Maybe Attributes
bsspar Maybe ByteString
flags Maybe Word64
toff Maybe Word64
rxdrop Maybe Word64
beacr Maybe Word8
beacsa Maybe Attributes
tidStat Maybe Attributes
associe
Attributes
attrs
where getField :: Get a -> Int -> Maybe a
getField :: forall a. Get a -> Int -> Maybe a
getField Get a
g Int
e = (ByteString -> a) -> Maybe ByteString -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either String a -> a
forall {b}. Either String b -> b
getRight (Either String a -> a)
-> (ByteString -> Either String a) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGet Get a
g) (Maybe ByteString -> Maybe a)
-> (Attributes -> Maybe ByteString) -> Attributes -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Attributes -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
e (Attributes -> Maybe a) -> Attributes -> Maybe a
forall a b. (a -> b) -> a -> b
$ Attributes
attrs
getRight :: Either String a -> a
getRight :: forall {b}. Either String b -> b
getRight (Right a
x) = a
x
getRight (Left String
x) = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse something in StaInfo: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
getStaInfo :: Get StaInfo
getStaInfo :: Get StaInfo
getStaInfo = (Attributes -> StaInfo) -> Get Attributes -> Get StaInfo
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attributes -> StaInfo
staInfoFromAttributes Get Attributes
getAttributes
staInfoFromPacket :: Packet a -> Maybe StaInfo
staInfoFromPacket :: forall a. Packet a -> Maybe StaInfo
staInfoFromPacket (Packet Header
_ a
_ Attributes
attrs) =
let y :: Maybe (Either String StaInfo)
y = Get StaInfo -> ByteString -> Either String StaInfo
forall a. Get a -> ByteString -> Either String a
runGet Get StaInfo
getStaInfo (ByteString -> Either String StaInfo)
-> Maybe ByteString -> Maybe (Either String StaInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Attributes -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
forall a. Num a => a
eNL80211_ATTR_STA_INFO Attributes
attrs
in (Either String StaInfo -> StaInfo)
-> Maybe (Either String StaInfo) -> Maybe StaInfo
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either String StaInfo -> StaInfo
forall {b}. Either String b -> b
getRight Maybe (Either String StaInfo)
y
where getRight :: Either String b -> b
getRight (Right b
x) = b
x
getRight (Left String
x) = String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
"Failed to decode staInfo: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
staInfoFromPacket Packet a
_ = Maybe StaInfo
forall a. Maybe a
Nothing