More rigorous handling of WhatsApp error return codes

- WhatsApp sends responses of the form ((:status . 200)) (or whatever the code
  may be) whenever we perform an asynchronous operation.
- Previously, most of these were ignored. But now...
- These are represented as the STATUS-CODE-ERROR condition, which now contains a
  useful symbol that you can use to determine what type of asynchronous
  operation went wrong, and print some warning/informational message to let the
  user know that something might have not worked out.
- In cases where the status code returned relates to logging in, the LOGIN-ERROR
  subclass is used, and the connection is terminated.

default.nix

@@ -18,6 +18,7 @@ buildLisp.library {
     "tables.lisp"
     "message.lisp"
     "api.lisp"
+    "errors.lisp"
     "whatscl.lisp"
   ];
 }

errors.lisp

@@ -0,0 +1,37 @@
+;;;; Condition types for errors returned by WhatsApp
+
+(in-package :whatscl)
+
+(define-condition status-code-error (error)
+  ((status-code
+    :initarg :status-code
+    :reader scerror-status-code)
+   (operation
+    :initarg :operation
+    :reader scerror-operation))
+  (:report (lambda (condit stream)
+             (with-slots (status-code operation) condit
+               (format stream "~A returned wrong status code: ~A" operation status-code))))
+  (:documentation "An error (with failure code STATUS-CODE) originating from some asynchronous WhatsApp operation, the nature of which is described by the keyword OPERATION.
+Unless the error is also of type LOGIN-ERROR, these conditions are often non-fatal and can be ignored."))
+
+(define-condition login-error (status-code-error) ()
+  (:report (lambda (condit stream)
+             (with-slots (status-code operation) condit
+               (format stream "Login to WhatsApp failed during stage ~A with code ~A" operation status-code))))
+  (:documentation "Subclass of STATUS-CODE-ERROR that indicates a failure to log into WhatsApp."))
+
+(defun cb-check-status (conn details &optional (reason :generic-operation) (condition-type 'status-code-error))
+  "Verifies that the included DETAILS object contains a :status key with value 200. If not, signals a condition of type CONDITION-TYPE, using the provide REASON as the OPERATION slot."
+  (declare (ignore conn))
+  (unless (eql (aval :status details) 200)
+    (error condition-type
+           :operation reason
+           :status-code (aval :status details))))
+
+(defmacro function-check-status (&optional reason condition-type)
+  "Returns a lambda taking (conn details) that calls CB-CHECK-STATUS with (conn details reason)."
+  (let ((conn-sym (gensym))
+        (details-sym (gensym)))
+    `(lambda (,conn-sym ,details-sym)
+       (cb-check-status ,conn-sym ,details-sym ,reason ,condition-type))))

whatscl.asd

@@ -12,4 +12,5 @@
    (:file "tables")
    (:file "message")
    (:file "api")
+   (:file "errors")
    (:file "whatscl")))

whatscl.lisp

@@ -178,7 +178,8 @@ CALLBACK, if provided, specifies a function to run with the reply sent by WhatsA
                                            (:owner . :false)
                                            (:count . "1"))
                                           nil)))
-                        :read))
+                        :read
+                        :callback (function-check-status :send-message-read)))
 
 (defun send-presence (conn presence-type &optional jid)
   "Send the presence PRESENCE-TYPE on CONN, with an optional JID string if the presence indicates composing, recording, or paused composition."
@@ -190,7 +191,8 @@ CALLBACK, if provided, specifies a function to run with the reply sent by WhatsA
                                                ,@(when jid
                                                    `((:to . ,(jid-to-message-target jid)))))
                                               nil)))
-                        :presence))
+                        :presence
+                        :callback (function-check-status :send-presence)))
 
 (defun get-profile-picture (conn jid callback)
   "Try and get a profile picture thumbnail for JID. Calls CALLBACK with CONN as first argument and then a URL (or NIL if none could be found)"
@@ -239,30 +241,13 @@ accumulator and close the stream."
                      (without-wac-lock (conn)
                        (funcall callback conn result)))))
 
-(define-condition status-code-error (error)
-  ((status-code
-    :initarg :status-code
-    :reader scerror-status-code)
-   (operation
-    :initarg :operation
-    :reader scerror-operation))
-  (:report (lambda (condit stream)
-             (with-slots (status-code operation) condit
-               (format stream "~A returned wrong status code: ~A" operation status-code)))))
-
-(defun cb-check-status (conn details &optional (reason "Generic operation"))
-  "Verifies that the included DETAILS object contains a :status key with value 200. If not, throws an error."
-  (declare (ignore conn))
-  (unless (eql (aval :status details) 200)
-    (error 'status-code-error
-           :operation reason
-           :status-code (aval :status details))))
-
 (defun on-login-message (conn details)
   "Called when WhatsApp sends us the initial login information."
   (with-accessors ((keypair wac-keypair) (client-id wac-client-id)) conn
     (unless (eql (aval :status details) 200)
-      (error "Login returned wrong status code: ~A" (aval :status details)))
+      (error 'login-error
+             :operation :on-login-message
+             :status-code (aval :status details)))
     (setf keypair (multiple-value-list (crypto:generate-key-pair :curve25519)))
     (let* ((pubkey
              (cadr (crypto:destructure-public-key (cadr keypair))))
@@ -281,7 +266,7 @@ accumulator and close the stream."
          (response (qbase64:encode-bytes signed-data)))
     (debug-format "Handling server challenge~%")
     (send-ws-message conn `("admin" "challenge" ,response ,(session-server-token sess) ,(session-client-id sess))
-                     (lambda (conn resp) (cb-check-status conn resp "Login challenge")))))
+                     (function-check-status :login-challenge 'login-error))))
 
 (defun send-login-message (conn)
   "Sends the login message, using information in the client's LOGIN-INFORMATION if provided."
@@ -289,7 +274,7 @@ accumulator and close the stream."
     (let ((login-msg (apply #'build-login-message client-id login-information))
           (callback (if (wac-session conn)
                         (lambda (conn resp)
-                          (cb-check-status conn resp "Login (for restore)")
+                          (cb-check-status conn resp :on-login-message 'login-error)
                           (send-restore-message conn))
                         #'on-login-message)))
       (send-ws-message conn login-msg callback))))
@@ -298,7 +283,7 @@ accumulator and close the stream."
   "Sends a session restore message, using the stored session in CONN."
   (let ((restore-msg (build-restore-message (wac-session conn))))
     (send-ws-message conn restore-msg
-                     (lambda (conn resp) (cb-check-status conn resp "Session restore")))))
+                     (function-check-status :restore-message 'login-error))))
 
 (defun on-connection-ack (conn msg)
   "Handles a 'connection acknowledgement' message, performing key generation."
@@ -482,7 +467,10 @@ accumulator and close the stream."
                             (on-server-message conn payload tag))))
                   (status-code-error (err)
                     (wac-emit :error-status-code conn err)
-                    (whatscl::close-connection conn))
+                    (when (typep err 'login-error)
+                      ;; General STATUS-CODE-ERROR conditions aren't fatal,
+                      ;; but login errors are.
+                      (whatscl::close-connection conn)))
                   (error (err)
                     (warn "Error when handling message: ~A" err)
                     (warn "Backtrace: ~A" last-err-backtrace)