AddChainPage.hs

module IptAdmin.AddChainPage where

import Control.Monad.Error
import Happstack.Server.SimpleHTTP
import Template
import IptAdmin.EditChainForm.Parse
import IptAdmin.EditChainForm.Render
import IptAdmin.Render
import IptAdmin.System
import IptAdmin.Types
import IptAdmin.Utils
import Iptables
import Iptables.Types
import Text.ParserCombinators.Parsec.Prim hiding (State (..))
import Text.Blaze.Renderer.Pretty (renderHtml)

pageHandlers :: IptAdmin Response
pageHandlers = msum [ methodSP GET pageHandlerGet
                    , methodSP POST pageHandlerPost
                    ]

pageHandlerGet :: IptAdmin Response
pageHandlerGet = do
    tableName <- getInputNonEmptyString "table"
    return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do
        header tableName $ "Add user defined chain in '" ++ tableName ++ "' table"
        editChainForm (tableName, "") "" Nothing

pageHandlerPost :: IptAdmin Response
pageHandlerPost = do
    tableName <- getInputNonEmptyString "table"
    newChainName <- getInputString "newChainName"
    let newChainNameE = parse parseChainName "chain name" newChainName
    case newChainNameE of
        Left e -> return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do
            header tableName $ "Add user defined chain in '" ++ tableName ++ "' table"
            editChainForm (tableName, "") newChainName $ Just $ "Parameter error: " ++ show e
        Right newChainName' -> do
            iptables <- getIptables
            table <- case tableName of
                "filter" -> return $ tFilter iptables
                "nat" -> return $ tNat iptables
                "mangle" -> return $ tMangle iptables
                "raw" -> return $ tRaw iptables
                a -> throwError $ "Invalid table parameter: " ++ a
            let checkChainMay = getChainByName newChainName' table
            case checkChainMay of
                Just _ -> return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do
                    header tableName $ "Add user defined chain in '" ++ tableName ++ "' table"
                    editChainForm (tableName, "") newChainName' $ Just "A chain with the same name already exists"
                Nothing -> do
                    submit <- getInputString "submit"
                    case submit of
                        "Check" -> return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do
                            header tableName $ "Add user defined chain in '" ++ tableName ++ "' table"
                            editChainForm (tableName, "") newChainName' $ Just "The name is valid"
                        "Submit" -> do
                            tryChange $ addChain tableName newChainName'
                            redir $ "/show?table=" ++ tableName
                        a -> throwError $ "Invalid value for 'submit' parameter: " ++ a