Netlink example

Netlink.hs

module Netlink where

import Control.Exception (bracket)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Maybe
import Data.ByteString.Char8 (ByteString, unpack)
import Data.Map qualified as M
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Serialize.Get (runGet)
import Data.Serialize.Put (putByteString, putWord32host, runPut)
import GHC.Int (Int8)
import System.Linux.Netlink hiding (query)
import System.Linux.Netlink.GeNetlink.NL80211
import System.Linux.Netlink.GeNetlink.NL80211.Constants
import System.Linux.Netlink.GeNetlink.NL80211.StaInfo
import System.Posix.IO (closeFd)

-- | Convert a 'Maybe' computation to 'MaybeT'.
hoistMaybe :: (Applicative m) => Maybe b -> MaybeT m b
hoistMaybe = MaybeT . pure

eitherToMaybe :: Either e a -> Maybe a
eitherToMaybe = \case
  Left _err -> Nothing
  Right a -> Just a

data IwRates = IwRates {wiTxRate :: Int, wiRxRate :: Int}
  deriving (Show)

data IwData = IwData {wiEssid :: String, wiSignal :: Maybe Int, wiQuality :: Int, wiRates :: Maybe IwRates}
  deriving (Show)

nic :: String
nic = "wlp170s0"

getBssId :: NL80211Packet -> Maybe ByteString
getBssId packet = do
  attrBss <- M.lookup eNL80211_ATTR_BSS (packetAttributes packet)
  attrs <- eitherToMaybe $ runGet getAttributes attrBss
  M.lookup eNL80211_BSS_BSSID attrs

getRates :: NL80211Packet -> Maybe IwRates
getRates stap = do
  staInfo <- staInfoFromPacket stap
  wiTxRate <- fmap fromIntegral . rateBitrate =<< staTXRate staInfo
  wiRxRate <- fmap fromIntegral . rateBitrate =<< staRXRate staInfo
  pure IwRates {..}
    
getWirelessInfo :: String -> IO IwData
getWirelessInfo ifname =
  bracket
    makeNL80211Socket
    (closeFd . getFd)
    ( \s -> do
        iflist <- getInterfaceList s
        iwdata <- runMaybeT $ do
          ifidx <- hoistMaybe $ foldr (\(n, i) z -> if ifname == "" || ifname == n then Just i else z) Nothing iflist
          scanp <- MaybeT $ fmap listToMaybe $ getConnectedWifi s ifidx
          bssid <- hoistMaybe $ getBssId scanp

          stap <- MaybeT $ fmap listToMaybe $ query s eNL80211_CMD_GET_STATION True $ M.fromList [(eNL80211_ATTR_IFINDEX, runPut $ putWord32host ifidx), (eNL80211_ATTR_MAC, runPut $ putByteString bssid)]
          rates <- hoistMaybe $ getRates stap

          let ssid =
                fromMaybe "" $
                  getWifiAttributes scanp >>= M.lookup eWLAN_EID_SSID
                    >>= return . unpack
              signal =
                staInfoFromPacket stap >>= staSignalMBM
                  >>= return . fromIntegral @Int8 . fromIntegral
              qlty =
                maybe
                  (-1)
                  ( round @Float . (/ 0.7) . (+ 110)
                      . clamp (-110) (-40)
                      . fromIntegral
                  )
                  signal
          MaybeT . return $ Just $ IwData ssid signal qlty (Just rates)

        return $ fromMaybe (IwData "" Nothing (-1) Nothing) iwdata
    )
  where
    rightToMaybe = either (const Nothing) Just
    clamp lb up v
      | v < lb = lb
      | v > up = up
      | otherwise = v