module Network.Asus.WL500gP 
    (
     -- Structures
     Connection (..)
    ,ConnectionStatus (..)
    ,Status (..)
    ,Log

    -- monadic operations
    ,Conn
    ,withConnection
    ,readStatus
    ,readLog
    ,connectWan
    ,disconnectWan
    ,clearLog

    ) where

import Control.Monad.Reader
import Network.Curl
import Text.Printf (printf)
import Text.HTML.TagSoup
import Data.List (tails)
import Data.Maybe (maybe)
import Data.Either (either)
import Control.Monad (guard)

data ConnectionStatus = Connected | Disconnected deriving (Eq, Show)

toConnStatus :: String -> ConnectionStatus
toConnStatus s = if s == "Connected" then Connected else Disconnected

-- |Connection - stores the connection credentials
data Connection = Connection {
      user :: String            -- ^ user name
    , password :: String        -- ^ user password
    , hostname :: String        -- ^ hostname (ip address)
    } deriving (Show, Eq)

-- |Status - return the complete connection information
data Status = Status {
      connectionStatus :: ConnectionStatus -- ^ connection status
                                           -- (connected, disconnected)
    , ip :: String                         -- ^ given ip address 
    , subnetMask :: String                 -- ^ subnet mask
    , defaultGateway :: String             -- ^ gefault gateway
    , dnsServers :: [String]               -- ^ list of ip addresses of DNS servers
    } deriving (Show)

-- |Log - router log representation
type Log = [String]

-- |Conn is the Reader monad over IO. It holds credentials to 
-- sequence actions with router
type Conn a = ReaderT Connection IO a

-- |Runs the Conn monad, logouts before exit
withConnection :: Connection -> Conn a -> IO a
withConnection con cl = runReaderT cl' con
    where cl' = cl >>= \r -> logout >> return r

-- |Reads the router status. `Left` is error
readStatus :: Conn (Either String Status)
readStatus = 
    liftM (either Left 
           (toEither "Fail to parse data" . parseStatusPage)) $
     getPage "Main_GStatus_Content.asp"

-- |Reads the router log
readLog :: Conn (Either String Log)
readLog = 
    liftM (either Left
           (toEither "Fail to parse data" . parseLogPage)) $
     getPage "Main_LogStatus_Content.asp"

-- |Send disconnect signal. Doesn't wait for response and doesn't
-- checks the result.
disconnectWan :: Conn ()
disconnectWan = 
    performAction (actionState "dhcpc_release")

-- |Connects to the WAN. Similary to disconnecting, doesn't wait for result.
-- It is useful to check the log after some time elapsed
connectWan :: Conn ()
connectWan = 
    performAction (actionState "dhcpc_renew")

-- |Clears log. It seems, that it allways succeeded
clearLog :: Conn ()
clearLog =
    performAction (actionLog "+Clear+")

---
-- some helper functions
---

-- maybe to either conversion
toEither :: a -> Maybe b -> Either a b
toEither a = maybe (Left a) Right

-- and action is simple call to http://hostname/apply.cgi with 
-- GET request in the url
performAction :: String -> Conn ()
performAction act = do
  up <- getUserPassword
  url <- liftM (++ act) $ getUrl "apply.cgi"
  (resuln, str) <- liftIO $ curlGetString url $ CurlUserPwd up : method_GET
  return ()

-- creates a GET request, valid for state page
actionState :: String -> String
actionState = printf "?action_mode=Update&action_script=%s"

-- creates a GET request, valide for log page
actionLog :: String -> String
actionLog = printf "?action_mode=%s"

-- simply downloads the page (note: page is not url)
getPage :: String -> Conn (Either String String)
getPage page = do
  up <- getUserPassword
  url <- getUrl page
  (result, str) <- liftIO $ curlGetString url $ CurlUserPwd up : method_GET
  return $ if result /= CurlOK 
            then Left $ printf "Failed to get url: '%s'" url
            else Right str

-- retrieve user and password in the format of "user:password"
getUserPassword :: Conn String
getUserPassword = do
  u <- liftM (user) ask
  p <- liftM (password) ask
  return $ printf "%s:%s" u p

-- retrieve the page url on the given hostname
getUrl :: String -> Conn String
getUrl page = do
  h <- liftM (hostname) ask
  return $ printf "http://%s/%s" h page 

-- log outs from the router
logout :: Conn ()
logout = do
  url <- getUrl "Logout.asp"
  liftIO $ curlGetString url method_GET 
  return ()

parseStatusPage :: String -> Maybe Status
parseStatusPage content = 
    let 
        inputs = [(fromAttrib "name" a, fromAttrib "value" a) 
                  | a:_ <- tails (parseTags content)
                 , a~== "<input>"
                 , fromAttrib "name" a /= ""] 
    in do
      (status':ip':subnet':gateway':dns':[]) <- 
          mapM (`lookup` inputs) ["wan_status_t", "wan_ipaddr_t", "wan_netmask_t",
                                  "wan_gateway_t", "wan_dns_t"]
      return $ Status 
                 {connectionStatus = toConnStatus status'
                 ,ip = ip'
                 ,subnetMask = subnet'
                 ,defaultGateway = gateway'
                 ,dnsServers = words dns'}
                               
parseLogPage :: String -> Maybe Log
parseLogPage content = 
    let 
        logString = [fromTagText t | a:t:_ <- tails (parseTags content),
                     a ~== "<textarea class=content_log_td>"]
    in do
      guard (not $ null logString)
      return $ filter (/= "") $ lines $ head logString