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