module Iptables.Print where

import Data.Bits
import Data.List
import Data.Set (toList)
import Data.Word
import Iptables.Types

printIptables :: Iptables -> String
printIptables (Iptables f n m r) =
    printTable "Filter" f
    ++ printTable "Nat" n
    ++ printTable "Mangle" m
    ++ printTable "Raw" r
    where
        printTable :: String -> [Chain] -> String
        printTable tableName chains =
            "Table " ++ tableName ++ "\n" ++ unlines (map printChain chains)

{-
printIptables (t:ts) =
    let (tableName, chains) = case t of
            TableFilter chs -> ("Filter",chs)
            TableNat chs -> ("Nat", chs)
            TableMangle chs -> ("Mangle", chs)
    in "Table " ++ tableName ++ "\n" ++ (unlines $ map printChain chains)
       ++ printIptables ts
       -}

printChain :: Chain -> String
printChain (Chain name policy counters rules) =
    "Chain: " ++ name
    ++ " ; Policy: "
    ++ printPolicy policy
    ++ " counters: " ++ printCounters counters ++ "\n"
    ++ unlines (map printRule $ zip rules [1 ..])

printPolicy :: Policy -> String
printPolicy ACCEPT = "ACCEPT"
printPolicy DROP = "DROP"
printPolicy PUNDEFINED = "UNDEFINED"

printCounters :: Counters -> String
printCounters (Counters a b) = "[" ++ show a ++ ":" ++ show b ++ "]"

printRuleForRun :: Rule -> String
printRuleForRun (Rule _ ruleOpts target) =
    unwords (map printOption ruleOpts) ++ " "
    ++ printTarget target

printRule :: (Rule, Int) -> String
printRule (Rule _ ruleOpts target, lineNum) =
    show lineNum ++ ". "
    ++ unwords (map printOption ruleOpts) ++ " "
    ++ printTarget target

printOption :: RuleOption -> String
printOption opt = case opt of
    (OProtocol b p) -> unwords $ printInv b ++ ["-p"] ++ [p]
    (OSource b addr) -> unwords $ printInv b ++ ["-s"] ++ [printAddress addr]
    (ODest b addr) -> unwords $ printInv b ++ ["-d"] ++ [printAddress addr]
    (OInInt b int) -> unwords $ printInv b ++ ["-i"] ++ [printInterface int]
    (OOutInt b int) -> unwords $ printInv b ++ ["-o"] ++ [printInterface int]
    (OFragment b) -> undefined b
    (OSourcePort b p) -> unwords $ printInv b ++ ["--sport"] ++ [printPort p]
    (ODestPort b p) -> unwords $ printInv b ++ ["--dport"] ++ [printPort p]
    (OTcpFlags b fs) -> undefined b fs
    (OSyn b) -> undefined b
    (OTcpOption b o) -> undefined b o
    (OIcmpType b t) -> undefined b t
    (OModule m) -> unwords $ "-m" : [printModule m]
    (OLimit b l) -> undefined b l
    (OLimitBurst b) -> undefined b
    (OMacSource b m) -> undefined b m
    (OMark a b) -> undefined a b
    (OPort b p) -> undefined b p
    (OUidOwner b u) -> undefined b u
    (OGidOwner b g) -> undefined b g
    (OSidOwner b s) -> undefined b s
    (OState s) -> unwords $ "--state" : [printStates $ toList s]
    (OTos t) -> undefined t
    (OTtl t) -> undefined t
    (OPhysDevIn b int) -> undefined b int
    (OPhysDevOut b int) -> undefined b int
    (OPhysDevIsIn b) -> undefined b
    (OPhysDevIsOut b) -> undefined b
    (OPhysDevIsBridged b) -> unwords $ printInv b ++ ["--physdev-is-bridged"]
    (OComment c) -> undefined c
    (OUnknown oName b opts) -> unwords $ printInv b ++ [oName] ++ opts

printInv :: Bool -> [String]
printInv True = []
printInv False = ["!"]

printTarget :: RuleTarget -> String
printTarget rt = (++) "-j " $ case rt of
                            TAccept -> "ACCEPT"
                            TDrop -> "DROP"
                            TReject rw -> "REJECT" ++ " --reject-with " ++ printRejectWith rw
                            TReturn -> "RETURN"
                            TUChain chain -> chain
                            TSNat natAddr rand persist ->
                                let randS = if rand then " --random"
                                                    else ""
                                    persistS = if persist then " --persistent"
                                                           else ""
                                in
                                    "SNAT " ++ "--to-source " ++ printNatAddr natAddr ++ randS ++ persistS
                            TDNat natAddr rand persist ->
                                let randS = if rand then " --random"
                                                    else ""
                                    persistS = if persist then " --persistent"
                                                          else ""
                                in
                                    "DNAT " ++ "--to-destination " ++ printNatAddr natAddr ++ randS ++ persistS
                            TMasquerade natPort rand ->
                                let randS = if rand then " --random"
                                                    else ""
                                    natPortS = case natPort of
                                        NatPortDefault -> ""
                                        _ -> " --to-ports " ++ printNatPort natPort
                                in
                                    "MASQUERADE" ++ natPortS ++ randS
                            TRedirect natPort rand ->
                                let randS = if rand then " --random"
                                                    else ""
                                    natPortS = case natPort of
                                        NatPortDefault -> ""
                                        _ -> " --to-ports " ++ printNatPort natPort
                                in
                                    "REDIRECT" ++ natPortS ++ randS
                            TUnknown tName opts ->
                                tName ++ " " ++ unwords opts

printAddress :: Addr -> String
printAddress (AddrIP ip) = printIp ip
printAddress (AddrMask ip mask) = printIp ip ++ "/" ++ printIp mask
printAddress (AddrPref ip pref) = printIp ip ++ "/" ++ show pref

printIp :: Word32 -> String
printIp ip =
    let oct1 = show $ shiftR ip 24
        oct2 = show $ shiftR (shiftL ip 8) 24
        oct3 = show $ shiftR (shiftL ip 16) 24
        oct4 = show $ shiftR (shiftL ip 24) 24
    in oct1 ++ "." ++ oct2 ++ "." ++ oct3 ++ "." ++ oct4

printInterface :: Interface -> String
printInterface (Interface str) = str

printPort :: Port -> String
printPort (Port ps) = intercalate "," $ map show ps
printPort (PortRange ps pe) = show ps ++ ":" ++ show pe

printStates :: [CState] -> String
printStates ss = intercalate "," $ map printState ss
    where
    printState st = case st of
            CStInvalid -> "INVALID"
            CStEstablished -> "ESTABLISHED"
            CStNew -> "NEW"
            CStRelated -> "RELATED"
            CStUntracked -> "UNTRACKED"

printModule :: Module -> String
printModule m = case m of
        ModTcp -> "tcp"
        ModUdp -> "udp"
        ModLimit -> "limit"
        ModMac -> "mac"
        ModMark -> "mark"
        ModMultiport -> "multiport"
        ModOwner -> "owner"
        ModState -> "state"
        ModTos -> "tos"
        ModTtl -> "ttl"
        ModPhysDev -> "physdev"
        ModComment -> "comment"
        ModOther s -> s

printNatAddr :: NatAddress -> String
printNatAddr (NAIp ip1 ip2) = printNatIp ip1 ip2
printNatAddr (NAIpPort ip1 ip2 port1 port2) = printNatIpPort ip1 ip2 port1 port2

printNatIp :: Word32 -> Word32 -> String
printNatIp ip1 ip2 =
    if ip1 == ip2 then printIp ip1
                  else printIp ip1 ++ "-" ++ printIp ip2

printNatIpPort :: Word32 -> Word32 -> Int -> Int -> String
printNatIpPort ip1 ip2 port1 port2 =
    let ipString = if ip1 == ip2 then printIp ip1
                                else printIp ip1 ++ "-" ++ printIp ip2
        portString = if port1 == port2 then show port1
                                       else show port1 ++ "-" ++ show port2
    in
        ipString ++ ":" ++ portString

printNatPort :: NatPort -> String
printNatPort NatPortDefault = ""
printNatPort (NatPort port1 port2) =
    if port1 == port2
        then show port1
        else show port1 ++ "-" ++ show port2

printRejectWith :: RejectType -> String
printRejectWith rw = case rw of
    RTNetUnreachable -> "icmp-net-unreachable"
    RTHostUnreachable -> "icmp-host-unreachable"
    RTPortUnreachable -> "icmp-port-unreachable"
    RTProtoUnreachable -> "icmp-proto-unreachable"
    RTNetProhibited -> "icmp-net-prohibited"
    RTHostProhibited -> "icmp-host-prohibited"
    RTAdminProhibited -> "icmp-admin-prohibited"
    RTTcpReset -> "tcp-reset"