Close SQLite and HTTP response on error paths
ober
c141cd3601c715a1ed2201442dc037e70ab9ba4e
--- a/src/jcode/core/session.ss +++ b/src/jcode/core/session.ss @@ -35,59 +35,63 @@ (sqlite-exec db "PRAGMA busy_timeout = 5000") db)) -(def (session-init-db) +;; Run PROC on a fresh db handle, guaranteeing close even on exception. +(def (with-db proc) (let ((db (open-db))) - ;; WAL allows concurrent readers + one writer, much friendlier to the - ;; agent's green-thread mix than the default rollback journal. Persists - ;; in the DB file, so this only needs to run once. - (sqlite-exec db "PRAGMA journal_mode = WAL") - (sqlite-exec db - "CREATE TABLE IF NOT EXISTS sessions ( - id TEXT PRIMARY KEY, - title TEXT NOT NULL, - created_at TEXT NOT NULL, - updated_at TEXT NOT NULL - )") - (sqlite-exec db - "CREATE TABLE IF NOT EXISTS messages ( - id INTEGER PRIMARY KEY AUTOINCREMENT, - session_id TEXT NOT NULL, - role TEXT NOT NULL, - content TEXT, - tool_calls TEXT, - tool_call_id TEXT, - created_at TEXT NOT NULL, - FOREIGN KEY (session_id) REFERENCES sessions(id) - )") - (sqlite-exec db - "CREATE INDEX IF NOT EXISTS idx_messages_session ON messages(session_id)") - (sqlite-close db))) + (dynamic-wind + (lambda () (void)) + (lambda () (proc db)) + (lambda () (sqlite-close db))))) + +(def (session-init-db) + (with-db + (lambda (db) + (sqlite-exec db "PRAGMA journal_mode = WAL") + (sqlite-exec db + "CREATE TABLE IF NOT EXISTS sessions ( + id TEXT PRIMARY KEY, + title TEXT NOT NULL, + created_at TEXT NOT NULL, + updated_at TEXT NOT NULL + )") + (sqlite-exec db + "CREATE TABLE IF NOT EXISTS messages ( + id INTEGER PRIMARY KEY AUTOINCREMENT, + session_id TEXT NOT NULL, + role TEXT NOT NULL, + content TEXT, + tool_calls TEXT, + tool_call_id TEXT, + created_at TEXT NOT NULL, + FOREIGN KEY (session_id) REFERENCES sessions(id) + )") + (sqlite-exec db + "CREATE INDEX IF NOT EXISTS idx_messages_session ON messages(session_id)")))) (def (session-create title) - (let* ((db (open-db)) - (id (uuid-string)) - (now (timestamp-now))) - (sqlite-eval db - "INSERT INTO sessions (id, title, created_at, updated_at) VALUES (?, ?, ?, ?)" - id title now now) - (sqlite-close db) + (let ((id (uuid-string)) + (now (timestamp-now))) + (with-db + (lambda (db) + (sqlite-eval db + "INSERT INTO sessions (id, title, created_at, updated_at) VALUES (?, ?, ?, ?)" + id title now now))) (make-session id title now '()))) (def (session-load id) - (let* ((db (open-db)) - (rows (sqlite-query db - "SELECT id, title, created_at FROM sessions WHERE id = ?" - id))) - (if (null? rows) - (begin (sqlite-close db) #f) - (let* ((row (car rows)) - (messages (load-messages db id))) - (sqlite-close db) - (make-session - (vector-ref row 0) - (vector-ref row 1) - (vector-ref row 2) - messages))))) + (with-db + (lambda (db) + (let ((rows (sqlite-query db + "SELECT id, title, created_at FROM sessions WHERE id = ?" + id))) + (and (not (null? rows)) + (let* ((row (car rows)) + (messages (load-messages db id))) + (make-session + (vector-ref row 0) + (vector-ref row 1) + (vector-ref row 2) + messages))))))) (def (load-messages db session-id) (let ((rows (sqlite-query db @@ -115,45 +119,43 @@ #f))) (def (session-list) - (let* ((db (open-db)) - (rows (sqlite-query db - "SELECT id, title, created_at FROM sessions - ORDER BY updated_at DESC"))) - (sqlite-close db) - (map (lambda (row) - (make-session - (vector-ref row 0) - (vector-ref row 1) - (vector-ref row 2) - '())) - rows))) + (with-db + (lambda (db) + (let ((rows (sqlite-query db + "SELECT id, title, created_at FROM sessions + ORDER BY updated_at DESC"))) + (map (lambda (row) + (make-session + (vector-ref row 0) + (vector-ref row 1) + (vector-ref row 2) + '())) + rows))))) (def (session-add-message session-id msg) - (let* ((db (open-db)) - (now (timestamp-now)) - (tool-calls-json - (and (message-tool-calls msg) - (json-object->string - (map tool-call->stored-json (message-tool-calls msg)))))) - (sqlite-eval db - "INSERT INTO messages (session_id, role, content, tool_calls, tool_call_id, created_at) - VALUES (?, ?, ?, ?, ?, ?)" - session-id - (message-role msg) - (let ((c (message-content msg))) (if (eq? c (void)) #f c)) - tool-calls-json - (let ((id (message-tool-call-id msg))) (if (eq? id (void)) #f id)) - now) - (sqlite-eval db - "UPDATE sessions SET updated_at = ? WHERE id = ?" - now session-id) - (sqlite-close db))) + (with-db + (lambda (db) + (let ((now (timestamp-now)) + (tool-calls-json + (and (message-tool-calls msg) + (json-object->string + (map tool-call->stored-json (message-tool-calls msg)))))) + (sqlite-eval db + "INSERT INTO messages (session_id, role, content, tool_calls, tool_call_id, created_at) + VALUES (?, ?, ?, ?, ?, ?)" + session-id + (message-role msg) + (let ((c (message-content msg))) (if (eq? c (void)) #f c)) + tool-calls-json + (let ((id (message-tool-call-id msg))) (if (eq? id (void)) #f id)) + now) + (sqlite-eval db + "UPDATE sessions SET updated_at = ? WHERE id = ?" + now session-id))))) (def (session-get-messages session-id) - (let* ((db (open-db)) - (messages (load-messages db session-id))) - (sqlite-close db) - messages)) + (with-db + (lambda (db) (load-messages db session-id)))) (def (session-replace-messages session-id msgs) ;; Atomically replace ALL stored messages for SESSION-ID with MSGS. @@ -185,36 +187,36 @@ (sqlite-close db))) (def (session-update-title session-id title) - (let ((db (open-db))) - (sqlite-eval db - "UPDATE sessions SET title = ?, updated_at = ? WHERE id = ?" - title (timestamp-now) session-id) - (sqlite-close db))) + (with-db + (lambda (db) + (sqlite-eval db + "UPDATE sessions SET title = ?, updated_at = ? WHERE id = ?" + title (timestamp-now) session-id)))) (def (session-search term) "Search all messages for TERM. Returns list of (session-title role snippet)." - (let* ((db (open-db)) - (pattern (string-append "%" term "%")) - (rows (sqlite-query db - "SELECT s.title, m.role, m.content - FROM messages m - JOIN sessions s ON s.id = m.session_id - WHERE m.content LIKE ? - ORDER BY m.created_at DESC - LIMIT 50" - pattern))) - (sqlite-close db) - (map (lambda (row) - (list (vector-ref row 0) - (vector-ref row 1) - (vector-ref row 2))) - rows))) + (with-db + (lambda (db) + (let* ((pattern (string-append "%" term "%")) + (rows (sqlite-query db + "SELECT s.title, m.role, m.content + FROM messages m + JOIN sessions s ON s.id = m.session_id + WHERE m.content LIKE ? + ORDER BY m.created_at DESC + LIMIT 50" + pattern))) + (map (lambda (row) + (list (vector-ref row 0) + (vector-ref row 1) + (vector-ref row 2))) + rows))))) (def (session-delete session-id) - (let ((db (open-db))) - (sqlite-eval db "DELETE FROM messages WHERE session_id = ?" session-id) - (sqlite-eval db "DELETE FROM sessions WHERE id = ?" session-id) - (sqlite-close db))) + (with-db + (lambda (db) + (sqlite-eval db "DELETE FROM messages WHERE session_id = ?" session-id) + (sqlite-eval db "DELETE FROM sessions WHERE id = ?" session-id)))) (def (timestamp-now) (let ((d (current-date))) --- a/src/jcode/tool/web.ss +++ b/src/jcode/tool/web.ss @@ -81,11 +81,14 @@ (resp (if (equal? method "POST") (http-post url extra-headers (or body "")) - (http-get url extra-headers #f))) - (status (request-status resp)) - (text (request-text resp))) - (request-close resp) - (format "Status: ~a\n~a" status text))) + (http-get url extra-headers #f)))) + (dynamic-wind + (lambda () (void)) + (lambda () + (let ((status (request-status resp)) + (text (request-text resp))) + (format "Status: ~a\n~a" status text))) + (lambda () (request-close resp))))) ;; ---- web_search (in-process jerbsearch) ----