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

package/src/language/haskell-comments.js

@@ -0,0 +1,65 @@
+// Haskell comments, found lexically. Used so that text a finding carries from the source (its snippet, and through it the identity and the
+// clone-shape of the finding) is the CODE of the line and never a comment on it: a verdict, an id and a cluster must not change because someone
+// edited, or lied in, a comment. Strings, character literals and pragmas are not comments; a run of dashes inside an operator (`-->`, `|--`) is
+// not a comment; block comments nest.
+
+const SYMBOL = new Set([...'!#$%&*+./<=>?@\\^|~:-']);
+const IDENT = /[A-Za-z0-9_']/;
+
+/** The comments of a Haskell source: [{start, end, kind}] with `end` exclusive. */
+export function findComments(src) {
+  const out = [];
+  const n = src.length;
+  let i = 0;
+  while (i < n) {
+    const c = src[i];
+    if (c === '"') {   // string literal
+      i++;
+      while (i < n && src[i] !== '"') { if (src[i] === '\\') i++; i++; }
+      i++;
+      continue;
+    }
+    if (c === "'" && !(i > 0 && IDENT.test(src[i - 1]))) {   // character literal (a prime after an identifier character is part of the name)
+      const m = /^'(?:\\(?:[^']|x[0-9A-Fa-f]+|[0-9]+|[A-Z]+)|[^'\\])'/.exec(src.slice(i, i + 12));
+      if (m) { i += m[0].length; continue; }
+    }
+    if (c === '{' && src[i + 1] === '-' && src[i + 2] !== '#') {
+      let depth = 1; const start = i; i += 2;
+      while (i < n && depth > 0) {
+        if (src[i] === '{' && src[i + 1] === '-') { depth++; i += 2; } else if (src[i] === '-' && src[i + 1] === '}') { depth--; i += 2; } else i++;
+      }
+      out.push({ start, end: i, kind: 'block' });
+      continue;
+    }
+    if (c === '-' && src[i + 1] === '-') {
+      let j = i; while (j < n && src[j] === '-') j++;
+      const prevSym = i > 0 && SYMBOL.has(src[i - 1]) && src[i - 1] !== '-';
+      const nextSym = j < n && SYMBOL.has(src[j]);
+      if (!prevSym && !nextSym) {
+        let e = j; while (e < n && src[e] !== '\n') e++;
+        out.push({ start: i, end: e, kind: 'line' });
+        i = e;
+        continue;
+      }
+      i = j;
+      continue;
+    }
+    i++;
+  }
+  return out;
+}
+
+const blank = (text) => text.replace(/[^\n]/g, ' ');
+
+/** The source with every comment overwritten by spaces: same length, same line breaks, so locations do not move. */
+export function stripComments(src) {
+  let out = ''; let at = 0;
+  for (const c of findComments(src)) { out += src.slice(at, c.start) + blank(src.slice(c.start, c.end)); at = c.end; }
+  return out + src.slice(at);
+}
+
+/** One source line without its comments, trimmed. A block comment that opened on an earlier line is not known here; a line that is only a comment becomes ''. */
+export function codeOfLine(line) {
+  if (typeof line !== 'string') return '';
+  return stripComments(line).trim();
+}

package/src/language/haskell-findings.js

@@ -4,6 +4,7 @@
 // finding is distinguishable, filterable and compliance-mappable without a second finding schema.
 
 import { HS_MODEL_VERSION } from './haskell-models.js';
+import { codeOfLine } from './haskell-comments.js';
 
 const HS_FILE = /\.(?:hs|lhs|hsc)$/i;
 
@@ -32,7 +33,7 @@ export function annotateHaskellFindings(findings, fileContents = null) {
     if (!f || !isHaskellFile(f.file)) continue;
     if (!f.snippet && fileContents && typeof fileContents[f.file] === 'string' && Number.isInteger(f.line) && f.line >= 1) {
       const text = fileContents[f.file].split('\n')[f.line - 1];
-      if (typeof text === 'string') f.snippet = text.trim().slice(0, 240);
+      if (typeof text === 'string') f.snippet = codeOfLine(text).slice(0, 240);
     }
     f.language = 'haskell';
     f.capability = f.capability || 'taint';

package/src/language/haskell-fix.js

@@ -124,7 +124,19 @@ function findCall(lineText, names) {
   return m ? { prefix: m[1], name: m[2], index: m.index, after: m.index + m[0].length } : null;
 }
 
+// The database driver whose `execute`/`query`/`Only` the rewrite uses is the one the FILE already imports: a hard-coded driver would add an
+// import of a library the project may not depend on, and a patch that compiles against nothing is not a fix. Only the two drivers whose
+// `execute_`/`query_`/`execute`/`query`/`Only` API is identical are rewritten; any other (mysql-simple, HDBC, persistent) or two at once is refused.
+const SQL_DRIVERS = Object.freeze(['Database.PostgreSQL.Simple', 'Database.SQLite.Simple']);
+const OTHER_SQL = /^import\s+(?:qualified\s+)?Database\.(?:MySQL|HDBC|Persist|Beam|Opaleye|Selda|Esqueleto|SQLite3|PostgreSQL\.LibPQ)/m;
+export function sqlDriverOf(text) {
+  const used = SQL_DRIVERS.filter((m) => importInfo(text, m));
+  return used.length === 1 && !OTHER_SQL.test(text) ? used[0] : null;
+}
+
 function fixSql(text, f) {
+  const driver = sqlDriverOf(text);
+  if (!driver) return null;
   const lb = lineBounds(text, f.line);
   const call = findCall(lb.text, ['execute_', 'query_']);
   if (!call) return null;
@@ -144,7 +156,7 @@ function fixSql(text, f) {
     if (q) { sql = sql.slice(0, -1); parts[i + 1] = { lit: after.lit.slice(1) }; }
     sql += '?'; params.push(p.var);
   }
-  const imp = ensureImport(text, 'Database.PostgreSQL.Simple', ['execute', 'query', 'Only']);
+  const imp = ensureImport(text, driver, ['execute', 'query', 'Only']);
   if (!imp) return null;
   const only = `${call.prefix || imp.prefix}Only`;
   const tuple = params.length === 1 ? `(${only} ${params[0]})` : `(${params.join(', ')})`;
@@ -214,6 +226,9 @@ function fixProcess(text, f) {
 }
 
 function fixHtml(text, f) {
+  // `preEscapedToHtml` and `toHtml` are blaze-html's pair (Yesod and the shakespeare packages re-export them); another library's raw-markup call has a
+  // different name and a different escaping function, so a file that does not import blaze or one of its re-exporters is not rewritten.
+  if (!/^import\s+(?:qualified\s+)?(?:Text\.Blaze|Yesod|Text\.Hamlet)/m.test(text)) return null;
   const lb = lineBounds(text, f.line);
   const m = /(?<![\w'.])((?:[A-Z][\w']*\.)?)preEscapedToHtml(?![\w'])/.exec(lb.text);
   if (!m) return null;
@@ -227,12 +242,98 @@ function fixWeakHash(text, f) {
   const lb = lineBounds(text, f.line);
   const re = /(?<![\w'.])(MD5|SHA1)(?![\w'.])/g;
   if (!re.test(lb.text)) return null;
+  // The algorithm is often a TYPE as well (`Digest MD5` in a signature, an annotation on another line): replacing it on one line only leaves a
+  // type error behind. Any other mention outside the import list means the rewrite is not provably the same program, so it is not made.
+  const elsewhere = text.split('\n').some((l, i) => i !== f.line - 1 && !/^import\s/.test(l) && /(?<![\w'.])(MD5|SHA1)(?![\w'.])/.test(l));
+  if (elsewhere) return null;
   const imp = ensureImport(text, 'Crypto.Hash', ['SHA256(..)']); if (!imp) return null;
   const repl = lb.text.replace(/(?<![\w'.])(MD5|SHA1)(?![\w'.])/g, 'SHA256');
   const next = applyImportDelta(text, imp.text, splice(text, lb.start, lb.end, repl));
   return { ruleId: 'hs-hash-sha256', label: 'FULL', text: next, explanation: 'MD5/SHA-1 replaced by SHA-256. Digests change: anything that stored or compares old digests must be migrated.', behavior: { kind: 'hash', from: ['MD5', 'SHA1'], to: 'SHA256' } };
 }
 
+
+// ── path traversal ───────────────────────────────────────────────────────────
+// `readFile ("/srv/data/" ++ name)` -> `readFile ("/srv/data/" ++ takeFileName name)` when `name` is a String/FilePath PARAMETER of the enclosing function.
+// The rewrite is a mitigation, not an equivalence: a name that carried directories now keeps only its last segment, and `.` / `..` survive
+// `takeFileName`, which is why directory operations are not rewritten (only operations on a file). Every other shape is a proposal.
+const PATH_FILE_OPS = ['readFile', 'writeFile', 'appendFile', 'removeFile', 'doesFileExist', 'openFile', 'withFile', 'openBinaryFile', 'withBinaryFile', 'getFileSize', 'getModificationTime'];
+
+/** Splits `a ++ b </> c` at its top-level `++` / `<>` / `</>` operators, keeping the operator text: [part, op, part, ...] or null. */
+function splitOperators(expr) {
+  const out = []; let depth = 0; let start = 0;
+  for (let i = 0; i < expr.length; i++) {
+    const c = expr[i];
+    if (c === '"') { const e = atomEnd(expr, i); if (e < 0) return null; i = e - 1; continue; }
+    if (c === '(' || c === '[') depth++;
+    else if (c === ')' || c === ']') depth--;
+    else if (depth === 0) {
+      const m = /^\s*(\+\+|<>|<\/>)\s*/.exec(expr.slice(i));
+      if (m && (i === start || /\s/.test(expr[i]) || true)) { out.push(expr.slice(start, i), m[0]); i += m[0].length - 1; start = i + 1; }
+    }
+  }
+  out.push(expr.slice(start));
+  return out;
+}
+
+/** The declared types of the parameters of the top-level function containing `line`: { name -> type text }, from its signature and first clause. */
+function paramTypesAt(text, line) {
+  const lines = text.split('\n');
+  let clause = -1;
+  for (let i = Math.min(line - 1, lines.length - 1); i >= 0; i--) if (/^[a-z_][\w']*\b[^:\n]*=/.test(lines[i]) && !/^[a-z_][\w']*\s*::/.test(lines[i])) { clause = i; break; }
+  if (clause < 0) return null;
+  const m = /^([a-z_][\w']*)([^=]*)=/.exec(lines[clause]);
+  if (!m) return null;
+  const name = m[1]; const params = m[2].trim() ? m[2].trim().split(/\s+/) : [];
+  if (params.some((p) => !/^[a-z_][\w']*$/.test(p))) return null;      // a pattern, not a plain name: not judged
+  const sigLine = lines.findIndex((l) => new RegExp(`^${name}\\s*::`).test(l));
+  if (sigLine < 0) return null;
+  let sig = lines[sigLine].replace(/^[^:]*::/, '');
+  for (let j = sigLine + 1; j < lines.length && /^\s+\S/.test(lines[j]) && !/^[a-z_][\w']*\s*(::|=)/.test(lines[j]); j++) sig += ` ${lines[j].trim()}`;
+  sig = sig.replace(/^.*=>/, '');
+  const types = []; let depth = 0; let cur = '';
+  for (let i = 0; i < sig.length; i++) {
+    const c = sig[i];
+    if (c === '(' || c === '[') depth++; else if (c === ')' || c === ']') depth--;
+    if (depth === 0 && sig.startsWith('->', i)) { types.push(cur.trim()); cur = ''; i++; continue; }
+    cur += c;
+  }
+  types.push(cur.trim());
+  const out = {};
+  params.forEach((p, i) => { if (types[i] !== undefined) out[p] = types[i]; });
+  return out;
+}
+
+function fixPath(text, f) {
+  const lb = lineBounds(text, f.line);
+  const call = findCall(lb.text, PATH_FILE_OPS);
+  if (!call) return null;
+  let aStart = call.after; while (lb.text[aStart] === ' ') aStart++;
+  let aEnd;
+  if (lb.text[aStart] === '$') { aStart++; while (lb.text[aStart] === ' ') aStart++; aEnd = lb.text.length; }
+  else aEnd = atomEnd(lb.text, aStart);
+  if (aEnd < 0) return null;
+  const arg = lb.text.slice(aStart, aEnd);
+  const inner = trimParens(arg);
+  const parts = splitOperators(inner);
+  if (!parts || parts.length < 3) return null;
+  const operands = parts.filter((_, i) => i % 2 === 0).map((x) => trimParens(x));
+  if (!operands.some((o) => STRING.test(o))) return null;                       // no fixed part: a pass-through, not a construction
+  const vars = operands.filter((o) => !STRING.test(o));
+  if (!vars.length || vars.some((v) => !IDENT.test(v))) return null;
+  const types = paramTypesAt(text, f.line);
+  if (!types || vars.some((v) => !/^(?:String|FilePath)$/.test(types[v] || ''))) return null;   // takeFileName takes a String: any other type would not compile
+  if (new RegExp(`(?<![\\w'.])takeFileName\\s+(?:${vars.join('|')})(?![\\w'])`).test(lb.text)) return null;
+  const imp = ensureImport(text, 'System.FilePath', ['takeFileName']); if (!imp) return null;
+  const fn = `${imp.prefix}takeFileName`;
+  let rebuilt = '';
+  parts.forEach((part, i) => { rebuilt += i % 2 === 1 ? part : (vars.includes(trimParens(part)) ? part.replace(trimParens(part), `${fn} ${trimParens(part)}`) : part); });
+  const wrapped = arg.startsWith('(') && atomEnd(arg, 0) === arg.length ? `(${rebuilt})` : rebuilt;
+  const replaced = lb.text.slice(0, aStart) + wrapped + lb.text.slice(aEnd);
+  const next = applyImportDelta(text, imp.text, splice(text, lb.start, lb.end, replaced));
+  return { ruleId: 'hs-path-takefilename', label: 'MITIGATION', text: next, explanation: `Applied takeFileName to ${vars.join(', ')} so only its last path segment is used under the fixed directory. A value that carried subdirectories now names a file directly inside it; "." and ".." survive takeFileName, so this is not applied to directory operations.`, behavior: { kind: 'path', sanitizer: 'takeFileName', vars } };
+}
+
 const LOG_CALLS = ['putStrLn', 'putStr', 'hPutStrLn', 'hPutStr', 'print', 'trace', 'traceShow', 'traceShowId', 'logInfoN', 'logDebugN', 'logWarnN', 'logErrorN', 'logInfo', 'logDebug', 'logWarn', 'logError'];
 function fixLogging(text, f) {
   const lb = lineBounds(text, f.line);
@@ -256,6 +357,7 @@ const FIXERS = [
   { id: 'hs-html-escape', applies: (f) => f.cwe === 'CWE-79', run: fixHtml },
   { id: 'hs-hash-sha256', applies: (f) => f.cwe === 'CWE-328' || f.rule === 'hs-weak-hash', run: fixWeakHash },
   { id: 'hs-log-redact', applies: (f) => f.cwe === 'CWE-532' || f.rule === 'hs-sensitive-logging', run: fixLogging },
+  { id: 'hs-path-takefilename', applies: (f) => f.cwe === 'CWE-22', run: fixPath },
 ];
 export const SUPPORTED_FIX_IDS = Object.freeze(FIXERS.map((x) => x.id));
 
@@ -300,9 +402,23 @@ export function planHaskellFix(finding, files) {
       if (r && r.text && r.text !== before) return { ok: true, ruleId: r.ruleId, label: r.label, file: finding.file, before, after: r.text, explanation: r.explanation, behavior: r.behavior, ...(line !== finding.line ? { fixedAtLine: line } : {}) };
     }
   }
-  return { ok: false, reason: 'no deterministic fix is supported for this exact shape', proposal: 'model-assisted' };
+  return { ok: false, reason: CLASS_REASONS[finding.cwe] || 'no deterministic fix is supported for this exact shape', proposal: 'model-assisted' };
 }
 
+// Classes whose repair needs a choice the code does not contain (a policy, a library, a limit). The scanner reports them; it does not guess.
+const CLASS_REASONS = Object.freeze({
+  'CWE-918': 'server-side request forgery is fixed by an allow-list of hosts or a resolved-address policy, which is a decision about this service, not a rewrite of this line',
+  'CWE-88': 'argument injection is fixed by validating the value against what the program accepts; inserting "--" only helps programs that honour it, so no patch is made',
+  'CWE-916': 'password hashing needs a memory-hard or iterated KDF (Argon2id, scrypt, bcrypt, PBKDF2) from a library the project may not depend on, and existing stored hashes must be migrated',
+  'CWE-338': 'a predictable generator is replaced by the operating system CSPRNG (Crypto.Random), whose result type differs from System.Random: the surrounding code must change with it',
+  'CWE-1004': 'cookie attributes live in different places for each framework (a record field, a header string, a helper); the rewrite is not provably the same program',
+  'CWE-306': 'a missing authentication check needs a policy (which credential, which rejection); the scanner reports the handler and does not invent the guard',
+  'CWE-770': 'a resource limit is a number only the operator can choose (how many bytes, how many requests)',
+  'CWE-295': 'enabling certificate validation can break connections the project depends on; the trust store to use is a deployment decision',
+  'CWE-798': 'a hard-coded secret must be rotated and moved to a secret store; rewriting the line would leave the leaked value valid',
+  'CWE-611': 'XML entity handling depends on the parser configuration in use',
+});
+
 // ── gates ────────────────────────────────────────────────────────────────────
 const key = (f) => `${f.file}|${f.cwe || ""}`;
 

package/src/language/haskell-guards.js

@@ -30,7 +30,7 @@ const FAMILY_BY_CWE = { 'CWE-22': 'path', 'CWE-918': 'url', 'CWE-78': 'cmd', 'CW
 
 const isStr = (e) => e && e.kind === 'literal' && typeof e.value === 'string';
 
-function identNames(e, out = new Set(), depth = 0) {
+export function identNames(e, out = new Set(), depth = 0) {
   if (!e || typeof e !== 'object' || depth > 30) return out;
   if (e.kind === 'ident' && e.name && !(e.hs && e.hs.functionRef)) out.add(e.name);
   for (const k of ['left', 'right', 'object', 'value', 'callee']) if (e[k] && typeof e[k] === 'object') identNames(e[k], out, depth + 1);
@@ -118,7 +118,7 @@ const exprChildren = (e) => {
 };
 
 // Find the sink call at `line` with callee `callee`; returns [{ nodeId, facts, call }].
-function findSites(fn, callee, line) {
+export function findSites(fn, callee, line) {
   const sites = [];
   const visit = (e, nodeId, facts, depth) => {
     if (!e || typeof e !== 'object' || depth > 60) return;

package/src/language/haskell-ir.js

@@ -264,6 +264,7 @@ function resolveGlobalUncached(proj, mod, name, qual, depth, seen) {
   const hits = [];
   const wildcard = [];
   let unknownReason = null;
+  let unknownCandidates = null;
   for (const imp of visibleImports(mod, name, qual)) {
     const target = proj.modules.get(imp.module);
     if (target) {
@@ -274,7 +275,7 @@ function resolveGlobalUncached(proj, mod, name, qual, depth, seen) {
         const owner = r.kind === 'def' ? (r.def.kind === 'field' ? (proj.modules.get(r.mod)?.cons.get(r.def.con)?.type) : r.def.kind === 'method' ? r.def.cls : null) : null;
         if (!owner || !(imp.typeAll || []).includes(owner)) continue;
       }
-      if (r.kind === 'unknown') unknownReason = r.reason; else hits.push(r);
+      if (r.kind === 'unknown') { unknownReason = r.reason; if (r.candidates) unknownCandidates = r.candidates; } else hits.push(r);
     } else if (qual || (imp.items && !imp.hiding && imp.items.includes(name))) hits.push({ kind: 'external', module: imp.module, name, certain: true });
     else wildcard.push(imp.module);   // includes `import M (T(..))` of a module we cannot read: possible, never certain
   }
@@ -282,7 +283,7 @@ function resolveGlobalUncached(proj, mod, name, qual, depth, seen) {
   const distinct = [...new Map(hits.map((r) => [keyOf(r), r])).values()];
   if (distinct.length === 1) return distinct[0];
   if (distinct.length > 1) return { kind: 'unknown', reason: 'ambiguous-import', candidates: distinct.map(keyOf) };
-  if (unknownReason) return { kind: 'unknown', reason: unknownReason };
+  if (unknownReason) return unknownCandidates ? { kind: 'unknown', reason: unknownReason, candidates: unknownCandidates } : { kind: 'unknown', reason: unknownReason };
   if (!qual && PRELUDE.has(name)) return { kind: 'builtin', module: 'Prelude', name };
   if (wildcard.length) return { kind: 'external', module: wildcard.length === 1 ? wildcard[0] : null, candidates: wildcard, name, certain: false };
   return { kind: 'unknown', reason: qual ? 'unknown-qualifier' : 'unbound-name' };
@@ -584,6 +585,7 @@ class FnLowerer {
       return { kind: 'ident', name: this.canonical(r), hs: { functionRef: r.qid } };
     }
     if (r.kind === 'param' || r.kind === 'local') return { kind: 'ident', name: e.name };
+    if (r.kind === 'unknown' && r.reason === 'ambiguous-import') for (const q of r.candidates || []) this.noteRef(q, 'ambiguous-import', ln);
     const lib = libraryName(r, e.name, e.qual);
     const viaReg = lib.viaRegistry ? { viaRegistry: true, certain: false } : {};
     // A modelled SOURCE action named as a value (`getLine >>= f`, `fmap g getLine`) yields untrusted data
@@ -725,6 +727,10 @@ class FnLowerer {
       if (IO_NAMES.has(f.name)) this.sawIO = true;
     } else {
       hs.status = 'unknown'; hs.reason = r.reason || 'unresolved'; hs.effect = 'unknown';
+      // An import that two modules both satisfy (the Posix and Windows variants of one module behind a CPP conditional, two re-exports of
+      // one name) is a call to ONE of them, which one is not decided here. Each candidate is referenced, so none of them reads as a
+      // function nothing in the project uses.
+      if (r.reason === 'ambiguous-import') for (const q of r.candidates || []) this.noteRef(q, 'ambiguous-import', ln);
     }
     if (hs.status === 'resolved' || hs.status === 'typeclass') {
       const ctxTargets = args.map((a) => argTargets(a));
@@ -1335,6 +1341,7 @@ function lowerTopFunction(proj, mod, fun, def) {
   const ann = callerControlledParams(fn, sig, exported, mod.imports.map((i) => i.module));
   for (const a of servantEndpointParams(mod, fn, sig, exported)) if (!ann.some((x) => x.name === a.name)) ann.push(a);
   fn.hs.textParams = ann.map((a) => a.name);
+  fn.hs.paramSources = ann.map((a) => ({ name: a.name, decorator: a.decorator }));
   fn.hs.inputParams = inputParams(fn, sig, exported);
   // Parameters of an exported function whose type is a record DECLARED IN THE PROJECT: the lineage view treats each such
   // parameter as a source of that record's fields (a customer record handed to an entry point), field by field.
@@ -1454,7 +1461,13 @@ function buildHaskellIRUncached(fileContents) {
   const reached = new Set();
   for (const e of callGraph.edges || []) if (e && e.callee) reached.add(e.callee);
   for (const fn of callGraph.functions.values()) for (const r of (fn.hs && fn.hs.refs) || []) if (r && r.target) reached.add(r.target);
-  for (const fn of callGraph.functions.values()) if (reached.has(fn.qid)) { if (fn.paramAnnotations) delete fn.paramAnnotations; if (fn.hs && fn.hs.recordParams) fn.hs.recordParams = []; }
+  assignEntryRoles(proj, callGraph);
+  for (const fn of callGraph.functions.values()) {
+    // `reached`: something in the analysed code calls or references this function, so its parameters take their values from THOSE callers
+    // (which the taint engine follows) and not from an unknown outside one. Rules that reason about "caller-supplied" text read it.
+    if (fn.hs) fn.hs.reached = reached.has(fn.qid);
+    if (reached.has(fn.qid)) { if (fn.paramAnnotations) delete fn.paramAnnotations; if (fn.hs && fn.hs.recordParams) fn.hs.recordParams = []; }
+  }
   return { perFile, callGraph, modules: proj.modules, diagnostics: proj.diagnostics, project: proj };
 }
 
@@ -1468,6 +1481,36 @@ function incomplete(proj, mod, f, err) {
   proj.diagnostics.push({ file: mod.file, line: f.line, kind: 'ir-lowering-failure', detail: String(err && err.message) });
 }
 
+// ── entry roles ──────────────────────────────────────────────────────────────
+// Who is on the other end of the program's inputs depends on what kind of program the function belongs to. A function reachable from a
+// `main` whose reachable modules import no server framework or socket library belongs to a command-line program: whoever runs it supplies its
+// arguments, environment, standard input and the files it is pointed at. One reachable from a `main` that imports a server framework (a WAI,
+// Scotty, Servant, Yesod, Snap, Happstack or Spock application, a socket listener) belongs to a service, whose inputs come from its clients.
+// A function no `main` reaches is `library`: its callers are unknown. The call graph is incomplete (an unresolved call ends a path), so a
+// function the walk does not reach is `library`, never `cli`.
+const SERVER_IMPORT = /^(?:Network\.Wai|Web\.Scotty|Servant|Yesod|Snap|Happstack\.Server|Web\.Spock)(?:\.|$)|^Network\.(?:Socket|Simple\.TCP|Run\.TCP|HTTP\.Server)$/;
+export function assignEntryRoles(proj, callGraph) {
+  const out = new Map();
+  for (const e of callGraph.edges || []) if (e && e.callee && e.caller) { if (!out.has(e.caller)) out.set(e.caller, []); out.get(e.caller).push(e.callee); }
+  const mains = [];
+  for (const fn of callGraph.functions.values()) if (fn.hs && fn.hs.module && fn.name === `${fn.hs.module}.main`) mains.push(fn);
+  const cli = new Set(); const service = new Set();
+  for (const m of mains) {
+    const seen = new Set([m.qid]);
+    const todo = [m.qid];
+    while (todo.length) { const q = todo.pop(); for (const c of out.get(q) || []) if (!seen.has(c)) { seen.add(c); todo.push(c); } }
+    const mods = new Set();
+    for (const q of seen) { const f = callGraph.functions.get(q); if (f && f.hs && f.hs.module) mods.add(f.hs.module); }
+    let isService = false;
+    for (const name of mods) { const mi = proj.modules.get(name); if (mi && (mi.imports || []).some((i) => SERVER_IMPORT.test(i.module))) { isService = true; break; } }
+    for (const q of seen) (isService ? service : cli).add(q);
+  }
+  for (const fn of callGraph.functions.values()) {
+    if (!fn.hs) continue;
+    fn.hs.entryRole = service.has(fn.qid) ? 'service' : (cli.has(fn.qid) ? 'cli' : 'library');
+  }
+}
+
 // ── call graph ───────────────────────────────────────────────────────────────
 function buildHaskellCallGraph(perFile, proj) {
   const functions = new Map();

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' });