@clear-capabilities/agentic-security-scanner 0.195.27 → 0.195.29

package/src/language/CLAUDE.md

@@ -160,7 +160,7 @@ The `unseen` split (unseen-v3) is a **DEVELOPMENT set since 2026-10-26**: its fa
 
 **The detection suite scores `actionable` findings (since 0.195.9):** a finding at `info`, or one the engine PROVED clean or infeasible (`proof.verdict` `proven-*`: a catalog sanitizer of the sink's family on the path, a dominating guard), is not a detection, the same rule `bench/language-support/lib.mjs` `actionable` already applied elsewhere. Before, `renderHtml (toHtml name)` into a Scotty `html` sink was scored a false positive although the proof gate had labelled it proven-clean. **Disclosure:** while the real-code precision work of 0.195.9 was being investigated, two frozen-holdout path-traversal sources (shapes s0 and s1, both a parameter joined under a fixed directory) were printed and read; no rule was changed to them (both are still findings), but the holdout has been seen by the person who changed the path-wrapper policy, and a reader weighing the holdout's independence should know that.
 
-Rules added for the unseen-v5 shapes, pinned both ways in `test/haskell/haskell-unseen-v5-shapes.test.js`: a Servant handler pairs the API's reads with its LAST parameters (`orderServer conn ref`; `haskell-ir.js` `servantEndpointParams` paired from the front and annotated the closure parameter); a `Set-Cookie` header handed to `setHeader`/`addHeader` is judged like a hand-written tuple; a project helper the IR inlined at its call site (`hs.inlinedFrom`) reports a fast password hash or a credential log once, in the helper (`markInlined`, `inlineCtx`, the filter before the return); mwc-random and splitmix are predictable generators (`System.Random.MWC` in `HS_RULE_APIS` so the IR qualifies the names); a function that MAKES a key (`newKey`, `generateApiKey`) is security-shaped, and `code`/`pin`/`otp` is a security value in a function that talks about a reset or a verification (`CONTEXT_CODE_VAR`, `CODE_CONTEXT`); an authentication endpoint (`AUTH_ENDPOINT_PATH`/`_NAME`) is never missing authentication; `X-Session`, `X-Token` and similar project header names are credentials (`CREDENTIAL_HEADER`); a yes/no answer about a credential (`accepted <- checkCredentials attempt`, a comparison, a `logical`, a helper whose returns are such: `returnsYesNo`) carries no credential text, a record built from one logged through another field (`attemptUser attempt`, a `member` of it) is that field, the record logged whole is the credential, and `lastFour`/`takeEnd`/`fingerprint` are masking helpers by name; `pushLogStr(Ln)` is a log sink. In `haskell-guards.js`: a CWE-918 flow whose URL starts from a literal (or a constant bound to one) naming the scheme, the host and a `/`, or whose request is built by http-conduit's modifiers over such a base, is lowered to `info` with `guardNote.kind: fixed-host-request` (`fixedHostRequest`; a record update that sets a host field, or a literal that stops inside the host, is not); `judgeFinding` locates the sink in the CALLEE when the finding was found from a caller (the canonicalise-and-prefix guard in `persistDraft` refutes the flow found from `saveDraft`), and the XSS escaper judgement knows the catalog's HTML escapers and a project helper that uses the parameter receiving the tainted value only under an escaper. Nix (`test/nix/nix-development-shapes.test.js`): `AmbientCapabilities` as one string, `Defaults !authenticate`, a `*File` option handed a `writeText` of a literal (`nix-secret-plaintext`, exposure `store`), a TLS key path on any enabled service (`sslKey`, `sslServerKey`, `keyFile`, ...), and one script-taint finding per rule, line and origin class.
+Rules added for the unseen-v5 shapes, pinned both ways in `test/haskell/haskell-unseen-v5-shapes.test.js`: a Servant handler pairs the API's reads with its LAST parameters (`orderServer conn ref`; `haskell-ir.js` `servantEndpointParams` paired from the front and annotated the closure parameter); a `Set-Cookie` header handed to `setHeader`/`addHeader` is judged like a hand-written tuple; a project helper the IR inlined at its call site (`hs.inlinedFrom`) reports a fast password hash or a credential log once, in the helper (`markInlined`, `inlineCtx`, the filter before the return); mwc-random and splitmix are predictable generators (`System.Random.MWC` in `HS_RULE_APIS` so the IR qualifies the names); a function that MAKES a key (`newKey`, `generateApiKey`) is security-shaped, and `code`/`pin`/`otp` is a security value in a function that talks about a reset or a verification (`CONTEXT_CODE_VAR`, `CODE_CONTEXT`); an authentication endpoint (`AUTH_ENDPOINT_PATH`/`_NAME`) is never missing authentication; `X-Session`, `X-Token` and similar project header names are credentials (`CREDENTIAL_HEADER`); a yes/no answer about a credential (`accepted <- checkCredentials attempt`, a comparison, a `logical`, a helper whose returns are such: `returnsYesNo`) carries no credential text, a record built from one logged through another field (`attemptUser attempt`, a `member` of it) is that field, the record logged whole is the credential, and `lastFour`/`takeEnd`/`fingerprint` are masking helpers by name; `pushLogStr(Ln)` is a log sink. In `haskell-guards.js`: a CWE-918 flow whose URL starts from a literal (or a constant bound to one) naming the scheme, the host and a `/`, or whose request is built by http-conduit's modifiers over such a base, is lowered to `info` with `guardNote.kind: fixed-host-request` (`fixedHostRequest`; a record update that sets a host field, or a literal that stops inside the host, is not); when the WHOLE destination (scheme, host and path) is the literal and the client reaches only the query, headers, body, method or auth (`destinationFixed`), the guard also records a `constant-input` refutation tied to the file's hash, so the disposition is `refuted` (a concatenation, a path setter, a manager or an unknown record field leaves it open: lowered only); `judgeFinding` locates the sink in the CALLEE when the finding was found from a caller (the canonicalise-and-prefix guard in `persistDraft` refutes the flow found from `saveDraft`), and the XSS escaper judgement knows the catalog's HTML escapers and a project helper that uses the parameter receiving the tainted value only under an escaper. Nix (`test/nix/nix-development-shapes.test.js`): `AmbientCapabilities` as one string, `Defaults !authenticate`, a `*File` option handed a `writeText` of a literal (`nix-secret-plaintext`, exposure `store`), a TLS key path on any enabled service (`sslKey`, `sslServerKey`, `keyFile`, ...), and one script-taint finding per rule, line and origin class.
 
 Rules added for the unseen-v4 shapes, each pinned both ways in `test/haskell/haskell-unseen-v4-shapes.test.js`: a value READ from the request inside a function (`param`, `strictRequestBody`, `requestHeaders`, any `REQUEST_PROVENANCE` source) is caller text for the partial-function, allocation and bounding rules whatever the function's parameters are; a presence test does not cover a partial call on a value SPLIT or parsed from the tested one (`SPLITTER`), while the same split of the same value does; a relational test on a count bounds the allocation it sizes; a `System.Random` value that reaches the result of a security-shaped function is predictable randomness; a project record parameter with a credential or card field logged whole (`show card`) is sensitive logging, through a masking helper by name it is not; wai-extra `requestSizeCheck` bounds the body read. In `haskell-web.js`: Servant closure arguments before the endpoint's values are paired from the end; a container lookup by the request id (`M.lookup`) is the object selection for BOLA only; BOLA without an authenticated principal needs either a WRITE to the selected object or OWNER EVIDENCE (`OWNER_COL`: a statement names an owner column its WHERE clause does not use; `OWNER_FIELD`: the record the handler works with has an owner field it never reads, where "works with" means another field of that record is read); a Scotty handler typed `ActionM` but registered elsewhere is a route with method `UNKNOWN` (ownership only, never a missing-auth finding); a Yesod `isAuthorized` clause that can answer `AuthenticationRequired` guards; a privileged path whose handler calls into unseen code is a lower-severity missing-auth finding, but a plain write with no visible operation is NOT (23 echo, upload-demo and health-check routes on four real projects). Taint: `Network.Wai.Parse.fileName` is an `upload` source; `Network.Wai.responseLBS`/`responseBuilder` are CWE-79 sinks judged by the header argument (`waiHtmlContext`: `text/html` keeps, another content type lowers to `info`, opaque headers keep with a stated uncertainty); the HTML-escaper judgement follows local bindings, and a definition with no value in it (a read) is the raw origin; a Shakespeare quasi-quote with interpolations is rewritten in place to an application of its interpolated expressions (`hamletInterpolations`, boundary kind `quasiquote-hamlet`, never opaque) so `#{preEscapedToHtml body}` is a sink site and `#{body}` is not. Two shapes stay as they were on purpose: `getArgs` reaching a shell is `operator-controlled` (info), and `fetch url = parseRequest url >>= httpNoBody` stays a finding (a URL wrapper is not an `api-contract`); unseen-v4 labels both the other way, and that is recorded, not decided.
 
@@ -203,3 +203,9 @@ at the use site that shares one of the names disables the expansion (it stays th
 the alias's call-graph edge is kept via `inlinedCalls`; arguments are lowered in the CALLER's module. Pinned both ways in
 `test/haskell/haskell-alias-taint.test.js`. Haskell verdict-flip cases live in `bench/mutation/cases-haskell.mjs`; the 8
 `bench/cve-replay/deep/hs-*-shape` entries are synthetic (self-authored, not from advisories).
+
+## Project models for Haskell wrappers (PRD FR 03)
+
+`haskell-project-models.js` loads `.agentic-security/haskell-models.json` (schema `haskell-project-models/1`). A model declares a source, sink or sanitizer by module and function name and is accepted only with provenance (reviewer, date, reason), an argument position for a sink, an explicit family list for a sanitizer (`*` is refused), and a paired positive and negative test file that exists inside the project. A rejected model is a scan-health condition and has no effect. Accepted models are registered into the taint catalog for one scan (`registerProjectCatalogEntries`, tagged `source: 'project'`) and removed when `runFullScan` returns or throws. Each scan runs in its own owner scope (`scanOwner`, an AsyncLocalStorage in `dataflow/catalog.js`), so overlapping scans of different roots in one process never match each other's project entries.
+
+`haskell-budget-state.js` reads operator parse budgets from `AGENTIC_SECURITY_HASKELL_PARSE_BUDGETS` (`name=value,...`, parser budget names only; anything else is refused as a condition), and writes `.agentic-security/haskell-budget.json` with the effective budgets and every remaining file plus a content digest. The next scan reports `budget.sinceLast` (completed, still remaining on the same inputs, still remaining after a change, gone, newly remaining). It records work left; it does not resume, because the assurance pass parses every eligible file on every scan.

package/src/language/assurance.js

@@ -23,6 +23,10 @@ import { deriveCppContext } from './haskell-cpp.js';
 import { createNixAdapter } from './nix-adapter.js';
 import { analyzeHaskellManifests } from './haskell-manifests.js';
 import { packageOfModule } from './haskell-models.js';
+import { buildHaskellCoverage } from './haskell-coverage.js';
+import { budgetRecord, loadBudgetState, saveBudgetState } from './haskell-budget-state.js';
+import { DEFAULT_PARSE_BUDGETS } from './haskell-parser.js';
+import { buildHaskellIR } from './haskell-ir.js';
 
 export const ASSURANCE_VERSION = 'language-assurance/1';
 
@@ -75,7 +79,9 @@ export async function assessLanguageAssurance(input = {}) {
   const DISCLOSED_KINDS = new Set(['cpp', 'ffi', 'th-safe-splice', 'quasiquote-inert']);
   const disclosed = new Map();   // boundary kind -> {count, files:Set}
   const projectModules = new Set(); const importedModules = new Map();   // module -> files
+  const parsesByFile = new Map();
   const onParse = (file, parse) => {
+    parsesByFile.set(file, parse);
     if (parse && parse.module && parse.module.name) projectModules.add(parse.module.name);
     for (const i of (parse && parse.imports) || []) if (i && i.module) { const e = importedModules.get(i.module) || new Set(); e.add(file); importedModules.set(i.module, e); }
     for (const b of (parse && parse.boundaries) || []) {
@@ -86,7 +92,7 @@ export async function assessLanguageAssurance(input = {}) {
       disclosed.set(b.kind, e);
     }
   };
-  const adapters = input.adapters || [createHaskellAdapter({ onParse, cpp: deriveCppContext(files) }), createNixAdapter()];
+  const adapters = input.adapters || [createHaskellAdapter({ onParse, cpp: deriveCppContext(files), budgets: input.parseBudgets || undefined }), createNixAdapter()];
   const run = await runLanguageAnalysis({ files, adapters, timeoutMs: input.timeoutMs || 0 });
   const reconcile = reconcileLanguageLedger(run.ledger, files);
   const base = languageHealth({ ledger: run.ledger, outcomes: run.outcomes });
@@ -136,6 +142,18 @@ export async function assessLanguageAssurance(input = {}) {
   if (ociFiles.length) limitations.push({ kind: 'container-image-scan', files: ociFiles.sort(), note: 'Nix-built images and declared OCI services are analysed as configuration only: image layers and base-image vulnerabilities are NOT scanned' });
   if (!reconcile.ok) conditions.push(`language ledger does not reconcile with the inputs: ${reconcile.errors[0]}`);
 
+  // Buck-built Haskell: its dependency graph is not resolved by this scanner, so version-based advisory matching has nothing to match.
+  // Stated as a coverage gap (PRD FR 08) rather than left looking like "no vulnerable dependencies".
+  const buckHaskell = Object.entries(files).filter(([f, t]) => /(?:^|\/)(?:BUCK|TARGETS)(?:\.v2)?$/.test(f) && typeof t === 'string' && /\bhaskell_(?:library|binary|test|ghci)\b|\bprebuilt_haskell_library\b/.test(t)).map(([f]) => f).sort();
+  if (present.has('haskell') && buckHaskell.length) conditions.push(`${buckHaskell.length} Buck target file(s) declare Haskell dependencies this scan does not resolve (${buckHaskell.slice(0, 3).join(', ')}): dependency advisories were not matched for them`);
+
+  // Declared project models (PRD FR 03): a rejected declaration means a wrapper the project meant to model is still opaque.
+  const pm = input.projectModels;
+  if (pm && pm.present) {
+    if (pm.rejected.length) conditions.push(`${pm.rejected.length} Haskell project model(s) were rejected and have no effect: ${pm.rejected.slice(0, 3).map((r) => `${r.id} (${r.reason})`).join('; ')}`);
+    if (pm.accepted.length) limitations.push({ kind: 'project-models', count: pm.accepted.length, ids: pm.accepted.map((m) => m.id).sort(), note: 'wrappers modelled by reviewed project declarations (.agentic-security/haskell-models.json); each carries provenance and a paired positive and negative test' });
+  }
+
   // 2. manifests
   if (manifests.length) {
     let m = null;
@@ -188,6 +206,39 @@ export async function assessLanguageAssurance(input = {}) {
     }
   }
 
+  // 5b. Haskell coverage accounting (FR 02): per-file stages, rates against the eligible denominator, rule families executed.
+  let haskellCoverage = null;
+  if (present.has('haskell')) {
+    try {
+      let ir = null;
+      if (input.deepEnabled !== false) {
+        try { const hs = Object.fromEntries(Object.entries(files).filter(([f]) => /\.hs$/i.test(f))); if (Object.keys(hs).length) ir = buildHaskellIR(hs); } catch { ir = null; }
+      }
+      haskellCoverage = buildHaskellCoverage({
+        files, parses: parsesByFile, ir, deepEnabled: input.deepEnabled !== false && !disabled.has('haskell:taint'),
+        ruleRuns: input.ruleRuns || null, sizeSkipped: input.sizeSkipped, policyExcluded: input.policyExcluded,
+        excludedPaths: run.ledger.excludedFiles, sourceMap: input.sourceMap || null,
+      });
+      // Effective parse budgets, operator overrides that were refused, and the persisted record of work left (haskell-budget-state.js).
+      const b = haskellCoverage.budget;
+      b.budgets = { ...DEFAULT_PARSE_BUDGETS, ...(input.parseBudgets || {}) };
+      if (Array.isArray(input.parseBudgetRejected) && input.parseBudgetRejected.length) {
+        b.rejectedOverrides = input.parseBudgetRejected;
+        conditions.push(`Haskell parse budget override refused: ${input.parseBudgetRejected.map((r) => `${r.entry} (${r.reason})`).join('; ')}`);
+      }
+      const budgetOf = (file) => { const p = parsesByFile.get(file); return p && p.budget ? { budgetName: p.budget.name } : {}; };
+      const remainingAll = (b.remainingAll || []).map((r) => ({ ...r, ...budgetOf(r.file) }));
+      const previous = loadBudgetState(input.scanRoot);
+      const { record, sinceLast } = budgetRecord({ remaining: remainingAll, completedFiles: b.completedFiles, budgets: b.budgets, files, previous });
+      b.remaining = b.remaining.map((r) => ({ ...r, ...budgetOf(r.file) }));
+      b.sinceLast = sinceLast;
+      if (record.remainingFiles || previous) b.recorded = saveBudgetState(input.scanRoot, record);
+      // Only a measured shortfall is a condition. A parse-only form is a stated limitation, not a gap in what was asked.
+      for (const r of haskellCoverage.capability.reasons) if (!/deep analysis is disabled/.test(r)) conditions.push(`Haskell coverage: ${r}`);
+      for (const l of haskellCoverage.capability.limitations) limitations.push({ kind: 'haskell-parse-only', note: l });
+    } catch (e) { conditions.push(`Haskell coverage accounting failed: ${String((e && e.message) || e).slice(0, 160)}`); }
+  }
+
   // 6. optional modes
   const optionalModes = {};
   for (const name of OPTIONAL_MODES) {
@@ -198,7 +249,7 @@ export async function assessLanguageAssurance(input = {}) {
 
   return {
     version: ASSURANCE_VERSION,
-    languageCoverage: { totals: base.totals, byKind, conditions, limitations, capabilities, optionalModes },
+    languageCoverage: { totals: base.totals, byKind, conditions, limitations, capabilities, optionalModes, ...(haskellCoverage ? { haskell: haskellCoverage } : {}) },
     ledger: { reconciled: reconcile.ok, errors: reconcile.errors, byAnalyzer: run.ledger.byAnalyzer },
     outcomes: run.outcomes,
     retained: { findings: findings.length, findingsRef: findings },

package/src/language/haskell-budget-state.js

@@ -0,0 +1,85 @@
+// Haskell parse budgets and the record of work left when one is hit (PRD FR 02 "budget behavior and proof of completion").
+//
+// The parser stops a file at a named bound (bytes, tokens, nesting, steps, wall clock) and reports `budget_exceeded`; the file is
+// not analysed and the capability stays incomplete. This module does three things around that:
+//
+//   1. Operator budgets. AGENTIC_SECURITY_HASKELL_PARSE_BUDGETS raises (or lowers) named bounds: `deadlineMs=20000,maxTokens=800000`.
+//      Only the parser's own budget names are accepted, as positive integers; anything else is rejected and reported, never guessed.
+//   2. A persisted record. Each scan writes `.agentic-security/haskell-budget.json`: the effective budgets, the count of completed
+//      files, and every remaining file with the reason and a digest of its content.
+//   3. A comparison. The next scan reads that record and states, for each previously remaining file, whether it is now complete,
+//      still remaining on the same inputs and budgets (a deterministic bound will be hit again: raise it), still remaining after
+//      a change, or gone.
+//
+// What it does not do: resume. The Haskell pass parses every eligible file on every scan, so nothing is reused from a previous
+// run, and nothing is skipped because it was analysed before. The record proves what was and was not finished; it does not
+// shortcut the work. `deadlineMs` is wall-clock time, so a file can complete on one machine and exceed it on another.
+
+import * as fs from 'node:fs';
+import * as crypto from 'node:crypto';
+import { statePath, safeWriteState } from '../posture/state-dir.js';
+import { DEFAULT_PARSE_BUDGETS } from './haskell-parser.js';
+
+export const BUDGET_STATE_SCHEMA = 'haskell-budget-state/1';
+export const HASKELL_PARSE_BUDGET_ENV = 'AGENTIC_SECURITY_HASKELL_PARSE_BUDGETS';
+const STATE_FILE = 'haskell-budget.json';
+const MAX_RECORDED = 5000;
+
+/** Parse `name=value,...` into parser budget overrides. Returns { budgets, rejected }. */
+export function parseBudgetOverrides(raw) {
+  const budgets = {};
+  const rejected = [];
+  for (const part of String(raw || '').split(',').map((s) => s.trim()).filter(Boolean)) {
+    const m = /^([A-Za-z]+)\s*=\s*(\d+)$/.exec(part);
+    if (!m) { rejected.push({ entry: part, reason: 'expected name=positive-integer' }); continue; }
+    if (!Object.prototype.hasOwnProperty.call(DEFAULT_PARSE_BUDGETS, m[1])) { rejected.push({ entry: part, reason: `unknown budget "${m[1]}"` }); continue; }
+    const v = Number(m[2]);
+    if (!Number.isSafeInteger(v) || v <= 0) { rejected.push({ entry: part, reason: 'value must be a positive integer' }); continue; }
+    budgets[m[1]] = v;
+  }
+  return { budgets, rejected };
+}
+
+export const contentDigest = (text) => crypto.createHash('sha256').update(String(text ?? '')).digest('hex');
+
+export function loadBudgetState(scanRoot) {
+  if (!scanRoot) return null;
+  try {
+    const doc = JSON.parse(fs.readFileSync(statePath(scanRoot, STATE_FILE), 'utf8'));
+    if (!doc || doc.schema !== BUDGET_STATE_SCHEMA || !Array.isArray(doc.remaining)) return null;
+    return doc;
+  } catch { return null; }
+}
+
+const sameBudgets = (a, b) => JSON.stringify(Object.entries(a || {}).sort()) === JSON.stringify(Object.entries(b || {}).sort());
+
+/**
+ * Build this scan's record and compare it with the previous one.
+ * @param {{remaining:{file:string,parse:string,flowAnalysis:string,budgetName?:string}[], completedFiles:number,
+ *          budgets:object, files:Record<string,string>, previous:object|null}} i
+ */
+export function budgetRecord({ remaining, completedFiles, budgets, files, previous }) {
+  const rows = remaining.slice(0, MAX_RECORDED).map((r) => ({ ...r, digest: contentDigest(files[r.file]) }));
+  const record = { schema: BUDGET_STATE_SCHEMA, budgets, completedFiles, remainingFiles: remaining.length, remaining: rows, truncated: remaining.length > rows.length };
+  if (!previous) return { record, sinceLast: null };
+  const now = new Map(rows.map((r) => [r.file, r]));
+  const budgetsChanged = !sameBudgets(previous.budgets, budgets);
+  const sinceLast = { budgetsChanged, completed: [], stillRemainingSameInputs: [], stillRemainingChanged: [], gone: [], newlyRemaining: [] };
+  for (const p of previous.remaining) {
+    if (!(p.file in files)) { sinceLast.gone.push(p.file); continue; }
+    const cur = now.get(p.file);
+    if (!cur) { sinceLast.completed.push(p.file); continue; }
+    // Both digests are hashes of source files the scan already read, not secrets: comparison time reveals nothing.
+    if (cur.digest === p.digest && !budgetsChanged) sinceLast.stillRemainingSameInputs.push(p.file); // agentic-security-ignore: CWE-208
+    else sinceLast.stillRemainingChanged.push(p.file);
+  }
+  const before = new Set(previous.remaining.map((p) => p.file));
+  for (const r of rows) if (!before.has(r.file)) sinceLast.newlyRemaining.push(r.file);
+  for (const k of Object.keys(sinceLast)) if (Array.isArray(sinceLast[k])) sinceLast[k].sort();
+  return { record, sinceLast };
+}
+
+export function saveBudgetState(scanRoot, record) {
+  if (!scanRoot) return false;
+  return safeWriteState(statePath(scanRoot, STATE_FILE), JSON.stringify(record, null, 1) + '\n');
+}

package/src/language/haskell-coverage.js

@@ -0,0 +1,230 @@
+// Haskell coverage accounting (PRD FR 02).
+//
+// Answers "what actually ran" for Haskell, counted in separate stages so a
+// recognised extension, a successful parse and a completed data-flow analysis
+// are never conflated:
+//
+//   read -> parse -> ruleEvaluation -> graphInclusion -> flowAnalysis
+//
+// Every eligible file is in the denominator whether it parsed or not. A file
+// excluded by policy, a size cap or an excluded directory is listed with its
+// reason and is not eligible. Nothing here reads a file, runs a tool or
+// executes project code: it summarises results the engine already produced.
+//
+// Pure: inputs in, one record out.
+
+import * as path from 'node:path';
+import { parseCabalFile, parseHpackFile } from './haskell-manifests.js';
+
+export const COVERAGE_SCHEMA = 'haskell-coverage/1';
+export const DEFAULT_THRESHOLDS = Object.freeze({ parseRate: 0.95, semanticRate: 0.90 });
+
+const HS_FORM = /\.(lhs-boot|hs-boot|lhs|hs|hsig|hsc)$/i;
+const norm = (p) => String(p || '').replace(/\\/g, '/');
+export const formOf = (f) => { const m = HS_FORM.exec(norm(f)); return m ? m[1].toLowerCase() : null; };
+const isPlainHs = (f) => formOf(f) === 'hs';
+
+/** Rule families the Haskell pipeline can run. `needsDeep` ones only run under the IR layer. */
+export const RULE_FAMILIES = Object.freeze([
+  { id: 'hs-security-rules', label: 'crypto, randomness, resource, XML and sensitive-logging rules', needsDeep: false },
+  { id: 'hs-web', label: 'web routes and authorization', needsDeep: false },
+  { id: 'hs-llm', label: 'LLM usage rules', needsDeep: false },
+  { id: 'ir-taint', label: 'interprocedural taint (SQL, command, path, SSRF, ...)', needsDeep: true },
+  { id: 'hs-sca', label: 'dependency manifests and advisories', needsDeep: false },
+]);
+
+function packageIndex(files) {
+  const roots = [];
+  for (const [p, text] of Object.entries(files)) {
+    const np = norm(p);
+    const base = np.split('/').pop();
+    let r = null;
+    try {
+      if (/\.cabal$/i.test(base)) r = parseCabalFile(text, { file: np });
+      else if (base === 'package.yaml') r = parseHpackFile(text, { file: np });
+    } catch { r = null; }
+    if (r) roots.push({ dir: path.posix.dirname(np) === '.' ? '' : path.posix.dirname(np), name: (r.package && r.package.name) || path.posix.basename(path.posix.dirname(np)) || '(root)', manifest: np });
+  }
+  return roots.sort((a, b) => b.dir.length - a.dir.length);
+}
+
+function packageOf(file, index, sourceMap) {
+  const f = norm(file);
+  if (sourceMap && sourceMap.packages) {
+    let best = null;
+    for (const [name, prefixes] of Object.entries(sourceMap.packages)) {
+      for (const pre of [].concat(prefixes)) {
+        const p = norm(pre).replace(/\/+$/, '');
+        if ((f === p || f.startsWith(p + '/')) && (!best || p.length > best.len)) best = { name, len: p.length };
+      }
+    }
+    if (best) return { name: best.name, source: 'source-map' };
+  }
+  for (const r of index) if (r.dir === '' || f.startsWith(r.dir + '/')) return { name: r.name, source: 'manifest' };
+  return { name: '(unassigned)', source: 'none' };
+}
+
+const rate = (n, d) => (d > 0 ? n / d : null);
+
+/**
+ * @param {object} i
+ * @param {Record<string,string>} i.files       sources and manifests the scan read
+ * @param {Map<string,object>|Record<string,object>} [i.parses]  file -> parseHaskell result
+ * @param {object|null} [i.ir]                  buildHaskellIR result, or null when no graph was built
+ * @param {boolean} i.deepEnabled
+ * @param {Record<string,{ran:boolean, failed?:string, findings?:number}>} [i.ruleRuns]
+ * @param {{file:string,bytes:number,cap:number}[]} [i.sizeSkipped]
+ * @param {string[]} [i.policyExcluded]
+ * @param {string[]} [i.excludedPaths]          language-excluded build-output paths seen
+ * @param {{packages:Record<string,string|string[]>}|null} [i.sourceMap]
+ * @param {{parseRate:number, semanticRate:number}} [i.thresholds]
+ */
+export function buildHaskellCoverage(i) {
+  const files = i.files || {};
+  const th = { ...DEFAULT_THRESHOLDS, ...(i.thresholds || {}) };
+  const parses = i.parses instanceof Map ? i.parses : new Map(Object.entries(i.parses || {}));
+  const ir = i.ir || null;
+  const index = packageIndex(files);
+  const byFile = {};
+  const skipped = [];
+
+  const sizeSkipped = new Map((i.sizeSkipped || []).filter((x) => formOf(x.file)).map((x) => [norm(x.file), x]));
+  const policy = new Set((i.policyExcluded || []).map(norm).filter((f) => formOf(f)));
+  const excl = new Set((i.excludedPaths || []).map(norm).filter((f) => formOf(f)));
+  const present = Object.keys(files).map(norm).filter((f) => formOf(f));
+
+  const add = (file, status) => { byFile[file] = { form: formOf(file), package: packageOf(file, index, i.sourceMap).name, ...status }; };
+
+  for (const f of [...sizeSkipped.keys()]) {
+    const s = sizeSkipped.get(f);
+    add(f, { eligible: true, read: 'oversize', parse: 'not-attempted', ruleEvaluation: 'not-run', graphInclusion: 'not-in-graph', flowAnalysis: 'not-run', reason: `over the read cap (${s.bytes} > ${s.cap} bytes)` });
+  }
+  for (const f of policy) if (!byFile[f]) { add(f, { eligible: false, read: 'not-read', reason: 'default-ignored directory' }); skipped.push({ file: f, reason: 'default-ignored directory' }); }
+  for (const f of excl) if (!byFile[f]) { add(f, { eligible: false, read: 'not-read', reason: 'build-output directory' }); skipped.push({ file: f, reason: 'build-output directory' }); }
+
+  const familyRan = (id) => !!(i.ruleRuns && i.ruleRuns[id] && i.ruleRuns[id].ran);
+  const staticRulesRan = familyRan('hs-security-rules') && familyRan('hs-web');
+
+  for (const f of present.sort()) {
+    if (byFile[f]) continue;
+    const form = formOf(f);
+    const p = parses.get(f);
+    const parse = !p ? 'not-attempted' : p.status; // parsed | parsed_with_errors | failed | budget_exceeded | missing_grammar
+    const parsedOk = parse === 'parsed' || parse === 'parsed_with_errors';
+    // The rule modules and the IR read `.hs` only; every other form is parse-only and is said to be.
+    const plain = form === 'hs';
+    const ruleEvaluation = !plain ? 'unsupported-form' : !parsedOk ? 'not-run' : (staticRulesRan ? 'evaluated' : 'not-run');
+    const irFile = ir && ir.perFile && ir.perFile[f];
+    const graphInclusion = !plain ? 'parse-only' : (irFile ? 'included' : 'not-in-graph');
+    let flowAnalysis;
+    let fnDiscovered = p && Array.isArray(p.functions) ? p.functions.length : 0;
+    let fnLowered = 0; let fnIncomplete = 0;
+    if (irFile) {
+      const fns = irFile.functions.filter((x) => !(x.hs && x.hs.kind === 'module-init'));
+      fnLowered = fns.length; fnIncomplete = fns.filter((x) => x.hs && x.hs.incomplete).length;
+      fnDiscovered = Math.max(fnDiscovered, fnLowered);
+    }
+    const capped = ir && (ir.diagnostics || []).some((d) => d.file === f && (d.kind === 'function-cap' || d.kind === 'ir-lowering-failure' || d.kind === 'ir-parse-failure'));
+    if (!plain) flowAnalysis = 'unsupported-form';
+    else if (!i.deepEnabled) flowAnalysis = 'not-run:deep-analysis-disabled';
+    else if (graphInclusion !== 'included') flowAnalysis = 'not-run:not-in-graph';
+    else if (capped || fnIncomplete > 0 || parse === 'parsed_with_errors') flowAnalysis = 'partial';
+    else flowAnalysis = 'completed';
+    const boundaries = p && Array.isArray(p.boundaries) ? [...new Set(p.boundaries.map((b) => b.kind))].sort() : [];
+    add(f, {
+      eligible: true, read: 'read', parse, ruleEvaluation, graphInclusion, flowAnalysis,
+      functions: { discovered: fnDiscovered, lowered: fnLowered, incomplete: fnIncomplete },
+      ...(boundaries.length ? { boundaries } : {}),
+      ...(p && p.errors && p.errors.length ? { parseErrors: p.errors.length } : {}),
+    });
+  }
+
+  const rows = Object.entries(byFile);
+  const eligible = rows.filter(([, r]) => r.eligible);
+  const eligibleHs = eligible.filter(([f]) => isPlainHs(f));
+
+  const byForm = {};
+  for (const [f, r] of rows) { const k = r.form; (byForm[k] = byForm[k] || { discovered: 0, eligible: 0, parsed: 0, parsedWithErrors: 0, failed: 0 }); byForm[k].discovered++; if (r.eligible) byForm[k].eligible++; if (r.parse === 'parsed') byForm[k].parsed++; else if (r.parse === 'parsed_with_errors') byForm[k].parsedWithErrors++; else if (r.eligible) byForm[k].failed++; }
+
+  const byPackage = {};
+  for (const [, r] of rows) {
+    const e = (byPackage[r.package] = byPackage[r.package] || { discovered: 0, eligible: 0, parsed: 0, semanticComplete: 0 });
+    e.discovered++; if (r.eligible) e.eligible++; if (r.parse === 'parsed') e.parsed++; if (r.flowAnalysis === 'completed') e.semanticComplete++;
+  }
+
+  const parsedHs = eligibleHs.filter(([, r]) => r.parse === 'parsed').length;
+  const semanticHs = eligibleHs.filter(([, r]) => r.flowAnalysis === 'completed').length;
+  const fn = { discovered: 0, lowered: 0, incomplete: 0 };
+  for (const [, r] of eligible) if (r.functions) { fn.discovered += r.functions.discovered; fn.lowered += r.functions.lowered; fn.incomplete += r.functions.incomplete; }
+  const unresolvedCalls = ir && ir.callGraph && Array.isArray(ir.callGraph.unresolved) ? ir.callGraph.unresolved.length : (ir ? 0 : null);
+
+  const families = RULE_FAMILIES.map((fam) => {
+    const run = (i.ruleRuns && i.ruleRuns[fam.id]) || null;
+    const ranDeep = fam.needsDeep ? (i.deepEnabled && !!ir) : true;
+    const ran = !!(run && run.ran) && ranDeep;
+    // A caller that did not report rule runs (a direct assurance call, not an engine scan) gets 'not-reported': unknown, not a failure.
+    if (!i.ruleRuns) return { id: fam.id, label: fam.label, ran: null, status: 'not-reported', findings: null };
+    return { id: fam.id, label: fam.label, ran, status: ran ? 'executed' : (fam.needsDeep && !i.deepEnabled ? 'not-run:deep-analysis-disabled' : (run && run.failed ? `failed:${run.failed}` : 'not-run')), findings: run && Number.isInteger(run.findings) ? run.findings : null };
+  });
+
+  const reasons = [];
+  const limitations = [];
+  if (present.length + sizeSkipped.size > 0) {
+    if (!i.deepEnabled) reasons.push('deep analysis is disabled: no Haskell data-flow analysis ran');
+    for (const f of families) if (f.ran === false && !(f.id === 'ir-taint' && !i.deepEnabled) && f.id !== 'hs-sca') reasons.push(`rule family ${f.id} did not run (${f.status})`);
+    const pr = rate(parsedHs, eligibleHs.length);
+    const sr = rate(semanticHs, eligibleHs.length);
+    if (pr !== null && pr < th.parseRate) reasons.push(`parse success ${(pr * 100).toFixed(1)}% is below ${(th.parseRate * 100)}% of eligible .hs files`);
+    if (sr !== null && sr < th.semanticRate) reasons.push(`semantic analysis completed for ${(sr * 100).toFixed(1)}% of eligible .hs files, below ${(th.semanticRate * 100)}%`);
+    const nonHs = eligible.filter(([f]) => !isPlainHs(f)).length;
+    if (nonHs) limitations.push(`${nonHs} eligible file(s) in a non-.hs form (.lhs, .hs-boot, .hsig, .hsc) are parse-only: no rules or data-flow analysis`);
+  }
+
+  const incompleteEntries = eligibleHs.filter(([, r]) => r.parse !== 'parsed' || r.flowAnalysis !== 'completed')
+    .map(([file, r]) => ({ file, parse: r.parse, flowAnalysis: r.flowAnalysis })).slice(0, 500);
+  const mains = [];
+  if (ir && ir.callGraph && ir.callGraph.functions) {
+    for (const f of ir.callGraph.functions.values()) if (/\.main$/.test(f.name || '') && byFile[f.file] && byFile[f.file].flowAnalysis !== 'completed') mains.push({ name: f.name, file: f.file, flowAnalysis: byFile[f.file].flowAnalysis });
+  }
+
+  // Work completed and work remaining when a limit stopped the analysis (PRD FR 02). A file is remaining when its parse hit a
+  // budget or its flow analysis did not complete. Nothing is sampled: the lists are exhaustive up to the cap, in path order, so a
+  // rerun over the same inputs names the same files. `resume` says only what the scanner can do today (assurance.js adds the
+  // effective budgets and the comparison with the previous scan's record, language/haskell-budget-state.js).
+  const remaining = eligibleHs.filter(([, r]) => r.parse === 'budget_exceeded' || (r.parse === 'parsed' && r.flowAnalysis !== 'completed' && r.flowAnalysis !== 'not-applicable'))
+    .map(([file, r]) => ({ file, parse: r.parse, flowAnalysis: r.flowAnalysis })).sort((a, b) => (a.file < b.file ? -1 : 1));
+  const budget = {
+    exhausted: eligibleHs.some(([, r]) => r.parse === 'budget_exceeded'),
+    completedFiles: eligibleHs.length - remaining.length,
+    remainingFiles: remaining.length,
+    remaining: remaining.slice(0, 500),
+    remainingTruncated: remaining.length > 500,
+    // The Haskell pass parses every eligible file on every scan: nothing is reused from a previous run, so there is no resume.
+    resume: { supported: false, toFinish: 'raise the named parse budget with AGENTIC_SECURITY_HASKELL_PARSE_BUDGETS (name=value,...) and rescan; a file whose flow analysis did not run needs deep analysis on. The remaining files are never skipped silently, and the capability stays incomplete until they are analysed' },
+  };
+  // The full list (not capped) for the persisted record in haskell-budget-state.js; non-enumerable so the report shape is unchanged.
+  Object.defineProperty(budget, 'remainingAll', { value: remaining, enumerable: false });
+  const hasHaskell = present.length + sizeSkipped.size + policy.size + excl.size > 0;
+  return {
+    schema: COVERAGE_SCHEMA,
+    present: hasHaskell,
+    // `complete` only when every stage that was required ran to completion; never inferred from a zero-finding scan.
+    capability: { status: !hasHaskell ? 'not-applicable' : (reasons.length || sizeSkipped.size) ? 'incomplete' : 'complete', reasons, limitations },
+    totals: { discovered: rows.length, eligible: eligible.length, eligibleHs: eligibleHs.length, skipped: skipped.length },
+    byForm, byPackage,
+    stages: {
+      parse: { success: parsedHs, partial: eligibleHs.filter(([, r]) => r.parse === 'parsed_with_errors').length, failed: eligibleHs.filter(([, r]) => !['parsed', 'parsed_with_errors'].includes(r.parse)).length, rate: rate(parsedHs, eligibleHs.length) },
+      semantic: { completed: semanticHs, rate: rate(semanticHs, eligibleHs.length) },
+    },
+    functions: fn,
+    unresolvedCalls,
+    ruleFamilies: families,
+    thresholds: th,
+    meetsThresholds: hasHaskell ? ((rate(parsedHs, eligibleHs.length) ?? 1) >= th.parseRate && (rate(semanticHs, eligibleHs.length) ?? 1) >= th.semanticRate) : null,
+    incompleteEntries,
+    incompleteMains: mains,
+    budget,
+    skipped: skipped.slice(0, 500),
+    byFile,
+  };
+}

package/src/language/haskell-guards.js

@@ -17,6 +17,7 @@
 // has the prefix. A weak guard is reported as a note on the finding and does not refute it.
 
 const CANON_CALLS = new Set(['System.Directory.canonicalizePath', 'System.Directory.makeAbsolute', 'System.FilePath.normalise']);
+import { createHash } from 'node:crypto';
 import { HS_SANITIZERS } from './haskell-models.js';
 // the catalog's HTML escapers (blaze, lucid): the same list the taint catalog is generated from
 const CATALOG_HTML_ESCAPERS = new Set(HS_SANITIZERS.filter((s) => (s.appliesTo || []).includes('xss')).map((s) => `${s.module}.${s.name}`));
@@ -570,6 +571,11 @@ const REQUEST_BUILDERS = /(?:^|\.)(?:parseRequest|parseRequest_|parseUrlThrow|pa
 const REQUEST_MODIFIERS = /(?:^|\.)(?:setRequestQueryString|setRequestQuery|setQueryString|setRequestPath|setRequestBody|setRequestBodyLBS|setRequestBodyJSON|setRequestBodyURLEncoded|setRequestBodyFile|setRequestBodySource|setRequestHeader|setRequestHeaders|addRequestHeader|setRequestMethod|setRequestBasicAuth|setRequestBearerAuth|setRequestIgnoreStatus|setRequestResponseTimeout|setRequestCheckStatus|setRequestManager|urlEncodedBody|applyBasicAuth|applyBearerAuth)$/;
 const PEEL_WRAPPERS = /(?:^|\.)(?:liftIO|pure|return|unpack|pack|fromString|toStrict|fromStrict|encodeUtf8|decodeUtf8|toText|fromText)$/;
 const HOST_FIELD = /^(?:host|port|secure|url|uri|requestHost)$/i;
+// Record fields and modifiers that leave the destination exactly as the literal names it. Anything else on the way (a concatenation, a
+// path setter, a custom manager, which can carry a proxy, an unknown field) leaves the PATH or the route open, and then the finding is
+// only lowered, never refuted.
+const DESTINATION_NEUTRAL_FIELD = /^(?:method|requestHeaders|requestBody|queryString|responseTimeout|checkResponse|redirectCount|decompress|requestVersion|cookieJar)$/;
+const PATH_OPENING_MODIFIER = /(?:^|\.)(?:setRequestPath|setRequestManager)$/;
 
 function fixedHostRequest(f, perFile) {
   if (!f || f.cwe !== 'CWE-918') return null;
@@ -593,6 +599,7 @@ function fixedHostRequest(f, perFile) {
     return rets.length === 1 ? rets[0].value : null;
   };
   let evidence = null;
+  let open = false;
   const fixed = (e, seen, depth) => {
     if (!e || typeof e !== 'object' || depth > 24) return false;
     if (e.kind === 'literal') { const ok = typeof e.value === 'string' && HOST_ANCHORED.test(e.value); if (ok) evidence = e.value.replace(/^([a-z][a-z0-9+.-]*:\/\/[^/@?#\s]+\/).*$/i, '$1'); return ok; }
@@ -606,15 +613,16 @@ function fixedHostRequest(f, perFile) {
     if (e.kind === 'object' && Array.isArray(e.props)) {
       // a record update: `{ method = "POST" }` joined (as a union) with its base; a field that names the host makes it unknown
       if (e.props.some((p) => HOST_FIELD.test(String(p.key || p.name || '')))) return false;
+      if (e.props.some((p) => !DESTINATION_NEUTRAL_FIELD.test(String(p.key || p.name || '')))) open = true;
       return e.object ? fixed(e.object, seen, depth + 1) : true;
     }
-    if (e.kind === 'binary' && (e.op === '<>' || e.op === '++' || (e.hs && e.hs.concat))) return fixed(e.left, seen, depth + 1);
+    if (e.kind === 'binary' && (e.op === '<>' || e.op === '++' || (e.hs && e.hs.concat))) { open = true; return fixed(e.left, seen, depth + 1); }
     if (e.kind === 'call' && typeof e.callee === 'string') {
       const args = e.args || [];
       if (PEEL_WRAPPERS.test(e.callee) && args.length === 1) return fixed(args[0], seen, depth + 1);
       if (REQUEST_BUILDERS.test(e.callee) && args.length >= 1) return fixed(args[args.length - 1], seen, depth + 1);
-      if (REQUEST_MODIFIERS.test(e.callee) && args.length >= 1) return fixed(args[args.length - 1], seen, depth + 1);
-      if (/(?:^|\.)(?:<\/>|combine|joinPath)$/.test(e.callee) && args.length === 2) return fixed(args[0], seen, depth + 1);
+      if (REQUEST_MODIFIERS.test(e.callee) && args.length >= 1) { if (PATH_OPENING_MODIFIER.test(e.callee)) open = true; return fixed(args[args.length - 1], seen, depth + 1); }
+      if (/(?:^|\.)(?:<\/>|combine|joinPath)$/.test(e.callee) && args.length === 2) { open = true; return fixed(args[0], seen, depth + 1); }
     }
     return false;
   };
@@ -625,10 +633,10 @@ function fixedHostRequest(f, perFile) {
     // update alone, which is fixed when it names no host field, so the base branch decides
     if (!fixed(arg, new Set(), 0)) return null;
   }
-  return { kind: 'fixed-host-request', base: evidence };
+  return { kind: 'fixed-host-request', base: evidence, destinationFixed: !open };
 }
 
-export function applyHaskellGuards(findings, perFile) {
+export function applyHaskellGuards(findings, perFile, fileContents = null) {
   const stats = { refuted: 0, weak: 0 };
   for (const f of findings || []) {
     if (!f || f.parser !== 'IR-TAINT') continue;
@@ -656,6 +664,19 @@ export function applyHaskellGuards(findings, perFile) {
         f._fixedHost = true; f.severity = 'info';
         f.controls = [...(f.controls || []), { kind: 'fixed-host-request', evidenceKind: 'source' }];
         f.guardNote = { kind: 'fixed-host-request', reason: `the request's host is fixed by the literal${fh.base ? ` "${fh.base}"` : ''} the URL or base request starts from; the client's text can only choose the path, query or fragment, which is not a server-side request forgery (a path it chooses on that host is still worth a look)` };
+        // When the whole destination (scheme, host and path) is the literal and the client's text reaches only the query, headers, body,
+        // method or authentication, the claim that the client chooses where the request goes is disproved by the code itself: an
+        // evidence-backed refutation, tied to this file's content. A path the client can still choose is lowered only (above).
+        const text = fileContents && typeof fileContents[f.file] === 'string' ? fileContents[f.file] : null;
+        if (fh.destinationFixed && text !== null) {
+          f.refutation = {
+            kind: 'constant-input', verifier: 'haskell-guards/fixed-host-request', version: 1,
+            // the host goes in the evidence, not the reason: a host name such as `internal.example.com` is not a context excuse
+            evidenceRefs: [`${f.file}:${f.line}`, ...(fh.base ? [`destination:${fh.base}`] : [])],
+            reason: 'the request\'s destination is a literal in full (scheme, host and path); the client\'s text reaches only the query, headers, body, method or authentication',
+            sourceHash: createHash('sha256').update(text).digest('hex'),
+          };
+        }
         stats.weak++;
         continue;
       }