path: root/lib/client.lisp

;;;; 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 <http://www.gnu.org/licenses/>.
(in-package :oneliners.cli)

;;;;                >>>>>NOTE WHILE HACKING<<<<<.
;;;; ----------------------------------------------------------------
;;;; Each of the functions below that make HTTP requests are meant to
;;;; be called within the body of a WITH-LOCAL-STATE form.  If you are
;;;; hacking in the REPL, make sure to wrap function calls
;;;; appropriately.
;;;; ----------------------------------------------------------------


;;; GETTING ONELINERS & DISPLAYING 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.")
  (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."
  (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)))

(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."
  (let ((nvar (gensym)))
    `(let ((,nvar ,name-or-id))
       (a:when-let (,var (the-oneliner ,nvar))
         ,@body))))

(defmacro when-draft ((var name) &body body)
  "Like when-oneliner but restricts itself to local drafts."
  (let ((nvar (gensym)))
    `(let ((,nvar ,name))
       (a:when-let (,var (fetch-draft ,nvar))
         ,@body))))

(defun newest-oneliners (&optional limit)
  (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)
  (let ((response 
          (if limit
              (api:get--oneliners-all-flagged :limit limit)
              (api:get--oneliners-all-flagged))))
    (cache-and-print-search-response response)))

(defun print-item-explanation (name-or-number)
  (when-oneliner (ol name-or-number)
    (print-oneliner-result-for-user ol)
    (when (plusp (length (remove #\space (oneliner-explanation ol))))
      (loop repeat (floor (/ *term-width* 3)) do (princ " "))
      (let ((tilde-count
              (floor (* 0.5 (- (/ *term-width* 3) (length "NOTES"))))))
        (loop repeat tilde-count do (princ "~"))
        (princ "NOTES")
        (loop repeat tilde-count do (princ "~")))
      (terpri)
      (princ (oneliner-explanation ol)))))

(defun print-drafts ()
  (when *drafts*
    (format t (concatenate 'string "~%~" (prin1-to-string *term-width*) "< ~;DRAFTS~; ~>~%"))
    (dolist (draft *drafts*)
      (format t "Draft Name: ~a~%" (first draft))
      (print-oneliner-result-for-user (rest draft)))))

;;; RUNNING ONELINERS

(defvar *ol-output-timeout* 1)

(defun run-item (ident args &key force-clip (timeout nil timeout-p) draftp verbose confirm)
  "Runs a oneliner identified by IDENT (if available) with arguments ARGS."
  (let ((ol (if draftp (fetch-draft ident) (the-oneliner ident))))
    (when ol
      (let ((*ol-output-timeout* (if timeout-p timeout *ol-output-timeout*)))
        (bind-vars-and-run-oneliner ol args force-clip verbose confirm)))))

(defun bind-vars-and-run-oneliner (ol args &optional force-clip verbose confirm)
  (let* ((oneliner (oneliner-oneliner ol))
         (runstyle (oneliner-runstyle ol))
         (pos-args (get-positional-arguments ol))
         (named-args (get-named-arguments ol)))
    
    (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)))

    (when  (or (not (oneliner-isflagged ol))
               (y-or-n-p "This oneliner is flagged. Are you sure you want to run it?"))
      (when (or verbose confirm) 
        (format t "Attempting to run:~%")
        (princ oneliner)
        (princ #\newline))

      (when (or (not confirm)
                (y-or-n-p "Proceed?")) 
        (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~%"))
      (run-with-shell ol :shell-name (or (shell) "bash") :await-output-p *ol-output-timeout*)))

;;; ADDING ONELINERS

(defun add-new-oneliner ()
  (api-token) ;; fails with error if not set.
  ;; read each field required to make a onelienr in from a prompt.
  (let* ((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 _.")))

         (draft-name
           (if (plusp (length name))
               name
               (prompt "No name was provided, name this draft: "
                       :expect 'valid-oneliner-name-p
                       :retry-text "Must begin with a letter contain only letters, numbers, - and _.")))

         (oneliner-string
           (prompt "Oneliner: "
                   :expect 'valid-oneliner-string-p
                   :retry-text "Oneliners must contain at least one command: "))
         (init-tags
           (parse-oneliner-tags oneliner-string))

         (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-string)))))
    (let ((local
            (make-oneliner
             :oneliner oneliner-string
             :name name 
             :tags tags
             :brief brief
             :explanation explanation
             :runstyle runstyle))) 
      (progn
        (put-draft draft-name local)
        (format t "Saved draft ~a~%" draft-name)))))

;;; EDITING ONELINERS 

(defun edit-item (ident &optional draftp)
  ;;(unless draftp (api-token)) ;; fails with error if not set.
  (let ((ol (if draftp (fetch-draft ident) (the-oneliner ident)))) 
    (let* ((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 (or (oneliner-name ol) ""))))

           (draft-name
             (if (plusp (length name))
                 name
                 (prompt "No name was provided, name this draft: "
                         :expect 'valid-oneliner-name-p
                         :retry-text "Must begin with a letter contain only letters, numbers, - and _.")))           
           (oneliner-string
             (prompt "Oneliner: "
                     :expect 'valid-oneliner-string-p
                     :retry-text "Oneliners must contain at least one command: "
                     :prefill (oneliner-oneliner ol)))
           (brief
             (prompt "Brief Description: "
                     :expect 'valid-brief-description-p
                     :retry-text "Too long. Must be <= 72 characters: "
                     :prefill (oneliner-brief ol)))

           (init-tags
             (parse-oneliner-tags oneliner-string))

           (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
                                                                (oneliner-tags ol)
                                                                init-tags
                                                                :test 'equal)))))))
           (runstyle
             (string-upcase
              (prompt "Runstyle (auto or manual): "
                      :expect 'valid-runstyle-p
                      :retry-text "Must be (auto or manual): "
                      :prefill (oneliner-runstyle ol))))

           (explanation
             (when (y-or-n-p "Alter the explanation?")
               (string-from-editor (oneliner-explanation ol)))))

      (let ((local 
              (make-oneliner
               :id (oneliner-id ol)
               :oneliner oneliner-string
               :name (if (plusp (length name)) name :null)
               :tags tags
               :brief brief
               :explanation explanation
               :runstyle runstyle))) 
        (progn
          (put-draft draft-name local)
          (format t "Saved draft ~a~%" draft-name))))))

(defun publish-draft (name)
  (when-draft (ol name)
    (api:request-with
        (:body (oneliner-to-json-body ol)
         :content-type "application/json")
      (let ((updated
              (jonathan:parse (if (oneliner-id ol)
                                  (api:patch--oneliner-entry-edit (oneliner-id ol) :token (api-token))
                                  (api:post--oneliner :token (api-token))))))
        (merge-oneliners (list updated))
        (drop-draft name)
        (format t "Draft ~a published and removed from drafts.~%" name)))))


;;; ADMIN OF ONELINER ENTRIES

(defun delete-item (ident)
  (when-oneliner (ol ident)
    (api:delete--oneliner-oneliner
     ident
     :token (api-token))
    ;; if we've made it this far no http error has been returned,
    ;; hence we can delete it from the cache
    (remove-from-cache ident)))

(defun flag-item (ident)
  (when-oneliner (ol ident)
    (api:put--oneliner-entry-flag
     ident
     :token (api-token)
     :value "true")
    ;; no http error, so we flag the cached version, ol.
    (setf (oneliner-isflagged ol) t)))

(defun unflag-item (ident)
  (when-oneliner (ol ident) 
    (api:put--oneliner-entry-flag
     ident
     :token (api-token)
     :value "false")
    ;; no http error, so we can unflag the cached version, ol
    (setf (oneliner-isflagged ol) nil)))

(defun lock-item (ident)
  (when-oneliner (ol ident) 
    (api:put--oneliner-oneliner-locked
     ident
     :token (api-token)
     :value "true")
    ;; no http error, so we can lock the cached version, ol
    (setf (oneliner-islocked ol) t)))

(defun unlock-item (ident)
  (when-oneliner (ol ident) 
    (api:put--oneliner-oneliner-locked
     ident
     :token (api-token)
     :value "false")
    ;; no http error, so we can unlock the cached version, ol
    (setf (oneliner-islocked ol) nil)))


;;; ACCOUNT AND INVITE STUFF

(defun request-invite-code ()
  (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)
  (let  ((response
           (jonathan:parse
            (api:request-with
                (:body (jonathan:to-json (list :password pass :handle user))
                 :content-type "application/json") 
              (api:post--access)))))
    (setf (api-token) (getf response :token)
          (handle) user)
    (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."))
  (api:put--contributor-who-password (handle)
                                     :token (api-token)
                                     :value new
                                     :repeated new
                                     :current current))

(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 (handle) :token (api-token))
      (format t "Your signature was changed.~%"))))


(defun show-contributor (name)
  (let ((contributor (api:get--contributor-who name)))
    (print-contributor (jonathan:parse  contributor))))


(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 redeem-invite (token name pass) 
  (when (yes-or-no-p +agree-to-the-unlicense+)
    (api:request-with
        (: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 ()
  (api:delete--access-access  (api-token) :token (api-token))
  (format t "You were logged out~%"))


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


(defun prompt-for-signature ()
  "Just prompt the user for confirmation about whether or not to
change their signature."
  (if (y-or-n-p "Provide a contributor signature about yourself? ")
      (prompt "Go ahead: ")
      ""))



(defun print-contributor (contributor)
  (format t "~20a ~@[-- ~a~]~%"
          (getf contributor :handle)
          (getf contributor :signature)))