From 61a460b2dfb81b64e0b592d531b1256fa0f467f5 Mon Sep 17 00:00:00 2001 From: Jiri Jakes Date: Fri, 13 Mar 2026 00:06:44 -0300 Subject: [PATCH] Introduce ppq-status --- ppq-status.el | 357 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 357 insertions(+) create mode 100644 ppq-status.el diff --git a/ppq-status.el b/ppq-status.el new file mode 100644 index 0000000..554f7ec --- /dev/null +++ b/ppq-status.el @@ -0,0 +1,357 @@ +;;; 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 . + +;;; 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: Fruits --- + +(defvar ppq-fruits-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map tabulated-list-mode-map) + (define-key map "q" #'ppq-quit) + map)) + +(define-derived-mode ppq-fruits-mode tabulated-list-mode "Fruits" + "A table of fruits." + (setq tabulated-list-format [("Fruit" 15 t) ("Color" 10 t) ("Taste" 10 t)]) + (setq tabulated-list-entries + '((1 ["Apple" "Red" "Sweet"]) + (2 ["Banana" "Yellow" "Sweet"]) + (3 ["Lemon" "Yellow" "Sour"]) + (4 ["Grape" "Purple" "Sweet"]))) + (tabulated-list-init-header) + (tabulated-list-print)) + +;; --- 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--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-id) + map)) + +(defun ppq-models-copy-id () + "Copy the ID of the current model to clipboard." + (interactive) + (when tabulated-list-entries + (let* ((entry (tabulated-list-get-entry)) + (id (aref entry 1))) + (kill-new id) + (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) + (list (ppq--aget model 'id) + (vector + (propertize (or (ppq--aget model 'name) "N/A") 'font-lock-face nil) + (propertize (or (ppq--aget model 'id) "N/A") 'font-lock-face nil) + (propertize (ppq--format-created-at (ppq--aget model 'created_at)) 'font-lock-face nil) + (propertize (ppq--format-context-length (ppq--aget model 'context_length)) 'font-lock-face nil) + (propertize (ppq--format-pricing model) 'font-lock-face 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) + (dolist (buf (list (get-buffer "*Dashboard:Fruits*") + (get-buffer "*Dashboard:Models*") + (get-buffer "*Dashboard:Info*"))) + (when buf (kill-buffer buf))) + (setq ppq--models-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 ((fruits-buf (get-buffer-create "*Dashboard:Fruits*")) + (models-buf (get-buffer-create "*Dashboard:Models*")) + (org-buf (get-buffer-create "*Dashboard:Info*"))) + + (with-current-buffer fruits-buf + (ppq-fruits-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 :: Fruits of the world\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 fruits-buf) + (set-window-buffer top-right models-buf) + (set-window-buffer bottom org-buf)) + + (select-window (get-buffer-window fruits-buf))) + + (ppq--fetch-models-async) + (ppq--fetch-balance-async)) + +(provide 'ppq-status) + +;;; ppq-status.el ends here