core: Veridicality.antiConsensusGate — 6th graduation (10th ferry + SD-9 operationalized)

src/Core/Veridicality.fs

@@ -195,3 +195,48 @@ module Veridicality =
                 | None -> []
             Map.add key (c :: existing) acc) Map.empty
         |> Map.map (fun _ xs -> List.rev xs)
+
+    /// **Anti-consensus gate** — claims supporting the same
+    /// assertion must come from at least TWO independent
+    /// `RootAuthority` values before they're allowed to upgrade
+    /// trust. Returns `Ok claims` when the set of distinct
+    /// non-empty root authorities across the input has
+    /// cardinality >= 2; `Error msg` otherwise.
+    ///
+    /// Operational intent: if 50 claims all assert the same
+    /// fact but they all trace back to a single upstream source,
+    /// the 50-way agreement is a single piece of evidence, not
+    /// 50 independent pieces. The gate rejects pseudo-consensus;
+    /// genuine multi-root agreement passes.
+    ///
+    /// The input list is assumed to already be ABOUT the same
+    /// assertion (callers group-by canonical claim key before
+    /// invoking). The gate does NOT canonicalize; that's the
+    /// `canonicalKey` / `groupByCanonical` pair's job.
+    ///
+    /// **Degenerate-root filter.** Empty / whitespace-only
+    /// `RootAuthority` values are dropped before counting —
+    /// they do not count as a distinct root. This matches the
+    /// tolerant-skip convention of the module's other
+    /// primitives (degenerate input is skipped rather than
+    /// throwing). Callers that want strict validation should
+    /// run `validateProvenance` first.
+    ///
+    /// Edge cases:
+    /// * Empty list — zero roots, fails the gate.
+    /// * Single-claim list — one root, fails.
+    /// * Duplicate-root lists — fails unless a distinct alternate
+    ///   root also appears.
+    /// * Lists whose only "second root" is empty/whitespace —
+    ///   fails (empty root does not count).
+    let antiConsensusGate (claims: Claim<'T> list) : Result<Claim<'T> list, string> =
+        let agreeingRoots =
+            claims
+            |> List.map (fun c -> c.Prov.RootAuthority)
+            |> List.filter (fun r -> not (String.IsNullOrWhiteSpace r))
+            |> Set.ofList
+            |> Set.count
+        if agreeingRoots < 2 then
+            Error "Agreement without independent roots"
+        else
+            Ok claims

tests/Tests.FSharp/Algebra/Veridicality.Tests.fs

@@ -186,3 +186,101 @@ let ``groupByCanonical produces distinct-root counts per bucket`` () =
         bucket |> List.map (fun c -> c.Prov.RootAuthority) |> Set.ofList |> Set.count
     distinctRoots grouped.[xKey] |> should equal 2
     distinctRoots grouped.[yKey] |> should equal 1
+
+
+// ─── antiConsensusGate ─────────
+
+let private claimWithRoot (id: string) (root: string) : Veridicality.Claim<int> =
+    { Id = id
+      Payload = 0
+      Weight = 1L
+      Prov = { goodProv () with RootAuthority = root } }
+
+[<Fact>]
+let ``antiConsensusGate rejects empty list`` () =
+    match Veridicality.antiConsensusGate [] with
+    | Error _ -> ()
+    | Ok _ -> failwith "expected Error for empty list"
+
+[<Fact>]
+let ``antiConsensusGate rejects a single-claim list`` () =
+    let claims = [ claimWithRoot "c1" "root-a" ]
+    match Veridicality.antiConsensusGate claims with
+    | Error _ -> ()
+    | Ok _ -> failwith "expected Error for single claim"
+
+[<Fact>]
+let ``antiConsensusGate rejects many claims from a single root`` () =
+    // 50-way agreement from one root is still one piece of
+    // evidence, not 50.
+    let claims =
+        [ for i in 1 .. 50 -> claimWithRoot $"c{i}" "root-a" ]
+    match Veridicality.antiConsensusGate claims with
+    | Error msg -> msg.Contains("independent") |> should equal true
+    | Ok _ -> failwith "expected Error for same-root cluster"
+
+[<Fact>]
+let ``antiConsensusGate accepts two claims from two distinct roots`` () =
+    let claims =
+        [ claimWithRoot "c1" "root-a"
+          claimWithRoot "c2" "root-b" ]
+    match Veridicality.antiConsensusGate claims with
+    | Ok returned -> returned |> should equal claims
+    | Error msg -> failwith $"expected Ok, got Error: {msg}"
+
+[<Fact>]
+let ``antiConsensusGate accepts many claims spanning multiple roots`` () =
+    let claims =
+        [ claimWithRoot "c1" "root-a"
+          claimWithRoot "c2" "root-a"
+          claimWithRoot "c3" "root-b"
+          claimWithRoot "c4" "root-c" ]
+    match Veridicality.antiConsensusGate claims with
+    | Ok _ -> ()
+    | Error msg -> failwith $"expected Ok, got Error: {msg}"
+
+[<Fact>]
+let ``antiConsensusGate returns Ok with the original list unchanged on pass`` () =
+    // Gate is read-only: it returns the same list it was given.
+    let claims =
+        [ claimWithRoot "c1" "root-a"
+          claimWithRoot "c2" "root-b" ]
+    match Veridicality.antiConsensusGate claims with
+    | Ok returned -> returned |> List.length |> should equal 2
+    | Error msg -> failwith msg
+
+[<Fact>]
+let ``antiConsensusGate does NOT count empty RootAuthority as a distinct root`` () =
+    // Degenerate/missing RootAuthority values must be filtered
+    // before counting distinct roots — otherwise an empty string
+    // would inflate the anti-consensus count and let a single-
+    // source cluster pass the gate.
+    let claims =
+        [ claimWithRoot "c1" "root-a"
+          claimWithRoot "c2" "" ]
+    match Veridicality.antiConsensusGate claims with
+    | Error _ -> ()
+    | Ok _ -> failwith "expected Error when the only 'second root' is empty"
+
+[<Fact>]
+let ``antiConsensusGate does NOT count whitespace RootAuthority as a distinct root`` () =
+    // Whitespace-only RootAuthority values are treated the same
+    // as empty — they don't count toward the distinct-root total.
+    let claims =
+        [ claimWithRoot "c1" "root-a"
+          claimWithRoot "c2" "   " ]
+    match Veridicality.antiConsensusGate claims with
+    | Error _ -> ()
+    | Ok _ -> failwith "expected Error when the only 'second root' is whitespace"
+
+[<Fact>]
+let ``antiConsensusGate skips empty RootAuthority but still passes on two valid roots`` () =
+    // Empty-root claims are silently skipped; remaining valid
+    // roots are counted. Two valid distinct roots → pass.
+    let claims =
+        [ claimWithRoot "c1" "root-a"
+          claimWithRoot "c2" ""
+          claimWithRoot "c3" "root-b" ]
+    match Veridicality.antiConsensusGate claims with
+    | Ok _ -> ()
+    | Error msg -> failwith $"expected Ok (two valid distinct roots), got Error: {msg}"