From a302741b1e5d66752e75a2d30500ad3c9995b953 Mon Sep 17 00:00:00 2001 From: CarterPerez-dev Date: Tue, 28 Apr 2026 17:35:33 -0400 Subject: [PATCH] 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. --- .../haskell-reverse-proxy/aenebris.cabal | 1 + .../scripts/regen_lgbm_fixture.py | 91 +++ .../src/Aenebris/ML/Loader.hs | 592 ++++++++++++++++++ .../haskell-reverse-proxy/test/Spec.hs | 254 ++++++++ .../test/fixtures/ml/stump_lgbm_v4.txt | 23 + .../test/fixtures/ml/tiny_lgbm_v4.txt | 46 ++ 6 files changed, 1007 insertions(+) create mode 100644 PROJECTS/advanced/haskell-reverse-proxy/scripts/regen_lgbm_fixture.py create mode 100644 PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Loader.hs create mode 100644 PROJECTS/advanced/haskell-reverse-proxy/test/fixtures/ml/stump_lgbm_v4.txt create mode 100644 PROJECTS/advanced/haskell-reverse-proxy/test/fixtures/ml/tiny_lgbm_v4.txt diff --git a/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal b/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal index 5b2a1812..bd62a5a6 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal +++ b/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 diff --git a/PROJECTS/advanced/haskell-reverse-proxy/scripts/regen_lgbm_fixture.py b/PROJECTS/advanced/haskell-reverse-proxy/scripts/regen_lgbm_fixture.py new file mode 100644 index 00000000..a2a3fe26 --- /dev/null +++ b/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() diff --git a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Loader.hs b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Loader.hs new file mode 100644 index 00000000..dc1c5497 --- /dev/null +++ b/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 = "" + +headerKey :: Text +headerKey = "
" + +treeKey :: Text +treeKey = "" + +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)) diff --git a/PROJECTS/advanced/haskell-reverse-proxy/test/Spec.hs b/PROJECTS/advanced/haskell-reverse-proxy/test/Spec.hs index ab169531..706efbbf 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/test/Spec.hs +++ b/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 diff --git a/PROJECTS/advanced/haskell-reverse-proxy/test/fixtures/ml/stump_lgbm_v4.txt b/PROJECTS/advanced/haskell-reverse-proxy/test/fixtures/ml/stump_lgbm_v4.txt new file mode 100644 index 00000000..af85e3e6 --- /dev/null +++ b/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 diff --git a/PROJECTS/advanced/haskell-reverse-proxy/test/fixtures/ml/tiny_lgbm_v4.txt b/PROJECTS/advanced/haskell-reverse-proxy/test/fixtures/ml/tiny_lgbm_v4.txt new file mode 100644 index 00000000..afed2e2b --- /dev/null +++ b/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]]