@clear-capabilities/agentic-security-scanner 0.187.0 → 0.189.0

package/src/language/haskell-manifests.js

@@ -371,7 +371,17 @@ function detectGenerated(text) {
 }
 
 function newStanza(kind, name, line, scope) {
-  return { kind, name, scope, line, deps: [], imports: [], surfaces: [], flagRefs: [], fields: {} };
+  return { kind, name, scope, line, deps: [], imports: [], surfaces: [], flagRefs: [], fields: {}, exposedModules: [], otherModules: [], opaque: [] };
+}
+
+// What a `ghc-options` value says about the build that the module graph cannot see: a different entry point, a source preprocessor, a compiler plugin.
+// Read from the field text, never from a comment (comment lines are dropped by the line lexer before a field is read).
+function ghcOpaqueKinds(text) {
+  const out = [];
+  if (/(?:^|\s)-main-is\b/.test(text)) out.push('main-is');
+  if (/(?:^|\s)-(?:F|pgmF)\b/.test(text)) out.push('preprocessor');
+  if (/(?:^|\s)-f?plugin(?:-package(?:-id)?)?\b/.test(text)) out.push('plugin');
+  return out;
 }
 
 function handleCabalField(st, name, node, conds, file) {
@@ -397,7 +407,17 @@ function handleCabalField(st, name, node, conds, file) {
     case 'import':
       for (const w of splitWords(val.text)) st.imports.push({ name: w.text, line: locate(val, w.offset).line });
       break;
+    case 'exposed-modules':
+      for (const w of splitWords(val.text)) st.exposedModules.push(w.text);
+      break;
+    case 'other-modules':
+      for (const w of splitWords(val.text)) st.otherModules.push(w.text);
+      break;
+    case 'signatures':
+      st.opaque.push('backpack-signatures');
+      break;
     case 'ghc-options': case 'ghc-prof-options': case 'ghc-shared-options':
+      for (const k of ghcOpaqueKinds(val.text)) if (!st.opaque.includes(k)) st.opaque.push(k);
       scanGhcOptions(val.text, null, (kind, detail, idx) => {
         const loc = locate(val, idx);
         st.surfaces.push({ kind, detail, file, line: loc.line, column: loc.column });
@@ -511,6 +531,7 @@ export function parseCabalFile(text, opts = {}) {
       for (const d of c.deps) into.deps.push({ ...d, via: `common:${imp.name}` });
       for (const s of c.surfaces) into.surfaces.push({ ...s, via: `common:${imp.name}` });
       for (const r of c.flagRefs) into.flagRefs.push(r);
+      for (const k of c.opaque) if (!into.opaque.includes(k)) into.opaque.push(k);
       expand(c, into, nextSeen, via);
     }
   };
@@ -518,7 +539,7 @@ export function parseCabalFile(text, opts = {}) {
   const declared = new Set(flags.map((f) => f.name));
   const unknownFlags = [];
   const components = stanzas.map((st) => {
-    const own = { deps: st.deps.slice(), surfaces: st.surfaces.slice(), flagRefs: st.flagRefs.slice() };
+    const own = { deps: st.deps.slice(), surfaces: st.surfaces.slice(), flagRefs: st.flagRefs.slice(), opaque: [] };
     expand(st, own, new Set(), null);
     for (const r of own.flagRefs) {
       if (!declared.has(r.flag)) {
@@ -535,6 +556,9 @@ export function parseCabalFile(text, opts = {}) {
       line: st.line,
       imports: st.imports,
       fields: st.fields,
+      exposedModules: st.exposedModules,
+      otherModules: st.otherModules,
+      opaque: [...new Set([...st.opaque, ...own.opaque])],
       dependencies: own.deps.map((d) => ({ ...d, scope: d.scopeOverride || st.scope, scopeOverride: undefined })),
       surfaces: own.surfaces,
     };
@@ -639,8 +663,16 @@ export function parseHpackFile(text, opts = {}) {
         if (scopeOverride === 'build-tool') surfaces.push({ kind: 'build-tool-depends', detail: `${e.name} ${e.rangeText}`.trim(), file, line, column: d.column, component: st.name });
       }
     }
+    for (const key of ['exposed-modules', 'other-modules']) {
+      if (!(key in sec)) continue;
+      const v = Array.isArray(sec[key]) ? sec[key] : [sec[key]];
+      for (const m of v) if (typeof m === 'string') (key === 'exposed-modules' ? st.exposedModules : st.otherModules).push(m.trim());
+      if (key === 'exposed-modules') st.exposedDeclared = true;
+    }
+    if ('generated-exposed-modules' in sec || 'generated-other-modules' in sec) st.opaque.push('hpack-generated-modules');
     if ('ghc-options' in sec) {
       const opt = Array.isArray(sec['ghc-options']) ? sec['ghc-options'].join(' ') : String(sec['ghc-options']);
+      for (const k of ghcOpaqueKinds(opt)) if (!st.opaque.includes(k)) st.opaque.push(k);
       let li = findLine(lines, new RegExp(`^${ind}(?:-\\s+)?ghc-options\\s*:`), start);
       if (li < 0) li = start;
       scanGhcOptions(opt, null, (kind, detail) => surfaces.push({ kind, detail, file, line: li + 1, column: 0, component: st.name }));
@@ -662,7 +694,7 @@ export function parseHpackFile(text, opts = {}) {
     }
   };
 
-  const mkStanza = (kind, name, scope) => ({ kind, name, scope, deps: [], flagRefs: [] });
+  const mkStanza = (kind, name, scope) => ({ kind, name, scope, deps: [], flagRefs: [], exposedModules: [], otherModules: [], opaque: [], exposedDeclared: false });
   const finish = (st, line) => {
     for (const r of st.flagRefs) {
       if (!(doc.flags && isObj(doc.flags) && r.flag in doc.flags)) {
@@ -670,17 +702,19 @@ export function parseHpackFile(text, opts = {}) {
         diagnostics.push(diag('unknown_flag', `condition references flag '${r.flag}' that package.yaml never declares`, file, r.line, 'warning', { flag: r.flag }));
       }
     }
-    return { kind: st.kind, name: st.name, scope: st.scope, file, line, dependencies: st.deps.map((d) => ({ ...d, scope: d.scopeOverride || st.scope, scopeOverride: undefined })) };
+    return { kind: st.kind, name: st.name, scope: st.scope, file, line, exposedModules: st.exposedModules, otherModules: st.otherModules, exposedDeclared: st.exposedDeclared, opaque: st.opaque, buildTools: st.deps.filter((d) => d.scopeOverride === 'build-tool').map((d) => d.name), dependencies: st.deps.map((d) => ({ ...d, scope: d.scopeOverride || st.scope, scopeOverride: undefined })) };
   };
 
   const components = [];
   let packageDependencies = [];
+  let topOpaque = [];
   try {
     const top = mkStanza('package', pkg.name, 'package');
     collect(doc, top, [], 0, 0);
     // top-level `when` and deps apply to every component
     const topLoc = finish(top, 1);
     packageDependencies = topLoc.dependencies;
+    topOpaque = topLoc.opaque;
 
     const section = (key, kind, scope, single) => {
       if (!(key in doc)) return;
@@ -735,7 +769,7 @@ export function parseHpackFile(text, opts = {}) {
   return {
     kind: 'hpack', file, package: pkg, provenance: { generatedBy: null, source: 'hand-written' },
     components, packageDependencies, flags: flagList, unknownFlags, sourceRepositories,
-    surfaces, incomplete, diagnostics,
+    surfaces, incomplete, diagnostics, topOpaque,
   };
 }
 
@@ -1258,6 +1292,55 @@ export function analyzeHaskellManifests(files, opts = {}) {
   return redactUrlsDeep(out);
 }
 
+// ---------------------------------------------------------------------------
+// Exposed modules (who can import this package from outside)
+// ---------------------------------------------------------------------------
+
+/** Work counter for the exposed-module index: one parse per cabal / package.yaml, never per function or per module. Read by the scaling test. */
+export const EXPOSED_INDEX_WORK = { manifestParses: 0, builds: 0 };
+
+/**
+ * The set of modules a package's manifests EXPOSE to other packages, over every `.cabal` file (and every `package.yaml` that has no `.cabal` beside
+ * it) in `manifests` (path -> text). Returns `{ modules, reason, packages, libraries }`: `modules` is a Set of module names, or `null` when the
+ * manifests cannot say (none present, one failed to parse or hit a budget, an hpack library that exposes every module by default, a build that uses an
+ * entry-point override, a source preprocessor, a plugin, Backpack signatures, a foreign library, or a build tool that generates code outside the
+ * analysed files). `null` is "unknown", never "nothing exposed": an executable-only package yields an EMPTY set, which is a real answer.
+ * Conditional stanzas are unioned (a module exposed under any flag setting is exposed). Nothing here reads a comment, a name or a path.
+ */
+export function exposedModuleIndex(manifests, opts = {}) {
+  EXPOSED_INDEX_WORK.builds++;
+  const budgets = budgetsOf(opts);
+  const entries = Object.entries(manifests || {}).map(([p, text]) => [String(p).replace(/\\/g, '/'), typeof text === 'string' ? text : '']).filter(([p]) => { const k = classifyManifest(p); return k === 'cabal' || k === 'hpack'; }).sort((a, b) => (a[0] < b[0] ? -1 : 1));
+  if (!entries.length) return { modules: null, reason: 'no-manifest', packages: 0, libraries: 0 };
+  const cabalDirs = new Set(entries.filter(([p]) => classifyManifest(p) === 'cabal').map(([p]) => path.posix.dirname(p)));
+  const modules = new Set();
+  let packages = 0; let libraries = 0; let unknown = null;
+  const fail = (why) => { if (!unknown) unknown = why; };
+  for (const [p, text] of entries) {
+    const kind = classifyManifest(p);
+    if (kind === 'hpack' && cabalDirs.has(path.posix.dirname(p))) continue;   // the generated .cabal beside it is what the build reads
+    EXPOSED_INDEX_WORK.manifestParses++;
+    let r;
+    try { r = kind === 'cabal' ? parseCabalFile(text, { file: p, budgets }) : parseHpackFile(text, { file: p, budgets }); } catch { fail('manifest-parse-failure'); continue; }
+    if (r.incomplete) { fail('manifest-incomplete'); continue; }
+    if ((r.diagnostics || []).some((d) => d.code === 'budget_exceeded' || d.kind === 'budget_exceeded')) { fail('manifest-budget'); continue; }
+    packages++;
+    if ((r.topOpaque || []).length) fail(`build-${r.topOpaque[0]}`);
+    for (const c of r.components) {
+      if (c.kind === 'foreign-library') fail('foreign-library');
+      if ((c.opaque || []).length) fail(`build-${c.opaque[0]}`);
+      const generates = (c.surfaces || []).some((s) => s.kind === 'build-tool-depends') || (c.buildTools || []).length > 0;
+      if (generates && c.kind !== 'test-suite' && c.kind !== 'benchmark') fail('build-tool-generated-sources');
+      if (c.kind !== 'library') continue;
+      libraries++;
+      if (kind === 'hpack' && !c.exposedDeclared) fail('hpack-library-exposes-all-modules');
+      for (const m of c.exposedModules || []) modules.add(m);
+    }
+  }
+  if (unknown) return { modules: null, reason: unknown, packages, libraries };
+  return { modules, reason: null, packages, libraries };
+}
+
 const WALK_SKIP = new Set(['node_modules', '.git', '.hg', '.svn']);
 
 /** Read manifests under `root` (bounded, symlinks never followed) and analyse them. */

package/src/language/haskell-models.js

@@ -73,6 +73,7 @@ export const HS_PACKAGES = Object.freeze({
   HsOpenSSL: { modules: ['OpenSSL.Session'], tested: [] },
   'wai-extra': { modules: ['Network.Wai.Parse', 'Network.Wai.Conduit'], tested: [] },
   'scotty-cookie': { modules: ['Web.Scotty.Cookie'], tested: [] },
+  ihp: { modules: ['IHP.ControllerPrelude', 'IHP.Controller.Param'], tested: [] },
   'http-types': { modules: ['Network.HTTP.Types', 'Network.HTTP.Types.Header'], tested: [] },
   'conduit-extra': { modules: ['Data.Conduit.Binary', 'Data.Conduit.Combinators'], tested: [] },
   'uri-parsing': { modules: ['Text.URI'], tested: [] },
@@ -85,10 +86,16 @@ const SRC = [];
 const src = (module, names, provenance, label, extra = {}) => { for (const e of E(module, names)) SRC.push({ ...e, provenance, label: `${label}${names.length > 1 ? '' : ''}`, package: extra.package, framework: extra.framework || null }); };
 
 src('Prelude', ['getLine', 'getContents', 'readLn', 'interact'], 'stdin', 'standard input', { package: 'base' });
-src('System.IO', ['getLine', 'getContents', 'hGetLine', 'hGetContents', 'hGetChar'], 'stdin', 'handle input', { package: 'base' });
-src('Data.Text.IO', ['getLine', 'getContents', 'hGetLine', 'hGetContents', 'interact'], 'stdin', 'text input', { package: 'text' });
-src('Data.ByteString', ['getLine', 'getContents', 'hGetLine', 'hGetContents'], 'stdin', 'bytes input', { package: 'bytestring' });
-src('Data.ByteString.Char8', ['getLine', 'getContents', 'hGetLine', 'hGetContents'], 'stdin', 'bytes input', { package: 'bytestring' });
+// `getLine` and `getContents` read standard input. `hGetLine`/`hGetContents`/`hGetChar` read WHATEVER handle they are given (a file the program opened,
+// a child process's pipe, a socket, or stdin), so they are modelled as a read through a handle, not as standard input.
+src('System.IO', ['getLine', 'getContents'], 'stdin', 'handle input', { package: 'base' });
+src('System.IO', ['hGetLine', 'hGetContents', 'hGetChar'], 'file-read', 'handle input', { package: 'base' });
+src('Data.Text.IO', ['getLine', 'getContents', 'interact'], 'stdin', 'text input', { package: 'text' });
+src('Data.Text.IO', ['hGetLine', 'hGetContents'], 'file-read', 'text input', { package: 'text' });
+src('Data.ByteString', ['getLine', 'getContents'], 'stdin', 'bytes input', { package: 'bytestring' });
+src('Data.ByteString', ['hGetLine', 'hGetContents'], 'file-read', 'bytes input', { package: 'bytestring' });
+src('Data.ByteString.Char8', ['getLine', 'getContents'], 'stdin', 'bytes input', { package: 'bytestring' });
+src('Data.ByteString.Char8', ['hGetLine', 'hGetContents'], 'file-read', 'bytes input', { package: 'bytestring' });
 src('System.Environment', ['getArgs'], 'cli', 'command-line argument', { package: 'base' });
 src('System.Environment', ['getEnv', 'lookupEnv', 'getEnvironment'], 'env', 'environment variable', { package: 'base' });
 src('Prelude', ['readFile'], 'file-read', 'file content', { package: 'base' });
@@ -144,6 +151,10 @@ for (const mod of ['Web.Scotty', 'Web.Scotty.Trans']) {
   src(mod, ['bodyReader', 'bodyRaw'], 'http-body', 'scotty request body', { package: 'scotty', framework: 'scotty' });
 }
 src('Web.Scotty.Cookie', ['getCookie', 'getCookies'], 'cookie', 'scotty request cookie', { package: 'scotty-cookie', framework: 'scotty' });
+// IHP: a controller action reads the request with `param @Text "name"` (a pure function over the implicit request): the value is whatever the client sent.
+for (const mod of ['IHP.ControllerPrelude', 'IHP.Controller.Param']) {
+  src(mod, ['param', 'paramText', 'paramOrNothing', 'paramOrDefault', 'paramList'], 'url-param', 'IHP request parameter', { package: 'ihp', framework: 'ihp' });
+}
 for (const mod of ['Yesod.Core', 'Yesod']) {
   src(mod, ['parseJsonBody', 'requireJsonBody', 'parseCheckJsonBody', 'requireCheckJsonBody', 'lookupCookies', 'lookupHeaders'], 'http-body', 'yesod request body', { package: 'yesod', framework: 'yesod' });
   src(mod, ['lookupBasicAuth'], 'header', 'yesod request header', { package: 'yesod', framework: 'yesod' });

package/src/language/haskell-parser.js

@@ -1142,10 +1142,24 @@ const IR_PREPROCESS_GUARD = /^[ \t]*#\s*(?:if|ifdef|ifndef|elif|else|endif|defin
  * Returns the input unchanged when it has nothing to preprocess or cannot be parsed.
  */
 export function preprocessForSyntax(source, opts = {}) {
-  if (typeof source !== 'string' || !IR_PREPROCESS_GUARD.test(source)) return source;
+  return preprocessForSyntaxInfo(source, opts).text;
+}
+
+/**
+ * The same preprocessing, plus what it learned about the file's opaque boundaries: `opaque` is `false` when the file has none (including every
+ * Template Haskell splice and quasi-quote the closed allow-lists accepted), `true` when a splice, quasi-quote or TH quotation remains whose expansion
+ * is generated at compile time (code the analysis never sees, which can call any function), and `null` when the file mentions Template Haskell but
+ * could not be parsed to find out. Decided from tokens and extensions, never from comment text (the guard only decides whether to look).
+ */
+export function preprocessForSyntaxInfo(source, opts = {}) {
+  const none = { text: source, opaque: false };
+  if (typeof source !== 'string') return none;
+  const thQuotesOnly = /\bTemplateHaskellQuotes\b/.test(source);
+  if (!IR_PREPROCESS_GUARD.test(source)) return thQuotesOnly ? { text: source, opaque: null } : none;
   let r;
-  try { r = parseHaskell(source, { file: opts.file, cpp: opts.cpp }); } catch { return source; }
-  if (!r || !r.ok || typeof r._preprocessed !== 'string' || r._preprocessed.length !== source.length) return source;
+  try { r = parseHaskell(source, { file: opts.file, cpp: opts.cpp }); } catch { return { text: source, opaque: null }; }
+  if (!r || !r.ok || typeof r._preprocessed !== 'string' || r._preprocessed.length !== source.length) return { text: source, opaque: /\b(?:TemplateHaskell|TemplateHaskellQuotes|QuasiQuotes)\b/.test(source) ? null : false };
+  const opaque = (r.boundaries || []).some((b) => b && typeof b.kind === 'string' && (b.kind.startsWith('th-') && b.kind !== 'th-safe-splice' || b.kind === 'quasiquote'));
   let out = r._preprocessed;
   for (const b of r.blankRanges || []) {
     const seg = out.slice(b.startOffset, b.endOffset);
@@ -1153,5 +1167,5 @@ export function preprocessForSyntax(source, opts = {}) {
     if (b.kind === 'quasiquote-inert' && repl.length >= 2) repl = `"${repl.slice(1, -1)}"`;
     out = out.slice(0, b.startOffset) + repl + out.slice(b.endOffset);
   }
-  return out;
+  return { text: out, opaque };
 }

package/src/language/haskell-reachability.js

@@ -0,0 +1,84 @@
+// Project-reachability adjudication of Haskell taint findings.
+//
+// `haskell-ir.js` `projectReachability` stamps every function with `hs.reachability {status, rootKind, holeReason}`: could any caller exist, judged from
+// the project's entry points over the call graph? This module reads that verdict for the function a taint finding was found in and records it on the
+// finding as `reachability {status, reason, premise, roots, holeReason}`. It is a SEPARATE record from `trustBoundary`: that one answers who controls
+// the input, this one answers whether a caller can exist, and either may be `unknown` independently.
+//
+//   status        entrypoint-reachable | unreachable-in-project | external-api | unknown
+//   premise       what the finding's own claim rests on:
+//                   caller-controlled-parameter   the only origin recorded is the assumption that an untrusted caller supplies a parameter of
+//                                                 an exported function (the weak label, `hs:caller-controlled`)
+//                   recorded-read                 a real environment, command-line, file, standard-input, socket or request read is on the chain
+//
+// What the verdict does to the finding:
+//   unreachable-in-project and premise caller-controlled-parameter   the premise is withdrawn (an entry-point-rooted walk over a hole-free graph says
+//                                                 there is no caller at all): lowered to `info`, never dropped (`lowerFinding`, `_reachLowered`)
+//   unreachable-in-project and premise recorded-read   NOT lowered. "Nothing calls this" is a claim about a call graph in a language where typeclass
+//                                                 dispatch, re-exports and point-free aliasing routinely defeat call graphs; being wrong costs a real
+//                                                 vulnerability, so it may cost rank (`posture/relevance.js` reads `f.reachability`) and not visibility
+//   unknown, external-api, entrypoint-reachable   nothing happens to the severity
+//
+// Nothing here reads a comment, a name or a path: the inputs are the call-graph verdict and the origins the taint engine recorded.
+
+import { lowerFinding, originClasses } from './haskell-trust.js';
+
+const HS_FILE = /\.(?:l?hs|hsc)$/i;
+
+const fnByQid = (perFile, qid) => {
+  if (!qid) return null;
+  const file = String(qid).split('::')[0];
+  const ir = perFile && perFile[file];
+  return ir ? ir.functions.find((x) => x.qid === qid) || null : null;
+};
+
+const REASONS = Object.freeze({
+  'entrypoint-reachable': 'a call path from a project entry point reaches the function',
+  'external-api': 'the function belongs to a module the package exposes, so its callers are outside the analysed code',
+  'unreachable-in-project': 'no entry point of the project reaches the function through the call graph (complete scan, hole-free graph, a main and a manifest present, module not exposed)',
+});
+const HOLE_TEXT = Object.freeze({
+  'partial-scan': 'the scan covered only part of the project',
+  'policy-excluded': 'Haskell sources were kept out of the scan by the path policy',
+  'size-skipped': 'Haskell sources were too large to read',
+  'no-entrypoint': 'the analysed files contain no `main`, so there is no entry point to walk from',
+  'no-manifest': 'no manifest says which modules the package exposes',
+  'parse-failure': 'a declaration could not be read, so its calls are missing from the graph',
+  'function-cap': 'functions past the per-file cap are not in the graph',
+  'opaque-boundary': 'Template Haskell, a quasi-quote, a foreign export, a build step that generates code or a source format the IR does not read can call functions the graph does not show',
+  'unresolved-call': 'a function reachable from an entry point makes a call the IR could not resolve',
+  'instance-method': 'an instance method can be invoked by anything that can see its type',
+  'unresolved-route': 'a route registration could not be resolved',
+});
+
+/** What the finding's own claim rests on (see the header). `null` when the recorded origins do not settle it. */
+function premiseOf(f) {
+  const { roots, classes } = originClasses(f);
+  if (!roots.length) return null;
+  if ([...classes].every((c) => c === 'weak-param')) return 'caller-controlled-parameter';
+  if ([...classes].some((c) => c === 'operator' || c === 'external' || c === 'data')) return 'recorded-read';
+  return null;
+}
+
+/**
+ * Stamps `reachability` on every Haskell IR-TAINT finding that has a verdict for its function, and lowers to `info` the ones whose only premise
+ * (a caller-controlled parameter) the verdict withdraws. Mutates the findings; returns counts.
+ */
+export function applyHaskellReachability(findings, perFile) {
+  const stats = { 'entrypoint-reachable': 0, 'unreachable-in-project': 0, 'external-api': 0, unknown: 0, lowered: 0, rankOnly: 0, unstamped: 0 };
+  for (const f of findings || []) {
+    if (!f || f.parser !== 'IR-TAINT' || !HS_FILE.test(String(f.file || ''))) continue;
+    const fn = fnByQid(perFile, f._funcQid);
+    const r = fn && fn.hs && fn.hs.reachability;
+    if (!r || !r.status) { stats.unstamped++; continue; }
+    const premise = premiseOf(f);
+    const reason = r.status === 'unknown' ? (HOLE_TEXT[r.holeReason] || 'the call graph cannot settle it') : REASONS[r.status];
+    f.reachability = { status: r.status, reason, premise, roots: r.rootKind ? [r.rootKind] : [], holeReason: r.holeReason || null };
+    stats[r.status] = (stats[r.status] || 0) + 1;
+    if (r.status !== 'unreachable-in-project') continue;
+    if (premise === 'caller-controlled-parameter') {
+      if (lowerFinding(f, { kind: 'unreachable-in-project', reason: 'the finding rests on a caller of an exported function supplying a parameter, and nothing in the project can call it', controlKind: 'no-caller-in-project', guard: '_reachLowered', keepNote: true })) stats.lowered++;
+    } else if (premise === 'recorded-read') stats.rankOnly++;
+  }
+  return stats;
+}

package/src/language/haskell-security-rules.js

@@ -15,6 +15,7 @@
 
 import { buildHaskellIR } from './haskell-ir.js';
 import { HS_LOG_SINKS, HS_MODEL_VERSION } from './haskell-models.js';
+import { codeOfLine } from './haskell-comments.js';
 
 export const HS_RULES_VERSION = 'haskell-security-rules/1';
 
@@ -68,7 +69,9 @@ const UNSAFE_CALLS = { 'System.IO.Unsafe.unsafePerformIO': 'unsafePerformIO', 'S
 const SECRET_KEY_CALLS = new Set(['Web.JWT.hmacSecret', 'Web.JWT.secret', 'Servant.Auth.Server.fromSecret', 'Web.ClientSession.initKey']);
 const isTrueLit = (e) => !!e && ((e.kind === 'literal' && /^true$/i.test(String(e.value))) || (e.kind === 'ident' && /(?:^|\.)True$/.test(e.name || '')));
 const TIME_SOURCES = new Set(['Data.Time.Clock.POSIX.getPOSIXTime', 'Data.Time.Clock.getCurrentTime', 'System.CPUTime.getCPUTime']);
-const SECURITY_FN_SUBSTR = /(?:token|nonce|secret|otp|csrf|session|salt|apikey|resetcode|passcode|verification)/i;
+// A salt is deliberately absent: it must be unique, not unpredictable or secret (it is stored beside the hash), so a non-cryptographic generator
+// producing one is not a weakness the way it is for a token, nonce or key.
+const SECURITY_FN_SUBSTR = /(?:token|nonce|secret|otp|csrf|session|apikey|resetcode|passcode|verification)/i;
 // Short credential words that would over-match as substrings (`spin`, `mapping`, `keyboard`): matched as whole camelCase / snake_case words.
 const SECURITY_WORDS = new Set(['pin', 'password', 'passwd', 'credential', 'credentials']);
 const SECURITY_FN = { test: (name) => SECURITY_FN_SUBSTR.test(name) || String(name).replace(/([a-z0-9])([A-Z])/g, '$1_$2').toLowerCase().split(/[^a-z0-9]+/).some((w) => SECURITY_WORDS.has(w)) };
@@ -89,7 +92,7 @@ const EMPTINESS_CHECK = /(?:^|\.)(?:null|notNull|isEmpty|length|size|isJust|isNo
 const SESSION_COOKIE = /(?:sess|sid|token|tok|auth|jwt|csrf|login|remember|secret)/i;
 
 // What makes a bound variable security-shaped, and what makes a value sensitive for logging.
-const SECURITY_VAR = /^(?:.*(?:token|secret|nonce|salt|otp|csrf|apikey|api_?key|sessionid|session_?key|sessiontoken|resettoken)[a-z0-9_']*|key|iv|sessionId|sid)$/i;
+const SECURITY_VAR = /^(?:.*(?:token|secret|nonce|otp|csrf|apikey|api_?key|sessionid|session_?key|sessiontoken|resettoken)[a-z0-9_']*|key|iv|sessionId|sid)$/i;
 const PASSWORD_VAR = /(?:^|[^a-z])(?:pass(?:word|wd|phrase)?|pwd|pw)(?:[^a-z]|$)|password/i;
 const LOW_ENTROPY = /(?:pass(?:word|wd|phrase)?|pwd|ssn|creditcard|cardnumber|cvv|\bpin\b)/i;
 export const SENSITIVE = /(?:pass(?:word|wd|phrase)?|pwd|(?:^|[^a-z])pw(?:[^a-z]|$)|secret|token|api_?key|ssn|credit_?card|card_?number|cvv|authorization|bearer|private_?key|session_?id)/i;
@@ -128,6 +131,15 @@ const isLiteralLike = (e, depth = 0) => {
   return false;
 };
 
+// A concatenation of literals only (`"a=" <> "0" <> "; Path=/"`).
+const constantConcat = (e, depth = 0) => {
+  if (!e || depth > 12) return false;
+  if (e.kind === 'literal') return true;
+  if (e.kind === 'binary' && e.hs && e.hs.concat) return constantConcat(e.left, depth + 1) && constantConcat(e.right, depth + 1);
+  if (e.kind === 'call' && /(?:^|\.)(?:pack|fromString|encodeUtf8|fromStrict|toStrict)$/.test(e.callee || '') && e.args && e.args.length === 1) return constantConcat(e.args[0], depth + 1);
+  return false;
+};
+
 function fnNodes(fn) { return Object.values(fn.cfg.nodes); }
 
 // The text a concatenation spells out, in order, skipping the parts that are not literals (`"session_id=" <> sid <> "; Path=/"` -> `session_id=; Path=/`).
@@ -142,7 +154,100 @@ function literalTextOf(e, depth = 0) {
 function snippetOf(text, line) {
   if (!text || !Number.isInteger(line) || line < 1) return '';
   const l = text.split('\n')[line - 1];
-  return typeof l === 'string' ? l.trim().slice(0, 240) : '';
+  return typeof l === 'string' ? codeOfLine(l).slice(0, 240) : '';
+}
+
+// An unbounded read is a resource-exhaustion finding when the party that fills the input is not the operator. A handle opened on a
+// local file, a child process's pipe or a handle passed in is the operator's own (a file's size is what the file system says); a
+// socket or connection handle is filled by the peer. A read of standard input is the operator's in a program's own control flow, and
+// the caller's only in an entry point nothing in the analysed code calls (a library function handing back whatever its caller pipes in).
+const NETWORK_HANDLE_CALL = /(?:^|\.)(?:socketToHandle|connectTo|accept|acceptOn|openTCPConnection)$/;
+
+/**
+ * Are this function's callers outside the analysed code? With no project-reachability verdict, or an `unknown` one, the answer is exactly what it
+ * has always been (nothing in the analysed code calls or references it). A function no caller can reach (`unreachable-in-project`) has none. One
+ * reached from an entry point takes its parameters from that path, EXCEPT a root nothing in the analysed code calls (a framework handler, a foreign
+ * export, code the parser withheld): its caller is outside.
+ *
+ * A function of an exposed module (`external-api`) is DELIBERATELY answered as today: the plan for this change said "a public API's callers are
+ * external, so true", but for an exposed function that something in the project also calls that turns on the partial-function and unbounded-read
+ * rules for every such function, and on the development set it added seven flagged sites and no true positive (precision 35.7% -> 23.8%). The
+ * status is still recorded and still keeps the taint finding at full severity; it just does not widen these two rules. Flipping it is the one line
+ * below, with that measurement as the cost.
+ */
+export function callersUnknown(fn) {
+  const hs = (fn && fn.hs) || {};
+  const r = hs.reachability || null;
+  if (!r || r.status === 'unknown' || r.status === 'external-api') return !hs.reached;
+  if (r.status === 'entrypoint-reachable') return !hs.reached && r.rootKind !== 'main';
+  return false;
+}
+function readsOutsideInput(fn, callee, args, importsNetwork) {
+  const h = args && args[0];
+  const isStdin = !!h && h.kind === 'ident' && /(?:^|\.)stdin$/.test(h.name || '');
+  const handleRead = /hGetContents$/.test(callee) && !isStdin;
+  // the networking packages are not all in the model registry, so a call keeps its bare name; the module imports say which library it is
+  if (handleRead) return !!importsNetwork && (fn.calls || []).some((x) => typeof x.callee === 'string' && NETWORK_HANDLE_CALL.test(x.callee));
+  const hs = fn.hs || {};
+  return callersUnknown(fn) && !/(?:^|\.)main$/.test(fn.name || '');
+}
+
+const EQUALITY_OPS = new Set(['==', '/=', '!=']);
+const VERIFY_CALL = /(?:^|\.)(?:constEq|secureCompare|verify\w*|authenticate\w*|checkPassword|validate\w*|hmac\w*|sign\w*|jwt\w*|encode(?:Signed)?)$/i;
+// Whole camelCase / snake_case words: `sig` must not match `design`, `mac` must not match `machine`.
+const CREDENTIAL_WORDS = new Set(['token', 'secret', 'nonce', 'otp', 'csrf', 'apikey', 'session', 'signature', 'sig', 'mac', 'hmac', 'credential', 'credentials', 'auth', 'cookie', 'passcode', 'cert', 'fingerprint']);
+const CREDENTIAL_NAME = { test: (name) => String(name).replace(/([a-z0-9])([A-Z])/g, '$1_$2').toLowerCase().split(/[^a-z0-9]+/).some((w) => CREDENTIAL_WORDS.has(w)) };
+
+/**
+ * Why a weak-hash call is a security matter: the list is empty when the digest is only an identifier or its use is not visible.
+ * Everything is read from the function's own IR (a value compared, bound to a credential-shaped name, hashing a secret-shaped value,
+ * handed to a signing or verifying call); nothing is read from comments or from the file's name.
+ */
+function weakDigestUse(fn, node, hashCall, hashArgs, fnBase) {
+  const reasons = [];
+  const nodes = Object.values(fn.cfg.nodes);
+  const exprsOf = (n) => [n.source, n.value, n.cond, ...(n.args || [])].filter(Boolean);
+  const hasNode = (x, target) => { for (const y of walk(x)) if (y === target) return true; return false; };
+  // 1. what is hashed
+  const hashed = (hashArgs || []).flatMap((a) => [...names(a)]).map((n) => n.replace(/^\./, ''));
+  if (hashed.some((n) => SENSITIVE.test(n) && !PASSWORD_VAR.test(n))) reasons.push('hashes a secret-shaped value');
+  // 2. values carrying the digest: the assignment target and everything derived from it
+  const carriers = new Set();
+  // the digest travels through formatting (`show`, `pack`, hex encoding, concatenation), not through an arbitrary call that merely receives it
+  const FORMAT = /(?:^|\.)(?:show|pack|unpack|take|drop|toLower|toUpper|showDigest|convertToBase|encode\w*|decode\w*|fromStrict|toStrict|toString|fromString|digestToHexByteString|toHex|hexlify|concat|append|map|fmap|fromText|toText)$/;
+  const flowsFrom = (e, depth = 0) => {
+    if (!e || depth > 10) return false;
+    if (e === hashCall) return true;
+    if (e.kind === 'ident') return carriers.has(e.name);
+    if (e.kind === 'binary' && e.hs && e.hs.concat) return flowsFrom(e.left, depth + 1) || flowsFrom(e.right, depth + 1);
+    if (e.kind === 'call' && typeof e.callee === 'string' && FORMAT.test(e.callee)) return (e.args || []).some((a) => flowsFrom(a, depth + 1));
+    if (e.kind === 'call' && e === hashCall) return true;
+    return false;
+  };
+  if (node.kind === 'assign' && node.target && node.source && flowsFrom(node.source)) carriers.add(node.target);
+  for (let round = 0; round < 8; round++) {
+    let grew = false;
+    for (const n of nodes) if (n.kind === 'assign' && n.target && n.source && !carriers.has(n.target) && flowsFrom(n.source)) { carriers.add(n.target); grew = true; }
+    if (!grew) break;
+  }
+  const carries = (x) => !!x && (flowsFrom(x) || [...names(x)].some((y) => carriers.has(y)));
+  let compared = false; let signed = false;
+  for (const n of nodes) {
+    for (const root of exprsOf(n)) {
+      for (const x of walk(root)) {
+        if (x.kind === 'binary' && EQUALITY_OPS.has(x.op) && (carries(x.left) || carries(x.right))) compared = true;
+        if (x.kind === 'call' && typeof x.callee === 'string' && VERIFY_CALL.test(x.callee) && (x.args || []).some((a) => carries(a))) signed = true;
+      }
+    }
+  }
+  if (compared) reasons.push('the digest is compared with another value');
+  if (signed) reasons.push('the digest is passed to a verifying or signing call');
+  // 3. what it becomes: a credential-shaped binding, or the result of a credential-shaped function
+  const bound = [...carriers].find((c) => CREDENTIAL_NAME.test(c) || SECURITY_VAR.test(c));
+  if (bound) reasons.push(`the digest is bound to \`${bound}\``);
+  const returned = nodes.some((n) => n.kind === 'return' && n.value && carries(n.value));
+  if (returned && (SECURITY_FN.test(fnBase) || CREDENTIAL_NAME.test(fnBase))) reasons.push(`the digest is the result of \`${fnBase}\``);
+  return reasons;
 }
 
 /**
@@ -159,7 +264,7 @@ export function analyzeHaskellRules(files, opts = {}) {
   const notes = [];
   if (!Object.keys(hs).length) return { findings, controls, notes };
 
-  const ir = buildHaskellIR(hs);
+  const ir = buildHaskellIR(hs, opts.reachability || {});
 
   // project-level facts
   let requestLimit = null;
@@ -186,6 +291,7 @@ export function analyzeHaskellRules(files, opts = {}) {
   };
 
   for (const [file, fir] of Object.entries(ir.perFile)) {
+    const importsNetwork = (fir.imports || []).some((im) => /^Network(?:\.|$)/.test(im.module));
     // imports of obsolete primitives (type-directed use is not resolved: disclosed on the finding)
     for (const imp of fir.imports || []) {
       if (WEAK_CIPHER_MODULES.has(imp.module)) {
@@ -199,7 +305,14 @@ export function analyzeHaskellRules(files, opts = {}) {
 
       const fnBase = fn.name.replace(/^.*\./, '');
       // text-typed parameters of an exported function, and every local value derived from them
-      const derivedText = new Set([...((fn.hs && fn.hs.textParams) || []), ...((fn.hs && fn.hs.inputParams) || [])]);
+      // A parameter a web framework hands to a handler IS request input wherever the handler is registered. Any other exported
+      // function's text parameter is "caller-supplied" only while nothing in the analysed code calls the function: once something does,
+      // its parameters take the values those callers pass (a check the taint engine makes per call), and a rule that does not follow
+      // calls cannot say the text comes from outside.
+      const fnHs = fn.hs || {};
+      const strongParam = new Set((fnHs.paramSources || []).filter((p) => /^hs:handler-param:/.test(p.decorator || '')).map((p) => p.name));
+      const entryLike = callersUnknown(fn);
+      const derivedText = new Set([...(fnHs.textParams || []).filter((n) => strongParam.has(n) || entryLike), ...(entryLike ? (fnHs.inputParams || []) : [])]);
       if (derivedText.size) {
         for (let round = 0; round < 8; round++) {
           let grew = false;
@@ -255,7 +368,7 @@ export function analyzeHaskellRules(files, opts = {}) {
               if (TIME_SOURCES.has(e.name) && SECURITY_FN.test(fnBase)) emitRandom(node.line, { vuln: 'Clock value used as a security value', detail: `${e.name} feeds \`${fnBase}\``, evidence: { function: fnBase, source: e.name } });
               // a generator named as the whole value of a security-shaped action (`newCsrfToken = randomIO`): no call is written, the name is the call
               if (RANDOM_CALLS.has(e.name) && SECURITY_FN.test(fnBase) && !(e.hs && e.hs.functionRef)) emitRandom(node.line, { detail: `${e.name} feeds \`${fnBase}\``, evidence: { function: fnBase, source: e.name } });
-              if (INPUT_READS.has(e.name) && !bounded) emit('hs-unbounded-input-read', file, node.line, { detail: `${e.name} reads everything`, confidence: 0.6 });
+              if (INPUT_READS.has(e.name) && !bounded && readsOutsideInput(fn, e.name, [], importsNetwork)) emit('hs-unbounded-input-read', file, node.line, { detail: `${e.name} reads everything`, confidence: 0.6 });
               continue;
             }
             // a Set-Cookie header written by hand: `(hSetCookie, "session_id=" <> sid <> "; Path=/")`
@@ -268,7 +381,8 @@ export function analyzeHaskellRules(files, opts = {}) {
                 const sessionLike = !nm || SESSION_COOKIE.test(nm[1]);
                 const secure = /;\s*Secure\b/i.test(text); const httpOnly = /;\s*HttpOnly\b/i.test(text);
                 // an attribute string that is not written here (a rendered cookie value) cannot be judged: only a cookie whose text is visible is
-                if (text && sessionLike && (!secure || !httpOnly)) emit('hs-insecure-cookie', file, e.line || node.line, { detail: `${!httpOnly ? 'HttpOnly missing' : ''}${!httpOnly && !secure ? ', ' : ''}${!secure ? 'Secure missing' : ''}`, evidence: { httpOnly, secure, cookie: nm ? nm[1] : null } });
+                // a header value that is entirely constant text (`authn=0` written to clear a login) carries no per-user credential
+                if (text && sessionLike && !isLiteralLike(v) && !constantConcat(v) && (!secure || !httpOnly)) emit('hs-insecure-cookie', file, e.line || node.line, { detail: `${!httpOnly ? 'HttpOnly missing' : ''}${!httpOnly && !secure ? ', ' : ''}${!secure ? 'Secure missing' : ''}`, evidence: { httpOnly, secure, cookie: nm ? nm[1] : null } });
               }
             }
             if (e.kind === 'object' && e.hs && e.hs.update && Array.isArray(e.props)) {
@@ -324,7 +438,17 @@ export function analyzeHaskellRules(files, opts = {}) {
             // weak hash
             if (WEAK_HASH_CALLS.has(c) || (c === 'Crypto.Hash.hashWith' && args[0] && args[0].kind === 'literal' && WEAK_ALGO_CONS.has(args[0].value))) {
               const pw = args.some((a) => [...names(a)].some((n) => PASSWORD_VAR.test(n)));
-              if (!pw) emit('hs-weak-hash', file, line, { detail: c });
+              // MD5 and SHA-1 are broken for collision and preimage resistance, which only matters where an attacker gains from a
+              // collision: a digest that is VERIFIED (compared with an expected value), that authenticates or signs, that hashes a
+              // secret, or that is a credential. A digest that only NAMES something (a file name, a cache key, a bookmark, an ETag) is
+              // an identifier, and a hash helper handed on to callers says nothing about its use: neither is a finding.
+              if (!pw) {
+                const use = weakDigestUse(fn, node, e, args, fnBase);
+                // The API identity is always reported (a reviewer wants to know where MD5/SHA-1 is computed); it is a vulnerability
+                // finding only where a use that depends on the hash's strength is visible. Otherwise it is an `info` note.
+                if (use.length) emit('hs-weak-hash', file, line, { detail: `${c}: ${use.join('; ')}`, evidence: { call: c, use } });
+                else emit('hs-weak-hash', file, line, { severity: 'info', confidence: 0.4, detail: `${c}: no use that depends on the digest's collision or preimage resistance is visible (it may only name or key something)`, evidence: { call: c, use: [] } });
+              }
             }
             // password hashed with a fast hash
             if (ANY_HASH_CALLS.has(c) && !STRONG_KDF.test(c) && args.some((a) => [...names(a)].some((n) => PASSWORD_VAR.test(n.replace(/^\./, ''))))) {
@@ -346,7 +470,7 @@ export function analyzeHaskellRules(files, opts = {}) {
               emitRandom(line, { detail: `${c} feeds \`${fnBase}\``, evidence: { function: fnBase, source: c } });
             }
             if (TIME_SOURCES.has(c) && SECURITY_FN.test(fnBase)) emitRandom(line, { vuln: 'Clock value used as a security value', detail: `${c} feeds \`${fnBase}\``, evidence: { function: fnBase, source: c } });
-            if (INPUT_READS.has(c) && !bounded) emit('hs-unbounded-input-read', file, line, { detail: `${c} reads everything`, confidence: 0.6 });
+            if (INPUT_READS.has(c) && !bounded && readsOutsideInput(fn, c, args, importsNetwork)) emit('hs-unbounded-input-read', file, line, { detail: `${c} reads everything`, confidence: 0.6 });
             // an allocation whose size is parsed caller text and is not clamped
             if (ALLOCATORS.has(c) && args[0] && mentionsText(args[0]) && callsIn(args[0]).some((x) => /(?:^|\.)(?:read|readMaybe|readEither)$/.test(x.callee)) && !callsIn(args[0]).some((x) => CLAMPS.test(x.callee))) {
               emit('hs-unbounded-allocation', file, line, { detail: `${c} sized by parsed caller text`, evidence: { allocator: c } });
@@ -369,7 +493,7 @@ export function analyzeHaskellRules(files, opts = {}) {
               if (yes) emit('hs-xml-entity-substitution', file, line, { detail: 'withSubstDTDEntities yes' });
             }
             // boundaries
-            if (UNSAFE_CALLS[c]) {
+            if (Object.hasOwn(UNSAFE_CALLS, c)) {
               const b = UNSAFE_CALLS[c];
               emit('hs-unsafe-io-boundary', file, line, { vuln: `Unsafe boundary: ${b}`, confidence: 0.5, modelNote: BOUNDARIES[b], detail: BOUNDARIES[b] });
             }

package/src/language/haskell-syntax.js

@@ -840,7 +840,8 @@ export function parseSyntax(src, opts = {}) {
           // `foreign import ccall unsafe "string.h strlen" c_strlen :: ...` names the Haskell-side function.
           let fname = null;
           for (let q = a; q < b; q++) if (isRop(T[q], '::')) { if (q > a && T[q - 1].t === 'var') fname = T[q - 1].v; break; }
-          res.boundaries.push({ kind: 'ffi', line: t0.line, detail: 'foreign declaration; the foreign code is not analyzed', ...(fname ? { name: fname } : {}) });
+          const dir = T[a + 1] && (T[a + 1].v === 'import' || T[a + 1].v === 'export') ? T[a + 1].v : null;
+          res.boundaries.push({ kind: 'ffi', line: t0.line, detail: 'foreign declaration; the foreign code is not analyzed', ...(dir ? { direction: dir } : {}), ...(fname ? { name: fname } : {}) });
           continue;
         }
         if (t0.v === 'class' || t0.v === 'instance') {