;;; 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--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-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) (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) (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