;;;; main.lisp -- client actions ;; Copyright (C) 2022 Colin Okay ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU Affero 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 Affero General Public License for more details. ;; You should have received a copy of the GNU Affero General Public License ;; along with this program. If not, see . (in-package :oneliners.cli) ;;; UTILITIES (defun cache-and-print-search-response (json) "Takes a json string and parses it. Using the parse results, create ONELINER instances. Print those using PRINT-ONELINER-RESULT-FOR-USER and then ensure the cache is updated." (merge-oneliners (loop for oneliner-plist in (getf (jonathan:parse json) :oneliners) for oneliner = (apply #'make-oneliner oneliner-plist) collect oneliner do (print-oneliner-result-for-user oneliner)))) (defmacro when-oneliner ((var name-or-id) &body body) "Finds the oneliner with name-or-id and binds it to var before running the body. If such a oneliner can be found." (assert (symbolp var)) (let ((nvar (gensym))) `(let ((,nvar ,name-or-id)) (a:when-let (,var (the-oneliner ,nvar)) ,@body)))) ;;; SEARCHING FOR ONELINERS (defun search-for-oneliners (terms limit &optional not-flagged-p all-flagged-p newestp) (assert (loop for term in terms never (find #\, term)) () "Search terms may not contain commas.") (with-local-state (let ((json (api:get--oneliners :tags (str:join "," terms) :limit limit :notflagged (true-or-false not-flagged-p) :newest (true-or-false newestp) :onlyflagged (true-or-false all-flagged-p)))) (cache-and-print-search-response json)))) (defun the-oneliner (name-or-id) "Get the oneliner with name-or-id. First look in the local cache. If not in the local cache, try to fetch from configured server." (with-local-state (a:if-let ((ol (get-cached name-or-id))) ol (let ((ol (jonathan:parse (api:get--oneliner-entry name-or-id)))) (merge-oneliners (list ol)) ol)))) ;;; RUNNING ONELINERS (defvar *ol-output-timeout* 1) (defun run-item (ident args &key force-clip (timeout nil timeout-p)) (with-local-state (when-oneliner (ol ident) (let ((*ol-output-timeout* (if timeout-p timeout *ol-output-timeout*))) (bind-vars-and-run-oneliner ol args force-clip))))) (defun bind-vars-and-run-oneliner (ol args &optional force-clip) (let* ((oneliner (oneliner-oneliner ol)) (runstyle (oneliner-runstyle ol)) (pos-args (collect-positional-arguments oneliner)) (named-args (collect-named-arguments oneliner))) (when (or (not (oneliner-isflagged ol)) (y-or-n-p "This oneliner is flagged. Are you sure you want to run it?")) ;; substitute positional args (loop for param in pos-args for arg in args do (setf oneliner (str:replace-all param arg oneliner))) ;; substitute named args (setf args (mapcar (lambda (s) (str:split "=" s)) (nthcdr (length pos-args) args))) (loop for var in named-args for bound = (assoc (subseq var 1) args :test #'equal) when bound do (setf oneliner (str:replace-all var (second bound) oneliner))) (handle-run-oneliner oneliner (or force-clip (equalp runstyle "manual")))))) (defun handle-run-oneliner (ol &optional clip) (if clip (progn (trivial-clipboard:text ol) (format t "Copied oneliner to clipboard~%")) (progn (format t "Attempting to run:~%") (princ ol) (princ #\newline) (princ #\newline) (run-with-shell ol :shell-name (or (config-shell *config*) "bash"))))) ;; (defun make-fresh-config () ;; (format t "No configuration file has been found. Running Setup~%~%") ;; (setf *config* ;; (make-config ;; :host (prompt "Oneliner Instance Host: " ;; :prefill "https://api.oneliners.wiki") ;; :shell (prompt "With which shell should commands be run: " ;; :prefill "bash"))) ;; (write-config-to-disk) ;; (format t "Configuration has been written to ~a~%. Edit this at any time.~%~%" ;; (config-file))) ;; (defun fetch-config-from-disk () ;; (let ((conf ;; (uiop:with-safe-io-syntax () ;; (uiop:read-file-form (config-file))))) ;; (assert (valid-config-p conf) () "Invalid configuration file") ;; (setf *config* conf))) ;; (defun ensure-config () ;; (unless (uiop:file-exists-p (config-file)) ;; (make-fresh-config)) ;; (fetch-config-from-disk)) ;; ;;; UTILITIES ;; ;; (defun cached-result (n) ;; ;; (when (uiop:file-exists-p (cached-oneliners-file)) ;; ;; (let ((contents (with-open-file (input (cached-oneliners-file)) (read input)))) ;; ;; (etypecase n ;; ;; (integer ;; ;; (find n contents :key (lambda (x) (getf x :id)))) ;; ;; (string ;; ;; (find n contents :key (lambda (x) (getf x :name)) :test #'equal)))))) ;; ;;; API REQUEST FUNCTIONS ;; (defun the-oneliner (name-or-id) ;; "Get the oneliner with name-or-id. Try to fetch from local cache, ;; and, failing that, try to fetch from configured server." ;; (a:if-let ((ol (cached-result name-or-id))) ;; ol ;; (progn ;; (ensure-config) ;; (a:when-let (ol ;; (api:request-with (:host (host)) ;; (jonathan:parse ;; (api:get--oneliner-entry name-or-id)))) ;; (merge-into-cache (list ol)) ;; ol)))) ;; (defun flag-item (ident) ;; (with-oneliner (ol ident) ;; (ensure-config) ;; (api:request-with ;; (:host (host)) ;; (api:put--oneliner-entry-flag (getf ol :id) :token (api-token) :value "true")))) ;; (defun unflag-item (item-number) ;; (with-oneliner (ol item-number) ;; (ensure-config) ;; (api:request-with ;; (:host (host)) ;; (api:put--oneliner-entry-flag (getf ol :id) :token (api-token) :value "false")))) ;; (defun lock-item (item-number) ;; (with-oneliner (ol item-number) ;; (ensure-config) ;; (api:request-with ;; (:host (host)) ;; (api:put--oneliner-oneliner-locked (getf ol :id) :token (api-token) :value "true")))) ;; (defun unlock-item (item-number) ;; (with-oneliner (ol item-number) ;; (ensure-config) ;; (api:request-with ;; (:host (host)) ;; (api:put--oneliner-oneliner-locked (getf ol :id) :token (api-token) :value "false")))) ;; ;;; PRINTING ONELINERS ;; (defun print-item-explanation (name-or-number) ;; (with-oneliner (ol name-or-number) ;; (set-term-width) ;; (print-oneliner-result-for-user ol) ;; (a:when-let (explanation (getf ol :explanation)) ;; (format t "EXPLANATION:~%~%") ;; (princ ;; (string-trim ;; '(#\newline #\space #\tab) ;; (if (str:starts-with? (getf ol :oneliner) explanation) ;; (subseq explanation (length (getf ol :oneliner))) ;; explanation))) ;; (terpri)))) ;; (defun tags-from-oneliner (string) ;; "Splits a string using consequitive whitespace as a separator, ;; returning a set of tags" ;; (remove-duplicates ;; (remove-if-not #'executable-on-system-p (ppcre:split " +" string)) ;; :test #'equal)) ;; (defun add-new-oneliner () ;; (ensure-config) ;; (assert (api-token) () "Cannot add a oneliner without an api token.") ;; (let* ((oneliner ;; (prompt "Oneliner: " ;; :expect 'valid-oneliner-string-p ;; :retry-text "Oneliners must contain at least one command: ")) ;; (name ;; (string-trim ;; '(#\space #\newline #\tab #\linefeed) ;; (prompt "Name (leave blank for none): " ;; :expect 'valid-oneliner-name-p ;; :retry-text "Must begin with a letter contain only letters, numbers, - and _."))) ;; (init-tags ;; (tags-from-oneliner oneliner)) ;; (brief ;; (prompt "Brief Description: " ;; :expect 'valid-brief-description-p ;; :retry-text "Too long. Must be <= 72 characters: ")) ;; (tags ;; (progn ;; (format t "Tags include: ~{~a ~}~%" init-tags) ;; (append init-tags ;; (ppcre:split " +" ;; (prompt "More tags here, or Enter to skip: "))))) ;; (runstyle ;; (string-upcase ;; (prompt "Runstyle (auto or manual): " ;; :expect 'valid-runstyle-p ;; :retry-text "Must be (auto or manual): " ;; :prefill "auto"))) ;; (explanation ;; (when (y-or-n-p "Provide an explanation?") ;; (string-from-editor ;; (format nil "~a~%~%" oneliner))))) ;; (api:request-with ;; (:host (host) ;; :body (jonathan:to-json ;; (list :oneliner oneliner ;; :name (if (plusp (length name)) name :null) ;; :tags tags ;; :brief brief ;; :explanation explanation ;; :runstyle runstyle)) ;; :content-type "application/json") ;; (api:post--oneliner :token (api-token)) ;; (format t "Added~%")))) ;; (defun edit-item (ident) ;; (with-oneliner (ol ident) ;; (ensure-config) ;; (assert (api-token) () "Cannot edit a oneliner without an api token.") ;; (let* ((oneliner ;; (prompt "Oneliner: " ;; :expect 'valid-oneliner-string-p ;; :retry-text "Oneliners must contain at least one command: " ;; :prefill (getf ol :oneliner))) ;; (name ;; (string-trim ;; '(#\space #\newline #\tab #\linefeed) ;; (prompt "Name (leave blank for none): " ;; :expect 'valid-oneliner-name-p ;; :retry-text "Must begin with a letter contain only letters, numbers, - and _." ;; :prefill (if (getf ol :name) (getf ol :name) "")))) ;; (brief ;; (prompt "Brief Description: " ;; :expect 'valid-brief-description-p ;; :retry-text "Too long. Must be <= 72 characters: " ;; :prefill (getf ol :brief))) ;; (init-tags ;; (tags-from-oneliner oneliner)) ;; (tags ;; (progn ;; (format t "Tags include: ~{~a ~}~%" init-tags) ;; (append init-tags ;; (ppcre:split " +" ;; (prompt "More tags here, or Enter to skip: " ;; :prefill (str:join " " ;; (set-difference ;; (getf ol :tags) ;; init-tags ;; :test 'equal))))))) ;; (runstyle ;; (string-upcase ;; (prompt "Runstyle (auto or manual): " ;; :expect 'valid-runstyle-p ;; :retry-text "Must be (auto or manual): " ;; :prefill (getf ol :runstyle)))) ;; (explanation ;; (when (y-or-n-p "Provide an explanation?") ;; (string-from-editor (getf ol :explanation))))) ;; (let ((new-item ;; (list :oneliner oneliner ;; :tags tags ;; :brief brief ;; :name (if (plusp (length name)) name :null) ;; :explanation explanation ;; :runstyle runstyle))) ;; (api:request-with ;; (:host (host) ;; :body (jonathan:to-json ;; new-item) ;; :content-type "application/json") ;; (api:patch--oneliner-entry-edit (getf ol :id) :token (api-token)) ;; (update-cached-item new-item) ;; (format t "OK~%")))))) ;; (defun request-invite-code () ;; (ensure-config) ;; (api:request-with ;; (:host (host)) ;; (let ((invite (jonathan:parse (api:post--invite :token (api-token))))) ;; (format t "Invite Code: ~a~%Expires: ~a~%" ;; (getf invite :code) ;; (getf invite :expires))))) ;; (defun login (user pass) ;; (ensure-config) ;; (a:when-let (response (jonathan:parse ;; (api:request-with ;; (:host (host) ;; :body (jonathan:to-json (list :password pass :handle user)) ;; :content-type "application/json") ;; (api:post--access)))) ;; (setf (api-token) (getf response :token) ;; (contributor-handle) user) ;; (write-config-to-disk) ;; (format t "Access token written to ~a~%You may now make contributions to the wiki!.~%" ;; (config-file)))) ;; (defun change-pw (current new repeated) ;; (unless (equal new repeated) ;; (error "The new password doesn't match the repeated value. Double check.")) ;; (ensure-config) ;; (api:request-with ;; (:host (host)) ;; (api:put--contributor-who-password (contributor-handle) ;; :token (api-token) ;; :value new ;; :repeated new ;; :current current))) ;; (defparameter +agree-to-the-unlicense+ ;; "By creating this contributor account, I agree that my contributions ;; be released into the public domain, for the benefit of the public at ;; large, and to the detriment of my heirs and successors. I intend ;; this dedication to be an overt act of relinquishment in perpetuity ;; of all present and future rights to my contributions under software ;; copyright law copyright law. More specifically, I agree to release all of my ;; contributions using The Unlicense. (see https://unlicense.org/)") ;; (defun prompt-for-signature () ;; (if (y-or-n-p "Provide a contributor signature about yourself? ") ;; (prompt "Go ahead: ") ;; "")) ;; (defun change-signature () ;; (let ((new-sig ;; (prompt-for-signature))) ;; (ensure-config) ;; (api:request-with ;; (:host (host) ;; :body (jonathan:to-json (list :signature new-sig)) ;; :content-type "application/json") ;; (api:put--contributor-who-signature (contributor-handle) :token (api-token)) ;; (format t "Your signature was changed.~%")))) ;; (defun print-contributor (contributor) ;; (format t "~20a ~@[-- ~a~]~%" ;; (getf contributor :handle) ;; (getf contributor :signature))) ;; (defun show-contributor (name) ;; (ensure-config) ;; (api:request-with ;; (:host (host)) ;; (a:when-let (contributor ;; (api:get--contributor-who name)) ;; (print-contributor (jonathan:parse contributor))))) ;; (defun redeem-invite (token name pass) ;; (ensure-config ) ;; (when (yes-or-no-p +agree-to-the-unlicense+) ;; (api:request-with ;; (:host (host) ;; :body (jonathan:to-json (list :handle name ;; :password1 pass :password2 pass ;; :signature (prompt-for-signature))) ;; :content-type "application/json") ;; (api:post--invite-redeem-code token) ;; (format t "Account made for ~a. You may log in now~%" name)))) ;; ;;TODO: check this .. shouldnt access be a username??? ;; (defun revoke-access () ;; (ensure-config) ;; (api:request-with ;; (:host (host)) ;; (api:delete--access-access (api-token) :token (api-token)) ;; (format t "You were logged out~%"))) ;; (defun update-cached-item (item) ;; (merge-into-cache (list item))) ;; (defun newest-oneliners (&optional limit) ;; (ensure-config) ;; (api:request-with ;; (:host (host)) ;; (let ((response ;; (if limit ;; (api:get--oneliners-newest :limit limit) ;; (api:get--oneliners-newest)))) ;; (cache-and-print-search-response response)))) ;; (defun all-flagged-oneliners (&optional limit) ;; (ensure-config) ;; (api:request-with ;; (:host (host)) ;; (let ((response ;; (if limit ;; (api:get--oneliners-all-flagged :limit limit) ;; (api:get--oneliners-all-flagged)))) ;; (cache-and-print-search-response response)))) ;; ;;; RUNNING THINGS IN THE SHELL.