aboutsummaryrefslogtreecommitdiff
path: root/lib/client.lisp
diff options
context:
space:
mode:
authorColin Okay <okay@toyful.space>2022-03-11 08:43:17 -0600
committerColin Okay <okay@toyful.space>2022-03-11 08:43:17 -0600
commite73fed7afb45d37a248f7b95d4a51bb4807a14a2 (patch)
tree4d1b1e80c3b3125bd6f5cb1d902e965599d64627 /lib/client.lisp
parent08ba2769abb7a36817a725d30d64cfd36f5bcf32 (diff)
agpl notices; s/lib/client; updated asd
Diffstat (limited to 'lib/client.lisp')
-rw-r--r--lib/client.lisp451
1 files changed, 451 insertions, 0 deletions
diff --git a/lib/client.lisp b/lib/client.lisp
new file mode 100644
index 0000000..f49201a
--- /dev/null
+++ b/lib/client.lisp
@@ -0,0 +1,451 @@
+;;;; main.lisp -- oneliners.cli entrypoint
+
+;; 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 <http://www.gnu.org/licenses/>.
+(in-package :oneliners.cli)
+
+;;; CONFIG AND RESULTS FILE LOCATIONS
+
+(defvar *ol-output-timeout* 1)
+
+(defun run-item (ident args &key force-clip (timeout nil timeout-p))
+ (with-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
+ (ensure-config)
+ (format t "Attempting to run:~%")
+ (princ ol)
+ (princ #\newline)
+ (princ #\newline)
+ (run-with-shell ol :shell-name (or (get-shell) "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))))))
+
+
+(defmacro with-oneliner ((var name-or-id) &body body)
+ (assert (symbolp var))
+ (let ((nvar (gensym)))
+ `(let ((,nvar ,name-or-id))
+ (a:if-let (,var (the-oneliner ,nvar))
+ (progn ,@body)
+ (format t "Could not find the oneliner specified by ~a~%" ,nvar)))))
+
+
+
+
+
+;;; 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 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 print-oneliner-result-for-user (oneliner)
+ (unless *term-width* (set-term-width)) ; setting here as a fallback, can set it elswere if desired.
+ (let* ((title-line-format-str
+ (concatenate 'string "~" (prin1-to-string *term-width*) "<[~a]~;~a~;~a~>~%"))
+ (tags-line-format-string
+ (concatenate 'string "~" (prin1-to-string *term-width*) "<~a~;by ~a~>~%")))
+ (loop repeat *term-width* do (princ #\_))
+ (terpri)
+ (format t title-line-format-str
+ (getf oneliner :id)
+ (or (getf oneliner :name) " ")
+ (format nil "~:[ ~;⚠~]~:[ ~;🔒~]~:[ ~;📋~]"
+ (getf oneliner :isflagged)
+ (getf oneliner :islocked)
+ (equalp "manual" (getf oneliner :runstyle))))
+ (format t tags-line-format-string
+ (format nil "tags: ~{~a~^ ~}"
+ (getf oneliner :tags))
+ (getf oneliner :createdby))
+ (loop
+ with brief = (getf oneliner :brief)
+ for x from 0 to (length brief) by *term-width*
+ do (format t "~a~%"
+ (string-trim '(#\space)
+ (alexandria-2:subseq* brief x (+ x *term-width*)))))
+ (format t "~%~a~%~%" (getf oneliner :oneliner))))
+
+(defun cache-and-print-search-response (response)
+ (merge-into-cache
+ (loop for oneliner in (getf (jonathan:parse response) :oneliners)
+ collect oneliner
+ do (print-oneliner-result-for-user oneliner))))
+
+(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))))
+
+(defun search-for-oneliners (terms limit not-flagged-p all-flagged-p newestp)
+ (assert (loop for term in terms never (find #\, term) ))
+ (set-term-width)
+ (ensure-config)
+ (let ((response
+ (api:request-with
+ (:host (host))
+ (api:get--oneliners :tags (str:join "," terms)
+ :limit limit
+ :notflagged (if not-flagged-p "true" "false")
+ :newest (if newestp "true" "false")
+ :onlyflagged (if all-flagged-p "true" "false")))))
+ (cache-and-print-search-response response)))
+
+;;; RUNNING THINGS IN THE SHELL.
+