EditChainPage.hs

module IptAdmin.EditChainPage where

import Control.Monad.Error
import Happstack.Server.SimpleHTTP
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