500 lines
19 KiB
EmacsLisp
500 lines
19 KiB
EmacsLisp
;;; ppq-status.el --- Dashboard for PayPerQ API -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2024 PayPerQ Contributors
|
|
|
|
;; Author: PayPerQ Contributors
|
|
;; Maintainer: PayPerQ Contributors
|
|
;; URL: https://github.com/ppqai/emacs
|
|
;; Version: 0.1.0
|
|
;; Package-Requires: ((emacs "28.1") (qrencode "0.1"))
|
|
;; Keywords: convenience, api, dashboard
|
|
|
|
;; This file is not part of GNU Emacs.
|
|
|
|
;; This program is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; A dashboard for the PayPerQ API showing models, balance and deposits.
|
|
|
|
;; Setup:
|
|
;; (require 'ppq-status)
|
|
;; M-x ppq-status
|
|
;;
|
|
;; Configure API key and credit ID in auth-sources:
|
|
;; (add-to-list 'auth-sources '("ppq.ai.gpg" :host "ppq.ai"))
|
|
|
|
;;; Code:
|
|
|
|
(require 'url)
|
|
(require 'json)
|
|
(require 'auth-source)
|
|
(require 'org)
|
|
(require 'tabulated-list)
|
|
(require 'hl-line)
|
|
|
|
(declare-function qrencode-string "qrencode")
|
|
|
|
(defgroup ppq nil
|
|
"Dashboard for PayPerQ API."
|
|
:group 'convenience
|
|
:prefix "ppq-"
|
|
:link '(url-link :tag "GitHub" "https://github.com/ppqai/emacs"))
|
|
|
|
(defcustom ppq-api-base-url "https://api.ppq.ai"
|
|
"Base URL for PayPerQ API."
|
|
:type 'string
|
|
:group 'ppq)
|
|
|
|
(defcustom ppq-models-endpoint "/v1/models"
|
|
"Endpoint for fetching models."
|
|
:type 'string
|
|
:group 'ppq)
|
|
|
|
(defvar ppq--window-config nil
|
|
"Saved window configuration before dashboard was shown.")
|
|
|
|
(defun ppq--get-api-key ()
|
|
"Get API key from auth-source for ppq.ai."
|
|
(let ((secret (auth-source-search :host "ppq.ai" :secret t)))
|
|
(when secret
|
|
(funcall (plist-get (car secret) :secret)))))
|
|
|
|
(defun ppq--get-credit-id ()
|
|
"Get credit ID from auth-source for ppq.ai/credit-id."
|
|
(let ((secret (auth-source-search :host "ppq.ai/credit-id" :secret t)))
|
|
(when secret
|
|
(funcall (plist-get (car secret) :secret)))))
|
|
|
|
;; --- Table 1: Releases ---
|
|
|
|
(defvar ppq--releases-data nil
|
|
"Cached releases data from GitHub.")
|
|
|
|
(defvar ppq--releases-projects
|
|
'(("Opencode" . "anomalyco/opencode"))
|
|
"List of projects to fetch releases for.
|
|
Each element is a cons cell (DISPLAY-NAME . REPO-STRING).")
|
|
|
|
(defun ppq--releases-get-buffer-name ()
|
|
"Get the releases buffer name."
|
|
"*Dashboard:Releases*")
|
|
|
|
(defvar ppq--releases-active-processes nil
|
|
"List of active release fetch processes.")
|
|
|
|
(defun ppq--releases-process-sentinel (process _event)
|
|
"Process sentinel for gh release list.
|
|
PROCESS is the process object, _EVENT is the status change string."
|
|
(setq ppq--releases-active-processes
|
|
(delq process ppq--releases-active-processes))
|
|
(when (memq (process-status process) '(exit signal))
|
|
(let ((stdout-buf (process-buffer process))
|
|
(stderr-buf (process-get process 'ppq-stderr-buffer))
|
|
(exit-code (process-exit-status process))
|
|
(project-name (process-get process 'ppq-project-name)))
|
|
(if (zerop exit-code)
|
|
(let ((output (with-current-buffer stdout-buf
|
|
(buffer-string))))
|
|
(condition-case nil
|
|
(let* ((json (json-parse-string (string-trim output) :object-type 'alist))
|
|
(releases (if (vectorp json) (append json nil) json)))
|
|
(push (cons project-name releases) ppq--releases-data)
|
|
(ppq--releases-refresh-buffer))
|
|
(error nil)))
|
|
(let ((stderr-output (with-current-buffer stderr-buf
|
|
(buffer-string))))
|
|
(message "ppq releases: failed for %s: %s"
|
|
project-name (string-trim stderr-output))))
|
|
(when (buffer-live-p stdout-buf)
|
|
(kill-buffer stdout-buf))
|
|
(when (buffer-live-p stderr-buf)
|
|
(kill-buffer stderr-buf)))))
|
|
|
|
(defun ppq--releases-fetch-async (project-name repo)
|
|
"Fetch releases for REPO asynchronously using gh CLI.
|
|
PROJECT-NAME is the display name for the project."
|
|
(let* ((stdout-buf (generate-new-buffer " *gh-releases-stdout*"))
|
|
(stderr-buf (generate-new-buffer " *gh-releases-stderr*"))
|
|
(process-environment (append '("PAGER=cat" "GH_PAGER=cat" "GIT_PAGER=cat" "NO_COLOR=1")
|
|
process-environment))
|
|
(process (make-process
|
|
:name "gh-releases"
|
|
:buffer stdout-buf
|
|
:command (list "gh" "api"
|
|
(format "repos/%s/releases?per_page=5" repo))
|
|
:stderr stderr-buf
|
|
:sentinel #'ppq--releases-process-sentinel
|
|
:noquery t)))
|
|
(process-put process 'ppq-project-name project-name)
|
|
(process-put process 'ppq-stderr-buffer stderr-buf)
|
|
(push process ppq--releases-active-processes)))
|
|
|
|
(defun ppq--releases-fetch-all-async ()
|
|
"Fetch releases for all configured projects."
|
|
(setq ppq--releases-data nil)
|
|
(dolist (project ppq--releases-projects)
|
|
(ppq--releases-fetch-async (car project) (cdr project))))
|
|
|
|
(defun ppq--releases-format-date (iso-date)
|
|
"Format ISO-DATE string to human-readable date."
|
|
(when iso-date
|
|
(condition-case nil
|
|
(format-time-string
|
|
"%Y-%m-%d"
|
|
(encode-time (parse-time-string iso-date)))
|
|
(error iso-date))))
|
|
|
|
(defun ppq--releases-insert-content ()
|
|
"Insert releases content into current buffer."
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(insert "* Software Releases\n\n")
|
|
(if ppq--releases-data
|
|
(dolist (project-data ppq--releases-data)
|
|
(let ((project-name (car project-data))
|
|
(releases (cdr project-data)))
|
|
(insert (format "** %s\n" project-name))
|
|
(if releases
|
|
(dolist (release releases)
|
|
(let* ((tag (cdr (assq 'tag_name release)))
|
|
(name (cdr (assq 'name release)))
|
|
(published (cdr (assq 'published_at release)))
|
|
(body (cdr (assq 'body release)))
|
|
(display-name (if (and name (not (string= name "")))
|
|
name
|
|
tag)))
|
|
(insert (format "*** %s (%s)\n"
|
|
display-name
|
|
(ppq--releases-format-date published)))
|
|
;; Insert changelog body if present
|
|
(when (and body (not (eq body :null)) (not (string= body "")))
|
|
(insert "\n#+begin_src markdown\n")
|
|
(insert body)
|
|
(insert "\n#+end_src\n"))))
|
|
(insert "- No releases found\n"))
|
|
(insert "\n")))
|
|
(insert "Loading releases...\n"))
|
|
(goto-char (point-min))
|
|
;; Fold to show release versions (level 3) but hide changelog content
|
|
(org-content 3)))
|
|
|
|
(defun ppq--releases-refresh-buffer ()
|
|
"Refresh the releases buffer if it exists."
|
|
(when-let ((buf (get-buffer (ppq--releases-get-buffer-name))))
|
|
(with-current-buffer buf
|
|
(ppq--releases-insert-content))))
|
|
|
|
(defun ppq-releases-mode ()
|
|
"Major mode for displaying GitHub releases."
|
|
(interactive)
|
|
(kill-all-local-variables)
|
|
(org-mode)
|
|
(org-indent-mode 1)
|
|
(setq major-mode 'ppq-releases-mode
|
|
mode-name "Releases")
|
|
(use-local-map (let ((map (copy-keymap org-mode-map)))
|
|
(define-key map "q" #'ppq-quit)
|
|
map))
|
|
(setq buffer-read-only t)
|
|
(ppq--releases-insert-content))
|
|
|
|
(defvar ppq-releases-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map "q" #'ppq-quit)
|
|
map))
|
|
|
|
;; --- Table 2: Models ---
|
|
|
|
(defvar ppq--models-data nil
|
|
"Cached models data from API.")
|
|
|
|
(defun ppq--aget (alist key)
|
|
"Safely get value from ALIST for KEY, returns nil if null."
|
|
(let ((val (cdr (assq key alist))))
|
|
(unless (eq val :null) val)))
|
|
|
|
(defun ppq--format-context-length (num)
|
|
"Format NUM as human-readable context length."
|
|
(if (numberp num)
|
|
(cond
|
|
((>= num 1000000) (format "%.1fM" (/ num 1000000.0)))
|
|
((>= num 1000) (format "%.0fK" (/ num 1000.0)))
|
|
(t (number-to-string num)))
|
|
"N/A"))
|
|
|
|
(defun ppq--format-pricing (model)
|
|
"Format pricing info from MODEL."
|
|
(let* ((pricing (ppq--aget model 'pricing))
|
|
(prompt (when pricing (ppq--aget pricing 'input_per_1M_tokens)))
|
|
(completion (when pricing (ppq--aget pricing 'output_per_1M_tokens)))
|
|
(currency (or (when pricing (ppq--aget pricing 'currency)) "USD")))
|
|
(if (and (numberp prompt) (numberp completion)
|
|
(eq prompt 0) (eq completion 0))
|
|
"Free"
|
|
(format "$%.2f/$%.2f %s"
|
|
(or prompt 0)
|
|
(or completion 0)
|
|
currency))))
|
|
|
|
(defun ppq--model-has-cheap-output-p (model)
|
|
"Check if MODEL has output price per 1M tokens in range [0, 1)."
|
|
(let* ((pricing (ppq--aget model 'pricing))
|
|
(completion (when pricing (ppq--aget pricing 'output_per_1M_tokens))))
|
|
(and (numberp completion)
|
|
(>= completion 0)
|
|
(< completion 1))))
|
|
|
|
(defun ppq--fetch-models-callback (status)
|
|
"Callback for async model fetching. STATUS is the url-retrieve status."
|
|
(unless (plist-get status :error)
|
|
(goto-char (point-min))
|
|
(re-search-forward "^$" nil t)
|
|
(let* ((json-str (buffer-substring (point) (point-max)))
|
|
(json (json-parse-string json-str :object-type 'alist))
|
|
(models (ppq--aget json 'data)))
|
|
(when (vectorp models)
|
|
(setq models (append models nil)))
|
|
(setq ppq--models-data models)
|
|
(when (get-buffer "*Dashboard:Models*")
|
|
(with-current-buffer "*Dashboard:Models*"
|
|
(ppq-models-mode)))
|
|
(message "Models loaded: %d entries" (length models)))))
|
|
|
|
(defun ppq--fetch-models-async ()
|
|
"Fetch models from PayPerQ API asynchronously."
|
|
(url-retrieve
|
|
(concat ppq-api-base-url ppq-models-endpoint)
|
|
#'ppq--fetch-models-callback
|
|
nil t t))
|
|
|
|
;; --- Balance ---
|
|
|
|
(defun ppq--fetch-balance-callback (status)
|
|
"Callback for async balance fetching. STATUS is the url-retrieve status."
|
|
(unless (plist-get status :error)
|
|
(goto-char (point-min))
|
|
(re-search-forward "^$" nil t)
|
|
(let* ((json-str (buffer-substring (point) (point-max)))
|
|
(json (json-parse-string json-str :object-type 'alist))
|
|
(balance (ppq--aget json 'balance)))
|
|
(when (get-buffer "*Dashboard:Info*")
|
|
(with-current-buffer "*Dashboard:Info*"
|
|
(let ((inhibit-read-only t))
|
|
(goto-char (point-min))
|
|
(when (re-search-forward "^\\*\\* Balance" nil t)
|
|
(delete-region (match-beginning 0) (progn (forward-line) (point)))
|
|
(insert "** Balance\n")
|
|
(insert (format "- Credits: %s\n" (or balance "N/A")))))
|
|
(message "Balance loaded"))))))
|
|
|
|
(defun ppq--fetch-balance-async ()
|
|
"Fetch balance from PayPerQ API asynchronously."
|
|
(let ((credit-id (ppq--get-credit-id)))
|
|
(when credit-id
|
|
(let ((url-request-method "POST")
|
|
(url-request-extra-headers (list (cons "Content-Type" "application/json")))
|
|
(url-request-data (json-encode (list (cons 'credit_id credit-id)))))
|
|
(url-retrieve
|
|
(concat ppq-api-base-url "/credits/balance")
|
|
#'ppq--fetch-balance-callback
|
|
nil nil t)))))
|
|
|
|
;; --- Topup ---
|
|
|
|
(defun ppq--create-topup-callback (status)
|
|
"Callback for async topup creation. STATUS is the url-retrieve status."
|
|
(unless (plist-get status :error)
|
|
(goto-char (point-min))
|
|
(re-search-forward "^$" nil t)
|
|
(let* ((json-str (buffer-substring (point) (point-max)))
|
|
(json (json-parse-string json-str :object-type 'alist))
|
|
(data (ppq--aget json 'data))
|
|
(invoice (ppq--aget data 'invoice))
|
|
(amount (ppq--aget data 'amount))
|
|
(currency (ppq--aget data 'currency)))
|
|
(when (get-buffer "*Dashboard:Info*")
|
|
(with-current-buffer "*Dashboard:Info*"
|
|
(let ((inhibit-read-only t))
|
|
(goto-char (point-max))
|
|
(insert (format "\n*** Topup Created\n"))
|
|
(insert (format "- Amount: %s %s\n" (or amount "N/A") (or currency "N/A")))
|
|
(when invoice
|
|
(insert (format "- Invoice (raw):\n%s\n" invoice))
|
|
(insert (format "- Invoice (BOLT-11):\n"))
|
|
(insert (qrencode-string invoice))
|
|
(insert "\n"))
|
|
(insert "\n"))
|
|
(goto-char (point-min)))
|
|
(message "Topup created")))))
|
|
|
|
(defun ppq--create-topup-async (amount currency)
|
|
"Create Lightning topup for AMOUNT in CURRENCY."
|
|
(let ((api-key (ppq--get-api-key)))
|
|
(when api-key
|
|
(let ((url-request-method "POST")
|
|
(url-request-extra-headers (list (cons "Authorization" (format "Bearer %s" api-key))
|
|
(cons "Content-Type" "application/json")))
|
|
(url-request-data (json-encode (list (cons 'amount amount)
|
|
(cons 'currency currency)))))
|
|
(url-retrieve
|
|
(concat ppq-api-base-url "/topup/create/btc-lightning")
|
|
#'ppq--create-topup-callback
|
|
nil nil t)))))
|
|
|
|
(defun ppq--topup-button-action (_)
|
|
"Action for topup button."
|
|
(let* ((satoshis (read-number "Enter amount in satoshis: "))
|
|
(currency (if (> satoshis 0) "SATS" "USD"))
|
|
(amount (if (string= currency "SATS") satoshis (read-number "Enter amount in USD: "))))
|
|
(message "Creating Lightning topup for %s %s..." amount currency)
|
|
(ppq--create-topup-async amount currency)))
|
|
|
|
(defun ppq--insert-topup-button ()
|
|
"Insert a topup button in the current buffer."
|
|
(insert-text-button "[Topup BTC-LN]"
|
|
'action #'ppq--topup-button-action
|
|
'follow-link t))
|
|
|
|
;; --- Models Mode ---
|
|
|
|
(defvar ppq-models-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(set-keymap-parent map tabulated-list-mode-map)
|
|
(define-key map "q" #'ppq-quit)
|
|
(define-key map "w" #'ppq-models-copy-nix-entry)
|
|
map))
|
|
|
|
(defun ppq-models-copy-nix-entry ()
|
|
"Copy the current model as a Nix attribute set to clipboard."
|
|
(interactive)
|
|
(when tabulated-list-entries
|
|
(let* ((id (tabulated-list-get-id))
|
|
(model (seq-find (lambda (m) (equal (ppq--aget m 'id) id))
|
|
ppq--models-data))
|
|
(name (ppq--aget model 'name))
|
|
(pricing (ppq--aget model 'pricing))
|
|
(input-price (or (ppq--aget pricing 'input_per_1M_tokens) 0))
|
|
(output-price (or (ppq--aget pricing 'output_per_1M_tokens) 0))
|
|
(nix-str (format " \"%s\" = {\n name = \"%s\";\n cost = [%s %s];\n };"
|
|
id name (or input-price 0) (or output-price 0))))
|
|
(kill-new nix-str)
|
|
(message "Copied: %s" id))))
|
|
|
|
(defun ppq--format-created-at (epoch-ms)
|
|
"Format EPOCH-MS as human-readable date."
|
|
(when epoch-ms
|
|
(format-time-string "%Y-%m-%d" (/ epoch-ms 1000))))
|
|
|
|
(define-derived-mode ppq-models-mode tabulated-list-mode "Models"
|
|
"A table of PayPerQ models."
|
|
(hl-line-mode 1)
|
|
(setq tabulated-list-format
|
|
[("Name" 35 t)
|
|
("ID" 35 t)
|
|
("Created" 12 t)
|
|
("Ctx" 8 t :right-align t :pad-right 3)
|
|
("Pricing" 20 t)])
|
|
(setq tabulated-list-sort-key (cons "Created" t))
|
|
(setq tabulated-list-entries
|
|
(mapcar
|
|
(lambda (model)
|
|
(let ((cheap-p (ppq--model-has-cheap-output-p model)))
|
|
(list (ppq--aget model 'id)
|
|
(vector
|
|
(propertize (or (ppq--aget model 'name) "N/A") 'font-lock-face (if cheap-p '(:foreground "green") nil))
|
|
(propertize (or (ppq--aget model 'id) "N/A") 'font-lock-face (if cheap-p '(:foreground "green") nil))
|
|
(propertize (ppq--format-created-at (ppq--aget model 'created_at)) 'font-lock-face (if cheap-p '(:foreground "green") nil))
|
|
(propertize (ppq--format-context-length (ppq--aget model 'context_length)) 'font-lock-face (if cheap-p '(:foreground "green") nil))
|
|
(propertize (ppq--format-pricing model) 'font-lock-face (if cheap-p '(:foreground "green") nil))))))
|
|
ppq--models-data))
|
|
(tabulated-list-init-header)
|
|
(tabulated-list-print))
|
|
|
|
;; --- Quit function ---
|
|
|
|
(defun ppq-quit ()
|
|
"Quit the dashboard, restore previous window configuration, and kill buffers."
|
|
(interactive)
|
|
;; Kill any active release fetch processes
|
|
(dolist (proc ppq--releases-active-processes)
|
|
(when (process-live-p proc)
|
|
(delete-process proc)))
|
|
(setq ppq--releases-active-processes nil)
|
|
;; Kill buffers
|
|
(dolist (buf (list (get-buffer "*Dashboard:Releases*")
|
|
(get-buffer "*Dashboard:Models*")
|
|
(get-buffer "*Dashboard:Info*")))
|
|
(when buf (kill-buffer buf)))
|
|
(setq ppq--models-data nil)
|
|
(setq ppq--releases-data nil)
|
|
(when ppq--window-config
|
|
(set-window-configuration ppq--window-config)
|
|
(setq ppq--window-config nil)))
|
|
|
|
;; --- Main entry point ---
|
|
|
|
;;;###autoload
|
|
(defun ppq-status ()
|
|
"Show a dashboard with PayPerQ models, balance and topup."
|
|
(interactive)
|
|
(setq ppq--window-config (current-window-configuration))
|
|
|
|
(let ((releases-buf (get-buffer-create "*Dashboard:Releases*"))
|
|
(models-buf (get-buffer-create "*Dashboard:Models*"))
|
|
(org-buf (get-buffer-create "*Dashboard:Info*")))
|
|
|
|
(with-current-buffer releases-buf
|
|
(ppq-releases-mode))
|
|
|
|
(with-current-buffer models-buf
|
|
(ppq-models-mode))
|
|
|
|
(with-current-buffer org-buf
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(org-mode)
|
|
(org-indent-mode 1)
|
|
(insert "* Dashboard\n\n")
|
|
(insert "Welcome to the *PayPerQ* dashboard!\n\n")
|
|
(insert "** Notes\n")
|
|
(insert "- Press ~q~ in any table to quit\n")
|
|
(insert "- Table 1 :: Recent Releases (loading...)\n")
|
|
(insert "- Table 2 :: PayPerQ Models (loading...)\n\n")
|
|
(insert "** Balance\n\n")
|
|
(insert "** Topup (BTC-LN)\n")
|
|
(ppq--insert-topup-button)
|
|
(insert "\n"))
|
|
(goto-char (point-min))
|
|
(use-local-map (let ((map (copy-keymap org-mode-map)))
|
|
(define-key map "q" #'ppq-quit)
|
|
map)))
|
|
|
|
(delete-other-windows)
|
|
(let* ((top-left (selected-window))
|
|
(top-right (split-window-right))
|
|
(bottom (split-window-below (/ (window-height) 2))))
|
|
(set-window-buffer top-left releases-buf)
|
|
(set-window-buffer top-right models-buf)
|
|
(set-window-buffer bottom org-buf))
|
|
|
|
(select-window (get-buffer-window releases-buf)))
|
|
|
|
(ppq--releases-fetch-all-async)
|
|
(ppq--fetch-models-async)
|
|
(ppq--fetch-balance-async))
|
|
|
|
(provide 'ppq-status)
|
|
|
|
;;; ppq-status.el ends here
|