EditChainPage.hs

module IptAdmin.EditChainPage 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 Text.Blaze.Renderer.Pretty (renderHtml)
import Text.ParserCombinators.Parsec.Prim hiding (State (..))

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

pageHandlerGet :: IptAdmin Response
pageHandlerGet = do
    tableName <- getInputNonEmptyString "table"
    chainName <- getInputNonEmptyString "chain"

    table <- getTable tableName

    let chainMay = getChainByName chainName table
    case chainMay of
        Nothing -> throwError $ "Invalid chain name: " ++ chainName
        Just _ -> return $ buildResponse $ renderHtml $ do
            editChainForm (tableName, chainName) chainName Nothing

pageHandlerPost :: IptAdmin Response
pageHandlerPost = do
    tableName <- getInputNonEmptyString "table"
    chainName <- getInputNonEmptyString "chain"

    newChainName <- getInputString "newChainName"

    let newChainNameE = parse parseChainName "chain name" newChainName
    case newChainNameE of
        Left e -> return $ buildResponse $ renderHtml $ do
            editChainForm (tableName, chainName) newChainName $ Just $ "Parameter error: " ++ show e
        Right newChainName' ->
            if chainName == newChainName'
                then return $ buildResponse $ renderHtml $ do
                    editChainForm (tableName, chainName) newChainName' $ Just "The name was not changed"
                else do
                    table <- getTable tableName
                    let checkChainMay = getChainByName newChainName' table
                    case checkChainMay of
                        Just _ -> return $ buildResponse $ renderHtml $ do
                            editChainForm (tableName, chainName) newChainName' $
                                Just "A chain with the same name already exists"
                        Nothing -> do
                            submit <- getInputString "submit"
                            case submit of
                                "Check" -> return $ buildResponse $ renderHtml $ do
                                    editChainForm (tableName, chainName) newChainName' $ Just "The name is valid"
                                "Submit" -> do
                                    tryChange $ renameChain tableName chainName newChainName'
                                    -- redir $ "/show?table=" ++ tableName ++ bookmarkForJump newChainName' Nothing
                                    return $ buildResponse $ "ok:" ++ newChainName'
                                a -> throwError $ "Invalid value for 'submit' parameter: " ++ a