@clear-capabilities/agentic-security-scanner 0.195.7 → 0.195.9

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

@@ -14,7 +14,7 @@
 // Nothing here executes code, evaluates a type, or reads a path outside the files it is handed.
 
 import { buildHaskellIR } from './haskell-ir.js';
-import { HS_LOG_SINKS, HS_MODEL_VERSION } from './haskell-models.js';
+import { HS_LOG_SINKS, HS_MODEL_VERSION, sourceInfo } from './haskell-models.js';
 import { codeOfLine } from './haskell-comments.js';
 
 export const HS_RULES_VERSION = 'haskell-security-rules/1';
@@ -53,7 +53,11 @@ const ANY_HASH_CALLS = new Set([...WEAK_HASH_CALLS, 'Crypto.Hash.hash', 'Crypto.
 const WEAK_CIPHER_MODULES = new Set(['Crypto.Cipher.DES', 'Crypto.Cipher.RC4', 'Crypto.Cipher.RC2', 'Crypto.Cipher.Blowfish']);
 const ECB_CALLS = new Set(['Crypto.Cipher.Types.ecbEncrypt', 'Crypto.Cipher.Types.ecbDecrypt']);
 const IV_CALLS = new Set(['Crypto.Cipher.Types.makeIV', 'Crypto.Cipher.ChaChaPoly1305.nonce12', 'Crypto.Cipher.ChaChaPoly1305.nonce8']);
-const RANDOM_CALLS = new Set(['System.Random.randomRIO', 'System.Random.randomIO', 'System.Random.newStdGen', 'System.Random.getStdGen', 'System.Random.mkStdGen', 'System.Random.randomR', 'System.Random.random', 'System.Random.randoms', 'System.Random.randomRs', 'System.Random.getStdRandom', 'System.Random.uniformR', 'System.Random.uniform', 'System.Random.initStdGen']);
+const RANDOM_CALLS = new Set(['System.Random.randomRIO', 'System.Random.randomIO', 'System.Random.newStdGen', 'System.Random.getStdGen', 'System.Random.mkStdGen', 'System.Random.randomR', 'System.Random.random', 'System.Random.randoms', 'System.Random.randomRs', 'System.Random.getStdRandom', 'System.Random.uniformR', 'System.Random.uniform', 'System.Random.initStdGen',
+  // mwc-random is a statistical generator (multiply-with-carry); `createSystemRandom` only seeds it from the OS, its output is not a CSPRNG
+  'System.Random.MWC.uniformR', 'System.Random.MWC.uniform', 'System.Random.MWC.uniformRM', 'System.Random.MWC.uniformM', 'System.Random.MWC.createSystemRandom', 'System.Random.MWC.create', 'System.Random.MWC.initialize', 'System.Random.MWC.withSystemRandom', 'System.Random.MWC.withSystemRandomST',
+  // splitmix is the pure generator behind random
+  'System.Random.SplitMix.nextWord64', 'System.Random.SplitMix.nextInt', 'System.Random.SplitMix.nextDouble', 'System.Random.SplitMix.mkSMGen', 'System.Random.SplitMix.newSMGen', 'System.Random.SplitMix.initSMGen']);
 const BODY_CALLS = new Set(['Network.Wai.strictRequestBody', 'Network.Wai.lazyRequestBody', 'Web.Scotty.body', 'Web.Scotty.Trans.body', 'Network.Wai.Conduit.sourceRequestBody']);
 const SOCKET_READS = new Set(['Network.Socket.ByteString.recv', 'Network.Socket.ByteString.recvFrom', 'Network.Socket.ByteString.Lazy.recv']);
 const SET_COOKIE_HEADER = new Set(['Network.HTTP.Types.Header.hSetCookie', 'Network.HTTP.Types.hSetCookie']);
@@ -71,12 +75,18 @@ const isTrueLit = (e) => !!e && ((e.kind === 'literal' && /^true$/i.test(String(
 const TIME_SOURCES = new Set(['Data.Time.Clock.POSIX.getPOSIXTime', 'Data.Time.Clock.getCurrentTime', 'System.CPUTime.getCPUTime']);
 // 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;
+// (`newKey`, `generateApiKey`, `mkKey`: a function that MAKES a key is security-shaped; `key` alone is not, it names map keys too)
+const SECURITY_FN_SUBSTR = /(?:token|nonce|secret|otp|csrf|session|apikey|resetcode|passcode|verification|(?:new|gen|generate|make|mk|create|issue|mint|fresh)_?(?:api_?)?key)/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)) };
 const INPUT_READS = new Set(['Prelude.getContents', 'System.IO.getContents', 'System.IO.hGetContents', 'Data.ByteString.getContents', 'Data.ByteString.hGetContents', 'Data.ByteString.Char8.getContents', 'Data.ByteString.Char8.hGetContents', 'Data.ByteString.Lazy.getContents', 'Data.ByteString.Lazy.hGetContents', 'Data.ByteString.Lazy.Char8.getContents', 'Data.ByteString.Lazy.Char8.hGetContents', 'Data.Text.IO.getContents', 'Data.Text.IO.hGetContents', 'Data.Text.Lazy.IO.getContents', 'Data.Text.Lazy.IO.hGetContents']);
 const BOUNDING = /(?:^|\.)(?:take|takeE|isolate|hGetSome|hGet|splitAt|limit|limitedRead)$/;
+// Source provenances (haskell-models.js) that mean "the HTTP client supplied this text": a read with one of these inside a function makes the
+// value caller-supplied for the partial-function, allocation and bounding rules, whatever the function's own parameters are.
+const REQUEST_PROVENANCE = new Set(['url-param', 'path-param', 'http-body', 'header', 'cookie', 'upload']);
+// wai-extra's `requestSizeCheck (Just n) req` wraps the request so the body read after it fails past n bytes: a bound on every body read of the function.
+const WAI_SIZE_CHECK = /(?:^|\.)requestSizeCheck$/;
 // `replicateM n getLine` reads n lines: the count is an allocation (and an input loop) sized by whoever supplied n.
 const ALLOCATORS = new Set(['replicate', 'Prelude.replicate', 'Data.List.replicate', 'Data.ByteString.replicate', 'Data.ByteString.Char8.replicate', 'Data.ByteString.Lazy.replicate', 'Data.Text.replicate', 'Data.Vector.replicate', 'Control.Monad.replicateM', 'Control.Monad.replicateM_', 'Data.Vector.replicateM', 'Data.List.genericReplicate']);
 const CLAMPS = /^(?:(?:Prelude|Data\.Ord)\.)?(?:min|clamp)$/;
@@ -89,14 +99,72 @@ const PARTIALS = new Set([...PARTIAL_NAMES, ...PARTIAL_NAMES.flatMap((n) => PART
   ...['Data.Map', 'Data.Map.Strict'].flatMap((m) => ['findMin', 'findMax', 'deleteFindMin', 'elemAt'].map((n) => `${m}.${n}`)), 'Data.Set.findMin', 'Data.Set.findMax', 'Data.Set.elemAt']);
 // A call that tests whether a container is empty, a key is present or a value is available: the partial call beside it is conditional on that test.
 const EMPTINESS_CHECK = /(?:^|\.)(?:null|notNull|isEmpty|length|size|isJust|isNothing|member|notMember|lookup|elem|notElem|nonEmpty|<match>)$/;
+// A call whose result has a different shape from its argument (pieces of it, or a parse of it): a test of the argument says nothing about the result.
+const SPLITTER = /(?:^|\.)(?:words|lines|splitOn|split|splitWhen|chunksOf|breakOn|decode|decodeStrict|eitherDecode|decodeEither|parseMaybe|parseEither|parse|readMaybe|readEither|reads)$/;
 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|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;
+// a variable whose name says it holds the HASH of a credential (`hashedPassword`, `passwordHash`, `tokenDigest`): the stored form, not the secret
+const HASH_NAMED = /(?:hash|digest)/i;
+// Every use of the identifier `n` inside `arg` is as the object of a member access whose field is not credential-shaped (`attemptUser attempt`).
+function usedOnlyAsNonSensitiveField(arg, n) {
+  let uses = 0; let fields = 0;
+  const visit = (e, parent, d) => {
+    if (!e || typeof e !== 'object' || d > 40) return;
+    if (e.kind === 'ident' && e.name === n) {
+      uses++;
+      if (parent && parent.kind === 'member' && parent.object === e && typeof parent.prop === 'string' && !SENSITIVE.test(parent.prop)) fields++;
+      return;
+    }
+    for (const k of Object.keys(e)) {
+      if (k === 'hs') continue;
+      const v = e[k];
+      if (Array.isArray(v)) { for (const x of v) visit(x, e, d + 1); } else if (v && typeof v === 'object') visit(v, e, d + 1);
+    }
+  };
+  visit(arg, null, 0);
+  return uses > 0 && uses === fields;
+}
+// a value that is a one-time code only in context: `code` is a security value where the function talks about a reset, a verification, an OTP
+const CONTEXT_CODE_VAR = /^(?:code|pin|passcode|otp)$/i;
+const CODE_CONTEXT = /reset|verif|otp|one.?time|activation|confirm|2fa|mfa|two.?factor/i;
+// A project function of this file whose every return value is a comparison, a conjunction or a boolean predicate (after `pure`/`return`).
+function returnsYesNo(fir, callee) {
+  const fn = (fir.functions || []).find((x) => x.name === callee || x.qid === callee || (x.qid || '').endsWith(`::${callee}`));
+  if (!fn) return false;
+  const rets = Object.values(fn.cfg.nodes).filter((n) => n.kind === 'return' && n.value);
+  if (!rets.length) return false;
+  return rets.every((n) => {
+    let e = n.value;
+    for (let i = 0; i < 6 && e && e.kind === 'call' && typeof e.callee === 'string' && /(?:^|\.)(?:pure|return|liftIO)$/.test(e.callee) && (e.args || []).length === 1; i++) e = e.args[0];
+    if (!e) return false;
+    if (e.kind === 'binary' && ['==', '/=', '!=', '&&', '||', '<', '>', '<=', '>='].includes(e.op)) return true;
+    if (e.kind === 'logical') return true;
+    if (e.kind === 'literal' && typeof e.value === 'boolean') return true;
+    return e.kind === 'call' && typeof e.callee === 'string' && /(?:^|\.)(?:not|elem|notElem|null|isJust|isNothing|any|all|and|or)$/.test(e.callee);
+  });
+}
+
+function fnMentions(fn, re) {
+  for (const n of Object.values(fn.cfg.nodes)) {
+    for (const k of ['source', 'value', 'cond']) {
+      if (!n[k]) continue;
+      for (const x of walk(n[k])) {
+        if (x.kind === 'literal' && typeof x.value === 'string' && re.test(x.value)) return true;
+        if (x.kind === 'call' && typeof x.callee === 'string' && re.test(x.callee)) return true;
+      }
+    }
+    if (n.kind === 'call' && typeof n.callee === 'string' && re.test(n.callee)) return true;
+    if (Array.isArray(n.args)) for (const a of n.args) for (const x of walk(a)) if (x.kind === 'literal' && typeof x.value === 'string' && re.test(x.value)) return true;
+  }
+  return false;
+}
 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;
-const REDACTOR = /(?:^|\.)(?:redact|mask|scrub|obfuscate|anonymi[sz]e|censor|length|null)$|(?:^|\.)(?:redact|mask|scrub|obfuscate|anonymi[sz]e|censor)/i;
+// (a helper that keeps only a few characters of the value, `lastFour`, `last4`, `fingerprint`, `takeEnd`, is a masking helper by its name too)
+const REDACTOR = /(?:^|\.)(?:redact|mask|scrub|obfuscate|anonymi[sz]e|censor|length|null|takeEnd|fingerprint|abbreviate|truncate)$|(?:^|\.)(?:redact|mask|scrub|obfuscate|anonymi[sz]e|censor|last(?:four|4|digits|chars)|fingerprint)/i;
 
 const kids = (e) => {
   const out = [];
@@ -108,6 +176,19 @@ const kids = (e) => {
   return out;
 };
 
+// Marks every node under an inlined helper's root with the helper's qid (`hs.inlineCtx`); idempotent, so a cached IR is marked once.
+function markInlined(e, ctx, depth) {
+  if (!e || typeof e !== 'object' || depth > 60) return;
+  const here = (e.hs && e.hs.inlinedFrom) || ctx;
+  if (here && !(e.hs && e.hs.inlineCtx)) e.hs = { ...(e.hs || {}), inlineCtx: here };
+  for (const k of Object.keys(e)) {
+    if (k === 'hs') continue;
+    const v = e[k];
+    if (Array.isArray(v)) { for (const x of v) markInlined(x, here, depth + 1); }
+    else if (v && typeof v === 'object') markInlined(v, here, depth + 1);
+  }
+}
+
 function* walk(e, depth = 0) {
   if (!e || typeof e !== 'object' || depth > 80) return;
   yield e;
@@ -272,11 +353,13 @@ export function analyzeHaskellRules(files, opts = {}) {
     if (/import\s+(?:qualified\s+)?Network\.Wai\.Middleware\.RequestSizeLimit\b/.test(text) || /\brequestSizeLimitMiddleware\b/.test(text)) { requestLimit = { file, line: (text.split('\n').findIndex((l) => /RequestSizeLimit|requestSizeLimitMiddleware/.test(l)) + 1) || 1 }; break; }
   }
 
+  let currentFn = null;
   const emit = (rule, file, line, extra = {}) => {
     const r = RULES[rule];
     const sev = extra.severity || r.severity;
     const f = {
       id: `hs-rule:${rule}:${file}:${line}`, severity: sev, file, line, vuln: extra.vuln || r.vuln, cwe: r.cwe,
+      _fnQid: currentFn ? currentFn.qid : null, ...(extra.inlineCtx ? { inlineCtx: extra.inlineCtx } : {}),
       description: `${extra.vuln || r.vuln}${extra.detail ? `: ${extra.detail}` : ''}`,
       remediation: r.remediation, parser: 'HS-RULES', family: r.family,
       language: 'haskell', capability: 'sast', analysisKind: 'application', evidenceKind: 'source',
@@ -299,6 +382,14 @@ export function analyzeHaskellRules(files, opts = {}) {
       }
     }
     for (const fn of fir.functions) {
+      currentFn = fn;
+      // A project helper the IR inlined at its call site (`digestFor (credPassword creds)` becomes the helper's body, rooted at a node with
+      // `hs.inlinedFrom`) is walked here as well as in the helper itself. Every node under such a root is marked with the helper's qid, so
+      // a rule that reports the same thing inside the helper can drop the call-site copy (the filter before the return).
+      for (const n of Object.values(fn.cfg.nodes)) {
+        for (const k of ['source', 'value', 'cond']) if (n[k]) markInlined(n[k], null, 0);
+        if (Array.isArray(n.args)) for (const a of n.args) markInlined(a, null, 0);
+      }
       if (fn.name.endsWith('.<module>')) continue;
       const bound = new Map();   // target var -> {callee, line}
       const sensitive = new Map(); // var -> {class:'low'|'high', hashed:boolean, line}
@@ -312,45 +403,89 @@ export function analyzeHaskellRules(files, opts = {}) {
       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 callsIn = (e) => { const out = []; for (const x of walk(e)) if (x.kind === 'call' && typeof x.callee === 'string') out.push(x); return out; };
+      // A value READ from the request inside the function (`raw <- param "page"`, `body <- strictRequestBody req`, `lookup h (requestHeaders req)`)
+      // is caller-supplied text wherever the function sits: the framework's own read says who supplied it, so no parameter label is needed.
+      const requestRead = (c) => { const s = sourceInfo(c.callee); return !!s && REQUEST_PROVENANCE.has(s.provenance); };
       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;
-          for (const n of fnNodes(fn)) if (n.kind === 'assign' && n.target && n.source && !derivedText.has(n.target) && [...names(n.source)].some((x) => derivedText.has(x))) { derivedText.add(n.target); grew = true; }
-          if (!grew) break;
+      const fromRequest = new Set();
+      for (let round = 0; round < 8; round++) {
+        let grew = false;
+        for (const n of fnNodes(fn)) {
+          if (n.kind !== 'assign' || !n.target || !n.source) continue;
+          const nm = [...names(n.source)];
+          const reads = callsIn(n.source).some(requestRead);
+          if (!derivedText.has(n.target) && (reads || nm.some((x) => derivedText.has(x)))) { derivedText.add(n.target); grew = true; }
+          if (!fromRequest.has(n.target) && (reads || nm.some((x) => fromRequest.has(x)))) { fromRequest.add(n.target); grew = true; }
         }
+        if (!grew) break;
       }
-      const mentionsText = (e) => [...names(e)].some((x) => derivedText.has(x));
-      const callsIn = (e) => { const out = []; for (const x of walk(e)) if (x.kind === 'call' && typeof x.callee === 'string') out.push(x); return out; };
+      const mentionsText = (e) => [...names(e)].some((x) => derivedText.has(x)) || callsIn(e).some(requestRead);
+      const mentionsRequest = (e) => [...names(e)].some((x) => fromRequest.has(x)) || callsIn(e).some(requestRead);
       const fnReturns = fnNodes(fn).filter((n) => n.kind === 'return' && n.value);
       const bounded = fnNodes(fn).some((n) => [n.value, n.source, ...(n.args || [])].some((e) => e && callsIn(e).some((c) => BOUNDING.test(c.callee))));
 
       // Values a condition in this function tests for emptiness or presence (`null ws`, `M.member k t`, `xs /= []`, a pattern match on it) and,
       // transitively, the values they were built from: a partial call on one of them is the other branch of that test.
+      // A test covers a partial call only on the value it tested, not on a value SPLIT or PARSED from it afterwards: `maybe "" id (lookup h hs)`
+      // proves the header is present, not that `words auth !! 1` has a second word; `isJust (decode body)` does cover `fromJust (decode body)`
+      // (the same split, of the same value, is what was tested). Names are therefore followed through assignments but not into a splitting call.
+      const directNames = (e) => { const out = new Set(); const visit = (x, d) => { if (!x || typeof x !== 'object' || d > 60) return; if (x.kind === 'call' && typeof x.callee === 'string' && SPLITTER.test(x.callee)) return; if (x.kind === 'ident' && x.name && !(x.hs && x.hs.functionRef)) out.add(x.name); for (const c of kids(x)) visit(c, d + 1); }; visit(e, 0); return out; };
+      const splitsIn = (e) => callsIn(e).filter((x) => SPLITTER.test(x.callee)).map((x) => `${x.callee.replace(/^.*\./, '')}|${[...names(x)].sort().join(',')}`);
       const assignSources = new Map();
-      for (const n of fnNodes(fn)) if (n.kind === 'assign' && n.target && n.source) assignSources.set(n.target, [...(assignSources.get(n.target) || []), ...names(n.source)]);
+      for (const n of fnNodes(fn)) if (n.kind === 'assign' && n.target && n.source) assignSources.set(n.target, [...(assignSources.get(n.target) || []), ...directNames(n.source)]);
       const withOrigins = (seed) => { const out = new Set(seed); const queue = [...seed]; while (queue.length) { const v = queue.pop(); for (const o of assignSources.get(v) || []) if (!out.has(o)) { out.add(o); queue.push(o); } } return out; };
       const testedVars = new Set();
+      const testedSplits = new Set();
       for (const n of fnNodes(fn)) {
         if (n.kind !== 'if' || !n.cond) continue;
         for (const x of walk(n.cond)) {
-          if (x.kind === 'call' && typeof x.callee === 'string' && EMPTINESS_CHECK.test(x.callee)) for (const nm of names(x)) testedVars.add(nm);
-          if (x.kind === 'binary' && ['==', '/=', '!='].includes(x.op) && [x.left, x.right].some((side) => side && side.kind === 'array' && side.elements.length === 0)) for (const nm of names(x)) testedVars.add(nm);
+          if (x.kind === 'call' && typeof x.callee === 'string' && EMPTINESS_CHECK.test(x.callee)) { for (const nm of directNames(x)) testedVars.add(nm); for (const s of splitsIn(x)) testedSplits.add(s); }
+          if (x.kind === 'binary' && ['==', '/=', '!='].includes(x.op) && [x.left, x.right].some((side) => side && side.kind === 'array' && side.elements.length === 0)) for (const nm of directNames(x)) testedVars.add(nm);
         }
       }
       const testedAll = withOrigins(testedVars);
-      const isTested = (args) => { const mine = withOrigins([...args.flatMap((a) => [...names(a)])]); for (const v of mine) if (testedAll.has(v) && derivedText.has(v)) return true; return false; };
+      const isTested = (args) => {
+        if (args.some((a) => splitsIn(a).some((s) => testedSplits.has(s)))) return true;
+        const mine = withOrigins([...args.flatMap((a) => [...directNames(a)])]);
+        for (const v of mine) if (testedAll.has(v) && derivedText.has(v)) return true;
+        return false;
+      };
 
       // A relational test against a number or a length (`total >= limit`, `size <= 65536`) in this function: the evidence that a read or a body is capped.
       const hasSizeTest = fnNodes(fn).some((n) => n.kind === 'if' && n.cond && [...walk(n.cond)].some((x) => x.kind === 'binary' && RELATIONAL.has(x.op)));
+      // The values a relational test in this function compares with something (`n > maxBatch`, `count <= 100`): a count one of them sizes is bounded
+      // by that test (the direction is not judged; a test that only rejects negatives still counts, which errs toward silence).
+      const sizeTestedVars = new Set();
+      for (const n of fnNodes(fn)) if (n.kind === 'if' && n.cond) for (const x of walk(n.cond)) if (x.kind === 'binary' && RELATIONAL.has(x.op)) for (const nm of names(x)) sizeTestedVars.add(nm);
       const readsRequestLength = fnNodes(fn).some((n) => [n.value, n.source, n.cond, ...(n.args || [])].some((ex) => ex && [...walk(ex)].some((x) => (x.kind === 'ident' && REQUEST_LENGTH.has(x.name)) || (x.kind === 'call' && REQUEST_LENGTH.has(x.callee)))));
-      const sizeChecked = hasSizeTest && readsRequestLength;
+      const waiSizeChecked = fnNodes(fn).some((n) => [n.value, n.source, n.cond, ...(n.args || [])].some((ex) => ex && callsIn(ex).some((x) => WAI_SIZE_CHECK.test(x.callee))));
+      const sizeChecked = (hasSizeTest && readsRequestLength) || waiSizeChecked;
       // One predictable-random finding per function: a clock reading that seeds a generator in a token-shaped function is a single flaw,
       // however many of its steps (the clock, the seed, the generator) the rule can see.
       let randomEmitted = false;
       const emitRandom = (line, extra) => { if (randomEmitted) return; randomEmitted = true; emit('hs-predictable-random', file, line, extra); };
 
       const seeds = (e) => { for (const n of names(e)) if (SENSITIVE.test(n.replace(/^\./, ''))) return n.replace(/^\./, ''); return null; };
+      // A parameter whose declared type is a record of this project with a credential or card field (`Card { cardNumber, cardCvv }`), written
+      // to a log WHOLE: `show card`, or the value spliced into the message. Handed to any other function (`masked card`) it is that function's
+      // result that is logged, which is judged by the names it carries, not here.
+      const sensitiveRecords = new Map((fnHs.recordParams || []).filter((r) => (r.fields || []).some((x) => SENSITIVE.test(x))).map((r) => [r.name, r]));
+      const FORMAT_WHOLE = /(?:^|\.)(?:show|tshow|showt|pack|unpack|encode|toJSON|encodeUtf8|decodeUtf8|fromStrict|toStrict|toLazyText|fromString|toString|displayShow|pShow|ppShow|textDisplay|toLogStr|logStr)$/;
+      const wholeRecord = (arg) => {
+        if (!sensitiveRecords.size) return null;
+        let found = null;
+        const visit = (e, d) => {
+          if (!e || typeof e !== 'object' || d > 40 || found) return;
+          if (e.kind === 'ident' && sensitiveRecords.has(e.name)) { const r = sensitiveRecords.get(e.name); found = { name: e.name, type: r.type, field: (r.fields || []).find((x) => SENSITIVE.test(x)) }; return; }
+          if (e.kind === 'binary') { visit(e.left, d + 1); visit(e.right, d + 1); return; }
+          if (e.kind === 'call' && typeof e.callee === 'string') { if (FORMAT_WHOLE.test(e.callee)) for (const a of e.args || []) visit(a, d + 1); return; }
+          if (e.kind === 'array') { for (const a of e.elements || []) visit(a, d + 1); return; }
+          if (e.hs && e.hs.inner) visit(e.hs.inner, d + 1);
+        };
+        visit(arg, 0);
+        return found;
+      };
 
       // pass over nodes in program order
       for (const node of fnNodes(fn)) {
@@ -371,9 +506,13 @@ export function analyzeHaskellRules(files, opts = {}) {
               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=/")`
-            if (e.kind === 'array' && e.hs && e.hs.tuple && e.elements.length === 2) {
-              const [k, v] = e.elements;
+            // a Set-Cookie header written by hand: `(hSetCookie, "session_id=" <> sid <> "; Path=/")`, or handed to a framework's header
+            // setter: Scotty `setHeader "Set-Cookie" ("session=" <> tok <> "; Path=/")`, Spock `setHeader`, Yesod `addHeader`
+            let cookiePair = null;
+            if (e.kind === 'array' && e.hs && e.hs.tuple && e.elements.length === 2) cookiePair = e.elements;
+            else if (e.kind === 'call' && typeof e.callee === 'string' && /(?:^|\.)(?:setHeader|addHeader|setResponseHeader|modifyHeader)$/.test(e.callee) && (e.args || []).length >= 2) cookiePair = [e.args[0], e.args[1]];
+            if (cookiePair) {
+              const [k, v] = cookiePair;
               const isSetCookie = k && ((k.kind === 'ident' && SET_COOKIE_HEADER.has(k.name)) || (k.kind === 'literal' && /^set-cookie$/i.test(String(k.value))) || (k.kind === 'call' && /(?:^|\.)(?:pack|fromString)$/.test(k.callee || '') && k.args && k.args[0] && k.args[0].kind === 'literal' && /^set-cookie$/i.test(String(k.args[0].value))));
               if (isSetCookie && v) {
                 const text = literalTextOf(v);
@@ -426,7 +565,10 @@ export function analyzeHaskellRules(files, opts = {}) {
             // scotty-cookie's helpers build a cookie that carries neither Secure nor HttpOnly
             if ((c === 'Web.Scotty.Cookie.setSimpleCookie' || c === 'Web.Scotty.Cookie.makeSimpleCookie') && args[0]) {
               const nm = args[0];
-              if (nm.kind !== 'literal' || SESSION_COOKIE.test(String(nm.value))) emit('hs-insecure-cookie', file, line, { detail: 'HttpOnly missing, Secure missing', evidence: { httpOnly: false, secure: false, helper: c } });
+              // A name that is a PARAMETER of this function is decided by the caller: the function is itself a cookie helper
+              // (scotty's own `setSimpleCookie n v`, `deleteCookie c`), and the call that passes a session name is the site to report.
+              const ownParam = nm.kind === 'ident' && Array.isArray(fn.params) && fn.params.includes(nm.name);
+              if (!ownParam && (nm.kind !== 'literal' || SESSION_COOKIE.test(String(nm.value)))) emit('hs-insecure-cookie', file, line, { detail: 'HttpOnly missing, Secure missing', evidence: { httpOnly: false, secure: false, helper: c } });
             }
             // a socket read repeated by a recursive loop, with no size test anywhere in it
             if (SOCKET_READS.has(c) && !hasSizeTest && !bounded && fn.calls.some((x) => x.callee === fn.name && x.hs && x.hs.target === fn.qid)) {
@@ -451,8 +593,9 @@ export function analyzeHaskellRules(files, opts = {}) {
               }
             }
             // 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(/^\./, ''))))) {
-              emit('hs-fast-password-hash', file, line, { detail: `${c} applied to a password-shaped value` });
+            // (a hash call the IR inlined from a project helper, `digestFor (credPassword creds)` at the comparison, is reported once, in the helper)
+            if (ANY_HASH_CALLS.has(c) && !STRONG_KDF.test(c) && !(e.hs && e.hs.inlinedFrom) && args.some((a) => [...names(a)].some((n) => PASSWORD_VAR.test(n.replace(/^\./, ''))))) {
+              emit('hs-fast-password-hash', file, line, { detail: `${c} applied to a password-shaped value`, inlineCtx: e.hs && e.hs.inlineCtx });
             }
             if (PBKDF2_CALLS.has(c)) {
               for (const a of args) for (const x of walk(a)) if (x.kind === 'object') for (const p of x.props || []) if (p.key === 'iterCounts' && p.value && p.value.kind === 'literal' && typeof p.value.value === 'number' && p.value.value < 10000) {
@@ -463,7 +606,7 @@ export function analyzeHaskellRules(files, opts = {}) {
             if (ECB_CALLS.has(c)) emit('hs-ecb-mode', file, line, { detail: c });
             if (IV_CALLS.has(c) && args[0] && isLiteralLike(args[0])) emit('hs-static-iv', file, line, { detail: `${c} of a constant value` });
             // randomness bound to a security-shaped name
-            if (RANDOM_CALLS.has(c) && node.kind === 'assign' && SECURITY_VAR.test(node.target || '')) {
+            if (RANDOM_CALLS.has(c) && node.kind === 'assign' && (SECURITY_VAR.test(node.target || '') || (CONTEXT_CODE_VAR.test(node.target || '') && fnMentions(fn, CODE_CONTEXT)))) {
               emitRandom(line, { detail: `${c} result bound to \`${node.target}\``, evidence: { binding: node.target } });
             }
             if (RANDOM_CALLS.has(c) && SECURITY_FN.test(fnBase) && node.kind !== 'assign') {
@@ -472,7 +615,8 @@ export function analyzeHaskellRules(files, opts = {}) {
             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 && 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))) {
+            // (a number the framework parsed from the request, `n <- param "count" :: ActionM Int`, is parsed caller text too)
+            if (ALLOCATORS.has(c) && args[0] && mentionsText(args[0]) && (mentionsRequest(args[0]) || callsIn(args[0]).some((x) => /(?:^|\.)(?:read|readMaybe|readEither)$/.test(x.callee))) && !callsIn(args[0]).some((x) => CLAMPS.test(x.callee)) && ![...names(args[0])].some((v) => sizeTestedVars.has(v))) {
               emit('hs-unbounded-allocation', file, line, { detail: `${c} sized by parsed caller text`, evidence: { allocator: c } });
             }
             // a partial function applied to caller text: one malformed value raises an uncaught exception
@@ -510,6 +654,14 @@ export function analyzeHaskellRules(files, opts = {}) {
           for (const n of srcNames) if (sensitive.has(n)) { const s = sensitive.get(n); cls = { name: s.name, low: s.low }; hashed = hashed || s.hashed; }
           if (cls) {
             let cleared = false;
+            // a yes/no answer about the credential (`accepted <- checkCredentials attempt`, a comparison, a conjunction) carries no credential text
+            let root = src; for (let i = 0; i < 6 && root && root.kind === 'call' && typeof root.callee === 'string' && /(?:^|\.)(?:liftIO|pure|return|lift)$/.test(root.callee) && (root.args || []).length === 1; i++) root = root.args[0];
+            if (root && ((root.kind === 'binary' && ['==', '/=', '!=', '&&', '||', '<', '>', '<=', '>='].includes(root.op)) || root.kind === 'logical')) cleared = true;
+            // the binding says it holds a hash or digest (`hashedPassword <- hashPassword plain`): the stored form, whatever made it
+            if (HASH_NAMED.test(node.target || '')) cleared = true;
+            if (root && root.kind === 'call' && typeof root.callee === 'string' && /(?:^|\.)(?:not|elem|notElem|null|isJust|isNothing|any|all|and|or)$/.test(root.callee)) cleared = true;
+            // a project helper whose every return is such an answer (`checkCredentials a = pure (user a == "x" && password a == "y")`)
+            if (root && root.kind === 'call' && typeof root.callee === 'string' && returnsYesNo(fir, root.callee)) cleared = true;
             for (const x of walk(src)) {
               if (x.kind !== 'call' || typeof x.callee !== 'string') continue;
               if (REDACTOR.test(x.callee)) cleared = true;
@@ -532,7 +684,8 @@ export function analyzeHaskellRules(files, opts = {}) {
             if (!argList.length || argList.every((a) => !a)) continue;
             // a file append is a log only when its path says so (a log, audit or trace file)
             if (sink.channel === 'file') { const p = (e.args || [])[0]; if (!(p && p.kind === 'literal' && /(?:log|audit|trace|journal)/i.test(String(p.value)))) continue; }
-            const isRedacted = (a) => { for (const x of walk(a)) if (x.kind === 'call' && typeof x.callee === 'string' && (REDACTOR.test(x.callee) || STRONG_KDF.test(x.callee) || x.callee === 'const')) return true; return false; };
+            // (a project function the IR inlined into the argument, `masked card`, keeps its origin in `hs.inlinedFrom`: a redactor by name earns the same credit inlined as called)
+            const isRedacted = (a) => { for (const x of walk(a)) { if (x.kind === 'call' && typeof x.callee === 'string' && (REDACTOR.test(x.callee) || STRONG_KDF.test(x.callee) || x.callee === 'const')) return true; if (x.hs && typeof x.hs.inlinedFrom === 'string' && REDACTOR.test(x.hs.inlinedFrom.replace(/^.*::/, ''))) return true; } return false; };
             for (const arg of argList) {
               if (!arg) continue;
               let hit = null;
@@ -547,12 +700,19 @@ export function analyzeHaskellRules(files, opts = {}) {
               for (const n of names(arg)) {
                 if (hit) break;
                 const bare = n.replace(/^\./, '');
-                if (sensitive.has(n)) hit = { ...sensitive.get(n), var: n };
-                else if (SENSITIVE.test(bare) && !/^[A-Z][A-Za-z0-9_.]*\./.test(n)) hit = { name: bare, low: LOW_ENTROPY.test(bare), hashed: false, var: n };
+                // a value built from a credential (`attempt = Attempt user password`) logged through a field that is not the credential
+                // (`attemptUser attempt`, lowered to a member of `attempt`) is that field, not the secret
+                if (sensitive.has(n) && !usedOnlyAsNonSensitiveField(arg, n)) hit = { ...sensitive.get(n), var: n };
+                // a name that says it holds a hash or digest of the credential (`hashedPassword`, `tokenDigest`) is the stored form, not the secret
+                else if (SENSITIVE.test(bare) && !/^[A-Z][A-Za-z0-9_.]*\./.test(n) && !HASH_NAMED.test(bare)) hit = { name: bare, low: LOW_ENTROPY.test(bare), hashed: false, var: n };
+                // the record itself, logged whole (`show attempt`), when one of its fields was built from a credential (`attempt.attemptPassword`)
+                else if (!sensitive.has(n)) { const field = [...sensitive.keys()].find((k) => k.startsWith(`${n}.`)); if (field && !usedOnlyAsNonSensitiveField(arg, n)) hit = { ...sensitive.get(field), name: field, var: n }; }
                 if (hit) break;
               }
+              if (!hit) { const rec = wholeRecord(arg); if (rec) hit = { name: `${rec.type}.${rec.field}`, low: LOW_ENTROPY.test(rec.field), hashed: false, var: rec.name }; }
               if (hit && !isRedacted(arg)) {
                 emit('hs-sensitive-logging', file, e.line || node.line, {
+                  inlineCtx: e.hs && e.hs.inlineCtx,
                   severity: hit.hashed ? 'low' : 'high',
                   detail: hit.hashed ? `a fast hash of low-entropy \`${hit.name}\` reaches ${e.callee}` : `\`${hit.name}\` reaches ${e.callee}`,
                   evidence: { value: hit.name, via: hit.var, channel: sink.channel, hashed: hit.hashed },
@@ -563,6 +723,20 @@ export function analyzeHaskellRules(files, opts = {}) {
           }
         }
       }
+      // A security-shaped function (`generateApiKey`, `newResetCode`) whose RESULT is built from a System.Random value: the generator was bound
+      // to an ordinary name (`g <- newStdGen`, `let bytes = take 16 (randoms g)`), so neither the binding rule nor the "feeds the function" rule
+      // above saw it; the value reaching the function's return is what makes it the token.
+      if (!randomEmitted && SECURITY_FN.test(fnBase)) {
+        const hasRandom = (e) => { for (const x of walk(e)) if ((x.kind === 'call' && RANDOM_CALLS.has(x.callee)) || (x.kind === 'ident' && RANDOM_CALLS.has(x.name) && !(x.hs && x.hs.functionRef))) return true; return false; };
+        const carriers = new Set(); let seedLine = null;
+        for (let round = 0; round < 8; round++) {
+          let grew = false;
+          for (const n of fnNodes(fn)) if (n.kind === 'assign' && n.target && n.source && !carriers.has(n.target) && (hasRandom(n.source) || [...names(n.source)].some((x) => carriers.has(x)))) { carriers.add(n.target); if (seedLine === null || (Number.isFinite(n.line) && n.line < seedLine)) seedLine = n.line; grew = true; }
+          if (!grew) break;
+        }
+        const ret = fnReturns.find((n) => hasRandom(n.value) || [...names(n.value)].some((x) => carriers.has(x)));
+        if (ret) emitRandom(ret.line || seedLine || fn.line, { detail: `a System.Random value reaches the result of \`${fnBase}\``, evidence: { function: fnBase, via: [...carriers].slice(0, 4) } });
+      }
     }
   }
 
@@ -571,5 +745,16 @@ export function analyzeHaskellRules(files, opts = {}) {
   const out = [];
   for (const f of findings) { if (seen.has(f.id)) continue; seen.add(f.id); out.push(f); }
   void notes; void opts;
-  return { findings: out, controls, notes };
+  // A call-site copy of a finding the helper itself reports (the helper's body was inlined at the call) is dropped; a call-site finding
+  // whose helper reports nothing (the password shape is visible only at the call) is kept.
+  // The kept finding lists the call sites it also covers (`alsoAt`), so a reviewer still sees every line of the one weakness.
+  const byKey = new Map(out.map((f) => [`${f.rule}|${f.file}|${f._fnQid}`, f]));
+  const deduped = out.filter((f) => {
+    const helper = f.inlineCtx && f._fnQid !== f.inlineCtx ? byKey.get(`${f.rule}|${f.file}|${f.inlineCtx}`) : null;
+    if (!helper) return true;
+    helper.alsoAt = [...(helper.alsoAt || []), { line: f.line, reason: 'the same helper inlined at this call' }];
+    return false;
+  });
+  for (const f of deduped) delete f._fnQid;
+  return { findings: deduped, controls, notes };
 }

package/src/language/haskell-trust.js

@@ -10,7 +10,11 @@
 //                         is lowered to `info`, never dropped
 //   api-contract          the value is a parameter of an exported function that nothing in the analysed code calls, and the function
 //                         hands it WHOLE (or as the root it appends fixed text to) to a path or command operation: a thin wrapper.
-//                         The caller chose what to read or run, and the wrapper has no fixed part to escape from. Lowered to `info`
+//                         The caller chose what to read or run, and the wrapper has no fixed part to escape from. Lowered to `info`.
+//                         Path operations joined this way since 0.195.9: `renderFile path = responseFile .. path` and
+//                         `store path = readFile (cs path)` were 2 of the 29 flagged path sites on the real-code sets and no true
+//                         positive had that shape; a parameter spliced UNDER a fixed directory (`"/srv/" ++ name`) is still kept,
+//                         because the function chose the directory and lets the caller leave it
 //   entry-parameter       a parameter of such a function used inside a larger value the function builds: its own construction, kept
 //   data-input            standard input or a file's content in a service or a library: data the program processes, kept
 //   unattributed          the engine recorded no origin: kept
@@ -26,11 +30,17 @@ import { findSites, identNames } from './haskell-guards.js';
 export const TRUST_VERDICTS = Object.freeze(['attacker-reachable', 'operator-controlled', 'api-contract', 'entry-parameter', 'data-input', 'unattributed']);
 
 const OPERATOR = new Set(['cli', 'env']);
-const EXTERNAL = new Set(['http-body', 'url-param', 'path-param', 'header', 'cookie', 'network']);
+const EXTERNAL = new Set(['http-body', 'url-param', 'path-param', 'header', 'cookie', 'network', 'upload']);
 const DATA = new Set(['stdin', 'file-read']);
 const WEAK_PARAM_LABEL = /\(caller-controlled\)$/;
-const WRAPPER_FAMILIES = new Set(['CWE-78', 'CWE-88']);
-const CONVERSIONS = /(?:^|\.)(?:pack|unpack|fromString|toString|show|encodeUtf8|decodeUtf8|toStrict|fromStrict|toText|unpackFS|fromText)$/;
+// CWE-918 is deliberately NOT a wrapper family: `fetch url = parseRequest url >>= httpNoBody` is pinned as a finding in
+// test/haskell/haskell-generalization.test.js (a URL the caller chooses is the SSRF shape of the development sets). unseen-v4 labels
+// that shape safe when the URL is configuration; that disagreement is recorded, not decided here. CWE-22 joined the set in 0.195.9
+// (see the header): the synthetic development sets label `load name = readFile name` vulnerable, the real-code sets label every such
+// site a false positive, and the real code won; a parameter under a fixed directory is still `entry-parameter`.
+const WRAPPER_FAMILIES = new Set(['CWE-78', 'CWE-88', 'CWE-22']);
+// `cs`/`convertString` (string-conversions) and `toS` (protolude) change the type of a text value and nothing else
+const CONVERSIONS = /(?:^|\.)(?:pack|unpack|fromString|toString|show|encodeUtf8|decodeUtf8|toStrict|fromStrict|toText|unpackFS|fromText|cs|convertString|toS|toSL|toST)$/;
 const PATH_JOIN = /(?:^|\.)(?:<\/>|combine|joinPath|<\.>)$/;
 // list plumbing that only lays the parameters out as text (`unwords args`, `concatMap (' ':) args`): no fixed words are added
 const LIST_LAYOUT = /(?:^|\.)(?:unwords|unlines|intercalate|concatMap|concat|map|fmap)$/;
@@ -176,7 +186,8 @@ function passThroughVerdict(perFile, f) {
     if (!weak.size) return null;
     const own = new Set(Array.isArray(analysed.params) ? analysed.params : []);
     const res = localResolver(analysed);
-    return args.every((a) => isPassThrough(a, own, family, res)) && args.some((a) => { const seen = new Set(); const walkIds = (e, d = 0) => { if (!e || d > 12) return; if (e.kind === 'ident') seen.add(e.name); for (const k of ['left', 'right', 'object', 'value']) if (e[k] && typeof e[k] === 'object') walkIds(e[k], d + 1); for (const k of ['args', 'elements']) if (Array.isArray(e[k])) e[k].forEach((x) => walkIds(x, d + 1)); }; let x = a; for (let i = 0; i < 4; i++) { const r = res(x); if (r === x) break; x = r; } walkIds(x); return [...seen].some((n) => weak.has(n)); }) ? 'direct' : null;
+    // (a name bound once in the function stands for its definition here too, so `req <- parseRequest url; httpLbs req m` reaches `url`; a record update is a union of base and update)
+    return args.every((a) => isPassThrough(a, own, family, res)) && args.some((a) => { const seen = new Set(); const walkIds = (e, d = 0) => { if (!e || d > 12) return; if (e.kind === 'ident') { seen.add(e.name); const r = res(e); if (r && r !== e) walkIds(r, d + 1); } for (const k of ['left', 'right', 'object', 'value']) if (e[k] && typeof e[k] === 'object') walkIds(e[k], d + 1); for (const k of ['args', 'elements', 'branches']) if (Array.isArray(e[k])) e[k].forEach((x) => walkIds(x, d + 1)); }; let x = a; for (let i = 0; i < 4; i++) { const r = res(x); if (r === x) break; x = r; } walkIds(x); return [...seen].some((n) => weak.has(n)); }) ? 'direct' : null;
   }
   // the sink is in a callee
   const own = new Set(Array.isArray(sink.fn.params) ? sink.fn.params : []);
@@ -257,9 +268,14 @@ export function applyTrustBoundary(findings, perFile) {
     else if (roots.length && [...classes].every((c) => c === 'operator')) {
       verdict = 'operator-controlled';
       reason = 'only command-line arguments or environment variables supply the value; whoever starts the program chooses them, so no trust boundary is crossed';
-    } else if (roots.length && role === 'cli' && roots.every((r) => r.provenance === 'file-read' || OPERATOR.has(r.provenance))) {
+    } else if (roots.length && role === 'cli' && roots.every((r) => r.provenance === 'file-read' || OPERATOR.has(r.provenance) || (f.cwe === 'CWE-22' && r.provenance === 'stdin'))) {
+      // Standard input counts here for a PATH operation only: a command-line program reading a file name from its own standard input
+      // is the person at the keyboard naming a file (14 of the 29 flagged path sites on the real-code sets, every one a false positive).
+      // A command built from standard input stays reported (`getLine >>= callCommand`, pinned in test/haskell/haskell-trust-boundary.test.js).
       verdict = 'operator-controlled';
-      reason = 'the function belongs to a command-line program (reached from a main that imports no server framework) and the value comes from files the person running it pointed the program at, or from its arguments and environment; standard input is not covered by this rule';
+      reason = f.cwe === 'CWE-22' && roots.some((r) => r.provenance === 'stdin')
+        ? 'the function belongs to a command-line program (reached from a main that imports no server framework) and the file it works on is named by the person running it: on its standard input, in files it was pointed at, or in its arguments and environment'
+        : 'the function belongs to a command-line program (reached from a main that imports no server framework) and the value comes from files the person running it pointed the program at, or from its arguments and environment; standard input is covered by this rule only for a path operation';
     } else if (classes.has('data')) { verdict = 'data-input'; reason = 'standard input or file content supplies the value'; }
     else if (classes.has('weak-param')) {
       verdict = 'entry-parameter';