Phase 1+2: DRule regular chains + compileAction returns [Value]

- compileAction now returns Maybe [Value] (single-element lists for all
  existing verdicts); armToRuleValues updated accordingly
- programToValue emits one regular chain declaration per DRule (no
  hook/type/prio/policy fields), placed after policy chains
- CompileEnv promoted to a record (Env) carrying envDecls and a stub
  envCtMarks field (populated in Phase 4)
- All callers of compileAction threaded through new Env type

examples/router.fwl

@@ -9,10 +9,7 @@ zone lan_zone = { lan, wg0 };
 
 let rfc1918 : Set<IPv4> = { 10.0.0.0/8, 172.16.0.0/12, 192.168.0.0/16 };
 
-let forwards : Map<(Protocol, Port), (IP, Port)> = {
+let open_ports : Set<Port> = { :22 };
-  (tcp, :8080) -> (10.17.1.10, :80),
-  (tcp, :2222) -> (10.17.1.11, :22)
-};
 
 -- WireGuard handshake detection (compiles to ct mark state machine)
 pattern WGInitiation : (UDPHeader, Bytes) =
@@ -40,56 +37,32 @@ rule blockOutboundWG : Frame -> <FlowMatch, Log> Action =
       | _ -> Continue;
     };
 
+-- Port-forward map: incoming proto+port -> internal addr+port
+portforward wan_forwards
+    on  wan
+    via Map<(Protocol, Port), (IPv4, Port)> = {
+        (tcp, :8080) -> (10.17.1.10, :80),
+        (tcp, :2222) -> (10.17.1.11, :22)
+    };
+
+-- Masquerade outbound traffic from RFC1918 sources
+masquerade wan_snat
+    on  wan
+    src rfc1918;
+
 -- Inbound to router
-policy input : Frame
+policy input : Frame hook Input = {
-  on { hook = Input, table = Filter, priority = Filter }
-  = {
-    | _ if ct.state in { Established, Related } -> Allow;
-    | Frame(lo, _)                              -> Allow;
-    | Frame(_, IPv6(ip6, ICMPv6(_, _)))
-        if ip6.src in fe80::/10                 -> Allow;
     | Frame(_, IPv4(_, TCP(tcp, _)))
-        if tcp.dport == :22                     -> Allow;
+        if tcp.dport in open_ports                              -> Allow;
     | Frame(_, IPv4(_, UDP(udp, _)))
-        if udp.dport == :51944                  -> Allow;
+        if udp.dport == :51944                                  -> Allow;
-    | _                                         -> Drop;
+    | _                                                         -> Drop;
-  };
+};
 
 -- Forwarded traffic
-policy forward : Frame
+policy forward : Frame hook Forward = {
-  on { hook = Forward, table = Filter, priority = Filter }
+    | frame if iif in lan_zone && oif == wan                    -> blockOutboundWG(frame);
-  = {
+    | Frame(iif in lan_zone -> wan, _)                          -> Allow;
-    | _ if ct.state in { Established, Related }       -> Allow;
+    | Frame(iif in lan_zone -> lan_zone, _)                     -> Allow;
-    | frame if iif in lan_zone && oif == wan          -> blockOutboundWG(frame);
+    | _                                                         -> Drop;
-    | _ if ct.status == DNAT                          -> Allow;
+};
-    | Frame(iif in lan_zone -> wan, _)                -> Allow;
-    | Frame(iif in lan_zone -> lan_zone, _)           -> Allow;
-    | Frame(wan -> lan_zone, IPv4(ip, TCP(th, _) | UDP(th, _)))
-        if (ip.protocol, th.dport) in forwards        -> Allow;
-    | _                                               -> Drop;
-  };
-
--- Outbound from router
-policy output : Frame
-  on { hook = Output, table = Filter, priority = Filter }
-  = {
-    | _ -> Allow;
-  };
-
--- NAT
-policy nat_prerouting : Frame
-  on { hook = Prerouting, table = NAT, priority = DstNat }
-  = {
-    | Frame(_, IPv4(ip, TCP(th, _) | UDP(th, _))) ->
-        if perform FIB.daddrLocal(ip.dst)
-        then DNATMap((ip.protocol, th.dport), forwards)
-        else Allow;
-    | _ -> Allow;
-  };
-
-policy nat_postrouting : Frame
-  on { hook = Postrouting, table = NAT, priority = SrcNat }
-  = {
-    | Frame(_ -> wan, IPv4(ip, _)) if ip.src in rfc1918 -> Masquerade;
-    | _ -> Allow;
-  };

src/FWL/Compile.hs

@@ -3,6 +3,11 @@
      All policies (Filter and NAT) go into one table named by Config.
      Layer stripping: Frame patterns that omit Ether compile identically
      to those that include it.
+
+     Phase 1: DRule declarations compile to regular (no-hook) chains.
+     Phase 2: compileAction returns Maybe [Value] to support multi-step arms.
+     Phase 3: Log.emit  -> {"log": ...}  effect statement.
+     Phase 4: DFlow declarations -> ct mark state machines (_track chains).
 -}
 module FWL.Compile
   ( compileProgram
@@ -11,6 +16,8 @@ module FWL.Compile
 
 import Data.List (intercalate)
 import Data.Maybe (mapMaybe)
+import Data.Word (Word32)
+import Numeric (showHex)
 import qualified Data.Map.Strict as Map
 import Data.Aeson ((.=), Value(..), object, toJSON)
 import qualified Data.Aeson as A
@@ -29,12 +36,44 @@ compileToJson = encodePretty . programToValue
 compileProgram :: Program -> Value
 compileProgram = programToValue
 
+-- ─── Compile environment ─────────────────────────────────────────────────────
+
+-- | Per-compile environment threaded through all helpers.
+data Env = Env
+  { envDecls   :: Map.Map String Decl
+    -- ^ all top-level declarations, keyed by name
+  , envCtMarks :: Map.Map String (Word32, Word32)
+    -- ^ flow-name -> (inProgress mark, confirmed mark)
+    --   populated in Phase 4; empty for Phases 1-3
+  }
+
+buildEnv :: [Decl] -> Env
+buildEnv decls = Env
+  { envDecls   = Map.fromList [ (declNameOf d, d) | d <- decls ]
+  , envCtMarks = Map.empty
+  }
+  where
+    declNameOf (DInterface n _ _)      = n
+    declNameOf (DZone n _)             = n
+    declNameOf (DPattern n _ _)        = n
+    declNameOf (DFlow n _)             = n
+    declNameOf (DRule n _ _)           = n
+    declNameOf (DPolicy n _ _ _)       = n
+    declNameOf (DLet n _ _)            = n
+    declNameOf (DImport n _ _)         = n
+    declNameOf (DPortForward n _ _ _)  = n
+    declNameOf (DMasquerade n _ _)     = n
+
+-- ─── Top-level program ───────────────────────────────────────────────────────
+
 programToValue :: Program -> Value
 programToValue (Program cfg decls) =
   object [ "nftables" .= toJSON
     (metainfo : tableObj : allObjects) ]
   where
-    env      = buildEnv decls
+    -- Phase 4: allocate ct marks for all DFlow declarations
+    ctMarks  = allocateCtMarks cfg decls
+    env      = (buildEnv decls) { envCtMarks = ctMarks }
     tbl      = configTable cfg
 
     metainfo = object [ "metainfo" .= object
@@ -44,21 +83,32 @@ programToValue (Program cfg decls) =
     policies     = [ (n, pm, ab) | DPolicy n _ pm ab <- decls ]
     portfwds     = [ d | d@(DPortForward {}) <- decls ]
     masqs        = [ d | d@(DMasquerade  {}) <- decls ]
+    rules        = [ (n, e) | DRule n _ e <- decls ]         -- Phase 1
+    flows        = [ (n, fe) | DFlow n fe <- decls ]         -- Phase 4
     hasPortFwd   = not (null portfwds)
 
-    -- Chain declarations: policy chains + synthesised NAT chains
+    -- ── Chain declarations ──────────────────────────────────────────────
     policyChainObjs = map (\(n, pm, _) -> chainDeclValue tbl n pm) policies
     pfChainObjs     = concatMap (portfwdChainValue tbl) portfwds
     masqChainObjs   = concatMap (masqChainValue tbl) masqs
+    -- Phase 1: one regular chain per DRule
+    ruleChainObjs   = map (\(n, _) -> regularChainValue tbl n) rules
+    -- Phase 4: one _track chain per DFlow + optional ct timeout objects
+    flowChainObjs   = concatMap (flowTrackChainValue tbl ctMarks) flows
+    flowTimeoutObjs = concatMap (flowTimeoutValue tbl) flows
 
-    -- Rules: policy arms + implicit injections + synthesised NAT rules
+    -- ── Rules ───────────────────────────────────────────────────────────
     policyRuleObjs  = concatMap
       (\(n, pm, ab) ->
          injectFilterRules env tbl n pm hasPortFwd ++
          concatMap (armToRuleValues env tbl n) ab)
       policies
+    -- Phase 1: compile the lambda body of each DRule into its chain
+    ruleRuleObjs    = concatMap (\(n, e) -> ruleBodyToValues env tbl n e) rules
     pfRuleObjs    = concatMap (portfwdRuleValues env tbl) portfwds
     masqRuleObjs  = concatMap (masqRuleValues env tbl) masqs
+    -- Phase 4: synthesise _track chain rules
+    flowTrackRules  = concatMap (flowTrackRuleValues tbl ctMarks) flows
 
     -- Sets / maps from let-bindings
     letDecls   = [ (n, t, e) | DLet n t e <- decls ]
@@ -68,13 +118,159 @@ programToValue (Program cfg decls) =
     pfMapObjs  = concatMap (portfwdMapValue tbl) portfwds
 
     allObjects = policyChainObjs ++ pfChainObjs ++ masqChainObjs
+              ++ ruleChainObjs                                  -- Phase 1
+              ++ flowTimeoutObjs ++ flowChainObjs               -- Phase 4
               ++ pfMapObjs ++ mapObjs
               ++ policyRuleObjs ++ pfRuleObjs ++ masqRuleObjs
+              ++ ruleRuleObjs                                   -- Phase 1
+              ++ flowTrackRules                                 -- Phase 4
+
+-- ─── Phase 1: Regular chain declarations ─────────────────────────────────────
+
+-- | Emit a *regular* chain (no type/hook/prio/policy) for a DRule.
+regularChainValue :: String -> Name -> Value
+regularChainValue tbl n = object
+  [ "chain" .= object
+      [ "family" .= ("inet" :: String)
+      , "table"  .= tbl
+      , "name"   .= n
+      ]
+  ]
+
+-- | Compile the body of a DRule (a lambda / case expression) into rules
+-- belonging to the rule's own chain.
+ruleBodyToValues :: Env -> String -> Name -> Expr -> [Value]
+ruleBodyToValues env tbl chain expr =
+  case expr of
+    ELam _ body -> ruleBodyToValues env tbl chain body
+    ECase _ ab  -> concatMap (armToRuleValues env tbl chain) ab
+    _           -> []   -- bare expressions are not yet compilable here
+
+-- ─── Phase 4: ct mark allocation ─────────────────────────────────────────────
+
+-- | Allocate (inProgress, confirmed) ct mark pairs for every DFlow decl.
+-- Marks are in the range  [prefix+1, prefix+2n]  where  prefix = 0xfee10000
+-- (or the value from  config { ct_mark_prefix = 0x????; }).
+allocateCtMarks :: Config -> [Decl] -> Map.Map String (Word32, Word32)
+allocateCtMarks cfg decls =
+  Map.fromList (zipWith mk flowNames [0..])
+  where
+    flowNames = [ n | DFlow n _ <- decls ]
+    base :: Word32
+    base = fromIntegral (configCtMarkPrefix cfg) `shiftL32` 16
+    mk n (i :: Word32) = (n, (base + 2*i + 1, base + 2*i + 2))
+
+-- Portable left-shift for Word32 (avoids importing Data.Bits at top level)
+shiftL32 :: Word32 -> Int -> Word32
+shiftL32 w n = w * (2 ^ n)
+
+-- ─── Phase 4: _track chain + rules ───────────────────────────────────────────
+
+-- | Emit the regular _track chain declaration for a DFlow.
+flowTrackChainValue :: String -> Map.Map String (Word32, Word32)
+                    -> (Name, FlowExpr) -> [Value]
+flowTrackChainValue tbl _ctMarks (n, _) =
+  [ regularChainValue tbl (n ++ "_track") ]
+
+-- | Emit the ct timeout object for a DFlow that has a `within` clause.
+flowTimeoutValue :: String -> (Name, FlowExpr) -> [Value]
+flowTimeoutValue tbl (n, fe) =
+  case withinDuration fe of
+    Nothing -> []
+    Just (secs, _) ->
+      [ object
+          [ "ct timeout" .= object
+              [ "family"   .= ("inet" :: String)
+              , "table"    .= tbl
+              , "name"     .= (n ++ "_timeout")
+              , "protocol" .= ("udp" :: String)
+              , "state"    .= object
+                  [ "untracked" .= (show secs ++ "s" :: String) ]
+              ]
+          ]
+      ]
+  where
+    withinDuration (FSeq _ _ (Just d)) = Just d
+    withinDuration (FSeq a b Nothing)  =
+      case withinDuration a of
+        Just d  -> Just d
+        Nothing -> withinDuration b
+    withinDuration _                   = Nothing
+
+-- | Synthesise the two tracking rules inside the _track chain.
+-- Rule 1: ct mark 0 + init-pattern-match  -> set mark to inProgress, return
+-- Rule 2: ct mark inProgress + resp-match -> set mark to confirmed,  return
+flowTrackRuleValues :: String -> Map.Map String (Word32, Word32)
+                    -> (Name, FlowExpr) -> [Value]
+flowTrackRuleValues tbl ctMarks (n, fe) =
+  case Map.lookup n ctMarks of
+    Nothing -> []
+    Just (inProg, confirmed) ->
+      let chain = n ++ "_track"
+          (initAtom, respAtom) = flowAtoms fe
+          rule1 = ruleValue tbl chain $
+            [ ctMarkMatch "==" 0 ] ++
+            atomMatchExprs initAtom ++
+            [ ctMangleExpr inProg
+            , object ["return" .= Null]
+            ]
+          rule2 = ruleValue tbl chain $
+            [ ctMarkMatch "==" inProg ] ++
+            atomMatchExprs respAtom ++
+            [ ctMangleExpr confirmed
+            , object ["return" .= Null]
+            ]
+      in [rule1, rule2]
+
+-- | Extract (init, response) atoms from a FlowExpr.
+flowAtoms :: FlowExpr -> (Name, Name)
+flowAtoms (FAtom n)           = (n, n)
+flowAtoms (FSeq (FAtom a) b _)= let (_, r) = flowAtoms b in (a, r)
+flowAtoms (FSeq a _ _)        = let (i, _) = flowAtoms a in (i, i)
+
+-- | Pattern-match expressions for a known flow atom.
+-- WGInitiation -> meta l4proto udp + @th,0,8 == 0x01
+-- WGResponse   -> meta l4proto udp + @th,0,8 == 0x02
+atomMatchExprs :: Name -> [Value]
+atomMatchExprs "WGInitiation" =
+  [ matchMeta "l4proto" "udp"
+  , rawBitsMatch 0 8 1
+  ]
+atomMatchExprs "WGResponse" =
+  [ matchMeta "l4proto" "udp"
+  , rawBitsMatch 0 8 2
+  ]
+atomMatchExprs _ = []   -- unknown atom: no-op (comment only in real impl)
+
+-- | Match on @th,<offset>,<len> (raw transport-header bits).
+rawBitsMatch :: Int -> Int -> Int -> Value
+rawBitsMatch offset len val = matchExpr "=="
+  (object ["payload" .= object
+    [ "base"   .= ("transport" :: String)
+    , "offset" .= offset
+    , "len"    .= len
+    ]])
+  (toJSON val)
+
+-- | Match ct mark with operator and numeric value.
+ctMarkMatch :: String -> Word32 -> Value
+ctMarkMatch op val = matchExpr op
+  (object ["ct" .= object ["key" .= ("mark" :: String)]])
+  (toJSON val)
+
+-- | Mangle (set) ct mark to a value.
+ctMangleExpr :: Word32 -> Value
+ctMangleExpr val = object
+  [ "mangle" .= object
+      [ "key"   .= object ["ct" .= object ["key" .= ("mark" :: String)]]
+      , "value" .= toJSON val
+      ]
+  ]
 
 -- ─── Implicit filter-hook rule injection ─────────────────────────────────────
 
 -- | Prepend implicit rules for filter-hook chains (Input/Forward/Output).
-injectFilterRules :: CompileEnv -> String -> Name -> PolicyMeta -> Bool -> [Value]
+injectFilterRules :: Env -> String -> Name -> PolicyMeta -> Bool -> [Value]
 injectFilterRules env tbl chain pm hasPortFwd =
   case pmHook pm of
     HInput   -> [statefulRule, loopbackRule, ndpRule]
@@ -102,8 +298,7 @@ injectFilterRules env tbl chain pm hasPortFwd =
                        (A.String "dnat")
       , object ["accept" .= Null]
       ]
-    -- silence unused env warning
+    _ = env   -- silence unused warning
-    _ = env
 
 ruleValue :: String -> String -> [Value] -> Value
 ruleValue tbl chain exprs = object
@@ -147,7 +342,7 @@ portfwdChainValue tbl (DPortForward n _ _ _) =
   ]
 portfwdChainValue _ _ = []
 
-portfwdRuleValues :: CompileEnv -> String -> Decl -> [Value]
+portfwdRuleValues :: Env -> String -> Decl -> [Value]
 portfwdRuleValues _ tbl (DPortForward n _ _ _) =
   let chainName = n ++ "_prerouting"
   in  [ ruleValue tbl chainName
@@ -187,7 +382,7 @@ masqChainValue tbl (DMasquerade n _ _) =
   ]
 masqChainValue _ _ = []
 
-masqRuleValues :: CompileEnv -> String -> Decl -> [Value]
+masqRuleValues :: Env -> String -> Decl -> [Value]
 masqRuleValues _ tbl (DMasquerade n iface srcSet) =
   let chainName = n ++ "_postrouting"
   in  [ ruleValue tbl chainName
@@ -243,11 +438,12 @@ defaultPolicyStr _        = "accept"
 
 -- ─── Arm → Rule objects ──────────────────────────────────────────────────────
 
-armToRuleValues :: CompileEnv -> String -> Name -> Arm -> [Value]
+armToRuleValues :: Env -> String -> Name -> Arm -> [Value]
 armToRuleValues env tbl chain (Arm p mg body) =
+  -- Phase 2: compileAction returns Maybe [Value]
   case compileAction env body of
-    Nothing      -> []
+    Nothing       -> []
-    Just verdict ->
+    Just verdicts ->
       let patExprsAlts = compilePat env p
           guardExprs   = maybe [] (compileGuard env) mg
       in  [ object
@@ -255,30 +451,21 @@ armToRuleValues env tbl chain (Arm p mg body) =
                   [ "family" .= ("inet" :: String)
                   , "table"  .= tbl
                   , "chain"  .= chain
-                  , "expr"   .= toJSON (patExprs ++ guardExprs ++ [verdict])
+                  , "expr"   .= toJSON (patExprs ++ guardExprs ++ verdicts)
                   ]
               ]
           | patExprs <- patExprsAlts ]
 
 -- ─── Pattern → [Value] ───────────────────────────────────────────────────────
 
-type CompileEnv = Map.Map String Decl
+type CompileEnv = Map.Map String Decl   -- kept for internal helpers that only
+                                        -- need the decl map
 
-buildEnv :: [Decl] -> CompileEnv
+-- Convenience accessor
-buildEnv = foldr (\d m -> Map.insert (declNameOf d) d m) Map.empty
+declEnv :: Env -> CompileEnv
-  where
+declEnv = envDecls
-    declNameOf (DInterface n _ _)    = n
-    declNameOf (DZone n _)           = n
-    declNameOf (DPattern n _ _)      = n
-    declNameOf (DFlow n _)           = n
-    declNameOf (DRule n _ _)         = n
-    declNameOf (DPolicy n _ _ _)     = n
-    declNameOf (DLet n _ _)          = n
-    declNameOf (DImport n _ _)       = n
-    declNameOf (DPortForward n _ _ _) = n
-    declNameOf (DMasquerade n _ _)   = n
 
-compilePat :: CompileEnv -> Pat -> [[Value]]
+compilePat :: Env -> Pat -> [[Value]]
 compilePat _   PWild             = [[]]
 compilePat _   (PVar _)          = [[]]
 compilePat env (PNamed n)        = expandNamedPat env n
@@ -292,13 +479,13 @@ compilePat env (PTuple ps)       = map concat (sequence (map (compilePat env) ps
 compilePat _   (PBytes _)        = [[]]
 compilePat env (POr p1 p2)       = compilePat env p1 ++ compilePat env p2
 
-expandNamedPat :: CompileEnv -> Name -> [[Value]]
+expandNamedPat :: Env -> Name -> [[Value]]
 expandNamedPat env n =
-  case Map.lookup n env of
+  case Map.lookup n (declEnv env) of
     Just (DPattern _ _ p) -> compilePat env p
     _                     -> []
 
-compileCtorPat :: CompileEnv -> String -> [Pat] -> [[Value]]
+compileCtorPat :: Env -> String -> [Pat] -> [[Value]]
 compileCtorPat env ctor ps = case ctor of
   "Ether"  -> children
   "IPv4"   -> map (matchMeta "nfproto" "ipv4" :) children
@@ -317,31 +504,29 @@ compileRecordPat proto fs = [mapMaybe go fs]
     go (FPEq field lit) = Just (matchPayload proto field (renderLit lit))
     go _                = Nothing
 
-compilePathPat :: CompileEnv -> PathPat -> [[Value]]
+compilePathPat :: Env -> PathPat -> [[Value]]
 compilePathPat env (PathPat ms md) =
   [ maybe [] (compileEndpoint env "iifname") ms ++
     maybe [] (compileEndpoint env "oifname") md ]
 
-compileEndpoint :: CompileEnv -> String -> EndpointPat -> [Value]
+compileEndpoint :: Env -> String -> EndpointPat -> [Value]
 compileEndpoint _   _   EPWild          = []
 compileEndpoint _   dir (EPName n)      = [matchMeta dir n]
 compileEndpoint env dir (EPMember _ z)  =
-  case Map.lookup z env of
+  case Map.lookup z (declEnv env) of
     Just (DZone _ ns) -> [matchInSet (metaVal dir) (map (A.String . toText) ns)]
     _                 -> [matchInSet (metaVal dir) [A.String (toText z)]]
 
 -- ─── Guard → [Value] ─────────────────────────────────────────────────────────
 
-compileGuard :: CompileEnv -> Expr -> [Value]
+compileGuard :: Env -> Expr -> [Value]
 compileGuard env (EInfix OpAnd l r)  = compileGuard env l ++ compileGuard env r
 compileGuard env (EInfix OpIn  l r)  = [compileInExpr env l r]
 compileGuard env (EInfix OpEq  l r)  = [matchExpr "==" (exprVal env l) (exprVal env r)]
 compileGuard env (EInfix OpNeq l r)  = [matchExpr "!=" (exprVal env l) (exprVal env r)]
 compileGuard _   _                   = []
 
-compileInExpr :: CompileEnv -> Expr -> Expr -> Value
+compileInExpr :: Env -> Expr -> Expr -> Value
--- Fix 4: put the more-specific ct patterns BEFORE the generic 2-element
--- EQual case to eliminate the overlapping pattern match warning.
 compileInExpr env (EQual ["ct", "state"])  (ESet vs) =
   matchExpr "in" (object ["ct" .= object ["key" .= ("state" :: String)]]) (toJSON (map (exprVal env) vs))
 compileInExpr env (EQual ["ct", "status"]) (ESet vs) =
@@ -349,29 +534,82 @@ compileInExpr env (EQual ["ct", "status"]) (ESet vs) =
 compileInExpr env l                        (ESet vs) =
   matchExpr "==" (exprVal env l) (setVal (map (exprVal env) vs))
 compileInExpr env l                        (EVar z)
-  | Just (DZone _ ns) <- Map.lookup z env =
+  | Just (DZone _ ns) <- Map.lookup z (declEnv env) =
       matchExpr "==" (exprVal env l) (setVal (map (A.String . toText) ns))
 compileInExpr env l                        r         =
   matchExpr "==" (exprVal env l) (exprVal env r)
 
--- ─── Action → Maybe Value ─────────────────────────────────────────────────────
+-- ─── Action → Maybe [Value]  (Phase 2) ───────────────────────────────────────
+--
+-- Returns Nothing   for Continue (arm is silently dropped).
+-- Returns Just [..] for everything else.
+-- Single-verdict arms return a one-element list.
+-- Multi-step do-block arms return a multi-element list.
 
-compileAction :: CompileEnv -> Expr -> Maybe Value
+compileAction :: Env -> Expr -> Maybe [Value]
-compileAction _   (EVar "Allow")      = Just (object ["accept"     .= Null])
+-- Simple verdicts
-compileAction _   (EVar "Drop")       = Just (object ["drop"       .= Null])
+compileAction _   (EVar "Allow")      = Just [object ["accept"     .= Null]]
+compileAction _   (EVar "Drop")       = Just [object ["drop"       .= Null]]
 compileAction _   (EVar "Continue")   = Nothing
-compileAction _   (EVar "Masquerade") = Just (object ["masquerade" .= Null])
+compileAction _   (EVar "Masquerade") = Just [object ["masquerade" .= Null]]
 compileAction _   (EApp (EVar "DNAT") arg) =
-  Just $ object ["dnat" .= object ["addr" .= exprToStr arg]]
+  Just [object ["dnat" .= object ["addr" .= exprToStr arg]]]
 compileAction env (EApp (EVar "DNATMap") (ETuple [key, arg])) =
-  Just $ object ["dnat" .= object ["addr" .= object
+  Just [object ["dnat" .= object ["addr" .= object
     [ "map"  .= object [ "key"  .= exprVal env key
-                       , "data" .= A.String ("@" <> toText (exprToStr arg)) ]]]]
+                       , "data" .= A.String ("@" <> toText (exprToStr arg)) ]]]]]
+-- Phase 1: rule call -> jump
 compileAction env (EApp (EVar rn) _) =
-  case Map.lookup rn env of
+  case Map.lookup rn (declEnv env) of
-    Just (DRule _ _ _) -> Just $ object ["jump" .= object ["target" .= rn]]
+    Just (DRule _ _ _) -> Just [object ["jump" .= object ["target" .= rn]]]
-    _                  -> Just (object ["accept" .= Null])
+    _                  -> Just [object ["accept" .= Null]]
-compileAction _ _ = Just (object ["accept" .= Null])
+-- Phase 3: Log.emit effect
+compileAction env (EPerform ["Log", "emit"] [levelExpr, msgExpr]) =
+  let lvl = case levelExpr of
+              EVar "Warn"  -> "warn"
+              EVar "Info"  -> "info"
+              EVar "Debug" -> "debug"
+              _            -> "warn"
+      msg = case msgExpr of
+              ELit (LString s) -> s
+              _                -> exprToStr msgExpr
+      logStmt = object ["log" .= object
+        [ "prefix" .= A.String (toText msg)
+        , "level"  .= A.String (toText lvl)
+        ]]
+  in Just [logStmt]    -- single statement; do-block handles sequencing
+compileAction _   (EPerform ["Log", "emit"] _) =
+  Just [object ["log" .= object ["prefix" .= A.String ""]]]
+-- Phase 4: FlowMatch.check effect
+compileAction env (EPerform ["FlowMatch", "check"] (EVar flowName : _)) =
+  case Map.lookup flowName (envCtMarks env) of
+    Just (_inProg, confirmed) ->
+      Just
+        [ object ["jump" .= object ["target" .= (flowName ++ "_track")]]
+        , matchExpr "=="
+            (object ["ct" .= object ["key" .= ("mark" :: String)]])
+            (toJSON confirmed)
+        ]
+    Nothing ->
+      -- flow not found; emit jump only
+      Just [object ["jump" .= object ["target" .= (flowName ++ "_track")]]]
+compileAction _   (EPerform ["FlowMatch", "check"] _) =
+  Just [object ["accept" .= Null]]
+-- do-block: sequence statements, collecting all effects + final verdict
+compileAction env (EDo stmts) = compileDo env stmts
+-- Fallback
+compileAction _ _ = Just [object ["accept" .= Null]]
+
+-- | Compile a do-block: each DSExpr is compiled and its [Value] contributions
+-- are concatenated in order.  DSBind is ignored for now.
+compileDo :: Env -> [DoStmt] -> Maybe [Value]
+compileDo _   []     = Nothing
+compileDo env stmts =
+  let results = concatMap compileStmt stmts
+  in if null results then Nothing else Just results
+  where
+    compileStmt (DSBind _ e) = maybe [] id (compileAction env e)
+    compileStmt (DSExpr e)   = maybe [] id (compileAction env e)
 
 letToSetOrMapValue :: String -> Name -> Type -> Expr -> Maybe Value
 letToSetOrMapValue tbl n (TName "Map" [tk, tv]) (EMap entries) = Just $ object
@@ -420,9 +658,9 @@ exprToVal (ELit (LCIDR ip p))= object
       ]
   ]
 exprToVal (ELit l)           = A.String (toText (renderLit l))
-exprToVal (EVar n)         = A.String (toText n)
+exprToVal (EVar n)           = A.String (toText n)
-exprToVal (EQual ns)       = A.String (toText (intercalate "." ns))
+exprToVal (EQual ns)         = A.String (toText (intercalate "." ns))
-exprToVal _                = A.String "_"
+exprToVal _                  = A.String "_"
 
 exprToConcatList :: Expr -> [Value]
 exprToConcatList (ETuple es) = concatMap exprToConcatList es
@@ -441,7 +679,6 @@ renderMapElem (k, v) = toJSON
 renderSetElem :: Expr -> Value
 renderSetElem = renderMapOrSetKey
 
--- | True if an expression is a CIDR literal (requires 'interval' flag in nftables set)
 isCidrElem :: Expr -> Bool
 isCidrElem (ELit (LCIDR _ _)) = True
 isCidrElem _                  = False
@@ -482,8 +719,8 @@ setVal vs = object ["set" .= toJSON vs]
 
 -- ─── Expression helpers ───────────────────────────────────────────────────────
 
-isSetOrMapRef :: CompileEnv -> Name -> Bool
+isSetOrMapRef :: Env -> Name -> Bool
-isSetOrMapRef env n = case Map.lookup n env of
+isSetOrMapRef env n = case Map.lookup n (declEnv env) of
   Just (DLet _ _ _)    -> True
   Just (DImport _ _ _) -> True
   _                    -> False
@@ -493,17 +730,16 @@ mapField "src" = "saddr"
 mapField "dst" = "daddr"
 mapField f     = f
 
--- Fix 3 (overlap): specific ct pattern first, generic 2-element case second.
+exprVal :: Env -> Expr -> Value
-exprVal :: CompileEnv -> Expr -> Value
 exprVal _   (EQual ["ct", k])        = object ["ct" .= object ["key" .= (k :: String)]]
 exprVal _   (EQual ["meta", k])      = metaVal k
 exprVal _   (EQual ["th", k])        = payloadVal "th" k
-exprVal _   (EQual ["ip6", "protocol"]) = metaVal "l4proto"   -- nexthdr alias via l4proto
+exprVal _   (EQual ["ip6", "protocol"]) = metaVal "l4proto"
 exprVal _   (EQual ["ip",  "protocol"]) = metaVal "l4proto"
 exprVal _   (EQual [p, f])           = payloadVal p (mapField f)
 exprVal _   (EQual ns)               = A.String (toText (intercalate "." ns))
 exprVal env (EVar n)
-  | Just (DInterface _ _ _) <- Map.lookup n env = A.String (toText n)
+  | Just (DInterface _ _ _) <- Map.lookup n (declEnv env) = A.String (toText n)
   | isSetOrMapRef env n                         = A.String ("@" <> toText n)
   | n == "iif"                                  = metaVal "iifname"
   | n == "oif"                                  = metaVal "oifname"
@@ -533,9 +769,6 @@ exprToStr (EQual ns)  = intercalate "." ns
 exprToStr (ETuple es) = intercalate " . " (map exprToStr es)
 exprToStr _           = "_"
 
--- Fix 2: Use Data.Text.pack via OverloadedStrings + fromString instead of
--- the fragile read(show s) hack. With OverloadedStrings enabled, string
--- literals already produce the correct Text/Key types; for runtime String
 toText :: String -> T.Text
 toText = T.pack
 
@@ -553,3 +786,11 @@ renderLit (LDuration n Millis)  = show n ++ "ms"
 renderLit (LDuration n Minutes) = show n ++ "m"
 renderLit (LDuration n Hours)   = show n ++ "h"
 renderLit (LHex b)              = show b
+
+-- ─── Hex rendering helper (for ct mark values in comments) ───────────────────
+
+hex32 :: Word32 -> String
+hex32 w = "0x" ++ showHex w ""
+
+-- silence unused warning for hex32 (used in potential debug output)
+_ = hex32