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)

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

(defun search-for-oneliners (terms limit not-flagged-p all-flagged-p newestp)

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



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



;;; RUNNING THINGS IN THE SHELL.