crazy mega refactor

test/ParserTests.hs

@@ -17,6 +17,8 @@ tests = testGroup "Parser"
   , typeTests
   , exprTests
   , policyTests
+  , portforwardTests
+  , masqueradeTests
   , ruleTests
   , configTests
   , errorTests
@@ -351,31 +353,38 @@ exprTests = testGroup "expressions"
 
 policyTests :: TestTree
 policyTests = testGroup "policy"
-  [ testCase "minimal policy" $ do
-      p <- parseOk
-            "policy output : Frame \
-            \  on { hook = Output, table = Filter, priority = Filter } \
-            \  = { | _ -> Allow; };"
+  [ testCase "compact hook Input syntax" $ do
+      p <- parseOk "policy input : Frame hook Input = { | _ -> Drop; };"
       d <- singleDecl p
       case d of
-        DPolicy "output" _ (PolicyMeta HOutput TFilter (Priority 0)) [_] -> return ()
+        DPolicy "input" _ (PolicyMeta HInput TFilter (Priority 0)) [_] -> return ()
         _ -> assertFailure (show d)
 
-  , testCase "NAT prerouting" $ do
+  , testCase "hook Prerouting priority Mangle" $ do
       p <- parseOk
-            "policy nat_pre : Frame \
-            \  on { hook = Prerouting, table = NAT, priority = DstNat } \
-            \  = { | _ -> Allow; };"
+            "policy pre : Frame hook Prerouting priority Mangle = { | _ -> Drop; };"
       d <- singleDecl p
       case d of
-        DPolicy _ _ (PolicyMeta HPrerouting TNAT (Priority (-100))) _ -> return ()
+        DPolicy _ _ (PolicyMeta HPrerouting TNAT (Priority (-150))) _ -> return ()
+        _ -> assertFailure (show d)
+
+  , testCase "hook Forward infers filter table and priority 0" $ do
+      p <- parseOk "policy forward : Frame hook Forward = { | _ -> Drop; };"
+      d <- singleDecl p
+      case d of
+        DPolicy _ _ (PolicyMeta HForward TFilter (Priority 0)) _ -> return ()
+        _ -> assertFailure (show d)
+
+  , testCase "hook Postrouting infers nat table and priority 100" $ do
+      p <- parseOk "policy post : Frame hook Postrouting = { | _ -> Allow; };"
+      d <- singleDecl p
+      case d of
+        DPolicy _ _ (PolicyMeta HPostrouting TNAT (Priority 100)) _ -> return ()
         _ -> assertFailure (show d)
 
   , testCase "arm with guard" $ do
       p <- parseOk
-            "policy input : Frame \
-            \  on { hook = Input, table = Filter, priority = Filter } \
-            \  = { \
+            "policy input : Frame hook Input = { \
             \    | _ if ct.state in { Established, Related } -> Allow; \
             \    | _ -> Drop; \
             \  };"
@@ -386,9 +395,7 @@ policyTests = testGroup "policy"
 
   , testCase "Frame pattern with path" $ do
       p <- parseOk
-            "policy forward : Frame \
-            \  on { hook = Forward, table = Filter, priority = Filter } \
-            \  = { \
+            "policy forward : Frame hook Forward = { \
             \    | Frame(iif in lan_zone -> wan, _) -> Allow; \
             \    | _ -> Drop; \
             \  };"
@@ -399,9 +406,7 @@ policyTests = testGroup "policy"
 
   , testCase "Frame pattern without Ether (layer stripping)" $ do
       p <- parseOk
-            "policy input : Frame \
-            \  on { hook = Input, table = Filter, priority = Filter } \
-            \  = { \
+            "policy input : Frame hook Input = { \
             \    | Frame(_, IPv4(ip, TCP(tcp, _))) if tcp.dport == :22 -> Allow; \
             \    | _ -> Drop; \
             \  };"
@@ -412,9 +417,7 @@ policyTests = testGroup "policy"
 
   , testCase "policy arm calls rule" $ do
       p <- parseOk
-            "policy forward : Frame \
-            \  on { hook = Forward, table = Filter, priority = Filter } \
-            \  = { \
+            "policy forward : Frame hook Forward = { \
             \    | frame -> blockOutboundWG(frame); \
             \  };"
       d <- singleDecl p
@@ -435,6 +438,36 @@ policyTests = testGroup "policy"
         _ -> assertFailure (show d)
   ]
 
+-- ─── PortForward ─────────────────────────────────────────────────────────────
+
+portforwardTests :: TestTree
+portforwardTests = testGroup "portforward"
+  [ testCase "basic portforward decl" $ do
+      p <- parseOk
+            "portforward wan_forwards \
+            \    on  wan \
+            \    via Map<(Protocol, Port), (IPv4, Port)> = { \
+            \        (tcp, :8080) -> (10.0.0.10, :80) \
+            \    };"
+      d <- singleDecl p
+      case d of
+        DPortForward "wan_forwards" "wan" (TName "Map" [TTuple _, TTuple _]) [(_, _)] -> return ()
+        DPortForward "wan_forwards" "wan" _ [_] -> return ()
+        _ -> assertFailure (show d)
+  ]
+
+-- ─── Masquerade ──────────────────────────────────────────────────────────────
+
+masqueradeTests :: TestTree
+masqueradeTests = testGroup "masquerade"
+  [ testCase "basic masquerade decl" $ do
+      p <- parseOk "masquerade wan_snat on wan src rfc1918;"
+      d <- singleDecl p
+      case d of
+        DMasquerade "wan_snat" "wan" "rfc1918" -> return ()
+        _ -> assertFailure (show d)
+  ]
+
 -- ─── Rule ────────────────────────────────────────────────────────────────────
 
 ruleTests :: TestTree
@@ -495,17 +528,18 @@ errorTests = testGroup "parse errors"
   [ testCase "missing semicolon" $
       parseFail "interface wan : WAN {}"
 
-  , testCase "unknown hook" $
+  , testCase "old on-brace policy syntax is a parse error" $
       parseFail
         "policy p : Frame \
-        \  on { hook = Bogus, table = Filter, priority = Filter } \
+        \  on { hook = Input, table = Filter, priority = Filter } \
         \  = { | _ -> Allow; };"
 
+  , testCase "unknown hook" $
+      parseFail
+        "policy p : Frame hook Bogus = { | _ -> Allow; };"
+
   , testCase "empty arm block with no arms is ok" $ do
-      p <- parseOk
-            "policy output : Frame \
-            \  on { hook = Output, table = Filter, priority = Filter } \
-            \  = {};"
+      p <- parseOk "policy output : Frame hook Output = {};"
       d <- singleDecl p
       case d of
         DPolicy _ _ _ [] -> return ()