    -- | Maintainer: Arnaud Bailly <arnaud.oqube@gmail.com>
    --
    -- Properties for configuring firewall (iptables) rules

    module Propellor.Property.Firewall (
    	rule,
    	installed,
    	Chain(..),
    	Table(..),
    	Target(..),
    	Proto(..),
    	Rules(..),
    	ConnectionState(..),
    	ICMPTypeMatch(..),
    	TCPFlag(..),
    	Frequency(..),
    	IPWithMask(..),
    ) where

    import Data.Monoid
    import Data.Char
    import Data.List

    import Propellor.Base
    import qualified Propellor.Property.Apt as Apt
    import qualified Propellor.Property.Network as Network

    installed :: Property DebianLike
    installed = Apt.installed ["iptables"]

    rule :: Chain -> Table -> Target -> Rules -> Property Linux
    rule c tb tg rs = property ("firewall rule: " <> show r) addIpTable
      where
    	r = Rule c tb tg rs
    	addIpTable = liftIO $ do
    		let args = toIpTable r
    		exist <- boolSystem "iptables" (chk args)
    		if exist
    			then return NoChange
    			else toResult <$> boolSystem "iptables" (add args)
    	add params = Param "-A" : params
    	chk params = Param "-C" : params

    toIpTable :: Rule -> [CommandParam]
    toIpTable r =  map Param $
    	val (ruleChain r) :
    	toIpTableArg (ruleRules r) ++
    	["-t", val (ruleTable r), "-j", val (ruleTarget r)]

    toIpTableArg :: Rules -> [String]
    toIpTableArg Everything = []
    toIpTableArg (Proto proto) = ["-p", map toLower $ show proto]
    toIpTableArg (DPort port) = ["--dport", val port]
    toIpTableArg (DPortRange (portf, portt)) =
    	["--dport", val portf ++ ":" ++ val portt]
    toIpTableArg (InIFace iface) = ["-i", iface]
    toIpTableArg (OutIFace iface) = ["-o", iface]
    toIpTableArg (Ctstate states) =
    	[ "-m"
    	, "conntrack"
    	, "--ctstate", intercalate "," (map show states)
    	]
    toIpTableArg (ICMPType i) =
    	[ "-m"
    	, "icmp"
    	, "--icmp-type", val i
    	]
    toIpTableArg (RateLimit f) =
    	[ "-m"
    	, "limit"
    	, "--limit", val f
    	]
    toIpTableArg (TCPFlags m c) =
    	[ "-m"
    	, "tcp"
    	, "--tcp-flags"
    	, intercalate "," (map show m)
    	, intercalate "," (map show c)
    	]
    toIpTableArg TCPSyn = ["--syn"]
    toIpTableArg (GroupOwner (Group g)) =
    	[ "-m"
    	, "owner"
    	, "--gid-owner"
    	, g
    	]
    toIpTableArg (Source ipwm) =
    	[ "-s"
    	, intercalate "," (map val ipwm)
    	]
    toIpTableArg (Destination ipwm) =
    	[ "-d"
    	, intercalate "," (map val ipwm)
    	]
    toIpTableArg (NotDestination ipwm) =
    	[ "!"
    	, "-d"
    	, intercalate "," (map val ipwm)
    	]
    toIpTableArg (NatDestination ip mport) =
    	[ "--to-destination"
    	, val ip ++ maybe "" (\p -> ":" ++ val p) mport
    	]
    toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r'

    data IPWithMask = IPWithNoMask IPAddr | IPWithIPMask IPAddr IPAddr | IPWithNumMask IPAddr Int
    	deriving (Eq, Show)

    instance ConfigurableValue IPWithMask where
    	val (IPWithNoMask ip) = val ip
    	val (IPWithIPMask ip ipm) = val ip ++ "/" ++ val ipm
    	val (IPWithNumMask ip m) = val ip ++ "/" ++ val m

    data Rule = Rule
    	{ ruleChain  :: Chain
    	, ruleTable  :: Table
    	, ruleTarget :: Target
    	, ruleRules  :: Rules
    	} deriving (Eq, Show)

    data Table = Filter | Nat | Mangle | Raw | Security
    	deriving (Eq, Show)

    instance ConfigurableValue Table where
    	val Filter = "filter"
    	val Nat = "nat"
    	val Mangle = "mangle"
    	val Raw = "raw"
    	val Security = "security"

    data Target = ACCEPT | REJECT | DROP | LOG | TargetCustom String
    	deriving (Eq, Show)

    instance ConfigurableValue Target where
    	val ACCEPT = "ACCEPT"
    	val REJECT = "REJECT"
    	val DROP = "DROP"
    	val LOG = "LOG"
    	val (TargetCustom t) = t

    data Chain = INPUT | OUTPUT | FORWARD | PREROUTING | POSTROUTING | ChainCustom String
    	deriving (Eq, Show)

    instance ConfigurableValue Chain where
    	val INPUT = "INPUT"
    	val OUTPUT = "OUTPUT"
    	val FORWARD = "FORWARD"
    	val PREROUTING = "PREROUTING"
    	val POSTROUTING = "POSTROUTING"
    	val (ChainCustom c) = c

    data Proto = TCP | UDP | ICMP
    	deriving (Eq, Show)

    data ConnectionState = ESTABLISHED | RELATED | NEW | INVALID
    	deriving (Eq, Show)

    data ICMPTypeMatch = ICMPTypeName String | ICMPTypeCode Int
    	deriving (Eq, Show)

    instance ConfigurableValue ICMPTypeMatch where
    	val (ICMPTypeName t) = t
    	val (ICMPTypeCode c) = val c

    data Frequency = NumBySecond Int
    	deriving (Eq, Show)

    instance ConfigurableValue Frequency where
    	val (NumBySecond n) = val n ++ "/second"

    type TCPFlagMask = [TCPFlag]

    type TCPFlagComp = [TCPFlag]

    data TCPFlag = SYN | ACK | FIN | RST | URG | PSH | ALL | NONE
    	deriving (Eq, Show)

    data Rules
    	= Everything
    	| Proto Proto
    	-- ^There is actually some order dependency between proto and port so this should be a specific
    	-- data type with proto + ports
    	| DPort Port
    	| DPortRange (Port, Port)
    	| InIFace Network.Interface
    	| OutIFace Network.Interface
    	| Ctstate [ ConnectionState ]
    	| ICMPType ICMPTypeMatch
    	| RateLimit Frequency
    	| TCPFlags TCPFlagMask TCPFlagComp
    	| TCPSyn
    	| GroupOwner Group
    	| Source [ IPWithMask ]
    	| Destination [ IPWithMask ]
    	| NotDestination [ IPWithMask ]
    	| NatDestination IPAddr (Maybe Port)
    	| Rules :- Rules   -- ^Combine two rules
    	deriving (Eq, Show)

    infixl 0 :-

    instance Monoid Rules where
    	mempty  = Everything
    	mappend = (:-)