glenn
/
asteroid
mirror of https://github.com/glenneth1/asteroid.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

fix: add data-model-save wrapper 

This tries to bypass a weird error where native "dm:save" fails with lambdalite.
This commit is contained in:
Luis Pereira 2025-11-15 20:52:14 +00:00 committed by Brian O'Reilly
parent 74088ca47b
commit 8245917b28
2 changed files with 28 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
database.lisp
View File

@ -52,3 +52,21 @@
(unless (dm:hull-p model) (unless (dm:hull-p model)
(loop for field in (dm:fields model) (loop for field in (dm:fields model)
collect (cons field (dm:field model field))))) collect (cons field (dm:field model field)))))
(defun lambdalite-db-p ()
"Checks if application is using lambdalite as database backend"
(string= (string-upcase (package-name (db:implementation)))
"I-LAMBDALITE"))
(defun data-model-save (data-model)
"Wrapper on data-model save method to bypass error using dm:save on lambdalite.
It uses the same approach as dm:save under the hood through db:save."
(if (lambdalite-db-p)
(progn
(format t "Updating lambdalite collection '~a'~%" (dm:collection data-model))
(db:update (dm:collection data-model)
(db:query (:= '_id (dm:id data-model)))
(dm:field-table data-model)))
(progn
(format t "Updating database table '~a'~%" (dm:collection data-model))
(dm:save data-model))))

15
user-management.lisp
View File

@ -68,7 +68,8 @@
(verify-password password user-password)) (verify-password password user-password))
;; Update last login ;; Update last login
(setf (dm:field user "last-login") (local-time:timestamp-to-unix (local-time:now))) (setf (dm:field user "last-login") (local-time:timestamp-to-unix (local-time:now)))
(dm:save user) ;; (dm:save user)
(data-model-save user)
user))))) user)))))
(defun hash-password (password) (defun hash-password (password)
@ -97,7 +98,8 @@
(format t "New hash: ~a~%" new-hash) (format t "New hash: ~a~%" new-hash)
;; Try direct update with uppercase field name to match stored case ;; Try direct update with uppercase field name to match stored case
(setf (dm:field user "password-hash") new-hash) (setf (dm:field user "password-hash") new-hash)
(dm:save user) ;; (dm:save user)
(data-model-save user)
;; Verify the update worked ;; Verify the update worked
(let ((updated-user (find-user-by-username username))) (let ((updated-user (find-user-by-username username)))
(format t "Verification - fetching user again...~%") (format t "Verification - fetching user again...~%")
@ -203,7 +205,8 @@
(if user (if user
(progn (progn
(setf (dm:field user "role") (string-downcase (symbol-name new-role))) (setf (dm:field user "role") (string-downcase (symbol-name new-role)))
(dm:save user) ;; (dm:save user)
(data-model-save user)
t) t)
(format t "Could not find user with id #~a~%" user-id))) (format t "Could not find user with id #~a~%" user-id)))
(error (e) (error (e)
@ -215,7 +218,8 @@
(handler-case (handler-case
(let ((user (find-user-by-id user-id))) (let ((user (find-user-by-id user-id)))
(setf (dm:field user "active") 0) (setf (dm:field user "active") 0)
(dm:save user) ;; (dm:save user)
(data-model-save user)
(format t "Deactivated user ~a~%" user-id) (format t "Deactivated user ~a~%" user-id)
t) t)
(error (e) (error (e)
@ -227,7 +231,8 @@
(handler-case (handler-case
(let ((user (find-user-by-id user-id))) (let ((user (find-user-by-id user-id)))
(setf (dm:field user "active") 1) (setf (dm:field user "active") 1)
(dm:save user) ;; (dm:save user)
(data-model-save user)
(format t "Activated user ~a~%" user-id) (format t "Activated user ~a~%" user-id)
t) t)
(error (e) (error (e)