{-# LANGUAGE CPP #-}
#ifdef USE_NL80211
{-# LANGUAGE TypeApplications #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.Wireless
-- Copyright   :  (c) Jose Antonio Ortega Ruiz
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose Antonio Ortega Ruiz
-- Stability   :  unstable
-- Portability :  unportable
--
-- A monitor reporting SSID and signal level for wireless interfaces
--
-----------------------------------------------------------------------------

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
  iflist <- NL80211Socket -> IO [(String, Word32)]
getInterfaceList NL80211Socket
s
  iwdata <- runMaybeT $ do
    ifidx <- MaybeT . return $ 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)
                                     Nothing
                                     iflist
    scanp <- liftIO (getConnectedWifi s ifidx) >>=
             MaybeT . return . listToMaybe
    bssid <- MaybeT . return $ M.lookup eNL80211_ATTR_BSS (packetAttributes scanp) >>=
                               rightToMaybe . runGet getAttributes >>=
                               M.lookup eNL80211_BSS_BSSID
    stap <- liftIO (query s eNL80211_CMD_GET_STATION True $ M.fromList
                          [(eNL80211_ATTR_IFINDEX, runPut $ putWord32host ifidx),
                           (eNL80211_ATTR_MAC, runPut $ putByteString bssid)]) >>=
            MaybeT . return . listToMaybe
    let 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 = 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 -> (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
    MaybeT . return $ Just $ IwData ssid signal qlty
  return $ fromMaybe (IwData "" Nothing (-1)) 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 = Just $ parseIconPattern 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
  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
#endif
  wi <- io $ getWirelessInfo iface'
  na <- getConfigValue naString
  let essid = IwData -> String
wiEssid IwData
wi
      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 = if String
essid String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then String
na else String
essid
  ep <- showWithPadding e
#ifdef USE_NL80211
  let s = IwData -> Maybe Int
wiSignal IwData
wi
#else
  let s = if qlty >= 0 then Just (qlty * 0.7 - 110) else Nothing
#endif
  sp <- showWithPadding $ maybe "" show s
  q <- if qlty >= 0
       then showPercentWithColors (qlty / 100)
       else showWithPadding ""
  qb <- showPercentBar qlty (qlty / 100)
  qvb <- showVerticalBar qlty (qlty / 100)
  qipat <- showIconPattern (qualityIconPattern opts) (qlty / 100)
  parseTemplate [ep, ep, sp, q, qb, qvb, 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