[elpa] externals/crdt a4a07fb 2/4: Improve error handling

[ELPA Syncer]

branch: externals/crdt
commit a4a07fb3aa935e7771d560adac0c5ae0fd58eebd
Author: Qiantan Hong <qhong@mit.edu>
Commit: Qiantan Hong <qhong@mit.edu>

    Improve error handling
    
    - add error recovery to protocol
    - server side error handling (by sending the client an error message)
    - fix a stupid typo for the crdt--buffer-sync-callback to relocate cursor
---
 HACKING.org | 12 +++++++-
 crdt.el     | 95 +++++++++++++++++++++++++++++++++++++------------------------
 2 files changed, 69 insertions(+), 38 deletions(-)

diff --git a/HACKING.org b/HACKING.org
index eab1b13..e066ddb 100644
--- a/HACKING.org
+++ b/HACKING.org
@@ -69,7 +69,7 @@ and second last two bytes represent site ID.
   - Initial Synchronization
     + sync ::
       This message is sent from server to client to get it sync to the state 
on the server.
-      Might be used for error recovery or other optimization in the future.
+      Might be used for other optimization in the future.
       One optimization I have in mind is let server try to merge all CRDT item 
into a single
       one and try to synchronize this state to clients at best effort.
       body takes the form =(buffer-name . crdt-id-list)=
@@ -83,6 +83,16 @@ and second last two bytes represent site ID.
       The client should now try to enable =major-mode-symbol= in the
       synchronized buffer.
 
+  - Error Recovery
+    Note: when a client side error happens, it just sends a =get= message and
+    follow initial synchronization procedure to reinitialize the buffer.
+
+    + error ::
+      body takes the form =(buffer-name error-symbol . error-datum)=.
+      This message is sent from server to client to notice that some messages 
from the
+      client is not processed due to error =(error-symbol . error-datum)=.
+      Normally client should follow initial synchronization procedure to 
reinitialize the buffer.
+
   - Buffer Service
     + add ::
       Indicates that the server has started sharing some buffers.
diff --git a/crdt.el b/crdt.el
index 42d09e7..d4da1f9 100644
--- a/crdt.el
+++ b/crdt.el
@@ -344,6 +344,9 @@ Each element is of the form (CURSOR-OVERLAY . 
REGION-OVERLAY).")
 
 (defvar crdt--session-menu-buffer nil)
 
+(defvar crdt--process nil
+  "Temporarily bound to the current network process when processing messages 
inside CRDT--NETWORK-FILTER.")
+
 ;;; crdt-mode
 
 (defvar crdt--hooks-alist
@@ -465,9 +468,7 @@ If such buffer doesn't exist yet, do nothing."
            (widen)
            (condition-case err
                ,(cons 'progn body)
-             (error (if (crdt--server-p)
-                        (signal (car err) (cdr err)) ; didn't implement server 
side recovery yet
-                      (crdt--client-recover)))))))))
+             (error (crdt--recover err))))))))
 
 (defmacro crdt--with-buffer-name-pull (name &rest body)
   "Find CRDT shared buffer associated with NAME and evaluate BODY in it.
@@ -1138,14 +1139,25 @@ Verify that CRDT IDs in a document follows ascending 
order."
 
 ;;; Recovery
 
-(defun crdt--client-recover ()
-  "Try to recover from a synchronization failure from a client.
+(defun crdt--recover (&optional err)
+  "Try to recover from a synchronization failure.
 Current buffer is assmuned to be the one with synchronization error."
-  (ding)
-  (read-only-mode)
-  (message "Synchronization error detected, try recovering...")
-  (crdt--broadcast-maybe
-   (crdt--format-message `(get ,crdt--buffer-network-name))))
+  (if (crdt--server-p)
+      (progn
+        (let ((message (crdt--format-message `(error 
,crdt--buffer-network-name ,@err))))
+          (condition-case nil
+              (read-from-string message)
+            (invalid-read-syntax
+             ;; (cdr err) must be unprintable, omit it for now
+             ;; maybe handle some objects in the future
+             ;; (e.g. represent buffer object with its name)
+             (setq message (crdt--format-message `(error 
,crdt--buffer-network-name ,(car err))))))
+          (process-send-string crdt--process message)))
+    (ding)
+    (read-only-mode)
+    (message "Synchronization error detected, try recovering...")
+    (crdt--broadcast-maybe
+     (crdt--format-message `(get ,crdt--buffer-network-name)))))
 
 ;;; Network protocol
 
@@ -1302,7 +1314,8 @@ The network process for the client connection is PROCESS."
 
 (cl-defmethod crdt-process-message (message process)
   (message "Unrecognized message %S from %s:%s."
-           message (process-contact process :host) (process-contact process 
:service)))
+           message (process-contact process :host) (process-contact process 
:service))
+  (signal 'crdt-unrecognized-message nil))
 
 (cl-defmethod crdt-process-message ((message (head insert)) process)
   (cl-destructuring-bind (buffer-name crdt-id position-hint content) (cdr 
message)
@@ -1349,7 +1362,7 @@ The network process for the client connection is PROCESS."
                     (lambda ()
                       (goto-char
                        (max (min pos (point-max))
-                            (point-max)))))))
+                            (point-min)))))))
           (erase-buffer)
           (crdt--load-ids ids))))
     (crdt--refresh-buffers-maybe)))
@@ -1367,6 +1380,13 @@ The network process for the client connection is 
PROCESS."
           (funcall crdt--buffer-sync-callback)
           (setq crdt--buffer-sync-callback nil))))))
 
+(cl-defmethod crdt-process-message ((message (head error)) _process)
+  (unless (crdt--server-p)
+    (cl-destructuring-bind (buffer-name &rest err) (cdr message)
+      (crdt--with-buffer-name buffer-name
+        (message "Server side error %s." err)
+        (crdt--recover)))))
+
 (cl-defmethod crdt-process-message ((message (head add)) _process)
   (dolist (buffer-name (cdr message))
     (unless (gethash buffer-name (crdt--session-buffer-table crdt--session))
@@ -1439,6 +1459,8 @@ The network process for the client connection is PROCESS."
     (crdt--refresh-users-maybe))
   (crdt--broadcast-maybe (crdt--format-message message) (process-get process 
'client-id)))
 
+(define-error 'crdt-unrecognized-message "Unhandled 
crdt-unrecognized-message.")
+
 (defun crdt--network-filter (process string)
   "Network filter function for CRDT network processes.
 Handle received STRING from PROCESS."
@@ -1459,31 +1481,30 @@ Handle received STRING from PROCESS."
         (while (setq message (ignore-errors (read (current-buffer))))
           (when crdt--log-network-traffic
             (print message))
-          (cl-macrolet ((body ()
-                          '(if (or (not (crdt--server-p)) (process-get process 
'authenticated))
-                            (let ((crdt--inhibit-update t))
-                              (crdt-process-message message process))
-                            (cl-block nil
-                              (when (eq (car message) 'hello)
-                                (cl-destructuring-bind (name &optional 
response) (cdr message)
-                                  (when (or (not (process-get process 
'password)) ; server password is empty
-                                            (and response (string-equal 
response (process-get process 'challenge))))
-                                    (process-put process 'authenticated t)
-                                    (process-put process 'client-name name)
-                                    (crdt--greet-client process)
-                                    (cl-return))))
-                              (let ((challenge (crdt--generate-challenge)))
-                                (process-put process 'challenge
-                                             (gnutls-hash-mac 'SHA1 (substring 
(process-get process 'password)) challenge))
-                                (process-send-string process 
(crdt--format-message `(challenge ,challenge))))))))
-            (if debug-on-error (body)
-              (condition-case err (body)
-                (error (message "%s error when processing message from %s:%s, 
disconnecting." err
-                                (process-contact process :host) 
(process-contact process :service))
-                       (if (crdt--server-p)
-                           (progn
-                             (delete-process process))
-                         (crdt--stop-session crdt--session))))))
+          (condition-case err
+              (if (or (not (crdt--server-p)) (process-get process 
'authenticated))
+                  (let ((crdt--inhibit-update t)
+                        (crdt--process process))
+                    (crdt-process-message message process))
+                (cl-block nil
+                  (when (eq (car message) 'hello)
+                    (cl-destructuring-bind (name &optional response) (cdr 
message)
+                      (when (or (not (process-get process 'password)) ; server 
password is empty
+                                (and response (string-equal response 
(process-get process 'challenge))))
+                        (process-put process 'authenticated t)
+                        (process-put process 'client-name name)
+                        (crdt--greet-client process)
+                        (cl-return))))
+                  (let ((challenge (crdt--generate-challenge)))
+                    (process-put process 'challenge
+                                 (gnutls-hash-mac 'SHA1 (substring 
(process-get process 'password)) challenge))
+                    (process-send-string process (crdt--format-message 
`(challenge ,challenge))))))
+            (error
+             (message "%s error when processing message from %s:%s, 
disconnecting." err
+                      (process-contact process :host) (process-contact process 
:service))
+             (if (crdt--server-p)
+                 (delete-process process)
+               (crdt--stop-session crdt--session))))
           (delete-region (point-min) (point))
           (goto-char (point-min)))))))