{-# LANGUAGE CPP #-}
{-|
Module      : System.Linux.Netlink.GeNetlink.NL80211.StaInfo
Description : Implementation of NL80211
Maintainer  : ongy
Stability   : testing
Portability : Linux

This module providis utility functions for NL80211 subsystem.
In particular the NL80211_ATTR_STA_INFO part of NL80211.
For more information see /usr/include/linux/nl80211.h
-}
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

-- |Type for "chain signal"
newtype Signal = Signal [Word8] deriving (Int -> Signal -> ShowS
[Signal] -> ShowS
Signal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signal] -> ShowS
$cshowList :: [Signal] -> ShowS
show :: Signal -> String
$cshow :: Signal -> String
showsPrec :: Int -> Signal -> ShowS
$cshowsPrec :: Int -> Signal -> ShowS
Show, Signal -> Signal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signal -> Signal -> Bool
$c/= :: Signal -> Signal -> Bool
== :: Signal -> Signal -> Bool
$c== :: Signal -> Signal -> Bool
Eq, ReadPrec [Signal]
ReadPrec Signal
Int -> ReadS Signal
ReadS [Signal]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Signal]
$creadListPrec :: ReadPrec [Signal]
readPrec :: ReadPrec Signal
$creadPrec :: ReadPrec Signal
readList :: ReadS [Signal]
$creadList :: ReadS [Signal]
readsPrec :: Int -> ReadS Signal
$creadsPrec :: Int -> ReadS Signal
Read)

-- |Get a Signal from the nested attributes.
signalFromAttributes :: Attributes -> Signal
signalFromAttributes :: Attributes -> Signal
signalFromAttributes Attributes
attrs =
    let bss :: [ByteString]
bss = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ Attributes
attrs
        eth :: [Either String Word8]
eth = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Get a -> ByteString -> Either String a
runGet Get Word8
getWord8) [ByteString]
bss
     in [Word8] -> Signal
Signal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {b}. Either String b -> b
getRight 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)  = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Failed to decode signal: " forall a. [a] -> [a] -> [a]
++ String
x


{- | Type for the signal width reported by the kernel.

 The nl80211 header defines more than this, but nl80211.c only uses the widths defined here.
-}
data SignalWidth
    = Width5MHz
    | Width10MHz
    | Width20MHz
    | Width40MHz
    | Width80MHz
    | Width160MHz
    deriving (Int -> SignalWidth -> ShowS
[SignalWidth] -> ShowS
SignalWidth -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignalWidth] -> ShowS
$cshowList :: [SignalWidth] -> ShowS
show :: SignalWidth -> String
$cshow :: SignalWidth -> String
showsPrec :: Int -> SignalWidth -> ShowS
$cshowsPrec :: Int -> SignalWidth -> ShowS
Show, SignalWidth -> SignalWidth -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignalWidth -> SignalWidth -> Bool
$c/= :: SignalWidth -> SignalWidth -> Bool
== :: SignalWidth -> SignalWidth -> Bool
$c== :: SignalWidth -> SignalWidth -> Bool
Eq, ReadPrec [SignalWidth]
ReadPrec SignalWidth
Int -> ReadS SignalWidth
ReadS [SignalWidth]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SignalWidth]
$creadListPrec :: ReadPrec [SignalWidth]
readPrec :: ReadPrec SignalWidth
$creadPrec :: ReadPrec SignalWidth
readList :: ReadS [SignalWidth]
$creadList :: ReadS [SignalWidth]
readsPrec :: Int -> ReadS SignalWidth
$creadsPrec :: Int -> ReadS SignalWidth
Read)

-- |Get the signal width from attributes that contain the flag.
widthFromAttributes :: Attributes -> SignalWidth
widthFromAttributes :: Attributes -> SignalWidth
widthFromAttributes Attributes
attrs =
    let five :: Maybe SignalWidth
five  = SignalWidth -> Int -> Maybe SignalWidth
opt SignalWidth
Width5MHz forall a. Num a => a
eNL80211_RATE_INFO_5_MHZ_WIDTH
        ten :: Maybe SignalWidth
ten   = SignalWidth -> Int -> Maybe SignalWidth
opt SignalWidth
Width10MHz forall a. Num a => a
eNL80211_RATE_INFO_10_MHZ_WIDTH
        forty :: Maybe SignalWidth
forty = SignalWidth -> Int -> Maybe SignalWidth
opt SignalWidth
Width40MHz forall a. Num a => a
eNL80211_RATE_INFO_40_MHZ_WIDTH
        eighty :: Maybe SignalWidth
eighty = SignalWidth -> Int -> Maybe SignalWidth
opt SignalWidth
Width80MHz forall a. Num a => a
eNL80211_RATE_INFO_80_MHZ_WIDTH
        osixty :: Maybe SignalWidth
osixty = SignalWidth -> Int -> Maybe SignalWidth
opt SignalWidth
Width160MHz 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 forall a. a -> Maybe a -> a
fromMaybe SignalWidth
Width20MHz forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const SignalWidth
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
e forall a b. (a -> b) -> a -> b
$ Attributes
attrs

-- |Type for the rate attributes in StaInfo
data StaRate = StaRate
    { -- |This will be reported as Word16/Word32 from the kernel. We read it into one value.
      -- |If this is Nothing, mcs is >= 32 looking at the code, so it *should*
      -- |never be Nothing.
      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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaRate] -> ShowS
$cshowList :: [StaRate] -> ShowS
show :: StaRate -> String
$cshow :: StaRate -> String
showsPrec :: Int -> StaRate -> ShowS
$cshowsPrec :: Int -> StaRate -> ShowS
Show, StaRate -> StaRate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaRate -> StaRate -> Bool
$c/= :: StaRate -> StaRate -> Bool
== :: StaRate -> StaRate -> Bool
$c== :: StaRate -> StaRate -> Bool
Eq, ReadPrec [StaRate]
ReadPrec StaRate
Int -> ReadS StaRate
ReadS [StaRate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StaRate]
$creadListPrec :: ReadPrec [StaRate]
readPrec :: ReadPrec StaRate
$creadPrec :: ReadPrec StaRate
readList :: ReadS [StaRate]
$creadList :: ReadS [StaRate]
readsPrec :: Int -> ReadS StaRate
$creadsPrec :: Int -> ReadS StaRate
Read)

-- |Get the StaRate from a parsed nested Attribute
staRateFromAttributes :: Attributes -> StaRate
staRateFromAttributes :: Attributes -> StaRate
staRateFromAttributes Attributes
attrs =
    let rate16 :: Maybe Word16
rate16 = forall a. Get a -> Int -> Maybe a
getField Get Word16
getWord16host forall a. Num a => a
eNL80211_RATE_INFO_BITRATE
        rate32 :: Maybe Word32
rate32 = forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host forall a. Num a => a
eNL80211_RATE_INFO_BITRATE32
        -- this locks us into Word32 for now, but that's ok.
        rate :: Maybe Word32
rate = Maybe Word32
rate32 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word16
rate16
        -- The rate width flag is "inline" in the rate.
        width :: SignalWidth
width = Attributes -> SignalWidth
widthFromAttributes Attributes
attrs
        mcs :: Maybe Word8
mcs = forall a. Get a -> Int -> Maybe a
getField Get Word8
getWord8 forall a. Num a => a
eNL80211_RATE_INFO_MCS
        shortGI :: Bool
shortGI = forall k a. Ord k => k -> Map k a -> Bool
M.member forall a. Num a => a
eNL80211_RATE_INFO_SHORT_GI Attributes
attrs
        vhtmcs :: Maybe Word8
vhtmcs = forall a. Get a -> Int -> Maybe a
getField Get Word8
getWord8 forall a. Num a => a
eNL80211_RATE_INFO_VHT_MCS
        vhtnss :: Maybe Word8
vhtnss = forall a. Get a -> Int -> Maybe a
getField Get Word8
getWord8 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {b}. Either String b -> b
getRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGet Get a
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
e 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)  = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Failed to parse something in StaRate: " forall a. [a] -> [a] -> [a]
++ String
x

-- |Structure for wifi station information.
data StaInfo = StaInfo
    { -- |For how long we are connected.
      StaInfo -> Maybe Word32
staConTime    :: Maybe Word32
    -- |Time since the last time we saw the station send something.
    , StaInfo -> Maybe Word32
staInaTime    :: Maybe Word32
    -- |Bytes received. This will be transmitted twice if 64bit in kernel. Will be parsed into this either way.
    , StaInfo -> Maybe Word64
staRXBytes    :: Maybe Word64
    -- |Bytes received. This will be transmitted twice if 64bit in kernel. Will be parsed into this either way.
    , 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

    -- |PM: STA link specific Power Mode
    , StaInfo -> Maybe Word32
staLocalPM    :: Maybe Word32
    , StaInfo -> Maybe Word32
staPeerPM     :: Maybe Word32
    , StaInfo -> Maybe Word32
staNonPeerPM  :: Maybe Word32

    -- |This field is a bit weird in the code :(
    , 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

    -- |Pointer to the Attributes map used to build this struct. This is purely
    -- |for forward compat, please file a feature report if you have to use this.
    , StaInfo -> Attributes
staSelf       :: Attributes
    } deriving (Int -> StaInfo -> ShowS
[StaInfo] -> ShowS
StaInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaInfo] -> ShowS
$cshowList :: [StaInfo] -> ShowS
show :: StaInfo -> String
$cshow :: StaInfo -> String
showsPrec :: Int -> StaInfo -> ShowS
$cshowsPrec :: Int -> StaInfo -> ShowS
Show, StaInfo -> StaInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaInfo -> StaInfo -> Bool
$c/= :: StaInfo -> StaInfo -> Bool
== :: StaInfo -> StaInfo -> Bool
$c== :: StaInfo -> StaInfo -> Bool
Eq, ReadPrec [StaInfo]
ReadPrec StaInfo
Int -> ReadS StaInfo
ReadS [StaInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StaInfo]
$creadListPrec :: ReadPrec [StaInfo]
readPrec :: ReadPrec StaInfo
$creadPrec :: ReadPrec StaInfo
readList :: ReadS [StaInfo]
$creadList :: ReadS [StaInfo]
readsPrec :: Int -> ReadS StaInfo
$creadsPrec :: Int -> ReadS StaInfo
Read)

-- |Parse the nested Netlink Attributes into an StaInfo
staInfoFromAttributes :: Attributes -> StaInfo
staInfoFromAttributes :: Attributes -> StaInfo
staInfoFromAttributes Attributes
attrs =
    let conTime :: Maybe Word32
conTime = forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host forall a. Num a => a
eNL80211_STA_INFO_CONNECTED_TIME
        inaTime :: Maybe Word32
inaTime = forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host forall a. Num a => a
eNL80211_STA_INFO_INACTIVE_TIME
        rxB32 :: Maybe Word32
rxB32   = forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host forall a. Num a => a
eNL80211_STA_INFO_RX_BYTES
        txB32 :: Maybe Word32
txB32   = forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host forall a. Num a => a
eNL80211_STA_INFO_TX_BYTES
        rxB64 :: Maybe Word64
rxB64   = forall a. Get a -> Int -> Maybe a
getField Get Word64
getWord64host forall a. Num a => a
eNL80211_STA_INFO_RX_BYTES64
        txB64 :: Maybe Word64
txB64   = forall a. Get a -> Int -> Maybe a
getField Get Word64
getWord64host forall a. Num a => a
eNL80211_STA_INFO_TX_BYTES64
        rxBytes :: Maybe Word64
rxBytes = Maybe Word64
rxB64 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word32
rxB32
        txBytes :: Maybe Word64
txBytes = Maybe Word64
txB64 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word32
txB32
        llid :: Maybe Word16
llid    = forall a. Get a -> Int -> Maybe a
getField Get Word16
getWord16host forall a. Num a => a
eNL80211_STA_INFO_LLID
        plid :: Maybe Word16
plid    = forall a. Get a -> Int -> Maybe a
getField Get Word16
getWord16host forall a. Num a => a
eNL80211_STA_INFO_PLID
        lstate :: Maybe Word8
lstate  = forall a. Get a -> Int -> Maybe a
getField Get Word8
getWord8 forall a. Num a => a
eNL80211_STA_INFO_PLINK_STATE
        rxDur :: Maybe Word64
rxDur   = forall a. Get a -> Int -> Maybe a
getField Get Word64
getWord64host forall a. Num a => a
eNL80211_STA_INFO_RX_DURATION
        sigMBM :: Maybe Word8
sigMBM  = forall a. Get a -> Int -> Maybe a
getField Get Word8
getWord8 forall a. Num a => a
eNL80211_STA_INFO_SIGNAL
        sigMBMA :: Maybe Word8
sigMBMA = forall a. Get a -> Int -> Maybe a
getField Get Word8
getWord8 forall a. Num a => a
eNL80211_STA_INFO_SIGNAL_AVG
        sigBS :: Maybe Attributes
sigBS   = forall a. Get a -> Int -> Maybe a
getField Get Attributes
getAttributes forall a. Num a => a
eNL80211_STA_INFO_CHAIN_SIGNAL
        sigBSA :: Maybe Attributes
sigBSA  = forall a. Get a -> Int -> Maybe a
getField Get Attributes
getAttributes forall a. Num a => a
eNL80211_STA_INFO_CHAIN_SIGNAL_AVG
        txr :: Maybe Attributes
txr     = forall a. Get a -> Int -> Maybe a
getField Get Attributes
getAttributes forall a. Num a => a
eNL80211_STA_INFO_TX_BITRATE
        rxr :: Maybe Attributes
rxr     = forall a. Get a -> Int -> Maybe a
getField Get Attributes
getAttributes forall a. Num a => a
eNL80211_STA_INFO_RX_BITRATE

        rxpack :: Maybe Word32
rxpack  = forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host forall a. Num a => a
eNL80211_STA_INFO_RX_PACKETS
        txpack :: Maybe Word32
txpack  = forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host forall a. Num a => a
eNL80211_STA_INFO_TX_PACKETS
        txretr :: Maybe Word32
txretr  = forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host forall a. Num a => a
eNL80211_STA_INFO_TX_RETRIES
        txfail :: Maybe Word32
txfail  = forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host forall a. Num a => a
eNL80211_STA_INFO_TX_FAILED

        exptp :: Maybe Word32
exptp   = forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host forall a. Num a => a
eNL80211_STA_INFO_EXPECTED_THROUGHPUT
        beloss :: Maybe Word32
beloss  = forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host forall a. Num a => a
eNL80211_STA_INFO_BEACON_LOSS
        localpm :: Maybe Word32
localpm = forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host forall a. Num a => a
eNL80211_STA_INFO_LOCAL_PM
        peerpm :: Maybe Word32
peerpm  = forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host forall a. Num a => a
eNL80211_STA_INFO_PEER_PM
        npeerpm :: Maybe Word32
npeerpm = forall a. Get a -> Int -> Maybe a
getField Get Word32
getWord32host forall a. Num a => a
eNL80211_STA_INFO_NONPEER_PM

        bsspar :: Maybe Attributes
bsspar  = forall a. Get a -> Int -> Maybe a
getField Get Attributes
getAttributes forall a. Num a => a
eNL80211_STA_INFO_BSS_PARAM
        flags :: Maybe ByteString
flags   = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup forall a. Num a => a
eNL80211_STA_INFO_STA_FLAGS Attributes
attrs
        toff :: Maybe Word64
toff    = forall a. Get a -> Int -> Maybe a
getField Get Word64
getWord64host forall a. Num a => a
eNL80211_STA_INFO_T_OFFSET
        rxdrop :: Maybe Word64
rxdrop  = forall a. Get a -> Int -> Maybe a
getField Get Word64
getWord64host forall a. Num a => a
eNL80211_STA_INFO_RX_DROP_MISC
        beacr :: Maybe Word64
beacr   = forall a. Get a -> Int -> Maybe a
getField Get Word64
getWord64host forall a. Num a => a
eNL80211_STA_INFO_BEACON_RX
        beacsa :: Maybe Word8
beacsa  = forall a. Get a -> Int -> Maybe a
getField Get Word8
getWord8 forall a. Num a => a
eNL80211_STA_INFO_BEACON_SIGNAL_AVG

        tidStat :: Maybe Attributes
tidStat = forall a. Get a -> Int -> Maybe a
getField Get Attributes
getAttributes forall a. Num a => a
eNL80211_STA_INFO_TID_STATS
        associe :: Maybe Attributes
associe = forall a. Get a -> Int -> Maybe a
getField Get Attributes
getWifiEIDs 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Attributes
sigBS)
            (Attributes -> Signal
signalFromAttributes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Attributes
sigBSA)
            (Attributes -> StaRate
staRateFromAttributes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Attributes
txr)
            (Attributes -> StaRate
staRateFromAttributes 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {b}. Either String b -> b
getRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGet Get a
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
e 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)  = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Failed to parse something in StaInfo: " forall a. [a] -> [a] -> [a]
++ String
x

-- |'Get' an StaInfo from a Bytestring
getStaInfo :: Get StaInfo
getStaInfo :: Get StaInfo
getStaInfo = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attributes -> StaInfo
staInfoFromAttributes Get Attributes
getAttributes

-- |extract the StaInfo from a Packet. Use with caution.
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 = forall a. Get a -> ByteString -> Either String a
runGet Get StaInfo
getStaInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup forall a. Num a => a
eNL80211_ATTR_STA_INFO Attributes
attrs
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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)  = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Failed to decode staInfo: " forall a. [a] -> [a] -> [a]
++ String
x
staInfoFromPacket Packet a
_ = forall a. Maybe a
Nothing
-- TODO:This eats error packets, fix?