fin-lisp/fin-lisp.lisp

;;;(ql:quickload "cl-store")
(ql:quickload "yason")
(ql:quickload "cl-ppcre")
(ql:quickload "unix-opts")
(ql:quickload "ironclad")
(ql:quickload "dexador")

;;; Features
;;; - Import records from old .txt format
;;;   - Removed as I'll never use it again
;;;     - Added in again to retest some things
;;; - Interactive prompt to manage expenses
;;; - Generic expense handling
;;; TODO
;;; - Non interactive CLI Interface
;;; - Upload/download support like perl version
;;;   - Should support encryption/decryption of records - DONE
;;; - Interface is not good, and doesn't protect the user from
;;;   data entry mistakes

;;;; Reimplementation of my bills tracker in Lisp

;;; All records exist in this data structure
;;; nil on start and loaded in from file
;;; *records* represents as hash of months,
;;; where the key is the month stamp, eg 20210701
;;; and the value is the monthly expenses hash
(defvar *records* (make-hash-table :test 'equalp))
(defvar *api-config-path* "./auth.json")
(defvar *api-url* NIL)
(defvar *api-key* NIL)

(defun file-test (filename)
  (if (probe-file filename) filename (print "Couldn't find filename")))

;;; Used by "print-month" arg to validate
;;; the user provided a valid key
(defun check-month (month-key)
  (if (stringp month-key) month-key))

(opts:define-opts
  (:name :help
   :description "Print help text"
   :short #\h
   :long "help")
  (:name :read
   :description "Read serialized records file"
   :short #\r
   :long "read"
   :arg-parser #'file-test)
  (:name :print-month
   :description "Print records for given month"
   :short #\p
   :long "print-month"
   :arg-parser #'check-month)
  (:name :interactive-mode
   :description "Run in interactive mode"
   :short #\i
   :long "interactive"))

;; See: https://github.com/libre-man/unix-opts/blob/master/example/example.lisp
(defmacro when-option ((options opt) &body body)
  `(let ((it (getf ,options ,opt)))
     (when it
       ,@body)))

(defun reload ()
  (load "~/Repos/fin-lisp/fin-lisp.lisp"))

(defun wfile (file-content file-path)
  (alexandria:write-string-into-file
   (concatenate 'string file-content) file-path :if-exists :overwrite
						:if-does-not-exist :create))

;;;;;;;;;;;;;;;;;;;;;;;;
;;; Encryption stuff ;;;
;;;;;;;;;;;;;;;;;;;;;;;;
;;; See: https://www.cliki.net/Ironclad

;;; Return cipher when provided key
;;; Currently, this is 'insecure' as we are using a string
;;; coerced into a byte array as the key, aka a non-random secret.
;;; Should use twofish
(defun get-cipher (key)
  (ironclad:make-cipher
   :blowfish
   :mode :ecb
   :key (ironclad:ascii-string-to-byte-array key)))

;;; First serialize the file,
;;; then encrypt it from disk
(defun encrypt-records (key filename)
  (let ((cipher (get-cipher key))
	(file-content (uiop:read-file-string filename)))
    (let ((content (ironclad:ascii-string-to-byte-array file-content)))
      (ironclad:encrypt-in-place cipher content)
      (wfile
       (write-to-string (ironclad:octets-to-integer content))
       (concatenate 'string filename ".enc")))))

(defun decrypt-records (key filename)
  (let ((cipher (get-cipher key))
	(file-content (uiop:read-file-string filename)))
    (let ((content (ironclad:integer-to-octets (parse-integer file-content))))
      (ironclad:decrypt-in-place cipher content)
      (coerce (mapcar #'code-char (coerce content 'list)) 'string))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; End Encryption Stuff ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Can only be called from the REPL,
;;; used for importing according to the old schema
(defun import-records (filename)
  (let ((old-file-lines
	  (with-open-file (stream filename)
	    (loop for line = (read-line stream nil)
		  while line
		  collect line)))
	(mre (ppcre:create-scanner "^(.*)[0-9]{4}$"))
	(ere (ppcre:create-scanner "^([A-Z].*)\ -\ \\\$([0-9]{1,4}) - PAID"))
	(cur-mon)
	(cur-exp))
    (loop for line in old-file-lines
	  do (progn
	       (if (ppcre:scan mre line) (setf cur-mon line))
	       (if (ppcre:scan ere line)
		   (progn
		     (setf cur-exp (ppcre:register-groups-bind (first second) (ere line) :sharedp t (list first second)))
		     (print cur-exp)
		     (if (gethash cur-mon *records*)
			 (let ((innerhash (gethash cur-mon *records*)))
			   (setf (gethash (first cur-exp) innerhash) (second cur-exp))))
		     (if (not (gethash cur-mon *records*))
			 (progn
			   (add-month cur-mon)
			   (let ((innerhash (gethash cur-mon *records*)))
			     (setf (gethash (first cur-exp) innerhash) (second cur-exp)))))))))))

(defun reset-records ()
  (setf *records* (make-hash-table :test 'equal)))
  
;; Called like: (add-month '202107)
(defun add-month (month-key)
  (setf (gethash month-key *records*) (make-hash-table :test 'equalp))
  month-key)

;;; Taken from practical common lisp
(defun prompt-read (prompt)
  (format *query-io* "~a: " prompt)
  (force-output *query-io*)
  (read-line *query-io*))

(defun prompt-for-expense ()
  (list
   (prompt-read "Enter expense name")
   (parse-integer
    (prompt-read "Enter expense value"))))

(defun add-expense-to-month (month)
  (if (gethash month *records*)
      (let ((innerhash (gethash month *records*))
	    (exp-l (prompt-for-expense)))
	(setf (gethash (first exp-l) innerhash) (second exp-l)))
      ;;NIL))
      (add-expense-to-month (add-month month))))

;;; Given key for *records* hash,
;;; print expenses/values for month
(defun dump-month (month-key)
  (format t "~a~C" month-key #\linefeed)
  (let ((month-hash)
	(exp-keys))
    (setf month-hash (gethash month-key *records*))
    (setf exp-keys (loop for key being the hash-keys of month-hash collect key))
    (dolist (exp-key exp-keys)
      (format t "~a : ~a~C" exp-key (gethash exp-key month-hash) #\linefeed))))

;;; Dump all records.
(defun dump-records ()
  (let ((record-key-list (loop for key being the hash-keys of *records* collect key)))
    (dolist (month-key record-key-list) (dump-month month-key))))

;;; Serialization and communicating with the web API
(defun serialize-records (key filename)
  (with-open-file (stream filename
			  :direction :output
			  :if-exists :overwrite
			  :if-does-not-exist :create)
    (yason:encode *records* stream))
  (encrypt-records key filename)
  (delete-file filename))

(defun deserialize-records (key filename)
  (setf *records* (yason:parse (decrypt-records key filename))))

(defun parse-api-config (path)
  (let ((api-config-hash (yason:parse (uiop:read-file-string path)))
	(ret-tuple '()))
    (push (gethash "token" api-config-hash) ret-tuple)
    (push (gethash "url" api-config-hash) ret-tuple)
    ret-tuple))

(defun download-records ()
  (let* ((api-config (parse-api-config *api-config-path*))
	(dl-records (yason:parse (dex:get (concatenate 'string (first api-config) "download")
					  :headers (list (cons "X-Token" (second api-config)))))))
    dl-records))

(defun upload-records (records-file))

(defmacro generic-handler (form error-string)
  `(handler-case ,form
    (error (e)
      (format t "Invalid input: ~a ~%" ,error-string)
      (values 0 e))))

;; Util screen clearer
(defun cls()
  (format t "~A[H~@*~A[J" #\escape))

(defun interactive-mode ()
  (format t "~%")
  (format t "Available options:~%")
  (format t "1. Enter expense~%")
  (format t "2. Display month~%")
  (format t "3. Write records~%")
  (format t "4. Read records~%")
  (format t "5. Quit~%")
  (let
      ((answer (prompt-read "Select an option")))
    (if (string= answer "1")
	(generic-handler
	 (add-expense-to-month (prompt-read "Enter month"))
	 "Invalid Input"))
    (if (string= answer "2")
	(generic-handler
	 (dump-month (prompt-read "Enter month"))
	 "Invalid month"))
    (if (string= answer "3")
	(generic-handler
	 (serialize-records (prompt-read "Enter encryption key")
			    (prompt-read "Enter filename"))
	 "Serialization error or invalid filename"))
    (if (string= answer "4")
	(generic-handler
	 (deserialize-records (prompt-read "Enter decryption key")
			      (prompt-read "Enter filename"))
	 "Deserialization error or invalid filename"))
    (if (string= answer "5")
	(quit)))
  (interactive-mode))

(defun display-help ()
  (format t "foo ~%")
  (opts:describe
   :prefix "fin-lisp.lisp - Basic expense tracker in lisp"
   :usage-of "fin-lisp.lisp"
   :args "[FREE-ARGS]")
  (quit))

;; Entry point
(defun main ()
  (if (= 1 (length sb-ext:*posix-argv*)) (interactive-mode))
  (let ((matches (opts:get-opts)))
    (format t "~a ~%" matches)
    (when-option (matches :help)
      (display-help))
    (when-option (matches :print-month)
    (when-option (matches :interactive-mode)
      (progn
	(interactive-mode)
	(quit))))))