feat: add Aenebris.ML.Loader for LightGBM v4 model parsing

- New Aenebris.ML.Loader module: pure ByteString -> Either ParseError Ensemble
  parser for LightGBM v4 plain-text models. Header / tree-blocks / trailing-
  section state machine; converts split-arrays + leaf-arrays into the unified
  Tree SoA via unifyChild + complement; rejects non-v4, multi-class, and
  is_linear=1; extracts embedded sigmoid scale and bare average_output flag;
  runs validateEnsemble before returning.
- Frozen test fixtures under test/fixtures/ml/ (tiny_lgbm_v4.txt,
  stump_lgbm_v4.txt) hand-crafted from the v4 spec annotated example. CI runs
  against these with zero Python dependency.
- scripts/regen_lgbm_fixture.py: uv-runnable PEP 723 script that retrains a
  tiny binary GBDT and writes to a separate
  test/fixtures/ml/regen_sample_v4.txt so the frozen fixtures stay pristine.
- 30 new mlLoaderSpec tests covering happy path, header rejection, sigmoid
  extraction, average_output, tree-level rejection, feature_names with '=',
  and ParseError reporting. 238 total examples passing, 0 GHC warnings on
  Loader.

PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal

@@ -40,6 +40,7 @@ library
                      , Aenebris.Geo
                      , Aenebris.ML.Features
                      , Aenebris.ML.Model
+                     , Aenebris.ML.Loader
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5
                      , warp >= 3.3

PROJECTS/advanced/haskell-reverse-proxy/scripts/regen_lgbm_fixture.py

@@ -0,0 +1,91 @@
+"""
+©AngelaMos | 2026
+regen_lgbm_fixture.py
+"""
+
+# /// script
+# requires-python = ">=3.11"
+# dependencies = [
+#     "lightgbm>=4.0,<5",
+#     "numpy>=1.26",
+# ]
+# ///
+
+import lightgbm as lgb
+import numpy as np
+from pathlib import Path
+
+OUTPUT_PATH = (
+    Path(__file__).resolve().parent.parent
+    / "test"
+    / "fixtures"
+    / "ml"
+    / "regen_sample_v4.txt"
+)
+NUM_FEATURES = 4
+NUM_SAMPLES = 200
+NUM_LEAVES = 7
+NUM_BOOST_ROUND = 3
+RANDOM_SEED = 42
+CAT_FEATURE_COL = 3
+CAT_VALUES = [0, 1, 2, 3]
+NOISE_SCALE = 0.5
+LEARNING_RATE = 0.1
+MIN_DATA_IN_LEAF = 5
+MIN_DATA_PER_GROUP = 5
+WEIGHT_FEAT_0 = 1.0
+WEIGHT_FEAT_1 = 0.5
+WEIGHT_FEAT_2 = -1.0
+
+
+def make_dataset() -> tuple[np.ndarray, np.ndarray]:
+    """
+    Build a deterministic synthetic dataset with one categorical feature
+    """
+    rng = np.random.default_rng(RANDOM_SEED)
+    features = rng.normal(0, 1, (NUM_SAMPLES, NUM_FEATURES))
+    features[:, CAT_FEATURE_COL] = rng.choice(CAT_VALUES, size=NUM_SAMPLES)
+    signal = (
+        WEIGHT_FEAT_0 * features[:, 0]
+        + WEIGHT_FEAT_1 * features[:, 1]
+        + WEIGHT_FEAT_2 * features[:, 2]
+    )
+    noise = rng.normal(0, NOISE_SCALE, NUM_SAMPLES)
+    labels = ((signal + noise) > 0).astype(int)
+    return features, labels
+
+
+def train_model(features: np.ndarray, labels: np.ndarray) -> lgb.Booster:
+    """
+    Train a tiny binary GBDT with one categorical feature
+    """
+    dataset = lgb.Dataset(
+        features,
+        label=labels,
+        categorical_feature=[CAT_FEATURE_COL],
+        feature_name=[f"feat{i}" for i in range(NUM_FEATURES)],
+    )
+    params = {
+        "objective": "binary",
+        "num_leaves": NUM_LEAVES,
+        "learning_rate": LEARNING_RATE,
+        "verbose": -1,
+        "min_data_in_leaf": MIN_DATA_IN_LEAF,
+        "min_data_per_group": MIN_DATA_PER_GROUP,
+    }
+    return lgb.train(params, dataset, num_boost_round=NUM_BOOST_ROUND)
+
+
+def main() -> None:
+    """
+    Train the booster and save it to the regen fixture path
+    """
+    features, labels = make_dataset()
+    booster = train_model(features, labels)
+    OUTPUT_PATH.parent.mkdir(parents=True, exist_ok=True)
+    booster.save_model(str(OUTPUT_PATH))
+    print(f"Wrote {OUTPUT_PATH}")
+
+
+if __name__ == "__main__":
+    main()

PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Loader.hs

@@ -0,0 +1,592 @@
+{-
+©AngelaMos | 2026
+Loader.hs
+-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Aenebris.ML.Loader
+  ( ParseError(..)
+  , parseEnsemble
+  ) where
+
+import Control.Monad (unless, when)
+import Data.Bits (complement)
+import qualified Data.ByteString as BS
+import Data.Foldable (foldlM)
+import Data.Int (Int8)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Data.Text.Read as TR
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as VU
+import Data.Word (Word32)
+
+import Aenebris.ML.Model
+  ( Ensemble(..)
+  , Objective(..)
+  , Tree(..)
+  , currentEnsembleVersion
+  , defaultSigmoidScale
+  , leafSentinel
+  , makeLeafTree
+  , noChildIndex
+  , parseObjective
+  , validateEnsemble
+  )
+
+expectedVersion :: Text
+expectedVersion = "v4"
+
+requiredNumClass :: Int
+requiredNumClass = 1
+
+requiredNumTreePerIteration :: Int
+requiredNumTreePerIteration = 1
+
+postParseLineSentinel :: Int
+postParseLineSentinel = -1
+
+initialBaseScore :: Double
+initialBaseScore = 0.0
+
+baseTreeKeyPrefix :: Text
+baseTreeKeyPrefix = "Tree="
+
+endOfTreesMarker :: Text
+endOfTreesMarker = "end of trees"
+
+averageOutputBareKey :: Text
+averageOutputBareKey = "average_output"
+
+sigmoidPrefix :: Text
+sigmoidPrefix = "sigmoid:"
+
+equalsSign :: Text
+equalsSign = "="
+
+validationKey :: Text
+validationKey = "<validation>"
+
+headerKey :: Text
+headerKey = "<header>"
+
+treeKey :: Text
+treeKey = "<tree>"
+
+keyTreeFirstLine :: Text
+keyTreeFirstLine = "tree"
+
+keyVersion :: Text
+keyVersion = "version"
+
+keyNumClass :: Text
+keyNumClass = "num_class"
+
+keyNumTreePerIteration :: Text
+keyNumTreePerIteration = "num_tree_per_iteration"
+
+keyLabelIndex :: Text
+keyLabelIndex = "label_index"
+
+keyMaxFeatureIdx :: Text
+keyMaxFeatureIdx = "max_feature_idx"
+
+keyObjective :: Text
+keyObjective = "objective"
+
+keyFeatureNames :: Text
+keyFeatureNames = "feature_names"
+
+keyFeatureInfos :: Text
+keyFeatureInfos = "feature_infos"
+
+keyMonotoneConstraints :: Text
+keyMonotoneConstraints = "monotone_constraints"
+
+keyTreeSizes :: Text
+keyTreeSizes = "tree_sizes"
+
+keyNumLeaves :: Text
+keyNumLeaves = "num_leaves"
+
+keyNumCat :: Text
+keyNumCat = "num_cat"
+
+keySplitFeature :: Text
+keySplitFeature = "split_feature"
+
+keyThreshold :: Text
+keyThreshold = "threshold"
+
+keyDecisionType :: Text
+keyDecisionType = "decision_type"
+
+keyLeftChild :: Text
+keyLeftChild = "left_child"
+
+keyRightChild :: Text
+keyRightChild = "right_child"
+
+keyLeafValue :: Text
+keyLeafValue = "leaf_value"
+
+keyCatBoundaries :: Text
+keyCatBoundaries = "cat_boundaries"
+
+keyCatThreshold :: Text
+keyCatThreshold = "cat_threshold"
+
+keyIsLinear :: Text
+keyIsLinear = "is_linear"
+
+ignoredHeaderKeys :: [Text]
+ignoredHeaderKeys =
+  [ keyFeatureInfos
+  , keyLabelIndex
+  , keyMonotoneConstraints
+  , keyTreeSizes
+  ]
+
+ignoredTreeKeys :: [Text]
+ignoredTreeKeys =
+  [ "split_gain"
+  , "leaf_weight"
+  , "leaf_count"
+  , "internal_value"
+  , "internal_weight"
+  , "internal_count"
+  , "shrinkage"
+  ]
+
+data ParseError = ParseError
+  { peLine   :: !Int
+  , peKey    :: !Text
+  , peReason :: !Text
+  } deriving (Eq, Show)
+
+data RawHeader = RawHeader
+  { rhVersion             :: !Text
+  , rhNumClass            :: !Int
+  , rhNumTreePerIteration :: !Int
+  , rhMaxFeatureIdx       :: !Int
+  , rhFeatureCount        :: !Int
+  , rhObjective           :: !Objective
+  , rhSigmoidScale        :: !Double
+  , rhAverageOutput       :: !Bool
+  , rhFeatureNames        :: ![Text]
+  }
+
+data HeaderAcc = HeaderAcc
+  { haVersion             :: !(Maybe Text)
+  , haNumClass            :: !(Maybe Int)
+  , haNumTreePerIteration :: !(Maybe Int)
+  , haMaxFeatureIdx       :: !(Maybe Int)
+  , haObjective           :: !(Maybe Objective)
+  , haSigmoidScale        :: !Double
+  , haAverageOutput       :: !Bool
+  , haFeatureNames        :: !(Maybe [Text])
+  }
+
+emptyHeaderAcc :: HeaderAcc
+emptyHeaderAcc = HeaderAcc
+  { haVersion             = Nothing
+  , haNumClass            = Nothing
+  , haNumTreePerIteration = Nothing
+  , haMaxFeatureIdx       = Nothing
+  , haObjective           = Nothing
+  , haSigmoidScale        = defaultSigmoidScale
+  , haAverageOutput       = False
+  , haFeatureNames        = Nothing
+  }
+
+data TreeAcc = TreeAcc
+  { taNumLeaves     :: !(Maybe Int)
+  , taNumCat        :: !(Maybe Int)
+  , taSplitFeature  :: !(Maybe [Int])
+  , taThreshold     :: !(Maybe [Double])
+  , taDecisionType  :: !(Maybe [Int8])
+  , taLeftChild     :: !(Maybe [Int])
+  , taRightChild    :: !(Maybe [Int])
+  , taLeafValue     :: !(Maybe [Double])
+  , taCatBoundaries :: !(Maybe [Int])
+  , taCatThreshold  :: !(Maybe [Word32])
+  }
+
+emptyTreeAcc :: TreeAcc
+emptyTreeAcc = TreeAcc
+  { taNumLeaves     = Nothing
+  , taNumCat        = Nothing
+  , taSplitFeature  = Nothing
+  , taThreshold     = Nothing
+  , taDecisionType  = Nothing
+  , taLeftChild     = Nothing
+  , taRightChild    = Nothing
+  , taLeafValue     = Nothing
+  , taCatBoundaries = Nothing
+  , taCatThreshold  = Nothing
+  }
+
+parseEnsemble :: BS.ByteString -> Either ParseError Ensemble
+parseEnsemble bs = case TE.decodeUtf8' bs of
+  Left _   -> Left (ParseError 1 headerKey "Input is not valid UTF-8")
+  Right tx -> parseFromText tx
+
+parseFromText :: Text -> Either ParseError Ensemble
+parseFromText tx = do
+  let numbered = zip [1 :: Int ..] (T.lines tx)
+  (hdr, afterHeader) <- runHeader numbered
+  trees <- runTrees afterHeader
+  let ens = buildEnsemble hdr trees
+  case validateEnsemble (rhFeatureCount hdr) ens of
+    Left err -> Left
+      (ParseError postParseLineSentinel validationKey (T.pack err))
+    Right () -> Right ens
+
+buildEnsemble :: RawHeader -> [Tree] -> Ensemble
+buildEnsemble hdr trees = Ensemble
+  { ensembleVersion       = currentEnsembleVersion
+  , ensembleFeatureCount  = rhFeatureCount hdr
+  , ensembleObjective     = rhObjective hdr
+  , ensembleBaseScore     = initialBaseScore
+  , ensembleSigmoidScale  = rhSigmoidScale hdr
+  , ensembleAverageOutput = rhAverageOutput hdr
+  , ensembleTrees         = V.fromList trees
+  }
+
+runHeader :: [(Int, Text)] -> Either ParseError (RawHeader, [(Int, Text)])
+runHeader allLines = case dropWhile (lineIsBlank . snd) allLines of
+  [] -> Left (ParseError 1 headerKey "Empty input")
+  ((n, firstLn):rest) -> do
+    unless (T.strip firstLn == keyTreeFirstLine)
+      (Left (ParseError n headerKey
+              ("First non-empty line must be 'tree', got: " <> firstLn)))
+    let (headerLines, treeRest) = breakAtTreeBlock rest
+    acc <- foldlM absorbHeaderLine emptyHeaderAcc headerLines
+    hdr <- finalizeHeader acc
+    Right (hdr, treeRest)
+
+breakAtTreeBlock :: [(Int, Text)] -> ([(Int, Text)], [(Int, Text)])
+breakAtTreeBlock =
+  break (\(_, t) -> T.isPrefixOf baseTreeKeyPrefix (T.strip t))
+
+lineIsBlank :: Text -> Bool
+lineIsBlank = T.null . T.strip
+
+absorbHeaderLine :: HeaderAcc -> (Int, Text) -> Either ParseError HeaderAcc
+absorbHeaderLine acc (n, rawLn) = do
+  let stripped = T.strip rawLn
+  if lineIsBlank stripped
+    then Right acc
+    else if stripped == averageOutputBareKey
+      then Right acc { haAverageOutput = True }
+      else do
+        (key, val) <- splitKv n stripped
+        assignHeaderField acc n key val
+
+assignHeaderField
+  :: HeaderAcc -> Int -> Text -> Text -> Either ParseError HeaderAcc
+assignHeaderField acc n key val
+  | key == keyVersion = do
+      unless (val == expectedVersion)
+        (Left (ParseError n keyVersion
+                ("Unsupported version: " <> val)))
+      Right acc { haVersion = Just val }
+  | key == keyNumClass = do
+      v <- parseDecimalInt n key val
+      unless (v == requiredNumClass)
+        (Left (ParseError n keyNumClass
+                ("Multi-class not supported: num_class="
+                 <> T.pack (show v))))
+      Right acc { haNumClass = Just v }
+  | key == keyNumTreePerIteration = do
+      v <- parseDecimalInt n key val
+      unless (v == requiredNumTreePerIteration)
+        (Left (ParseError n keyNumTreePerIteration
+                ("Multi-class not supported: num_tree_per_iteration="
+                 <> T.pack (show v))))
+      Right acc { haNumTreePerIteration = Just v }
+  | key == keyMaxFeatureIdx = do
+      v <- parseDecimalInt n key val
+      Right acc { haMaxFeatureIdx = Just v }
+  | key == keyObjective = do
+      (obj, sig) <- parseObjectiveLine n val
+      Right acc { haObjective = Just obj, haSigmoidScale = sig }
+  | key == keyFeatureNames =
+      Right acc { haFeatureNames = Just (T.words val) }
+  | key `elem` ignoredHeaderKeys = Right acc
+  | otherwise =
+      Left (ParseError n key ("Unknown header key: " <> key))
+
+finalizeHeader :: HeaderAcc -> Either ParseError RawHeader
+finalizeHeader acc = do
+  ver  <- requireField keyVersion (haVersion acc)
+  nc   <- requireField keyNumClass (haNumClass acc)
+  ntpi <- requireField keyNumTreePerIteration (haNumTreePerIteration acc)
+  mfi  <- requireField keyMaxFeatureIdx (haMaxFeatureIdx acc)
+  fns  <- requireField keyFeatureNames (haFeatureNames acc)
+  let featureCount = mfi + 1
+  unless (length fns == featureCount)
+    (Left (ParseError postParseLineSentinel keyFeatureNames
+            ("Feature name count "
+             <> T.pack (show (length fns))
+             <> " does not match max_feature_idx+1 "
+             <> T.pack (show featureCount))))
+  let obj = case haObjective acc of
+              Just o  -> o
+              Nothing -> ObjectiveBinaryLogistic
+  Right RawHeader
+    { rhVersion             = ver
+    , rhNumClass            = nc
+    , rhNumTreePerIteration = ntpi
+    , rhMaxFeatureIdx       = mfi
+    , rhFeatureCount        = featureCount
+    , rhObjective           = obj
+    , rhSigmoidScale        = haSigmoidScale acc
+    , rhAverageOutput       = haAverageOutput acc
+    , rhFeatureNames        = fns
+    }
+
+requireField :: Text -> Maybe a -> Either ParseError a
+requireField key mv = case mv of
+  Just v  -> Right v
+  Nothing -> Left
+    (ParseError postParseLineSentinel key
+      ("Missing required header key: " <> key))
+
+runTrees :: [(Int, Text)] -> Either ParseError [Tree]
+runTrees lns = case dropWhile (lineIsBlank . snd) lns of
+  [] -> Right []
+  ((n, ln):rest)
+    | T.strip ln == endOfTreesMarker -> Right []
+    | T.isPrefixOf baseTreeKeyPrefix (T.strip ln) -> do
+        let (block, after) = break (lineIsBlank . snd) rest
+        tree <- parseTreeBlock block
+        more <- runTrees after
+        Right (tree : more)
+    | otherwise -> Left
+        (ParseError n treeKey
+          ("Expected 'Tree=N' or 'end of trees', got: " <> ln))
+
+parseTreeBlock :: [(Int, Text)] -> Either ParseError Tree
+parseTreeBlock block = do
+  acc <- foldlM absorbTreeLine emptyTreeAcc block
+  finalizeTree acc
+
+absorbTreeLine :: TreeAcc -> (Int, Text) -> Either ParseError TreeAcc
+absorbTreeLine acc (n, rawLn) = do
+  let stripped = T.strip rawLn
+  if lineIsBlank stripped
+    then Right acc
+    else do
+      (key, val) <- splitKv n stripped
+      assignTreeField acc n key val
+
+assignTreeField
+  :: TreeAcc -> Int -> Text -> Text -> Either ParseError TreeAcc
+assignTreeField acc n key val
+  | key == keyNumLeaves = do
+      v <- parseDecimalInt n key val
+      Right acc { taNumLeaves = Just v }
+  | key == keyNumCat = do
+      v <- parseDecimalInt n key val
+      Right acc { taNumCat = Just v }
+  | key == keySplitFeature = do
+      v <- parseIntArray n key val
+      Right acc { taSplitFeature = Just v }
+  | key == keyThreshold = do
+      v <- parseDoubleArray n key val
+      Right acc { taThreshold = Just v }
+  | key == keyDecisionType = do
+      v <- parseInt8Array n key val
+      Right acc { taDecisionType = Just v }
+  | key == keyLeftChild = do
+      v <- parseIntArray n key val
+      Right acc { taLeftChild = Just v }
+  | key == keyRightChild = do
+      v <- parseIntArray n key val
+      Right acc { taRightChild = Just v }
+  | key == keyLeafValue = do
+      v <- parseDoubleArray n key val
+      Right acc { taLeafValue = Just v }
+  | key == keyCatBoundaries = do
+      v <- parseIntArray n key val
+      Right acc { taCatBoundaries = Just v }
+  | key == keyCatThreshold = do
+      v <- parseWord32Array n key val
+      Right acc { taCatThreshold = Just v }
+  | key == keyIsLinear = do
+      v <- parseDecimalInt n key val
+      when (v /= 0)
+        (Left (ParseError n keyIsLinear
+                "Linear trees not supported (is_linear=1)"))
+      Right acc
+  | key `elem` ignoredTreeKeys = Right acc
+  | otherwise =
+      Left (ParseError n key ("Unknown tree key: " <> key))
+
+finalizeTree :: TreeAcc -> Either ParseError Tree
+finalizeTree acc = do
+  nL <- requireField keyNumLeaves (taNumLeaves acc)
+  nC <- requireField keyNumCat (taNumCat acc)
+  leafValues <- requireField keyLeafValue (taLeafValue acc)
+  unless (length leafValues == nL)
+    (Left (ParseError postParseLineSentinel keyLeafValue
+            ("leaf_value array length "
+             <> T.pack (show (length leafValues))
+             <> " does not match num_leaves "
+             <> T.pack (show nL))))
+  if nL == 1
+    then buildStumpTree leafValues
+    else buildSplitTree nL nC acc leafValues
+
+buildStumpTree :: [Double] -> Either ParseError Tree
+buildStumpTree [v] = Right (makeLeafTree v)
+buildStumpTree _ = Left
+  (ParseError postParseLineSentinel keyLeafValue
+    "Stump tree must have exactly 1 leaf value")
+
+buildSplitTree
+  :: Int -> Int -> TreeAcc -> [Double] -> Either ParseError Tree
+buildSplitTree nL nC acc leafValues = do
+  let nI = nL - 1
+  splitF <- requireField keySplitFeature (taSplitFeature acc)
+  thr    <- requireField keyThreshold    (taThreshold acc)
+  lefts  <- requireField keyLeftChild    (taLeftChild acc)
+  rights <- requireField keyRightChild   (taRightChild acc)
+  let dts = case taDecisionType acc of
+              Just xs -> xs
+              Nothing -> replicate nI 0
+  validateArrayLen keySplitFeature  nI splitF
+  validateArrayLen keyThreshold     nI thr
+  validateArrayLen keyLeftChild     nI lefts
+  validateArrayLen keyRightChild    nI rights
+  validateArrayLen keyDecisionType  nI dts
+  (catBounds, catThr) <- buildCategorical nC acc
+  let internalLefts  = map (unifyChild nI) lefts
+      internalRights = map (unifyChild nI) rights
+      leafFeatures   = replicate nL leafSentinel
+      leafThresholds = replicate nL 0.0
+      leafDt         = replicate nL (0 :: Int8)
+      leafLefts      = replicate nL noChildIndex
+      leafRights     = replicate nL noChildIndex
+      internalLv     = replicate nI 0.0
+  Right Tree
+    { treeFeatureIdx    = VU.fromList (splitF ++ leafFeatures)
+    , treeThreshold     = VU.fromList (thr ++ leafThresholds)
+    , treeLeftChild     = VU.fromList (internalLefts ++ leafLefts)
+    , treeRightChild    = VU.fromList (internalRights ++ leafRights)
+    , treeLeafValue     = VU.fromList (internalLv ++ leafValues)
+    , treeDecisionType  = VU.fromList (dts ++ leafDt)
+    , treeCatBoundaries = VU.fromList catBounds
+    , treeCatThreshold  = VU.fromList catThr
+    }
+
+buildCategorical :: Int -> TreeAcc -> Either ParseError ([Int], [Word32])
+buildCategorical nC acc
+  | nC <= 0   = Right ([], [])
+  | otherwise = do
+      bounds <- requireField keyCatBoundaries (taCatBoundaries acc)
+      thr    <- requireField keyCatThreshold  (taCatThreshold acc)
+      Right (bounds, thr)
+
+unifyChild :: Int -> Int -> Int
+unifyChild nI n
+  | n >= 0    = n
+  | otherwise = nI + complement n
+
+validateArrayLen :: Text -> Int -> [a] -> Either ParseError ()
+validateArrayLen key expected xs
+  | length xs == expected = Right ()
+  | otherwise = Left
+      (ParseError postParseLineSentinel key
+        ("Array " <> key <> " has length "
+         <> T.pack (show (length xs))
+         <> ", expected " <> T.pack (show expected)))
+
+splitKv :: Int -> Text -> Either ParseError (Text, Text)
+splitKv n ln =
+  let (k, rest) = T.breakOn equalsSign ln
+  in if T.null rest
+       then Left (ParseError n headerKey
+                   ("Line missing '=': " <> ln))
+       else Right (T.strip k, T.strip (T.drop 1 rest))
+
+parseObjectiveLine :: Int -> Text -> Either ParseError (Objective, Double)
+parseObjectiveLine n val = case T.words val of
+  [] -> Left (ParseError n keyObjective "Empty objective value")
+  (objName : rest) -> do
+    obj <- case parseObjective objName of
+      Left err -> Left (ParseError n keyObjective (T.pack err))
+      Right o  -> Right o
+    sig <- findSigmoid n rest
+    Right (obj, sig)
+
+findSigmoid :: Int -> [Text] -> Either ParseError Double
+findSigmoid _ [] = Right defaultSigmoidScale
+findSigmoid n (t:ts) = case T.stripPrefix sigmoidPrefix t of
+  Nothing  -> findSigmoid n ts
+  Just raw -> case TR.double raw of
+    Right (d, leftover)
+      | T.null leftover -> Right d
+      | otherwise -> Left
+          (ParseError n keyObjective
+            ("Invalid sigmoid value: " <> raw))
+    Left err -> Left
+      (ParseError n keyObjective
+        ("Invalid sigmoid value: " <> T.pack err))
+
+parseDecimalInt :: Int -> Text -> Text -> Either ParseError Int
+parseDecimalInt n key val =
+  case TR.signed TR.decimal (T.strip val) of
+    Right (v, leftover)
+      | T.null leftover -> Right v
+      | otherwise -> Left
+          (ParseError n key
+            ("Trailing characters after int: " <> leftover))
+    Left err -> Left
+      (ParseError n key ("Invalid integer: " <> T.pack err))
+
+parseDouble :: Int -> Text -> Text -> Either ParseError Double
+parseDouble n key val = case TR.double (T.strip val) of
+  Right (v, leftover)
+    | T.null leftover -> Right v
+    | otherwise -> Left
+        (ParseError n key
+          ("Trailing characters after double: " <> leftover))
+  Left err -> Left
+    (ParseError n key ("Invalid double: " <> T.pack err))
+
+parseIntArray :: Int -> Text -> Text -> Either ParseError [Int]
+parseIntArray n key val = traverse (parseDecimalInt n key) (T.words val)
+
+parseDoubleArray :: Int -> Text -> Text -> Either ParseError [Double]
+parseDoubleArray n key val = traverse (parseDouble n key) (T.words val)
+
+parseInt8Array :: Int -> Text -> Text -> Either ParseError [Int8]
+parseInt8Array n key val = do
+  ints <- parseIntArray n key val
+  traverse (toInt8 n key) ints
+
+toInt8 :: Int -> Text -> Int -> Either ParseError Int8
+toInt8 n key v
+  | v < fromIntegral (minBound :: Int8) =
+      Left (ParseError n key
+              ("Value below Int8 range: " <> T.pack (show v)))
+  | v > fromIntegral (maxBound :: Int8) =
+      Left (ParseError n key
+              ("Value above Int8 range: " <> T.pack (show v)))
+  | otherwise = Right (fromIntegral v)
+
+parseWord32Array :: Int -> Text -> Text -> Either ParseError [Word32]
+parseWord32Array n key val = traverse (parseWord32 n key) (T.words val)
+
+parseWord32 :: Int -> Text -> Text -> Either ParseError Word32
+parseWord32 n key val = case TR.decimal (T.strip val) of
+  Right (v, leftover)
+    | T.null leftover -> Right v
+    | otherwise -> Left
+        (ParseError n key
+          ("Trailing characters after Word32: " <> leftover))
+  Left err -> Left
+    (ParseError n key ("Invalid Word32: " <> T.pack err))

PROJECTS/advanced/haskell-reverse-proxy/test/Spec.hs

@@ -180,6 +180,10 @@ import Aenebris.ML.Features
   , uaSecChConsistency
   , userAgentLengthCap
   )
+import Aenebris.ML.Loader
+  ( ParseError(..)
+  , parseEnsemble
+  )
 import Aenebris.Middleware.Redirect (httpsRedirect, httpsRedirectWithPort)
 import Aenebris.Middleware.Security
   ( addSecurityHeaders
@@ -224,6 +228,9 @@ import qualified Data.IP as IP
 import qualified Data.Vector as V
 import qualified Data.Vector.Unboxed as VU
 import qualified Data.Map.Strict as Map
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import Data.Either (isLeft)
 import Data.Int (Int8)
 import Data.Maybe (isJust, isNothing)
 import Data.Time.Clock.POSIX (getPOSIXTime)
@@ -266,8 +273,10 @@ import Network.Wai.Test
 import Test.Hspec
   ( Spec
   , describe
+  , expectationFailure
   , hspec
   , it
+  , runIO
   , shouldBe
   , shouldNotBe
   , shouldReturn
@@ -323,6 +332,7 @@ main = hspec $ do
   geoSpec
   mlFeaturesSpec
   mlModelSpec
+  mlLoaderSpec
 
 configSpec :: Spec
 configSpec = describe "Config" $ do
@@ -1788,6 +1798,250 @@ mlModelSpec = describe "ML.Model" $ do
     validateTree 20 bad `shouldSatisfy`
       (\r -> case r of { Left _ -> True; Right _ -> False })
 
+mlLoaderModel :: T.Text
+mlLoaderModel = T.unlines
+  [ "tree"
+  , "version=v4"
+  , "num_class=1"
+  , "num_tree_per_iteration=1"
+  , "label_index=0"
+  , "max_feature_idx=0"
+  , "objective=binary sigmoid:1"
+  , "feature_names=feat0"
+  , "feature_infos=[0:1]"
+  , ""
+  , "Tree=0"
+  , "num_leaves=1"
+  , "num_cat=0"
+  , "leaf_value=0.5"
+  , "shrinkage=1"
+  , ""
+  , "end of trees"
+  ]
+
+mlLoaderModelBytes :: BS.ByteString
+mlLoaderModelBytes = TE.encodeUtf8 mlLoaderModel
+
+mlLoaderSubst :: T.Text -> T.Text -> BS.ByteString
+mlLoaderSubst needle replacement =
+  TE.encodeUtf8 (T.replace needle replacement mlLoaderModel)
+
+parseFailsAt :: T.Text -> Either ParseError Ensemble -> Bool
+parseFailsAt expectedKey (Left e) = peKey e == expectedKey
+parseFailsAt _ _                  = False
+
+parseSucceeds :: Either ParseError Ensemble -> Bool
+parseSucceeds (Right _) = True
+parseSucceeds _         = False
+
+mlLoaderSpec :: Spec
+mlLoaderSpec = describe "ML.Loader" $ do
+  tinyBytes  <- runIO (BS.readFile "test/fixtures/ml/tiny_lgbm_v4.txt")
+  stumpBytes <- runIO (BS.readFile "test/fixtures/ml/stump_lgbm_v4.txt")
+
+  describe "happy path: tiny v4 fixture" $ do
+    it "parses into a single-tree binary-logistic ensemble" $
+      case parseEnsemble tinyBytes of
+        Right ens -> do
+          ensembleTreeCount ens     `shouldBe` 1
+          ensembleFeatureCount ens  `shouldBe` 2
+          ensembleObjective ens     `shouldBe` ObjectiveBinaryLogistic
+          ensembleSigmoidScale ens  `shouldBe` 1.0
+          ensembleAverageOutput ens `shouldBe` False
+          ensembleVersion ens       `shouldBe` currentEnsembleVersion
+          ensembleBaseScore ens     `shouldBe` 0.0
+        Left err -> expectationFailure (show err)
+
+    it "produces unified SoA with 2*num_leaves - 1 = 5 nodes" $
+      case parseEnsemble tinyBytes of
+        Right ens -> treeNodeCount (V.head (ensembleTrees ens)) `shouldBe` 5
+        Left err  -> expectationFailure (show err)
+
+    it "decodes negative children into unified leaf indices" $
+      case parseEnsemble tinyBytes of
+        Right ens -> do
+          let tree = V.head (ensembleTrees ens)
+          treeLeftChild  tree VU.! 0 `shouldBe` 1
+          treeRightChild tree VU.! 0 `shouldBe` 4
+          treeLeftChild  tree VU.! 1 `shouldBe` 2
+          treeRightChild tree VU.! 1 `shouldBe` 3
+        Left err -> expectationFailure (show err)
+
+    it "marks unified leaf rows with leafSentinel and noChildIndex" $
+      case parseEnsemble tinyBytes of
+        Right ens -> do
+          let tree = V.head (ensembleTrees ens)
+          treeFeatureIdx tree VU.! 2 `shouldBe` leafSentinel
+          treeFeatureIdx tree VU.! 3 `shouldBe` leafSentinel
+          treeFeatureIdx tree VU.! 4 `shouldBe` leafSentinel
+          treeLeftChild  tree VU.! 2 `shouldBe` noChildIndex
+          treeRightChild tree VU.! 2 `shouldBe` noChildIndex
+        Left err -> expectationFailure (show err)
+
+    it "preserves leaf values at unified leaf indices" $
+      case parseEnsemble tinyBytes of
+        Right ens -> do
+          let tree = V.head (ensembleTrees ens)
+          treeLeafValue tree VU.! 2 `shouldBe`   0.3
+          treeLeafValue tree VU.! 3 `shouldBe` (-0.2)
+          treeLeafValue tree VU.! 4 `shouldBe` (-0.4)
+        Left err -> expectationFailure (show err)
+
+    it "preserves split feature indices and thresholds for internal nodes" $
+      case parseEnsemble tinyBytes of
+        Right ens -> do
+          let tree = V.head (ensembleTrees ens)
+          treeFeatureIdx tree VU.! 0 `shouldBe` 1
+          treeFeatureIdx tree VU.! 1 `shouldBe` 0
+          treeThreshold  tree VU.! 0 `shouldBe` 0.0
+          treeThreshold  tree VU.! 1 `shouldBe` 5.0
+        Left err -> expectationFailure (show err)
+
+    it "encodes categorical bitmap with cat_boundaries" $
+      case parseEnsemble tinyBytes of
+        Right ens -> do
+          let tree = V.head (ensembleTrees ens)
+          VU.toList (treeCatBoundaries tree) `shouldBe` [0, 1]
+          VU.toList (treeCatThreshold  tree) `shouldBe` [3]
+        Left err -> expectationFailure (show err)
+
+    it "tags categorical and numerical nodes via decision-type bits" $
+      case parseEnsemble tinyBytes of
+        Right ens -> do
+          let tree = V.head (ensembleTrees ens)
+          splitKindFromDecisionType (treeDecisionType tree VU.! 0)
+            `shouldBe` SplitCategorical
+          splitKindFromDecisionType (treeDecisionType tree VU.! 1)
+            `shouldBe` SplitNumerical
+        Left err -> expectationFailure (show err)
+
+    it "ignores trailing feature_importances:, parameters:, pandas_categorical:" $
+      parseEnsemble tinyBytes `shouldSatisfy` parseSucceeds
+
+  describe "happy path: stump v4 fixture" $ do
+    it "parses into a single-leaf tree with leafSentinel root" $
+      case parseEnsemble stumpBytes of
+        Right ens -> do
+          ensembleTreeCount ens      `shouldBe` 1
+          ensembleFeatureCount ens   `shouldBe` 1
+          let tree = V.head (ensembleTrees ens)
+          treeNodeCount tree         `shouldBe` 1
+          treeLeafValue  tree VU.! 0 `shouldBe` 0.5
+          treeFeatureIdx tree VU.! 0 `shouldBe` leafSentinel
+          treeLeftChild  tree VU.! 0 `shouldBe` noChildIndex
+          treeRightChild tree VU.! 0 `shouldBe` noChildIndex
+        Left err -> expectationFailure (show err)
+
+  describe "header rejection" $ do
+    it "rejects empty input" $
+      parseEnsemble BS.empty `shouldSatisfy` isLeft
+
+    it "rejects when first non-blank line is not 'tree'" $
+      parseEnsemble (TE.encodeUtf8 (T.replace "tree\n" "garbage\n" mlLoaderModel))
+        `shouldSatisfy` isLeft
+
+    it "rejects version=v3" $
+      parseEnsemble (mlLoaderSubst "version=v4" "version=v3")
+        `shouldSatisfy` parseFailsAt "version"
+
+    it "rejects version=v5" $
+      parseEnsemble (mlLoaderSubst "version=v4" "version=v5")
+        `shouldSatisfy` parseFailsAt "version"
+
+    it "rejects num_class=2 (multi-class)" $
+      parseEnsemble (mlLoaderSubst "num_class=1" "num_class=2")
+        `shouldSatisfy` parseFailsAt "num_class"
+
+    it "rejects num_tree_per_iteration=2 (multi-class)" $
+      parseEnsemble
+        (mlLoaderSubst "num_tree_per_iteration=1" "num_tree_per_iteration=2")
+        `shouldSatisfy` parseFailsAt "num_tree_per_iteration"
+
+    it "rejects feature_names count not matching max_feature_idx+1" $
+      parseEnsemble
+        (TE.encodeUtf8
+          (T.replace "feature_names=feat0" "feature_names=feat0 feat1" mlLoaderModel))
+        `shouldSatisfy` parseFailsAt "feature_names"
+
+    it "rejects unknown header keys" $
+      parseEnsemble
+        (TE.encodeUtf8
+          (T.replace "feature_infos=[0:1]\n"
+                     "feature_infos=[0:1]\nbogus_key=42\n" mlLoaderModel))
+        `shouldSatisfy` isLeft
+
+    it "rejects missing required header key (version)" $
+      parseEnsemble (TE.encodeUtf8 (T.replace "version=v4\n" "" mlLoaderModel))
+        `shouldSatisfy` parseFailsAt "version"
+
+  describe "objective and sigmoid extraction" $ do
+    it "parses sigmoid:0.5 from objective line" $
+      case parseEnsemble (mlLoaderSubst "sigmoid:1" "sigmoid:0.5") of
+        Right ens -> ensembleSigmoidScale ens `shouldBe` 0.5
+        Left err  -> expectationFailure (show err)
+
+    it "defaults objective to binary logistic when objective key absent" $
+      case parseEnsemble
+             (TE.encodeUtf8
+               (T.replace "objective=binary sigmoid:1\n" "" mlLoaderModel)) of
+        Right ens -> do
+          ensembleObjective ens    `shouldBe` ObjectiveBinaryLogistic
+          ensembleSigmoidScale ens `shouldBe` 1.0
+        Left err -> expectationFailure (show err)
+
+    it "rejects malformed sigmoid value" $
+      parseEnsemble (mlLoaderSubst "sigmoid:1" "sigmoid:notanumber")
+        `shouldSatisfy` parseFailsAt "objective"
+
+    it "rejects unknown objective name" $
+      parseEnsemble (mlLoaderSubst "objective=binary sigmoid:1" "objective=poisson")
+        `shouldSatisfy` parseFailsAt "objective"
+
+  describe "average_output bare key" $ do
+    it "defaults to False when absent" $
+      case parseEnsemble mlLoaderModelBytes of
+        Right ens -> ensembleAverageOutput ens `shouldBe` False
+        Left err  -> expectationFailure (show err)
+
+    it "sets True when bare 'average_output' line present" $
+      case parseEnsemble
+             (TE.encodeUtf8
+               (T.replace "feature_infos=[0:1]\n"
+                          "feature_infos=[0:1]\naverage_output\n" mlLoaderModel)) of
+        Right ens -> ensembleAverageOutput ens `shouldBe` True
+        Left err  -> expectationFailure (show err)
+
+  describe "tree-level rejection" $ do
+    it "rejects is_linear=1 in any tree" $
+      parseEnsemble
+        (TE.encodeUtf8
+          (T.replace "shrinkage=1\n" "is_linear=1\nshrinkage=1\n" mlLoaderModel))
+        `shouldSatisfy` parseFailsAt "is_linear"
+
+    it "rejects unknown tree keys" $
+      parseEnsemble
+        (TE.encodeUtf8
+          (T.replace "leaf_value=0.5\n" "leaf_value=0.5\nbogus=1\n" mlLoaderModel))
+        `shouldSatisfy` isLeft
+
+  describe "feature_names containing '='" $
+    it "accepts feature_names with '=' in a name" $
+      parseEnsemble
+        (TE.encodeUtf8
+          (T.replace "feature_names=feat0" "feature_names=foo=bar" mlLoaderModel))
+        `shouldSatisfy` parseSucceeds
+
+  describe "ParseError reporting" $ do
+    it "reports correct 1-indexed line number for version error" $
+      case parseEnsemble (mlLoaderSubst "version=v4" "version=v3") of
+        Left err -> peLine err `shouldBe` 2
+        Right _  -> expectationFailure "expected Left"
+
+    it "reports the failing key name for version error" $
+      case parseEnsemble (mlLoaderSubst "version=v4" "version=v3") of
+        Left err -> peKey err `shouldBe` "version"
+        Right _  -> expectationFailure "expected Left"
+
 headersOnlyRequest :: [(BS.ByteString, BS.ByteString)] -> Request
 headersOnlyRequest hs =
   Network.Wai.Test.defaultRequest

PROJECTS/advanced/haskell-reverse-proxy/test/fixtures/ml/stump_lgbm_v4.txt

@@ -0,0 +1,23 @@
+tree
+version=v4
+num_class=1
+num_tree_per_iteration=1
+label_index=0
+max_feature_idx=0
+objective=binary sigmoid:1
+feature_names=feat0
+feature_infos=[0:1]
+
+Tree=0
+num_leaves=1
+num_cat=0
+leaf_value=0.5
+shrinkage=1
+
+end of trees
+
+feature_importances:
+
+parameters:
+[boosting: gbdt]
+end of parameters

PROJECTS/advanced/haskell-reverse-proxy/test/fixtures/ml/tiny_lgbm_v4.txt

@@ -0,0 +1,46 @@
+tree
+version=v4
+num_class=1
+num_tree_per_iteration=1
+label_index=0
+max_feature_idx=1
+objective=binary sigmoid:1
+feature_names=num_feat cat_feat
+feature_infos=[0:10] 0:1:2
+tree_sizes=300
+
+Tree=0
+num_leaves=3
+num_cat=1
+split_feature=1 0
+split_gain=150.5 80.2
+threshold=0 5
+decision_type=1 0
+left_child=1 -1
+right_child=-3 -2
+leaf_value=0.3 -0.2 -0.4
+leaf_weight=120 85 95
+leaf_count=120 85 95
+internal_value=0 0
+internal_weight=300 205
+internal_count=300 205
+cat_boundaries=0 1
+cat_threshold=3
+is_linear=0
+shrinkage=1
+
+end of trees
+
+feature_importances:
+cat_feat=1
+num_feat=1
+
+parameters:
+[boosting: gbdt]
+[objective: binary]
+[num_iterations: 1]
+[learning_rate: 0.1]
+[num_leaves: 31]
+end of parameters
+
+pandas_categorical:[[0, 1, 2]]