never executed always true always false
1 module PureClaw.Harness.ClaudeCode
2 ( mkClaudeCodeHarness
3 , mkClaudeCodeHarnessWith
4 , mkDiscoveredClaudeCodeHandle
5 -- * Response extraction (exported for testing)
6 , extractLastResponse
7 , isIdle
8 , isResponseMarker
9 , isUiBoundary
10 ) where
11
12 import Control.Concurrent
13 import Control.Monad (when)
14 import Data.Aeson qualified as Aeson
15 import Data.ByteString (ByteString)
16 import Data.ByteString qualified as BS
17 import Data.ByteString.Lazy qualified as LBS
18 import Data.IORef
19 import Data.Text.Encoding qualified as TE
20 import Data.Map.Strict qualified as Map
21 import Data.Text (Text)
22 import Data.Text qualified as T
23 import Data.Time
24 import Data.UUID qualified as UUID
25 import Data.UUID.V4 qualified as UUID
26 import System.Directory qualified as Dir
27 import System.Exit
28 import System.Process.Typed qualified as P
29 import PureClaw.Handles.Harness
30 import PureClaw.Handles.Transcript
31 import PureClaw.Harness.Tmux
32 import PureClaw.Security.Command
33 import PureClaw.Security.Policy
34 import PureClaw.Transcript.Types
35
36 -- | Session name used by the Claude Code harness.
37 sessionName :: Text
38 sessionName = "pureclaw"
39
40 -- | Create a Claude Code harness using real system dependencies.
41 -- The 'Int' is the tmux window index (0 for the first harness, 1 for the next, etc.).
42 mkClaudeCodeHarness
43 :: SecurityPolicy
44 -> TranscriptHandle
45 -> Int
46 -> Maybe FilePath -- ^ optional working directory
47 -> [Text] -- ^ extra CLI arguments (e.g. --dangerously-skip-permissions)
48 -> IO (Either HarnessError HarnessHandle)
49 mkClaudeCodeHarness =
50 mkClaudeCodeHarnessWith
51 (Dir.findExecutable "claude")
52 requireTmux
53 addHarnessWindow
54 startTmuxSession
55
56 -- | Testable variant with injectable dependencies.
57 mkClaudeCodeHarnessWith
58 :: IO (Maybe FilePath) -- ^ findExecutable "claude"
59 -> IO (Either HarnessError ()) -- ^ requireTmux
60 -> (Text -> Int -> FilePath -> [Text] -> Maybe FilePath -> IO (Either HarnessError ())) -- ^ addHarnessWindow
61 -> (Text -> IO (Either HarnessError ())) -- ^ startTmuxSession
62 -> SecurityPolicy
63 -> TranscriptHandle
64 -> Int -- ^ tmux window index
65 -> Maybe FilePath -- ^ optional working directory
66 -> [Text] -- ^ extra CLI arguments
67 -> IO (Either HarnessError HarnessHandle)
68 mkClaudeCodeHarnessWith findClaude checkTmux addWindow startSession policy th windowIdx mWorkDir extraArgs =
69 -- Step 1: Pre-check authorization (pure, no IO needed).
70 -- This catches Deny autonomy and missing command allowlisting before any IO.
71 case preAuthorize policy of
72 Left cmdErr -> pure (Left (HarnessNotAuthorized cmdErr))
73 Right () -> do
74 -- Step 2: Check tmux availability
75 tmuxResult <- checkTmux
76 case tmuxResult of
77 Left err -> pure (Left err)
78 Right () -> do
79 -- Step 3: Find claude binary
80 mClaudePath <- findClaude
81 case mClaudePath of
82 Nothing -> pure (Left (HarnessBinaryNotFound "claude"))
83 Just claudePath -> do
84 -- Step 4: Authorize the full command path
85 case authorize policy claudePath [] of
86 Left cmdErr -> pure (Left (HarnessNotAuthorized cmdErr))
87 Right authorizedCmd -> do
88 let program = getCommandProgram authorizedCmd
89 -- Step 5: Start tmux session (idempotent)
90 sessionResult <- startSession sessionName
91 case sessionResult of
92 Left err -> pure (Left err)
93 Right () -> do
94 -- Step 6: Add harness window at the assigned index
95 windowResult <- addWindow sessionName windowIdx program extraArgs mWorkDir
96 case windowResult of
97 Left err -> pure (Left err)
98 Right () -> do
99 -- Step 6b: If unsafe mode, auto-confirm the safety prompt
100 when (hasUnsafeFlag extraArgs) $ do
101 threadDelay 2000000 -- 2s for the prompt to appear
102 sendToWindow sessionName windowIdx ""
103 -- Step 7: Wire up the HarnessHandle
104 baselineRef <- newIORef BS.empty
105 let handle = HarnessHandle
106 { _hh_send = harnesseSend th windowIdx baselineRef
107 , _hh_receive = harnessReceive th windowIdx baselineRef
108 , _hh_name = "Claude Code"
109 , _hh_session = sessionName
110 , _hh_status = checkWindowStatus th
111 , _hh_stop = stopHarnessWindow sessionName windowIdx
112 }
113 pure (Right handle)
114
115 -- | Check whether the extra args include the unsafe/skip-permissions flag.
116 hasUnsafeFlag :: [Text] -> Bool
117 hasUnsafeFlag = elem "--dangerously-skip-permissions"
118
119 -- | Pre-authorize: check that the policy would allow "claude" at all.
120 -- This is a fast pure check before doing any IO (tmux, findExecutable, etc.).
121 preAuthorize :: SecurityPolicy -> Either CommandError ()
122 preAuthorize policy = case authorize policy "claude" [] of
123 Left err -> Left err
124 Right _ -> Right ()
125
126 -- | Send input to the Claude Code window and log the request.
127 harnesseSend :: TranscriptHandle -> Int -> IORef ByteString -> ByteString -> IO ()
128 harnesseSend th windowIdx _baselineRef input = do
129 -- Log the request
130 entryId <- UUID.toText <$> UUID.nextRandom
131 now <- getCurrentTime
132 let entry = TranscriptEntry
133 { _te_id = entryId
134 , _te_timestamp = now
135 , _te_harness = Just "claude-code"
136 , _te_model = Nothing
137 , _te_direction = Request
138 , _te_payload = encodePayload input
139 , _te_durationMs = Nothing
140 , _te_correlationId = entryId
141 , _te_metadata = Map.empty
142 }
143 _th_record th entry
144 sendToWindow sessionName windowIdx input
145
146 -- | Poll the Claude Code window until idle, then extract the last response.
147 --
148 -- Idle = screen contains @❯@ and does not contain busy indicators.
149 -- Requires 3 consecutive stable captures before returning.
150 -- After stabilisation, captures full scrollback and extracts the last
151 -- response block (from the last @⏺@ marker to the next UI boundary).
152 -- Times out after 120 seconds.
153 harnessReceive :: TranscriptHandle -> Int -> IORef ByteString -> IO ByteString
154 harnessReceive th windowIdx _baselineRef = do
155 let target = sessionName <> ":" <> T.pack (show windowIdx)
156 startTime <- getCurrentTime
157 -- Poll until Claude Code is idle and screen is stable
158 pollUntilIdle target startTime "" (0 :: Int)
159 -- Capture full scrollback and extract the last response
160 fullCapture <- captureFullScrollback target
161 let responseText = extractLastResponse fullCapture
162 -- Log the response
163 entryId <- UUID.toText <$> UUID.nextRandom
164 now <- getCurrentTime
165 let entry = TranscriptEntry
166 { _te_id = entryId
167 , _te_timestamp = now
168 , _te_harness = Just "claude-code"
169 , _te_model = Nothing
170 , _te_direction = Response
171 , _te_payload = encodePayload responseText
172 , _te_durationMs = Nothing
173 , _te_correlationId = entryId
174 , _te_metadata = Map.empty
175 }
176 _th_record th entry
177 pure responseText
178 where
179 pollUntilIdle target startTime lastScreen stableCount = do
180 threadDelay 500000 -- 500ms
181 current <- captureWindow target 300
182 now <- getCurrentTime
183 let elapsed = diffUTCTime now startTime
184 screenText = TE.decodeUtf8Lenient current
185 if elapsed > 120
186 then pure () -- timeout — extract whatever we have
187 else if isIdle screenText
188 then if current == lastScreen
189 then if stableCount >= 2 -- 3 consecutive stable captures
190 then pure ()
191 else pollUntilIdle target startTime current (stableCount + 1)
192 else pollUntilIdle target startTime current 0
193 else pollUntilIdle target startTime "" 0
194
195 -- | Check if Claude Code is idle (showing prompt, not busy).
196 isIdle :: Text -> Bool
197 isIdle screen =
198 let hasPrompt = T.isInfixOf "\x276F" screen -- ❯
199 isBusy = T.isInfixOf "\x280B" screen -- ⠋ (spinner)
200 || T.isInfixOf "Thinking" screen
201 || T.isInfixOf "Running" screen
202 in hasPrompt && not isBusy
203
204 -- | Capture the full scrollback buffer (not just the visible pane).
205 captureFullScrollback :: Text -> IO ByteString
206 captureFullScrollback target = do
207 mPath <- findTmux
208 case mPath of
209 Nothing -> pure ""
210 Just tmuxBin -> do
211 let config = P.setStdin P.closed
212 $ P.setStdout P.byteStringOutput
213 $ P.setStderr P.nullStream
214 $ P.proc tmuxBin
215 [ "capture-pane", "-t", T.unpack target
216 , "-p"
217 , "-S", "-" -- from start of scrollback
218 , "-E", "-" -- to end of scrollback
219 ]
220 (exitCode, stdout, _stderr) <- P.readProcess config
221 case exitCode of
222 ExitSuccess -> pure (LBS.toStrict stdout)
223 ExitFailure _ -> pure ""
224
225 -- | Extract the last response block from Claude Code scrollback.
226 --
227 -- Finds the last line starting with @\x23FA@ (⏺ — Claude's response marker),
228 -- collects lines until a UI boundary is hit.
229 extractLastResponse :: ByteString -> ByteString
230 extractLastResponse capture =
231 let allLines = map TE.decodeUtf8Lenient (BS.split 0x0A capture)
232 -- Find the index of the last response marker
233 markerIdxs = [ i | (i, line) <- zip [0..] allLines
234 , isResponseMarker line ]
235 in case markerIdxs of
236 [] -> "" -- no response found
237 _ ->
238 let startIdx = last markerIdxs
239 response = takeWhile (not . isUiBoundary)
240 $ drop startIdx allLines
241 -- Strip the marker prefix from the first line
242 cleaned = case response of
243 (first : rest) -> stripMarker first : rest
244 [] -> []
245 in TE.encodeUtf8 (T.intercalate "\n" cleaned)
246
247 -- | Lines starting with ⏺ (U+23FA, BLACK CIRCLE FOR RECORD) are response markers.
248 isResponseMarker :: Text -> Bool
249 isResponseMarker line =
250 T.isPrefixOf "\x23FA" (T.stripStart line)
251 || T.isPrefixOf "\x2B24" (T.stripStart line) -- ⬤ alternate marker
252
253 -- | UI boundaries that terminate response extraction.
254 isUiBoundary :: Text -> Bool
255 isUiBoundary line =
256 let stripped = T.stripStart line
257 in T.isPrefixOf "\x276F" stripped -- ❯ input prompt
258 || T.isPrefixOf "?" stripped
259 && T.isInfixOf "shortcut" line -- "? for shortcuts"
260 || T.isInfixOf "\x2580\x2580" line -- ▀▀ top bar
261 || T.isInfixOf "\x2584\x2584" line -- ▄▄ bottom bar
262 || T.isInfixOf "\x2500\x2500\x2500" line -- ─── horizontal rule
263
264 -- | Strip the response marker prefix (⏺ or ⬤) from a line.
265 stripMarker :: Text -> Text
266 stripMarker line =
267 let stripped = T.stripStart line
268 in if T.isPrefixOf "\x23FA" stripped || T.isPrefixOf "\x2B24" stripped
269 then T.stripStart (T.drop 1 stripped)
270 else line
271
272 -- | Check if the Claude Code tmux window is still running.
273 -- Uses @tmux list-windows@ to check if the window exists.
274 checkWindowStatus :: TranscriptHandle -> IO HarnessStatus
275 checkWindowStatus th = do
276 mTmux <- findTmux
277 case mTmux of
278 Nothing -> pure (HarnessExited (ExitFailure 127))
279 Just tmuxBin -> checkWithTmux tmuxBin th
280
281 checkWithTmux :: FilePath -> TranscriptHandle -> IO HarnessStatus
282 checkWithTmux tmuxBin th = do
283 exitCode <- P.runProcess
284 $ P.setStdin P.closed
285 $ P.setStdout P.nullStream
286 $ P.setStderr P.nullStream
287 $ P.proc tmuxBin ["list-windows", "-t", "pureclaw", "-F", "#{window_name}"]
288 case exitCode of
289 ExitSuccess -> pure HarnessRunning
290 ExitFailure code -> do
291 -- Window or session is gone — log the event
292 now <- getCurrentTime
293 entryId <- UUID.toText <$> UUID.nextRandom
294 let entry = TranscriptEntry
295 { _te_id = entryId
296 , _te_timestamp = now
297 , _te_harness = Just "claude-code"
298 , _te_model = Nothing
299 , _te_direction = Response
300 , _te_payload = ""
301 , _te_durationMs = Nothing
302 , _te_correlationId = entryId
303 , _te_metadata = Map.fromList
304 [ ("event", Aeson.String "harness_exited")
305 , ("exit_code", Aeson.toJSON code)
306 ]
307 }
308 _th_record th entry
309 pure (HarnessExited (ExitFailure code))
310
311 -- | Reconstruct a 'HarnessHandle' for an already-running Claude Code window
312 -- discovered via tmux. Used on startup to recover harness state.
313 mkDiscoveredClaudeCodeHandle :: TranscriptHandle -> Int -> IO HarnessHandle
314 mkDiscoveredClaudeCodeHandle th windowIdx = do
315 baselineRef <- newIORef BS.empty
316 pure HarnessHandle
317 { _hh_send = harnesseSend th windowIdx baselineRef
318 , _hh_receive = harnessReceive th windowIdx baselineRef
319 , _hh_name = "Claude Code"
320 , _hh_session = sessionName
321 , _hh_status = checkWindowStatus th
322 , _hh_stop = stopHarnessWindow sessionName windowIdx
323 }