feat: meter eval gate context by encoded request bytes, drop dead Eval modules

eval/neuro-symbolic/siza-eval.cabal

@@ -19,7 +19,6 @@ library
     default-language: Haskell2010
     default-extensions: OverloadedStrings, LambdaCase, ScopedTypeVariables
     exposed-modules:  Eval.Ollama
-                      Eval.Provider
                       Eval.Preflight
                       Eval.Tools
                       Eval.Bench
@@ -38,17 +37,8 @@ library
                       Eval.ElisionLint
                       Eval.VerdictLint
                       Eval.VerifierLeakLint
-                      Eval.Discover
-                      Eval.Exemplars
-                      Eval.Sample
                       Eval.Agent
-                      Eval.HoleFit
-                      Eval.Messages
-                      Eval.Owned
                       Eval.Render
-                      Eval.Repair
-                      Eval.Salvage
-                      Eval.Scaffold
                       Eval.Transcript
                       Eval.Task
                       Eval.TaskSet

eval/neuro-symbolic/src/Eval/Gate.hs

@@ -10,17 +10,26 @@ module Eval.Gate (
     searchEnv,
     armOrder,
     capabilityEnvFor,
+    meteredTlsManagerSettings,
     module Eval.GateReport,
     module Eval.GateResult,
 ) where
 
 import Control.Monad (forM, forM_, unless, when)
-import qualified Data.Set as Set
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as TIO
 import Data.Time.Clock.POSIX (getPOSIXTime)
-import Network.HTTP.Client.TLS (newTlsManager)
+import Network.HTTP.Client (
+    ManagerSettings (managerModifyRequest),
+    Request (requestBody),
+    RequestBody (..),
+    newManager,
+ )
+import Network.HTTP.Client.TLS (tlsManagerSettings)
 import System.Environment (setEnv, unsetEnv)
 
 import Eval.Agent (
@@ -50,7 +59,6 @@ import Eval.Task (
  )
 import Eval.Tools (dispatch, episodeCatalogue)
 import Eval.TranscriptLint (lintLine, lintMessages, stopIssues)
-import Siza.Agent.Transcript (contextChars)
 
 data GateLever = ResolverLever | CapabilityLever | ServerFlagLever String
     deriving (Eq, Show)
@@ -101,7 +109,7 @@ runGateResuming ::
     BenchConfig -> GateLever -> FilePath -> [Task] -> [Int] -> IO [GateResult]
 runGateResuming cfg lever resultsFile tasks seeds = do
     prior <- readGateResults resultsFile
-    let done = Set.fromList (map gateKey prior)
+    let done = gateKeysForMetric EncodedRequestBodyBytes prior
         runs = gateRuns tasks seeds
         total = length runs
     forM_ (zip [0 ..] runs) $ \(i, (task, seed, mode)) ->
@@ -122,6 +130,7 @@ runGateResuming cfg lever resultsFile tasks seeds = do
                         (rsCalls st)
                         stopped
                         ctx
+                        EncodedRequestBodyBytes
             appendGateResult resultsFile gr
             TIO.putStrLn (progressLine (i + 1) total task seed mode st)
     readGateResults resultsFile
@@ -152,6 +161,7 @@ runArmGate ::
 runArmGate cfg lever base seed mode task = do
     setCapabilityEnv lever mode
     cat <- episodeCatalogue
+    requestBytes <- newIORef 0
     let attempt s = do
             when (s /= seed) $
                 putStrLn $
@@ -163,7 +173,7 @@ runArmGate cfg lever base seed mode task = do
                         <> T.unpack (modeText mode)
                         <> ": 0-turn infra failure — retrying with fresh seed "
                         <> show s
-            mgr <- newTlsManager
+            mgr <- newManager (meteredTlsManagerSettings requestBytes)
             let driver =
                     Driver
                         { drvChat =
@@ -183,12 +193,41 @@ runArmGate cfg lever base seed mode task = do
         retryFreshSeed maxEpisodeRetries seed ((>= 1) . arTurns) attempt
     saveGateEpisode cfg lever base task seed seedsTried mode run
     (v, _) <- grade (bcConn cfg) base task
+    totalRequestBytes <- readIORef requestBytes
     pure
         ( RunStat (v == Surfaced) (arTurns run) (arToolCalls run)
         , arStopped run
-        , contextChars (arTranscript run)
+        , totalRequestBytes
         )
 
+{- | Count encoded bodies after the shared client resolves its request. The
+counter spans fresh-seed retries, which also consumed model input.
+-}
+meteredTlsManagerSettings :: IORef Int -> ManagerSettings
+meteredTlsManagerSettings total =
+    tlsManagerSettings
+        { managerModifyRequest = \request -> do
+            ready <- managerModifyRequest tlsManagerSettings request
+            bytes <- requestBodyBytes (requestBody ready)
+            modifyIORef' total (+ bytes)
+            pure ready
+        }
+
+requestBodyBytes :: RequestBody -> IO Int
+requestBodyBytes body = case body of
+    RequestBodyLBS bytes -> pure (fromIntegral (LBS.length bytes))
+    RequestBodyBS bytes -> pure (BS.length bytes)
+    RequestBodyBuilder bytes _ -> pure (fromIntegral bytes)
+    RequestBodyStream bytes _ -> pure (fromIntegral bytes)
+    RequestBodyStreamChunked _ -> unsupported
+    RequestBodyIO _ -> unsupported
+  where
+    unsupported =
+        ioError
+            ( userError
+                "gate payload meter: Ollama request body has no exact encoded length"
+            )
+
 maxEpisodeRetries :: Int
 maxEpisodeRetries = 2
 

eval/neuro-symbolic/src/Eval/GateResult.hs

@@ -2,9 +2,11 @@
 
 module Eval.GateResult (
     GateResult (..),
+    ContextMetric (..),
     SearchMode (..),
     modeText,
     gateKey,
+    gateKeysForMetric,
     readGateResults,
     appendGateResult,
     isDone,
@@ -49,6 +51,18 @@ import Eval.Bench (
 data SearchMode = SearchOff | SearchOn
     deriving (Eq, Ord, Show)
 
+data ContextMetric = LegacyTranscriptChars | EncodedRequestBodyBytes
+    deriving (Eq, Show)
+
+metricText :: ContextMetric -> Text
+metricText LegacyTranscriptChars = "transcript_chars"
+metricText EncodedRequestBodyBytes = "request_body_bytes"
+
+metricFromText :: Text -> Maybe ContextMetric
+metricFromText "transcript_chars" = Just LegacyTranscriptChars
+metricFromText "request_body_bytes" = Just EncodedRequestBodyBytes
+metricFromText _ = Nothing
+
 modeText :: SearchMode -> Text
 modeText SearchOff = "off"
 modeText SearchOn = "on"
@@ -67,6 +81,8 @@ data GateResult = GateResult
     , grCalls :: Int
     , grStopped :: Text
     , grCtxChars :: Int
+    -- ^ Legacy field name; 'grContextMetric' supplies its unit.
+    , grContextMetric :: ContextMetric
     }
     deriving (Eq, Show)
 
@@ -81,12 +97,19 @@ instance ToJSON GateResult where
             , "grCalls" .= grCalls g
             , "grStopped" .= grStopped g
             , "grCtxChars" .= grCtxChars g
+            , "grCtxMetric" .= metricText (grContextMetric g)
             ]
 
 instance FromJSON GateResult where
     parseJSON = withObject "GateResult" $ \o -> do
         m <- o .: "grMode"
         mode <- maybe (fail ("bad grMode: " <> T.unpack m)) pure (modeFromText m)
+        metricTag <- o .:? "grCtxMetric" .!= "transcript_chars"
+        metric <-
+            maybe
+                (fail ("bad grCtxMetric: " <> T.unpack metricTag))
+                pure
+                (metricFromText metricTag)
         GateResult
             <$> o .: "grTask"
             <*> o .: "grSeed"
@@ -96,10 +119,16 @@ instance FromJSON GateResult where
             <*> o .: "grCalls"
             <*> o .:? "grStopped" .!= ""
             <*> o .:? "grCtxChars" .!= 0
+            <*> pure metric
 
 gateKey :: GateResult -> (Text, Int, SearchMode)
 gateKey g = (grTask g, grSeed g, grMode g)
 
+gateKeysForMetric ::
+    ContextMetric -> [GateResult] -> Set.Set (Text, Int, SearchMode)
+gateKeysForMetric metric =
+    Set.fromList . map gateKey . filter ((== metric) . grContextMetric)
+
 readGateResults :: FilePath -> IO [GateResult]
 readGateResults path = do
     exists <- doesFileExist path
@@ -128,14 +157,15 @@ isDone done task seed mode = Set.member (task, seed, mode) done
 renderGateResults :: [GateResult] -> Text
 renderGateResults rs =
     T.unlines
-        ("Per task (A=SearchOff, B=SearchOn):" : map taskRow (byTaskComparison rs))
+        ("Per task (A=SearchOff, B=SearchOn):" : map taskRow (byTaskComparison measured))
         <> "\nOverall:\n"
-        <> renderComparison (summarise rs)
+        <> renderComparison (summarise measured)
         <> "\n"
-        <> renderCost rs
+        <> renderCost measured
         <> renderCtx rs
-        <> infraNote rs
+        <> infraNote measured
   where
+    measured = [g | g <- rs, grContextMetric g == EncodedRequestBodyBytes]
     taskRow (tid, Comparison a b _ _) =
         "  " <> tid <> ":  A " <> rate a <> "   B " <> rate b
     rate r = tshow (arPasses r) <> "/" <> tshow (arRuns r)
@@ -197,26 +227,35 @@ costByTask rs =
 
 renderCtx :: [GateResult] -> Text
 renderCtx rs
-    | all ((== 0) . grCtxChars) rs = ""
+    | null measured = legacyNote
     | otherwise =
         T.unlines
-            ( "Context/task (mean chars, A=Off B=On):"
+            ( "Model request payload/task (mean cumulative bytes, A=Off B=On):"
                 : [ "  " <> tid <> ":  A " <> mean tid SearchOff <> "   B " <> mean tid SearchOn
-                  | tid <- nub (map grTask rs)
+                  | tid <- nub (map grTask measured)
                   ]
             )
             <> "Overall:  A "
             <> meanAll SearchOff
             <> "   B "
             <> meanAll SearchOn
             <> "\n"
+            <> legacyNote
   where
-    mean tid mode = fmt [grCtxChars g | g <- rs, grTask g == tid, grMode g == mode]
-    meanAll mode = fmt [grCtxChars g | g <- rs, grMode g == mode]
+    measured = [g | g <- rs, grContextMetric g == EncodedRequestBodyBytes]
+    legacyN = length rs - length measured
+    mean tid mode = fmt [grCtxChars g | g <- measured, grTask g == tid, grMode g == mode]
+    meanAll mode = fmt [grCtxChars g | g <- measured, grMode g == mode]
     fmt [] = "-"
     fmt xs =
         tshow (round1 (fromIntegral (sum xs) / (1000 * fromIntegral (length xs))))
             <> "k"
+    legacyNote
+        | legacyN == 0 = ""
+        | otherwise =
+            "Excluded legacy context rows: "
+                <> tshow legacyN
+                <> " (final-transcript chars; not mixed with request bytes).\n"
 
 infraNote :: [GateResult] -> Text
 infraNote rs

eval/neuro-symbolic/test/Test/EpisodeSpec.hs

@@ -45,7 +45,11 @@ import Eval.Episode (
     voidPair,
  )
 import Eval.GateMetrics (renderGateMetrics)
-import Eval.GateResult (GateResult (..), SearchMode (..))
+import Eval.GateResult (
+    ContextMetric (EncodedRequestBodyBytes),
+    GateResult (..),
+    SearchMode (..),
+ )
 import Eval.Ollama (ToolCall (..), Turn (..))
 import Eval.ReportGuard (guardReport)
 import Eval.TranscriptLint (lintLine, lintMessages)
@@ -208,6 +212,6 @@ spec = describe "Eval.Episode (R8.1-R8.3 measurement plumbing)" $ do
   where
     readFileT p = T.pack <$> readFile p
     gateRows task =
-        [ GateResult task 1 SearchOff True 2 1 "done" 0
-        , GateResult task 1 SearchOn True 2 1 "done" 0
+        [ GateResult task 1 SearchOff True 2 1 "done" 0 EncodedRequestBodyBytes
+        , GateResult task 1 SearchOn True 2 1 "done" 0 EncodedRequestBodyBytes
         ]

eval/neuro-symbolic/test/Test/GateLeverSpec.hs

@@ -2,12 +2,26 @@
 
 module Test.GateLeverSpec (spec) where
 
+import Data.Aeson (encode, object, (.=))
+import Data.IORef (newIORef, readIORef)
 import qualified Data.Text as T
+import Network.HTTP.Client (
+    Request (requestBody),
+    RequestBody (RequestBodyLBS),
+    managerModifyRequest,
+    parseRequest,
+ )
 import Test.Hspec
 
 import Eval.Bench (ArmResult (..), Comparison (..), renderComparison)
-import Eval.Gate (GateLever (..), armOrder, searchEnv)
+import Eval.Gate (
+    GateLever (..),
+    armOrder,
+    meteredTlsManagerSettings,
+    searchEnv,
+ )
 import Eval.GateResult (SearchMode (..))
+import Eval.Ollama (OllamaReqOpts (..), chatRequestBody)
 
 spec :: Spec
 spec = describe "Eval.Gate.searchEnv" $ do
@@ -45,3 +59,49 @@ spec = describe "Eval.Gate.searchEnv" $ do
         it "does not label a significant delta" $
             renderComparison (cmp 3.0)
                 `shouldSatisfy` (not . T.isInfixOf "NOISE")
+
+    describe "gate model-request payload meter" $ do
+        it "counts encoded bytes, including the exact offered catalogue" $ do
+            withTotal <- newIORef 0
+            withoutTotal <- newIORef 0
+            request <- parseRequest "http://localhost:11434/api/chat"
+            let messages = [object ["role" .= ("user" :: T.Text), "content" .= ("λ" :: T.Text)]]
+                catalogue =
+                    [ object
+                        [ "type" .= ("function" :: T.Text)
+                        , "function"
+                            .= object
+                                [ "name" .= ("discover" :: T.Text)
+                                , "description" .= ("look up one fact" :: T.Text)
+                                ]
+                        ]
+                    ]
+                opts = OllamaReqOpts False (Just 7) "30m" 32768 0.4
+                withBody = encode (chatRequestBody opts "gpt-oss:20b" messages catalogue)
+                withoutBody = encode (chatRequestBody opts "gpt-oss:20b" messages [])
+                withSettings = meteredTlsManagerSettings withTotal
+                withoutSettings = meteredTlsManagerSettings withoutTotal
+            _ <-
+                managerModifyRequest
+                    withSettings
+                    request{requestBody = RequestBodyLBS withBody}
+            _ <-
+                managerModifyRequest
+                    withoutSettings
+                    request{requestBody = RequestBodyLBS withoutBody}
+            withBytes <- readIORef withTotal
+            withoutBytes <- readIORef withoutTotal
+            withBytes `shouldSatisfy` (> withoutBytes)
+
+        it "accumulates every request rather than measuring the final transcript" $ do
+            total <- newIORef 0
+            request <- parseRequest "http://localhost:11434/api/chat"
+            let settings = meteredTlsManagerSettings total
+                -- Aeson writes lambda as two UTF-8 bytes: 16 bytes, 15 characters.
+                firstBody = encode (object ["content" .= ("λ" :: T.Text)])
+                first = request{requestBody = RequestBodyLBS firstBody}
+                second = request{requestBody = RequestBodyLBS "1234567"}
+            _ <- managerModifyRequest settings first
+            _ <- managerModifyRequest settings second
+            measured <- readIORef total
+            measured `shouldBe` 23