commit e0c383ed99aaceba8c078b507bdf76910f0a3bfb
Author: Simon Watson <spesk@pm.me>
Date: Tue Dec 20 10:43:20 2022 -0500
Uploads and downloads working
Also updated a few other things. Included table printing
from https://gist.github.com/WetHat/a49e6f2140b401a190d45d31e052af8f
and cleaned a few things up.
diff --git a/fin-lisp.lisp b/fin-lisp.lisp
index 317ed83..d0d92c4 100644
--- a/fin-lisp.lisp
+++ b/fin-lisp.lisp
@@ -11,10 +11,10 @@
;;; - Added in again to retest some things
;;; - Interactive prompt to manage expenses
;;; - Generic expense handling
+;;; - Encryption/decryption of old records
+;;; - Upload/download support like perl version
;;; 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
@@ -30,8 +30,54 @@
(defvar *api-url* NIL)
(defvar *api-key* NIL)
-(defun file-test (filename)
- (if (probe-file filename) filename (print "Couldn't find filename")))
+;;; Taken from: https://gist.github.com/WetHat/a49e6f2140b401a190d45d31e052af8f
+;;; Used for pretty printing output
+(defconstant +CELL-FORMATS+ '(:left "~vA"
+ :center "~v:@<~A~>"
+ :right "~v@A"))
+
+(defun format-table (stream data &key (column-label (loop for i from 1 to (length (car data))
+ collect (format nil "COL~D" i)))
+ (column-align (loop for i from 1 to (length (car data))
+ collect :left)))
+ (let* ((col-count (length column-label))
+ (strtable (cons column-label ; table header
+ (loop for row in data ; table body with all cells as strings
+ collect (loop for cell in row
+ collect (if (stringp cell)
+ cell
+ ;else
+ (format nil "~A" cell))))))
+ (col-widths (loop with widths = (make-array col-count :initial-element 0)
+ for row in strtable
+ do (loop for cell in row
+ for i from 0
+ do (setf (aref widths i)
+ (max (aref widths i) (length cell))))
+ finally (return widths))))
+ ;------------------------------------------------------------------------------------
+ ; splice in the header separator
+ (setq strtable
+ (nconc (list (car strtable) ; table header
+ (loop for align in column-align ; generate separator
+ for width across col-widths
+ collect (case align
+ (:left (format nil ":~v@{~A~:*~}"
+ (1- width) "-"))
+ (:right (format nil "~v@{~A~:*~}:"
+ (1- width) "-"))
+ (:center (format nil ":~v@{~A~:*~}:"
+ (- width 2) "-")))))
+ (cdr strtable))) ; table body
+ ;------------------------------------------------------------------------------------
+ ; Generate the formatted table
+ (let ((row-fmt (format nil "| ~{~A~^ | ~} |~~%" ; compile the row format
+ (loop for align in column-align
+ collect (getf +CELL-FORMATS+ align))))
+ (widths (loop for w across col-widths collect w)))
+ ; write each line to the given stream
+ (dolist (row strtable)
+ (apply #'format stream row-fmt (mapcan #'list widths row))))))
;;; Used by "print-month" arg to validate
;;; the user provided a valid key
@@ -43,14 +89,9 @@
: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
+ :shora #\p
:long "print-month"
:arg-parser #'check-month)
(:name :interactive-mode
@@ -67,10 +108,12 @@
(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))
+(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))
;;;;;;;;;;;;;;;;;;;;;;;;
;;; Encryption stuff ;;;
@@ -87,59 +130,42 @@
: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))))
+(defun encrypt-records (key)
+ (let* ((cipher (get-cipher key))
+ (content (ironclad:ascii-string-to-byte-array (with-output-to-string (json)
+ (yason:encode *records* json)))))
+ (ironclad:encrypt-in-place cipher content)
+ (write-to-string (ironclad:octets-to-integer content))))
+
+(defun decrypt-records (key enc-record-string)
+ (let ((cipher (get-cipher key)))
+ (let ((content (ironclad:integer-to-octets (parse-integer enc-record-string))))
(ironclad:decrypt-in-place cipher content)
(coerce (mapcar #'code-char (coerce content 'list)) 'string))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; End Encryption Stuff ;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(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))
-;;; 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 upload-records (enc-records-string)
+ (let* ((api-config (parse-api-config *api-config-path*))
+ (result (dex:post (concatenate 'string (first api-config) "upload")
+ :headers (list (cons "X-Token" (second api-config))
+ (cons "Content-Type" "application/json"))
+ :content (concatenate 'string "{\"content\": \"" enc-records-string "\"}"))))
+ result))
+
+;;; Serialization and communicating with the web API
+(defun push-records (key)
+ "Upload records to remote server"
+ (upload-records (encrypt-records key)))
+
+(defun get-records (key)
+ "Get records from remote server"
+ (setf *records* (yason:parse (decrypt-records key (gethash "content" (download-records))))))
-(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))
@@ -168,47 +194,32 @@
;;; 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))
+ (format t "~C" #\linefeed)
+ (format t "~a~C" month-key #\linefeed)
+ (dolist (exp-key exp-keys)
+ (format t "~a : ~a~C" exp-key (gethash exp-key month-hash) #\linefeed))
+ (format t "~C" #\linefeed)))
+
+;;; Given key for *records* hash,
+;;; print expenses/values for month
+(defun dump-month-table (month-key)
+ (let* ((month-hash (gethash month-key *records*))
+ (exp-keys (loop for key being the hash-keys of month-hash collect key))
+ (flist))
(dolist (exp-key exp-keys)
- (format t "~a : ~a~C" exp-key (gethash exp-key month-hash) #\linefeed))))
+ (setq flist (append flist (list (list exp-key (gethash exp-key month-hash))))))
+ (format-table T flist :column-label '("Expense" "Amount"))))
+
;;; 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)
@@ -224,8 +235,8 @@
(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 "3. Push records~%")
+ (format t "4. Get records~%")
(format t "5. Quit~%")
(let
((answer (prompt-read "Select an option")))
@@ -235,20 +246,18 @@
"Invalid Input"))
(if (string= answer "2")
(generic-handler
- (dump-month (prompt-read "Enter month"))
- "Invalid month"))
+ (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"))
+ (push-records (prompt-read "Enter encryption key"))
"Serialization error or invalid filename"))
(if (string= answer "4")
(generic-handler
- (deserialize-records (prompt-read "Enter decryption key")
- (prompt-read "Enter filename"))
+ (get-records (prompt-read "Enter decryption key"))
"Deserialization error or invalid filename"))
(if (string= answer "5")
- (quit)))
+ (return-from interactive-mode nil)))
(interactive-mode))
(defun display-help ()
@@ -271,4 +280,36 @@
(progn
(interactive-mode)
(quit))))))
-
+
+;;; 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 ()
+ "Used for debugging, just resets the *records* hash to NIL"
+ (setf *records* (make-hash-table :test 'equal)))
+