diff --git a/src/FWL/Compile.hs b/src/FWL/Compile.hs index 54246a7..a2c8cea 100644 --- a/src/FWL/Compile.hs +++ b/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,, (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 + _ = env -- silence unused warning 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 -> [] - Just verdict -> + Nothing -> [] + 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 -buildEnv = foldr (\d m -> Map.insert (declNameOf d) d m) 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 +-- Convenience accessor +declEnv :: Env -> CompileEnv +declEnv = envDecls -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 --- Fix 4: put the more-specific ct patterns BEFORE the generic 2-element --- EQual case to eliminate the overlapping pattern match warning. +compileInExpr :: Env -> Expr -> Expr -> Value 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 _ (EVar "Allow") = Just (object ["accept" .= Null]) -compileAction _ (EVar "Drop") = Just (object ["drop" .= Null]) +compileAction :: Env -> Expr -> Maybe [Value] +-- Simple verdicts +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 - Just (DRule _ _ _) -> Just $ object ["jump" .= object ["target" .= rn]] - _ -> Just (object ["accept" .= Null]) -compileAction _ _ = Just (object ["accept" .= Null]) + case Map.lookup rn (declEnv env) of + Just (DRule _ _ _) -> Just [object ["jump" .= object ["target" .= rn]]] + _ -> 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 (EQual ns) = A.String (toText (intercalate "." ns)) -exprToVal _ = A.String "_" +exprToVal (EVar n) = A.String (toText n) +exprToVal (EQual ns) = A.String (toText (intercalate "." ns)) +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 n = case Map.lookup n env of +isSetOrMapRef :: Env -> Name -> Bool +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 :: CompileEnv -> Expr -> Value +exprVal :: Env -> 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