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.

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