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

This module providis utility functions for NL80211 subsystem.
In particular the IEEE80211 WifiEI part of NL80211.
-}
module System.Linux.Netlink.GeNetlink.NL80211.WifiEI
    ( showWifiEid
    , getWifiEIDs
    )
where

import qualified Data.Map as M
import Data.ByteString (ByteString)
import System.Linux.Netlink
import System.Linux.Netlink.Helpers (indent)
import Data.Serialize.Get (runGet, getByteString, getWord8, isEmpty, Get)
import Control.Monad.Loops (whileM)

import System.Linux.Netlink.GeNetlink.NL80211.Constants

#if MIN_VERSION_base(4,8,0)
#else
import Control.Applicative ((<$>))
#endif

getRight :: Show a => Either a b -> b
getRight :: Either a b -> b
getRight (Right b
x) = b
x
getRight (Left a
err) = [Char] -> b
forall a. HasCallStack => [Char] -> a
error ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$a -> [Char]
forall a. Show a => a -> [Char]
show a
err

-- |Prettyprint the WifiEid map
showWifiEid :: ByteString -> String
showWifiEid :: ByteString -> [Char]
showWifiEid ByteString
bs = let attrs :: Attributes
attrs = Either [Char] Attributes -> Attributes
forall a b. Show a => Either a b -> b
getRight (Either [Char] Attributes -> Attributes)
-> Either [Char] Attributes -> Attributes
forall a b. (a -> b) -> a -> b
$ Get Attributes -> ByteString -> Either [Char] Attributes
forall a. Get a -> ByteString -> Either [Char] a
runGet Get Attributes
getWifiEIDs ByteString
bs in
  [Char]
"WifiEIDs:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  ([Char] -> [Char]
indent ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$(Int -> [Char]) -> Attributes -> [Char]
showAttrs Int -> [Char]
forall a. (Num a, Show a, Eq a) => a -> [Char]
showIEEE80211EID Attributes
attrs)

-- |'Get' the EID Attributes from a buffer
getWifiEIDs :: Get Attributes
getWifiEIDs :: Get Attributes
getWifiEIDs = [(Int, ByteString)] -> Attributes
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, ByteString)] -> Attributes)
-> Get [(Int, ByteString)] -> Get Attributes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool -> Get (Int, ByteString) -> Get [(Int, ByteString)]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not (Bool -> Bool) -> Get Bool -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get (Int, ByteString)
getWifiEID

-- |'Get' an EID attribute from a buffer
getWifiEID :: Get (Int, ByteString)
getWifiEID :: Get (Int, ByteString)
getWifiEID = do
  Int
ty  <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
  Int
len <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
  ByteString
val <- Int -> Get ByteString
getByteString Int
len
  (Int, ByteString) -> Get (Int, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
ty, ByteString
val)