AddPage.hs

module IptAdmin.AddPage where

import Control.Monad.Error
import Control.Monad.State
import Happstack.Server.SimpleHTTP
import IptAdmin.EditForm
import IptAdmin.EditForm.Class
import IptAdmin.EditForm.Render
import IptAdmin.EditForm.Utils
import IptAdmin.System
import IptAdmin.Types
import IptAdmin.Utils
import Iptables
import Iptables.Print
import Iptables.Types
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"
    chainName <- getInputNonEmptyString "chain"

    table <- getTable tableName

    checkParams table chainName

    (PackedEditForm form) <- nullSelForm tableName chainName
    let userChainNames = getUserChains form chainName table
    return $ buildResponse $ renderHtml $ do
        editFormHtml (tableName, chainName, 0, userChainNames) form Nothing

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

    table <- getTable tableName

    checkParams table chainName

    (PackedEditForm addFormParams) <- httpInputToSelForm tableName chainName
    let userChainNames = getUserChains addFormParams chainName table

    let checkResE = editPageProcessParams addFormParams
    case checkResE of
            Left formMes -> return $ buildResponse $ renderHtml $ do
                editFormHtml (tableName, chainName, 0, userChainNames) addFormParams $ Just formMes
            Right (options, target, formMes) -> do
                let (_, options') = runState (mapM_ completeModules options) options
                let rule = Rule (Counters 0 0) options' target

                submit <- getInputString "submit"
                case submit of
                    "Check" -> return $ buildResponse $ renderHtml (do
                        editFormHtml (tableName, chainName, 0, userChainNames) addFormParams $ Just formMes
                        ) -- ++ printRuleForRun rule
                    "Submit" -> do
                        tryChange (appendRule tableName chainName rule)
                        -- redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName Nothing
                        return $ buildResponse "ok"
                    a -> throwError $ "Wrong value for 'submit' parameter: " ++ a

checkParams :: [Chain] -> String -> IptAdmin ()
checkParams table chainName = do
    let chainMay = getChainByName chainName table
    _ <- maybe (throwError $ "Invalid chain name: " ++ chainName)
                   return
                   chainMay
    return ()