{-# OPTIONS -fglasgow-exts #-}

-- | WLAN Commands
module HNM.WLAN where

import IO
import Data.List
import System.IO
import System.Exit
import System.Process
import System.IO.Unsafe
import Text.Regex.Posix
import System.Posix.User
import System.Environment
import Control.Concurrent
import Control.Monad.State

ignore :: Monad m ⇒ m a  → m ()
ignore _ = return ()

assu :: IO a → IO a → IO a
assu a b = do
  root ← userIsRoot
  case root of
    True  → a
    False → b

userIsRoot :: IO Bool
userIsRoot = return . (0 ==) =<< getRealUserID

run :: String → IO String
run cmd = do
  (i,o,e,h) ← runInteractiveCommand cmd
  hGetContents o >>= \s → waitForProcess h >> return s

type Key       = String
type SSID      = String
type MAC       = String
type Interface = String
type Cell      = String
type IP        = String
type AP        = String
type Driver    = String

getDefaultInterface :: IO Interface
getDefaultInterface = return . head =<< getInterfaces

getInterfaces :: IO [Interface]
getInterfaces = do
  cat ← run "cat /proc/net/wireless"
  return $ filter (/= "") $ map (matching " *(.*[0-9]+):") $ lines cat

scan :: Interface → IO [Cell]
scan interface = return . drop 1 . getCells =<< run ("iwlist " ++ interface ++ " scan")

getCells :: String → [Cell]
getCells block = map unwords $ groupBy (const $ (/=) "Cell") $ words block


-- | WLAN encryption values
data Encryption = None        -- ^ no  encryption
                | WEP         -- ^ WEP encryption
                | WPA Version -- ^ WPA encryption
                deriving (Show, Read, Eq, Ord)

-- | WPA version
data Version = One
             | Two
             deriving (Show, Read, Eq, Ord)

type Quality = Int
type Unit = (MAC,Quality)

data CWLAN = CWLAN
             {
               cessid   :: SSID,
               cencrypt :: Encryption,
               ccell    :: [Unit]
             }
             deriving (Show, Read, Eq, Ord)

meanQuality :: [Quality] → Quality
meanQuality = round . mean . (map (fromInteger . toInteger))

mean :: Fractional a ⇒ [a] → a
mean [] = 0
mean (x:xs) = mean' (x:xs) 0 0
  where
    mean' []     s c = s / c
    mean' (x:xs) s c = mean' xs (s+x) (c+1)

data WLAN = WLAN
            {
              essid      :: SSID,
              quality    :: Quality,
              encryption :: Encryption, 
              mac        :: MAC
            }
            deriving (Show, Read, Eq, Ord)

compact :: [WLAN] → [CWLAN]
compact []     = []
compact (w:ws) = CWLAN cid cen ceq_us : compact cne
  where
    cid = essid w
    cen = encryption w
    (ceq,cne) = partition ((cid ==) . essid) ws
    ceq_us = macqual w : map macqual ceq
    macqual = \ew → (mac ew, quality ew)

cellToWLAN :: Cell → WLAN
cellToWLAN c = WLAN (getEssid c) (getQuality c) (getEncrypt c) (getMac c)
  where
    getEssid   = matching "ESSID:\"(.*)\""
    getMac     = matching "Address: (.{17})"
    getQuality = \c → case matching "Quality=(.*)/100" c of { "" → 0; q → read q :: Int }
    getEncrypt = \c → case matching "Encryption key:(on|off)" c of
                        "on"  → case matching "(WPA.)" c of
                                  "WPA " → WPA One
                                  "WPA2" → WPA Two
                                  _      → WEP
                        _     → None

-- | given an interface, returns a list of wireless lans 
getWLANs :: Interface → IO [WLAN]
getWLANs interface = return . {-debug . -}map cellToWLAN =<< scan interface

getLocalIP :: Interface → IO IP
getLocalIP interface = return . matching "inet addr:(.+)  ." =<< run ("ifconfig " ++ interface)

getESSID :: Interface → IO SSID
getESSID interface = return . matching "ESSID:\"(.+)\"" =<< run ("iwconfig " ++ interface)

getAP :: Interface → IO AP
getAP interface = return . matching "Access Point: (.+)\n" =<< run ("iwconfig " ++ interface)

data ConnectionStatus = NotConnected | Connected IP SSID
                        deriving (Show, Read, Eq, Ord)

getConnectionStatus :: Interface → IO ConnectionStatus
getConnectionStatus interface = do
  ip ← getLocalIP interface
  case ip of
    [] → return NotConnected
    ip → do
    ap ← getAP interface
    case (debug ap) of
      "Not-Associated   " → return NotConnected
      ap                  → return . Connected ip =<< getESSID interface

matching :: String → String → String
matching = \pattern info → case info =~ pattern of { [[a,b]] → b; [[a,b],[c,d]] → d; _ → "" }

debug :: Show a ⇒ a → a
debug a = unsafePerformIO (print a >> return a)

exec :: String → IO ()
exec cmd = runCommand cmd >>= waitForProcess >> return ()

pcom :: String → [String] → IO ()
pcom c = exec . unwords . (c:)

modprobe :: [String] → IO ()
modprobe = pcom "modprobe"

iwconfig :: [String] → IO ()
iwconfig = pcom "iwconfig"

ifconfig :: [String] → IO ()
ifconfig = pcom "ifconfig"

dhclient :: [String] → IO ()
dhclient = pcom "dhclient"

wpa_supplicant :: [String] → IO ()
wpa_supplicant = pcom "wpa_supplicant"

initHardware :: Driver → Interface → IO ()
initHardware driver interface = do
  disconnect interface
  deactivate driver interface
  activate driver interface
  threadDelay 2000000
  exec $ "iwlist " ++ interface ++ " scan"
  return ()

deactivate :: Driver → Interface → IO ()
deactivate driver interface = do
  ifconfig [interface, "down"]
  modprobe ["-r", driver]

activate :: Driver → Interface → IO ()
activate driver interface = do
  modprobe [driver]
  ifconfig [interface, "up"]

disconnect :: Interface → IO ()
disconnect interface = do
  exec $ "killall dhclient"
  exec $ "killall wpa_supplicant"
  ifconfig [interface, "down"]

connectFree :: Interface → SSID → IO ()
connectFree interface ssid = do
  connect interface (Wireless ssid Nothing)

connect :: Interface → ConnectionSetting → IO ()
connect interface (Wireless ssid enc) = do
  disconnect interface
  ifconfig [interface, "up"]
  case enc of
    Nothing        → iwconfig [interface, "essid", ssid]
    Just (WEP,   key) → iwconfig [interface, "essid", ssid, "key", "s:" ++ key]
    Just (WPA _, key) → wpaconfig [interface, ssid, key]
  dhclient [interface]

wpaconfig :: [String] → IO ()
wpaconfig [interface, ssid, key] = do
  h ← openFile wpa_temp WriteMode
  l h $ "network={"
  l h $ ""
  l h $ "  ssid=\"" ++ ssid ++ "\""
  l h $ "  key_mgmt=WPA-PSK"
  l h $ "  psk=\"" ++ key ++ "\""
  l h $ ""
  l h $ "}"
  hClose h
  wpa_supplicant ["-B", "-c"++wpa_temp, "-i"++interface]
  threadDelay 2000000
  where
    l = hPutStrLn 

wpa_temp :: FilePath
wpa_temp = "/tmp/wpatemp.conf"

data ConnectionSetting = Wireless SSID (Maybe (Encryption,Key))
                       deriving (Show, Read, Eq, Ord)