From d9dd59db2a42d46afda3daa66337d6d47aaa9141 Mon Sep 17 00:00:00 2001 From: CarterPerez-dev Date: Wed, 29 Apr 2026 02:15:14 -0400 Subject: [PATCH] fix: close audit-pass-1 remaining MAJOR + quick MINOR (Findings 14, 19, 20, 28, 29) - Geo.hs (Finding 14): geoAsnCounts is now bounded by defaultGeoAsnCountCap = 200_000. capAsnCounts is called inside bumpAsnCounter; on overflow, the entry with the oldest awWindowStart is evicted via Data.List.minimumBy + Data.Ord.comparing. Closes the unbounded-Map memory growth path. Uses minimumBy and comparing imports added to the existing module. - ML/Middleware.hs, WAF/Engine.hs, Honeypot.hs (Finding 19): em dashes (\x2014) in user-facing response bodies and the generated robots.txt comment replaced with ASCII hyphens, per the project's guardrail-safe terminology rule. - aenebris.cabal (Finding 20): copyright field updated from '2025 Carter Perez' to '2026 AngelaMos' to match the file headers. - ML/IForest.hs (Finding 28): pathLength now respects a hard maxIForestDepth = 64 cutoff. Beyond that depth the function returns currentDepth + c(1) (= currentDepth) without further recursion, so a pathological tree built by a buggy fitter cannot blow the stack. Standard iForest depth is ceil(log2(256)) = 8, so the cap leaves >>8 generous headroom. - ML/Model.hs (Finding 29): validateCategoricalNode now also rejects categorical thresholds that are not whole numbers. A threshold of 1.5 would silently floor to 1 today; with this change it is reported as a clear validation error instead. Real LightGBM never writes non-integer cat indices, so this is defense-in-depth against malformed exporters. Build clean, 358 examples passing, 0 failures. --- .../haskell-reverse-proxy/aenebris.cabal | 2 +- .../haskell-reverse-proxy/src/Aenebris/Geo.hs | 18 ++++++++++++- .../src/Aenebris/Honeypot.hs | 2 +- .../src/Aenebris/ML/IForest.hs | 26 +++++++++++++------ .../src/Aenebris/ML/Middleware.hs | 2 +- .../src/Aenebris/ML/Model.hs | 18 ++++++++----- .../src/Aenebris/WAF/Engine.hs | 2 +- 7 files changed, 50 insertions(+), 20 deletions(-) diff --git a/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal b/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal index a95ad7bd..eac26e1f 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal +++ b/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal @@ -9,7 +9,7 @@ license: MIT license-file: LICENSE author: Carter Perez maintainer: support@certgames.com -copyright: 2025 Carter Perez +copyright: 2026 AngelaMos category: Network, Security, Web build-type: Simple extra-source-files: README.md diff --git a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/Geo.hs b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/Geo.hs index 93567003..774af8fe 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/Geo.hs +++ b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/Geo.hs @@ -60,9 +60,11 @@ import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as LBS import Data.GeoIP2 (GeoDB, GeoResult(..), AS(..), findGeoData, openGeoDB) import Data.IP (IP(..), fromHostAddress, fromHostAddress6) +import Data.List (minimumBy) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe, isJust) +import Data.Ord (comparing) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE @@ -95,6 +97,9 @@ defaultGeoSweepIntervalMicros = 60_000_000 defaultGeoFlaggedAsns :: [Int] defaultGeoFlaggedAsns = [] +defaultGeoAsnCountCap :: Int +defaultGeoAsnCountCap = 200_000 + geoResponseHeaderName :: HeaderName geoResponseHeaderName = "x-aenebris-geo" @@ -262,9 +267,20 @@ bumpAsnCounter Geo{..} n now = do | now - awWindowStart w < window -> w { awCount = awCount w + 1 } _ -> AsnWindow { awCount = 1, awWindowStart = now } - writeTVar geoAsnCounts $! Map.insert n entry m + inserted = Map.insert n entry m + bounded = capAsnCounts inserted + writeTVar geoAsnCounts $! bounded pure (awCount entry) +capAsnCounts :: Map Int AsnWindow -> Map Int AsnWindow +capAsnCounts m + | Map.size m <= defaultGeoAsnCountCap = m + | otherwise = + let oldestKey = fst $ minimumBy + (comparing (awWindowStart . snd)) + (Map.toList m) + in Map.delete oldestKey m + asnConcentrationScore :: Geo -> Int -> Double asnConcentrationScore Geo{..} count = let threshold = max 1 (gcConcentrationThreshold geoConfig) diff --git a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/Honeypot.hs b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/Honeypot.hs index 0e819b4f..6e0fbabb 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/Honeypot.hs +++ b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/Honeypot.hs @@ -274,7 +274,7 @@ robotsResponse cfg = robotsTxtBody :: HoneypotConfig -> ByteString robotsTxtBody HoneypotConfig{..} = BS.concat $ [ "User-agent: *\n" - , "# Honeypot trap paths — Disallow per RFC 9309. Visiting these\n" + , "# Honeypot trap paths. Disallow per RFC 9309. Visiting these\n" , "# paths is treated as a violation signal regardless of declared UA.\n" ] <> map disallowLine hpPatterns where diff --git a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/IForest.hs b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/IForest.hs index 8515c15a..188884bd 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/IForest.hs +++ b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/IForest.hs @@ -16,6 +16,7 @@ module Aenebris.ML.IForest , minSubsampleForNormalization , defaultIForestNumTrees , defaultIForestSubsampleSize + , maxIForestDepth ) where import Data.Vector (Vector) @@ -44,6 +45,12 @@ defaultIForestNumTrees = 100 defaultIForestSubsampleSize :: Int defaultIForestSubsampleSize = 256 +maxIForestDepth :: Int +maxIForestDepth = 64 + +depthBoundLeafSize :: Int +depthBoundLeafSize = 1 + data ITree = ITreeLeaf !Int | ITreeSplit !Int !Double !ITree !ITree @@ -77,14 +84,17 @@ averagePathLength !trees !fv = addPath !acc !tree = acc + pathLength tree fv initialDepth pathLength :: ITree -> VU.Vector Double -> Int -> Double -pathLength !tree !fv !currentDepth = case tree of - ITreeLeaf !size -> - fromIntegral currentDepth + normalizationConstant size - ITreeSplit !featIdx !thr !left !right -> - let !fval = fv VU.! featIdx - in if fval <= thr - then pathLength left fv (currentDepth + 1) - else pathLength right fv (currentDepth + 1) +pathLength !tree !fv !currentDepth + | currentDepth >= maxIForestDepth = + fromIntegral currentDepth + normalizationConstant depthBoundLeafSize + | otherwise = case tree of + ITreeLeaf !size -> + fromIntegral currentDepth + normalizationConstant size + ITreeSplit !featIdx !thr !left !right -> + let !fval = fv VU.! featIdx + in if fval <= thr + then pathLength left fv (currentDepth + 1) + else pathLength right fv (currentDepth + 1) normalizationConstant :: Int -> Double normalizationConstant n diff --git a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Middleware.hs b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Middleware.hs index 1433542f..eb99af13 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Middleware.hs +++ b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Middleware.hs @@ -54,7 +54,7 @@ challengeWireText :: ByteString challengeWireText = "challenge" botBlockBody :: LBS.ByteString -botBlockBody = "403 Forbidden \x2014 request blocked by Aenebris ML" +botBlockBody = "403 Forbidden - request blocked by Aenebris ML" challengePageBody :: LBS.ByteString challengePageBody = diff --git a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Model.hs b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Model.hs index b2faa917..b9f90837 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Model.hs +++ b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Model.hs @@ -329,15 +329,19 @@ validateCategoricalNode :: Int -> Int -> Tree -> Int -> Int -> Int -> Int -> Either String () validateCategoricalNode featureCount nodeCount t i fIdx lIdx rIdx = do validateSplitNode featureCount nodeCount i fIdx lIdx rIdx - let catIdx = floor (treeThreshold t VU.! i) :: Int - nBound = VU.length (treeCatBoundaries t) - if nBound < 2 + let rawThreshold = treeThreshold t VU.! i + catIdx = floor rawThreshold :: Int + nBound = VU.length (treeCatBoundaries t) + if fromIntegral catIdx /= rawThreshold then Left ("Categorical node " <> show i - <> " requires non-empty cat_boundaries") - else if catIdx < 0 || catIdx >= nBound - 1 + <> " has non-integer threshold " <> show rawThreshold) + else if nBound < 2 then Left ("Categorical node " <> show i - <> " has out-of-range bitmap slice index " <> show catIdx) - else Right () + <> " requires non-empty cat_boundaries") + else if catIdx < 0 || catIdx >= nBound - 1 + then Left ("Categorical node " <> show i + <> " has out-of-range bitmap slice index " <> show catIdx) + else Right () validateEnsemble :: Int -> Ensemble -> Either String () validateEnsemble expectedFeatures ens = do diff --git a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/WAF/Engine.hs b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/WAF/Engine.hs index 17eff80b..301f8c07 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/WAF/Engine.hs +++ b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/WAF/Engine.hs @@ -170,4 +170,4 @@ wafMiddleware rsVar app req respond = do [ ("Content-Type", "text/plain; charset=utf-8") , (wafResponseHeader, "blocked score=" <> BC.pack (show score)) ] - "403 Forbidden — request blocked by Aenebris WAF" + "403 Forbidden - request blocked by Aenebris WAF"