{-# LANGUAGE CPP #-}
#ifdef USE_NL80211
{-# LANGUAGE TypeApplications #-}
#endif
module Xmobar.Plugins.Monitors.Wireless (wirelessConfig, runWireless) where
import System.Console.GetOpt
import Xmobar.Plugins.Monitors.Common
#ifdef IWLIB
import Network.IWlib
#elif defined USE_NL80211
import Control.Exception (bracket)
import qualified Data.Map as M
import GHC.Int (Int8)
import Data.Maybe (listToMaybe, fromMaybe)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
import Data.ByteString.Char8 (unpack)
import Data.Serialize.Put (runPut, putWord32host, putByteString)
import Data.Serialize.Get (runGet)
import System.Linux.Netlink hiding (query)
import System.Linux.Netlink.GeNetlink.NL80211
import System.Linux.Netlink.GeNetlink.NL80211.StaInfo
import System.Linux.Netlink.GeNetlink.NL80211.Constants
import System.Posix.IO (closeFd)
data IwData = IwData { IwData -> String
wiEssid :: String, IwData -> Maybe Int
wiSignal :: Maybe Int, IwData -> Int
wiQuality :: Int }
getWirelessInfo :: String -> IO IwData
getWirelessInfo :: String -> IO IwData
getWirelessInfo String
ifname =
IO NL80211Socket
-> (NL80211Socket -> IO ())
-> (NL80211Socket -> IO IwData)
-> IO IwData
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO NL80211Socket
makeNL80211Socket (Fd -> IO ()
closeFd (Fd -> IO ()) -> (NL80211Socket -> Fd) -> NL80211Socket -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NL80211Socket -> Fd
getFd) (\NL80211Socket
s -> do
[(String, Word32)]
iflist <- NL80211Socket -> IO [(String, Word32)]
getInterfaceList NL80211Socket
s
Maybe IwData
iwdata <- MaybeT IO IwData -> IO (Maybe IwData)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO IwData -> IO (Maybe IwData))
-> MaybeT IO IwData -> IO (Maybe IwData)
forall a b. (a -> b) -> a -> b
$ do
Word32
ifidx <- IO (Maybe Word32) -> MaybeT IO Word32
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Word32) -> MaybeT IO Word32)
-> (Maybe Word32 -> IO (Maybe Word32))
-> Maybe Word32
-> MaybeT IO Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Word32 -> IO (Maybe Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Word32 -> MaybeT IO Word32)
-> Maybe Word32 -> MaybeT IO Word32
forall a b. (a -> b) -> a -> b
$ ((String, Word32) -> Maybe Word32 -> Maybe Word32)
-> Maybe Word32 -> [(String, Word32)] -> Maybe Word32
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(String
n, Word32
i) Maybe Word32
z ->
if String
ifname String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" Bool -> Bool -> Bool
|| String
ifname String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n then Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
i else Maybe Word32
z)
Maybe Word32
forall a. Maybe a
Nothing
[(String, Word32)]
iflist
NL80211Packet
scanp <- IO [NL80211Packet] -> MaybeT IO [NL80211Packet]
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (NL80211Socket -> Word32 -> IO [NL80211Packet]
getConnectedWifi NL80211Socket
s Word32
ifidx) MaybeT IO [NL80211Packet]
-> ([NL80211Packet] -> MaybeT IO NL80211Packet)
-> MaybeT IO NL80211Packet
forall a b. MaybeT IO a -> (a -> MaybeT IO b) -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
IO (Maybe NL80211Packet) -> MaybeT IO NL80211Packet
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe NL80211Packet) -> MaybeT IO NL80211Packet)
-> ([NL80211Packet] -> IO (Maybe NL80211Packet))
-> [NL80211Packet]
-> MaybeT IO NL80211Packet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe NL80211Packet -> IO (Maybe NL80211Packet)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NL80211Packet -> IO (Maybe NL80211Packet))
-> ([NL80211Packet] -> Maybe NL80211Packet)
-> [NL80211Packet]
-> IO (Maybe NL80211Packet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NL80211Packet] -> Maybe NL80211Packet
forall a. [a] -> Maybe a
listToMaybe
ByteString
bssid <- IO (Maybe ByteString) -> MaybeT IO ByteString
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe ByteString) -> MaybeT IO ByteString)
-> (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString
-> MaybeT IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> MaybeT IO ByteString)
-> Maybe ByteString -> MaybeT IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Map Int ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
forall a. Num a => a
eNL80211_ATTR_BSS (NL80211Packet -> Map Int ByteString
forall a. Packet a -> Map Int ByteString
packetAttributes NL80211Packet
scanp) Maybe ByteString
-> (ByteString -> Maybe (Map Int ByteString))
-> Maybe (Map Int ByteString)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Either String (Map Int ByteString) -> Maybe (Map Int ByteString)
forall {a} {a}. Either a a -> Maybe a
rightToMaybe (Either String (Map Int ByteString) -> Maybe (Map Int ByteString))
-> (ByteString -> Either String (Map Int ByteString))
-> ByteString
-> Maybe (Map Int ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get (Map Int ByteString)
-> ByteString -> Either String (Map Int ByteString)
forall a. Get a -> ByteString -> Either String a
runGet Get (Map Int ByteString)
getAttributes Maybe (Map Int ByteString)
-> (Map Int ByteString -> Maybe ByteString) -> Maybe ByteString
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Int -> Map Int ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
forall a. Num a => a
eNL80211_BSS_BSSID
NL80211Packet
stap <- IO [NL80211Packet] -> MaybeT IO [NL80211Packet]
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (NL80211Socket
-> Word8 -> Bool -> Map Int ByteString -> IO [NL80211Packet]
query NL80211Socket
s Word8
forall a. Num a => a
eNL80211_CMD_GET_STATION Bool
True (Map Int ByteString -> IO [NL80211Packet])
-> Map Int ByteString -> IO [NL80211Packet]
forall a b. (a -> b) -> a -> b
$ [(Int, ByteString)] -> Map Int ByteString
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[(Int
forall a. Num a => a
eNL80211_ATTR_IFINDEX, Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter Word32
putWord32host Word32
ifidx),
(Int
forall a. Num a => a
eNL80211_ATTR_MAC, Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter ByteString
putByteString ByteString
bssid)]) MaybeT IO [NL80211Packet]
-> ([NL80211Packet] -> MaybeT IO NL80211Packet)
-> MaybeT IO NL80211Packet
forall a b. MaybeT IO a -> (a -> MaybeT IO b) -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
IO (Maybe NL80211Packet) -> MaybeT IO NL80211Packet
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe NL80211Packet) -> MaybeT IO NL80211Packet)
-> ([NL80211Packet] -> IO (Maybe NL80211Packet))
-> [NL80211Packet]
-> MaybeT IO NL80211Packet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe NL80211Packet -> IO (Maybe NL80211Packet)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NL80211Packet -> IO (Maybe NL80211Packet))
-> ([NL80211Packet] -> Maybe NL80211Packet)
-> [NL80211Packet]
-> IO (Maybe NL80211Packet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NL80211Packet] -> Maybe NL80211Packet
forall a. [a] -> Maybe a
listToMaybe
let ssid :: String
ssid = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ NL80211Packet -> Maybe (Map Int ByteString)
getWifiAttributes NL80211Packet
scanp Maybe (Map Int ByteString)
-> (Map Int ByteString -> Maybe ByteString) -> Maybe ByteString
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Map Int ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
forall a. Num a => a
eWLAN_EID_SSID Maybe ByteString -> (ByteString -> Maybe String) -> Maybe String
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
String -> Maybe String
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String)
-> (ByteString -> String) -> ByteString -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
unpack
signal :: Maybe Int
signal = NL80211Packet -> Maybe StaInfo
forall a. Packet a -> Maybe StaInfo
staInfoFromPacket NL80211Packet
stap Maybe StaInfo -> (StaInfo -> Maybe Word8) -> Maybe Word8
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StaInfo -> Maybe Word8
staSignalMBM Maybe Word8 -> (Word8 -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> (Word8 -> Int) -> Word8 -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int8 (Int8 -> Int) -> (Word8 -> Int8) -> Word8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
qlty :: Int
qlty = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-Int
1) (forall a b. (RealFrac a, Integral b) => a -> b
round @Float (Float -> Int) -> (Int -> Float) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
0.7) (Float -> Float) -> (Int -> Float) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
110) (Float -> Float) -> (Int -> Float) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Float -> Float -> Float -> Float
forall {a}. Ord a => a -> a -> a -> a
clamp (-Float
110) (-Float
40) (Float -> Float) -> (Int -> Float) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Maybe Int
signal
IO (Maybe IwData) -> MaybeT IO IwData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe IwData) -> MaybeT IO IwData)
-> (Maybe IwData -> IO (Maybe IwData))
-> Maybe IwData
-> MaybeT IO IwData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe IwData -> IO (Maybe IwData)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe IwData -> MaybeT IO IwData)
-> Maybe IwData -> MaybeT IO IwData
forall a b. (a -> b) -> a -> b
$ IwData -> Maybe IwData
forall a. a -> Maybe a
Just (IwData -> Maybe IwData) -> IwData -> Maybe IwData
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int -> Int -> IwData
IwData String
ssid Maybe Int
signal Int
qlty
IwData -> IO IwData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IwData -> IO IwData) -> IwData -> IO IwData
forall a b. (a -> b) -> a -> b
$ IwData -> Maybe IwData -> IwData
forall a. a -> Maybe a -> a
fromMaybe (String -> Maybe Int -> Int -> IwData
IwData String
"" Maybe Int
forall a. Maybe a
Nothing (-Int
1)) Maybe IwData
iwdata)
where
rightToMaybe :: Either a a -> Maybe a
rightToMaybe = (a -> Maybe a) -> (a -> Maybe a) -> Either a a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just
clamp :: a -> a -> a -> a
clamp a
lb a
up a
v
| a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
lb = a
lb
| a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
up = a
up
| Bool
otherwise = a
v
#endif
newtype WirelessOpts = WirelessOpts
{ WirelessOpts -> Maybe IconPattern
qualityIconPattern :: Maybe IconPattern
}
defaultOpts :: WirelessOpts
defaultOpts :: WirelessOpts
defaultOpts = WirelessOpts
{ qualityIconPattern :: Maybe IconPattern
qualityIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
}
options :: [OptDescr (WirelessOpts -> WirelessOpts)]
options :: [OptDescr (WirelessOpts -> WirelessOpts)]
options =
[ String
-> [String]
-> ArgDescr (WirelessOpts -> WirelessOpts)
-> String
-> OptDescr (WirelessOpts -> WirelessOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"quality-icon-pattern"] ((String -> WirelessOpts -> WirelessOpts)
-> String -> ArgDescr (WirelessOpts -> WirelessOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
d WirelessOpts
opts ->
WirelessOpts
opts { qualityIconPattern :: Maybe IconPattern
qualityIconPattern = IconPattern -> Maybe IconPattern
forall a. a -> Maybe a
Just (IconPattern -> Maybe IconPattern)
-> IconPattern -> Maybe IconPattern
forall a b. (a -> b) -> a -> b
$ String -> IconPattern
parseIconPattern String
d }) String
"") String
""
]
wirelessConfig :: IO MConfig
wirelessConfig :: IO MConfig
wirelessConfig =
String -> [String] -> IO MConfig
mkMConfig String
"<ssid> <quality>"
[String
"ssid", String
"essid", String
"signal", String
"quality", String
"qualitybar", String
"qualityvbar", String
"qualityipat"]
runWireless :: String -> [String] -> Monitor String
runWireless :: String -> [String] -> Monitor String
runWireless String
iface [String]
args = do
WirelessOpts
opts <- IO WirelessOpts -> Monitor WirelessOpts
forall a. IO a -> Monitor a
io (IO WirelessOpts -> Monitor WirelessOpts)
-> IO WirelessOpts -> Monitor WirelessOpts
forall a b. (a -> b) -> a -> b
$ [OptDescr (WirelessOpts -> WirelessOpts)]
-> WirelessOpts -> [String] -> IO WirelessOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [String] -> IO opts
parseOptsWith [OptDescr (WirelessOpts -> WirelessOpts)]
options WirelessOpts
defaultOpts [String]
args
#ifdef IWLIB
iface' <- if "" == iface then io findInterface else return iface
#else
let iface' :: String
iface' = String
iface
#endif
IwData
wi <- IO IwData -> Monitor IwData
forall a. IO a -> Monitor a
io (IO IwData -> Monitor IwData) -> IO IwData -> Monitor IwData
forall a b. (a -> b) -> a -> b
$ String -> IO IwData
getWirelessInfo String
iface'
String
na <- Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
naString
let essid :: String
essid = IwData -> String
wiEssid IwData
wi
qlty :: Float
qlty = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ IwData -> Int
wiQuality IwData
wi
e :: String
e = if String
essid String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then String
na else String
essid
String
ep <- String -> Monitor String
showWithPadding String
e
#ifdef USE_NL80211
let s :: Maybe Int
s = IwData -> Maybe Int
wiSignal IwData
wi
#else
let s = if qlty >= 0 then Just (qlty * 0.7 - 110) else Nothing
#endif
String
sp <- String -> Monitor String
showWithPadding (String -> Monitor String) -> String -> Monitor String
forall a b. (a -> b) -> a -> b
$ String -> IconPattern -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" IconPattern
forall a. Show a => a -> String
show Maybe Int
s
String
q <- if Float
qlty Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0
then Float -> Monitor String
showPercentWithColors (Float
qlty Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100)
else String -> Monitor String
showWithPadding String
""
String
qb <- Float -> Float -> Monitor String
showPercentBar Float
qlty (Float
qlty Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100)
String
qvb <- Float -> Float -> Monitor String
showVerticalBar Float
qlty (Float
qlty Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100)
String
qipat <- Maybe IconPattern -> Float -> Monitor String
showIconPattern (WirelessOpts -> Maybe IconPattern
qualityIconPattern WirelessOpts
opts) (Float
qlty Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100)
[String] -> Monitor String
parseTemplate [String
ep, String
ep, String
sp, String
q, String
qb, String
qvb, String
qipat]
#ifdef IWLIB
findInterface :: IO String
findInterface = do
c <- readFile "/proc/net/wireless"
let nds = lines c
return $ if length nds > 2 then takeWhile (/= 'c') (nds!!2) else []
#endif