Very strange behaviour with the :dao keyword.

[K1D77A]

Okay so I have a method called find-user that looks up a user within my database and returns it using :dao user.

(defmethod find-user (user)
  (%pomo-find-user user))

(defmethod %pomo-find-user ((username string))
  (first (pomo:query (:select '* :from 'users :where (:= 'userid username)) (:dao user))))

If I make a call to (find-user ) at my repl while connected using either connect-toplevel or with-connection I get a returned user:

LUNA-SITE> (find-user "@jgr:ss.com")
#<USER @jr:scom::3013>

I have removed some of the aspects of the output for the sake of privacy. Now I have my function that is called within a hunchentoot easy handler:

(defun authorize-login-page (userid token theme)
  (declare (ignorable theme))
  (on-failure
      (progn (sleep 1)
             (tbnl:redirect "/sticgin"))
    (pomo:with-connection '(" "" "
                            "" :pooled-p t);actual values removed for privacy obviously
      (let ((user (find-user userid)))
        (if (and user (string= token (token user)))
            (progn (setf (tbnl:session-value :user (tbnl:start-session)) user)
                   (tbnl:redirect "/sticd-in"))
            (error "not valid"))))))

When this is called at the toplevel with valid arguments all is well and nothing freezes.

Now if this function is called within a hunchentoot handler I get the following:

  0: (LUNAMECH-SITE::AUTHORIZE-LOGIN-PAGE "@jom" "dfd" NIL)
    1: (LUNAMECH-SITE::FIND-USER "@jom")
      2: (ERROR #<SB-INT:SIMPLE-PROGRAM-ERROR "invalid number of arguments: ~S" {100C375143}>)

Once again aspects have been removed for privacy.

Now if I try using (query ..) directly:

      (let ((user (pomo:query (:select '* :from 'users :where (:= 'userid userid))
                              (:dao user))))

I get

  0: (LUNAMECH-SITE::AUTHORIZE-LOGIN-PAGE "@m" "dfd" NIL)
    1: (ERROR #<SB-INT:SIMPLE-PROGRAM-ERROR "invalid number of arguments: ~S" {100D003803}>)

Clearly not working. Now if I remove :dao

 (let ((user (pomo:query (:select '* :from 'users :where (:= 'userid userid)))))

it works:

0: (LUNAMECH-SITE::AUTHORIZE-LOGIN-PAGE "@jgreenriver:scyldings.com" "" NIL)
    1: (ERROR SB-PCL::NO-APPLICABLE-METHOD-ERROR :GENERIC-FUNCTION #<STANDARD-GENERIC-FUNCTION LUNAMECH-SITE::TOKEN (4)> :ARGS ((("@jg

You can see it has now made it to the (token ..) call. I dont have a clue why this is happening. Everything works fine until the :dao key is added within a hunchentoot handler. Not sure if it is related but I have that fix you suggested for my previous issue still installed.

Thanks!

[K1D77A]

Oh also its important to note that this completely freezes the postgres connection if I'm using the top level one.

[sabracrolleton]

Weird. (By the way, you can use (:dao user :single) to just get the dao. (Avoids the need to call (first...))

Ok. Just trying to narrow things down on the Postmodern side (I do not know much about hunchentoot handlers).

When you do (pomo:with-connection '(blah blah) (find-user ...) in a pomo:with-connection, you said get a valid user dao.

When you do the same thing contained in the authorize-login-page as a function, you said when connected at the toplevel it works. Since authorize-login-page contains a with-connection clause, a toplevel connection should not be necessary. Does it work without the toplevel connection (before we get to the hunchentoot handler)?

I notice your successful find-user example was (find-user "@jgr:ss.com"), but the error message with the hunchentoot handler was (FIND-USER "@jom") and then when you used query directly the error message indicated that the userid was "@m". I assume that does not make a difference - we really are talking three different userids here?

A couple of things to check:

When using (:dao classname) or (:dao classname :single), the names of the column names in the Postgresql table need to match the names of the slots in the dao. I assume that is correct. You would normally get a different error message if the number of columns returned was different than the number of slots in the dao-class but freezing the postgres connection can occur in that situation. Can you validate the table matches the dao?

Do you really need multiple column keys here (both id and userid)? If you make userid by itself the primary key, is the behavior about missing arguments the same if you are using (get-dao 'user userid)?

I would have thought that if it was complaining about an invalid number of arguments for the import function server-ids->servers (assuming that is correct from what you said in the other bug report), the error message would have mentioned that function.

I will try to create some simple hunchentoot app this weekend to see if I can replicate the error.

[K1D77A]

Does it work without the toplevel connection (before we get to the hunchentoot handler)? Yes, outside of the handler.

I notice your successful find-user example was (find-user "@jgr:ss.com"), but the error message with the hunchentoot handler was (FIND-USER "@jom") and then when you used query directly the error message indicated that the userid was "@m". I assume that does not make a difference - we really are talking three different userids here?

Its the same username I have just obfuscated it for privacy reasons.

When using (:dao classname) or (:dao classname :single), the names of the column names in the Postgresql table need to match the names of the slots in the dao. I assume that is correct. You would normally get a different error message if the number of columns returned was different than the number of slots in the dao-class but freezing the postgres connection can occur in that situation. Can you validate the table matches the dao? I have dropped all my tables and reconstructed them with dao-table-definition and then refilled them, same problem.

Do you really need multiple column keys here (both id and userid)? If you make userid by itself the primary key, is the behavior about missing arguments the same if you are using (get-dao 'user userid)? Removed the 'userid' key and moved to just 'id' and same problem.

Here is my user class definition:

(defclass user ()
  ((userid
    :accessor userid
    :initarg :userid
    :type string
    :documentation "The matrix user-id"
    :col-type string
    :col-unique t
    :check (:<> 'userid ""))
   (id
    :accessor id
    :col-type integer
    :col-unique t
    :col-identity t)
   (merchant-id
    :accessor merchant-id
    :initarg :merchant-id
    :initform ""
    :type string
    :documentation "A string denoting their merchant id"
    :col-type string)
   (accepted-currencies
    :accessor accepted-currencies
    :initarg :accepted-currencies
    :initform ()
    :type list
    :col-type (or pomo:db-null string)
    :col-import string-to-list
    :col-export list-to-string
    :documentation "A list of accepted currencies as keyword ie :BTC :LTC etc")
   (authorized-in
    :accessor authorized-in
    :initarg :authorized-in
    :initform ()
    :type list
    :col-type (or pomo:db-null (integer array))
    :col-import arr->list
    :col-export list->arr
    :documentation "A list of server ids the user is authorized in")
   (token
    :accessor token
    :initarg :token
    :type string
    :documentation "The users token."
    :col-type string
    :col-unique t
    :check (:<> 'token ""))
   (extra-information
    :accessor extra-information
    :initarg :extra-information
    :initform ""
    :type string
    :documentation "A slot for extra info"
    :col-type string))
  (:documentation "")
  (:metaclass pomo:dao-class)
  (:keys id)
  (:table-name users))

My importers and exporters:

(defun arr->list (arr)
  (if (eq arr :null)
      nil
      (coerce arr 'list)))

(defun list->arr (list)
  (if (null list)
      :null
      (coerce list 'vector)))

(defun intern-key (str)
  (intern (string-upcase str) :keyword))

(defun string-to-list (str)
  "Take a string representation of a list and return a lisp list.
    Note that you need to handle :NULLs."
  (cond ((eq str :NULL)
         nil)
        ((string= str "false")
         nil)
        (str
         (with-input-from-string (s str) (read s)))
        (t nil)))

(defun list-to-string (val)
  "Simply uses (format ..) to write a list out as a string"
  (cond ((null val)
         nil)
        ((listp val)
         (format nil "~S" val))
        (t nil)))

I tried using (find-server ..) as well and I get the same problem, here is the definition of both:

(defgeneric find-user (username)
  (:documentation "Attempts to find the user associated with username. 
If it fails then signals 'unknown-user"))

(defmethod find-user :around (user)
  (restart-case 
      (let ((res (call-next-method)))
        (or res
            (error 'unknown-user :user user
                                 :message "couldn't find the user.")))
    (do-nothing ()
      :report "Couldn't find should I do nothing?"
      nil)))

(defmethod find-user (user)
  (%pomo-find-user user))

(defmethod find-user ((user user))
  user)

(defmethod %pomo-find-user ((username string))
  (pomo:query (:select '* :from 'users :where (:= 'userid username)) (:dao user :single)))

(defmethod %pomo-find-user ((username fixnum))
  (pomo:query (:select '* :from 'users :where (:= 'id username)) (:dao user :single)))

(defmethod find-server :around (server)
  (restart-case
      (let ((res (call-next-method)))
        (or res
            (error 'unknown-server :server server
                                   :message "couldn't find the server.")))
    (use-default ()
      :report "Couldn't find should I use the default server?"
      (%default-server))
    (do-nothing ()
      :report "Couldn't find should I do nothing?"
      nil)))

(defmethod %pomo-find-server ((server string))
  (first (pomo:query (:select '* :from 'servers :where (:= 'domain server)) (:dao server))))

(defmethod %pomo-find-server ((server fixnum))
  (first (pomo:query (:select '* :from 'servers :where (:= 'id server))
                     (:dao server))))

(defmethod find-server (server)
  (%pomo-find-server server))

(defmethod find-server ((server server))
  server)

I hope these are helpful.

[sabracrolleton]

Just in case this is turning into another version of issue 278, Can you do me a favor? In the file postmodern/table.lisp starting on line 673 you can find the dao-from-fields function. Can you comment that out and insert the following?

(defun dao-from-fields (class column-map query-fields
                              result-next-field-generator-fn)
  (let ((instance (allocate-instance class)))
    (loop :for field :across query-fields
          :for writer := (cdr (assoc (field-name field)
                                     column-map
                                     :test #'string=))
          :do
          (etypecase writer
            (null (if *ignore-unknown-columns*
                      (funcall result-next-field-generator-fn field)
                    (error "No slot named ~a in class ~a. DAO out of sync with table, or incorrect query used."
                           (field-name field) (class-name class))))
            (symbol (setf (slot-value instance writer)
                          (funcall result-next-field-generator-fn field)))
            (function (let ((import-function-symbol
                             (find-import-function instance (field-name field))))
                        (cond ((and import-function-symbol
                                    (eq writer
                                        (fdefinition import-function-symbol)))
                               (format t "dao-from-fields 1~%")
                               (setf (slot-value instance (field-name-to-slot-name
                                                           class (field-name field)))
                                     (funcall writer
                                              (funcall result-next-field-generator-fn field))))
                              ((and import-function-symbol
                                    (not (functionp import-function-symbol)))
                               (format t "dao-from-fields 2~%")                               
                               (setf (slot-value instance (field-name-to-slot-name
                                                           class (field-name field)))
                                     (funcall (fdefinition import-function-symbol)
                                              (funcall result-next-field-generator-fn field))))
                              ((and import-function-symbol
                                    (functionp import-function-symbol))
                               (format t "dao-from-fields 3~%")
                               (setf (slot-value instance (field-name-to-slot-name
                                                           class (field-name field)))
                                     (funcall import-function-symbol
                                              (funcall result-next-field-generator-fn field))))
                              (t
                               (format t "dao-from-fields 4~%")
                               (funcall writer instance
                                          (funcall result-next-field-generator-fn field))))))))
    (initialize-instance instance)
    instance))

Can you tell me if that works and, if so, which logging format string was called?

[K1D77A]

  0: (LUNAMECH-SITE::FIND-USER "@kgs.com")
dao-from-fields 4
    1: (ERROR #<SB-INT:SIMPLE-PROGRAM-ERROR "invalid number of arguments: ~S" {10068B9343}>)

It does not work.

[K1D77A]

Not sure if this is relevant but two of the methods within my user class dont have default behaviour. The same is true for my server class which has even more accessors with non default behaviour.

(defmacro conditionally-update (object/s &body body)
  (alexandria:with-gensyms (res)
    `(locally (declare (special *dont-update*))
       (let ((,res (locally ,@body)))
         (unless (boundp '*dont-update*)
           (mapc #'%pomo-update ,object/s))
         ,res))))

(defmethod %pomo-update ((user user))
  (pomo:update-dao user))

(defmethod (setf accepted-currencies) :around (newval (user user))
  (conditionally-update (list user)
    (call-next-method)))

(defmethod (setf authorized-in) :around (newval (user user))
  (conditionally-update (list user)
    (call-next-method)))

(defmethod authorized-in ((user user))
  (mapcar #'find-server (authorized-in user)))

[sabracrolleton]

Thanks. Will add that to the checklist. By the way, your col-type for user:authorized-in is incorrect - you have the integer and array transposed.

:col-type (or pomo:db-null (integer array))

It should be:

:col-type (or pomo:db-null (array integer))

[K1D77A]

ah, well fortunately it hasn't been used yet. I'll have to fix.

[sabracrolleton]

Can you try the following work around while I try to get to the bottom of the real problem?

Change your import functions to take two parameters with the value you are trying to import being the second parameter. If you look at issue 278, Helmut is having success passing in an instance of the class as the first parameter, but not actually using it.

I want to see if issue 278 and this one are the same.

[K1D77A]

Hi Sabra, yes that fixed it. Changing the definition of my import functions to:

(defun arr->list (x arr)
  (declare (ignore x))
  (if (eq arr :null)
      nil
      (coerce arr 'list)))

(defun string-to-list (x str)
  "Take a string representation of a list and return a lisp list.
    Note that you need to handle :NULLs."
  (declare (ignore x))
  (cond ((eq str :NULL)
         nil)
        ((string= str "false")
         nil)
        (str
         (with-input-from-string (s str) (read s)))
        (t nil)))

Fixed it.

[sabracrolleton]

Ok. I am pretty sure I found the problem. When using a hunchentoot easy handler, the current package actually changes to cl-user and I did not take that possibility into account. Working on tests now and should have something for you to test with the documented one parameter version tomorrow.

[K1D77A]

Very epic, thank you for all your hard work!

[sabracrolleton]

Before I push this to the main line, I want to make sure it works for you (export and single parameter import functions)

I uploaded changes to my personal fork at https://github.com/sabracrolleton/Postmodern. The only file you need to care about is https://github.com/sabracrolleton/Postmodern/blob/master/postmodern/table.lisp.

The commit is shown at https://github.com/sabracrolleton/Postmodern/commit/3342af623760a7fd64bbbfa5e52be696136f4b9a (but the commits to table.lisp (the only ones relevant to you) is about 80% down the page past a bunch of documentation changes).

[K1D77A]

It appears to be working.

[sabracrolleton]

Resolved with today's commit.