claude-gate (empty) → 1.0.0

raw patch · 23 files changed

+2634/−0 lines, 23 filesdep +aesondep +annotated-exceptiondep +base

Dependencies added: aeson, annotated-exception, base, bytestring, claude-gate, directory, filepath, hedgehog, optparse-applicative, safe-exceptions, tasty, tasty-hedgehog, tasty-hunit, text, typed-process

Files

• Changelog.md +1/−0
• LICENSE +21/−0
• app/Main.hs +59/−0
• claude-gate.cabal +142/−0
• src/Claude/Gate/Corpus.hs +85/−0
• src/Claude/Gate/Critique.hs +389/−0
• src/Claude/Gate/DiffRender.hs +49/−0
• src/Claude/Gate/Dumbify.hs +140/−0
• src/Claude/Gate/Edit.hs +91/−0
• src/Claude/Gate/EditStack.hs +70/−0
• src/Claude/Gate/FileContext.hs +37/−0
• src/Claude/Gate/GateConfig.hs +28/−0
• src/Claude/Gate/HookProtocol.hs +91/−0
• src/Claude/Gate/NestedClaude.hs +224/−0
• src/Claude/Gate/RecordEdit.hs +118/−0
• src/Claude/Gate/Repo.hs +109/−0
• src/Claude/Gate/ReviewPrompt.hs +105/−0
• src/Claude/Gate/RuleReview.hs +73/−0
• src/Claude/Gate/SpawnAnnotation.hs +30/−0
• src/Claude/Gate/StopGate.hs +67/−0
• src/Claude/Gate/Transcript.hs +135/−0
• src/Claude/Gate/TurnState.hs +184/−0
• test/Test.hs +386/−0

@@ -0,0 +1,1 @@+# claude-gate changelog

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2025 Jappie Klooster++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,59 @@+-- | The claude-gate executable: one binary, four subcommands.+--+-- Claude Code wires each hook to a subcommand in settings.json:+--   record     PostToolUse(Write|Edit|MultiEdit|NotebookEdit)+--   reset      UserPromptSubmit+--   stop-gate  Stop+--+-- The fourth, @critique@, is not wired to a hook: it runs ONLY the adversarial+-- critique phase against the same hook event on stdin, so the nested reviewer+-- call can be exercised and debugged in isolation (e.g. to see whether the+-- nested @claude@ authenticates and answers, rather than hanging) without the+-- dumbify and rule-review phases around it.+module Main (main) where++import Control.Monad (join)+import Claude.Gate.Critique (runCritique)+import Claude.Gate.HookProtocol (HookEvent (sessionId, transcriptPath), readHookEvent)+import Claude.Gate.RecordEdit (recordEdit)+import Claude.Gate.StopGate (runStopGate)+import Claude.Gate.TurnState (ensureStateDir, resetState, turnPaths)+import Options.Applicative++main :: IO ()+-- Each subcommand parses to the IO action for its hook, so execParser yields an+-- IO (IO ()); join runs the chosen action.+main = join (execParser (info (subcommands <**> helper) description))++description :: InfoMod a+description = fullDesc <> progDesc "Claude Code end-of-turn gate hooks (record, reset, stop-gate)"++-- | Each subcommand parses no options and yields the IO action for its hook.+subcommands :: Parser (IO ())+subcommands =+  subparser+    ( command "record" (info (pure recordEdit) (progDesc "PostToolUse: record an edit onto the review stack"))+        <> command "reset" (info (pure resetTurnState) (progDesc "UserPromptSubmit: wipe the previous turn's state"))+        <> command "stop-gate" (info (pure runStopGate) (progDesc "Stop: rule review, then verification"))+        <> command "critique" (info (pure runCritiqueOnly) (progDesc "Run only the adversarial critique phase (for debugging the nested reviewer)"))+    )++-- | Run the critique phase standalone against the hook event on stdin. This is+-- the same call 'runStopGate' makes for phase 1, lifted out of the phase chain+-- so the nested reviewer can be reproduced on its own. It reads the hook event,+-- prepares the turn state dir, and runs the critique against the live transcript+-- and the edits already recorded this turn.+runCritiqueOnly :: IO ()+runCritiqueOnly = do+  event <- readHookEvent+  paths <- turnPaths (sessionId event)+  ensureStateDir paths+  runCritique (sessionId event) (transcriptPath event) paths++-- | UserPromptSubmit: wipe the previous turn's review stack and verify-done+-- flag so they do not leak into the new turn.+resetTurnState :: IO ()+resetTurnState = do+  event <- readHookEvent+  paths <- turnPaths (sessionId event)+  resetState paths

@@ -0,0 +1,142 @@+cabal-version:      3.0++name:           claude-gate+version:        1.0.0+synopsis:       Hook gate that reviews and records edits from nested Claude Code sessions+description:+    A Claude Code hook-protocol gate. It intercepts edits made by nested Claude+    sessions, renders their diffs, tracks per-turn state, and drives the+    review, critique and dumbify passes that decide whether an edit is allowed+    through.+category:       Development+homepage:       https://github.com/jappeace/vibes#readme+bug-reports:    https://github.com/jappeace/vibes/issues+author:         Jappie Klooster+maintainer:     hi@jappie.me+copyright:      2026 Jappie Klooster+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-doc-files:+    Changelog.md++source-repository head+  type: git+  location: https://github.com/jappeace/vibes++-- Decision: -Werror lives behind a manual flag, default False. cabal check+-- rejects an unconditional -Werror (future GHCs add warnings that would break+-- the package), so the flag keeps `cabal check` green while CI and the nix+-- build still compile warning-clean by turning it on (see nix/hpkgs.nix and+-- cabal.project). Alternative considered: dropping -Werror entirely, rejected+-- because it would let warnings rot in.+flag werror+  description: Turn warnings into errors. Off by default; CI and the nix build enable it.+  default:     False+  manual:      True++common common-options+  default-extensions:+      EmptyCase+      FlexibleContexts+      FlexibleInstances+      InstanceSigs+      MultiParamTypeClasses+      LambdaCase+      MultiWayIf+      NamedFieldPuns+      TupleSections+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      GeneralizedNewtypeDeriving+      StandaloneDeriving+      OverloadedStrings+      ScopedTypeVariables+      TypeApplications+      NumericUnderscores+      ImportQualifiedPost++  ghc-options:+    -O2 -Wall -Wincomplete-uni-patterns+    -Wincomplete-record-updates -Widentities -Wredundant-constraints+    -Wcpp-undef -fwarn-tabs -Wpartial-fields+    -fdefer-diagnostics -Wunused-packages+    -fno-omit-yields++  if flag(werror)+    ghc-options: -Werror++  build-depends:+      base >=4.9.1.0 && <4.22++  default-language: Haskell2010++library+  import: common-options+  exposed-modules:+      Claude.Gate.HookProtocol+      Claude.Gate.Edit+      Claude.Gate.TurnState+      Claude.Gate.RecordEdit+      Claude.Gate.DiffRender+      Claude.Gate.Corpus+      Claude.Gate.FileContext+      Claude.Gate.Repo+      Claude.Gate.SpawnAnnotation+      Claude.Gate.GateConfig+      Claude.Gate.EditStack+      Claude.Gate.NestedClaude+      Claude.Gate.Transcript+      Claude.Gate.ReviewPrompt+      Claude.Gate.Dumbify+      Claude.Gate.Critique+      Claude.Gate.RuleReview+      Claude.Gate.StopGate+  other-modules:+      Paths_claude_gate+  autogen-modules:+      Paths_claude_gate+  hs-source-dirs:+      src+  build-depends:+      aeson               < 2.3,+      annotated-exception < 0.4,+      bytestring          < 0.13,+      text                < 2.2,+      directory           < 1.4,+      filepath            < 1.6,+      typed-process       < 0.3,+      safe-exceptions     < 0.2++executable claude-gate+  import: common-options+  main-is: Main.hs+  hs-source-dirs:+      app+  build-depends:+      claude-gate,+      optparse-applicative < 0.19+  ghc-options: -Wno-unused-packages -threaded -rtsopts "-with-rtsopts=-N"++test-suite unit+  import: common-options+  type: exitcode-stdio-1.0+  main-is: Test.hs+  ghc-options: -Wno-unused-packages -threaded -rtsopts "-with-rtsopts=-N"+  hs-source-dirs:+      test+  build-depends:+      tasty          < 1.6,+      tasty-hunit    < 0.11,+      tasty-hedgehog < 1.5,+      hedgehog       < 1.6,+      claude-gate,+      aeson          < 2.3,+      bytestring     < 0.13,+      text           < 2.2,+      directory      < 1.4,+      filepath       < 1.6

@@ -0,0 +1,85 @@+-- | Assemble the rules corpus the reviewer is checked against.+--+-- The corpus is the global CLAUDE.md, the project CLAUDE.md (if it is a+-- different file), and the SKILL.md of each skill whose rules could apply to+-- the file types touched this turn. Attaching every skill was almost all of the+-- old prompt and pure latency, so only language skills matching the touched+-- extensions are selected; the two CLAUDE.md files are always included.+module Claude.Gate.Corpus+  ( selectSkills+  , buildCorpus+  ) where++import Data.List (isSuffixOf, nub, sort)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.IO qualified as TextIO+import Claude.Gate.Repo (gitRoot)+import System.Directory (doesFileExist, getHomeDirectory)+import System.FilePath (takeDirectory, (</>))++-- | Skill names whose rules are relevant to the touched file types, sorted and+-- deduplicated. Pure so the mapping can be tested directly.+selectSkills :: [FilePath] -> [Text]+selectSkills = sort . nub . concatMap skillsForPath++skillsForPath :: FilePath -> [Text]+skillsForPath path+  | any (`isSuffixOf` path) haskellExtensions = haskellSkills+  | ".nix" `isSuffixOf` path = nixSkills+  | otherwise = []++haskellExtensions :: [FilePath]+haskellExtensions = [".hs", ".lhs", ".hsig", ".cabal"]++haskellSkills :: [Text]+haskellSkills =+  ["haskell-project", "haskell-backpack", "unwitch-conversions", "verify-test-fails", "error-messages"]++nixSkills :: [Text]+nixSkills = ["nix", "ci-nix"]++-- | Build the corpus text for the files touched this turn. Reads the two+-- CLAUDE.md files and the selected skills from disk.+buildCorpus :: [FilePath] -> IO Text+buildCorpus touchedPaths = do+  home <- getHomeDirectory+  let globalClaude = home </> ".claude" </> "CLAUDE.md"+  globalSection <- fileSection ("=== " <> Text.pack globalClaude <> " ===") globalClaude+  projectSection <- projectClaudeSection globalClaude touchedPaths+  skillSections <- mapM (skillSection home) (selectSkills touchedPaths)+  pure (Text.concat (globalSection <> projectSection <> concat skillSections))++-- | The project CLAUDE.md, resolved from the git root of the first touched+-- file, included only if it exists and is a different file from the global one.+projectClaudeSection :: FilePath -> [FilePath] -> IO [Text]+projectClaudeSection globalClaude touchedPaths = case touchedPaths of+  [] -> pure []+  (firstFile : _) -> do+    maybeRoot <- gitRoot (takeDirectory firstFile)+    case maybeRoot of+      Nothing -> pure []+      Just root ->+        let projectClaude = root </> "CLAUDE.md"+         in if projectClaude == globalClaude+              then pure []+              else fileSection ("=== " <> Text.pack projectClaude <> " ===") projectClaude++skillSection :: FilePath -> Text -> IO [Text]+skillSection home skillName =+  fileSection+    ("=== skill: " <> skillName <> " ===")+    (home </> ".claude" </> "skills" </> Text.unpack skillName </> "SKILL.md")++-- | A labelled section for a file, or nothing if the file is absent. Absence is+-- expected (not every skill or project has the file), so it is a legitimate+-- empty result rather than a swallowed error.+fileSection :: Text -> FilePath -> IO [Text]+fileSection heading path = do+  present <- doesFileExist path+  if present+    then do+      body <- TextIO.readFile path+      pure ["\n" <> heading <> "\n" <> body]+    else pure []+

@@ -0,0 +1,389 @@+-- | Phase 1: adversarial critique.+--+-- A fresh independent critic (default Opus, full tools and MCP) tries to PROVE+-- THE WORKER WRONG about both the code it changed and the claims it made this+-- turn, by running tests and commands and searching authoritative sources. It+-- also flags any factual claim it can find no supporting source for, since an+-- assertion the worker cannot back is itself evidence. The prompt is anchored to+-- ground truth (the round number and the repo's real commit history) so the+-- critic judges the current state and maps CI runs to commits by sha rather than+-- reconstructing the order from run timestamps. A substantiated+-- CHALLENGE blocks the turn. The critic is an advisor, not a wall:+-- exactly like dumbify, convergence is observed via the edit stack, so a turn+-- with no new edits (the worker stood by its work) is a shrug that ends the+-- debate. Runs after dumbify (so it verifies the canary's refactor too) and+-- before rule review (so its fixes land on the stack and get rule-checked).+--+-- The claims are read from the transcript by POLLING ('readTurnClaims'):+-- Claude Code can fire the Stop hook before the turn's final assistant message+-- is flushed to the transcript file, and a single immediate read loses that+-- race. A turn that still offers neither claims nor edits after polling is an+-- EMPTY DOSSIER and fails loudly ('classifyDossier'): a critic spawned with+-- nothing to refute can only answer OK, and recording that OK as approval+-- would be a false green stamp.+module Claude.Gate.Critique+  ( runCritique+  , critiqueDiffBlock+  , recentClaims+  , critiqueAnchor+  , retryWhileEmpty+  , classifyDossier+  , CritiqueDossier(..)+  , EditPresence(..)+  , RoundBudget(..)+  ) where++import Control.Concurrent (threadDelay)+import Control.Monad (when)+import Data.Maybe (fromMaybe, isJust)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.IO qualified as TextIO+import Claude.Gate.DiffRender (renderDiffs)+import Claude.Gate.EditStack (readEdits, stackFilePaths)+import Claude.Gate.GateConfig (envInt, envStr, phaseDisabled)+import Claude.Gate.HookProtocol (BlockReason (BlockReason), blockAndExit)+import Claude.Gate.NestedClaude+  ( GateFailure (GateFailure, failureBlockReason, failureHeadline, failureLogBody, failureUserNotice)+  , NestedResult (NestedBroken, NestedOutput)+  , Reviewer (Reviewer)+  , runNested+  , surfaceGateFailure+  , surfaceNestedFailure+  )+import Claude.Gate.Repo (commitHistory, repoForFilesOrCwd)+import Claude.Gate.ReviewPrompt (maxDiffPromptChars)+import Claude.Gate.Transcript (turnAssistantText)+import Claude.Gate.TurnState+  ( TurnPaths (critiqueApproved, critiqueBroke, critiqueDone, critiqueEditmark, critiquePrev, critiqueRound, reviewStack)+  , fileNonEmpty+  , flagExists+  , readCounter+  , readMark+  , stackLineCount+  , writeCounter+  , writeFlag+  )+import System.Directory (doesFileExist, findExecutable)++-- | The critic refutes both the code and the claims, so it runs on EVERY turn,+-- including conversational ones with no edits. A shrug (no new edits since the+-- last challenge) ends the debate within the turn.+maxCritiqueClaimChars :: Int+maxCritiqueClaimChars = 16_000++-- | Keep the most recent claims within the character budget. The worker's prose+-- accumulates across a turn's critique rounds (a block is not a turn boundary,+-- so 'turnAssistantText' keeps growing), and it is chronological. Trimming from+-- the FRONT would hand the critic the OLDEST claims (round 1, the first CI runs)+-- and drop the newest (the current HEAD's claims), so the critic judges stale+-- claims and misattributes runs. Trim from the end so the current round survives.+recentClaims :: Int -> Text -> Text+recentClaims = Text.takeEnd++-- | Which critique round this is, and the cap it counts against. The two travel+-- together through the anchor, the block reason, and 'handleChallenge'; bundling+-- them keeps the round and its cap from being swapped at a call site (both are+-- 'Int'), and threading one value keeps the number the critic is told identical+-- to the number the worker is told.+data RoundBudget = RoundBudget+  { thisRound :: Int+  , maxRounds :: Int+  }++-- | Whether this turn recorded file edits onto the review stack. The fact+-- travels through the whole phase (mark computation, dossier classification,+-- diff rendering), so it gets named constructors rather than a bare Bool.+data EditPresence = EditsRecorded | NoEditsRecorded+  deriving stock (Eq, Show)++editPresence :: TurnPaths -> IO EditPresence+editPresence paths = do+  stackNonEmpty <- fileNonEmpty (reviewStack paths)+  pure (if stackNonEmpty then EditsRecorded else NoEditsRecorded)++runCritique :: Text -> Maybe FilePath -> TurnPaths -> IO ()+runCritique session transcript paths = do+  disabled <- phaseDisabled "CLAUDE_SKIP_CRITIQUE"+  done <- flagExists (critiqueDone paths)+  claudeAvailable <- isJust <$> findExecutable "claude"+  when (not disabled && not done && claudeAvailable) $ do+    edits <- editPresence paths+    currentMark <- case edits of+      EditsRecorded -> stackLineCount (reviewStack paths)+      NoEditsRecorded -> pure 0+    previousMark <- readMark (critiqueEditmark paths)+    if previousMark == Just currentMark+      then+        -- The critic already challenged this turn and the worker made no new+        -- edits since: it stood by its work. A shrug ends the debate.+        writeFlag (critiqueDone paths)+      else runCritiqueRound session transcript paths edits currentMark++runCritiqueRound :: Text -> Maybe FilePath -> TurnPaths -> EditPresence -> Int -> IO ()+runCritiqueRound session transcript paths edits currentMark = do+  claims <- recentClaims maxCritiqueClaimChars <$> readTurnClaims transcript+  case classifyDossier claims edits of+    EmptyDossier -> surfaceEmptyDossier session transcript paths+    DossierReady -> runCriticOnDossier session paths edits currentMark claims++-- Decision: poll the transcript for the turn's claims instead of reading it+-- once. Claude Code fires the Stop hook before it has flushed the turn's final+-- assistant message to the transcript file (observed lag ~0.7s), so a single+-- immediate read handed the critic an empty dossier it could only wave OK at.+-- Alternatives considered: one fixed sleep before reading (pays the full delay+-- on every turn, even when the flush already happened) and filesystem watching+-- (a new dependency for a bounded, sub-second race). Polling costs nothing on+-- the common path because the first non-blank read returns immediately.+claimsFlushAttempts :: Int+claimsFlushAttempts = 5++-- | The pause between transcript polls. The observed flush lag is well under a+-- second, so the second attempt normally wins the race.+claimsFlushDelayMicroseconds :: Int+claimsFlushDelayMicroseconds = 1_000_000++-- | The worker's prose for this turn, polled per the Decision above. A Stop+-- event without a transcript path yields empty claims immediately; whether an+-- empty result is fatal is decided by 'classifyDossier', not here.+readTurnClaims :: Maybe FilePath -> IO Text+readTurnClaims Nothing = pure ""+readTurnClaims (Just path) =+  retryWhileEmpty claimsFlushAttempts claimsFlushDelayMicroseconds (turnAssistantText path)++-- | Run the read until it yields non-blank text, up to the attempt budget,+-- sleeping the given microseconds between attempts. The final attempt's result+-- is returned as-is (possibly still blank); the caller decides what that means.+retryWhileEmpty :: Int -> Int -> IO Text -> IO Text+retryWhileEmpty attempts delayMicroseconds readAction = do+  result <- readAction+  if not (Text.null (Text.strip result)) || attempts <= 1+    then pure result+    else do+      threadDelay delayMicroseconds+      retryWhileEmpty (attempts - 1) delayMicroseconds readAction++-- | Whether the turn gives the critic anything to refute. Claims that are all+-- whitespace count as absent, exactly like a missing transcript.+data CritiqueDossier = EmptyDossier | DossierReady+  deriving stock (Eq, Show)++classifyDossier :: Text -> EditPresence -> CritiqueDossier+classifyDossier claims edits = case edits of+  EditsRecorded -> DossierReady+  NoEditsRecorded ->+    if Text.null (Text.strip claims)+      then EmptyDossier+      else DossierReady++-- | Fail loudly on an empty dossier, mirroring 'surfaceNestedFailure': log it+-- durably and block the Stop once per turn with a user-visible notice. On a+-- repeat occurrence within the turn the phase gives up WITHOUT writing the+-- approved flag, so the missing critique is never recorded as a clean pass.+surfaceEmptyDossier :: Text -> Maybe FilePath -> TurnPaths -> IO ()+surfaceEmptyDossier session transcript paths = do+  surfaceGateFailure session (emptyDossierFailure transcript) (critiqueBroke paths)+  writeFlag (critiqueDone paths)++-- | The empty dossier described for 'surfaceGateFailure'. The log records the+-- transcript path the hook event carried (or its absence), which is the first+-- thing to check when debugging why the claims came up empty.+emptyDossierFailure :: Maybe FilePath -> GateFailure+emptyDossierFailure transcript =+  GateFailure+    { failureHeadline = "critique got an empty dossier (no claims, no edits)"+    , failureLogBody = "transcript_path=" <> maybe "(absent from Stop event)" Text.pack transcript+    , failureBlockReason = emptyDossierReason+    , failureUserNotice = emptyDossierNotice+    }++emptyDossierReason :: Text+emptyDossierReason =+  "GATE INPUT FAILURE in the critique phase: even after polling the transcript, \+  \this turn shows no assistant text and has no recorded edits, so there was \+  \nothing to hand the critic and this turn was NOT critiqued. An empty dossier \+  \is never a clean pass. Likely causes: the Stop event carried no \+  \transcript_path, or the transcript flush lagged past the polling window. \+  \This warning fires once per turn; you may continue after acknowledging it."++emptyDossierNotice :: Text+emptyDossierNotice =+  "claude-gate: the critique phase found no claims in the transcript and no \+  \edits even after polling, so this turn was NOT critiqued. Details in the \+  \gate failure log ($CLAUDE_GATE_FAILURE_LOG, default ~/.claude/gate-failures.log)."++-- | Spawn the nested critic on a non-empty dossier and act on its verdict.+runCriticOnDossier :: Text -> TurnPaths -> EditPresence -> Int -> Text -> IO ()+runCriticOnDossier session paths edits currentMark claims = do+  files <- stackFilePaths (reviewStack paths)+  diffs <- critiqueDiffBlock edits (reviewStack paths)+  repo <- repoForFilesOrCwd files+  history <- maybe (pure Nothing) commitHistory repo+  previous <- readPreviousChallenges (critiquePrev paths)+  previousRound <- readCounter (critiqueRound paths)+  roundCap <- envInt "CLAUDE_CRITIQUE_MAX_ROUNDS" 2+  timeoutSecs <- envInt "CLAUDE_CRITIQUE_TIMEOUT" 1200+  model <- envStr "CLAUDE_CRITIQUE_MODEL" "claude-opus-4-8"+  -- The round is computed once and threaded to both the prompt and the block, so+  -- the critic is told the same round the worker is (the nested critic runs with+  -- the critique phase disabled, so it never bumps this counter mid-round).+  let budget = RoundBudget { thisRound = previousRound + 1, maxRounds = roundCap }+      reviewer = Reviewer model False timeoutSecs repo+      prompt = critiquePrompt (critiqueAnchor budget history) previous claims diffs+  result <- runNested reviewer prompt+  case result of+    NestedBroken exitCode emptyOut stderrText -> do+      surfaceNestedFailure session "critique" model exitCode emptyOut stderrText (critiqueBroke paths)+      writeFlag (critiqueDone paths)+    NestedOutput output ->+      if hasChallenge output+        then handleChallenge paths model output currentMark budget+        else do+          -- Clean OK: critique is done and this turn cleared.+          writeFlag (critiqueDone paths)+          writeFlag (critiqueApproved paths)++handleChallenge :: TurnPaths -> Text -> Text -> Int -> RoundBudget -> IO ()+handleChallenge paths model output currentMark budget = do+  writeCounter (critiqueRound paths) (thisRound budget)+  if thisRound budget <= maxRounds budget+    then do+      -- Record this challenge and the stack size it was based on. No new edits+      -- before the next Stop reads as a shrug; new edits earn a fresh critique.+      TextIO.writeFile (critiquePrev paths) output+      writeCounter (critiqueEditmark paths) currentMark+      blockAndExit (BlockReason (critiqueBlockReason model budget output))+    else+      -- Round cap reached: stop debating without marking approved (the concern+      -- is unresolved), and let rule review proceed.+      writeFlag (critiqueDone paths)++-- | The diff block shown to the critic. Only a turn that recorded edits has a+-- review stack on disk; a conversational turn has none, and reading the absent+-- stack would crash this phase before the critic runs (the critic is meant to+-- run on every turn, edits or not). So read the stack only when there are edits,+-- and otherwise hand the critic the explicit no-edits placeholder.+critiqueDiffBlock :: EditPresence -> FilePath -> IO Text+critiqueDiffBlock edits stackPath = case edits of+  EditsRecorded -> renderDiffs <$> readEdits stackPath+  NoEditsRecorded -> pure "(no file edits this turn)"++readPreviousChallenges :: FilePath -> IO (Maybe Text)+readPreviousChallenges path = do+  present <- doesFileExist path+  if present then Just <$> TextIO.readFile path else pure Nothing++hasChallenge :: Text -> Bool+hasChallenge output = any ("CHALLENGE:" `Text.isPrefixOf`) (Text.lines output)++critiquePrompt :: Text -> Maybe Text -> Text -> Text -> Text+critiquePrompt anchor previous claims diffs =+  Text.concat+    [ critiqueHeader+    , "\n=== GROUND TRUTH (authoritative; use this, do not reconstruct it from timestamps) ===\n"+    , anchor+    , maybe "" ("\n=== YOUR PREVIOUS CHALLENGES (the worker has since responded and may have changed code or claims; only re-raise what still holds and you can still substantiate) ===\n" <>) previous+    , "\n=== WHAT THE WORKER CLAIMS THIS TURN ===\n"+    , if Text.null claims then "(no transcript claims available)\n" else claims <> "\n"+    , "\n=== CODE CHANGES THIS TURN (may be empty) ===\n"+    , Text.take maxDiffPromptChars diffs+    ]++-- | The ground-truth anchor: which round this critique is, and the repo's real+-- commit history. A critic with full tools cross-checks external CI runs; stating+-- the round stops it renumbering the debate from the worker's prose, and the+-- commit history (HEAD first, with each commit's timestamp) lets it map a run to+-- a commit by sha instead of inferring the order from run start times. A missing+-- history is rendered as an explicit placeholder, never dropped silently.+critiqueAnchor :: RoundBudget -> Maybe Text -> Text+critiqueAnchor RoundBudget { thisRound, maxRounds } history =+  Text.concat+    [ "This is critique round ", Text.pack (show thisRound), " of at most "+    , Text.pack (show maxRounds), " this turn. The worker's prose this turn may recount"+    , " earlier rounds; judge the CURRENT state and keep this round numbering, do not"+    , " renumber the debate.\n"+    , "Repo commit history, newest first, one commit per line as"+    , " \"<full-sha> <committer-ISO-8601-date> <subject>\"; the FIRST line is HEAD."+    , " Map any CI run to a commit by its sha (a run can start on an older HEAD and"+    , " finish after a newer commit exists, so run start time is not commit order):\n"+    , fromMaybe "(git commit history unavailable)" history+    , "\n"+    ]++critiqueHeader :: Text+critiqueHeader =+  "You are an adversarial correctness critic. A different, larger Claude Code agent\n\+  \just finished a turn. Below are the code changes it made (possibly none) and the\n\+  \claims it made about what it did or found. Your single job is to PROVE THE WORKER\n\+  \WRONG, by any means necessary. Assume both the code and the claims are wrong until\n\+  \you have evidence otherwise. A factual claim you can neither reproduce nor find any\n\+  \authoritative source for does not earn the benefit of the doubt: an assertion the\n\+  \worker cannot back is a weakness to surface, not something to wave through.\n\+  \\n\+  \Use every tool you have to gather counter-evidence:\n\+  \\n\+  \- For code: write and run tests, run the type-checker/build, run a one-off\n\+  \  command. Look for logic errors that still typecheck (wrong boundaries, inverted\n\+  \  conditions, unhandled cases, off-by-one, broken invariants, missing coverage)\n\+  \  and ways the change breaks the rest of the codebase.\n\+  \- For prose/claims: check them against reality. Run the command the worker says\n\+  \  it ran. Search the web and read authoritative sources, both to contradict a\n\+  \  factual claim and to look for the support the worker never cited. A claim of\n\+  \  \"I verified X\" that was never actually demonstrated is itself suspect. When\n\+  \  the worker states a checkable fact as established (attributing a view to\n\+  \  someone, quoting a spec, describing what a tool or library does), actively try\n\+  \  to find the authoritative source that backs it.\n\+  \\n\+  \Rank your counter-evidence by authority, and gather as much as you can:\n\+  \\n\+  \- Strongest: a failing test, a non-zero exit code, a command you ran and its\n\+  \  output. A machine cannot misreport these.\n\+  \- Good: an authoritative external source (documentation, a standard, a primary\n\+  \  source) that contradicts the claim. Cite the URL and quote the line.\n\+  \- Also evidence: the ABSENCE of a source. If the worker asserts a checkable fact\n\+  \  as established and you genuinely search for it (authoritative docs, the primary\n\+  \  source, the web) and find nothing that supports it, report that. Your evidence\n\+  \  is the search itself: name the queries you ran and the sources you checked, show\n\+  \  they turned up nothing backing the claim, and ask why the worker is asserting it.\n\+  \  Absence only counts once you have actually looked, so \"I did not look\" is not\n\+  \  \"no source exists\". This is for facts presented as established, not for the\n\+  \  worker's own clearly-labelled opinions, recommendations, or plans.\n\+  \- More independent counter-evidence is stronger than one: a test AND a source\n\+  \  beats either alone.\n\+  \- Not evidence: your own opinion or doubt with no search behind it. If you have\n\+  \  neither a test, a command, a cited source, nor a documented failed search, DROP\n\+  \  it.\n\+  \\n\+  \Do not add files to the repository under review; use /tmp for scratch\n\+  \reproducers. Do not flag style, naming, or \"could be cleaner\".\n\+  \\n\+  \Response format, no markdown:\n\+  \\n\+  \- If you cannot prove anything wrong: respond with the single line OK.\n\+  \- Otherwise, one block per item you are challenging:\n\+  \\n\+  \    CHALLENGE: <one-sentence summary of what is wrong or unsupported>\n\+  \    CLAIM: <the worker claim or code behaviour you are challenging>\n\+  \    EVIDENCE: <for a refutation: the test/command you ran and its output, and/or a\n\+  \              source URL with the contradicting quote. For an unsourced claim: the\n\+  \              searches you ran, e.g. \"I searched X and Y and found nothing that\n\+  \              supports Z\", listing the queries and sources checked. Concrete and\n\+  \              reproducible either way.>\n\+  \    SEVERITY: blocker | major | minor\n\+  \\n\+  \Separate blocks with a blank line."++critiqueBlockReason :: Text -> RoundBudget -> Text -> Text+critiqueBlockReason model RoundBudget { thisRound, maxRounds } output =+  Text.concat+    [ "A fresh adversarial ", model, " critic tried to prove your work wrong this turn, "+    , "using tests and sources, and produced the counter-evidence below (round "+    , Text.pack (show thisRound), " of ", Text.pack (show maxRounds)+    , "). This critic is an advisor, not a wall: you are the final judge. For each challenge, either:\n"+    , "  1. Agree: fix the code, correct the claim, or (for an unsourced factual claim) cite a source or retract it. Code fixes are re-critiqued and rule-checked automatically.\n"+    , "  2. Disagree: rebut it with STRONGER evidence than the critic brought (run the test yourself, cite a better source), or simply stand by your work. Do not just assert.\n"+    , "Engage every challenge, then decide. If you make no further edits, the gate takes that as your considered judgement and moves on (a shrug is allowed); it does not re-litigate. Set CLAUDE_SKIP_CRITIQUE=1 to disable this gate.\n"+    , "\n--- critic challenges ---\n"+    , output+    , "\n--- end critic challenges ---"+    ]

@@ -0,0 +1,49 @@+-- | Render recorded edits as labelled diff blocks for the reviewer prompt.+--+-- Showing the diff (the old and new text) rather than the whole file keeps the+-- prompt small and points the reviewer at exactly the text the agent wrote.+-- The reviewer is told to only flag text in a "with"/"new content" section.+module Claude.Gate.DiffRender+  ( renderDiffs+  ) where++import Data.Text (Text)+import Data.Text qualified as Text+import Claude.Gate.Edit (Edit (..), Replacement (..))++-- | Render a turn's edits as one labelled block per edit, in order.+renderDiffs :: [Edit] -> Text+renderDiffs = Text.concat . map renderOne++renderOne :: Edit -> Text+renderOne edit =+  Text.concat+    [ "=== FILE: ", Text.pack (editPath edit), " (via ", toolLabel edit, ") ===\n"+    , editBody edit+    , "\n"+    ]++editPath :: Edit -> FilePath+editPath = \case+  SingleEdit path _ -> path+  MultiEditFile path _ -> path+  WriteFileContent path _ -> path+  NotebookCellSource path _ -> path++toolLabel :: Edit -> Text+toolLabel = \case+  SingleEdit _ _ -> "Edit"+  MultiEditFile _ _ -> "MultiEdit"+  WriteFileContent _ _ -> "Write"+  NotebookCellSource _ _ -> "NotebookEdit"++editBody :: Edit -> Text+editBody = \case+  SingleEdit _ replacement -> renderReplacement replacement+  MultiEditFile _ replacements -> Text.intercalate "\n" (map renderReplacement replacements)+  WriteFileContent _ content -> "--- new content ---\n" <> content+  NotebookCellSource _ source -> "--- new source ---\n" <> source++renderReplacement :: Replacement -> Text+renderReplacement (Replacement old new) =+  Text.concat ["--- replaced ---\n", old, "\n--- with ---\n", new]

@@ -0,0 +1,140 @@+-- | Phase 0: the dumbify complexity canary.+--+-- For code-touching turns, a small model (Haiku) reads the changed code with the+-- full files as context and explains it; the larger main-loop model judges that+-- explanation. If the canary could not work out what the code DOES, the code is+-- too complex and the larger model simplifies it (behaviour-preserving), which+-- re-triggers the canary. Convergence is OBSERVED via the edit stack: no new+-- edits since the last explanation means the larger model accepted it. Bounded+-- by CLAUDE_DUMBIFY_MAX_ROUNDS. Runs first so the cheap canary shapes the code+-- before the expensive critic verifies the result.+module Claude.Gate.Dumbify+  ( runDumbify+  ) where++import Control.Monad (when)+import Data.Maybe (isJust)+import Data.Text (Text)+import Data.Text qualified as Text+import Claude.Gate.DiffRender (renderDiffs)+import Claude.Gate.EditStack (readEdits, stackFilePaths, stackHasCode)+import Claude.Gate.FileContext (renderFullFiles)+import Claude.Gate.GateConfig (envInt, envStr, phaseDisabled)+import Claude.Gate.HookProtocol (BlockReason (BlockReason), blockAndExit)+import Claude.Gate.NestedClaude (NestedResult (NestedBroken, NestedOutput), Reviewer (Reviewer), runNested, surfaceNestedFailure)+import Claude.Gate.Repo (repoForFiles)+import Claude.Gate.ReviewPrompt (maxDiffPromptChars)+import Claude.Gate.TurnState+  ( TurnPaths (dumbifyApproved, dumbifyBroke, dumbifyDone, dumbifyEditmark, dumbifyRound, reviewStack)+  , fileNonEmpty+  , flagExists+  , readCounter+  , readMark+  , stackLineCount+  , writeCounter+  , writeFlag+  )+import System.Directory (findExecutable)++-- | Run Phase 0. Fires only for a code-touching turn whose stack has not yet+-- converged, and only when claude is available.+runDumbify :: Text -> TurnPaths -> IO ()+runDumbify session paths = do+  disabled <- phaseDisabled "CLAUDE_SKIP_DUMBIFY"+  done <- flagExists (dumbifyDone paths)+  stackReady <- fileNonEmpty (reviewStack paths)+  hasCode <- stackHasCode (reviewStack paths)+  claudeAvailable <- isJust <$> findExecutable "claude"+  when (not disabled && not done && stackReady && hasCode && claudeAvailable) $ do+    currentMark <- stackLineCount (reviewStack paths)+    previousMark <- readMark (dumbifyEditmark paths)+    if previousMark == Just currentMark+      then do+        -- No new edits since the last explanation: the larger model judged the+        -- explanation correct and chose not to simplify. Accept and move on.+        writeFlag (dumbifyDone paths)+        writeFlag (dumbifyApproved paths)+      else do+        previousRound <- readCounter (dumbifyRound paths)+        maxRounds <- envInt "CLAUDE_DUMBIFY_MAX_ROUNDS" 2+        let thisRound = previousRound + 1+        if thisRound > maxRounds+          then writeFlag (dumbifyDone paths)+          else runDumbifyRound session paths currentMark thisRound maxRounds++runDumbifyRound :: Text -> TurnPaths -> Int -> Int -> Int -> IO ()+runDumbifyRound session paths currentMark thisRound maxRounds = do+  files <- stackFilePaths (reviewStack paths)+  edits <- readEdits (reviewStack paths)+  fullFiles <- renderFullFiles files+  repo <- repoForFiles files+  timeoutSecs <- envInt "CLAUDE_DUMBIFY_TIMEOUT" 300+  model <- envStr "CLAUDE_DUMBIFY_MODEL" "claude-haiku-4-5"+  let reviewer = Reviewer model True timeoutSecs repo+      prompt = dumbifyPrompt (renderDiffs edits) fullFiles+  result <- runNested reviewer prompt+  case result of+    NestedBroken exitCode emptyOut stderrText -> do+      surfaceNestedFailure session "dumbify canary" model exitCode emptyOut stderrText (dumbifyBroke paths)+      writeFlag (dumbifyDone paths)+    NestedOutput output -> do+      -- Record the round and the stack size this explanation was based on, so the+      -- next Stop can tell whether the larger model simplified.+      writeCounter (dumbifyRound paths) thisRound+      writeCounter (dumbifyEditmark paths) currentMark+      blockAndExit (BlockReason (dumbifyBlockReason model thisRound maxRounds output))++dumbifyPrompt :: Text -> Text -> Text+dumbifyPrompt renderedDiffs fullFiles =+  Text.concat+    [ dumbifyHeader+    , "\n=== DIFFS JUST APPLIED THIS TURN ===\n"+    , Text.take maxDiffPromptChars renderedDiffs+    , "\n=== FULL CURRENT CONTENTS OF THE TOUCHED FILES (context: definitions the diffs reference live here) ===\n"+    , fullFiles+    ]++dumbifyHeader :: Text+dumbifyHeader =+  "You are a complexity canary. You are a small model reading code a larger agent\n\+  \just wrote, with no explanation from its author. Your job is to test whether the\n\+  \CHANGED code is understandable.\n\+  \\n\+  \You are given two things below: the diffs applied this turn, and the FULL current\n\+  \contents of each file they touched. Use the full file as context. A definition,\n\+  \variable, or helper that the diff references but that lives elsewhere in the file\n\+  \is available to you, so \"I can't see where X is defined\" is NOT a valid confusion\n\+  \unless X is genuinely absent from the file.\n\+  \\n\+  \For each function or section in the diffs, explain in your own words:\n\+  \- what it does,\n\+  \- what its inputs mean and what it returns,\n\+  \- and any concern that makes it hard to follow. Label each concern:\n\+  \    BLOCKS       - you could not work out what the changed code actually does.\n\+  \    NICE-TO-HAVE - you understood it, but a comment or clearer name would help.\n\+  \\n\+  \Rules:\n\+  \- Judge from the diffs plus the full files shown and anything else you can read in\n\+  \  the repository. Nobody will explain it to you; that is the point.\n\+  \- Be honest. If something genuinely stops you understanding the behaviour, say so\n\+  \  plainly and label it BLOCKS. Hedging (\"I think\", \"probably\", \"I'm not sure\")\n\+  \  about what the code DOES is itself a BLOCKS signal worth stating outright.\n\+  \- Do NOT report code outside this turn's change (untouched surrounding functions,\n\+  \  the harness/hook protocol that consumes this script's output, the build system)\n\+  \  as confusion. That is context, not the work under review.\n\+  \- Do not suggest fixes. Just explain, and label each concern BLOCKS or NICE-TO-HAVE."++dumbifyBlockReason :: Text -> Int -> Int -> Text -> Text+dumbifyBlockReason model thisRound maxRounds output =+  Text.concat+    [ "A ", model, " model (a small 'complexity canary') read the code you changed this turn, "+    , "with the full files as context, and explained it as follows (round "+    , Text.pack (show thisRound), " of ", Text.pack (show maxRounds)+    , "). You are the larger model and the final judge. Weigh its explanation:\n"+    , "  1. If it could NOT work out what the changed code DOES (a BLOCKS concern, a misread, or hedging about behaviour), the code is too complex. Apply a behaviour-preserving simplification (split a large dispatch into named functions, bundle threaded parameters into a record, add a domain-bridging comment, extract a capturing where-block). Your edits trigger a re-explanation. Do NOT change behaviour.\n"+    , "  2. If it understood the behaviour correctly, make no change and say so; the gate moves on. A NICE-TO-HAVE request for more comments when it already understood is advisory: weigh it, but you may decline and proceed rather than pile on prose.\n"+    , "Set CLAUDE_SKIP_DUMBIFY=1 to disable this gate.\n"+    , "\n--- canary explanation ---\n"+    , output+    , "\n--- end canary explanation ---"+    ]

@@ -0,0 +1,91 @@+-- | A single file mutation recorded during a turn.+--+-- The PostToolUse hook only fires for the four edit tools (the matcher in+-- settings.json is @Write|Edit|MultiEdit|NotebookEdit@), so those four+-- constructors are the complete set: there is no "unknown tool" case to fall+-- back on. Each edit is persisted as one JSON line on the review stack and read+-- back at Stop time to reconstruct the diff for the reviewer.+module Claude.Gate.Edit+  ( Edit(..)+  , Replacement(..)+  , editFilePath+  , parseEditFromTool+  ) where++import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value, object, withObject, (.:), (.=))+import Data.Aeson.Types qualified as Aeson (Parser, parseEither)+import Data.Text (Text)++-- | One old/new text pair, as carried by Edit and each element of MultiEdit.+data Replacement = Replacement+  { replacedText :: Text+  , replacementText :: Text+  }+  deriving stock (Eq, Show)++instance FromJSON Replacement where+  parseJSON :: Value -> Aeson.Parser Replacement+  parseJSON = withObject "Replacement" $ \object' ->+    Replacement+      <$> object' .: "old_string"+      <*> object' .: "new_string"++-- | A recorded edit, one constructor per edit tool the hook fires for.+data Edit+  = SingleEdit FilePath Replacement+  | MultiEditFile FilePath [Replacement]+  | WriteFileContent FilePath Text+  | NotebookCellSource FilePath Text+  deriving stock (Eq, Show)++editFilePath :: Edit -> FilePath+editFilePath = \case+  SingleEdit path _ -> path+  MultiEditFile path _ -> path+  WriteFileContent path _ -> path+  NotebookCellSource path _ -> path++-- | Parse an edit from a PostToolUse payload's tool name and tool_input. The+-- tool name selects the shape; an unexpected name means the settings.json+-- matcher and this code disagree, which is a bug we surface loudly rather than+-- silently drop.+parseEditFromTool :: Text -> Value -> Either String Edit+parseEditFromTool tool = Aeson.parseEither (editParser tool)++editParser :: Text -> Value -> Aeson.Parser Edit+editParser tool = withObject "tool_input" $ \object' -> case tool of+  "Edit" ->+    SingleEdit <$> object' .: "file_path" <*> (Replacement <$> object' .: "old_string" <*> object' .: "new_string")+  "MultiEdit" ->+    MultiEditFile <$> object' .: "file_path" <*> object' .: "edits"+  "Write" ->+    WriteFileContent <$> object' .: "file_path" <*> object' .: "content"+  "NotebookEdit" ->+    NotebookCellSource <$> object' .: "file_path" <*> object' .: "new_source"+  other ->+    fail ("unexpected edit tool: " <> show other)++-- Persisted form: tag with the tool name and keep exactly the fields needed to+-- reconstruct the diff. Round-trips through parseEditFromTool's shape so the+-- record and review halves of the gate stay in sync.+instance ToJSON Edit where+  toJSON :: Edit -> Value+  toJSON = \case+    SingleEdit path (Replacement old new) ->+      object ["tool" .= ("Edit" :: Text), "file_path" .= path, "old_string" .= old, "new_string" .= new]+    MultiEditFile path edits ->+      object ["tool" .= ("MultiEdit" :: Text), "file_path" .= path, "edits" .= map replacementToJSON edits]+    WriteFileContent path content ->+      object ["tool" .= ("Write" :: Text), "file_path" .= path, "content" .= content]+    NotebookCellSource path source ->+      object ["tool" .= ("NotebookEdit" :: Text), "file_path" .= path, "new_source" .= source]++replacementToJSON :: Replacement -> Value+replacementToJSON (Replacement old new) =+  object ["old_string" .= old, "new_string" .= new]++instance FromJSON Edit where+  parseJSON :: Value -> Aeson.Parser Edit+  parseJSON value = flip (withObject "Edit") value $ \object' -> do+    tool <- object' .: "tool"+    editParser tool value

@@ -0,0 +1,70 @@+-- | Reading the per-turn edit stack the phases review.+--+-- record-edit appends one JSON-encoded edit per line. The phases read it back to+-- render diffs and to list the touched files; Phase A also returns a claimed+-- stack to the live stack when its reviewer fails, so the next Stop retries.+module Claude.Gate.EditStack+  ( readEdits+  , stackFilePaths+  , stackHasCode+  , returnClaimedToStack+  ) where++import Data.Aeson qualified as Aeson+import Data.ByteString qualified as StrictByteString+import Data.ByteString.Char8 qualified as ByteString+import Data.List (isSuffixOf, nub, sort)+import Claude.Gate.Edit (Edit, editFilePath)+import Claude.Gate.TurnState (TurnPaths (claimedStack, reviewStack), removeIfExists)+import System.Directory (doesFileExist)++-- | Read a stack file back into edits. We wrote these lines ourselves, so a line+-- that fails to decode is a bug in this program, surfaced loudly.+readEdits :: FilePath -> IO [Edit]+readEdits path = do+  contents <- ByteString.readFile path+  pure (map decodeEdit (filter (not . ByteString.null) (ByteString.lines contents)))++decodeEdit :: ByteString.ByteString -> Edit+decodeEdit raw = case Aeson.eitherDecodeStrict raw of+  Right edit -> edit+  Left err -> error ("claude-gate: corrupt edit on the review stack: " <> err)++-- | The sorted, deduplicated file paths recorded on a stack file.+stackFilePaths :: FilePath -> IO [FilePath]+stackFilePaths path = do+  present <- doesFileExist path+  if not present+    then pure []+    else do+      edits <- readEdits path+      pure (sort (nub (map editFilePath edits)))++-- | Whether any file on the stack is source code. Dumbify is about code+-- comprehension, so prose and config edits do not trigger it.+stackHasCode :: FilePath -> IO Bool+stackHasCode path = do+  paths <- stackFilePaths path+  pure (any isCode paths)++isCode :: FilePath -> Bool+isCode path = any (`isSuffixOf` path) codeExtensions++codeExtensions :: [FilePath]+codeExtensions =+  [ ".hs", ".lhs", ".hsig", ".cabal", ".nix", ".sh", ".bash", ".py", ".rs"+  , ".js", ".ts", ".tsx", ".go", ".c", ".h", ".cpp", ".hpp", ".java"+  ]++-- | Return the claimed diffs to the live stack so the next Stop re-reviews them,+-- then drop the claimed copy. Used when the rule reviewer fails: the diffs must+-- not be lost to an infrastructure hiccup.+returnClaimedToStack :: TurnPaths -> IO ()+returnClaimedToStack paths = do+  present <- doesFileExist (claimedStack paths)+  if not present+    then pure ()+    else do+      claimed <- StrictByteString.readFile (claimedStack paths)+      StrictByteString.appendFile (reviewStack paths) claimed+      removeIfExists (claimedStack paths)

@@ -0,0 +1,37 @@+-- | Render the current contents of the touched files for a reviewer prompt.+--+-- The dumbify canary and the rule reviewer both get the diffs AND the full+-- current file, so a reference the diff makes to code defined elsewhere in the+-- same file is not a false "I can't see it" confusion, and the reviewer can+-- judge the ABSENCE of required elements (e.g. a missing type signature) that a+-- diff fragment alone cannot show. Each file is capped to keep the prompt bounded.+module Claude.Gate.FileContext+  ( renderFullFiles+  , maxFileContextChars+  ) where++import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding (decodeUtf8Lenient)+import Data.ByteString qualified as ByteString+import System.Directory (doesFileExist)++-- | Each file's contents are truncated to this many bytes, matching the shell+-- gate's @head -c 40000@ per file.+maxFileContextChars :: Int+maxFileContextChars = 40_000++-- | A labelled block per existing file, in the given order. Missing files are+-- skipped (a path may have been deleted this turn).+renderFullFiles :: [FilePath] -> IO Text+renderFullFiles paths = Text.concat <$> mapM renderOne paths++renderOne :: FilePath -> IO Text+renderOne path = do+  present <- doesFileExist path+  if not present+    then pure ""+    else do+      raw <- ByteString.readFile path+      let body = decodeUtf8Lenient (ByteString.take maxFileContextChars raw)+      pure (Text.concat ["\n--- ", Text.pack path, " ---\n", body, "\n"])

@@ -0,0 +1,28 @@+-- | Environment-tunable gate configuration: the skip flags and the integer+-- knobs (round caps, timeouts) each phase reads.+module Claude.Gate.GateConfig+  ( phaseDisabled+  , envInt+  , envStr+  ) where++import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as Text+import System.Environment (lookupEnv)+import Text.Read (readMaybe)++-- | A @CLAUDE_SKIP_*@ flag is set when it equals exactly "1".+phaseDisabled :: String -> IO Bool+phaseDisabled name = (== Just "1") <$> lookupEnv name++-- | Read an integer environment knob, falling back to the default when it is+-- unset or not a number.+envInt :: String -> Int -> IO Int+envInt name fallback = do+  value <- lookupEnv name+  pure (fromMaybe fallback (value >>= readMaybe))++-- | Read a string environment knob (e.g. a model override), with a default.+envStr :: String -> Text -> IO Text+envStr name fallback = maybe fallback Text.pack <$> lookupEnv name

@@ -0,0 +1,91 @@+-- | The JSON protocol Claude Code uses to talk to hook commands.+--+-- A hook reads one JSON object from stdin describing the event, and a Stop hook+-- may write one JSON object to stdout to influence the turn. This module models+-- the fields the gate reads from the input, and the two output shapes it emits:+-- a @decision: block@ (with a reason fed back to the main-loop model) and a+-- @systemMessage@ (shown to the user, not added to model context).+module Claude.Gate.HookProtocol+  ( HookEvent(..)+  , BlockReason(..)+  , readHookEvent+  , emitBlock+  , blockAndExit+  , blockAndExitWithNotice+  , emitSystemMessage+  ) where++import Data.Aeson (FromJSON (parseJSON), Value, object, withObject, (.!=), (.:?), (.=))+import Data.Aeson qualified as Aeson+-- Data.Aeson does not re-export Parser; it lives in Data.Aeson.Types. Both are+-- qualified as Aeson so the FromJSON method signature reads Aeson.Parser.+import Data.Aeson.Types qualified as Aeson (Parser)+import Data.ByteString.Lazy qualified as LazyByteString+import Data.Text (Text)+import System.Exit (exitSuccess)++-- | The subset of a hook's stdin payload the gate reads. Every field except+-- the session id is optional because which fields are present depends on the+-- event (PostToolUse carries a tool, Stop carries a transcript path).+data HookEvent = HookEvent+  { sessionId :: Text+  , transcriptPath :: Maybe FilePath+  , toolName :: Maybe Text+  , toolInput :: Maybe Value+  }++instance FromJSON HookEvent where+  parseJSON :: Value -> Aeson.Parser HookEvent+  parseJSON = withObject "HookEvent" $ \object' ->+    HookEvent+      <$> object' .:? "session_id" .!= "default"+      <*> object' .:? "transcript_path"+      <*> object' .:? "tool_name"+      <*> object' .:? "tool_input"++-- | The text shown back to the main-loop model when the gate blocks the Stop.+newtype BlockReason = BlockReason Text++-- | Read and decode the hook event from stdin. A malformed payload is a bug in+-- the harness contract, not something to paper over, so we crash loudly.+readHookEvent :: IO HookEvent+readHookEvent = do+  raw <- LazyByteString.getContents+  case Aeson.eitherDecode raw of+    Left err -> error ("claude-gate: could not decode hook event from stdin: " <> err)+    Right event -> pure event++-- | Block the Stop and feed the reason back to the model. Printing this JSON and+-- exiting 0 is how a Stop hook asks the turn to continue.+emitBlock :: BlockReason -> IO ()+emitBlock (BlockReason reason) =+  LazyByteString.putStr (Aeson.encode (object ["decision" .= ("block" :: Text), "reason" .= reason]))++-- | A blocking phase emits its reason and ends the gate immediately: later+-- phases do not run on a Stop that one phase already blocked.+blockAndExit :: BlockReason -> IO a+blockAndExit reason = emitBlock reason >> exitSuccess++-- | Block the Stop and, in the SAME hook response, show the user a notice. A+-- Stop hook may emit only one JSON object, so the model-facing block reason and+-- the user-facing systemMessage are combined into one object: the model gets the+-- reason it must act on, and the human watching sees the notice rather than being+-- left to guess at a phase that broke silently. Used for infrastructure failures+-- (a nested reviewer that timed out or returned a weird exit status).+--+-- Decision: emit one JSON object carrying both "reason" and "systemMessage",+-- rather than reusing emitBlock then emitSystemMessage as two writes. Alternative+-- considered: two separate emits. Rejected because a hook may write only one JSON+-- object to stdout, so the second write is ignored or breaks parsing; a single+-- merged object is the only way to deliver both signals from one hook response.+blockAndExitWithNotice :: BlockReason -> Text -> IO a+blockAndExitWithNotice (BlockReason reason) notice = do+  LazyByteString.putStr+    (Aeson.encode (object ["decision" .= ("block" :: Text), "reason" .= reason, "systemMessage" .= notice]))+  exitSuccess++-- | Emit a user-visible, non-blocking message (the end-of-gate "gate clear"+-- notice). systemMessage is shown to the user and is not added to model context.+emitSystemMessage :: Text -> IO ()+emitSystemMessage message =+  LazyByteString.putStr (Aeson.encode (object ["systemMessage" .= message]))

@@ -0,0 +1,224 @@+-- | Running a nested @claude -p@ reviewer and surfacing its failures loudly.+--+-- Each Stop-gate phase shells out to a fresh @claude@ to review the turn. Two+-- rules from the shell gate are preserved here. First, the nested call is launched+-- with every gate phase disabled in its environment, so its own hooks cannot+-- re-enter this gate. Second, the gate FAILS LOUD: a reviewer that timed out,+-- crashed, or returned nothing is not read as a clean pass. It is logged and, on+-- its first occurrence this turn, blocks the Stop with a descriptive reason for+-- the model AND a user-visible systemMessage naming the weird exit status, so a+-- silently broken reviewer is never mistaken for a clean pass by either of them.+module Claude.Gate.NestedClaude+  ( Reviewer(..)+  , NestedResult(..)+  , GateFailure(..)+  , runNested+  , surfaceNestedFailure+  , surfaceGateFailure+  ) where++import Control.Exception.Safe (displayException, tryAny)+import Control.Monad (unless)+import Data.ByteString.Lazy qualified as LazyByteString+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding (decodeUtf8Lenient, encodeUtf8)+import Claude.Gate.HookProtocol (BlockReason (BlockReason), blockAndExitWithNotice)+import Claude.Gate.SpawnAnnotation (annotateSpawn)+import Claude.Gate.TurnState (flagExists, writeFlag)+import System.Directory (createDirectoryIfMissing)+import System.Environment (getEnvironment, lookupEnv)+import System.Exit (ExitCode (ExitFailure, ExitSuccess))+import System.FilePath (takeDirectory)+import System.Process.Typed (byteStringInput, proc, readProcess, setEnv, setStdin, setWorkingDir)++-- | How to launch one nested reviewer. A read-only reviewer (the dumbify canary+-- and the rule reviewer) gets MCP disabled and only Read/Grep/Glob, skipping the+-- MCP cold-start cost; the critic is deliberately given neither, so it has full+-- tools to gather counter-evidence.+data Reviewer = Reviewer+  { reviewerModel :: Text+  , reviewerReadOnly :: Bool+  , reviewerTimeoutSecs :: Int+  , reviewerWorkdir :: Maybe FilePath+  }++-- | The outcome of a nested call. NestedBroken carries the exit code, whether+-- stdout was empty, and the captured stderr, so a failure can be described.+data NestedResult+  = NestedBroken Int Bool Text+  | NestedOutput Text++-- | Run @timeout N claude -p ... --model M@ feeding the prompt on stdin. The+-- timeout binary kills a hung reviewer (exit 124). A non-zero exit, an empty+-- stdout, or a spawn exception all count as broken.+runNested :: Reviewer -> Text -> IO NestedResult+runNested reviewer prompt = do+  baseEnv <- getEnvironment+  let configure =+        setStdin (byteStringInput (LazyByteString.fromStrict (encodeUtf8 prompt)))+          . setEnv (guardEnv baseEnv)+          . maybe id setWorkingDir (reviewerWorkdir reviewer)+      reviewerProcess = configure (proc "timeout" (timeoutArgs reviewer))+  outcome <- tryAny (annotateSpawn (nestedSpawnLabel reviewer) (readProcess reviewerProcess))+  pure $ case outcome of+    Left err -> NestedBroken 1 True (Text.pack (displayException err))+    Right (exitCode, out, errOut) -> interpret exitCode (decodeLazy out) (decodeLazy errOut)++interpret :: ExitCode -> Text -> Text -> NestedResult+interpret exitCode out err+  | nestedBroken exitCode out = NestedBroken (exitNumber exitCode) (emptyOutput out) err+  | otherwise = NestedOutput out++-- | Mirrors the shell @nested_call_broken@: a non-zero exit, or exit 0 with no+-- usable stdout, is broken; a reviewer that answered (even "OK") is not.+nestedBroken :: ExitCode -> Text -> Bool+nestedBroken ExitSuccess out = emptyOutput out+nestedBroken (ExitFailure _) _ = True++emptyOutput :: Text -> Bool+emptyOutput = Text.null . Text.strip++exitNumber :: ExitCode -> Int+exitNumber ExitSuccess = 0+exitNumber (ExitFailure n) = n++timeoutArgs :: Reviewer -> [String]+timeoutArgs reviewer =+  [show (reviewerTimeoutSecs reviewer), "claude", "-p"]+    <> (if reviewerReadOnly reviewer then readOnlyArgs else [])+    <> ["--model", Text.unpack (reviewerModel reviewer)]++readOnlyArgs :: [String]+readOnlyArgs = ["--strict-mcp-config", "--mcp-config", "{\"mcpServers\":{}}", "--tools", "Read", "Grep", "Glob"]++-- | A label for the nested reviewer spawn, attached to any spawn failure so a+-- broken 'NestedResult' names which reviewer's process could not start (rather+-- than a bare @timeout: posix_spawnp@). Keyed by model, which distinguishes the+-- canary, rule reviewer and critic.+nestedSpawnLabel :: Reviewer -> String+nestedSpawnLabel reviewer =+  "timeout claude (nested " <> Text.unpack (reviewerModel reviewer) <> " reviewer)"++-- | Disable every gate phase in the nested reviewer's environment so its own+-- Stop hook cannot recurse into this gate.+guardEnv :: [(String, String)] -> [(String, String)]+guardEnv base =+  upsert "CLAUDE_SKIP_DUMBIFY" "1"+    (upsert "CLAUDE_SKIP_CRITIQUE" "1" (upsert "CLAUDE_SKIP_RULE_CHECK" "1" base))++upsert :: String -> String -> [(String, String)] -> [(String, String)]+upsert key value environment = (key, value) : filter ((/= key) . fst) environment++decodeLazy :: LazyByteString.ByteString -> Text+decodeLazy = decodeUtf8Lenient . LazyByteString.toStrict++-- | One gate failure described for its three audiences: the durable log, the+-- main-loop model, and the human watching. A record rather than positional+-- Text arguments so the reason and the notice cannot be swapped at a call site.+data GateFailure = GateFailure+  { failureHeadline :: Text+    -- ^ One line naming the failure in the durable log header.+  , failureLogBody :: Text+    -- ^ Detail recorded under the headline (stderr tail, paths).+  , failureBlockReason :: Text+    -- ^ Model-facing reason fed back when the Stop is blocked.+  , failureUserNotice :: Text+    -- ^ User-visible systemMessage shown alongside the block.+  }++-- | The shared fail-loud path: append the failure to the durable log and, on+-- its first occurrence this turn (tracked via the warn flag), block the Stop+-- with a reason for the model AND a user-visible notice (then exit). Later+-- occurrences only log and return, so a persistent failure surfaces once but+-- does not wedge the turn. Used for broken nested calls and for the critique's+-- empty dossier; anything the gate must never silently wave through.+surfaceGateFailure :: Text -> GateFailure -> FilePath -> IO ()+surfaceGateFailure session failure warnFlag = do+  appendFailureLog session (failureHeadline failure) (failureLogBody failure)+  alreadyWarned <- flagExists warnFlag+  unless alreadyWarned $ do+    writeFlag warnFlag+    blockAndExitWithNotice+      (BlockReason (failureBlockReason failure))+      (failureUserNotice failure)++-- | Log a broken nested call, and on its first occurrence this turn block the+-- Stop with a loud reason for the model and a user-visible notice (then exit).+-- On later occurrences it only logs and returns, so a permanently broken CLI+-- surfaces once but does not wedge the turn.+surfaceNestedFailure :: Text -> Text -> Text -> Int -> Bool -> Text -> FilePath -> IO ()+surfaceNestedFailure session phase model exitCode emptyOut stderrText =+  surfaceGateFailure session (nestedCallFailure phase model detail stderrText)+  where+    detail = failureDetail exitCode emptyOut++-- | Describe a broken nested call for 'surfaceGateFailure'.+nestedCallFailure :: Text -> Text -> Text -> Text -> GateFailure+nestedCallFailure phase model detail stderrText =+  GateFailure+    { failureHeadline = Text.concat ["nested call broke: phase=", phase, " model=", model, " ", detail]+    , failureLogBody = "--- stderr (last 20 lines) ---\n" <> stderrTail stderrText+    , failureBlockReason = failureReason phase model detail stderrText+    , failureUserNotice = failureNotice phase model detail+    }++-- | The short, user-visible companion to 'failureReason'. It names the phase,+-- the model, and the weird exit status so a watching human sees at once that a+-- reviewer broke and where to look, instead of mistaking the silence for a+-- clean pass. The default failure log path is named because it holds the detail.+failureNotice :: Text -> Text -> Text -> Text+failureNotice phase model detail =+  Text.concat+    [ "claude-gate: the ", phase, " reviewer (", model, ") returned a bad exit status ("+    , detail, "), so this turn was NOT checked by it. Details in the gate failure log "+    , "($CLAUDE_GATE_FAILURE_LOG, default ~/.claude/gate-failures.log)."+    ]++failureDetail :: Int -> Bool -> Text+failureDetail exitCode emptyOut =+  "exit=" <> Text.pack (show exitCode)+    <> (if exitCode == 124 then " (timed out)" else "")+    <> (if emptyOut then ", empty output" else "")++failureReason :: Text -> Text -> Text -> Text -> Text+failureReason phase model detail stderrText =+  Text.concat+    [ "GATE INFRASTRUCTURE FAILURE in the ", phase, " phase: the nested ", model+    , " call returned no usable result (", detail, "), so this turn was NOT checked "+    , "by that phase. Find out why the reviewer could not run (timeout, auth, MCP, "+    , "model error) before trusting this turn. This loud warning fires once per turn; "+    , "you may continue after acknowledging it.\nLast stderr lines:\n"+    , stderrTail stderrText+    ]++stderrTail :: Text -> Text+stderrTail = Text.unlines . lastN 20 . Text.lines++lastN :: Int -> [a] -> [a]+lastN n xs = drop (length xs - n) xs++-- | Append a failure record to the durable log outside the per-turn state dir+-- (so it survives the per-prompt reset), overridable via CLAUDE_GATE_FAILURE_LOG.+appendFailureLog :: Text -> Text -> Text -> IO ()+appendFailureLog session headline body = do+  path <- failureLogPath+  createDirectoryIfMissing True (takeDirectory path)+  appendFile path $+    Text.unpack $+      Text.concat+        [ "=== gate failure: ", headline, " ===\n"+        , "session=", session, "\n"+        , body+        , "\n"+        ]++failureLogPath :: IO FilePath+failureLogPath = do+  override <- lookupEnv "CLAUDE_GATE_FAILURE_LOG"+  case override of+    Just path -> pure path+    Nothing -> do+      home <- lookupEnv "HOME"+      pure (fromMaybe "/tmp" home <> "/.claude/gate-failures.log")

@@ -0,0 +1,118 @@+-- | The PostToolUse half of the gate: record an edit onto the per-turn review+-- stack, near-instantly, so the Stop gate can review the whole turn's diffs in+-- one pass. This never blocks the agent and never reviews anything itself.+module Claude.Gate.RecordEdit+  ( recordEdit+  , editTools+  , pathSkipReason+  , SkipReason(..)+  , maxRecordedFileBytes+  ) where++import Control.Monad (unless, when)+import Data.Aeson qualified as Aeson+import Data.ByteString qualified as ByteString+import Data.ByteString.Lazy qualified as LazyByteString+import Data.List (isInfixOf, isSuffixOf)+import Data.Text (Text)+import Claude.Gate.Edit (Edit, editFilePath, parseEditFromTool)+import Claude.Gate.HookProtocol (HookEvent (sessionId, toolInput, toolName), readHookEvent)+import Claude.Gate.TurnState (TurnPaths (reviewStack), ensureStateDir, turnPaths)+import System.Directory (doesFileExist, getFileSize)+import System.Environment (lookupEnv)++-- | The tools whose edits we record. Matches the PostToolUse matcher in+-- settings.json; any other tool name is simply not an edit event.+editTools :: [Text]+editTools = ["Edit", "MultiEdit", "Write", "NotebookEdit"]++-- | Files larger than this are skipped so a huge generated write does not burn+-- review tokens. Matches the 50 KB cutoff the shell hook used.+maxRecordedFileBytes :: Integer+maxRecordedFileBytes = 50_000++-- | Why an edit was not recorded. Kept as data (rather than a bare Bool) so the+-- reason is greppable and testable, even though the hook acts the same for all+-- of them: it skips silently, because a skipped file is an intended no-op, not+-- a failure.+data SkipReason+  = SkipBinaryExtension+  | SkipArchive+  | SkipBuildArtifact+  deriving stock (Eq, Show)++-- | Decide, from the path alone, whether prose/style rules could apply. Returns+-- the reason to skip, or Nothing to consider the file. Pure so it can be tested+-- without touching the filesystem.+pathSkipReason :: FilePath -> Maybe SkipReason+pathSkipReason path+  | any (`isSuffixOf` path) binaryExtensions = Just SkipBinaryExtension+  | any (`isSuffixOf` path) archiveExtensions = Just SkipArchive+  | any (`isInfixOf` path) buildArtifactInfixes = Just SkipBuildArtifact+  | "/result" `isSuffixOf` path = Just SkipBuildArtifact+  | "/result-" `isInfixOf` path = Just SkipBuildArtifact+  | otherwise = Nothing++binaryExtensions :: [FilePath]+binaryExtensions =+  [ ".lock", ".json", ".csv", ".tsv", ".png", ".jpg", ".jpeg", ".gif"+  , ".pdf", ".ico", ".svg", ".sqlite", ".db", ".so", ".dylib", ".exe", ".bin"+  ]++archiveExtensions :: [FilePath]+archiveExtensions = [".zip", ".tar", ".tar.gz", ".tgz", ".bz2", ".xz", ".7z", ".rar"]++buildArtifactInfixes :: [FilePath]+buildArtifactInfixes = ["/node_modules/", "/.git/", "/dist-newstyle/"]++-- | Entry point for the @record@ subcommand. Reads the PostToolUse event,+-- applies the same filters the shell hook did, and appends the edit as one JSON+-- line to the review stack.+recordEdit :: IO ()+recordEdit = do+  -- Recording respects the rule-review skip flag because the only consumer of+  -- the review stack is the Stop gate's Phase A rule review. With review off+  -- nothing ever reads the stack, so recording would be pure overhead.+  disabled <- ruleCheckDisabled+  unless disabled $ do+    event <- readHookEvent+    case (toolName event, toolInput event) of+      (Just tool, Just input)+        | tool `elem` editTools ->+            case parseEditFromTool tool input of+              Left err -> error ("claude-gate record: malformed " <> show tool <> " input: " <> err)+              Right edit -> recordIfRelevant (sessionId event) edit+      _notAnEditEvent -> pure ()++ruleCheckDisabled :: IO Bool+ruleCheckDisabled = (== Just "1") <$> lookupEnv "CLAUDE_SKIP_RULE_CHECK"++recordIfRelevant :: Text -> Edit -> IO ()+recordIfRelevant session edit = case pathSkipReason path of+  Just SkipBinaryExtension -> pure ()+  Just SkipArchive -> pure ()+  Just SkipBuildArtifact -> pure ()+  Nothing -> do+    isRegularFile <- doesFileExist path+    when isRegularFile $ do+      tooBig <- aboveSizeLimit path+      binary <- looksBinary path+      when (not tooBig && not binary) (appendEdit session edit)+  where+    path = editFilePath edit++aboveSizeLimit :: FilePath -> IO Bool+aboveSizeLimit path = (> maxRecordedFileBytes) <$> getFileSize path++-- | Cheap binary heuristic matching the shell hook: a NUL byte in the first+-- 8 KB means binary.+looksBinary :: FilePath -> IO Bool+looksBinary path = do+  prefix <- ByteString.take 8192 <$> ByteString.readFile path+  pure (ByteString.elem 0 prefix)++appendEdit :: Text -> Edit -> IO ()+appendEdit session edit = do+  paths <- turnPaths session+  ensureStateDir paths+  LazyByteString.appendFile (reviewStack paths) (Aeson.encode edit <> "\n")

@@ -0,0 +1,109 @@+-- | Resolving the git work-tree root a reviewer should run in.+--+-- The dumbify canary and the critic run in the repository so they can read code+-- and (the critic) run tests. The root is taken from the first edited file;+-- the critic falls back to the gate's own working directory on a turn with no+-- file edits.+module Claude.Gate.Repo+  ( gitRoot+  , repoForFiles+  , repoForFilesOrCwd+  , commitHistory+  ) where++import Data.ByteString.Lazy.Char8 qualified as LazyChar8+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding (decodeUtf8Lenient)+import System.Directory (findExecutable)+import System.Exit (ExitCode (ExitFailure, ExitSuccess))+import System.FilePath (takeDirectory)+import System.Process.Typed (proc, readProcess)++import Claude.Gate.SpawnAnnotation (annotateSpawn)++-- | The git work-tree root containing a directory. 'Nothing' when the directory+-- is not in a repository, or when @git@ is not on @PATH@ at all.+--+-- Decision: guard the spawn with 'findExecutable' rather than spawning blind.+-- A missing @git@, or a @\/bin\/git@ symlink left dangling by a nix+-- garbage-collection, otherwise crashes the whole Stop hook on @posix_spawnp@;+-- declining to resolve a root lets the caller skip that reviewer instead. This+-- mirrors the @findExecutable "claude"@ guard the reviewers already use.+-- Alternative considered: catch the spawn exception; rejected because the+-- pre-flight check keeps the not-installed path explicit and never swallows a+-- genuine spawn failure of a @git@ that IS present.+gitRoot :: FilePath -> IO (Maybe FilePath)+gitRoot dir = do+  gitOnPath <- findExecutable "git"+  case gitOnPath of+    Nothing -> pure Nothing+    Just _ -> do+      (exitCode, out, _err) <-+        annotateSpawn ("git -C " <> dir <> " rev-parse --show-toplevel") $+          readProcess (proc "git" ["-C", dir, "rev-parse", "--show-toplevel"])+      pure (parseTopLevel exitCode out)++-- | The first line of @git rev-parse --show-toplevel@ output is the work-tree+-- root on success; a failing exit or empty output means not-a-repository.+parseTopLevel :: ExitCode -> LazyChar8.ByteString -> Maybe FilePath+parseTopLevel exitCode out =+  case LazyChar8.lines out of+    (root : _) ->+      if isSuccess exitCode && not (LazyChar8.null root)+        then Just (LazyChar8.unpack root)+        else Nothing+    [] -> Nothing++isSuccess :: ExitCode -> Bool+isSuccess = \case+  ExitSuccess -> True+  ExitFailure _ -> False++-- | The repo's recent commit history, newest first, one commit per line as+-- @\<full-sha\> \<committer-ISO-8601-date\> \<subject\>@. The first line is HEAD.+-- The critic runs with full tools and cross-checks external CI runs; handed the+-- real commit order and each commit's timestamp it can pin a run to a commit by+-- its sha instead of reconstructing the order from run start times (which are not+-- commit order: a run can start on an older HEAD and finish after a newer commit+-- exists) and pinning runs to the wrong commits. 'Nothing' when the directory is+-- not a work tree, or when @git@ is not on @PATH@ (same guard as 'gitRoot').+commitHistory :: FilePath -> IO (Maybe Text)+commitHistory dir = do+  gitOnPath <- findExecutable "git"+  case gitOnPath of+    Nothing -> pure Nothing+    -- The resolved path is unused; we invoke @git@ through PATH, the presence+    -- check is all we need from findExecutable.+    Just _gitExecutable -> do+      -- 15 commits: enough to cover a turn's worth of recent work (so the critic+      -- can place the runs it checks) without bloating the prompt with ancient+      -- history the critique will never reference.+      (exitCode, out, _err) <-+        annotateSpawn ("git -C " <> dir <> " log -n 15 --format=%H %cI %s") $+          readProcess (proc "git" ["-C", dir, "log", "-n", "15", "--format=%H %cI %s"])+      pure (parseHistory exitCode out)++-- | The git log output as trimmed 'Text' on success with non-empty output; a+-- failing exit (not a repository, an empty repo with no commits) is 'Nothing' so+-- the caller renders an explicit placeholder rather than a blank anchor.+parseHistory :: ExitCode -> LazyChar8.ByteString -> Maybe Text+parseHistory exitCode out =+  let decoded = Text.stripEnd (decodeUtf8Lenient (LazyChar8.toStrict out))+  in if isSuccess exitCode && not (Text.null decoded)+       then Just decoded+       else Nothing++-- | The repo root of the first edited file, or Nothing when there are no files.+repoForFiles :: [FilePath] -> IO (Maybe FilePath)+repoForFiles [] = pure Nothing+repoForFiles (firstFile : _) = gitRoot (takeDirectory firstFile)++-- | The repo root of the first edited file, falling back to the current+-- directory's repo when the turn made no file edits.+repoForFilesOrCwd :: [FilePath] -> IO (Maybe FilePath)+repoForFilesOrCwd files = do+  fromFiles <- repoForFiles files+  case fromFiles of+    Just root -> pure (Just root)+    Nothing -> gitRoot "."

@@ -0,0 +1,105 @@+-- | The Phase A rule-review prompt and the parsing of the reviewer's reply.+--+-- Keeping the prompt text here, separate from the orchestration in+-- "Claude.Gate.RuleReview", makes the wording easy to find and edit without wading+-- through control flow.+module Claude.Gate.ReviewPrompt+  ( buildReviewPrompt+  , maxDiffPromptChars+  , hasViolations+  , reviewBlockReason+  ) where++import Data.Text (Text)+import Data.Text qualified as Text++-- | The rendered diffs are truncated to this many characters so a giant turn+-- cannot blow up the reviewer prompt. Matches the shell hook's @head -c 40000@.+maxDiffPromptChars :: Int+maxDiffPromptChars = 40_000++-- | Assemble the reviewer prompt from the rules corpus, the rendered diffs, and+-- the full current contents of the touched files (so the reviewer can judge the+-- absence of required elements that a diff fragment cannot show).+buildReviewPrompt :: Text -> Text -> Text -> Text+buildReviewPrompt corpus renderedDiffs fullFiles =+  Text.concat+    [ reviewPromptHeader+    , corpus+    , "\n=== DIFFS JUST APPLIED ===\n"+    , Text.take maxDiffPromptChars renderedDiffs+    , "\n=== FULL FILE CONTENTS (context; judge presence/absence of required elements only for definitions that appear in the diffs above) ===\n"+    , fullFiles+    ]++reviewPromptHeader :: Text+reviewPromptHeader =+  "You are a rule-compliance reviewer. Another Claude Code agent (a larger model\n\+  \than you) just finished a turn in which it made the edits shown below. You are\n\+  \reviewing the DIFFS of those edits, not whole files. Your output is fed back to\n\+  \that larger model, which then decides whether to fix the file or rebut your\n\+  \finding. Give it enough evidence to judge, not just a label.\n\+  \\n\+  \Below is a corpus of rules from CLAUDE.md and the relevant skills, followed by\n\+  \the diffs that were just applied.\n\+  \\n\+  \Be strict about what counts as a violation:\n\+  \\n\+  \- Only flag clear, objective violations of a rule stated in the rules corpus.\n\+  \  Quote the rule you are applying.\n\+  \- Only flag text that appears in a \"--- with ---\", \"--- new content ---\" or\n\+  \  \"--- new source ---\" section: that is what the agent actually wrote. Do not\n\+  \  flag text in a \"--- replaced ---\" section; that is the old text being removed.\n\+  \- A violation can also be the ABSENCE of required text. For rules of the form\n\+  \  \"always do X\" / \"every Y must have Z\" (e.g. \"always add a top-level type\n\+  \  signature to every top-level binding\"), a diff fragment cannot show a missing\n\+  \  line. So for any top-level definition that appears in the diffs (added or\n\+  \  modified this turn), consult the FULL FILE CONTENTS section below to check\n\+  \  whether the required element is present; if it is missing, flag it. Apply this\n\+  \  ONLY to definitions that appear in the diffs, never to untouched code.\n\+  \- Do NOT flag stylistic preferences that are not stated in the rules.\n\+  \- Do NOT flag judgement calls or things that \"might be better\".\n\+  \- If you are unsure, do not flag it.\n\+  \- Skill rules only apply when the skill's trigger conditions match the file\n\+  \  being reviewed.\n\+  \\n\+  \Response format:\n\+  \\n\+  \- If there are no violations: respond with the single line `OK`.\n\+  \- Otherwise: one block per violation, no markdown, with these labelled lines:\n\+  \\n\+  \    VIOLATION: <one-sentence summary>\n\+  \    RULE: \"<verbatim quote of the rule, including which file/skill it came from>\"\n\+  \    EVIDENCE: <file path>: <the offending text, copied verbatim from a newly\n\+  \              written section>\n\+  \    REASONING: <one or two sentences naming the concrete mechanism by which the\n\+  \               text breaks the rule. Note any borderline-ness so the larger\n\+  \               model can decide whether to fix or rebut.>\n\+  \\n\+  \Separate blocks with a blank line.\n\+  \\n\+  \=== RULES ===\n"++-- | A reviewer reply reports violations when it contains at least one line+-- beginning with @VIOLATION:@.+hasViolations :: Text -> Bool+hasViolations reviewOutput =+  any ("VIOLATION:" `Text.isPrefixOf`) (Text.lines reviewOutput)++-- | The block reason shown to the main-loop model when the reviewer flags+-- something. It frames the model as the final judge: fix or rebut, never+-- silently ignore.+reviewBlockReason :: Text -> Text -> Text+reviewBlockReason model reviewOutput =+  Text.concat+    [ "A ", model, " reviewer flagged possible rule violations in the diffs you just applied.\n"+    , "You are the larger model and the final judge. For each finding, either:\n"+    , "  1. Agree: edit the file to fix it (the fix is re-reviewed automatically), or\n"+    , "  2. Disagree: explain to the user why the finding is wrong (the reviewer misread\n"+    , "     the rule, the rule does not apply to this file type, evidence out of context)\n"+    , "     and proceed without fixing.\n"+    , "Do not silently ignore findings. Set CLAUDE_SKIP_RULE_CHECK=1 to disable.\n"+    , "\n--- reviewer findings ---\n"+    , reviewOutput+    , "\n--- end reviewer findings ---"+    ]

@@ -0,0 +1,73 @@+-- | Phase A: rule review.+--+-- Claims the edit stack and reviews every diff in a single reviewer call against+-- the rules corpus (global and project CLAUDE.md plus the skills matching the+-- touched file types), with the full file contents for context. Violations block+-- the Stop with the findings; the model's fixes are themselves edits, recorded on+-- a fresh stack and re-reviewed next Stop, so review loops until clean. A reviewer+-- that fails returns the diffs to the stack and is surfaced loudly.+module Claude.Gate.RuleReview+  ( runRuleReview+  ) where++import Control.Monad (when)+import Data.Maybe (isJust)+import Data.Text (Text)+import Claude.Gate.Corpus (buildCorpus)+import Claude.Gate.DiffRender (renderDiffs)+import Claude.Gate.EditStack (readEdits, returnClaimedToStack, stackFilePaths)+import Claude.Gate.FileContext (renderFullFiles)+import Claude.Gate.GateConfig (envInt, envStr, phaseDisabled)+import Claude.Gate.HookProtocol (BlockReason (BlockReason), blockAndExit)+import Claude.Gate.NestedClaude (NestedResult (NestedBroken, NestedOutput), Reviewer (Reviewer), runNested, surfaceNestedFailure)+import Claude.Gate.ReviewPrompt (buildReviewPrompt, hasViolations, reviewBlockReason)+import Claude.Gate.TurnState+  ( TurnPaths (claimedStack, reviewApproved, reviewBroke, reviewStack)+  , claimReviewStack+  , fileNonEmpty+  , removeIfExists+  , writeFlag+  )+import System.Directory (findExecutable)++runRuleReview :: Text -> TurnPaths -> IO ()+runRuleReview session paths = do+  disabled <- phaseDisabled "CLAUDE_SKIP_RULE_CHECK"+  claudeAvailable <- isJust <$> findExecutable "claude"+  stackReady <- fileNonEmpty (reviewStack paths)+  when (not disabled && claudeAvailable && stackReady) $ do+    -- Claim the stack atomically so any edit recorded after this point lands on a+    -- fresh stack and is reviewed on the next Stop rather than lost.+    claimed <- claimReviewStack paths+    claimedReady <- if claimed then fileNonEmpty (claimedStack paths) else pure False+    when claimedReady (reviewClaimed session paths)++reviewClaimed :: Text -> TurnPaths -> IO ()+reviewClaimed session paths = do+  files <- stackFilePaths (claimedStack paths)+  edits <- readEdits (claimedStack paths)+  corpus <- buildCorpus files+  fullFiles <- renderFullFiles files+  timeoutSecs <- envInt "CLAUDE_RULE_REVIEW_TIMEOUT" 300+  -- Phase A reviewer model. Decision: Sonnet rather than Haiku. The review only+  -- fires on turns that edited files and batches that turn's diffs into one call,+  -- so cost is per-edit-turn, not per-Stop, and the extra reasoning catches+  -- semantic violations (silent failures, tests asserting static content) a+  -- smaller model misses. The main-loop model is still the final judge. Read via+  -- the env, defaulting to the current Sonnet, so bumping the model to the next+  -- generation needs no rebuild, matching CLAUDE_CRITIQUE_MODEL / CLAUDE_DUMBIFY_MODEL.+  model <- envStr "CLAUDE_REVIEWER_MODEL" "claude-sonnet-5"+  let reviewer = Reviewer model True timeoutSecs Nothing+      prompt = buildReviewPrompt corpus (renderDiffs edits) fullFiles+  result <- runNested reviewer prompt+  case result of+    NestedBroken exitCode emptyOut stderrText -> do+      -- Do not lose the diffs: return them to the stack so the next Stop+      -- re-reviews once the reviewer works again, then surface the failure.+      returnClaimedToStack paths+      surfaceNestedFailure session "rule review" model exitCode emptyOut stderrText (reviewBroke paths)+    NestedOutput output -> do+      removeIfExists (claimedStack paths)+      if hasViolations output+        then blockAndExit (BlockReason (reviewBlockReason model output))+        else writeFlag (reviewApproved paths)

@@ -0,0 +1,30 @@+-- | Naming external-process spawns in the exception context.+--+-- 'System.Process.Typed.readProcess' spawns through @posix_spawnp@. When that+-- fails, for a missing binary or a @\/bin@ symlink left dangling by a nix+-- garbage-collection, the exception is a bare+-- @git: startProcess: posix_spawnp: does not exist@ that says nothing about+-- which of the gate's spawns raised it. Wrapping every spawn in 'annotateSpawn'+-- attaches its command, and (via 'checkpoint'\'s 'HasCallStack') the call site,+-- to the exception with @annotated-exception@, so an uncaught crash, or a+-- 'Control.Exception.displayException' of a caught one, names the spawn.+module Claude.Gate.SpawnAnnotation+  ( ProcessCallSite(..)+  , annotateSpawn+  ) where++import Control.Exception.Annotated (Annotation (Annotation), checkpoint)+import GHC.Stack (HasCallStack)++-- | The command a process spawn was for. Its 'Show' is the message the+-- annotation renders, so a crash reads as a sentence rather than a constructor.+newtype ProcessCallSite = ProcessCallSite String++instance Show ProcessCallSite where+  show (ProcessCallSite command) = "while spawning: " <> command++-- | Run a process spawn with its command, and the caller's source location,+-- attached to any exception it raises. The action is otherwise unchanged; this+-- only decorates failures.+annotateSpawn :: HasCallStack => String -> IO a -> IO a+annotateSpawn command = checkpoint (Annotation (ProcessCallSite command))

@@ -0,0 +1,67 @@+-- | The Stop hook: the end-of-turn gate.+--+-- Three phases run in order over the per-turn state, mirroring the shell gate:+--+--   Phase 0 (dumbify). A cheap canary checks the changed code is understandable,+--   and the larger model simplifies it if not. See "Claude.Gate.Dumbify".+--   Phase 1 (critique). An adversarial critic tries to prove the work wrong with+--   tests and sources. See "Claude.Gate.Critique". (This replaced the old verification+--   nudge.)+--   Phase A (rule review). The diffs are checked against the rules corpus. See+--   "Claude.Gate.RuleReview".+--+-- Each phase may block the Stop (emit a reason and exit); later phases only run+-- on a Stop that no earlier phase blocked. The phases converge across the turn's+-- repeated Stops via per-phase flags on tmpfs. When every phase that ran cleared+-- without blocking, a non-blocking "gate clear" notice names them.+module Claude.Gate.StopGate+  ( runStopGate+  ) where++import Control.Monad (unless)+import Data.Maybe (catMaybes)+import Data.Text (Text)+import Data.Text qualified as Text+import Claude.Gate.Critique (runCritique)+import Claude.Gate.Dumbify (runDumbify)+import Claude.Gate.HookProtocol (HookEvent (sessionId, transcriptPath), emitSystemMessage, readHookEvent)+import Claude.Gate.RuleReview (runRuleReview)+import Claude.Gate.TurnState+  ( TurnPaths (critiqueApproved, dumbifyApproved, reviewApproved)+  , ensureStateDir+  , flagExists+  , turnPaths+  )++-- | Entry point for the @stop-gate@ subcommand.+runStopGate :: IO ()+runStopGate = do+  event <- readHookEvent+  paths <- turnPaths (sessionId event)+  ensureStateDir paths+  runDumbify (sessionId event) paths+  runCritique (sessionId event) (transcriptPath event) paths+  runRuleReview (sessionId event) paths+  emitGateClear paths++-- | Every phase that ran this turn concluded without blocking (a block would+-- have exited above). Emit one user-visible, non-blocking confirmation naming+-- the phases that ran and cleared, from their per-turn approved markers.+emitGateClear :: TurnPaths -> IO ()+emitGateClear paths = do+  cleared <- clearedPhases paths+  unless (null cleared) (emitSystemMessage ("gate clear:" <> Text.concat (map (" " <>) cleared)))++clearedPhases :: TurnPaths -> IO [Text]+clearedPhases paths =+  catMaybes+    <$> sequence+      [ namedIfPresent (dumbifyApproved paths) "dumbify"+      , namedIfPresent (critiqueApproved paths) "critique"+      , namedIfPresent (reviewApproved paths) "rules"+      ]++namedIfPresent :: FilePath -> Text -> IO (Maybe Text)+namedIfPresent path name = do+  present <- flagExists path+  pure (if present then Just name else Nothing)

@@ -0,0 +1,135 @@+-- | Extract the assistant's claims this turn from the session transcript.+--+-- The transcript is JSON Lines. A real user message is @type == "user"@ with a+-- /string/ content; a tool reply is also @type == "user"@ but with an /array/+-- content, which is how the two are told apart. The critique phase refutes the+-- prose the assistant produced since the most recent real user message, so we+-- collect the text blocks of every assistant entry after that point.+module Claude.Gate.Transcript+  ( TranscriptLine(..)+  , classifyLine+  , turnAssistantText+  ) where++import Data.Aeson (Value (Array, Object, String))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap qualified as KeyMap+import Data.ByteString.Char8 qualified as ByteString+import Data.Foldable (toList)+import Data.Text (Text)+import Data.Text qualified as Text+import System.Directory (doesFileExist)++-- | One transcript entry, reduced to what the critique cares about: a real user+-- prompt (the boundary), an assistant turn with its text blocks, or neither.+data TranscriptLine+  = RealUserPrompt+  | AssistantText [Text]+  | OtherLine+  deriving stock (Eq, Show)++-- | Classify a decoded transcript entry. Anything that is not a string-content+-- user message or an assistant message is OtherLine; that is the genuine meaning+-- of "an entry we do not care about", not a swallowed parse error (malformed+-- JSON never reaches here, see 'readLines').+classifyLine :: Value -> TranscriptLine+classifyLine value = case lookupKey "type" value of+  Just (String "user") -> userLine (messageContent value)+  Just (String "assistant") -> assistantLine (messageContent value)+  -- Any other "type" string is an entry we ignore. String values cannot be+  -- enumerated, so this is the one unavoidable catch-all.+  Just (String _otherType) -> OtherLine+  Just (Object _) -> OtherLine+  Just (Array _) -> OtherLine+  Just (Aeson.Number _) -> OtherLine+  Just (Aeson.Bool _) -> OtherLine+  Just Aeson.Null -> OtherLine+  Nothing -> OtherLine++-- | A user entry is a real prompt only when its content is a string; an array+-- content is a tool result, which does not count as a turn boundary.+userLine :: Maybe Value -> TranscriptLine+userLine = \case+  Just (String _userText) -> RealUserPrompt+  Just (Object _) -> OtherLine+  Just (Array _) -> OtherLine+  Just (Aeson.Number _) -> OtherLine+  Just (Aeson.Bool _) -> OtherLine+  Just Aeson.Null -> OtherLine+  Nothing -> OtherLine++-- | An assistant entry contributes its text blocks. Array content is the list of+-- content blocks (we keep the @text@ ones); a bare string content is itself the+-- text.+assistantLine :: Maybe Value -> TranscriptLine+assistantLine = \case+  Just (Array items) -> AssistantText (collectTextBlocks (toList items))+  Just (String text) -> AssistantText [text]+  Just (Object _) -> OtherLine+  Just (Aeson.Number _) -> OtherLine+  Just (Aeson.Bool _) -> OtherLine+  Just Aeson.Null -> OtherLine+  Nothing -> OtherLine++messageContent :: Value -> Maybe Value+messageContent value = lookupKey "message" value >>= lookupKey "content"++collectTextBlocks :: [Value] -> [Text]+collectTextBlocks items =+  [ text+  | item <- items+  , lookupKey "type" item == Just (String "text")+  , Just (String text) <- [lookupKey "text" item]+  ]++lookupKey :: Text -> Value -> Maybe Value+lookupKey key value = case value of+  Object fields -> KeyMap.lookup (Key.fromText key) fields+  Array _ -> Nothing+  String _ -> Nothing+  Aeson.Number _ -> Nothing+  Aeson.Bool _ -> Nothing+  Aeson.Null -> Nothing++-- | The assistant's text since the most recent real user message, joined with+-- newlines. This is the prose the critic refutes. A missing transcript is empty.+turnAssistantText :: FilePath -> IO Text+turnAssistantText path = do+  present <- doesFileExist path+  if not present+    then pure ""+    else do+      transcriptLines <- readLines path+      pure (Text.intercalate "\n" (concatMap assistantTextsOf (linesAfterLastUserPrompt transcriptLines)))++assistantTextsOf :: TranscriptLine -> [Text]+assistantTextsOf = \case+  RealUserPrompt -> []+  AssistantText texts -> texts+  OtherLine -> []++-- | The suffix of lines following the last real user prompt. Implemented by+-- reversing, taking lines up to the first prompt from the end, then reversing+-- back: 'takeWhile' from the end stops at the most recent prompt, so what+-- survives is exactly the lines after it (or all lines if there is no prompt).+linesAfterLastUserPrompt :: [TranscriptLine] -> [TranscriptLine]+linesAfterLastUserPrompt = reverse . takeWhile (not . isRealUserPrompt) . reverse++isRealUserPrompt :: TranscriptLine -> Bool+isRealUserPrompt = \case+  RealUserPrompt -> True+  AssistantText _ -> False+  OtherLine -> False++-- | Parse the transcript file into classified lines. Blank lines and lines that+-- are not valid JSON classify as OtherLine; the transcript is appended to live+-- and the tail can be a partial write, so a single unparseable line is expected+-- noise, not a failure of the whole turn.+readLines :: FilePath -> IO [TranscriptLine]+readLines path = do+  contents <- ByteString.readFile path+  pure (map classifyRaw (ByteString.lines contents))++classifyRaw :: ByteString.ByteString -> TranscriptLine+classifyRaw raw = maybe OtherLine classifyLine (Aeson.decodeStrict raw)

@@ -0,0 +1,184 @@+-- | Per-turn state kept on tmpfs, shared by the hooks and the three Stop-gate+-- phases (dumbify, critique, rule review).+--+-- A "turn" is one user prompt and everything the agent does to satisfy it.+-- record-edit appends to the review stack during the turn; each Stop-gate phase+-- keeps its own done/round/editmark/approved flags here so it converges across+-- the turn's repeated Stops; reset wipes the whole directory when the next user+-- prompt arrives. All of it lives under @$TMPDIR/claude-turn-state/<session>@.+module Claude.Gate.TurnState+  ( TurnPaths(..)+  , turnPaths+  , sanitiseSession+  , ensureStateDir+  , resetState+  , claimReviewStack+  , flagExists+  , writeFlag+  , readCounter+  , writeCounter+  , readMark+  , stackLineCount+  , fileNonEmpty+  , removeIfExists+  ) where++import Control.Monad (when)++import Data.ByteString.Char8 qualified as ByteString+import Data.Char (isAsciiLower, isAsciiUpper, isDigit, isSpace)+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as Text+import System.Directory (createDirectoryIfMissing, doesFileExist, getFileSize, removeFile, removePathForcibly, renameFile)+import System.Environment (lookupEnv)+import System.FilePath ((</>))+import Text.Read (readMaybe)++-- | Every state file for one session. Grouping them keeps the on-disk layout in+-- one place rather than recomputed in each phase. The @*Done@ flags stop a phase+-- re-running once it has converged this turn; @*Round@ counts rounds against the+-- per-phase cap; @*Editmark@ records the edit-stack size a block was based on so+-- the next Stop can tell a fix (stack grew) from a shrug (unchanged); @*Approved@+-- records a clean pass for the end-of-gate notice; @*Broke@ is the once-per-turn+-- guard for surfacing an infrastructure failure.+data TurnPaths = TurnPaths+  { stateDir :: FilePath+  , reviewStack :: FilePath+  , claimedStack :: FilePath+  , dumbifyDone :: FilePath+  , dumbifyRound :: FilePath+  , dumbifyEditmark :: FilePath+  , dumbifyApproved :: FilePath+  , dumbifyBroke :: FilePath+  , critiqueDone :: FilePath+  , critiqueRound :: FilePath+  , critiquePrev :: FilePath+  , critiqueEditmark :: FilePath+  , critiqueApproved :: FilePath+  , critiqueBroke :: FilePath+  , reviewApproved :: FilePath+  , reviewBroke :: FilePath+  }++-- | Resolve the state paths for a session id, reading TMPDIR the same way the+-- shell hooks did (defaulting to /tmp).+turnPaths :: Text -> IO TurnPaths+turnPaths session = do+  tmp <- fromMaybe "/tmp" <$> lookupEnv "TMPDIR"+  let dir = tmp </> "claude-turn-state" </> Text.unpack (sanitiseSession session)+  pure+    TurnPaths+      { stateDir = dir+      , reviewStack = dir </> "edits.jsonl"+      , claimedStack = dir </> "edits.processing"+      , dumbifyDone = dir </> "dumbify-done"+      , dumbifyRound = dir </> "dumbify-round"+      , dumbifyEditmark = dir </> "dumbify-editmark"+      , dumbifyApproved = dir </> "dumbify-approved"+      , dumbifyBroke = dir </> "dumbify-broke"+      , critiqueDone = dir </> "critique-done"+      , critiqueRound = dir </> "critique-round"+      , critiquePrev = dir </> "critique-prev"+      , critiqueEditmark = dir </> "critique-editmark"+      , critiqueApproved = dir </> "critique-approved"+      , critiqueBroke = dir </> "critique-broke"+      , reviewApproved = dir </> "review-approved"+      , reviewBroke = dir </> "review-broke"+      }++-- | Make the session id safe to use as a single path component by replacing any+-- character outside @[A-Za-z0-9_.-]@ with an underscore, matching the shell+-- @tr -c@ the hooks used.+sanitiseSession :: Text -> Text+sanitiseSession = Text.map keepOrUnderscore++keepOrUnderscore :: Char -> Char+keepOrUnderscore character+  | isSafe character = character+  | otherwise = '_'++isSafe :: Char -> Bool+isSafe character =+  isAsciiUpper character+    || isAsciiLower character+    || isDigit character+    || character == '_'+    || character == '.'+    || character == '-'++ensureStateDir :: TurnPaths -> IO ()+ensureStateDir paths = createDirectoryIfMissing True (stateDir paths)++-- | Wipe a session's state directory. Used by the UserPromptSubmit reset so the+-- previous turn's review stack and per-phase flags do not leak into the next.+resetState :: TurnPaths -> IO ()+resetState paths = removePathForcibly (stateDir paths)++-- | Atomically claim the review stack: rename edits.jsonl to edits.processing+-- so any edit recorded after this point lands on a fresh stack and is reviewed+-- on the next Stop rather than lost. Returns whether there was a stack to claim.+claimReviewStack :: TurnPaths -> IO Bool+claimReviewStack paths = do+  hasStack <- doesFileExist (reviewStack paths)+  if hasStack+    then renameFile (reviewStack paths) (claimedStack paths) >> pure True+    else pure False++-- | Whether a marker/flag file is present.+flagExists :: FilePath -> IO Bool+flagExists = doesFileExist++-- | Create an empty marker file (the shell @: > flag@).+writeFlag :: FilePath -> IO ()+writeFlag path = writeFile path ""++-- | Read an integer counter file, defaulting to 0 when absent or unparseable.+readCounter :: FilePath -> IO Int+readCounter path = do+  present <- doesFileExist path+  if not present+    then pure 0+    else do+      -- Strict read. A lazy 'Prelude.readFile' leaves the handle open until the+      -- contents thunk is forced, and the very next 'writeCounter' (which is+      -- 'withFile' in WriteMode) on the same path then dies with "resource busy+      -- (file is locked)" under GHC's single-writer file locking. Reading+      -- strictly closes the handle before we return. See handleChallenge, which+      -- reads then immediately rewrites critique-round.+      contents <- ByteString.readFile path+      pure (fromMaybe 0 (readMaybe (filter (not . isSpace) (ByteString.unpack contents))))++writeCounter :: FilePath -> Int -> IO ()+writeCounter path n = writeFile path (show n)++-- | Read an editmark, distinguishing "no mark written yet" (Nothing) from a+-- recorded count: a phase only treats an unchanged stack as a shrug when it+-- actually wrote a mark on a previous Stop this turn.+readMark :: FilePath -> IO (Maybe Int)+readMark path = do+  present <- doesFileExist path+  if present then Just <$> readCounter path else pure Nothing++-- | The number of recorded edits, i.e. non-empty lines on a stack file. Used as+-- the convergence signal: it grows when the worker makes new edits.+stackLineCount :: FilePath -> IO Int+stackLineCount path = do+  present <- doesFileExist path+  if not present+    then pure 0+    else do+      contents <- ByteString.readFile path+      pure (length (filter (not . ByteString.null) (ByteString.lines contents)))++-- | Whether a file exists and has non-zero size.+fileNonEmpty :: FilePath -> IO Bool+fileNonEmpty path = do+  present <- doesFileExist path+  if present then (> 0) <$> getFileSize path else pure False++-- | Remove a file if it is there; absence is fine.+removeIfExists :: FilePath -> IO ()+removeIfExists path = do+  present <- doesFileExist path+  when present (removeFile path)

@@ -0,0 +1,386 @@+module Main (main) where++import Control.Exception (ErrorCall (ErrorCall), SomeException, displayException, throwIO, try)+import Data.Aeson (Result (Success), Value, eitherDecode, eitherDecodeStrict, encode, fromJSON, toJSON)+import Data.ByteString.Lazy qualified as LazyByteString+import Data.ByteString.Char8 qualified as ByteString+import Data.List (isInfixOf)+import Data.Text (Text)+import Data.Text qualified as Text+import Claude.Gate.Corpus (selectSkills)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Claude.Gate.Critique+  ( CritiqueDossier (DossierReady, EmptyDossier)+  , EditPresence (EditsRecorded, NoEditsRecorded)+  , RoundBudget (RoundBudget)+  , classifyDossier+  , critiqueAnchor+  , critiqueDiffBlock+  , recentClaims+  , retryWhileEmpty+  )+import Claude.Gate.DiffRender (renderDiffs)+import Claude.Gate.Edit (Edit (..), Replacement (..), editFilePath, parseEditFromTool)+import Claude.Gate.RecordEdit (SkipReason (..), pathSkipReason)+import Claude.Gate.ReviewPrompt (hasViolations)+import Claude.Gate.SpawnAnnotation (annotateSpawn)+import Claude.Gate.Transcript (turnAssistantText)+import Claude.Gate.TurnState (readCounter, writeCounter)+import Hedgehog (Gen, Property, forAll, property, (===))+import Hedgehog.Gen qualified as Gen+import Hedgehog.Range qualified as Range+import System.Directory (getTemporaryDirectory)+import System.FilePath ((</>))+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.Hedgehog (testProperty)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests =+  testGroup+    "claude-gate"+    [ transcriptTests+    , skillSelectionTests+    , skipReasonTests+    , violationTests+    , editRoundTripTests+    , editPropertyTests+    , critiqueDiffTests+    , recentClaimsTests+    , critiqueAnchorTests+    , claimsRetryTests+    , dossierTests+    , counterTests+    , spawnAnnotationTests+    ]++-- The claims blob accumulates across a turn's critique rounds and is+-- chronological, so when it exceeds the budget the critic must keep the NEWEST+-- claims (the current round) and drop the oldest. A front trim (the old+-- Text.take) kept the oldest and dropped the newest, which is what fed the critic+-- stale claims. These assert the tail survives and the head is dropped.++recentClaimsTests :: TestTree+recentClaimsTests =+  testGroup+    "recentClaims"+    [ testCase "keeps the newest claims and drops the oldest over budget" $ do+        let oldest = "OLDEST-round-1-run-A"+            newest = "NEWEST-round-3-run-C"+            blob = oldest <> Text.replicate 200 "x" <> newest+            trimmed = recentClaims (Text.length newest + 20) blob+        assertBool "the current round's claim survives" (Text.isInfixOf newest trimmed)+        assertBool "the stale first round's claim is dropped" (not (Text.isInfixOf oldest trimmed))+    , testCase "claims within budget pass through unchanged" $+        recentClaims 1000 "short claim" @?= "short claim"+    ]++-- The anchor threads the round and the commit history into the prompt. The one+-- piece of logic (not static text) is that a missing history is turned into an+-- explicit placeholder rather than dropped, and a present history is carried+-- through verbatim so the critic actually sees the real commit order.++critiqueAnchorTests :: TestTree+critiqueAnchorTests =+  testGroup+    "critiqueAnchor"+    [ testCase "a present commit history is carried through verbatim" $+        assertBool+          "the supplied history appears in the anchor"+          (Text.isInfixOf "deadbeef 2026-07-10T12:00:00Z fix the thing" (critiqueAnchor (RoundBudget 2 3) (Just "deadbeef 2026-07-10T12:00:00Z fix the thing")))+    , testCase "a missing history becomes an explicit placeholder, not a blank" $+        assertBool+          "the placeholder names the missing history"+          (Text.isInfixOf "unavailable" (critiqueAnchor (RoundBudget 1 2) Nothing))+    ]++-- The transcript can lag the Stop hook (the final assistant message flushes+-- after the hook fires), so the claims read polls via 'retryWhileEmpty'. These+-- drive the real retry loop with a scripted sequence of reads: it must return+-- at the first non-blank read, keep polling past blank ones, and hand back the+-- final blank result when the budget runs out so the caller can fail loud.++claimsRetryTests :: TestTree+claimsRetryTests =+  testGroup+    "retryWhileEmpty"+    [ testCase "returns at the first non-blank read without extra attempts" $ do+        (result, reads') <- scriptedRetry 5 ["claims right away"]+        result @?= "claims right away"+        reads' @?= 1+    , testCase "polls past blank reads until text appears" $ do+        (result, reads') <- scriptedRetry 5 ["", "  \n  ", "late claims"]+        result @?= "late claims"+        reads' @?= 3+    , testCase "gives up blank after the attempt budget so the caller can fail loud" $ do+        (result, reads') <- scriptedRetry 3 ["", "", "", "", ""]+        result @?= ""+        reads' @?= 3+    ]++-- | Drive 'retryWhileEmpty' (with no pause between attempts) through a+-- scripted sequence of reads, returning the final result and the number of+-- reads it consumed.+scriptedRetry :: Int -> [Text] -> IO (Text, Int)+scriptedRetry attempts script = do+  counter <- newIORef (0 :: Int)+  result <- retryWhileEmpty attempts 0 (nextScriptedRead counter script)+  reads' <- readIORef counter+  pure (result, reads')++nextScriptedRead :: IORef Int -> [Text] -> IO Text+nextScriptedRead counter script = do+  index <- readIORef counter+  writeIORef counter (index + 1)+  case drop index script of+    [] -> throwIO (ErrorCall "scripted retry consumed more reads than the test provided")+    next : _ -> pure next++-- The empty-dossier rule: a critic spawned with neither claims nor edits can+-- only answer OK, and that OK must never be recorded as approval. The+-- classification decides between failing loud and spawning the critic, so a+-- wrong verdict here either wedges healthy turns or silently green-stamps+-- unchecked ones.++dossierTests :: TestTree+dossierTests =+  testGroup+    "classifyDossier"+    [ testCase "no claims and no edits is an empty dossier" $+        classifyDossier "" NoEditsRecorded @?= EmptyDossier+    , testCase "whitespace-only claims count as no claims" $+        classifyDossier "  \n \t " NoEditsRecorded @?= EmptyDossier+    , testCase "claims alone are enough to critique" $+        classifyDossier "I fixed the bug" NoEditsRecorded @?= DossierReady+    , testCase "edits alone are enough to critique" $+        classifyDossier "" EditsRecorded @?= DossierReady+    ]++-- A spawn that fails (a missing binary, or a /bin symlink left dangling by a+-- nix GC) must not vanish into a bare posix_spawnp error: 'annotateSpawn' tags+-- the exception with its command so an uncaught crash, or a displayException of+-- a caught one, names the call site. The assertion drives a real exception+-- through 'annotateSpawn' and checks the label survives into displayException.++spawnAnnotationTests :: TestTree+spawnAnnotationTests =+  testGroup+    "annotateSpawn"+    [ testCase "a failing spawn carries its call site into displayException" $ do+        let spawnLabel = "git -C /x rev-parse --show-toplevel"+        outcome <- try (annotateSpawn spawnLabel (throwIO (ErrorCall "spawn blew up")))+        case (outcome :: Either SomeException ()) of+          Right () -> assertFailure "expected the wrapped action to throw"+          Left err ->+            assertBool+              "displayException names the spawn call site"+              (spawnLabel `isInfixOf` displayException err)+    ]++-- A read-then-write on the same counter file, the exact sequence handleChallenge+-- runs on critique-round. With a lazy 'readFile' inside 'readCounter' the read+-- handle is still open when 'writeCounter' opens the path in WriteMode, and GHC's+-- single-writer file lock aborts with "resource busy (file is locked)". The+-- assertion is that the cycle completes and round-trips the value.+counterTests :: TestTree+counterTests =+  testGroup+    "TurnState counters"+    [ testCase "readCounter then writeCounter on the same path does not lock" $ do+        dir <- getTemporaryDirectory+        let path = dir </> "claude-gate-counter-roundtrip"+        writeCounter path 1+        previous <- readCounter path+        writeCounter path (previous + 1)+        final <- readCounter path+        final @?= 2+    ]++-- The critique claims-extraction end to end: write a transcript file and ask the+-- real 'turnAssistantText' for the assistant prose since the last real user+-- prompt. This exercises line parsing, "since the last real user prompt", and+-- text-block extraction together, which is where the gnarly logic lives.++transcriptTests :: TestTree+transcriptTests =+  testGroup+    "turnAssistantText"+    [ testCase "collects assistant text after the last user prompt" $ do+        claims <- claimsFor "after" [userPrompt, assistantSays "I fixed the bug"]+        claims @?= "I fixed the bug"+    , testCase "ignores assistant text before the last user prompt" $ do+        -- The first claim is from a previous turn; only the latest turn counts.+        claims <- claimsFor "before" [assistantSays "old claim", userPrompt, assistantSays "new claim"]+        claims @?= "new claim"+    , testCase "joins multiple assistant turns with newlines" $ do+        claims <- claimsFor "multi" [userPrompt, assistantSays "first", assistantSays "second"]+        claims @?= "first\nsecond"+    , testCase "a tool-reply user entry is not a turn boundary" $ do+        -- The array-content user entry is a tool result, not a real prompt, so+        -- the earlier claim is still in this turn.+        claims <- claimsFor "toolreply" [userPrompt, assistantSays "before tool", toolResult, assistantSays "after tool"]+        claims @?= "before tool\nafter tool"+    ]++claimsFor :: String -> [Text] -> IO Text+claimsFor name transcriptLines = do+  tmp <- getTemporaryDirectory+  let path = tmp </> ("claude-gate-test-" <> name <> ".jsonl")+  writeFile path (Text.unpack (Text.unlines transcriptLines))+  turnAssistantText path++userPrompt :: Text+userPrompt = "{\"type\":\"user\",\"message\":{\"content\":\"do the thing\"}}"++toolResult :: Text+toolResult = "{\"type\":\"user\",\"message\":{\"content\":[{\"type\":\"tool_result\",\"content\":\"ok\"}]}}"++assistantSays :: Text -> Text+assistantSays text =+  "{\"type\":\"assistant\",\"message\":{\"content\":[{\"type\":\"text\",\"text\":\""+    <> text+    <> "\"}]}}"++-- Skill selection maps touched extensions to the relevant language skills.++skillSelectionTests :: TestTree+skillSelectionTests =+  testGroup+    "selectSkills"+    [ testCase "haskell sources pull in the haskell skills" $+        selectSkills ["src/Foo.hs"]+          @?= ["error-messages", "haskell-backpack", "haskell-project", "unwitch-conversions", "verify-test-fails"]+    , testCase "nix files pull in the nix skills" $+        selectSkills ["default.nix"] @?= ["ci-nix", "nix"]+    , testCase "unrelated files select nothing" $+        selectSkills ["notes.md"] @?= []+    , testCase "results are deduplicated across many files" $+        selectSkills ["A.hs", "B.hs", "x.cabal"]+          @?= ["error-messages", "haskell-backpack", "haskell-project", "unwitch-conversions", "verify-test-fails"]+    ]++-- The record filter: which paths are skipped and why.++skipReasonTests :: TestTree+skipReasonTests =+  testGroup+    "pathSkipReason"+    [ testCase "haskell source is reviewed" $ pathSkipReason "src/Foo.hs" @?= Nothing+    , testCase "json is skipped as binary-ish" $ pathSkipReason "package.json" @?= Just SkipBinaryExtension+    , testCase "archives are skipped" $ pathSkipReason "bundle.tar.gz" @?= Just SkipArchive+    , testCase "build artifacts under dist-newstyle are skipped" $+        pathSkipReason "/home/x/dist-newstyle/build/Foo.hs" @?= Just SkipBuildArtifact+    , testCase "the result symlink is skipped" $ pathSkipReason "/home/x/result" @?= Just SkipBuildArtifact+    ]++-- Reviewer-reply parsing: only a VIOLATION line means findings.++violationTests :: TestTree+violationTests =+  testGroup+    "hasViolations"+    [ testCase "the clean reply OK is not a violation" $ hasViolations "OK\n" @?= False+    , testCase "empty output is not a violation" $ hasViolations "" @?= False+    , testCase "a VIOLATION block is a violation" $+        hasViolations "VIOLATION: used a wildcard\nRULE: \"...\"\n" @?= True+    , testCase "the word violation mid-line is not a violation" $+        hasViolations "no violation here\n" @?= False+    ]++-- Edits survive the persist/reload round trip the two hooks rely on, and the+-- reconstructed diff shows the new text under the right label.++editRoundTripTests :: TestTree+editRoundTripTests =+  testGroup+    "edit persistence"+    [ testCase "an Edit round-trips and renders its new text" $ do+        edit <- parsedEdit "Edit" "{\"file_path\":\"src/Foo.hs\",\"old_string\":\"old line\",\"new_string\":\"new line\"}"+        reloaded <- reencode edit+        editFilePath reloaded @?= "src/Foo.hs"+        let rendered = renderDiffs [reloaded]+        assertBool "new text under --- with ---" (Text.isInfixOf "--- with ---\nnew line" rendered)+        assertBool "old text under --- replaced ---" (Text.isInfixOf "--- replaced ---\nold line" rendered)+    , testCase "a Write round-trips and renders its content" $ do+        edit <- parsedEdit "Write" "{\"file_path\":\"a.txt\",\"content\":\"hello body\"}"+        reloaded <- reencode edit+        assertBool "content under --- new content ---" (Text.isInfixOf "--- new content ---\nhello body" (renderDiffs [reloaded]))+    ]++-- The critic runs on every turn, including conversational ones with no edits. On+-- such a turn there is no review stack on disk, so the diff block must come back+-- as the placeholder WITHOUT reading (and crashing on) the absent stack file.+-- This is the regression: the old code read the stack unconditionally and died on+-- a missing edits.jsonl, which silently killed the whole critique phase.++critiqueDiffTests :: TestTree+critiqueDiffTests =+  testGroup+    "critiqueDiffBlock"+    [ testCase "a no-edit turn yields the placeholder without touching the stack" $ do+        block <- critiqueDiffBlock NoEditsRecorded "/no/such/edits.jsonl"+        block @?= "(no file edits this turn)"+    , testCase "an edited turn renders the recorded diff" $ do+        edit <- parsedEdit "Edit" "{\"file_path\":\"src/Foo.hs\",\"old_string\":\"old line\",\"new_string\":\"new line\"}"+        stackPath <- writeStack "critique-edits" [edit]+        block <- critiqueDiffBlock EditsRecorded stackPath+        assertBool "new text appears in the diff block" (Text.isInfixOf "new line" block)+    ]++-- | Write edits to a stack file in the one-JSON-per-line form record-edit uses,+-- so the reader under test sees exactly what production writes.+writeStack :: String -> [Edit] -> IO FilePath+writeStack name edits = do+  tmp <- getTemporaryDirectory+  let path = tmp </> ("claude-gate-test-" <> name <> ".jsonl")+  LazyByteString.writeFile path (LazyByteString.intercalate "\n" (map encode edits))+  pure path++parsedEdit :: Text -> ByteString.ByteString -> IO Edit+parsedEdit tool inputJson = case eitherDecodeStrict inputJson of+  Left err -> fail ("test fixture is not valid JSON: " <> err)+  Right (value :: Value) -> case parseEditFromTool tool value of+    Left err -> fail ("parseEditFromTool failed: " <> err)+    Right edit -> pure edit++reencode :: Edit -> IO Edit+reencode edit = case eitherDecode (encode edit) of+  Left err -> fail ("edit did not round-trip: " <> err)+  Right reloaded -> pure reloaded++-- The JSON instances the two hooks rely on must satisfy+-- fromJSON (toJSON e) == Success e for every edit shape, checked over+-- generated inputs rather than the few hand-written fixtures above.++editPropertyTests :: TestTree+editPropertyTests =+  testGroup+    "edit JSON property"+    [ testProperty "fromJSON . toJSON == Success" editJsonRoundTrip+    ]++editJsonRoundTrip :: Property+editJsonRoundTrip = property $ do+  edit <- forAll genEdit+  fromJSON (toJSON edit) === Success edit++genEdit :: Gen Edit+genEdit =+  Gen.choice+    [ SingleEdit <$> genPath <*> genReplacement+    , MultiEditFile <$> genPath <*> Gen.list (Range.linear 0 4) genReplacement+    , WriteFileContent <$> genPath <*> genText+    , NotebookCellSource <$> genPath <*> genText+    ]++genReplacement :: Gen Replacement+genReplacement = Replacement <$> genText <*> genText++genText :: Gen Text+genText = Gen.text (Range.linear 0 40) Gen.unicode++genPath :: Gen FilePath+genPath = Gen.string (Range.linear 1 30) Gen.alphaNum