{-# LANGUAGE TypeApplications, CPP #-}
-----------------------------------------------------------------------------
-- |
-- 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 Data.Maybe (fromMaybe)

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)
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 { wiEssid :: String, wiSignal :: Maybe Int, wiQuality :: Int }

getWirelessInfo :: String -> IO IwData
getWirelessInfo ifname = do
  bracket makeNL80211Socket (closeFd . getFd) (\s -> do
  iflist <- getInterfaceList s
  iwdata <- runMaybeT $ do
    ifidx <- MaybeT . return $ foldr (\(n, i) z ->
                                       if (ifname == "" || ifname == n) then Just i else 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   = fromMaybe "" $ getWifiAttributes scanp >>= M.lookup eWLAN_EID_SSID >>=
                                return . unpack
        signal = staInfoFromPacket stap >>= staSignalMBM >>=
                 return . fromIntegral @Int8 . fromIntegral
        qlty   = fromMaybe (-1) (round @Float . (/ 0.7) . (+ 110) .
                                                clamp (-110) (-40) . fromIntegral <$> signal)
    MaybeT . return $ Just $ IwData ssid signal qlty
  return $ fromMaybe (IwData "" Nothing (-1)) iwdata)
  where
    rightToMaybe = either (const Nothing) Just
    clamp lb up v = if v < lb then lb else if v > up then up else v
#endif

newtype WirelessOpts = WirelessOpts
  { WirelessOpts -> Maybe IconPattern
qualityIconPattern :: Maybe IconPattern
  }

defaultOpts :: WirelessOpts
defaultOpts :: WirelessOpts
defaultOpts = WirelessOpts :: Maybe IconPattern -> WirelessOpts
WirelessOpts
  { qualityIconPattern :: Maybe IconPattern
qualityIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
  }

options :: [OptDescr (WirelessOpts -> WirelessOpts)]
options :: [OptDescr (WirelessOpts -> WirelessOpts)]
options =
  [ [Char]
-> [[Char]]
-> ArgDescr (WirelessOpts -> WirelessOpts)
-> [Char]
-> OptDescr (WirelessOpts -> WirelessOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"" [[Char]
"quality-icon-pattern"] (([Char] -> WirelessOpts -> WirelessOpts)
-> [Char] -> ArgDescr (WirelessOpts -> WirelessOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
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
$ [Char] -> IconPattern
parseIconPattern [Char]
d }) [Char]
"") [Char]
""
  ]

wirelessConfig :: IO MConfig
wirelessConfig :: IO MConfig
wirelessConfig =
  [Char] -> [[Char]] -> IO MConfig
mkMConfig [Char]
"<ssid> <quality>"
            [[Char]
"ssid", [Char]
"essid", [Char]
"signal", [Char]
"quality", [Char]
"qualitybar", [Char]
"qualityvbar", [Char]
"qualityipat"]

runWireless :: String -> [String] -> Monitor String
runWireless :: [Char] -> [[Char]] -> Monitor [Char]
runWireless [Char]
iface [[Char]]
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 -> [[Char]] -> IO WirelessOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [[Char]] -> IO opts
parseOptsWith [OptDescr (WirelessOpts -> WirelessOpts)]
options WirelessOpts
defaultOpts [[Char]]
args
#ifdef IWLIB
  [Char]
iface' <- if [Char]
"" [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
iface then IO [Char] -> Monitor [Char]
forall a. IO a -> Monitor a
io IO [Char]
findInterface else [Char] -> Monitor [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
iface
#else
  let iface' = iface
#endif
  WirelessInfo
wi <- IO WirelessInfo -> Monitor WirelessInfo
forall a. IO a -> Monitor a
io (IO WirelessInfo -> Monitor WirelessInfo)
-> IO WirelessInfo -> Monitor WirelessInfo
forall a b. (a -> b) -> a -> b
$ [Char] -> IO WirelessInfo
getWirelessInfo [Char]
iface'
  [Char]
na <- Selector [Char] -> Monitor [Char]
forall a. Selector a -> Monitor a
getConfigValue Selector [Char]
naString
  let essid :: [Char]
essid = WirelessInfo -> [Char]
wiEssid WirelessInfo
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
$ WirelessInfo -> Int
wiQuality WirelessInfo
wi
      e :: [Char]
e = if [Char]
essid [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"" then [Char]
na else [Char]
essid
  [Char]
ep <- [Char] -> Monitor [Char]
showWithPadding [Char]
e
#ifdef USE_NL80211
  let s = wiSignal wi
#else
  let s :: Maybe Float
s = if Float
qlty Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0 then Float -> Maybe Float
forall a. a -> Maybe a
Just (Float
qlty Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.7 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
110) else Maybe Float
forall a. Maybe a
Nothing
#endif
  [Char]
sp <- [Char] -> Monitor [Char]
showWithPadding ([Char] -> Monitor [Char]) -> [Char] -> Monitor [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> (Float -> [Char]) -> Maybe Float -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" Float -> [Char]
forall a. Show a => a -> [Char]
show Maybe Float
s
  [Char]
q <- if Float
qlty Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0
       then Float -> Monitor [Char]
showPercentWithColors (Float
qlty Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100)
       else [Char] -> Monitor [Char]
showWithPadding [Char]
""
  [Char]
qb <- Float -> Float -> Monitor [Char]
showPercentBar Float
qlty (Float
qlty Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100)
  [Char]
qvb <- Float -> Float -> Monitor [Char]
showVerticalBar Float
qlty (Float
qlty Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100)
  [Char]
qipat <- Maybe IconPattern -> Float -> Monitor [Char]
showIconPattern (WirelessOpts -> Maybe IconPattern
qualityIconPattern WirelessOpts
opts) (Float
qlty Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100)
  [[Char]] -> Monitor [Char]
parseTemplate [[Char]
ep, [Char]
ep, [Char]
sp, [Char]
q, [Char]
qb, [Char]
qvb, [Char]
qipat]

#ifdef IWLIB
findInterface :: IO String
findInterface :: IO [Char]
findInterface = do
  [Char]
c <- [Char] -> IO [Char]
readFile [Char]
"/proc/net/wireless"
  let nds :: [[Char]]
nds = [Char] -> [[Char]]
lines [Char]
c
  [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ if [[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
nds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 then (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'c') ([[Char]]
nds[[Char]] -> IconPattern
forall a. [a] -> Int -> a
!!Int
2) else []
#endif