packages feed

baikai-agent (empty) → 0.1.0.0

raw patch · 10 files changed

+5233/−0 lines, 10 filesdep +aesondep +baikaidep +baikai-agent

Dependencies added: aeson, baikai, baikai-agent, baikai-claude, baikai-openai, base, bytestring, containers, directory, filepath, generic-lens, lens, optparse-applicative, process, settei, settei-env, settei-kdl, settei-optparse-applicative, streamly-core, tasty, tasty-hunit, temporary, text, time, unix

Files

+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2026 Nadeem Bitar++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ app/Main.hs view
@@ -0,0 +1,48 @@+-- | The @baikai@ executable.+--+-- Deliberately thin. Everything real lives in "Baikai.Agent.Cli", which+-- returns an 'AgentCliRun' rather than writing to streams or exiting, so+-- the whole command-line surface is reachable from the test suite+-- without spawning this binary. This module's only job is to interpret+-- that record into real streams and a real exit code.+module Main (main) where++import Baikai.Agent.Cli+  ( AgentCliRun,+    agentCliParserInfo,+    runAgentCli,+  )+import Control.Lens ((^.))+import Data.Generics.Labels ()+import Data.Text qualified as Text+import Data.Text.IO qualified as TextIO+import Options.Applicative qualified as Options+import Settei.Env (EnvSnapshot, envSnapshot)+import System.Environment (getEnvironment)+import System.Exit (ExitCode (..), exitWith)+import System.IO (stderr, stdout)++main :: IO ()+main = do+  options <- Options.execParser agentCliParserInfo+  snapshot <- captureEnvironment+  finished <- runAgentCli snapshot options+  emit finished+  exitWith (exitCodeFrom (finished ^. #exitCode))++-- | Snapshot the real environment once. @settei@ takes the snapshot as+-- a value rather than reading the environment itself, which is what+-- makes the layer testable without mutating the process.+captureEnvironment :: IO EnvSnapshot+captureEnvironment = do+  values <- getEnvironment+  pure (envSnapshot [(Text.pack name, Text.pack value) | (name, value) <- values])++emit :: AgentCliRun -> IO ()+emit finished = do+  TextIO.hPutStr stdout (finished ^. #standardOutput)+  TextIO.hPutStr stderr (finished ^. #standardError)++exitCodeFrom :: Int -> ExitCode+exitCodeFrom 0 = ExitSuccess+exitCodeFrom code = ExitFailure code
+ baikai-agent.cabal view
@@ -0,0 +1,138 @@+cabal-version: 3.4+name:          baikai-agent+version:       0.1.0.0+synopsis:      Unattended coding-agent runs for the Baikai abstraction+description:+  Runs a local coding-agent command-line tool with no terminal and no+  human present: delivers the prompt on standard input, drains both+  output streams concurrently within a byte limit, and on timeout+  terminates the child's whole process group. The provider-neutral+  vocabulary lives in @Baikai.Agent@ in the core package, and vendor+  packages own the translation into each tool's argument vector.++category:      AI+license:       BSD-3-Clause+license-file:  LICENSE+author:        Nadeem Bitar+maintainer:    nadeem@gmail.com+copyright:     (c) 2026 Nadeem Bitar+build-type:    Simple++common common-options+  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-uni-patterns+    -Wincomplete-record-updates -Wredundant-constraints+    -fhide-source-paths -Wmissing-export-lists -Wpartial-fields+    -Wmissing-deriving-strategies++  -- Exhaustiveness is an error, not a warning. A non-exhaustive match+  -- is a crash the compiler already found: it fails at runtime, on+  -- whichever input reaches the missing branch, usually in front of a+  -- user. This is not hypothetical here — adding a constructor to+  -- AgentRunFailure left `failureExitCode` non-exhaustive and shipped a+  -- pattern-match failure on `baikai agent run --require-evidence`,+  -- because the warning scrolled past in a build log.+  --+  -- Promoted individually rather than through -Werror, which would also+  -- fail the build on warnings that are stylistic or that a future GHC+  -- invents, and would push people toward blanket suppression.+  ghc-options:+    -Werror=incomplete-patterns -Werror=incomplete-uni-patterns+    -Werror=incomplete-record-updates++  default-language:   GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    OverloadedLabels+    OverloadedStrings++library+  import:          common-options+  hs-source-dirs:  src+  exposed-modules:+    Baikai.Agent.Cli+    Baikai.Agent.Config+    Baikai.Agent.Run++  build-depends:+    , aeson                        ^>=2.2+    , baikai                       ^>=0.5.0+    , baikai-claude                ^>=0.5+    , baikai-openai                ^>=0.5+    , base                         >=4.20   && <5+    , bytestring                   ^>=0.12+    , containers                   ^>=0.7+    , directory                    ^>=1.3+    , filepath                     ^>=1.5+    , generic-lens                 ^>=2.3+    , lens                         ^>=5.3+    , optparse-applicative         ^>=0.19+    , process                      ^>=1.6+    , settei                       ^>=0.2+    , settei-env                   ^>=0.2+    , settei-kdl                   ^>=0.2+    , settei-optparse-applicative  ^>=0.2+    , streamly-core                >=0.3    && <0.5+    , text                         ^>=2.1+    , time                         ^>=1.14++  -- The process package offers a group-wide interrupt but no group-wide+  -- terminate, which a timeout needs to reach a coding agent's own+  -- children. Where POSIX signals exist, use them.+  if !os(windows)+    build-depends: unix ^>=2.8+    cpp-options:   -DBAIKAI_POSIX_SIGNALS++executable baikai+  import:         common-options+  hs-source-dirs: app+  main-is:        Main.hs++  -- Deliberately thin: everything real lives in Baikai.Agent.Cli so the+  -- whole command-line surface is reachable from the test suite without+  -- spawning the built binary.+  build-depends:+    , baikai-agent+    , base                  >=4.20  && <5+    , generic-lens          ^>=2.3+    , lens                  ^>=5.3+    , optparse-applicative  ^>=0.19+    , settei-env            ^>=0.2+    , text                  ^>=2.1++test-suite baikai-agent-test+  import:         common-options+  type:           exitcode-stdio-1.0+  hs-source-dirs: test+  main-is:        Main.hs+  other-modules:+    CliTests+    ConfigTests+    EvidenceTests++  -- -threaded is not optional here: the runner forks threads to drain+  -- pipes and relies on System.Timeout interrupting a blocking wait.+  ghc-options:    -threaded -with-rtsopts=-N+  build-depends:+    , aeson+    , baikai+    , baikai-agent+    , base+    , bytestring+    , containers+    , directory+    , filepath+    , generic-lens+    , lens+    , optparse-applicative+    , process+    , settei+    , settei-env+    , settei-kdl+    , settei-optparse-applicative+    , tasty+    , tasty-hunit+    , temporary+    , text+    , time
+ src/Baikai/Agent/Cli.hs view
@@ -0,0 +1,1236 @@+-- | The @baikai agent@ command-line surface: @run@, @show@, and+-- @list@.+--+-- This module is where the five earlier pieces of the unattended+-- surface meet. It resolves a named job from layered KDL configuration,+-- caps it against the operator's policy ceiling, dispatches it to the+-- vendor renderer for its provider, and hands the rendered command to+-- the process runner. It is also the only place in the codebase that+-- knows both providers.+--+-- Everything real lives here rather than in @app\/Main.hs@ so the whole+-- surface is reachable from a test without spawning the built binary.+-- 'runAgentCli' returns an 'AgentCliRun' — an exit code and two captured+-- streams — and the executable's only job is to interpret that record.+--+-- __Stream discipline__, because a shell script depends on it. Baikai's+-- own diagnostics always go to standard error. The agent's own output+-- follows the job's configured output mode: under @inherit@ it goes+-- straight to the real streams and never enters 'AgentCliRun' at all,+-- under @capture@ Baikai holds it and returns it, and under @tee@ both+-- happen. That is what makes @response=$(baikai agent run job)@ yield+-- the agent's answer and nothing else for a capturing job, while a human+-- watching still sees diagnostics.+module Baikai.Agent.Cli+  ( -- * The parsed command line+    AgentCliCommand (..),+    PromptSource (..),+    AgentCliOptions (..),+    agentCliParser,+    agentCliParserInfo,++    -- * Running it+    AgentCliRun (..),+    runAgentCli,+    runAgentCliWithPaths,++    -- * Provider dispatch+    renderJobCommand,++    -- * Exit codes+    usageExitCode,+    unavailableExitCode,+    internalExitCode,+    timeoutExitCode,+    refusedExitCode,+    configExitCode,++    -- * Exposed for testing+    readPromptSource,+    renderEffectiveConfig,+  )+where++import Baikai.Agent+  ( AgentCapturedOutput (..),+    AgentCeiling,+    AgentCommand,+    AgentOutputMode (..),+    AgentPromptTransport (..),+    AgentProvider (..),+    AgentRenderError,+    AgentRunFailure (..),+    AgentRunRequest,+    AgentRunResult,+    renderAgentCapability,+    renderAgentProvider,+    renderAgentRenderError,+    renderAgentRunFailure,+  )+import Baikai.Agent.Config+  ( AgentConfigPaths (..),+    AgentJob,+    agentJobRequest,+    applyCeilingToJob,+    defaultAgentConfigPaths,+    listAgentJobs,+    loadAgentCeiling,+    renderAgentConfigError,+    renderAgentConfigScope,+    resolveAgentJob,+  )+import Baikai.Agent.Run (runAgentCommand)+import Baikai.Evidence+  ( EvidenceRequest (..),+    EvidenceStrength (..),+    EvidenceStrictness (..),+    ModelCallEvidence,+    ThinkingTranslation,+    evidenceRequest,+  )+import Baikai.Provider.Claude.Agent+  ( ClaudeAgentConfig,+    claudeAgentCommand,+    defaultClaudeAgentConfig,+  )+import Baikai.Provider.OpenAI.Agent+  ( CodexAgentConfig,+    codexAgentCommand,+    defaultCodexAgentConfig,+  )+import Control.Applicative ((<|>))+import Control.Exception (IOException, displayException, try)+import Control.Lens ((&), (.~), (^.))+import Data.Aeson qualified as Aeson+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BSL+import Data.Char (isControl, ord)+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import GHC.Generics (Generic)+import Numeric (showHex)+import Options.Applicative (Parser, ParserInfo)+import Options.Applicative qualified as Options+import Settei.Env (EnvSnapshot)+import Settei.Key (keySegments, mkKey, parseKey, renderKey)+import Settei.Optparse (CliOverride, cliOverride, cliOverrideKey, cliOverrideValue)+import Settei.Origin (Origin, SourceKind (..), SourceLocation)+import Settei.Provenance (renderReportedValue)+import Settei.Render (renderErrorsText, renderResolutionJson, renderWarningsText)+import Settei.Report+  ( ResolutionOutcome (..),+    ResolutionReport,+    reportNodes,+  )+import Settei.Value (RawValue (..))+import System.Directory (doesFileExist, renameFile)+import System.Exit (ExitCode (..))+import System.IO (stdin)++-- | Which of the three commands was asked for.+data AgentCliCommand+  = -- | Run a named job, taking the prompt from the given source.+    AgentRun !Text !PromptSource+  | -- | Explain a named job without starting anything.+    AgentShow !Text+  | -- | Enumerate the configured jobs.+    AgentList+  deriving stock (Eq, Show, Generic)++-- | Where the prompt comes from. The three are mutually exclusive on+-- the command line, so supplying two is a usage error rather than a+-- silent precedence puzzle.+data PromptSource+  = PromptStdin+  | PromptFile !FilePath+  | PromptInline !Text+  deriving stock (Eq, Show, Generic)++-- | The parsed command line, before any file is opened.+data AgentCliOptions = AgentCliOptions+  { command :: !AgentCliCommand,+    -- | Parsed @--set@ overrides, __with keys as the operator wrote+    -- them__. A key that does not already begin with the @jobs@ segment+    -- is job-relative and is rewritten to @jobs.\<job\>.\<key\>@ before+    -- resolution; the job name is not known while parsing, so the+    -- rewrite cannot happen here.+    overrides :: ![CliOverride],+    -- | Explicit operator-scope file, overriding discovery.+    userConfig :: !(Maybe FilePath),+    -- | Explicit repository-scope file, overriding discovery.+    repoConfig :: !(Maybe FilePath),+    jsonOutput :: !Bool,+    -- | Where to write the run's evidence record, from+    -- @--evidence-file@. Only @run@ accepts it; the other two commands+    -- start nothing and so have nothing to record.+    evidenceFile :: !(Maybe FilePath),+    -- | The caller's identifier for the logical run this invocation+    -- belongs to, from @--run-id@.+    runId :: !(Maybe Text),+    -- | The evidence strength this run must reach, from+    -- @--require-evidence@. Setting it turns recording on and makes the+    -- run refuse rather than start when the configuration cannot+    -- produce it.+    requiredEvidence :: !(Maybe EvidenceStrength)+  }+  deriving stock (Generic)++-- | One capturable run of the command-line surface.+--+-- 'standardOutput' and 'standardError' are __Baikai's__ output. Under+-- the @inherit@ and @tee@ output modes the agent's own output goes+-- straight to the real process streams and bypasses this record+-- entirely, which is correct and is what the motivating consumer wants.+data AgentCliRun = AgentCliRun+  { exitCode :: !Int,+    standardOutput :: !Text,+    standardError :: !Text+  }+  deriving stock (Eq, Show, Generic)++usageExitCode,+  unavailableExitCode,+  internalExitCode,+  timeoutExitCode,+  refusedExitCode,+  configExitCode ::+    Int++-- | The command line could not be parsed, or the prompt was empty.+--+-- Baikai's own failures start at 64 and follow the @sysexits@+-- convention, because the coding agent's own exit code passes through+-- unchanged and the two must stay separable. Coding agents+-- conventionally exit 0 or 1, so in practice they do; the residual+-- ambiguity when a provider exits 64 or above is documented rather than+-- hidden, and @--json@ carries the unambiguous answer.+usageExitCode = 64++-- | The coding-agent executable could not be started.+unavailableExitCode = 69++-- | The agent produced output the caller could not interpret.+internalExitCode = 70++-- | The run exceeded its timeout and its process group was terminated.+timeoutExitCode = 75++-- | Policy refused the run: the ceiling was exceeded, or the provider+-- cannot express the requested policy. Nothing was started.+refusedExitCode = 77++-- | Configuration was missing, unreadable, or invalid.+configExitCode = 78++-- --------------------------------------------------------------------+-- Parsing+-- --------------------------------------------------------------------++-- | Complete parser metadata, including the usage-error exit code.+--+-- Without 'Options.failureCode' a mistyped flag would exit 1, which is+-- indistinguishable from a coding agent that ran and exited 1.+agentCliParserInfo :: ParserInfo AgentCliOptions+agentCliParserInfo =+  Options.info+    (agentCliParser Options.<**> Options.helper)+    ( Options.fullDesc+        <> Options.progDesc "Run unattended coding-agent jobs from configuration"+        <> Options.header "baikai - unattended coding-agent runs"+        <> Options.failureCode usageExitCode+    )++-- | The top level takes one subcommand group, @agent@, leaving room for+-- future groups without minting a new executable.+agentCliParser :: Parser AgentCliOptions+agentCliParser =+  Options.hsubparser+    ( Options.command+        "agent"+        ( Options.info+            agentGroupParser+            (Options.progDesc "Inspect and run unattended coding-agent jobs")+        )+    )++agentGroupParser :: Parser AgentCliOptions+agentGroupParser =+  Options.hsubparser+    ( Options.command+        "run"+        ( Options.info+            runOptionsParser+            (Options.progDesc "Run a configured job, propagating the agent's exit code")+        )+        <> Options.command+          "show"+          ( Options.info+              showOptionsParser+              (Options.progDesc "Print a job's effective configuration and rendered command")+          )+        <> Options.command+          "list"+          ( Options.info+              listOptionsParser+              (Options.progDesc "List the configured jobs and the scope each came from")+          )+    )++runOptionsParser :: Parser AgentCliOptions+runOptionsParser =+  assemble+    <$> jobArgument+    <*> promptSourceParser+    <*> Options.many overrideOption+    <*> Options.optional userConfigOption+    <*> Options.optional repoConfigOption+    <*> jsonSwitch+    <*> Options.optional evidenceFileOption+    <*> Options.optional runIdOption+    <*> Options.optional requireEvidenceOption+  where+    assemble+      jobName+      promptSource+      overrides+      userConfig+      repoConfig+      jsonOutput+      evidenceFile+      runId+      requiredEvidence =+        AgentCliOptions+          { command = AgentRun jobName promptSource,+            overrides,+            userConfig,+            repoConfig,+            jsonOutput,+            evidenceFile,+            runId,+            requiredEvidence+          }++showOptionsParser :: Parser AgentCliOptions+showOptionsParser =+  assemble+    <$> jobArgument+    <*> Options.many overrideOption+    <*> Options.optional userConfigOption+    <*> Options.optional repoConfigOption+    <*> jsonSwitch+  where+    assemble jobName overrides userConfig repoConfig jsonOutput =+      AgentCliOptions+        { command = AgentShow jobName,+          overrides,+          userConfig,+          repoConfig,+          jsonOutput,+          evidenceFile = Nothing,+          runId = Nothing,+          requiredEvidence = Nothing+        }++listOptionsParser :: Parser AgentCliOptions+listOptionsParser =+  assemble+    <$> Options.optional userConfigOption+    <*> Options.optional repoConfigOption+    <*> jsonSwitch+  where+    assemble userConfig repoConfig jsonOutput =+      AgentCliOptions+        { command = AgentList,+          overrides = [],+          userConfig,+          repoConfig,+          jsonOutput,+          evidenceFile = Nothing,+          runId = Nothing,+          requiredEvidence = Nothing+        }++jobArgument :: Parser Text+jobArgument =+  Options.strArgument+    (Options.metavar "JOB" <> Options.help "Name of the configured job")++-- | The three prompt sources are alternatives, so supplying two is a+-- usage error. @run@ requires one: an unattended agent with no+-- instruction is not a meaningful run.+promptSourceParser :: Parser PromptSource+promptSourceParser =+  Options.flag'+    PromptStdin+    ( Options.long "prompt-stdin"+        <> Options.help "Read the prompt from standard input"+    )+    <|> ( PromptFile+            <$> Options.strOption+              ( Options.long "prompt-file"+                  <> Options.metavar "PATH"+                  <> Options.help "Read the prompt from PATH"+              )+        )+    <|> ( PromptInline+            <$> Options.strOption+              ( Options.long "prompt"+                  <> Options.metavar "TEXT"+                  <> Options.help "Use TEXT as the prompt"+              )+        )++overrideOption :: Parser CliOverride+overrideOption =+  Options.option+    overrideReader+    ( Options.long "set"+        <> Options.metavar "KEY=VALUE"+        <> Options.help+          "Override one setting of the selected job; KEY is relative to the job \+          \unless it already starts with jobs."+    )++-- | Parse @KEY=VALUE@ into a @settei@ override, keeping the key exactly+-- as written.+--+-- This duplicates the shape of @settei@'s own @overrideOptions@ rather+-- than calling it, because the key here is normally job-relative and the+-- job name is not available while parsing. The value still becomes a+-- 'CliOverride' through @settei@'s own constructor, so it stays inside+-- the same provenance machinery as every other layer and its spelling+-- never carries the value.+overrideReader :: Options.ReadM CliOverride+overrideReader = Options.eitherReader $ \input ->+  let rendered = Text.pack input+      (keyText, assignment) = Text.breakOn "=" rendered+   in if Text.null assignment+        then Left "expected KEY=VALUE"+        else case parseKey keyText of+          Left problem -> Left ("invalid configuration key: " <> show problem)+          Right key -> Right (cliOverride key (Text.drop 1 assignment))++userConfigOption :: Parser FilePath+userConfigOption =+  Options.strOption+    ( Options.long "user-config"+        <> Options.metavar "PATH"+        <> Options.help "Read operator-scope configuration from PATH"+    )++repoConfigOption :: Parser FilePath+repoConfigOption =+  Options.strOption+    ( Options.long "config"+        <> Options.metavar "PATH"+        <> Options.help "Read repository-scope configuration from PATH"+    )++jsonSwitch :: Parser Bool+jsonSwitch =+  Options.switch+    (Options.long "json" <> Options.help "Emit machine-readable JSON")++evidenceFileOption :: Parser FilePath+evidenceFileOption =+  Options.strOption+    ( Options.long "evidence-file"+        <> Options.metavar "PATH"+        <> Options.help "Write the run's evidence record to PATH as one JSON object"+    )++runIdOption :: Parser Text+runIdOption =+  Options.strOption+    ( Options.long "run-id"+        <> Options.metavar "TEXT"+        <> Options.help "Identifier for the logical run this invocation belongs to"+    )++-- | @--require-evidence@ takes a strength name and refuses the run when+-- the configuration cannot reach it.+--+-- The names are the ones an evidence record spells, so an operator reads+-- a record's @strength@ and passes that word back verbatim.+requireEvidenceOption :: Parser EvidenceStrength+requireEvidenceOption =+  Options.option+    (Options.eitherReader parse)+    ( Options.long "require-evidence"+        <> Options.metavar "STRENGTH"+        <> Options.help+          "Refuse to start unless the run can produce evidence of at least this \+          \strength: requested_only, correlated, model_observed, or fully_observed"+    )+  where+    parse = \case+      "requested_only" -> Right EvidenceRequestedOnly+      "correlated" -> Right EvidenceCorrelated+      "model_observed" -> Right EvidenceModelObserved+      "fully_observed" -> Right EvidenceFullyObserved+      other ->+        Left+          ( "unknown evidence strength: "+              <> other+              <> " (expected requested_only, correlated, model_observed, or fully_observed)"+          )++-- --------------------------------------------------------------------+-- Provider dispatch+-- --------------------------------------------------------------------++-- | Turn a resolved job into a rendered command, or refuse.+--+-- __This is the only place in the codebase that knows both+-- providers.__ It is the answer to the improvement request's first+-- acceptance criterion — that a script select Claude Code or Codex+-- entirely through configuration — and if provider knowledge spreads to+-- a second site, adding a third provider later becomes a hunt.+--+-- Both the job and the request are taken even though the request was+-- built from the job. The renderers consume the request; the job carries+-- the executable override, for which 'AgentRunRequest' has no field+-- because it is a configuration concern rather than a run description.+-- The redundancy looks like an accident and is not.+--+-- The translation half of the pair says what the request's reasoning+-- effort became on that provider's command line. It is threaded through+-- rather than discarded here, because the runner cannot derive it: it+-- deliberately imports no vendor renderer.+renderJobCommand ::+  AgentJob ->+  AgentRunRequest ->+  Either AgentRenderError (AgentCommand, ThinkingTranslation)+renderJobCommand job request = case request ^. #provider of+  AgentClaude -> claudeAgentCommand (claudeConfigFor job) request+  AgentCodex -> codexAgentCommand (codexConfigFor job) request++claudeConfigFor :: AgentJob -> ClaudeAgentConfig+claudeConfigFor job =+  maybe+    defaultClaudeAgentConfig+    (\exe -> defaultClaudeAgentConfig & #executable .~ exe)+    (job ^. #executable)++codexConfigFor :: AgentJob -> CodexAgentConfig+codexConfigFor job =+  maybe+    defaultCodexAgentConfig+    (\exe -> defaultCodexAgentConfig & #executable .~ exe)+    (job ^. #executable)++-- --------------------------------------------------------------------+-- Running+-- --------------------------------------------------------------------++-- | Run the command line against the real configuration file+-- locations, with any explicit path overriding the discovered one.+runAgentCli :: EnvSnapshot -> AgentCliOptions -> IO AgentCliRun+runAgentCli snapshot options = do+  paths <- effectiveConfigPaths options+  runAgentCliWithPaths paths snapshot options++-- | Run the command line against explicitly supplied configuration+-- paths.+--+-- Tests use this rather than 'runAgentCli': a developer with a real+-- @~\/.config\/baikai\/agents.kdl@ would otherwise get different results+-- from a clean machine, and the failure would be baffling.+runAgentCliWithPaths ::+  AgentConfigPaths -> EnvSnapshot -> AgentCliOptions -> IO AgentCliRun+runAgentCliWithPaths paths snapshot options = case options ^. #command of+  AgentList -> listCommand paths options+  AgentShow jobName -> showCommand paths snapshot options jobName+  AgentRun jobName promptSource ->+    runCommand paths snapshot options jobName promptSource++-- | Discovery, with explicit paths winning per scope. When both scopes+-- are explicit nothing is discovered at all, so a fully specified+-- invocation never reads @HOME@ or @XDG_CONFIG_HOME@.+effectiveConfigPaths :: AgentCliOptions -> IO AgentConfigPaths+effectiveConfigPaths options =+  case (options ^. #userConfig, options ^. #repoConfig) of+    (Just user, Just repo) ->+      pure AgentConfigPaths {userConfig = Just user, repoConfig = Just repo}+    (user, repo) -> do+      discovered <- defaultAgentConfigPaths+      pure+        AgentConfigPaths+          { userConfig = user <|> discovered ^. #userConfig,+            repoConfig = repo <|> discovered ^. #repoConfig+          }++successfulRun :: Text -> Text -> AgentCliRun+successfulRun out err =+  AgentCliRun {exitCode = 0, standardOutput = out, standardError = err}++failedRun :: Int -> Text -> AgentCliRun+failedRun code message =+  AgentCliRun {exitCode = code, standardOutput = "", standardError = message}++-- --------------------------------------------------------------------+-- agent list+-- --------------------------------------------------------------------++listCommand :: AgentConfigPaths -> AgentCliOptions -> IO AgentCliRun+listCommand paths options = do+  listed <- listAgentJobs paths+  pure $ case listed of+    Left problem -> failedRun configExitCode (renderAgentConfigError problem <> "\n")+    Right entries+      | options ^. #jsonOutput -> successfulRun (jsonArray (map entryJson entries) <> "\n") ""+      -- An empty list is a normal state, not an error, and the note+      -- saying so goes to standard error so that a script piping the+      -- list never has to filter prose out of its data.+      | null entries -> successfulRun "" "no jobs are configured\n"+      | otherwise ->+          successfulRun+            (Text.unlines (map (entryLine (nameWidth entries)) entries))+            ""+  where+    nameWidth entries = maximum (0 : map (Text.length . (^. #name)) entries)+    entryLine width entry =+      Text.justifyLeft (width + 2) ' ' (entry ^. #name)+        <> renderAgentConfigScope (entry ^. #scope)+        <> ( if entry ^. #definingScopes > 1+               then " (also defined in another scope)"+               else ""+           )+    entryJson entry =+      jsonObject+        [ ("name", jsonString (entry ^. #name)),+          ("scope", jsonString (renderAgentConfigScope (entry ^. #scope))),+          ("definingScopes", Text.pack (show (entry ^. #definingScopes)))+        ]++-- --------------------------------------------------------------------+-- Shared resolution+-- --------------------------------------------------------------------++-- | Everything both @show@ and @run@ need before they diverge.+data StagedJob = StagedJob+  { job :: !AgentJob,+    report :: !ResolutionReport,+    warnings :: !Text,+    ceiling :: !AgentCeiling,+    ceilingSource :: !Text+  }+  deriving stock (Generic)++-- | A stage that ended before a job was ready.+data StageFailure = StageFailure+  { exitCode :: !Int,+    message :: !Text,+    -- | A failed resolution still carries a report, and for an explain+    -- command that provenance is exactly what the operator needs.+    report :: !(Maybe ResolutionReport),+    warnings :: !Text+  }+  deriving stock (Generic)++stageJob ::+  AgentConfigPaths ->+  EnvSnapshot ->+  AgentCliOptions ->+  Text ->+  IO (Either StageFailure StagedJob)+stageJob paths snapshot options jobName = do+  loaded <- resolveAgentJob paths snapshot (map (scopeOverride jobName) (options ^. #overrides)) jobName+  case loaded of+    Left problem -> pure (Left (configFailure (renderAgentConfigError problem)))+    Right resolved -> do+      let warningsText = renderWarningsText (resolved ^. #warnings)+      case resolved ^. #answer of+        Left problems ->+          pure+            ( Left+                StageFailure+                  { exitCode = configExitCode,+                    message = renderErrorsText problems,+                    report = Just (resolved ^. #report),+                    warnings = warningsText+                  }+            )+        Right job -> do+          -- The ceiling is a separate load with a deliberately different+          -- source list, and this command must not introduce a second+          -- path to it. It calls loadAgentCeiling and adds no override+          -- of its own.+          loadedCeiling <- loadAgentCeiling paths+          pure $ case loadedCeiling of+            Left problem ->+              Left+                StageFailure+                  { exitCode = configExitCode,+                    message = renderAgentConfigError problem,+                    report = Nothing,+                    warnings = warningsText+                  }+            Right ceiling' ->+              Right+                StagedJob+                  { job,+                    report = resolved ^. #report,+                    warnings = warningsText,+                    ceiling = ceiling',+                    ceilingSource = ceilingSourceLabel paths+                  }+  where+    configFailure text =+      StageFailure+        { exitCode = configExitCode,+          message = text,+          report = Nothing,+          warnings = ""+        }++ceilingSourceLabel :: AgentConfigPaths -> Text+ceilingSourceLabel paths = case paths ^. #userConfig of+  Nothing -> "built-in default (no operator configuration file)"+  Just path -> Text.pack path++-- | Rewrite a job-relative override key to its absolute form.+--+-- A key already beginning with @jobs@ is absolute and passes through+-- untouched, which keeps @--set jobs.demo.provider=codex@ meaning what+-- it says. Everything else names a setting of the selected job, so+-- @--set output=capture@ addresses @jobs.\<job\>.output@. The rewrite+-- cannot happen while parsing, because the job name is parsed by the+-- same applicative.+-- The last guard is unreachable by construction — 'cliOverride' always+-- builds a 'RawText', and 'RawValue' has no 'Show' instance precisely so+-- that a possibly-secret value cannot be rendered — so a shape this+-- function cannot rewrite is passed through unchanged rather than+-- reported with its value inlined.+scopeOverride :: Text -> CliOverride -> CliOverride+scopeOverride jobName original+  | firstSegment == "jobs" = original+  | RawText value <- cliOverrideValue original,+    Right scoped <- mkKey ("jobs" NonEmpty.:| (jobName : segments)) =+      cliOverride scoped value+  | otherwise = original+  where+    segments = NonEmpty.toList (keySegments (cliOverrideKey original))+    firstSegment = NonEmpty.head (keySegments (cliOverrideKey original))++-- --------------------------------------------------------------------+-- agent show+-- --------------------------------------------------------------------++showCommand ::+  AgentConfigPaths -> EnvSnapshot -> AgentCliOptions -> Text -> IO AgentCliRun+showCommand paths snapshot options jobName = do+  staged <- stageJob paths snapshot options jobName+  pure $ case staged of+    Left failure ->+      AgentCliRun+        { exitCode = failure ^. #exitCode,+          -- A failed resolution's provenance is exactly what an explain+          -- command is for, so the report is printed when there is one.+          standardOutput = maybe "" (renderReport options) (failure ^. #report),+          standardError = failure ^. #warnings <> failure ^. #message <> "\n"+        }+    Right stagedJob -> explain options jobName stagedJob++-- | Print the effective configuration, the ceiling, and the command+-- that would be spawned — or the refusal, after the configuration, so+-- the operator sees both what was asked for and why it was refused.+explain :: AgentCliOptions -> Text -> StagedJob -> AgentCliRun+explain options jobName staged =+  case rendered of+    Left refusal+      | options ^. #jsonOutput ->+          AgentCliRun+            { exitCode = refusedExitCode,+              standardOutput = jsonShow (Just (renderAgentRenderError refusal)) Nothing <> "\n",+              standardError = staged ^. #warnings+            }+      | otherwise ->+          AgentCliRun+            { exitCode = refusedExitCode,+              standardOutput = textSections,+              standardError =+                staged ^. #warnings <> "refused: " <> renderAgentRenderError refusal <> "\n"+            }+    Right command+      | options ^. #jsonOutput ->+          successfulRun (jsonShow Nothing (Just command) <> "\n") (staged ^. #warnings)+      | otherwise ->+          successfulRun+            (textSections <> "\n" <> renderCommandSection command)+            (staged ^. #warnings)+  where+    -- `show` takes no prompt, so a clearly artificial placeholder stands+    -- in for it and is labelled as such wherever it could be mistaken+    -- for a configured value.+    placeholder = "<prompt supplied at run time>"+    request = agentJobRequest (staged ^. #job) placeholder+    -- The argument vector is printed, so it must not carry the one+    -- setting that can hold a credential. The ceiling is checked against+    -- the real request; only the request the display is rendered from+    -- has its raw provider arguments replaced, so each one still shows+    -- in its true position without showing its value.+    displayRequest =+      request+        & #safety+          . #providerArgs+          .~ ["<redacted>" | _ <- staged ^. #job . #providerArgs]+    rendered = do+      _ <- applyCeilingToJob (staged ^. #ceiling) request+      fst <$> renderJobCommand (staged ^. #job) displayRequest+    textSections =+      "job \""+        <> jobName+        <> "\"\n\neffective configuration\n"+        <> renderEffectiveConfig (staged ^. #report)+        <> "\npolicy ceiling, from "+        <> staged ^. #ceilingSource+        <> "\n"+        <> renderCeiling (staged ^. #ceiling)+    jsonShow refusal command =+      jsonObject+        ( [ ("job", jsonString jobName),+            ("configuration", renderResolutionJson (staged ^. #report)),+            ("ceiling", ceilingJson (staged ^. #ceilingSource) (staged ^. #ceiling))+          ]+            <> maybe [] (\message -> [("refused", jsonString message)]) refusal+            <> maybe [] (\value -> [("command", commandJson value)]) command+        )++renderReport :: AgentCliOptions -> ResolutionReport -> Text+renderReport options report+  | options ^. #jsonOutput = renderResolutionJson report <> "\n"+  | otherwise = renderEffectiveConfig report++-- | Render every resolved value with the file, line, and column it came+-- from.+--+-- @settei@'s own @renderResolutionText@ names a value's source but drops+-- its location; only the JSON rendering carries path, line, and column.+-- Improvement-request acceptance criterion 5 requires the position, so+-- this walks the report itself rather than delegating.+renderEffectiveConfig :: ResolutionReport -> Text+renderEffectiveConfig report =+  Text.concat (map renderNode (reportNodes report))+  where+    renderNode node = case node ^. #outcome of+      NotSelected -> ""+      MissingValue ->+        "  " <> renderKey (node ^. #key) <> " = (unset)\n"+      Resolved value ->+        "  "+          <> renderKey (node ^. #key)+          <> " = "+          <> renderReportedValue value+          <> "\n"+          <> renderSource node+    renderSource node =+      case (node ^. #origin, node ^. #derivation) of+        (Just origin, _) -> "      from " <> renderOrigin origin <> "\n"+        (Nothing, Just derivation) ->+          "      from default rule "+            <> derivation ^. #rule+            <> " ("+            <> derivation ^. #explanation+            <> ")\n"+        (Nothing, Nothing) -> ""++-- | A value produced by a named default rule carries a 'DerivedSource'+-- origin whose name is the rule, which reads as a bare word without the+-- prefix — @no-provider-args@ rather than+-- @default rule no-provider-args@.+renderOrigin :: Origin -> Text+renderOrigin origin =+  prefix+    <> origin ^. #name+    <> maybe "" ((" at " <>) . renderLocation) (origin ^. #location)+  where+    prefix = case origin ^. #kind of+      DerivedSource -> "default rule "+      _ -> ""++renderLocation :: SourceLocation -> Text+renderLocation location =+  location+    ^. #path+    <> maybe "" (\line -> ":" <> Text.pack (show line)) (location ^. #line)+    <> maybe "" (\column -> ":" <> Text.pack (show column)) (location ^. #column)++renderCeiling :: AgentCeiling -> Text+renderCeiling ceiling' =+  Text.unlines+    [ "  max-capability       " <> renderAgentCapability (ceiling' ^. #maxCapability),+      "  allow-provider-args  " <> renderBool (ceiling' ^. #allowProviderArgs),+      "  allowed-providers    " <> renderProviders (ceiling' ^. #allowedProviders)+    ]+  where+    renderBool True = "true"+    renderBool False = "false"+    renderProviders [] = "none"+    renderProviders providers =+      Text.intercalate ", " (map renderAgentProvider providers)++-- | The rendered command, one flag per line.+--+-- A flag and the value that follows it are shown together purely as a+-- display convenience; the argument vector itself is the flat list.+renderCommandSection :: AgentCommand -> Text+renderCommandSection command =+  "rendered command\n"+    <> "  "+    <> Text.pack (command ^. #executable)+    <> "\n"+    <> Text.concat ["    " <> Text.pack line <> "\n" | line <- groupArguments (command ^. #arguments)]+    <> "  prompt transport: "+    <> renderTransport (command ^. #promptTransport)+    <> "\n"++renderTransport :: AgentPromptTransport -> Text+renderTransport PromptOnStdin =+  "standard input (the prompt appears nowhere in the argument vector)"+renderTransport PromptAsArgument =+  "the final argument (the child gets no standard input)"++groupArguments :: [String] -> [String]+groupArguments [] = []+groupArguments [single] = [single]+groupArguments (flag : value : rest)+  | isFlag flag && not (isFlag value) = (flag <> " " <> value) : groupArguments rest+  | otherwise = flag : groupArguments (value : rest)+  where+    isFlag ('-' : _) = True+    isFlag _ = False++-- --------------------------------------------------------------------+-- agent run+-- --------------------------------------------------------------------++runCommand ::+  AgentConfigPaths ->+  EnvSnapshot ->+  AgentCliOptions ->+  Text ->+  PromptSource ->+  IO AgentCliRun+runCommand paths snapshot options jobName promptSource = do+  staged <- stageJob paths snapshot options jobName+  case staged of+    Left failure ->+      pure+        ( failedRun+            (failure ^. #exitCode)+            (failure ^. #warnings <> failure ^. #message <> "\n")+        )+    Right stagedJob -> do+      promptRead <- readPromptSource promptSource+      case promptRead of+        Left problem -> pure (failedRun usageExitCode (problem <> "\n"))+        Right promptBody+          | Text.null promptBody ->+              pure+                ( failedRun+                    usageExitCode+                    ( "the prompt read from "+                        <> promptSourceLabel promptSource+                        <> " is empty; an unattended agent given no instruction \+                           \does something unpredictable and expensive\n"+                    )+                )+          | otherwise -> execute options stagedJob promptBody++execute :: AgentCliOptions -> StagedJob -> Text -> IO AgentCliRun+execute options staged promptBody =+  case prepared of+    Left refusal -> pure (refusedRun (renderAgentRenderError refusal))+    Right (request, command, translation) -> do+      ran <- runAgentCommand (evidenceRequestFor options) translation request command+      written <- writeEvidenceFile (options ^. #evidenceFile) (ran ^. #evidence)+      pure (interpret options staged request (ran ^. #outcome) written)+  where+    request0 = agentJobRequest (staged ^. #job) promptBody+    prepared = do+      permitted <- applyCeilingToJob (staged ^. #ceiling) request0+      (command, translation) <- renderJobCommand (staged ^. #job) permitted+      pure (permitted, command, translation)+    refusedRun message+      | options ^. #jsonOutput =+          AgentCliRun+            { exitCode = refusedExitCode,+              standardOutput =+                jsonObject+                  [ ("outcome", jsonString "refused"),+                    ("exitCode", Text.pack (show refusedExitCode)),+                    ("message", jsonString message)+                  ]+                  <> "\n",+              standardError = staged ^. #warnings+            }+      | otherwise =+          failedRun refusedExitCode (staged ^. #warnings <> "refused: " <> message <> "\n")++interpret ::+  AgentCliOptions ->+  StagedJob ->+  AgentRunRequest ->+  Either AgentRunFailure AgentRunResult ->+  -- | Whatever went wrong writing the evidence file, appended to+  -- standard error. A failed write never changes the exit code: the+  -- agent's own status is what a calling script branches on, and+  -- silently turning a successful run into a failure because a log could+  -- not be written would be the worse surprise.+  Text ->+  AgentCliRun+interpret options staged request result evidenceNote = case result of+  Left failure+    | options ^. #jsonOutput ->+        AgentCliRun+          { exitCode = failureExitCode failure,+            standardOutput =+              jsonObject+                [ ("outcome", jsonString "failed"),+                  ("exitCode", Text.pack (show (failureExitCode failure))),+                  ("message", jsonString (renderAgentRunFailure failure))+                ]+                <> "\n",+            standardError = staged ^. #warnings <> evidenceNote+          }+    | otherwise ->+        failedRun+          (failureExitCode failure)+          (staged ^. #warnings <> evidenceNote <> renderAgentRunFailure failure <> "\n")+  Right ran+    | options ^. #jsonOutput ->+        AgentCliRun+          { exitCode = resultExitCode ran,+            standardOutput = resultJson ran <> "\n",+            standardError = staged ^. #warnings <> evidenceNote <> truncationNotes ran+          }+    | otherwise ->+        AgentCliRun+          { exitCode = resultExitCode ran,+            -- Only a captured stream reaches this record. Under `tee`+            -- the runner already echoed the bytes to the real streams+            -- while draining, so re-emitting them here would print+            -- everything twice.+            standardOutput = if capturing then decoded (ran ^. #stdout) else "",+            standardError =+              staged ^. #warnings+                <> evidenceNote+                <> (if capturing then decoded (ran ^. #stderr) else "")+                <> truncationNotes ran+          }+  where+    -- Only a captured stream is Baikai's to re-emit. `tee` already wrote+    -- the bytes to the real streams while draining, and `inherit`+    -- captured nothing at all.+    capturing = request ^. #output == CaptureOutput++-- | The caller's evidence request, or 'Nothing' when they asked for+-- none.+--+-- Evidence is built exactly when the operator named a destination for it+-- or an outer run to correlate it with. Anyone who supplies neither gets+-- the behaviour they had before evidence existed, at the cost they had+-- before it existed: no digest, no call identifier, and no @--version@+-- probe of the tool.+--+-- With @--evidence-file@ but no @--run-id@ the job's own name stands in.+-- It is opaque text baikai never parses, and the alternative — an empty+-- string — would be a field a consumer has to special-case.+evidenceRequestFor :: AgentCliOptions -> Maybe EvidenceRequest+evidenceRequestFor options =+  case (options ^. #evidenceFile, options ^. #runId, options ^. #requiredEvidence) of+    (Nothing, Nothing, Nothing) -> Nothing+    (_, _, strictness) ->+      Just+        ( (evidenceRequest (fromMaybe (jobNameOf (options ^. #command)) (options ^. #runId)))+            { strictness = maybe EvidenceBestEffort EvidenceRequired strictness+            }+        )+  where+    jobNameOf = \case+      AgentRun name _ -> name+      AgentShow name -> name+      AgentList -> "agent"++-- | Write one evidence record to the operator's chosen path, returning+-- whatever went wrong.+--+-- The write is atomic — a temporary file beside the destination, then a+-- rename — so a reader polling the path never sees a half-written+-- record. It never appends: each run writes one complete object, and an+-- operator wanting a log of many runs points each at its own path.+--+-- Nothing is written when the operator named no path, and nothing is+-- written when the run produced no evidence, which is the case where the+-- tool never started. An empty file would claim a run happened.+writeEvidenceFile :: Maybe FilePath -> Maybe ModelCallEvidence -> IO Text+writeEvidenceFile Nothing _ = pure ""+writeEvidenceFile (Just _) Nothing = pure ""+writeEvidenceFile (Just path) (Just record) = do+  let staging = path <> ".partial"+  written <-+    try+      ( do+          BSL.writeFile staging (Aeson.encode record)+          renameFile staging path+      ) ::+      IO (Either IOException ())+  pure $ case written of+    Right () -> ""+    Left problem ->+      "could not write the evidence record to "+        <> Text.pack path+        <> ": "+        <> Text.pack (displayException problem)+        <> "\n"++resultExitCode :: AgentRunResult -> Int+resultExitCode result = case result ^. #exitCode of+  ExitSuccess -> 0+  ExitFailure code -> code++failureExitCode :: AgentRunFailure -> Int+failureExitCode = \case+  RunTimedOut _ -> timeoutExitCode+  SpawnFailed _ _ -> unavailableExitCode+  WorkingDirMissing _ -> configExitCode+  MissingEnvironment _ -> configExitCode+  OutputMalformed _ -> internalExitCode+  -- Policy said no and nothing was started, which is exactly what+  -- 'refusedExitCode' means for a ceiling violation or a provider that+  -- cannot express a safety policy. A script that already branches on+  -- 77 for those needs no new case for this one.+  EvidenceRefused _ -> refusedExitCode++-- | Announce truncation. A silently truncated response that a script+-- then parses is a bug waiting to happen.+truncationNotes :: AgentRunResult -> Text+truncationNotes result =+  note "standard output" (result ^. #stdout) <> note "standard error" (result ^. #stderr)+  where+    note label (OutputTruncated _) =+      "the agent's " <> label <> " was truncated at the configured output limit\n"+    note _ _ = ""++decoded :: AgentCapturedOutput -> Text+decoded captured = case captured of+  OutputNotCaptured -> ""+  OutputCaptured bytes -> Text.decodeUtf8Lenient bytes+  OutputTruncated bytes -> Text.decodeUtf8Lenient bytes++resultJson :: AgentRunResult -> Text+resultJson result =+  jsonObject+    ( [ ("outcome", jsonString "ran"),+        ("exitCode", Text.pack (show (resultExitCode result))),+        ("provider", jsonString (renderAgentProvider (result ^. #provider))),+        ("durationSeconds", Text.pack (show (realToFrac (result ^. #duration) :: Double)))+      ]+        <> streamFields "stdout" (result ^. #stdout)+        <> streamFields "stderr" (result ^. #stderr)+    )+  where+    streamFields _ OutputNotCaptured = []+    streamFields label captured =+      [ (label, jsonString (decoded captured)),+        ( label <> "Truncated",+          case captured of+            OutputTruncated _ -> "true"+            _ -> "false"+        )+      ]++-- --------------------------------------------------------------------+-- Prompts+-- --------------------------------------------------------------------++-- | Read the prompt, decoding UTF-8 explicitly.+--+-- Explicit decoding rather than @getContents@ on purpose: the latter's+-- behavior depends on the handle's locale encoding, and the motivating+-- consumer's prompt contains interpolated paths and could contain any+-- character, so a locale-dependent read would corrupt it on a machine+-- without a UTF-8 locale.+readPromptSource :: PromptSource -> IO (Either Text Text)+readPromptSource = \case+  PromptStdin -> decodeFrom "standard input" <$> BS.hGetContents stdin+  PromptFile path -> do+    present <- doesFileExist path+    if not present+      then pure (Left ("the prompt file does not exist: " <> Text.pack path))+      else decodeFrom (Text.pack path) <$> BS.readFile path+  PromptInline value -> pure (Right value)+  where+    decodeFrom label bytes = case Text.decodeUtf8' bytes of+      Left problem ->+        Left+          ( "the prompt read from "+              <> label+              <> " is not valid UTF-8: "+              <> Text.pack (show problem)+          )+      Right value -> Right value++promptSourceLabel :: PromptSource -> Text+promptSourceLabel PromptStdin = "standard input"+promptSourceLabel (PromptFile path) = Text.pack path+promptSourceLabel (PromptInline _) = "--prompt"++-- --------------------------------------------------------------------+-- A very small JSON writer+-- --------------------------------------------------------------------++-- | Hand-rolled rather than pulled from @aeson@: the package needs+-- exactly three shapes, and the alternative is a dependency the library+-- otherwise has no use for.+jsonObject :: [(Text, Text)] -> Text+jsonObject fields =+  "{" <> Text.intercalate "," [jsonString name <> ":" <> value | (name, value) <- fields] <> "}"++jsonArray :: [Text] -> Text+jsonArray values = "[" <> Text.intercalate "," values <> "]"++jsonString :: Text -> Text+jsonString value = "\"" <> Text.concatMap escape value <> "\""+  where+    escape '"' = "\\\""+    escape '\\' = "\\\\"+    escape '\n' = "\\n"+    escape '\r' = "\\r"+    escape '\t' = "\\t"+    escape character+      | isControl character =+          "\\u" <> Text.justifyRight 4 '0' (Text.pack (showHex (ord character) ""))+      | otherwise = Text.singleton character++ceilingJson :: Text -> AgentCeiling -> Text+ceilingJson sourceLabel ceiling' =+  jsonObject+    [ ("source", jsonString sourceLabel),+      ("maxCapability", jsonString (renderAgentCapability (ceiling' ^. #maxCapability))),+      ( "allowProviderArgs",+        if ceiling' ^. #allowProviderArgs then "true" else "false"+      ),+      ( "allowedProviders",+        jsonArray (map (jsonString . renderAgentProvider) (ceiling' ^. #allowedProviders))+      )+    ]++commandJson :: AgentCommand -> Text+commandJson command =+  jsonObject+    [ ("executable", jsonString (Text.pack (command ^. #executable))),+      ("arguments", jsonArray (map (jsonString . Text.pack) (command ^. #arguments))),+      ( "promptTransport",+        jsonString+          ( case command ^. #promptTransport of+              PromptOnStdin -> "stdin"+              PromptAsArgument -> "argument"+          )+      )+    ]
+ src/Baikai/Agent/Config.hs view
@@ -0,0 +1,805 @@+-- | Resolve an unattended coding-agent job from layered KDL+-- configuration.+--+-- A repository owns @.baikai\/agents.kdl@, which names jobs; an operator+-- owns @~\/.config\/baikai\/agents.kdl@, which supplies defaults __and__+-- the safety ceiling. A caller asks for a job by name and receives a+-- fully resolved description together with a report saying, for every+-- value, which file and which line it came from.+--+-- Two loads with deliberately different rules live here, and the+-- asymmetry between them is the security property of this module.+-- 'resolveAgentJob' layers five sources, later ones winning.+-- 'loadAgentCeiling' reads the operator's own file and __nothing else__,+-- so no repository file, environment variable, or command-line override+-- can raise the ceiling. They are two functions rather than one function+-- with a flag precisely so the difference is visible in the code.+--+-- A repository configuration file is untrusted input: an automation+-- daemon that encounters a checkout is reading a file somebody else+-- wrote, and that file could ask for unrestricted filesystem access.+-- 'applyCeilingToJob' is where that ask is refused.+module Baikai.Agent.Config+  ( -- * The configured shape of one job+    AgentJob (..),+    agentJobConfig,+    agentJobRequest,++    -- * Where configuration lives+    AgentConfigPaths (..),+    AgentConfigScope (..),+    renderAgentConfigScope,+    defaultAgentConfigPaths,++    -- * Layered resolution+    resolveAgentJob,++    -- * The operator policy ceiling+    agentCeilingConfig,+    loadAgentCeiling,+    applyCeilingToJob,++    -- * Enumeration+    AgentJobEntry (..),+    listAgentJobs,++    -- * Failures+    AgentConfigError (..),+    renderAgentConfigError,++    -- * Exposed for testing+    parseDuration,+    agentEnvBindings,+    defaultOutputLimit,+    scalarOrListDecoder,+    validateJobName,+  )+where++import Baikai.Agent+  ( AgentCapability,+    AgentCeiling,+    AgentOutputMode (..),+    AgentProvider,+    AgentRenderError (..),+    AgentRunRequest,+    AgentSafety,+    agentRunRequest,+    agentSafety,+    applyAgentCeiling,+    defaultAgentCeiling,+    parseAgentCapability,+    parseAgentOutputMode,+    parseAgentProvider,+    renderAgentCapability,+    renderAgentOutputMode,+    renderAgentProvider,+  )+import Baikai.ThinkingLevel (ThinkingLevel (..), renderThinkingLevel)+import Control.Lens ((&), (.~), (^.))+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Read qualified as TextRead+import Data.Time.Clock (NominalDiffTime)+import GHC.Generics (Generic)+import Settei.Config (Config, optional, required, withDefault)+import Settei.Default (Default, RuleName (..), constantDefault)+import Settei.Env+  ( Bindings,+    EnvName (..),+    EnvSnapshot,+    binding,+    bindings,+    environmentSource,+    renderEnvErrorsText,+  )+import Settei.Kdl+  ( kdlSourceOptions,+    readKdlSource,+    renderKdlErrorsText,+    withKdlSourcePath,+  )+import Settei.Key (Key, keySegments, parseKey)+import Settei.Optparse (CliOverride, cliSources)+import Settei.Resolve (ResolveResult, defaultResolveOptions, resolve)+import Settei.Setting+  ( Setting,+    publicSetting,+    publicSettingWithRenderer,+    publicShowSetting,+    secretSetting,+  )+import Settei.Source (Source, sourceLeaves)+import Settei.Value+  ( Decoder,+    RawValue (..),+    boolDecoder,+    boundedIntegralDecoder,+    decodeFailure,+    decoder,+    enumDecoder,+    parsedDecoder,+    runDecoder,+    textDecoder,+  )+import System.Directory (doesFileExist)+import System.Environment (lookupEnv)+import System.FilePath ((</>))++-- | The configured shape of one named job.+--+-- The safety fields are flattened here rather than nested as an+-- 'AgentSafety', even though the KDL document nests them under a+-- @safety@ node. A @settei@ setting is addressed by a dotted key, not by+-- a nested record, so a flat record maps one-to-one onto the+-- declaration; 'agentJobRequest' reassembles the nested value.+--+-- There is deliberately no @name@ field. The name is how the job was+-- looked up, not a property of it, and storing it would invite a+-- mismatch between the two.+data AgentJob = AgentJob+  { -- | Which coding-agent tool to run. Required.+    provider :: !AgentProvider,+    -- | Where the tool lives, for an operator whose installation is not+    -- on @PATH@ under its canonical name. 'AgentRunRequest' has no field+    -- for this, so it stays a configuration concern.+    executable :: !(Maybe FilePath),+    -- | Model override, or 'Nothing' to leave the tool's default.+    modelId :: !(Maybe Text),+    -- | Reasoning-effort override, or 'Nothing' to leave the tool's+    -- default.+    effort :: !(Maybe ThinkingLevel),+    -- | The directory the run is rooted in. Required.+    workingDir :: !FilePath,+    -- | Directories the run may reach beyond 'workingDir'.+    extraDirs :: ![FilePath],+    -- | How much filesystem authority the job asks for. Required: a job+    -- that forgot to state its authority must not silently receive+    -- some.+    capability :: !AgentCapability,+    -- | Optional narrowing of the provider's tool set.+    allowedTools :: ![Text],+    -- | Raw provider arguments passed through verbatim. Classified+    -- __secret__, because it is the one field an operator could write a+    -- credential into.+    providerArgs :: ![Text],+    -- | Wall-clock limit for the whole run, or 'Nothing' for no limit.+    timeout :: !(Maybe NominalDiffTime),+    -- | What to do with the child's output streams.+    output :: !AgentOutputMode,+    -- | Maximum captured bytes per stream. 'Nothing' means unbounded.+    outputLimit :: !(Maybe Int),+    -- | Names of environment variables the job declares it requires.+    -- Names only, never values, so the list cannot carry a secret.+    envRequires :: ![Text]+  }+  deriving stock (Eq, Show, Generic)++-- | Which configuration file a value or a job name came from.+--+-- This is Baikai's own vocabulary rather than @settei@'s 'SourceKind',+-- which cannot serve: @settei-kdl@ tags every document it reads+-- @FileSource \"KDL v2\"@ — naming the /format/, not the file — so the+-- user and repository documents are indistinguishable by kind.+data AgentConfigScope+  = UserScope+  | RepositoryScope+  deriving stock (Eq, Ord, Show, Generic)++renderAgentConfigScope :: AgentConfigScope -> Text+renderAgentConfigScope UserScope = "user configuration"+renderAgentConfigScope RepositoryScope = "repository configuration"++-- | One configured job name and the scope that supplied the winning+-- definition of it.+data AgentJobEntry = AgentJobEntry+  { -- | The job name, as it appears after the @jobs@ segment.+    name :: !Text,+    -- | The highest-precedence scope defining the name.+    scope :: !AgentConfigScope,+    -- | How many scopes define this name. A bare name with no+    -- indication that two files define it hides a real source of+    -- confusion, so the count is reported rather than dropped.+    definingScopes :: !Int+  }+  deriving stock (Eq, Show, Generic)++-- | The two configuration files, each absent when it does not exist.+--+-- An explicit record with a pure resolution path underneath is what lets+-- a test point at a temporary directory. Nothing below this record reads+-- the real @HOME@ or @XDG_CONFIG_HOME@.+data AgentConfigPaths = AgentConfigPaths+  { userConfig :: !(Maybe FilePath),+    repoConfig :: !(Maybe FilePath)+  }+  deriving stock (Eq, Show, Generic)++-- | A failure loading configuration, as distinct from a resolution+-- failure, which @settei@ reports through 'ResolveResult'.+data AgentConfigError+  = -- | The file that could not be read or parsed, and the rendered+    -- @settei-kdl@ diagnosis. The diagnosis never contains the file's+    -- contents: @settei-kdl@ errors carry a category, a name, a path, a+    -- span, and a concise message, and appending the document \"for+    -- context\" would defeat that redaction.+    ConfigFileUnreadable !FilePath !Text+  | -- | The job name, and why it cannot address a configuration key.+    InvalidJobName !Text !Text+  deriving stock (Eq, Show, Generic)++renderAgentConfigError :: AgentConfigError -> Text+renderAgentConfigError (ConfigFileUnreadable path message) =+  "could not read the configuration file " <> Text.pack path <> ": " <> message+renderAgentConfigError (InvalidJobName jobName why) =+  "invalid job name " <> jobName <> ": " <> why++-- | Bytes per stream captured when no layer states a limit.+--+-- Concrete rather than unbounded on purpose: an operator who never+-- mentions a limit should not be one runaway agent away from exhausting+-- memory. Four mebibytes is far more than a normal run prints, and any+-- layer may raise it, lower it, or write @output-limit \"unlimited\"@ to+-- remove it.+defaultOutputLimit :: Int+defaultOutputLimit = 4194304++-- | Accept a scalar, an array, or an absent value as a list.+--+-- @settei@'s own @listDecoder@ accepts only an array, which cannot serve+-- here: a KDL node's raw shape depends on how many arguments it has, so+-- @extra-dirs@ with no arguments is a null, with one argument is a+-- scalar, and only with two or more is it an array. A command-line+-- override is always a scalar, because @cliOverride@ builds a+-- @RawText@. Requiring an array would make the one-directory spelling+-- and every list-valued @--set@ undecodable.+scalarOrListDecoder :: Decoder a -> Decoder [a]+scalarOrListDecoder elementDecoder =+  decoder $ \key raw -> case raw of+    RawNull -> Right []+    RawArray values -> traverse (runDecoder elementDecoder key) values+    scalar -> fmap pure (runDecoder elementDecoder key scalar)++-- | Parse a duration written with a unit suffix, or a bare number of+-- seconds.+--+-- @\"90s\"@ is ninety seconds, @\"45m\"@ is forty-five minutes,+-- @\"2h\"@ is two hours, and @\"45\"@ is forty-five seconds. Zero and+-- negative values are rejected: a timeout of zero would mean \"kill+-- every run immediately\", which no operator intends and which would be+-- baffling to diagnose. Omitting the setting is how a run goes+-- untimed.+parseDuration :: Text -> Maybe NominalDiffTime+parseDuration raw =+  case TextRead.decimal (Text.strip raw) of+    Right (magnitude :: Integer, rest)+      | magnitude > 0 ->+          fmap+            (\multiplier -> fromInteger (magnitude * multiplier))+            (unitMultiplier (Text.strip rest))+    _ -> Nothing+  where+    unitMultiplier "" = Just 1+    unitMultiplier "s" = Just 1+    unitMultiplier "m" = Just 60+    unitMultiplier "h" = Just 3600+    unitMultiplier _ = Nothing++renderDuration :: NominalDiffTime -> Text+renderDuration value = Text.pack (show value)++-- | The configuration key addressing one leaf of one named job.+--+-- Calling 'error' on an unparseable key is safe only because the leaf+-- names are compile-time constants and the job name has already passed+-- 'validateJobName'; a failure here is a programming error, not bad+-- input. This mirrors the @validKey@ helper in @settei@'s own reference+-- application.+jobKey :: Text -> Text -> Key+jobKey jobName leaf = validKey ("jobs." <> jobName <> "." <> leaf)++validKey :: Text -> Key+validKey value = either (error . show) id (parseKey value)++-- | Reject a job name that cannot address a configuration key.+--+-- A name containing a dot would silently nest one level deeper than the+-- operator wrote, and an empty name would address the @jobs@ node+-- itself. Both are refused here so 'jobKey' is only ever reached with a+-- good name.+validateJobName :: Text -> Either AgentConfigError ()+validateJobName jobName+  | Text.null jobName = Left (InvalidJobName jobName "the name is empty")+  | Text.any (== '.') jobName =+      Left (InvalidJobName jobName "a job name may not contain a dot")+  | otherwise = case parseKey ("jobs." <> jobName <> ".provider") of+      Left problem -> Left (InvalidJobName jobName (Text.pack (show problem)))+      Right _ -> Right ()++providerDecoder :: Decoder AgentProvider+providerDecoder =+  parsedDecoder+    "one of: claude, codex"+    (maybe (Left "unknown provider") Right . parseAgentProvider)++capabilityDecoder :: Decoder AgentCapability+capabilityDecoder =+  parsedDecoder+    "one of: read-only, edit-workspace, full-access"+    (maybe (Left "unknown capability") Right . parseAgentCapability)++outputModeDecoder :: Decoder AgentOutputMode+outputModeDecoder =+  parsedDecoder+    "one of: inherit, capture, tee"+    (maybe (Left "unknown output mode") Right . parseAgentOutputMode)++-- | The six canonical reasoning-effort names. The list lives in+-- @baikai\/src\/Baikai\/ThinkingLevel.hs@, which has a renderer but no+-- parser, so a future level must be added in both places.+effortDecoder :: Decoder ThinkingLevel+effortDecoder =+  enumDecoder+    [ ("minimal", ThinkingMinimal),+      ("low", ThinkingLow),+      ("medium", ThinkingMedium),+      ("high", ThinkingHigh),+      ("xhigh", ThinkingXHigh),+      ("max", ThinkingMax)+    ]++pathDecoder :: Decoder FilePath+pathDecoder = fmap Text.unpack textDecoder++-- | A duration written with a unit, or a bare positive number of+-- seconds. The unquoted form @timeout 2700@ is accepted too, because a+-- KDL number is a @RawNumber@ rather than a @RawText@.+durationDecoder :: Decoder NominalDiffTime+durationDecoder =+  decoder $ \key raw ->+    let reject = Left (decodeFailure key durationExpectation)+     in case raw of+          RawText value -> maybe reject Right (parseDuration value)+          _ -> case runDecoder boundedIntegralDecoder key raw of+            Right (seconds :: Int) | seconds > 0 -> Right (fromIntegral seconds)+            _ -> reject+  where+    durationExpectation =+      "a positive duration such as 90s, 45m, or 2h, or a bare number of seconds"++-- | A positive byte count, or the word @unlimited@ for no bound.+outputLimitDecoder :: Decoder (Maybe Int)+outputLimitDecoder =+  decoder $ \key raw -> case raw of+    RawText "unlimited" -> Right Nothing+    _ -> case runDecoder boundedIntegralDecoder key raw of+      Right (bytes :: Int) | bytes > 0 -> Right (Just bytes)+      _ -> Left (decodeFailure key "a positive number of bytes, or the word unlimited")++providerSetting :: Text -> Setting AgentProvider+providerSetting jobName =+  publicSettingWithRenderer+    (jobKey jobName "provider")+    "Coding-agent tool to run"+    providerDecoder+    renderAgentProvider++executableSetting :: Text -> Setting FilePath+executableSetting jobName =+  publicShowSetting+    (jobKey jobName "executable")+    "Path to the coding-agent executable, overriding PATH lookup"+    pathDecoder++modelSetting :: Text -> Setting Text+modelSetting jobName =+  publicSetting (jobKey jobName "model") "Model override" textDecoder++effortSetting :: Text -> Setting ThinkingLevel+effortSetting jobName =+  publicSettingWithRenderer+    (jobKey jobName "effort")+    "Reasoning-effort override"+    effortDecoder+    renderThinkingLevel++workingDirSetting :: Text -> Setting FilePath+workingDirSetting jobName =+  publicShowSetting+    (jobKey jobName "working-dir")+    "Directory the run is rooted in"+    pathDecoder++extraDirsSetting :: Text -> Setting [FilePath]+extraDirsSetting jobName =+  publicShowSetting+    (jobKey jobName "extra-dirs")+    "Directories the run may reach beyond its working directory"+    (scalarOrListDecoder pathDecoder)++capabilitySetting :: Text -> Setting AgentCapability+capabilitySetting jobName =+  publicSettingWithRenderer+    (jobKey jobName "safety.capability")+    "Filesystem authority the job requests"+    capabilityDecoder+    renderAgentCapability++allowedToolsSetting :: Text -> Setting [Text]+allowedToolsSetting jobName =+  publicShowSetting+    (jobKey jobName "safety.allowed-tools")+    "Narrowing of the provider's tool set"+    (scalarOrListDecoder textDecoder)++-- | Raw provider arguments, classified __secret__.+--+-- This is the only setting in the schema that can carry a credential —+-- nothing stops an operator from writing @--api-key sk-…@ here — and+-- @settei@ converts a secret-classified value to an opaque redacted form+-- before it can be retained in a resolution report or in a structural+-- error. Every other setting is structurally incapable of holding a+-- secret: environment variables are referenced by name and never by+-- value, and both coding agents keep their credentials in their own+-- stores.+providerArgsSetting :: Text -> Setting [Text]+providerArgsSetting jobName =+  secretSetting+    (jobKey jobName "safety.provider-args")+    "Raw provider arguments passed through verbatim"+    (scalarOrListDecoder textDecoder)++timeoutSetting :: Text -> Setting NominalDiffTime+timeoutSetting jobName =+  publicSettingWithRenderer+    (jobKey jobName "timeout")+    "Wall-clock limit for the whole run"+    durationDecoder+    renderDuration++outputSetting :: Text -> Setting AgentOutputMode+outputSetting jobName =+  publicSettingWithRenderer+    (jobKey jobName "output")+    "What to do with the child's output streams"+    outputModeDecoder+    renderAgentOutputMode++outputLimitSetting :: Text -> Setting (Maybe Int)+outputLimitSetting jobName =+  publicShowSetting+    (jobKey jobName "output-limit")+    "Maximum captured bytes per stream"+    outputLimitDecoder++envRequiresSetting :: Text -> Setting [Text]+envRequiresSetting jobName =+  publicShowSetting+    (jobKey jobName "env-requires")+    "Environment variable names the job requires; names only, never values"+    (scalarOrListDecoder textDecoder)++emptyListDefault :: Text -> Default [a]+emptyListDefault ruleName =+  constantDefault (RuleName ruleName) "nothing configured" []++-- | The declaration for one named job.+--+-- The keys are built from the job name because @settei@'s 'Config'+-- describes a statically known set of keys while a document holds an+-- unknown number of jobs. A 'Config' is an ordinary value, so one is+-- built per name; decoding the whole document into an opaque map would+-- work too but would lose per-value provenance, and provenance is the+-- point.+--+-- Defaults are named rules rather than a synthetic built-in source+-- because a source would have to be rebuilt for every job name — every+-- key contains it — while a rule is name-independent, keeps this+-- declaration complete on its own, and is reported with its own name and+-- rationale.+agentJobConfig :: Text -> Config AgentJob+agentJobConfig jobName =+  AgentJob+    <$> required (providerSetting jobName)+    <*> optional (executableSetting jobName)+    <*> optional (modelSetting jobName)+    <*> optional (effortSetting jobName)+    <*> required (workingDirSetting jobName)+    <*> withDefault (extraDirsSetting jobName) (emptyListDefault "no-extra-dirs")+    <*> required (capabilitySetting jobName)+    <*> withDefault (allowedToolsSetting jobName) (emptyListDefault "no-tool-restriction")+    <*> withDefault (providerArgsSetting jobName) (emptyListDefault "no-provider-args")+    <*> optional (timeoutSetting jobName)+    <*> withDefault+      (outputSetting jobName)+      (constantDefault (RuleName "inherit-output") "no output discipline configured" InheritOutput)+    <*> withDefault+      (outputLimitSetting jobName)+      ( constantDefault+          (RuleName "default-output-limit")+          "no output limit configured"+          (Just defaultOutputLimit)+      )+    <*> withDefault (envRequiresSetting jobName) (emptyListDefault "no-required-environment")++-- | Convert a resolved job into a run request, with the prompt supplied+-- at call time because a job describes where the text comes from rather+-- than carrying it.+--+-- The ceiling is deliberately __not__ applied here. Burying the check+-- inside a conversion would make it bypassable by calling the conversion+-- directly; 'applyCeilingToJob' is a separate, explicitly named step.+agentJobRequest :: AgentJob -> Text -> AgentRunRequest+agentJobRequest job promptBody =+  agentRunRequest (job ^. #provider) (job ^. #workingDir) promptBody+    & #modelId .~ (job ^. #modelId)+    & #effort .~ (job ^. #effort)+    & #extraDirs .~ (job ^. #extraDirs)+    & #safety .~ requestedSafety+    & #timeout .~ (job ^. #timeout)+    & #output .~ (job ^. #output)+    & #outputLimit .~ (job ^. #outputLimit)+    & #envPassthrough .~ (job ^. #envRequires)+  where+    requestedSafety :: AgentSafety+    requestedSafety =+      agentSafety (job ^. #capability)+        & #allowedTools .~ (job ^. #allowedTools)+        & #providerArgs .~ (job ^. #providerArgs)++-- | Environment variables that may influence a job, bound explicitly.+--+-- The set is small and deliberately chosen: the provider, the model, the+-- executable, and the timeout. The capability, the tool list, and the+-- raw provider arguments are __not__ bound. An environment variable is+-- easy to set accidentally and is inherited by every child process, so+-- letting one widen a job's authority would create exactly the ambient+-- influence the ceiling exists to prevent.+--+-- The binding list is a function of the job name rather than a module+-- constant, because every key contains the name. Forcing it for any name+-- validates the whole list, which the test suite does so an invalid edit+-- fails in tests rather than at start-up.+agentEnvBindings :: Text -> Bindings+agentEnvBindings jobName =+  either+    (error . Text.unpack . renderEnvErrorsText)+    id+    ( bindings+        [ binding (EnvName "BAIKAI_AGENT_PROVIDER") (jobKey jobName "provider"),+          binding (EnvName "BAIKAI_AGENT_MODEL") (jobKey jobName "model"),+          binding (EnvName "BAIKAI_AGENT_EXECUTABLE") (jobKey jobName "executable"),+          binding (EnvName "BAIKAI_AGENT_TIMEOUT") (jobKey jobName "timeout")+        ]+    )++-- | Locate the two configuration files, treating a missing file as a+-- normal state rather than an error.+--+-- The user path is @$XDG_CONFIG_HOME\/baikai\/agents.kdl@ when that+-- variable is set and non-empty, otherwise+-- @$HOME\/.config\/baikai\/agents.kdl@. The repository path is+-- @.\/.baikai\/agents.kdl@ relative to the current working directory and+-- __nothing else__: an upward search would make the effective+-- configuration depend on where the process happened to start, and a job+-- could silently pick up a file from a parent directory outside the+-- repository it believes it is working in. For an untrusted file that+-- grants filesystem authority that is an unacceptable surprise. A caller+-- wanting a different file passes an explicit path.+defaultAgentConfigPaths :: IO AgentConfigPaths+defaultAgentConfigPaths = do+  xdgHome <- lookupEnv "XDG_CONFIG_HOME"+  homeDir <- lookupEnv "HOME"+  let configBase = case xdgHome of+        Just dir | not (null dir) -> Just dir+        _ -> fmap (</> ".config") (nonEmptyPath =<< homeDir)+      userPath = fmap (\base -> base </> "baikai" </> "agents.kdl") configBase+  userConfig <- maybe (pure Nothing) whenPresent userPath+  repoConfig <- whenPresent (".baikai" </> "agents.kdl")+  pure AgentConfigPaths {userConfig, repoConfig}+  where+    nonEmptyPath dir = if null dir then Nothing else Just dir+    whenPresent path = do+      present <- doesFileExist path+      pure (if present then Just path else Nothing)++-- | Read one scope's document, if it is configured at all.+loadScope :: AgentConfigScope -> Maybe FilePath -> IO (Either AgentConfigError [Source])+loadScope _ Nothing = pure (Right [])+loadScope scope (Just path) = do+  outcome <-+    readKdlSource+      (withKdlSourcePath path (kdlSourceOptions (renderAgentConfigScope scope)))+      path+  pure $ case outcome of+    Left problems -> Left (ConfigFileUnreadable path (renderKdlErrorsText problems))+    Right loaded -> Right [loaded]++-- | Both documents in ascending precedence order, each tagged with the+-- scope that produced it.+loadScopeSources :: AgentConfigPaths -> IO (Either AgentConfigError [(AgentConfigScope, Source)])+loadScopeSources paths = do+  userLoaded <- loadScope UserScope (paths ^. #userConfig)+  repoLoaded <- loadScope RepositoryScope (paths ^. #repoConfig)+  pure $ do+    userSources <- userLoaded+    repoSources <- repoLoaded+    Right (map ((,) UserScope) userSources <> map ((,) RepositoryScope) repoSources)++-- | Resolve one named job across all five layers.+--+-- The environment snapshot is a parameter rather than the real+-- environment so the layer is testable without mutating the process, and+-- the command-line overrides arrive already parsed so this module needs+-- no @optparse-applicative@ wiring.+resolveAgentJob ::+  AgentConfigPaths ->+  EnvSnapshot ->+  [CliOverride] ->+  Text ->+  IO (Either AgentConfigError (ResolveResult AgentJob))+resolveAgentJob paths snapshot overrides jobName = do+  loaded <- loadScopeSources paths+  pure $ do+    validateJobName jobName+    scoped <- loaded+    Right+      ( resolve+          defaultResolveOptions+          -- Lowest precedence first: built-in defaults (named rules+          -- inside `agentJobConfig`), the user file, the repository+          -- file, the environment, then explicit command-line+          -- overrides. This list is the only place the order is+          -- expressed, so reordering it is a silent behavior change.+          ( map snd scoped+              <> [environmentSource (agentEnvBindings jobName) snapshot]+              <> cliSources "arguments" overrides+          )+          (agentJobConfig jobName)+      )++-- | The declaration for the operator's policy ceiling.+--+-- Each setting defaults to the corresponding field of+-- 'defaultAgentCeiling', so an operator file that sets only one of the+-- three still yields a complete ceiling. 'AgentCeiling' hides its+-- constructor, so the value is built by updating the default through+-- its generic field lenses rather than by a record literal.+agentCeilingConfig :: Config AgentCeiling+agentCeilingConfig =+  buildCeiling+    <$> withDefault+      maxCapabilitySetting+      ( constantDefault+          (RuleName "default-max-capability")+          "no operator policy configured"+          (defaultAgentCeiling ^. #maxCapability)+      )+    <*> withDefault+      allowProviderArgsSetting+      ( constantDefault+          (RuleName "default-allow-provider-args")+          "no operator policy configured"+          (defaultAgentCeiling ^. #allowProviderArgs)+      )+    <*> withDefault+      allowedProvidersSetting+      ( constantDefault+          (RuleName "default-allowed-providers")+          "no operator policy configured"+          (defaultAgentCeiling ^. #allowedProviders)+      )+  where+    buildCeiling cap rawArgs providers =+      defaultAgentCeiling+        & #maxCapability .~ cap+        & #allowProviderArgs .~ rawArgs+        & #allowedProviders .~ providers+    maxCapabilitySetting =+      publicSettingWithRenderer+        (validKey "policy.max-capability")+        "Highest capability any job may request"+        capabilityDecoder+        renderAgentCapability+    allowProviderArgsSetting =+      publicShowSetting+        (validKey "policy.allow-provider-args")+        "Whether jobs may pass raw provider arguments at all"+        boolDecoder+    allowedProvidersSetting =+      publicShowSetting+        (validKey "policy.allowed-providers")+        "Providers jobs may select"+        (scalarOrListDecoder providerDecoder)++-- | Load the operator's policy ceiling.+--+-- __The source list below is the entire mechanism.__ It resolves against+-- the user file and nothing else. It must never include the repository+-- file, the environment source, or command-line overrides: a ceiling any+-- lower layer could raise is not a ceiling. If the repository file could+-- set @policy.max-capability@ an untrusted checkout would grant itself+-- whatever it liked, and if a command-line override could, then+-- @--set policy.max-capability=full-access@ would defeat the mechanism+-- outright — which is exactly the flag a compromised automation script+-- would add. Someone \"fixing an inconsistency\" by adding the+-- repository source here would silently remove the security property+-- while every test that does not specifically check it kept passing.+--+-- With no user file the ceiling is 'defaultAgentCeiling': read-only and+-- edit-workspace are permitted, full access is refused, and raw provider+-- arguments are refused.+loadAgentCeiling :: AgentConfigPaths -> IO (Either AgentConfigError AgentCeiling)+loadAgentCeiling paths = do+  userLoaded <- loadScope UserScope (paths ^. #userConfig)+  pure $ do+    userSources <- userLoaded+    let resolved = resolve defaultResolveOptions userSources agentCeilingConfig+    case resolved ^. #answer of+      Left problems ->+        Left+          ( ConfigFileUnreadable+              (maybe "<no user configuration>" id (paths ^. #userConfig))+              (renderCeilingProblems problems)+          )+      Right ceiling' -> Right ceiling'+  where+    renderCeilingProblems problems =+      Text.intercalate "; " (map (Text.pack . show) (NonEmpty.toList problems))++-- | Refuse a request that exceeds the operator's ceiling.+--+-- The comparison itself is 'applyAgentCeiling', which is pure and+-- already tested in the core package. This wrapper only converts the+-- violation list into the 'AgentRenderError' the command-line tool+-- reports through, so there is one error type on the path from+-- configuration to rendered command. The request is never clamped to+-- fit.+applyCeilingToJob :: AgentCeiling -> AgentRunRequest -> Either AgentRenderError AgentRunRequest+applyCeilingToJob ceiling' request =+  case applyAgentCeiling ceiling' request of+    Left violations -> Left (CeilingRejected violations)+    Right permitted -> Right permitted++-- | Every configured job name, sorted, each attributed to the+-- highest-precedence scope defining it.+--+-- Sorting matters because a script may diff the output. The names come+-- from parsed keys, so they are already valid key segments and cannot+-- contain a dot; 'validateJobName' guards the other direction, where a+-- caller supplies a name.+listAgentJobs :: AgentConfigPaths -> IO (Either AgentConfigError [AgentJobEntry])+listAgentJobs paths = do+  loaded <- loadScopeSources paths+  pure (fmap entriesFrom loaded)+  where+    entriesFrom scoped =+      [ AgentJobEntry {name, scope, definingScopes}+      | (name, (scope, definingScopes)) <- Map.toAscList (foldl' absorb Map.empty scoped)+      ]+    absorb seen (scope, loadedSource) =+      foldl'+        (\acc jobName -> Map.insertWith laterScopeWins jobName (scope, 1) acc)+        seen+        (jobNamesIn loadedSource)+    -- Map.insertWith applies its function as @f new old@, so the later+    -- source's scope replaces the earlier one and the count accumulates.+    laterScopeWins (newScope, _) (_, count) = (newScope, count + 1)++-- | The distinct job names one document defines.+--+-- Distinct per source, not per leaf: one job contributes many leaf keys,+-- and counting them would inflate the defining-scope count.+jobNamesIn :: Source -> [Text]+jobNamesIn loadedSource =+  Set.toList+    ( Set.fromList+        [ jobName+        | (key, _) <- sourceLeaves loadedSource,+          "jobs" : jobName : _ <- [NonEmpty.toList (keySegments key)]+        ]+    )
+ src/Baikai/Agent/Run.hs view
@@ -0,0 +1,767 @@+{-# LANGUAGE CPP #-}++-- | Spawn an unattended coding-agent process from a request and an+-- already-rendered command.+--+-- An unattended run has no terminal and no human present: the coding+-- agent drives its own tool loop, changes files inside directories the+-- caller explicitly authorized, and finishes with a process result.+--+-- This module renders no command-line flags. Vendor packages own that+-- translation and produce the 'AgentCommand' this module consumes, so+-- the runner never imports a vendor renderer and can be exercised+-- entirely with hand-written argument vectors.+--+-- A non-zero exit code is a __successful__ run, reported in+-- 'AgentRunResult'. The distinction a caller needs is between \"the tool+-- never started or never finished\" and \"the tool ran and this is what+-- happened\"; a coding agent that attempts its task and fails has run.+module Baikai.Agent.Run+  ( runAgentCommand,++    -- * Evidence envelopes+    agentRequestEnvelope,+    agentConfigurationEnvelope,++    -- * Exposed for testing+    timeoutMicros,+  )+where++import Baikai.Agent+  ( AgentCapturedOutput (..),+    AgentCommand,+    AgentOutputMode (..),+    AgentPromptTransport (..),+    AgentProvider (..),+    AgentRunFailure (..),+    AgentRunOutcome (..),+    AgentRunRequest,+    AgentRunResult,+    agentRunOutcome,+    agentRunResult,+    renderAgentProvider,+    renderAgentRunFailure,+  )+import Baikai.Api (Api (..))+import Baikai.Error (BaikaiError, processError, providerError)+import Baikai.Evidence+  ( CallStatus (..),+    EndpointIdentity (..),+    EvidenceRequest,+    EvidenceStrength (..),+    EvidenceStrictness (..),+    ModelCallEvidence (..),+    Observed (..),+    ThinkingTranslation (..),+    TransportKind (..),+    baseEvidence,+    commitmentDigest,+    configurationDigest,+    declaredStrength,+    newCallId,+  )+import Baikai.Evidence.Build (baikaiPackageVersion, renderEvidenceRefusal)+import Baikai.Evidence.Build qualified as Build+import Baikai.Provider.Cli.Internal+  ( ExecutableIdentity (..),+    cliResponseEnvelope,+    decodeClaudeCliResult,+    executableIdentity,+    parseCodexJsonlStream,+    subprocessStrength,+  )+import Baikai.Usage (Usage)+import Control.Concurrent (forkIO)+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)+import Control.Exception+  ( SomeAsyncException (..),+    SomeException,+    displayException,+    fromException,+    throwIO,+    try,+  )+import Control.Lens ((&), (.~), (^.))+import Control.Monad (void)+import Data.Aeson (Value)+import Data.Aeson qualified as Aeson+import Data.ByteString qualified as BS+import Data.Generics.Labels ()+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)+import Streamly.Data.Stream qualified as Stream+import System.Directory (doesDirectoryExist)+import System.Environment (lookupEnv)+import System.Exit (ExitCode (..))+import System.IO (Handle, hClose, hFlush, stderr, stdout)+import System.Process qualified as P+import System.Timeout qualified as Timeout+#if defined(BAIKAI_POSIX_SIGNALS)+import System.Posix.Signals qualified as Signals+#endif++-- | Run one unattended coding-agent command.+--+-- The request supplies every process-level setting — working directory,+-- timeout, output discipline, output limit, and declared environment+-- variables — while the command supplies the executable, the argument+-- vector, and the prompt transport. 'AgentCommand' deliberately carries+-- no working directory, because Claude Code has no working-directory+-- flag and two copies of a working directory could disagree, which would+-- be a sandbox escape rather than a cosmetic bug.+--+-- The outcomes:+--+-- * ran, whatever its exit code — @Right@ carrying that code+-- * working directory absent — @Left WorkingDirMissing@, nothing spawned+-- * a declared variable unset or empty — @Left MissingEnvironment@+-- * executable not startable — @Left SpawnFailed@+-- * still running at the deadline — @Left RunTimedOut@, whole process+--   group terminated+--+-- __Evidence.__ The first argument is the caller's request for a+-- verifiable record of the run. 'Nothing' means they want none, which is+-- what every caller got before this existed and what costs exactly+-- nothing: no digest is computed, no call identifier is generated, no+-- @--version@ probe is spawned, and the returned 'AgentRunOutcome'+-- carries 'Nothing'. That gate matters more here than on a model call,+-- because an unattended run can be a single short invocation and a+-- version probe would double its process count to describe a tool it is+-- about to run anyway.+--+-- The second argument is what the vendor renderer said it did with the+-- request's reasoning effort. This module never imports a vendor+-- renderer — that independence is why it can be tested with hand-written+-- argument vectors — so it cannot derive the translation and takes it.+--+-- __What evidence from this surface can and cannot prove.__ The tool's+-- own session identifier, model, and token counts are read out of+-- captured standard output, so they are available only when the run+-- captured output /and/ the tool was configured to print a structured+-- format — @--output-format json@ for @claude@, @--json@ for+-- @codex exec@, neither of which the vendor renderers emit by default.+-- Under 'InheritOutput' there is nothing to read at all. Absent those,+-- every tool-reported field stays 'Unobserved' and the strength stays at+-- 'Baikai.Evidence.EvidenceRequestedOnly'. An operator who needs+-- correlated evidence from an unattended run has to arrange both, and+-- that is a real constraint rather than something to discover from an+-- empty record.+--+-- A zero exit status never raises the strength. A coding agent that+-- exits zero has demonstrated that it ran; it has not said which model+-- served it.+runAgentCommand ::+  Maybe EvidenceRequest ->+  ThinkingTranslation ->+  AgentRunRequest ->+  AgentCommand ->+  IO AgentRunOutcome+runAgentCommand evidenceReq translation req cmd+  | not (null refusals) =+      pure (agentRunOutcome (Left (EvidenceRefused (map renderEvidenceRefusal refusals))))+  | otherwise = do+      -- Preconditions first, cheapest and most informative before costliest.+      -- Without the directory check a missing directory surfaces as an+      -- opaque spawn failure that appears to blame the coding-agent+      -- binary.+      --+      -- A precondition that fails means nothing started, so there is no+      -- run to describe and no evidence is built — which is also why the+      -- opt-in check below sits after them rather than before.+      dirExists <- doesDirectoryExist (req ^. #workingDir)+      if not dirExists+        then pure (agentRunOutcome (Left (WorkingDirMissing (req ^. #workingDir))))+        else do+          missing <- missingEnvironment (req ^. #envPassthrough)+          if not (null missing)+            then pure (agentRunOutcome (Left (MissingEnvironment missing)))+            else do+              start <- getCurrentTime+              result <- spawn req cmd+              end <- getCurrentTime+              case evidenceReq of+                Nothing -> pure (agentRunOutcome result)+                Just wanted -> do+                  built <- buildEvidence wanted translation req cmd start end result+                  pure AgentRunOutcome {outcome = result, evidence = built}+  where+    refusals = agentEvidenceRefusals evidenceReq translation req++-- | Every declared variable that is unset or empty, collected rather+-- than short-circuited so an operator fixing a job configuration sees+-- all of them in one run.+missingEnvironment :: [Text] -> IO [Text]+missingEnvironment names = do+  states <- traverse check names+  pure [name | (name, absent) <- states, absent]+  where+    check name = do+      value <- lookupEnv (Text.unpack name)+      pure (name, maybe True null value)++-- ====================================================================+-- Strict evidence: the pre-dispatch gate for this surface+-- ====================================================================++-- | Every reason this run cannot produce the evidence it was required+-- to, or an empty list.+--+-- The agent surface never touches 'Baikai.Provider.Registry.ApiProvider'+-- and has no trace sink, so neither of the gates+-- 'Baikai.Evidence.Build.checkEvidenceRequirements' is wired into+-- reaches it. This is its own, built from the same two halves.+--+-- __Structural, never predictive.__ It refuses when the requirement is+-- impossible with this configuration — an @inherit@ job can observe+-- nothing at all, and a @codex@ job can never learn a model — and stays+-- silent when the requirement is merely uncertain. A run that could have+-- reported what the caller needed and did not says so in its own+-- record's @strength@; failing it after the fact would destroy a report+-- of work that really happened, and the caller has the record to check.+agentEvidenceRefusals ::+  Maybe EvidenceRequest -> ThinkingTranslation -> AgentRunRequest -> [Build.EvidenceRefusal]+agentEvidenceRefusals Nothing _ _ = []+agentEvidenceRefusals (Just wanted) translation req = case wanted ^. #strictness of+  EvidenceBestEffort -> []+  EvidenceRequired needed ->+    [Build.StrengthUnreachable needed reachable | reachable < needed]+      <> [Build.ThinkingWouldDowngrade downgrades | not (null downgrades)]+    where+      reachable = agentReachableStrength req+      downgrades = translation ^. #adjustments++-- | The highest strength an unattended run with this configuration+-- could reach.+--+-- Under 'InheritOutput' the agent's bytes go to the operator's terminal+-- and baikai never holds them, so nothing the tool says can be observed+-- and the ceiling is 'EvidenceRequestedOnly' whatever the tool is. That+-- is the single most useful refusal on this surface: an operator who+-- wants a correlated record from an @inherit@ job has misconfigured it,+-- and finding out before the run rather than from an empty record is the+-- whole point.+--+-- Otherwise it is the tool's own ceiling, the same one+-- 'Baikai.Evidence.declaredStrength' states for that tool's completion+-- transport — read from there rather than restated, so the two surfaces+-- that drive the same binary cannot disagree about what it can tell you.+agentReachableStrength :: AgentRunRequest -> EvidenceStrength+agentReachableStrength req = case req ^. #output of+  InheritOutput -> EvidenceRequestedOnly+  CaptureOutput -> toolCeiling+  TeeOutput -> toolCeiling+  where+    toolCeiling = declaredStrength $ case req ^. #provider of+      AgentClaude -> AnthropicMessagesCli+      AgentCodex -> OpenAICompletionsCli++-- ====================================================================+-- Evidence+-- ====================================================================++-- | Everything that determines what the tool was asked to do, prompt+-- included. This is what 'Baikai.Evidence.commitmentDigest' commits to.+--+-- The prompt is a named field rather than being left to the argument+-- vector, and that is the whole point. Under 'PromptAsArgument' the+-- prompt is in the vector; under 'PromptOnStdin' — which is what both+-- vendor renderers produce today — it is not in the vector at all. A+-- commitment over the vector alone would give two runs with identical+-- flags and completely different instructions the same digest, which+-- would quietly defeat the one thing this digest exists to do.+agentRequestEnvelope :: AgentCommand -> Value+agentRequestEnvelope cmd =+  Aeson.object+    [ "argv" Aeson..= argvOf cmd,+      "prompt" Aeson..= (cmd ^. #promptText)+    ]++-- | The same request minus its content, for+-- 'Baikai.Evidence.configurationDigest'.+--+-- The prompt is removed by /value/ rather than by position: under+-- 'PromptAsArgument' it is documented as the last element, but matching+-- on the text cannot be wrong if a renderer ever appends something after+-- it.+--+-- Note that 'Baikai.Evidence.configurationProjection' currently reduces+-- this to @{}@, because @argv@ is not a name its allow-list admits — so+-- every agent run shares one configuration digest today. That is the+-- allow-list failing in the safe direction and matches what the two+-- subprocess completion providers already do. Building the value+-- prompt-free anyway costs nothing and means that if the projection ever+-- learns about argument vectors, it cannot start leaking the prompt on+-- the transport that puts it there.+agentConfigurationEnvelope :: AgentCommand -> Value+agentConfigurationEnvelope cmd =+  Aeson.object ["argv" Aeson..= filter (/= promptArgument) (argvOf cmd)]+  where+    promptArgument = cmd ^. #promptText++-- | The executable and its arguments, as a JSON-ready list of strings.+argvOf :: AgentCommand -> [Text]+argvOf cmd = map Text.pack ((cmd ^. #executable) : (cmd ^. #arguments))++-- | Assemble the run's evidence, or 'Nothing' when nothing ran.+--+-- Reached only when the caller opted in, which is what makes the+-- executable probe and the two digests affordable here.+buildEvidence ::+  EvidenceRequest ->+  ThinkingTranslation ->+  AgentRunRequest ->+  AgentCommand ->+  UTCTime ->+  UTCTime ->+  Either AgentRunFailure AgentRunResult ->+  IO (Maybe ModelCallEvidence)+buildEvidence wanted translation req cmd start end result =+  case evidenceStatus result of+    Nothing -> pure Nothing+    Just (st, failure) -> do+      cid <- newCallId+      identity <- executableIdentity (cmd ^. #executable)+      (session, model, tokens) <- observeToolOutput (req ^. #provider) result+      pure . Just $+        baseEvidence+          wanted+          cid+          (agentEndpoint req cmd identity)+          (requestedModelOf req)+          translation+          start+          end+          st+          (commitmentDigest (agentRequestEnvelope cmd))+          (configurationDigest (agentConfigurationEnvelope cmd))+          & #errorInfo .~ failure+          & #responseId .~ session+          & #observedModel .~ model+          & #usage .~ tokens+          & #responseCommitment .~ responseCommitmentOf st result tokens+          & #strength .~ subprocessStrength session model++-- | The call status for a run, and the normalized error that must+-- accompany a non-successful one.+--+-- 'Nothing' means no process ever started, so there is nothing to+-- describe. A timeout is not that case: the tool started, ran, consumed+-- tokens, and may well have changed the working tree before it was+-- killed, which is precisely the run an operator most wants a record of.+evidenceStatus ::+  Either AgentRunFailure AgentRunResult -> Maybe (CallStatus, Maybe BaikaiError)+evidenceStatus = \case+  Left failure@(RunTimedOut _) ->+    Just (CallAborted, Just (providerError (renderAgentRunFailure failure)))+  Left _ -> Nothing+  Right ran -> case ran ^. #exitCode of+    ExitSuccess -> Just (CallSucceeded, Nothing)+    ExitFailure code ->+      Just+        ( CallFailed,+          Just (processError code (capturedText (ran ^. #stderr)))+        )++-- | Where the run went, recorded without a URL, because there is no+-- request and no server.+--+-- @api@ names this surface rather than a wire protocol. An unattended+-- run speaks none: it writes to a pipe. Leaving the field empty would+-- read as "unknown" when it is in fact "not applicable", and borrowing a+-- 'Baikai.Api.Api' tag would claim an HTTP shape that was never used.+--+-- @implementationVersion@ is the tool's own reported version rather than+-- this package's, because for this surface the tool /is/ the+-- implementation.+agentEndpoint :: AgentRunRequest -> AgentCommand -> ExecutableIdentity -> EndpointIdentity+agentEndpoint req cmd identity =+  EndpointIdentity+    { provider = renderAgentProvider (req ^. #provider),+      api = "agent_run",+      transport = TransportAgentRun,+      endpoint = Just (fromMaybe (Text.pack (cmd ^. #executable)) (identity ^. #resolvedPath)),+      baikaiVersion = baikaiPackageVersion,+      implementationVersion = identity ^. #version+    }++-- | The model the caller asked for.+--+-- An unattended request may leave the model unset, which means "whatever+-- the tool defaults to". 'Baikai.Evidence.ModelCallEvidence' spells its+-- requested model as plain 'Text' with no way to say "none", so that+-- case is the empty string, and a reader of an agent-run record should+-- take an empty @requested_model@ to mean the tool's own default applied+-- rather than that an empty model id was sent — no @--model@ flag is+-- rendered at all in that case.+requestedModelOf :: AgentRunRequest -> Text+requestedModelOf req = fromMaybe "" (req ^. #modelId)++-- | What the tool said about its own run, read out of captured standard+-- output.+--+-- Best-effort by necessity. Neither vendor renderer asks its tool for a+-- structured format — @claude@ gets no @--output-format json@ and+-- @codex exec@ gets no @--json@ — because that would change what an+-- operator watching the run sees. So this parses if the operator+-- configured one through the job's extra arguments, and reports honest+-- silence if not. Under 'InheritOutput' there are no bytes at all.+--+-- Truncated output is still parsed: @codex@\'s newline-delimited stream+-- yields every complete line, which is more than nothing. Only the+-- response commitment insists on complete output, because a digest of a+-- truncated stream would stand for a response that was never seen whole.+observeToolOutput ::+  AgentProvider ->+  Either AgentRunFailure AgentRunResult ->+  IO (Observed Text, Observed Text, Observed Usage)+observeToolOutput provider result = case capturedBytes result of+  Nothing -> pure (Unobserved, Unobserved, Unobserved)+  Just bytes -> case provider of+    AgentClaude -> pure $ case decodeClaudeCliResult bytes of+      Left _ -> (Unobserved, Unobserved, Unobserved)+      Right report ->+        ( observedOf (report ^. #sessionId),+          observedOf (report ^. #reportedModel),+          observedOf (report ^. #usage)+        )+    AgentCodex -> do+      report <- parseCodexJsonlStream (Stream.fromList [bytes])+      pure+        ( observedOf (report ^. #threadId),+          observedOf (report ^. #reportedModel),+          observedOf (report ^. #usage)+        )++observedOf :: Maybe a -> Observed a+observedOf = maybe Unobserved Observed++-- | A commitment to what the run produced, on a run that produced it+-- whole.+--+-- Deliberately over the complete captured standard output rather than+-- over a parsed answer: that is unambiguously what the tool emitted, and+-- anyone holding the run's log can recompute it without knowing whether+-- the tool was configured for a structured format. 'Unobserved' when the+-- output was inherited, truncated, or the run did not finish — a digest+-- of a partial stream is a real-looking value standing for something+-- nobody saw whole.+responseCommitmentOf ::+  CallStatus ->+  Either AgentRunFailure AgentRunResult ->+  Observed Usage ->+  Observed Text+responseCommitmentOf CallSucceeded (Right ran) tokens = case ran ^. #stdout of+  OutputCaptured bytes ->+    Observed+      ( commitmentDigest+          (cliResponseEnvelope (Text.decodeUtf8Lenient bytes) (usageOr tokens))+      )+  _ -> Unobserved+  where+    usageOr = \case+      Observed u -> u+      Unobserved -> mempty+responseCommitmentOf _ _ _ = Unobserved++-- | The standard output bytes a run captured, complete or truncated.+capturedBytes :: Either AgentRunFailure AgentRunResult -> Maybe BS.ByteString+capturedBytes = \case+  Right ran -> case ran ^. #stdout of+    OutputCaptured bytes -> Just bytes+    OutputTruncated bytes -> Just bytes+    OutputNotCaptured -> Nothing+  Left _ -> Nothing++-- | Captured bytes as text, for an error message. Absent capture yields+-- the empty string rather than a claim about what the tool said.+capturedText :: AgentCapturedOutput -> Text+capturedText = \case+  OutputCaptured bytes -> Text.decodeUtf8Lenient bytes+  OutputTruncated bytes -> Text.decodeUtf8Lenient bytes+  OutputNotCaptured -> ""++spawn ::+  AgentRunRequest -> AgentCommand -> IO (Either AgentRunFailure AgentRunResult)+spawn req cmd = do+  let spec =+        (P.proc (cmd ^. #executable) (cmd ^. #arguments))+          { P.cwd = Just (req ^. #workingDir),+            P.std_in = stdinSpec,+            P.std_out = outSpec,+            P.std_err = outSpec,+            -- A coding agent runs shell commands as its own children.+            -- Its own group is what lets a timeout reach them.+            P.create_group = True,+            -- The child inherits the parent's environment in full. Both+            -- tools need HOME, PATH, and their own credential files;+            -- envPassthrough is a precondition check, not a filter.+            P.env = Nothing+          }+      stdinSpec = case cmd ^. #promptTransport of+        PromptOnStdin -> P.CreatePipe+        -- The prompt is already the last element of the argument vector.+        -- Supplying standard input as well is specifically harmful for+        -- Codex, which appends piped input as a separate <stdin> block,+        -- so the agent would receive the prompt twice.+        PromptAsArgument -> P.NoStream+      outSpec = case req ^. #output of+        InheritOutput -> P.Inherit+        CaptureOutput -> P.CreatePipe+        TeeOutput -> P.CreatePipe+  start <- getCurrentTime+  outcome <- trySync (P.withCreateProcess spec (consume req cmd start))+  case outcome of+    Right result -> pure result+    Left e ->+      pure+        ( Left+            ( SpawnFailed+                (cmd ^. #executable)+                (Text.pack (displayException e))+            )+        )++consume ::+  AgentRunRequest ->+  AgentCommand ->+  UTCTime ->+  Maybe Handle ->+  Maybe Handle ->+  Maybe Handle ->+  P.ProcessHandle ->+  IO (Either AgentRunFailure AgentRunResult)+consume req cmd start mIn mOut mErr ph = do+  case (cmd ^. #promptTransport, mIn) of+    (PromptOnStdin, Just hIn) -> writePromptAsync hIn (cmd ^. #promptText)+    _ -> pure ()+  -- Start draining both streams *before* waiting for the process. An+  -- operating-system pipe holds a bounded amount of data, typically 64+  -- kilobytes; if the parent waits for the child to exit before reading,+  -- a child that writes more than that blocks on write while the parent+  -- blocks on wait and neither proceeds. Waiting first looks more+  -- natural and is the classic deadlock — do not "simplify" it.+  --+  -- Both drains are forked, rather than one of them running here, so+  -- that the timeout below can fire while a stream is still open. A+  -- drain on this thread would block until the child exits, which would+  -- make the timeout unreachable in the two capturing modes.+  outVar <- forkDrain limit teeOut mOut+  errVar <- forkDrain limit teeErr mErr+  waited <- waitWithTimeout (timeoutMicros (req ^. #timeout)) ph+  case waited of+    Nothing -> do+      terminateGroup ph+      -- Report the configured limit rather than the measured elapsed+      -- time: the caller asked for a limit and wants to be told which+      -- one was hit, and the elapsed time is slightly larger because of+      -- the grace period.+      pure (Left (RunTimedOut (maybe 0 id (req ^. #timeout))))+    Just code -> do+      capturedOut <- takeMVar outVar+      capturedErr <- takeMVar errVar+      end <- getCurrentTime+      pure+        ( Right+            ( agentRunResult (req ^. #provider) code (diffUTCTime end start)+                & #stdout .~ capturedOut+                & #stderr .~ capturedErr+            )+        )+  where+    limit = req ^. #outputLimit+    (teeOut, teeErr) = case req ^. #output of+      TeeOutput -> (Just stdout, Just stderr)+      InheritOutput -> (Nothing, Nothing)+      CaptureOutput -> (Nothing, Nothing)++-- | Write the prompt and close the handle, on its own thread.+--+-- Closing is what signals end-of-input: without it both tools wait for+-- more prompt text and the run hangs until its timeout, a failure that+-- looks like a slow model rather than a bug.+--+-- The write is forked because a child that never reads its standard+-- input would otherwise block this thread before it could reach the+-- timeout. Failures are ignored: a child that exits without reading its+-- prompt makes the write fail, and that is the child's business, not a+-- reason to report the run as unstartable.+writePromptAsync :: Handle -> Text -> IO ()+writePromptAsync h promptBody =+  void . forkIO . void $+    (try :: IO () -> IO (Either SomeException ())) $ do+      -- Encode explicitly rather than using hPutStr, whose behavior+      -- depends on the handle's locale encoding and would corrupt a+      -- non-ASCII prompt on a machine with a non-UTF-8 locale.+      BS.hPut h (Text.encodeUtf8 promptBody)+      hClose h++-- | Drain one stream on its own thread, delivering the result through+-- an 'MVar'. A stream that was inherited rather than piped has no+-- handle and yields 'OutputNotCaptured' immediately.+forkDrain ::+  Maybe Int -> Maybe Handle -> Maybe Handle -> IO (MVar AgentCapturedOutput)+forkDrain limit tee source = do+  var <- newEmptyMVar+  case source of+    Nothing -> putMVar var OutputNotCaptured+    Just h ->+      void . forkIO $ do+        -- A plain 'try' rather than 'trySync' here on purpose: nothing+        -- delivers an asynchronous exception to this thread, and+        -- re-throwing one would leave the MVar empty and hang whoever+        -- takes it. A drain that fails yields no capture rather than+        -- propagating; the handles are closed under us on timeout, and+        -- that is a normal end rather than an error.+        result <- try (drain limit tee h) :: IO (Either SomeException AgentCapturedOutput)+        putMVar var (either (const OutputNotCaptured) id result)+  pure var++-- | Read a stream to the end, retaining at most the byte limit.+--+-- Once the retained bytes reach the limit the excess is read and+-- discarded rather than the pipe being closed early: closing the read+-- end makes the child's next write fail, which for a coding agent+-- usually means a crash and a confusing error attributed to the tool+-- rather than to the limit.+--+-- A 'Nothing' limit retains everything. That is unbounded by request;+-- the configuration layer supplies a default limit so an operator who+-- says nothing still gets a bound.+drain :: Maybe Int -> Maybe Handle -> Handle -> IO AgentCapturedOutput+drain limit tee h = go [] 0 False+  where+    go chunks retained dropped = do+      chunk <- BS.hGetSome h chunkSize+      if BS.null chunk+        then+          let bytes = BS.concat (reverse chunks)+           in pure (if dropped then OutputTruncated bytes else OutputCaptured bytes)+        else do+          echo chunk+          case limit of+            Nothing -> go (chunk : chunks) (retained + BS.length chunk) dropped+            Just cap+              | retained >= cap -> go chunks retained True+              | otherwise -> do+                  let kept = BS.take (cap - retained) chunk+                  go+                    (kept : chunks)+                    (retained + BS.length kept)+                    (dropped || BS.length kept < BS.length chunk)+    -- Flush per chunk: an unattended run can take many minutes, and an+    -- operator watching a log wants progress rather than a silent block+    -- that appears all at once at the end.+    echo chunk = case tee of+      Nothing -> pure ()+      Just target -> BS.hPut target chunk >> hFlush target++-- | Chunk size for pipe reads, matching the batch CLI provider in+-- @baikai-openai@.+chunkSize :: Int+chunkSize = 4096++-- | Convert a timeout in seconds to the microseconds+-- 'System.Timeout.timeout' expects.+--+-- Zero and negative durations mean __no timeout__ rather than \"expire+-- immediately\": a configuration file saying @timeout 0@ almost+-- certainly means unset, and immediately killing every run would be a+-- baffling failure. A duration too large to fit an 'Int' likewise means+-- no timeout, because a saturated deadline would be indistinguishable+-- from a much shorter one.+timeoutMicros :: Maybe NominalDiffTime -> Maybe Int+timeoutMicros Nothing = Nothing+timeoutMicros (Just seconds)+  | seconds <= 0 = Nothing+  | micros > toInteger (maxBound :: Int) = Nothing+  | otherwise = Just (fromInteger micros)+  where+    micros = ceiling (seconds * 1000000)++-- | Wait for the child, bounded by the timeout when there is one.+--+-- Only the wait is wrapped, never the whole spawn: a timeout firing+-- mid-drain would lose the output collected so far and the chance to+-- terminate cleanly.+waitWithTimeout :: Maybe Int -> P.ProcessHandle -> IO (Maybe ExitCode)+waitWithTimeout Nothing ph = Just <$> P.waitForProcess ph+waitWithTimeout (Just micros) ph = Timeout.timeout micros (P.waitForProcess ph)++-- | How long a timed-out run is given to clean up after the interrupt+-- before it is terminated outright. Long enough for a coding agent to+-- flush its state, short enough that an automated pipeline is not left+-- waiting on a tool that is not going to stop.+gracePeriodMicros :: Int+gracePeriodMicros = 2000000++-- | Signal the child's whole process group, escalating from interrupt+-- to terminate.+--+-- Signalling the group rather than the child is the point: a coding+-- agent runs shell commands as its own children, and terminating only+-- the agent leaves those grandchildren running, holding the working tree+-- open and possibly still writing to it — which for an unattended run a+-- script is about to inspect and commit is a correctness problem rather+-- than untidiness.+--+-- The escalation to a group-wide terminate happens whether or not the+-- interrupt stopped the agent itself, and that is not belt-and-braces.+-- POSIX requires a non-interactive shell to set @SIGINT@ to /ignored/ in+-- the background commands it starts, so an interrupt that kills the+-- agent outright can leave the very children this is meant to reach+-- still running. Only a group-wide terminate collects them.+--+-- Every signal is wrapped because a process that has already exited+-- makes these throw, and a race between the timeout firing and the+-- process exiting on its own is normal rather than exceptional. The+-- final wait always runs so the child is reaped instead of lingering as+-- a zombie.+terminateGroup :: P.ProcessHandle -> IO ()+terminateGroup ph = do+  -- Read the identifier before any wait: 'P.getPid' yields 'Nothing'+  -- once the process has been reaped, and the group is named after its+  -- leader.+  leader <- P.getPid ph+  _ <- trySync (P.interruptProcessGroupOf ph)+  stopped <- Timeout.timeout gracePeriodMicros (P.waitForProcess ph)+  _ <- trySync (terminateProcessGroup leader)+  case stopped of+    Just _ -> pure ()+    Nothing -> do+      _ <- trySync (P.terminateProcess ph)+      _ <- trySync (P.waitForProcess ph)+      pure ()++-- | Send @SIGTERM@ to a whole process group, named by its leader.+--+-- The @process@ package offers a group-wide /interrupt/ but no+-- group-wide /terminate/, so this reaches for the POSIX signal API+-- directly. On a platform without it the group's leader has already+-- been interrupted and is terminated by the caller; only survivors that+-- ignored the interrupt are missed.+terminateProcessGroup :: Maybe P.Pid -> IO ()+#if defined(BAIKAI_POSIX_SIGNALS)+terminateProcessGroup Nothing = pure ()+terminateProcessGroup (Just leader) =+  Signals.signalProcessGroup Signals.sigTERM leader+#else+terminateProcessGroup _ = pure ()+#endif++-- | Catch synchronous exceptions while re-throwing asynchronous ones.+--+-- Swallowing an asynchronous exception would break the timeout, whose+-- own exception is delivered asynchronously to this thread.+trySync :: IO a -> IO (Either SomeException a)+trySync action = do+  result <- try action+  case result of+    Left e+      | Just (SomeAsyncException _) <- (fromException e :: Maybe SomeAsyncException) ->+          throwIO e+      | otherwise -> pure (Left e)+    Right a -> pure (Right a)
+ test/CliTests.hs view
@@ -0,0 +1,864 @@+-- | Tests for the @baikai agent@ command-line surface.+--+-- The centerpiece is the @sync-keiro-dsl@ fixture: a fake @claude@+-- executable, a real KDL job file, and the real command-line entry+-- point, asserting the exact argument vector and the exact bytes the+-- fake received on standard input. No model is ever called and no+-- coding-agent binary is ever required.+--+-- Every test builds an 'AgentConfigPaths' explicitly and drives+-- 'runAgentCliWithPaths' rather than 'runAgentCli'. A developer with a+-- real @~\/.config\/baikai\/agents.kdl@ would otherwise get different+-- results from a clean machine, and the failure would be baffling.+module CliTests (cliTests) where++import Baikai.Agent (AgentCommand, agentRunRequest)+import Baikai.Agent.Cli+  ( AgentCliCommand (..),+    AgentCliOptions (..),+    AgentCliRun,+    PromptSource (..),+    agentCliParserInfo,+    configExitCode,+    readPromptSource,+    refusedExitCode,+    renderJobCommand,+    runAgentCliWithPaths,+    usageExitCode,+  )+import Baikai.Agent.Config (AgentConfigPaths (..), AgentJob, resolveAgentJob)+import Baikai.Evidence (EvidenceStrength (..), evidenceSchemaVersion)+import Control.Lens ((^.))+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KeyMap+import Data.Generics.Labels ()+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.IO qualified as TextIO+import GHC.IO.Handle (hDuplicate, hDuplicateTo)+import Options.Applicative qualified as Options+import Settei.Env (EnvSnapshot, envSnapshot)+import Settei.Key (parseKey)+import Settei.Optparse (cliOverride)+import System.Directory+  ( doesFileExist,+    getPermissions,+    setOwnerExecutable,+    setPermissions,+  )+import System.Environment (setEnv)+import System.FilePath ((</>))+import System.IO (IOMode (..), hClose, openFile, stdin)+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++cliTests :: TestTree+cliTests =+  testGroup+    "Baikai.Agent.Cli"+    [ testGroup+        "provider dispatch"+        [ dispatchesToClaudeTest,+          dispatchesToCodexTest,+          honorsExecutableOverrideTest+        ],+      testGroup+        "agent list"+        [ listsNothingWhenUnconfiguredTest,+          listsConfiguredJobsTest+        ],+      testGroup+        "agent show"+        [ showExplainsWithProvenanceTest,+          showRedactsProviderArgumentsTest,+          showPrintsConfigurationBeforeRefusalTest,+          showReportsAnUnreadableFileTest+        ],+      testGroup+        "the sync-keiro-dsl fixture"+        [ syncKeiroDslRunsTest,+          swappingTheProviderIsAConfigurationChangeTest,+          swappingTheProviderRefusesATheToolListTest,+          theCeilingRefusesBeforeAnythingIsStartedTest+        ],+      testGroup+        "agent run"+        [ propagatesTheAgentExitCodeTest,+          inheritModeCapturesNothingTest,+          reportsAMissingExecutableTest,+          refusesAnEmptyPromptTest,+          writesTheEvidenceFileTest,+          writesNoEvidenceFileByDefaultTest,+          refusesAnImpossibleEvidenceRequirementTest+        ],+      testGroup+        "prompts"+        [ readsThePromptFromStandardInputTest,+          readsThePromptFromAFileTest,+          rejectsAMissingPromptFileTest+        ],+      testGroup+        "the parser"+        [ twoPromptSourcesAreAUsageErrorTest,+          parsesTheMotivatingInvocationTest+        ]+    ]++-- --------------------------------------------------------------------+-- Harness+-- --------------------------------------------------------------------++noEnvironment :: EnvSnapshot+noEnvironment = envSnapshot []++-- | Options naming one command, with no overrides and neither+-- configuration scope. Tests supply the paths separately, so the two+-- path fields stay 'Nothing' here and are never consulted.+options :: AgentCliCommand -> AgentCliOptions+options command =+  AgentCliOptions+    { command,+      overrides = [],+      userConfig = Nothing,+      repoConfig = Nothing,+      jsonOutput = False,+      evidenceFile = Nothing,+      runId = Nothing,+      requiredEvidence = Nothing+    }++withOverride :: Text -> Text -> AgentCliOptions -> AgentCliOptions+withOverride key value opts =+  opts+    { overrides =+        (opts ^. #overrides) <> [cliOverride (either (error . show) id (parseKey key)) value]+    }++-- | Demand a strength the run must reach, or be refused.+requiringEvidence :: EvidenceStrength -> AgentCliOptions -> AgentCliOptions+requiringEvidence needed opts = opts {requiredEvidence = Just needed}++-- | Ask for evidence, naming both a destination and an outer run.+withEvidence :: FilePath -> Text -> AgentCliOptions -> AgentCliOptions+withEvidence path outerRun opts =+  opts {evidenceFile = Just path, runId = Just outerRun}++-- | Paths naming only a repository document, which is the normal state+-- for an operator who has written no policy file.+repositoryOnly :: FilePath -> AgentConfigPaths+repositoryOnly path = AgentConfigPaths {userConfig = Nothing, repoConfig = Just path}++-- | Write a KDL document into a temporary directory and hand back the+-- workspace directory and the document's path.+withWorkspace :: (FilePath -> IO a) -> IO a+withWorkspace = withSystemTempDirectory "baikai-agent-cli"++writeDocument :: FilePath -> String -> Text -> IO FilePath+writeDocument dir name body = do+  let path = dir </> name+  TextIO.writeFile path body+  pure path++-- | Write a tiny shell script and make it executable. Every behavior+-- these tests need from a coding agent is a few lines of @sh@, which is+-- what keeps the suite free of any coding-agent binary, any+-- authentication, and any model.+writeFakeAgent :: FilePath -> String -> Text -> IO FilePath+writeFakeAgent dir name body = do+  path <- writeDocument dir name body+  perms <- getPermissions path+  setPermissions path (setOwnerExecutable True perms)+  pure path++-- | A fake agent that records its argument vector and its standard+-- input into the files named by two environment variables, then behaves+-- like a coding agent that succeeded.+recordingAgent :: Text -> Text -> Text+recordingAgent argvVariable stdinVariable =+  Text.unlines+    [ "#!/bin/sh",+      "printf '%s\\n' \"$@\" > \"$" <> argvVariable <> "\"",+      "cat > \"$" <> stdinVariable <> "\"",+      "echo 'reconciled the lexical surface'"+    ]++-- | The recorded argument vector, one element per line.+recordedArgv :: FilePath -> IO [Text]+recordedArgv path = Text.lines <$> TextIO.readFile path++run :: AgentConfigPaths -> AgentCliOptions -> IO AgentCliRun+run paths = runAgentCliWithPaths paths noEnvironment++-- | The prompt the fixture sends: multi-line, with a dash-leading line+-- and a non-ASCII character, because the transport decision exists to+-- make exactly that safe.+fixturePrompt :: Text+fixturePrompt =+  Text.unlines+    [ "--reconcile the lexical surface against the grammar",+      "réconcilier la grammaire — 文法",+      "leave the test gate to the script"+    ]++-- --------------------------------------------------------------------+-- Provider dispatch+-- --------------------------------------------------------------------++-- | Resolve one job from a document, failing the test with the real+-- diagnosis.+resolveOne :: Text -> Text -> IO AgentJob+resolveOne document jobName =+  withWorkspace $ \dir -> do+    path <- writeDocument dir "repo.kdl" document+    loaded <- resolveAgentJob (repositoryOnly path) noEnvironment [] jobName+    case loaded of+      Left problem -> assertFailure ("loading failed: " <> show problem)+      Right resolved -> case resolved ^. #answer of+        Left problems -> assertFailure ("resolution failed: " <> show problems)+        Right job -> pure job++minimalJob :: Text -> Text -> Text+minimalJob provider extra =+  Text.unlines+    [ "jobs {",+      "  demo {",+      "    provider \"" <> provider <> "\"",+      "    working-dir \"/tmp\"",+      extra,+      "    safety { capability \"edit-workspace\" }",+      "  }",+      "}"+    ]++renderedFor :: Text -> Text -> IO AgentCommand+renderedFor provider extra = do+  job <- resolveOne (minimalJob provider extra) "demo"+  let request = agentRunRequest (job ^. #provider) (job ^. #workingDir) "a prompt"+  case renderJobCommand job request of+    Left refusal -> assertFailure ("expected a rendered command: " <> show refusal)+    Right (command, _) -> pure command++dispatchesToClaudeTest :: TestTree+dispatchesToClaudeTest =+  testCase "a claude job renders a claude argument vector" $ do+    command <- renderedFor "claude" ""+    take 1 (command ^. #arguments) @?= ["-p"]+    command ^. #executable @?= "claude"++dispatchesToCodexTest :: TestTree+dispatchesToCodexTest =+  testCase "a codex job renders a codex argument vector" $ do+    command <- renderedFor "codex" ""+    take 1 (command ^. #arguments) @?= ["exec"]+    command ^. #executable @?= "codex"++honorsExecutableOverrideTest :: TestTree+honorsExecutableOverrideTest =+  testCase "the job's executable override becomes the program" $ do+    command <- renderedFor "claude" "    executable \"/opt/bin/claude\""+    command ^. #executable @?= "/opt/bin/claude"++-- --------------------------------------------------------------------+-- agent list+-- --------------------------------------------------------------------++listsNothingWhenUnconfiguredTest :: TestTree+listsNothingWhenUnconfiguredTest =+  testCase "an empty list exits 0 and keeps standard output empty" $ do+    -- An empty list is a normal state, not an error, and a script+    -- piping the output should never have to filter prose out of data.+    finished <- run AgentConfigPaths {userConfig = Nothing, repoConfig = Nothing} (options AgentList)+    finished ^. #exitCode @?= 0+    finished ^. #standardOutput @?= ""+    assertBool+      ("the note explains the empty list: " <> Text.unpack (finished ^. #standardError))+      ("no jobs are configured" `Text.isInfixOf` (finished ^. #standardError))++listsConfiguredJobsTest :: TestTree+listsConfiguredJobsTest =+  testCase "configured jobs are listed, sorted, with their scope" $+    withWorkspace $ \dir -> do+      path <-+        writeDocument+          dir+          "repo.kdl"+          ( Text.unlines+              [ "jobs {",+                "  zebra { provider \"claude\" }",+                "  alpha { provider \"codex\" }",+                "}"+              ]+          )+      finished <- run (repositoryOnly path) (options AgentList)+      finished ^. #exitCode @?= 0+      let listed = Text.lines (finished ^. #standardOutput)+      map (take 1 . Text.words) listed @?= [["alpha"], ["zebra"]]+      assertBool+        ("the scope is named: " <> Text.unpack (finished ^. #standardOutput))+        ("repository configuration" `Text.isInfixOf` (finished ^. #standardOutput))++-- --------------------------------------------------------------------+-- agent show+-- --------------------------------------------------------------------++showExplainsWithProvenanceTest :: TestTree+showExplainsWithProvenanceTest =+  testCase "show names each value's file and line, and the rendered command" $+    -- Improvement-request acceptance criterion 5. settei's own+    -- renderResolutionText drops the location, so this is also the test+    -- that the command-line layer walks the report itself.+    withWorkspace $ \dir -> do+      path <- writeDocument dir "repo.kdl" (minimalJob "claude" "")+      finished <- run (repositoryOnly path) (options (AgentShow "demo"))+      let output = finished ^. #standardOutput+      finished ^. #exitCode @?= 0+      assertBool+        ("the provider is named: " <> Text.unpack output)+        ("jobs.demo.provider" `Text.isInfixOf` output && "claude" `Text.isInfixOf` output)+      assertBool+        ("the file is cited: " <> Text.unpack output)+        (Text.pack path `Text.isInfixOf` output)+      assertBool+        ("a line and column follow the path: " <> Text.unpack output)+        ((Text.pack path <> ":3:") `Text.isInfixOf` output)+      assertBool+        ("the ceiling is shown: " <> Text.unpack output)+        ("max-capability" `Text.isInfixOf` output)+      assertBool+        ("the rendered vector is shown: " <> Text.unpack output)+        ("--permission-mode acceptEdits" `Text.isInfixOf` output)+      assertBool+        ("the prompt transport is shown: " <> Text.unpack output)+        ("prompt transport: standard input" `Text.isInfixOf` output)++showRedactsProviderArgumentsTest :: TestTree+showRedactsProviderArgumentsTest =+  testCase "show never prints a raw provider argument" $+    -- provider-args is the one setting an operator could write a+    -- credential into. It must not appear in the effective+    -- configuration and it must not appear in the rendered argument+    -- vector either, which is the easier of the two to overlook.+    withWorkspace $+      \dir -> do+        userPath <-+          writeDocument+            dir+            "user.kdl"+            (Text.unlines ["policy {", "  allow-provider-args #true", "}"])+        repoPath <-+          writeDocument+            dir+            "repo.kdl"+            ( Text.unlines+                [ "jobs {",+                  "  demo {",+                  "    provider \"claude\"",+                  "    working-dir \"/tmp\"",+                  "    safety {",+                  "      capability \"edit-workspace\"",+                  "      provider-args \"--api-key\" \"sk-not-a-real-key\"",+                  "    }",+                  "  }",+                  "}"+                ]+            )+        finished <-+          run+            AgentConfigPaths {userConfig = Just userPath, repoConfig = Just repoPath}+            (options (AgentShow "demo"))+        let output = finished ^. #standardOutput <> finished ^. #standardError+        finished ^. #exitCode @?= 0+        assertBool+          ("the credential does not appear: " <> Text.unpack output)+          (not ("sk-not-a-real-key" `Text.isInfixOf` output))+        assertBool+          ("the redaction marker appears: " <> Text.unpack output)+          ("<redacted>" `Text.isInfixOf` output)+        assertBool+          ("the setting is still named: " <> Text.unpack output)+          ("jobs.demo.safety.provider-args" `Text.isInfixOf` output)++showPrintsConfigurationBeforeRefusalTest :: TestTree+showPrintsConfigurationBeforeRefusalTest =+  testCase "a refused job still shows its configuration" $+    -- A job the ceiling refuses is precisely the case an operator most+    -- needs `show` for; printing nothing would hide it.+    withWorkspace $ \dir -> do+      path <-+        writeDocument+          dir+          "repo.kdl"+          ( Text.unlines+              [ "jobs {",+                "  demo {",+                "    provider \"claude\"",+                "    working-dir \"/tmp\"",+                "    safety { capability \"full-access\" }",+                "  }",+                "}"+              ]+          )+      finished <- run (repositoryOnly path) (options (AgentShow "demo"))+      finished ^. #exitCode @?= refusedExitCode+      assertBool+        ("the configuration was printed: " <> Text.unpack (finished ^. #standardOutput))+        ("jobs.demo.safety.capability" `Text.isInfixOf` (finished ^. #standardOutput))+      assertBool+        ("the refusal names both values: " <> Text.unpack (finished ^. #standardError))+        ( "full-access" `Text.isInfixOf` (finished ^. #standardError)+            && "edit-workspace" `Text.isInfixOf` (finished ^. #standardError)+        )++showReportsAnUnreadableFileTest :: TestTree+showReportsAnUnreadableFileTest =+  testCase "a malformed document exits with the configuration code" $+    withWorkspace $ \dir -> do+      path <- writeDocument dir "repo.kdl" "jobs {\n  demo {\n    provider \"claude\"\n"+      finished <- run (repositoryOnly path) (options (AgentShow "demo"))+      finished ^. #exitCode @?= configExitCode+      assertBool+        ("the file is named: " <> Text.unpack (finished ^. #standardError))+        (Text.pack path `Text.isInfixOf` (finished ^. #standardError))++-- --------------------------------------------------------------------+-- The sync-keiro-dsl fixture+-- --------------------------------------------------------------------++-- | The translation of the motivating script's launch into+-- configuration.+--+-- The real consumer would use @inherit@, and the migration guide shows+-- it that way; this fixture uses @capture@ so the test can observe the+-- output. The extra directory is deliberately __not__ here: it arrives+-- on the command line as a single @--set@, which is what makes the+-- "no provider flags in the script" claim testable.+syncKeiroDslDocument :: FilePath -> FilePath -> Text+syncKeiroDslDocument workingDir executable =+  Text.unlines+    [ "jobs {",+      "  sync-keiro-dsl {",+      "    provider     \"claude\"",+      "    working-dir  \"" <> Text.pack workingDir <> "\"",+      "    executable   \"" <> Text.pack executable <> "\"",+      "    output       \"capture\"",+      "    env-requires \"BAIKAI_TEST_CLAUDE_ARGV\" \"BAIKAI_TEST_CLAUDE_STDIN\"",+      "    safety {",+      "      capability    \"edit-workspace\"",+      "      allowed-tools \"Read\" \"Write\" \"Edit\" \"Glob\" \"Grep\" \"Bash\" \"Skill\" \"TodoWrite\"",+      "    }",+      "  }",+      "}"+    ]++syncKeiroDslRunsTest :: TestTree+syncKeiroDslRunsTest =+  testCase "THE MOTIVATING LAUNCH RUNS WITH NO PROVIDER FLAGS IN THE INVOCATION" $+    -- The initiative's central acceptance criterion. The invocation+    -- below names a job and one --set and nothing else; every Claude+    -- flag in the asserted vector came from configuration.+    withWorkspace $ \dir -> do+      let argvRecord = dir </> "argv"+          stdinRecord = dir </> "stdin"+          keiroPath = dir </> "keiro"+      setEnv "BAIKAI_TEST_CLAUDE_ARGV" argvRecord+      setEnv "BAIKAI_TEST_CLAUDE_STDIN" stdinRecord+      executable <-+        writeFakeAgent+          dir+          "claude"+          (recordingAgent "BAIKAI_TEST_CLAUDE_ARGV" "BAIKAI_TEST_CLAUDE_STDIN")+      promptPath <- writeDocument dir "prompt.txt" fixturePrompt+      configPath <- writeDocument dir "repo.kdl" (syncKeiroDslDocument dir executable)+      finished <-+        run+          (repositoryOnly configPath)+          ( withOverride+              "extra-dirs"+              (Text.pack keiroPath)+              (options (AgentRun "sync-keiro-dsl" (PromptFile promptPath)))+          )+      finished ^. #exitCode @?= 0+      argv <- recordedArgv argvRecord+      -- The whole vector, not individual members: a test that checks+      -- only membership would pass with an extra flag nobody asked for.+      argv+        @?= [ "-p",+              "--no-session-persistence",+              "--permission-mode",+              "acceptEdits",+              "--allowedTools",+              "Read,Write,Edit,Glob,Grep,Bash,Skill,TodoWrite",+              "--add-dir",+              Text.pack keiroPath+            ]+      delivered <- TextIO.readFile stdinRecord+      delivered @?= fixturePrompt+      assertBool+        ("the agent's answer is on standard output: " <> Text.unpack (finished ^. #standardOutput))+        ("reconciled the lexical surface" `Text.isInfixOf` (finished ^. #standardOutput))++swappingTheProviderIsAConfigurationChangeTest :: TestTree+swappingTheProviderIsAConfigurationChangeTest =+  testCase "changing only the provider line moves the run to codex" $+    -- The initiative's headline claim. The tool allow-list is removed+    -- too, because codex exec has no such flag; the next test covers+    -- what happens when it is left in.+    withWorkspace $ \dir -> do+      let argvRecord = dir </> "argv"+          stdinRecord = dir </> "stdin"+      setEnv "BAIKAI_TEST_CODEX_ARGV" argvRecord+      setEnv "BAIKAI_TEST_CODEX_STDIN" stdinRecord+      executable <-+        writeFakeAgent+          dir+          "codex"+          (recordingAgent "BAIKAI_TEST_CODEX_ARGV" "BAIKAI_TEST_CODEX_STDIN")+      promptPath <- writeDocument dir "prompt.txt" fixturePrompt+      configPath <-+        writeDocument+          dir+          "repo.kdl"+          ( Text.unlines+              [ "jobs {",+                "  sync-keiro-dsl {",+                "    provider     \"codex\"",+                "    working-dir  \"" <> Text.pack dir <> "\"",+                "    executable   \"" <> Text.pack executable <> "\"",+                "    output       \"capture\"",+                "    safety { capability \"edit-workspace\" }",+                "  }",+                "}"+              ]+          )+      finished <-+        run+          (repositoryOnly configPath)+          (options (AgentRun "sync-keiro-dsl" (PromptFile promptPath)))+      finished ^. #exitCode @?= 0+      argv <- recordedArgv argvRecord+      argv+        @?= [ "exec",+              "--sandbox",+              "workspace-write",+              "--cd",+              Text.pack dir,+              "--skip-git-repo-check",+              "--ephemeral"+            ]+      delivered <- TextIO.readFile stdinRecord+      delivered @?= fixturePrompt++swappingTheProviderRefusesATheToolListTest :: TestTree+swappingTheProviderRefusesATheToolListTest =+  testCase "keeping the tool allow-list on codex is refused, loudly" $+    -- The honest half of "switching providers is a configuration+    -- change": where it is not, you are told rather than silently given+    -- weaker isolation.+    withWorkspace $ \dir -> do+      let argvRecord = dir </> "argv"+      executable <- writeFakeAgent dir "codex" "#!/bin/sh\ntouch \"$1\"\n"+      promptPath <- writeDocument dir "prompt.txt" fixturePrompt+      configPath <-+        writeDocument+          dir+          "repo.kdl"+          ( Text.unlines+              [ "jobs {",+                "  sync-keiro-dsl {",+                "    provider     \"codex\"",+                "    working-dir  \"" <> Text.pack dir <> "\"",+                "    executable   \"" <> Text.pack executable <> "\"",+                "    safety {",+                "      capability    \"edit-workspace\"",+                "      allowed-tools \"Read\" \"Write\"",+                "    }",+                "  }",+                "}"+              ]+          )+      finished <-+        run+          (repositoryOnly configPath)+          (options (AgentRun "sync-keiro-dsl" (PromptFile promptPath)))+      finished ^. #exitCode @?= refusedExitCode+      assertBool+        ("the message names the sandbox alternative: " <> Text.unpack (finished ^. #standardError))+        ("sandbox" `Text.isInfixOf` (finished ^. #standardError))+      started <- doesFileExist argvRecord+      assertBool "nothing was started" (not started)++theCeilingRefusesBeforeAnythingIsStartedTest :: TestTree+theCeilingRefusesBeforeAnythingIsStartedTest =+  testCase "A REFUSED JOB NEVER REACHES PROCESS CREATION" $+    -- Improvement-request acceptance criterion 6. The assertion that+    -- carries the weight is the last one: the fake's record file does+    -- not exist, so the fake was never run.+    withWorkspace $ \dir -> do+      let argvRecord = dir </> "argv"+      executable <-+        writeFakeAgent dir "claude" ("#!/bin/sh\ntouch '" <> Text.pack argvRecord <> "'\n")+      promptPath <- writeDocument dir "prompt.txt" fixturePrompt+      configPath <-+        writeDocument+          dir+          "repo.kdl"+          ( Text.unlines+              [ "jobs {",+                "  sync-keiro-dsl {",+                "    provider    \"claude\"",+                "    working-dir \"" <> Text.pack dir <> "\"",+                "    executable  \"" <> Text.pack executable <> "\"",+                "    safety { capability \"full-access\" }",+                "  }",+                "}"+              ]+          )+      finished <-+        run+          (repositoryOnly configPath)+          (options (AgentRun "sync-keiro-dsl" (PromptFile promptPath)))+      finished ^. #exitCode @?= refusedExitCode+      assertBool+        ("the refusal names both values: " <> Text.unpack (finished ^. #standardError))+        ( "full-access" `Text.isInfixOf` (finished ^. #standardError)+            && "edit-workspace" `Text.isInfixOf` (finished ^. #standardError)+        )+      started <- doesFileExist argvRecord+      assertBool "the executable was never invoked" (not started)++-- --------------------------------------------------------------------+-- agent run+-- --------------------------------------------------------------------++-- | A job rooted in the workspace, running the given script, capturing+-- output unless told otherwise.+scriptedJob :: FilePath -> FilePath -> Text -> Text+scriptedJob dir executable outputMode =+  Text.unlines+    [ "jobs {",+      "  demo {",+      "    provider    \"claude\"",+      "    working-dir \"" <> Text.pack dir <> "\"",+      "    executable  \"" <> Text.pack executable <> "\"",+      "    output      \"" <> outputMode <> "\"",+      "    safety { capability \"edit-workspace\" }",+      "  }",+      "}"+    ]++propagatesTheAgentExitCodeTest :: TestTree+propagatesTheAgentExitCodeTest =+  testCase "the agent's own exit code passes through unchanged" $+    -- The motivating script ends its launch with `|| die`, and a script+    -- that wants to tell "the agent failed the task" from "the tool+    -- could not start" needs the codes to stay separate.+    withWorkspace $ \dir -> do+      executable <- writeFakeAgent dir "claude" "#!/bin/sh\ncat > /dev/null\nexit 3\n"+      configPath <- writeDocument dir "repo.kdl" (scriptedJob dir executable "capture")+      finished <-+        run (repositoryOnly configPath) (options (AgentRun "demo" (PromptInline "do the thing")))+      finished ^. #exitCode @?= 3+      -- Nothing extra is narrated: the agent has already explained+      -- itself on its own standard error.+      finished ^. #standardError @?= ""++inheritModeCapturesNothingTest :: TestTree+inheritModeCapturesNothingTest =+  testCase "inherit mode leaves the record empty" $+    -- The agent's line goes to the test runner's own output, which is+    -- expected: under inherit the child writes to the real streams and+    -- bypasses AgentCliRun entirely.+    withWorkspace $ \dir -> do+      executable <-+        writeFakeAgent dir "claude" "#!/bin/sh\ncat > /dev/null\necho 'inherited line'\n"+      configPath <- writeDocument dir "repo.kdl" (scriptedJob dir executable "inherit")+      finished <-+        run (repositoryOnly configPath) (options (AgentRun "demo" (PromptInline "do the thing")))+      finished ^. #exitCode @?= 0+      finished ^. #standardOutput @?= ""+      finished ^. #standardError @?= ""++reportsAMissingExecutableTest :: TestTree+reportsAMissingExecutableTest =+  testCase "a missing coding-agent binary exits 69" $+    withWorkspace $ \dir -> do+      configPath <-+        writeDocument dir "repo.kdl" (scriptedJob dir (dir </> "not-installed") "capture")+      finished <-+        run (repositoryOnly configPath) (options (AgentRun "demo" (PromptInline "do the thing")))+      finished ^. #exitCode @?= 69+      assertBool+        ("the missing program is named: " <> Text.unpack (finished ^. #standardError))+        ("not-installed" `Text.isInfixOf` (finished ^. #standardError))++writesTheEvidenceFileTest :: TestTree+writesTheEvidenceFileTest =+  testCase "--evidence-file writes one schema-valid record for the run" $+    -- The point of the option: an automation job gets a reviewable+    -- record as a side effect of running, without the script having to+    -- know anything about evidence.+    withWorkspace $ \dir -> do+      let evidencePath = dir </> "evidence.json"+      executable <-+        writeFakeAgent+          dir+          "claude"+          "#!/bin/sh\ncat > /dev/null\necho 'the task is done'\n"+      configPath <- writeDocument dir "repo.kdl" (scriptedJob dir executable "capture")+      finished <-+        run+          (repositoryOnly configPath)+          (withEvidence evidencePath "outer-run-7" (options (AgentRun "demo" (PromptInline "do the thing"))))+      finished ^. #exitCode @?= 0+      -- Nothing about the evidence file leaks onto the agent's own+      -- output, which a script may be capturing.+      finished ^. #standardOutput @?= "the task is done\n"+      recorded <- Aeson.eitherDecodeFileStrict evidencePath+      case recorded of+        Left problem -> assertFailure ("the record did not parse as JSON: " <> problem)+        Right (Aeson.Object o) -> do+          KeyMap.lookup "schema_version" o @?= Just (Aeson.String evidenceSchemaVersion)+          KeyMap.lookup "run_id" o @?= Just (Aeson.String "outer-run-7")+          KeyMap.lookup "status" o @?= Just (Aeson.String "succeeded")+          -- The fake reports nothing about itself, so the record says so+          -- rather than inferring anything from its clean exit.+          KeyMap.lookup "strength" o @?= Just (Aeson.String "requested_only")+          assertBool+            ("a call id was generated: " <> show (KeyMap.lookup "call_id" o))+            (KeyMap.lookup "call_id" o /= Nothing)+        Right other -> assertFailure ("expected one JSON object, got: " <> show other)+      -- The write is atomic through a staging file, which must not be+      -- left behind.+      leftover <- doesFileExist (evidencePath <> ".partial")+      assertBool "the staging file was renamed away" (not leftover)++writesNoEvidenceFileByDefaultTest :: TestTree+writesNoEvidenceFileByDefaultTest =+  testCase "a run that named no evidence destination writes nothing" $+    withWorkspace $ \dir -> do+      let evidencePath = dir </> "evidence.json"+      executable <-+        writeFakeAgent dir "claude" "#!/bin/sh\ncat > /dev/null\necho 'the task is done'\n"+      configPath <- writeDocument dir "repo.kdl" (scriptedJob dir executable "capture")+      finished <-+        run (repositoryOnly configPath) (options (AgentRun "demo" (PromptInline "do the thing")))+      finished ^. #exitCode @?= 0+      written <- doesFileExist evidencePath+      assertBool "no evidence file appeared" (not written)++-- | A run whose evidence requirement cannot be met is refused through+-- the command surface, with the refusal exit code.+--+-- This case exists because its absence let a crash ship: adding the+-- 'EvidenceRefused' constructor left `failureExitCode`'s match+-- non-exhaustive, and no test drove a refused run through the command,+-- so the only symptom was a pattern-match failure on a real invocation.+refusesAnImpossibleEvidenceRequirementTest :: TestTree+refusesAnImpossibleEvidenceRequirementTest =+  testCase "a run demanding evidence an inherit job cannot produce is refused" $+    withWorkspace $ \dir -> do+      let argvRecord = dir </> "argv"+      executable <-+        writeFakeAgent dir "claude" ("#!/bin/sh\ntouch '" <> Text.pack argvRecord <> "'\n")+      -- `inherit` sends the agent's bytes to the terminal, so baikai+      -- holds nothing and can observe nothing however the run goes.+      configPath <- writeDocument dir "repo.kdl" (scriptedJob dir executable "inherit")+      finished <-+        run+          (repositoryOnly configPath)+          ( requiringEvidence+              EvidenceCorrelated+              (options (AgentRun "demo" (PromptInline "do the thing")))+          )+      finished ^. #exitCode @?= refusedExitCode+      assertBool+        ("the refusal explains itself: " <> Text.unpack (finished ^. #standardError))+        -- The whole phrase, not a prefix: a mis-escaped string gap once+        -- turned "it required" into a carriage return plus "equired",+        -- and an assertion that stopped before the word did not notice.+        ( "cannot produce the evidence it required"+            `Text.isInfixOf` (finished ^. #standardError)+            && "correlated" `Text.isInfixOf` (finished ^. #standardError)+        )+      started <- doesFileExist argvRecord+      assertBool "nothing was started" (not started)++refusesAnEmptyPromptTest :: TestTree+refusesAnEmptyPromptTest =+  testCase "an empty prompt is a usage error, not an expensive run" $+    withWorkspace $ \dir -> do+      executable <- writeFakeAgent dir "claude" "#!/bin/sh\nexit 0\n"+      configPath <- writeDocument dir "repo.kdl" (scriptedJob dir executable "capture")+      emptyPrompt <- writeDocument dir "empty.txt" ""+      finished <-+        run (repositoryOnly configPath) (options (AgentRun "demo" (PromptFile emptyPrompt)))+      finished ^. #exitCode @?= usageExitCode+      assertBool+        ("the empty source is named: " <> Text.unpack (finished ^. #standardError))+        (Text.pack emptyPrompt `Text.isInfixOf` (finished ^. #standardError))++-- --------------------------------------------------------------------+-- Prompts+-- --------------------------------------------------------------------++readsThePromptFromStandardInputTest :: TestTree+readsThePromptFromStandardInputTest =+  testCase "the standard-input reader decodes UTF-8 explicitly" $+    -- The fixture above uses a file, because standard input cannot be+    -- piped in-process; this is the narrow test of the transport the+    -- motivating script actually uses. The real handle is duplicated+    -- and restored so no other test is affected.+    withWorkspace $ \dir -> do+      path <- writeDocument dir "prompt.txt" fixturePrompt+      saved <- hDuplicate stdin+      source <- openFile path ReadMode+      hDuplicateTo source stdin+      hClose source+      outcome <- readPromptSource PromptStdin+      hDuplicateTo saved stdin+      hClose saved+      outcome @?= Right fixturePrompt++readsThePromptFromAFileTest :: TestTree+readsThePromptFromAFileTest =+  testCase "a prompt file is read byte for byte" $+    withWorkspace $ \dir -> do+      path <- writeDocument dir "prompt.txt" fixturePrompt+      outcome <- readPromptSource (PromptFile path)+      outcome @?= Right fixturePrompt++rejectsAMissingPromptFileTest :: TestTree+rejectsAMissingPromptFileTest =+  testCase "a missing prompt file is named rather than read as empty" $+    withWorkspace $ \dir -> do+      outcome <- readPromptSource (PromptFile (dir </> "absent.txt"))+      case outcome of+        Right value -> assertFailure ("expected a failure, got: " <> show value)+        Left message ->+          assertBool+            ("the path is named: " <> Text.unpack message)+            (Text.pack (dir </> "absent.txt") `Text.isInfixOf` message)++-- --------------------------------------------------------------------+-- The parser+-- --------------------------------------------------------------------++parse :: [String] -> Options.ParserResult AgentCliOptions+parse = Options.execParserPure Options.defaultPrefs agentCliParserInfo++twoPromptSourcesAreAUsageErrorTest :: TestTree+twoPromptSourcesAreAUsageErrorTest =+  testCase "supplying two prompt sources is a usage error" $+    case parse ["agent", "run", "demo", "--prompt-stdin", "--prompt", "also this"] of+      Options.Success _ -> assertFailure "expected two prompt sources to be refused"+      _ -> pure ()++parsesTheMotivatingInvocationTest :: TestTree+parsesTheMotivatingInvocationTest =+  testCase "the motivating invocation parses to a job, a prompt source, and one override" $+    case parse ["agent", "run", "sync-keiro-dsl", "--prompt-stdin", "--set", "extra-dirs=/keiro"] of+      Options.Success parsed -> do+        parsed ^. #command @?= AgentRun "sync-keiro-dsl" PromptStdin+        length (parsed ^. #overrides) @?= 1+      _ -> assertFailure "expected the motivating invocation to parse"
+ test/ConfigTests.hs view
@@ -0,0 +1,546 @@+-- | Tests for layered KDL job resolution and the operator policy+-- ceiling.+--+-- Every test constructs an 'AgentConfigPaths' explicitly and points it+-- at a temporary directory. None of them reads the real @HOME@ or+-- @XDG_CONFIG_HOME@: a developer with a real+-- @~\/.config\/baikai\/agents.kdl@ would otherwise get different results+-- from a clean machine, and the failure would be baffling.+module ConfigTests (configTests) where++import Baikai.Agent+  ( AgentOutputMode (..),+    AgentProvider (..),+    renderAgentRenderError,+  )+import Baikai.Agent.Config+  ( AgentConfigPaths (..),+    AgentConfigScope (..),+    AgentJob,+    agentEnvBindings,+    agentJobRequest,+    applyCeilingToJob,+    defaultOutputLimit,+    listAgentJobs,+    loadAgentCeiling,+    parseDuration,+    renderAgentConfigError,+    resolveAgentJob,+  )+import Control.Lens ((^.))+import Data.Generics.Labels ()+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.IO qualified as TextIO+import Settei.Env (EnvSnapshot, envSnapshot)+import Settei.Key (parseKey)+import Settei.Optparse (CliOverride, cliOverride)+import Settei.Render (renderErrorsText, renderResolutionJson, renderResolutionText)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++configTests :: TestTree+configTests =+  testGroup+    "Baikai.Agent.Config"+    [ testGroup+        "layering"+        [ repositoryBeatsUserTest,+          commandLineBeatsBothTest,+          environmentLayerTest,+          defaultsTest,+          singleArgumentListTest,+          missingFileTest+        ],+      testGroup+        "provenance and secrecy"+        [ provenanceTest,+          redactionTest+        ],+      testGroup+        "malformed input"+        [ noSilentFallbackTest,+          kdlSyntaxErrorTest,+          durationTests,+          invalidJobNameTest+        ],+      testGroup+        "the operator policy ceiling"+        [ defaultCeilingRefusesFullAccessTest,+          defaultCeilingPermitsEditWorkspaceTest,+          userFileRaisesCeilingTest,+          repositoryFileCannotRaiseTheCeilingTest,+          commandLineCannotRaiseTheCeilingTest+        ],+      testGroup+        "enumeration"+        [ listJobsTest+        ],+      environmentBindingsValidateTest+    ]++-- | Write the supplied documents into a temporary directory and hand+-- back paths pointing at them. Either scope may be absent, which is the+-- normal state for an operator who has written no policy file.+withConfigs :: Maybe Text -> Maybe Text -> (AgentConfigPaths -> IO a) -> IO a+withConfigs userDoc repoDoc action =+  withSystemTempDirectory "baikai-agent-config" $ \dir -> do+    userConfig <- traverse (writeDoc dir "user.kdl") userDoc+    repoConfig <- traverse (writeDoc dir "repo.kdl") repoDoc+    action AgentConfigPaths {userConfig, repoConfig}+  where+    writeDoc dir fileName body = do+      let path = dir </> fileName+      TextIO.writeFile path body+      pure path++noEnvironment :: EnvSnapshot+noEnvironment = envSnapshot []++-- | An override as the command line would supply it.+override :: Text -> Text -> CliOverride+override key value =+  cliOverride (either (error . show) id (parseKey key)) value++-- | Resolve a job, failing the test with the real diagnosis when either+-- loading or resolution fails.+resolveJob :: AgentConfigPaths -> EnvSnapshot -> [CliOverride] -> Text -> IO AgentJob+resolveJob paths snapshot overrides jobName = do+  loaded <- resolveAgentJob paths snapshot overrides jobName+  case loaded of+    Left problem ->+      assertFailure ("loading failed: " <> Text.unpack (renderAgentConfigError problem))+    Right resolved -> case resolved ^. #answer of+      Left problems ->+        assertFailure ("resolution failed: " <> Text.unpack (renderErrorsText problems))+      Right job -> pure job++-- | The rendered resolution failure, for tests that expect one.+resolutionFailure :: AgentConfigPaths -> Text -> IO Text+resolutionFailure paths jobName = do+  loaded <- resolveAgentJob paths noEnvironment [] jobName+  case loaded of+    Left problem -> pure (renderAgentConfigError problem)+    Right resolved -> case resolved ^. #answer of+      Left problems -> pure (renderErrorsText problems)+      Right job -> assertFailure ("expected a failure, got: " <> show job)++-- | A complete job that asks for the given capability.+jobDoc :: Text -> Text+jobDoc capability =+  Text.unlines+    [ "jobs {",+      "  demo {",+      "    provider \"claude\"",+      "    working-dir \"/tmp\"",+      "    safety {",+      "      capability \"" <> capability <> "\"",+      "    }",+      "  }",+      "}"+    ]++repositoryBeatsUserTest :: TestTree+repositoryBeatsUserTest =+  testCase "a repository value beats a user value"+    $ withConfigs+      (Just (Text.unlines ["jobs {", "  demo {", "    provider \"codex\"", "  }", "}"]))+      (Just (jobDoc "edit-workspace"))+    $ \paths -> do+      job <- resolveJob paths noEnvironment [] "demo"+      job ^. #provider @?= AgentClaude++commandLineBeatsBothTest :: TestTree+commandLineBeatsBothTest =+  testCase "a command-line override beats both files"+    $ withConfigs+      (Just (Text.unlines ["jobs {", "  demo {", "    provider \"codex\"", "  }", "}"]))+      (Just (jobDoc "edit-workspace"))+    $ \paths -> do+      job <-+        resolveJob paths noEnvironment [override "jobs.demo.provider" "codex"] "demo"+      job ^. #provider @?= AgentCodex++environmentLayerTest :: TestTree+environmentLayerTest =+  testCase "the environment beats a file but loses to the command line" $+    withConfigs Nothing (Just (jobDoc "read-only")) $ \paths -> do+      fromEnvironment <-+        resolveJob paths (envSnapshot [("BAIKAI_AGENT_PROVIDER", "codex")]) [] "demo"+      fromEnvironment ^. #provider @?= AgentCodex+      fromCommandLine <-+        resolveJob+          paths+          (envSnapshot [("BAIKAI_AGENT_PROVIDER", "codex")])+          [override "jobs.demo.provider" "claude"]+          "demo"+      fromCommandLine ^. #provider @?= AgentClaude++defaultsTest :: TestTree+defaultsTest =+  testCase "a minimal job resolves with the built-in defaults" $+    -- The counterpart to the runner's own defaults test: this is what+    -- makes a terse configuration file usable.+    withConfigs Nothing (Just (jobDoc "read-only")) $ \paths -> do+      job <- resolveJob paths noEnvironment [] "demo"+      job ^. #output @?= InheritOutput+      job ^. #outputLimit @?= Just defaultOutputLimit+      job ^. #extraDirs @?= []+      job ^. #allowedTools @?= []+      job ^. #providerArgs @?= []+      job ^. #envRequires @?= []+      job ^. #timeout @?= Nothing+      job ^. #executable @?= Nothing++singleArgumentListTest :: TestTree+singleArgumentListTest =+  testCase "a list setting accepts none, one, or many arguments"+    $+    -- A KDL node's raw shape depends on its argument count: none is a+    -- null, one is a scalar, and only two or more is an array. settei's+    -- own listDecoder accepts an array alone, so without the+    -- scalar-tolerant decoder the one-directory spelling below — the+    -- form the user guide documents — would fail to decode.+    withConfigs+      Nothing+      ( Just+          ( Text.unlines+              [ "jobs {",+                "  one { provider \"claude\"; working-dir \"/tmp\"",+                "    extra-dirs \"/only\"",+                "    safety { capability \"read-only\" }",+                "  }",+                "  many { provider \"claude\"; working-dir \"/tmp\"",+                "    extra-dirs \"/first\" \"/second\"",+                "    safety { capability \"read-only\" }",+                "  }",+                "  none { provider \"claude\"; working-dir \"/tmp\"",+                "    extra-dirs",+                "    safety { capability \"read-only\" }",+                "  }",+                "}"+              ]+          )+      )+    $ \paths -> do+      one <- resolveJob paths noEnvironment [] "one"+      one ^. #extraDirs @?= ["/only"]+      many <- resolveJob paths noEnvironment [] "many"+      many ^. #extraDirs @?= ["/first", "/second"]+      none <- resolveJob paths noEnvironment [] "none"+      none ^. #extraDirs @?= []+      -- A command-line override is always a scalar too.+      overridden <-+        resolveJob paths noEnvironment [override "jobs.none.extra-dirs" "/from-flag"] "none"+      overridden ^. #extraDirs @?= ["/from-flag"]++missingFileTest :: TestTree+missingFileTest =+  testCase "with no configuration at all the required settings are named" $+    withConfigs Nothing Nothing $ \paths -> do+      message <- resolutionFailure paths "demo"+      assertBool+        ("the provider key is named: " <> Text.unpack message)+        (Text.isInfixOf "jobs.demo.provider" message)+      assertBool+        ("the working directory key is named: " <> Text.unpack message)+        (Text.isInfixOf "jobs.demo.working-dir" message)+      assertBool+        ("the capability key is named: " <> Text.unpack message)+        (Text.isInfixOf "jobs.demo.safety.capability" message)++provenanceTest :: TestTree+provenanceTest =+  testCase "the report attributes each value to its own file, with a line number"+    $+    -- The headline capability of this plan, and improvement-request+    -- acceptance criterion 5.+    withConfigs+      (Just (Text.unlines ["jobs {", "  demo {", "    timeout \"45m\"", "  }", "}"]))+      (Just (jobDoc "edit-workspace"))+    $ \paths -> do+      loaded <- resolveAgentJob paths noEnvironment [] "demo"+      resolved <- case loaded of+        Left problem ->+          assertFailure ("loading failed: " <> Text.unpack (renderAgentConfigError problem))+        Right value -> pure value+      let asText = renderResolutionText (resolved ^. #report)+          asJson = renderResolutionJson (resolved ^. #report)+      assertBool+        ("the text report names the repository scope: " <> Text.unpack asText)+        (Text.isInfixOf "repository configuration" asText)+      assertBool+        ("the text report names the user scope: " <> Text.unpack asText)+        (Text.isInfixOf "user configuration" asText)+      -- renderResolutionText names the source but drops the location,+      -- so the line number is asserted against the JSON rendering,+      -- which carries path, line, and column. Without this the test+      -- would pass even if settei-kdl's span preservation were+      -- silently dropped on the way into the report.+      userPath <- maybe (assertFailure "expected a user file") pure (paths ^. #userConfig)+      repoPath <- maybe (assertFailure "expected a repository file") pure (paths ^. #repoConfig)+      assertBool+        ("the JSON report cites the repository file: " <> Text.unpack asJson)+        (Text.isInfixOf (Text.pack repoPath) asJson)+      assertBool+        ("the JSON report cites the user file: " <> Text.unpack asJson)+        (Text.isInfixOf (Text.pack userPath) asJson)+      assertBool+        ("the JSON report carries a line number: " <> Text.unpack asJson)+        (Text.isInfixOf "\"line\":" asJson)++redactionTest :: TestTree+redactionTest =+  testCase "raw provider arguments never reach a report"+    $+    -- This is what makes the secret classification real rather than+    -- decorative: provider-args is the one field an operator could write+    -- a credential into.+    withConfigs+      Nothing+      ( Just+          ( Text.unlines+              [ "jobs {",+                "  demo {",+                "    provider \"claude\"",+                "    working-dir \"/tmp\"",+                "    safety {",+                "      capability \"read-only\"",+                "      provider-args \"--api-key\" \"sk-not-a-real-key\"",+                "    }",+                "  }",+                "}"+              ]+          )+      )+    $ \paths -> do+      loaded <- resolveAgentJob paths noEnvironment [] "demo"+      resolved <- case loaded of+        Left problem ->+          assertFailure ("loading failed: " <> Text.unpack (renderAgentConfigError problem))+        Right value -> pure value+      let asText = renderResolutionText (resolved ^. #report)+          asJson = renderResolutionJson (resolved ^. #report)+      assertBool+        "the text report does not contain the credential"+        (not (Text.isInfixOf "sk-not-a-real-key" asText))+      assertBool+        "the JSON report does not contain the credential"+        (not (Text.isInfixOf "sk-not-a-real-key" asJson))+      -- Redacting the value must not hide that the setting was set.+      assertBool+        ("the key name still appears: " <> Text.unpack asText)+        (Text.isInfixOf "jobs.demo.safety.provider-args" asText)+      -- The resolved job still carries the real value; only reports redact.+      job <- resolveJob paths noEnvironment [] "demo"+      job ^. #providerArgs @?= ["--api-key", "sk-not-a-real-key"]++noSilentFallbackTest :: TestTree+noSilentFallbackTest =+  testCase "a misspelled value fails rather than falling back to a valid one"+    $+    -- Pins settei's no-silent-fallback behavior, which this module+    -- depends on and which a dependency upgrade could regress: a typo in+    -- an untrusted repository file must not quietly activate an+    -- operator's default.+    withConfigs+      (Just (jobDoc "read-only"))+      ( Just+          ( Text.unlines+              [ "jobs {",+                "  demo {",+                "    safety { capability \"edit-worksapce\" }",+                "  }",+                "}"+              ]+          )+      )+    $ \paths -> do+      message <- resolutionFailure paths "demo"+      assertBool+        ("the offending key is named: " <> Text.unpack message)+        (Text.isInfixOf "jobs.demo.safety.capability" message)++kdlSyntaxErrorTest :: TestTree+kdlSyntaxErrorTest =+  testCase "a syntax error is reported without echoing the document" $+    withConfigs Nothing (Just "jobs {\n  demo {\n    provider \"secret-looking-value\"\n") $ \paths -> do+      loaded <- resolveAgentJob paths noEnvironment [] "demo"+      case loaded of+        Right _ -> assertFailure "expected the malformed document to be refused"+        Left problem -> do+          let message = renderAgentConfigError problem+          -- settei-kdl errors carry a category, a name, a path, and a+          -- span, never an excerpt. Appending the document "for context"+          -- would defeat that redaction, so assert it was not.+          assertBool+            ("the message does not echo the document: " <> Text.unpack message)+            (not (Text.isInfixOf "secret-looking-value" message))++durationTests :: TestTree+durationTests =+  testGroup+    "durations"+    [ testCase "seconds" $ parseDuration "90s" @?= Just 90,+      testCase "minutes" $ parseDuration "45m" @?= Just 2700,+      testCase "hours" $ parseDuration "2h" @?= Just 7200,+      testCase "a bare number means seconds" $ parseDuration "45" @?= Just 45,+      -- Zero is refused rather than treated as "no timeout": it would+      -- mean "kill every run immediately", which no operator intends.+      testCase "zero is refused" $ parseDuration "0" @?= Nothing,+      testCase "a negative duration is refused" $ parseDuration "-5m" @?= Nothing,+      testCase "unparseable text is refused" $ parseDuration "soon" @?= Nothing,+      testCase "an unknown unit is refused" $ parseDuration "5d" @?= Nothing+    ]++invalidJobNameTest :: TestTree+invalidJobNameTest =+  testCase "a job name that cannot address a key is refused" $+    withConfigs Nothing (Just (jobDoc "read-only")) $ \paths -> do+      loaded <- resolveAgentJob paths noEnvironment [] "has.a.dot"+      case loaded of+        Right _ -> assertFailure "expected a dotted job name to be refused"+        Left problem ->+          assertBool+            "the message explains the dot"+            (Text.isInfixOf "dot" (renderAgentConfigError problem))++-- | Load the ceiling, failing the test with the real diagnosis.+ceilingFor :: AgentConfigPaths -> IO (Either Text Text)+ceilingFor paths = do+  loaded <- loadAgentCeiling paths+  case loaded of+    Left problem ->+      assertFailure ("loading the ceiling failed: " <> Text.unpack (renderAgentConfigError problem))+    Right ceiling' -> pure (Right (Text.pack (show ceiling')))++-- | Resolve a job, apply the ceiling, and report the refusal message if+-- there was one.+runAgainstCeiling :: AgentConfigPaths -> [CliOverride] -> Text -> IO (Either Text ())+runAgainstCeiling paths overrides jobName = do+  job <- resolveJob paths noEnvironment overrides jobName+  loaded <- loadAgentCeiling paths+  ceiling' <- case loaded of+    Left problem ->+      assertFailure ("loading the ceiling failed: " <> Text.unpack (renderAgentConfigError problem))+    Right value -> pure value+  pure $ case applyCeilingToJob ceiling' (agentJobRequest job "a prompt") of+    Left refusal -> Left (renderAgentRenderError refusal)+    Right _ -> Right ()++-- | A user document that raises the ceiling, and a repository document+-- that tries to.+raisingPolicyDoc :: Text+raisingPolicyDoc = Text.unlines ["policy {", "  max-capability \"full-access\"", "}"]++defaultCeilingRefusesFullAccessTest :: TestTree+defaultCeilingRefusesFullAccessTest =+  testCase "with no user file, full access is refused naming both values" $+    withConfigs Nothing (Just (jobDoc "full-access")) $ \paths -> do+      outcome <- runAgainstCeiling paths [] "demo"+      case outcome of+        Right () -> assertFailure "expected full access to be refused"+        Left message -> do+          assertBool+            ("the requested value is named: " <> Text.unpack message)+            (Text.isInfixOf "full-access" message)+          assertBool+            ("the permitted maximum is named: " <> Text.unpack message)+            (Text.isInfixOf "edit-workspace" message)++defaultCeilingPermitsEditWorkspaceTest :: TestTree+defaultCeilingPermitsEditWorkspaceTest =+  testCase "with no user file, editing the workspace is permitted" $+    -- The zero-configuration path the first consumer depends on: a job+    -- that changes files must work on a fresh machine with no+    -- out-of-band setup step.+    withConfigs Nothing (Just (jobDoc "edit-workspace")) $ \paths -> do+      outcome <- runAgainstCeiling paths [] "demo"+      outcome @?= Right ()++userFileRaisesCeilingTest :: TestTree+userFileRaisesCeilingTest =+  testCase "the operator's own file may raise the ceiling" $+    withConfigs (Just raisingPolicyDoc) (Just (jobDoc "full-access")) $ \paths -> do+      outcome <- runAgainstCeiling paths [] "demo"+      outcome @?= Right ()++repositoryFileCannotRaiseTheCeilingTest :: TestTree+repositoryFileCannotRaiseTheCeilingTest =+  testCase "A REPOSITORY FILE CANNOT RAISE THE CEILING" $+    -- The central security property of this module. A repository+    -- configuration file is untrusted input; if it could set+    -- policy.max-capability an untrusted checkout would grant itself+    -- whatever it liked. If this test fails, the repository source has+    -- leaked into loadAgentCeiling's source list.+    withConfigs Nothing (Just (jobDoc "full-access" <> raisingPolicyDoc)) $ \paths -> do+      shown <- ceilingFor paths+      case shown of+        Left problem -> assertFailure (Text.unpack problem)+        Right rendered ->+          assertBool+            ("the ceiling is unchanged: " <> Text.unpack rendered)+            (Text.isInfixOf "AgentEditWorkspace" rendered)+      outcome <- runAgainstCeiling paths [] "demo"+      case outcome of+        Right () -> assertFailure "the repository file raised the ceiling"+        Left message ->+          assertBool+            ("the refusal names the permitted maximum: " <> Text.unpack message)+            (Text.isInfixOf "edit-workspace" message)++commandLineCannotRaiseTheCeilingTest :: TestTree+commandLineCannotRaiseTheCeilingTest =+  testCase "A COMMAND-LINE OVERRIDE CANNOT RAISE THE CEILING" $+    -- The other half of the central security property.+    -- `--set policy.max-capability=full-access` is exactly the flag a+    -- compromised automation script would add, and it must change+    -- nothing. Note that loadAgentCeiling takes no overrides at all,+    -- which is the structural reason this holds; the test pins the+    -- behavior so a later signature change cannot quietly undo it.+    withConfigs Nothing (Just (jobDoc "full-access")) $ \paths -> do+      outcome <-+        runAgainstCeiling paths [override "policy.max-capability" "full-access"] "demo"+      case outcome of+        Right () -> assertFailure "a command-line override raised the ceiling"+        Left message ->+          assertBool+            ("the refusal names the permitted maximum: " <> Text.unpack message)+            (Text.isInfixOf "edit-workspace" message)++listJobsTest :: TestTree+listJobsTest =+  testCase "job names are sorted and attributed to the winning scope"+    $ withConfigs+      ( Just+          ( Text.unlines+              [ "jobs {",+                "  demo { provider \"codex\" }",+                "  user-only { provider \"codex\" }",+                "}"+              ]+          )+      )+      (Just (jobDoc "read-only"))+    $ \paths -> do+      listed <- listAgentJobs paths+      case listed of+        Left problem ->+          assertFailure ("listing failed: " <> Text.unpack (renderAgentConfigError problem))+        Right entries -> do+          map (^. #name) entries @?= ["demo", "user-only"]+          map (^. #scope) entries @?= [RepositoryScope, UserScope]+          -- A name defined in two files is reported once, with the+          -- count, because a bare name hides a real source of+          -- confusion.+          map (^. #definingScopes) entries @?= [2, 1]++environmentBindingsValidateTest :: TestTree+environmentBindingsValidateTest =+  testCase "the environment binding list is valid" $+    -- The binding list calls `error` on an invalid entry, so forcing it+    -- here makes a bad edit fail in tests rather than at start-up.+    agentEnvBindings "probe" `seq`+      pure ()
+ test/EvidenceTests.hs view
@@ -0,0 +1,466 @@+-- | Model-call evidence for an unattended coding-agent run.+--+-- Every case here spawns a real child process — a few lines of @sh@+-- written into a temporary directory — and reads the evidence back off+-- the 'AgentRunOutcome' the real runner returns. Nothing is stubbed: the+-- process is spawned, drained, and timed by production code, and the+-- record is assembled by it too. No credential and no coding-agent+-- binary is required.+--+-- Assertions go through the encoded JSON rather than through Haskell+-- record accessors, because the JSON is the contract other systems pin+-- against, and it spells its fields in snake_case where a Haskell mirror+-- would silently paper over a rename.+module EvidenceTests (evidenceTests) where++import Baikai.Agent+  ( AgentCommand (..),+    AgentOutputMode (..),+    AgentPromptTransport (..),+    AgentProvider (..),+    AgentRunFailure (..),+    AgentRunOutcome (..),+    AgentRunRequest,+    agentRunRequest,+  )+import Baikai.Agent.Run+  ( agentConfigurationEnvelope,+    agentRequestEnvelope,+    runAgentCommand,+  )+import Baikai.Evidence+  ( EvidenceRequest,+    EvidenceStrength (..),+    EvidenceStrictness (..),+    ModelCallEvidence,+    ThinkingTranslation,+    canonicalEncode,+    evidenceRequest,+    noThinkingRequested,+  )+import Control.Lens ((&), (.~), (^.))+import Data.Aeson (Value (..))+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 BS8+import Data.Generics.Labels ()+import Data.List (isInfixOf)+import Data.Text (Text)+import Data.Text qualified as Text+import System.Directory+  ( doesFileExist,+    getPermissions,+    setOwnerExecutable,+    setPermissions,+  )+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++evidenceTests :: TestTree+evidenceTests =+  testGroup+    "unattended run evidence"+    [ reportedRunTest,+      silentToolTest,+      nonZeroExitTest,+      timedOutRunTest,+      inheritedOutputTest,+      nothingStartedTest,+      optOutTest,+      strictRefusalTests,+      digestTests+    ]++-- ====================================================================+-- The cases+-- ====================================================================++reportedRunTest :: TestTree+reportedRunTest =+  testCase "a tool that reports a session and a model is recorded as saying so" $+    -- Neither vendor renderer asks its tool for structured output, so+    -- this is the shape an operator gets only after configuring+    -- `--output-format json` through the job's extra arguments. That is+    -- a real constraint and the runner's documentation states it.+    withFake "#!/bin/sh\ncat > /dev/null\necho '" claudeResultJson "'\n" $ \dir exe -> do+      ev <- oneEvidence =<< run (wanted "run-56") dir exe []+      field "status" ev @?= Just (String "succeeded")+      field "run_id" ev @?= Just (String "run-56")+      field "response_id" ev @?= Just (observedJson "sess-abc123")+      field "observed_model" ev @?= Just (observedJson "claude-opus-5[1m]")+      field "strength" ev @?= Just (String "model_observed")+      case observedObject "usage" ev of+        Nothing -> assertFailure ("expected an observed usage, got: " <> show (field "usage" ev))+        Just u -> do+          KeyMap.lookup "input_tokens" u @?= Just (Number 11)+          KeyMap.lookup "output_tokens" u @?= Just (Number 5)+      -- A subprocess has no endpoint URL and no wire protocol; the+      -- resolved executable path and this surface's own name stand in.+      case field "endpoint" ev of+        Just (Object o) -> do+          KeyMap.lookup "transport" o @?= Just (String "agent_run")+          KeyMap.lookup "api" o @?= Just (String "agent_run")+          KeyMap.lookup "provider" o @?= Just (String "claude")+          KeyMap.lookup "endpoint" o @?= Just (String (Text.pack exe))+        other -> assertFailure ("expected an endpoint object, got: " <> show other)+      assertDigest "request_commitment" ev+      assertDigest "request_configuration" ev+      assertObservedDigest "response_commitment" ev++silentToolTest :: TestTree+silentToolTest =+  testCase "A ZERO EXIT WITH NO IDENTIFIER AND NO MODEL STAYS AT requested_only" $+    -- IR-3's rule, and the one this surface is most likely to violate by+    -- accident: almost every unattended run exits zero. A coding agent+    -- that exits zero has demonstrated that it ran, not which model+    -- served it.+    withFake "#!/bin/sh\ncat > /dev/null\necho '" "the task is done" "'\n" $ \dir exe -> do+      ev <- oneEvidence =<< run (wanted "run-56") dir exe []+      field "status" ev @?= Just (String "succeeded")+      field "strength" ev @?= Just (String "requested_only")+      field "response_id" ev @?= Just (String "unobserved")+      field "observed_model" ev @?= Just (String "unobserved")+      field "usage" ev @?= Just (String "unobserved")+      -- The run still produced output, so the commitment to it is real.+      assertObservedDigest "response_commitment" ev++nonZeroExitTest :: TestTree+nonZeroExitTest =+  testCase "a non-zero exit is recorded as failed, and the exit code changes no strength" $+    withFake "#!/bin/sh\ncat > /dev/null\necho '" claudeResultJson "'\nexit 3\n" $ \dir exe -> do+      ev <- oneEvidence =<< run (wanted "run-56") dir exe []+      field "status" ev @?= Just (String "failed")+      case field "error_info" ev of+        Just (Object o) ->+          assertBool+            ("expected a populated error_info, got: " <> show o)+            (KeyMap.member "message" o)+        other -> assertFailure ("expected a populated error_info, got: " <> show other)+      -- The tool named itself before it failed, so the strength is what+      -- it reported — not something derived from exiting 3.+      field "response_id" ev @?= Just (observedJson "sess-abc123")+      field "strength" ev @?= Just (String "model_observed")+      -- No successful run means nothing complete to commit to.+      field "response_commitment" ev @?= Just (String "unobserved")++timedOutRunTest :: TestTree+timedOutRunTest =+  testCase "A RUN KILLED BY ITS OWN TIMEOUT STILL PRODUCES A RECORD" $+    -- The reason evidence travels beside the outcome rather than inside+    -- AgentRunResult. A timed-out run started, consumed tokens, and may+    -- have changed the working tree; it reports Left RunTimedOut, so a+    -- record hanging off the Right would be unreachable exactly here.+    withFake "#!/bin/sh\n" "sleep 30" "\n" $ \dir exe -> do+      outcome <- runWith (wanted "run-56") dir exe [] (\req -> req & #timeout .~ Just 1)+      case outcome ^. #outcome of+        Right ran -> assertFailure ("expected a timeout, the run finished: " <> show ran)+        Left _ -> pure ()+      ev <- oneEvidence outcome+      field "status" ev @?= Just (String "aborted")+      field "strength" ev @?= Just (String "requested_only")+      field "response_commitment" ev @?= Just (String "unobserved")+      case field "error_info" ev of+        Just (Object o) -> assertBool ("names the timeout: " <> show o) (KeyMap.member "message" o)+        other -> assertFailure ("expected a populated error_info, got: " <> show other)++inheritedOutputTest :: TestTree+inheritedOutputTest =+  testCase "an inherited run observes nothing, because there are no bytes to read" $+    -- Under `inherit` the agent's output went to this process's own+    -- terminal and baikai never held it. Every tool-reported field is+    -- therefore Unobserved — which is the honest answer, and is why the+    -- runner's documentation tells an operator who needs correlated+    -- evidence to capture output.+    withFake "#!/bin/sh\necho '" claudeResultJson "'\n" $ \dir exe -> do+      outcome <- runWith (wanted "run-56") dir exe [] (\req -> req & #output .~ InheritOutput)+      ev <- oneEvidence outcome+      field "status" ev @?= Just (String "succeeded")+      field "response_id" ev @?= Just (String "unobserved")+      field "observed_model" ev @?= Just (String "unobserved")+      field "usage" ev @?= Just (String "unobserved")+      field "response_commitment" ev @?= Just (String "unobserved")+      field "strength" ev @?= Just (String "requested_only")++nothingStartedTest :: TestTree+nothingStartedTest =+  testCase "a run that never started produces no evidence at all" $+    -- There is nothing to describe. An evidence record for a process+    -- that was never created would assert a run happened.+    withSystemTempDirectory "baikai-agent-evidence" $ \dir -> do+      let missing = dir </> "not-installed"+      outcome <- run (wanted "run-56") dir missing []+      case outcome ^. #outcome of+        Right ran -> assertFailure ("expected a spawn failure, got: " <> show ran)+        Left _ -> pure ()+      outcome ^. #evidence @?= Nothing++optOutTest :: TestTree+optOutTest =+  testCase "A RUN THAT ASKED FOR NO EVIDENCE SPAWNS EXACTLY ONE PROCESS" $+    -- The absent field is the easy half. The process count is the half+    -- that catches a --version probe firing on a path it must never+    -- reach: the probe is a whole extra subprocess, and an unattended+    -- run can be one short invocation.+    withSystemTempDirectory "baikai-agent-evidence" $ \dir -> do+      let ledger = dir </> "invocations"+      exe <-+        writeFakeExecutable+          dir+          "counted"+          ("#!/bin/sh\ncat > /dev/null\necho x >> '" <> ledger <> "'\necho done\n")+      optedOut <- run Nothing dir exe []+      optedOut ^. #evidence @?= Nothing+      afterOptOut <- invocationCount ledger+      afterOptOut @?= 1++      -- And the contrast, so the assertion above cannot pass because+      -- the fake was never run at all: opting in probes the executable+      -- as well as running it.+      optedIn <- run (wanted "run-56") dir exe []+      assertBool "the opted-in run built evidence" (optedIn ^. #evidence /= Nothing)+      afterOptIn <- invocationCount ledger+      assertBool+        ("the opted-in run also probed the executable, saw " <> show afterOptIn)+        (afterOptIn > afterOptOut + 1)++-- ====================================================================+-- Strict evidence on this surface+-- ====================================================================++strictRefusalTests :: TestTree+strictRefusalTests =+  testGroup+    -- The agent surface never touches ApiProvider and has no trace+    -- sink, so neither of the gates the completion path uses reaches+    -- it. These prove its own.+    "a run that cannot produce the required evidence is refused before it starts"+    [ testCase "AN INHERIT JOB DEMANDING A CORRELATED RECORD IS REFUSED" $+        -- The most useful refusal on this surface. Under inherit the+        -- agent's bytes go to the operator's terminal and baikai never+        -- holds them, so nothing the tool says can be observed however+        -- well the run goes. Finding that out before the run rather than+        -- from an empty record is the point.+        withFake "#!/bin/sh\ncat > /dev/null\necho '" "ok" "'\n" $ \dir exe -> do+          let ledger = dir </> "invocations"+          recording <- writeFakeExecutable dir "counted" ("#!/bin/sh\necho x >> '" <> ledger <> "'\n")+          outcome <-+            runWith+              (requiring EvidenceCorrelated)+              dir+              recording+              []+              (\req -> req & #output .~ InheritOutput)+          case outcome ^. #outcome of+            Right ran -> assertFailure ("expected a refusal, the run started: " <> show ran)+            Left failure -> case failure of+              EvidenceRefused reasons ->+                assertBool+                  ("the refusal explains itself: " <> show reasons)+                  (any ("requested_only" `Text.isInfixOf`) reasons)+              other -> assertFailure ("expected EvidenceRefused, got: " <> show other)+          outcome ^. #evidence @?= Nothing+          started <- invocationCount ledger+          started @?= 0+          -- `exe` is unused on this path; naming it keeps withFake's+          -- shape rather than adding a second helper.+          assertBool "the fixture executable exists" (not (null exe)),+      testCase "a codex job demanding a model is refused, because codex names none" $+        withFake "#!/bin/sh\n" "exit 0" "\n" $ \dir exe -> do+          outcome <-+            runWith+              (requiring EvidenceModelObserved)+              dir+              exe+              []+              (\req -> req & #provider .~ AgentCodex)+          case outcome ^. #outcome of+            Left (EvidenceRefused _) -> pure ()+            other -> assertFailure ("expected EvidenceRefused, got: " <> show other),+      testCase "a capturing claude job demanding a model is allowed to try" $+        -- Structural, not predictive: this run may or may not report a+        -- model, and the gate must not pretend to know. The record's own+        -- strength is where the caller reads what actually happened.+        withFake "#!/bin/sh\ncat > /dev/null\necho '" claudeResultJson "'\n" $ \dir exe -> do+          outcome <- run (requiring EvidenceModelObserved) dir exe []+          case outcome ^. #outcome of+            Left failure -> assertFailure ("expected the run to start: " <> show failure)+            Right _ -> pure ()+          ev <- oneEvidence outcome+          field "strength" ev @?= Just (String "model_observed"),+      testCase "a best-effort caller is never refused, whatever the configuration" $+        withFake "#!/bin/sh\n" "exit 0" "\n" $ \dir exe -> do+          outcome <-+            runWith (wanted "run-56") dir exe [] (\req -> req & #output .~ InheritOutput)+          case outcome ^. #outcome of+            Left failure -> assertFailure ("a best-effort run must not be refused: " <> show failure)+            Right _ -> pure ()+    ]++requiring :: EvidenceStrength -> Maybe EvidenceRequest+requiring needed =+  Just (evidenceRequest "run-57" & #strictness .~ EvidenceRequired needed)++-- ====================================================================+-- The digests+-- ====================================================================++digestTests :: TestTree+digestTests =+  testGroup+    -- The subtlest part of this surface. Both vendor renderers put the+    -- prompt on standard input, so a commitment computed over the+    -- argument vector alone would give two runs with identical flags and+    -- completely different instructions the same digest.+    "the prompt is committed to under both transports and excluded from the configuration"+    [ testCase (label transport) $ do+        let one = command transport "first instruction"+            two = command transport "second instruction"+        assertBool+          "two prompts must not share a request commitment"+          (encoded (agentRequestEnvelope one) /= encoded (agentRequestEnvelope two))+        encoded (agentConfigurationEnvelope one) @?= encoded (agentConfigurationEnvelope two)+        assertBool+          "the commitment input must contain the prompt"+          ("PROMPT-BODY-MARKER" `isInfixOf` encoded (agentRequestEnvelope (command transport marker)))+        assertBool+          "the configuration input must not contain the prompt"+          ( not+              ( "PROMPT-BODY-MARKER"+                  `isInfixOf` encoded (agentConfigurationEnvelope (command transport marker))+              )+          )+    | transport <- [PromptOnStdin, PromptAsArgument]+    ]+  where+    marker = "PROMPT-BODY-MARKER"+    label PromptOnStdin = "prompt on standard input"+    label PromptAsArgument = "prompt as an argument"+    encoded = BS8.unpack . canonicalEncode+    -- Under PromptAsArgument the prompt is in the vector too, which is+    -- what makes excluding it from the configuration a real operation+    -- rather than a no-op.+    command transport promptBody =+      AgentCommand+        { executable = "/bin/agent",+          arguments =+            ["-p", "--effort", "high"]+              <> case transport of+                PromptAsArgument -> ["--", Text.unpack promptBody]+                PromptOnStdin -> [],+          promptTransport = transport,+          promptText = promptBody+        }++-- ====================================================================+-- Harness+-- ====================================================================++-- | Run one command against a fake executable rooted in a directory.+run :: Maybe EvidenceRequest -> FilePath -> FilePath -> [String] -> IO AgentRunOutcome+run evidenceReq dir exe args = runWith evidenceReq dir exe args id++runWith ::+  Maybe EvidenceRequest ->+  FilePath ->+  FilePath ->+  [String] ->+  (AgentRunRequest -> AgentRunRequest) ->+  IO AgentRunOutcome+runWith evidenceReq dir exe args adjust =+  runAgentCommand evidenceReq translation (adjust request) command+  where+    request =+      agentRunRequest AgentClaude dir "PROMPT-BODY-MARKER" & #output .~ CaptureOutput+    command =+      AgentCommand+        { executable = exe,+          arguments = args,+          promptTransport = PromptOnStdin,+          promptText = "PROMPT-BODY-MARKER"+        }++-- | Every case here drives the runner directly rather than through a+-- vendor renderer, so there is no translation to carry. The renderers'+-- own translations are asserted in each vendor package's test suite.+translation :: ThinkingTranslation+translation = noThinkingRequested++wanted :: Text -> Maybe EvidenceRequest+wanted = Just . evidenceRequest++-- | Write a fake tool from three pieces, so a case can wrap recorded+-- JSON in shell quoting without escaping it twice.+withFake :: String -> String -> String -> (FilePath -> FilePath -> IO a) -> IO a+withFake before body after action =+  withSystemTempDirectory "baikai-agent-evidence" $ \dir -> do+    exe <- writeFakeExecutable dir "fake-agent" (before <> body <> after)+    action dir exe++writeFakeExecutable :: FilePath -> String -> String -> IO FilePath+writeFakeExecutable dir name body = do+  let path = dir </> name+  writeFile path body+  perms <- getPermissions path+  setPermissions path (setOwnerExecutable True perms)+  pure path++invocationCount :: FilePath -> IO Int+invocationCount path = do+  here <- doesFileExist path+  if here then length . lines <$> readFile path else pure 0++-- | A @claude -p --output-format json@ result, as the tool emits one+-- when an operator has configured that format through the job's extra+-- arguments. Single-quote-free so it survives the shell wrapping above.+claudeResultJson :: String+claudeResultJson =+  "{\"type\":\"result\",\"is_error\":false,\"result\":\"done\",\+  \\"session_id\":\"sess-abc123\",\+  \\"usage\":{\"input_tokens\":11,\"output_tokens\":5},\+  \\"modelUsage\":{\"claude-opus-5[1m]\":{\"inputTokens\":11}}}"++-- ====================================================================+-- Assertions on the encoded record+-- ====================================================================++oneEvidence :: AgentRunOutcome -> IO ModelCallEvidence+oneEvidence outcome = case outcome ^. #evidence of+  Just ev -> pure ev+  Nothing -> assertFailure "expected the run to produce evidence"++field :: Text -> ModelCallEvidence -> Maybe Value+field k ev = case Aeson.toJSON ev of+  Object o -> KeyMap.lookup (Key.fromText k) o+  _ -> Nothing++-- | How 'Baikai.Evidence.Observed' encodes a present value.+observedJson :: Text -> Value+observedJson v = Object (KeyMap.singleton "observed" (String v))++observedObject :: Text -> ModelCallEvidence -> Maybe (KeyMap.KeyMap Value)+observedObject k ev = case field k ev of+  Just (Object o) -> case KeyMap.lookup "observed" o of+    Just (Object inner) -> Just inner+    _ -> Nothing+  _ -> Nothing++assertDigest :: Text -> ModelCallEvidence -> IO ()+assertDigest k ev = case field k ev of+  Just (String d) -> assertSha256 k d+  other -> assertFailure (Text.unpack k <> " missing or not a string: " <> show other)++assertObservedDigest :: Text -> ModelCallEvidence -> IO ()+assertObservedDigest k ev = case field k ev of+  Just (Object o) -> case KeyMap.lookup "observed" o of+    Just (String d) -> assertSha256 k d+    other -> assertFailure (Text.unpack k <> " not a digest: " <> show other)+  other -> assertFailure ("expected an observed " <> Text.unpack k <> ", got: " <> show other)++assertSha256 :: Text -> Text -> IO ()+assertSha256 k d =+  assertBool+    (Text.unpack k <> " must be a sha256 digest, got: " <> show d)+    ("sha256:" `Text.isPrefixOf` d && Text.length d == 71)
+ test/Main.hs view
@@ -0,0 +1,337 @@+module Main (main) where++import Baikai.Agent+  ( AgentCapturedOutput (..),+    AgentCommand (..),+    AgentOutputMode (..),+    AgentPromptTransport (..),+    AgentProvider (..),+    AgentRunFailure (..),+    AgentRunRequest,+    AgentRunResult,+    agentRunRequest,+    capturedBytes,+  )+import Baikai.Agent.Run (runAgentCommand, timeoutMicros)+import Baikai.Evidence (noThinkingRequested)+import CliTests (cliTests)+import ConfigTests (configTests)+import Control.Concurrent (threadDelay)+import Control.Lens ((&), (.~), (^.))+import Data.ByteString qualified as BS+import Data.ByteString.Char8 qualified as BS8+import Data.Generics.Labels ()+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.Time.Clock (diffUTCTime, getCurrentTime)+import EvidenceTests (evidenceTests)+import System.Directory+  ( doesFileExist,+    getPermissions,+    setOwnerExecutable,+    setPermissions,+  )+import System.Exit (ExitCode (..))+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++main :: IO ()+main =+  defaultMain $+    testGroup+      "baikai-agent"+      [ runTests,+        configTests,+        cliTests+      ]++runTests :: TestTree+runTests =+  testGroup+    "Baikai.Agent.Run"+    [ promptRoundTripTest,+      streamSeparationTest,+      workingDirectoryTest,+      nonZeroExitTest,+      spawnFailureTest,+      missingWorkingDirectoryTest,+      missingEnvironmentTest,+      timeoutTest,+      processGroupTest,+      outputLimitTest,+      inheritOutputTest,+      promptAsArgumentTest,+      timeoutMicrosTests,+      evidenceTests+    ]++-- | Write a tiny shell script into a temporary directory, make it+-- executable, and hand its path to the action. Every process-level+-- behavior this package implements can be reproduced by a few lines of+-- @sh@, which is what keeps the suite free of any coding-agent binary,+-- any authentication, and any model.+withFakeExecutable :: String -> String -> (FilePath -> FilePath -> IO a) -> IO a+withFakeExecutable name body action =+  withSystemTempDirectory "baikai-agent-test" $ \dir -> do+    let path = dir </> name+    writeFile path body+    perms <- getPermissions path+    setPermissions path (setOwnerExecutable True perms)+    action dir path++-- | A request rooted in the given directory, capturing output.+capturingRequest :: FilePath -> Text.Text -> AgentRunRequest+capturingRequest dir promptBody =+  agentRunRequest AgentClaude dir promptBody & #output .~ CaptureOutput++-- | A command that delivers the prompt on standard input, the transport+-- both shipped vendor renderers select.+stdinCommand :: FilePath -> [String] -> Text.Text -> AgentCommand+stdinCommand exe args promptBody =+  AgentCommand+    { executable = exe,+      arguments = args,+      promptTransport = PromptOnStdin,+      promptText = promptBody+    }++-- | Unwrap a run that was expected to start, reporting the failure's own+-- message when it did not.+expectRan ::+  Either AgentRunFailure AgentRunResult -> IO AgentRunResult+expectRan (Left failure) =+  assertFailure ("expected the run to start: " <> show failure)+expectRan (Right result) = pure result++-- | The runner as every case in this module uses it: no evidence+-- requested, and therefore no reasoning-effort translation to describe.+--+-- The evidence path has its own module. Keeping it out of here means+-- these cases still assert exactly what they asserted before evidence+-- existed, which is what makes them a regression guard for it.+runPlain ::+  AgentRunRequest -> AgentCommand -> IO (Either AgentRunFailure AgentRunResult)+runPlain req cmd =+  (^. #outcome) <$> runAgentCommand Nothing noThinkingRequested req cmd++promptRoundTripTest :: TestTree+promptRoundTripTest =+  testCase "delivers the prompt on stdin and captures stdout" $+    -- A non-ASCII prompt on purpose: a locale-dependent write would+    -- corrupt it, so this also pins the explicit UTF-8 encoding.+    withFakeExecutable "echo-stdin" "#!/bin/sh\nexec cat\n" $ \dir exe -> do+      let promptBody = "réconcilier la grammaire — 文法" :: Text.Text+      result <-+        runPlain+          (capturingRequest dir promptBody)+          (stdinCommand exe [] promptBody)+          >>= expectRan+      result ^. #exitCode @?= ExitSuccess+      capturedBytes (result ^. #stdout) @?= Just (Text.encodeUtf8 promptBody)++streamSeparationTest :: TestTree+streamSeparationTest =+  testCase "separates stdout from stderr"+    $ withFakeExecutable+      "two-streams"+      "#!/bin/sh\nprintf 'to-stdout' \nprintf 'to-stderr' >&2\n"+    $ \dir exe -> do+      result <-+        runPlain (capturingRequest dir "ignored") (stdinCommand exe [] "ignored")+          >>= expectRan+      capturedBytes (result ^. #stdout) @?= Just "to-stdout"+      capturedBytes (result ^. #stderr) @?= Just "to-stderr"++workingDirectoryTest :: TestTree+workingDirectoryTest =+  testCase "honors the request working directory" $+    -- AgentCommand carries no working directory, so this is the only+    -- evidence that the request's one reaches the child.+    withFakeExecutable "print-cwd" "#!/bin/sh\nexec pwd\n" $ \dir exe -> do+      result <-+        runPlain (capturingRequest dir "ignored") (stdinCommand exe [] "ignored")+          >>= expectRan+      let reported = maybe "" (BS8.unpack . stripTrailingNewline) (capturedBytes (result ^. #stdout))+      -- Compare on the basename: macOS resolves /var to /private/var, so+      -- the child's pwd is the same directory by a different path.+      basename reported @?= basename dir++nonZeroExitTest :: TestTree+nonZeroExitTest =+  testCase "reports a non-zero exit as a successful run, intentionally" $+    -- Intentional, and the behavior most likely to be "fixed" into a+    -- Left by someone who has not read the plan: a coding agent that+    -- attempts its task and fails has still run.+    withFakeExecutable "exit-three" "#!/bin/sh\nexit 3\n" $ \dir exe -> do+      result <-+        runPlain (capturingRequest dir "ignored") (stdinCommand exe [] "ignored")+          >>= expectRan+      result ^. #exitCode @?= ExitFailure 3++spawnFailureTest :: TestTree+spawnFailureTest =+  testCase "reports a missing executable as SpawnFailed" $+    withSystemTempDirectory "baikai-agent-test" $ \dir -> do+      let missing = dir </> "not-installed"+      outcome <-+        runPlain (capturingRequest dir "ignored") (stdinCommand missing [] "ignored")+      case outcome of+        Left (SpawnFailed path _) -> path @?= missing+        other -> assertFailure ("expected SpawnFailed, got: " <> show other)++missingWorkingDirectoryTest :: TestTree+missingWorkingDirectoryTest =+  testCase "checks the working directory before spawning" $+    withSystemTempDirectory "baikai-agent-test" $ \dir -> do+      -- The executable is missing too, so a spawn attempt would have+      -- produced SpawnFailed. Getting WorkingDirMissing proves the+      -- precondition ran first.+      let absentDir = dir </> "no-such-directory"+          absentExe = dir </> "no-such-executable"+      outcome <-+        runPlain+          (capturingRequest absentDir "ignored")+          (stdinCommand absentExe [] "ignored")+      case outcome of+        Left (WorkingDirMissing path) -> path @?= absentDir+        other -> assertFailure ("expected WorkingDirMissing, got: " <> show other)++missingEnvironmentTest :: TestTree+missingEnvironmentTest =+  testCase "reports every missing declared variable at once" $+    withSystemTempDirectory "baikai-agent-test" $ \dir -> do+      -- Names chosen to be absent rather than unset here, so the test+      -- never mutates the suite's own environment.+      let names = ["BAIKAI_AGENT_TEST_ABSENT_ONE", "BAIKAI_AGENT_TEST_ABSENT_TWO"]+          req = capturingRequest dir "ignored" & #envPassthrough .~ names+      outcome <- runPlain req (stdinCommand (dir </> "unused") [] "ignored")+      case outcome of+        Left (MissingEnvironment missing) -> missing @?= names+        other -> assertFailure ("expected MissingEnvironment, got: " <> show other)++timeoutTest :: TestTree+timeoutTest =+  testCase "times out and terminates rather than waiting the script out" $+    withFakeExecutable "sleeper" "#!/bin/sh\nsleep 5\n" $ \dir exe -> do+      let req = capturingRequest dir "ignored" & #timeout .~ Just 1+      start <- getCurrentTime+      outcome <- runPlain req (stdinCommand exe [] "ignored")+      end <- getCurrentTime+      case outcome of+        Left (RunTimedOut limit) -> limit @?= 1+        other -> assertFailure ("expected RunTimedOut, got: " <> show other)+      -- Without this assertion the test would pass just as well by+      -- waiting for the script to finish, which proves nothing about+      -- termination.+      assertBool+        "returned well before the script would have finished"+        (diffUTCTime end start < 4)++processGroupTest :: TestTree+processGroupTest =+  testCase "kills grandchildren when the group is terminated"+    $+    -- The most valuable test here and the easiest to omit: it is what+    -- proves a coding agent's own child processes die with it.+    withFakeExecutable+      "spawns-a-child"+      "#!/bin/sh\n(sleep 3; touch \"$1\") &\nsleep 5\n"+    $ \dir exe -> do+      let marker = dir </> "grandchild-survived"+          req = capturingRequest dir "ignored" & #timeout .~ Just 1+      outcome <- runPlain req (stdinCommand exe [marker] "ignored")+      case outcome of+        Left (RunTimedOut _) -> pure ()+        other -> assertFailure ("expected RunTimedOut, got: " <> show other)+      -- Wait past the grandchild's delay before checking, or the file+      -- would be absent merely because it is early.+      waitSeconds 4+      survived <- doesFileExist marker+      assertBool "the grandchild was terminated with its group" (not survived)++outputLimitTest :: TestTree+outputLimitTest =+  testCase "truncates captured output at the byte limit"+    $ withFakeExecutable+      "flood"+      "#!/bin/sh\ni=0\nwhile [ $i -lt 2000 ]; do printf '0123456789'; i=$((i+1)); done\n"+    $ \dir exe -> do+      let req = capturingRequest dir "ignored" & #outputLimit .~ Just 1024+      result <-+        runPlain req (stdinCommand exe [] "ignored") >>= expectRan+      case result ^. #stdout of+        OutputTruncated bytes -> BS.length bytes @?= 1024+        other -> assertFailure ("expected OutputTruncated, got: " <> show other)+      -- Proves the excess was discarded rather than the pipe closed:+      -- closing it would have made the child's next write fail.+      result ^. #exitCode @?= ExitSuccess++inheritOutputTest :: TestTree+inheritOutputTest =+  testCase "captures nothing in inherit mode" $+    withFakeExecutable "chatty" "#!/bin/sh\nprintf 'inherited line\\n'\n" $ \dir exe -> do+      -- The line goes to the test runner's own output, which is expected.+      let req = agentRunRequest AgentClaude dir "ignored"+      result <- runPlain req (stdinCommand exe [] "ignored") >>= expectRan+      result ^. #stdout @?= OutputNotCaptured+      result ^. #stderr @?= OutputNotCaptured+      result ^. #exitCode @?= ExitSuccess++promptAsArgumentTest :: TestTree+promptAsArgumentTest =+  testCase "supports the prompt-as-argument transport"+    $+    -- No shipped renderer selects this transport, so a fixture is the+    -- only place the two-sided contract can be observed. The script+    -- echoes its argument and appends whatever standard input it can+    -- read, which must be nothing.+    withFakeExecutable+      "echo-arg"+      -- Shift past the -- separator the way a real tool's own argument+      -- parser would, then echo the prompt and append whatever standard+      -- input can be read, which must be nothing. Reading fails outright+      -- because this transport gives the child no standard input at all,+      -- and that failure is tolerated so the script's own exit code+      -- still reports success.+      "#!/bin/sh\n[ \"$1\" = \"--\" ] && shift\nprintf '%s' \"$1\"\ncat 2>/dev/null || true\n"+    $ \dir exe -> do+      let promptBody = "the prompt is an argument" :: Text.Text+          cmd =+            AgentCommand+              { executable = exe,+                arguments = ["--", Text.unpack promptBody],+                promptTransport = PromptAsArgument,+                promptText = promptBody+              }+      result <-+        runPlain (capturingRequest dir promptBody) cmd >>= expectRan+      capturedBytes (result ^. #stdout) @?= Just (Text.encodeUtf8 promptBody)+      result ^. #exitCode @?= ExitSuccess++timeoutMicrosTests :: TestTree+timeoutMicrosTests =+  testGroup+    "timeout conversion"+    [ testCase "no timeout stays absent" $ timeoutMicros Nothing @?= Nothing,+      testCase "zero means no timeout, not expire immediately" $+        timeoutMicros (Just 0) @?= Nothing,+      testCase "a negative duration means no timeout" $+        timeoutMicros (Just (-5)) @?= Nothing,+      testCase "an ordinary duration converts to microseconds" $+        timeoutMicros (Just 1.5) @?= Just 1500000,+      testCase "a duration too large for an Int means no timeout" $+        timeoutMicros (Just 1e30) @?= Nothing+    ]++stripTrailingNewline :: BS.ByteString -> BS.ByteString+stripTrailingNewline bytes+  | not (BS.null bytes) && BS.last bytes == 10 = BS.init bytes+  | otherwise = bytes++basename :: FilePath -> FilePath+basename = reverse . takeWhile (/= '/') . reverse++waitSeconds :: Int -> IO ()+waitSeconds seconds = threadDelay (seconds * 1000000)