Initial sync progress

This commit is contained in:
Adam Porter 2020-11-28 07:41:13 -06:00
parent 795bdf18b4
commit 5779caecbe
3 changed files with 129 additions and 81 deletions

View file

@ -24,6 +24,12 @@
;;; Code:
;;;; Debugging
(eval-and-compile
(setq-local warning-minimum-log-level nil)
(setq-local warning-minimum-log-level :debug))
;;;; Requirements
(require 'json)
@ -45,17 +51,24 @@
;;;; Functions
(cl-defun ement-api (hostname port token transaction-id endpoint data then
&key timeout raw-data
(cl-defun ement-api (hostname port token _transaction-id endpoint _data then
&key _timeout _raw-data
(content-type "application/json")
(else #'ement-api-error) (method 'get))
;; FIXME: Use transaction-id or add it in calling functions.
;; FIXME: Use timeout.
(declare (indent defun))
(pcase-let* ((path (concat "/_matrix/client/r0/" endpoint))
(url (url-recreate-url (url-parse-make-urlobj "https" nil nil hostname port path nil nil t)))
(headers (ement-alist "Content-Type" content-type
"Authorization" (concat "Bearer " token))))
(debug-warn (current-time) session method endpoint data then timeout url)
(debug-warn (list 'plz-get url :headers headers :as #'json-read :then then :else else))))
(debug-warn (current-time) method url headers then)
(pcase method
('get (plz-get url :headers headers :as #'json-read :then then :else else)))))
(defun ement-api-error (&rest args)
(debug-warn args)
(error "ement-api-error: %S" args))
;;;; Footer

View file

@ -26,12 +26,70 @@
;;;; Requirements
(require 'map)
;;;; Debugging
(eval-and-compile
(setq-local warning-minimum-log-level nil)
(setq-local warning-minimum-log-level :debug))
(cl-defmacro debug-warn (&rest args)
"Display a debug warning showing the runtime value of ARGS.
The warning automatically includes the name of the containing
function, and it is only displayed if `warning-minimum-log-level'
is `:debug' at expansion time (otherwise the macro expands to nil
and is eliminated by the byte-compiler). When debugging, the
form also returns nil so, e.g. it may be used in a conditional in
place of nil.
Each of ARGS may be a string, which is displayed as-is, or a
symbol, the value of which is displayed prefixed by its name, or
a Lisp form, which is displayed prefixed by its first symbol.
Before the actual ARGS arguments, you can write keyword
arguments, i.e. alternating keywords and values. The following
keywords are supported:
:buffer BUFFER Name of buffer to pass to `display-warning'.
:level LEVEL Level passed to `display-warning', which see.
Default is :debug."
(pcase-let* ((fn-name (with-current-buffer
(or byte-compile-current-buffer (current-buffer))
;; This is a hack, but a nifty one.
(save-excursion
(beginning-of-defun)
(cl-second (read (current-buffer))))))
(plist-args (cl-loop while (keywordp (car args))
collect (pop args)
collect (pop args)))
((map (:buffer buffer) (:level level)) plist-args)
(level (or level :debug))
(string (cl-loop for arg in args
concat (pcase arg
((pred stringp) "%S ")
((pred symbolp)
(concat (upcase (symbol-name arg)) ":%S "))
((pred listp)
(concat "(" (upcase (symbol-name (car arg)))
(pcase (length arg)
(1 ")")
(_ "...)"))
":%S "))))))
(when (eq :debug warning-minimum-log-level)
`(progn
(display-warning ',fn-name (format ,string ,@args) ,level ,buffer)
nil))))
;;;; Macros
(defmacro ement-alist (&rest pairs)
"Expand to an alist of the keys and values in PAIRS."
`(list ,@(cl-loop for (key value) on pairs by #'cddr
collect `(cons ,key ,value))))
;;;; Variables

131
ement.el
View file

@ -25,6 +25,12 @@
;;; Code:
;;;; Debugging
(eval-and-compile
(setq-local warning-minimum-log-level nil)
(setq-local warning-minimum-log-level :debug))
;;;; Requirements
;; Built in.
@ -36,69 +42,16 @@
(require 'ement-api)
(require 'ement-macros)
;;;; Debugging
(eval-and-compile
(setq-local warning-minimum-log-level nil)
(setq-local warning-minimum-log-level :debug))
(cl-defmacro debug-warn (&rest args)
"Display a debug warning showing the runtime value of ARGS.
The warning automatically includes the name of the containing
function, and it is only displayed if `warning-minimum-log-level'
is `:debug' at expansion time (otherwise the macro expands to nil
and is eliminated by the byte-compiler). When debugging, the
form also returns nil so, e.g. it may be used in a conditional in
place of nil.
Each of ARGS may be a string, which is displayed as-is, or a
symbol, the value of which is displayed prefixed by its name, or
a Lisp form, which is displayed prefixed by its first symbol.
Before the actual ARGS arguments, you can write keyword
arguments, i.e. alternating keywords and values. The following
keywords are supported:
:buffer BUFFER Name of buffer to pass to `display-warning'.
:level LEVEL Level passed to `display-warning', which see.
Default is :debug."
(pcase-let* ((fn-name (with-current-buffer
(or byte-compile-current-buffer (current-buffer))
;; This is a hack, but a nifty one.
(save-excursion
(beginning-of-defun)
(cl-second (read (current-buffer))))))
(plist-args (cl-loop while (keywordp (car args))
collect (pop args)
collect (pop args)))
((map (:buffer buffer) (:level level)) plist-args)
(level (or level :debug))
(string (cl-loop for arg in args
concat (pcase arg
((pred stringp) "%S ")
((pred symbolp)
(concat (upcase (symbol-name arg)) ":%S "))
((pred listp)
(concat "(" (upcase (symbol-name (car arg)))
(pcase (length arg)
(1 ")")
(_ "...)"))
":%S "))))))
(when (eq :debug warning-minimum-log-level)
`(progn
(display-warning ',fn-name (format ,string ,@args) ,level ,buffer)
nil))))
;;;; Structs
(cl-defstruct ement-user
id displayname)
id displayname account-data)
(cl-defstruct ement-server
hostname port)
(cl-defstruct ement-session
user server token transaction-id rooms)
user server token transaction-id rooms next-batch)
;;;; Variables
@ -115,46 +68,50 @@ keywords are supported:
"Save username and access token upon successful login."
:type 'boolean)
(defcustom ement-save-token-file "~/.cache/matrix-client.el.token"
(defcustom ement-save-session-file "~/.cache/matrix-client.el.token"
;; FIXME: Uses matrix-client.el token.
"Save username and access token to this file."
:type 'file)
;;;; Commands
(defun ement-connect (user-id _password hostname token)
(defun ement-connect (user-id _password hostname token &optional transaction-id)
;; FIXME: Use password if given.
"Connect to Matrix and sync once."
(interactive (list (read-string "User ID: " (or (when (car ement-sessions)
(ement-session-user (car ement-sessions)))
""))
(read-passwd "Password: ")
(read-string "Hostname (default: from user ID): ")
(ement--load-token)))
(interactive (pcase-let* (((map username server token ('txn-id transaction-id))
(ement--load-session)))
(list username nil server token transaction-id))
;; (list (read-string "User ID: " (or (when (car ement-sessions)
;; (ement-session-user (car ement-sessions)))
;; ""))
;; (read-passwd "Password: ")
;; (read-string "Hostname (default: from user ID): ")
;; (alist-get 'token (ement--load-session)))
)
;; FIXME: Overwrites any current session.
(pcase-let* ((hostname (if (not (string-empty-p hostname))
hostname
(or (awhen (string-match (rx ":" (group (1+ anything))) user-id)
(match-string 1 user-id))
"matrix.org")))
(if (string-match (rx ":" (group (1+ anything))) user-id)
(match-string 1 user-id)
"matrix.org")))
;; FIXME: Lookup hostname from user ID with DNS.
;; FIXME: Dynamic port.
(server (make-ement-server :hostname hostname :port 443))
(user (make-ement-user :id user-id))
(transaction-id (random 100000))
(transaction-id (or transaction-id (random 100000)))
(session (make-ement-session :user user :server server :token token :transaction-id transaction-id)))
(setf ement-sessions (list session)))
(debug-warn (car ement-sessions))
(ement--sync (car ement-sessions)))
(defun ement-view-room (room)
"Switch to a buffer for ROOM."
(interactive (list (ement-complete-room (car ement-sessions)))))
;; (defun ement-view-room (room)
;; "Switch to a buffer for ROOM."
;; (interactive (list (ement-complete-room (car ement-sessions)))))
;;;; Functions
(defun ement-complete-room (session)
"Return a room selected from SESSION with completion.")
;; (defun ement-complete-room (session)
;; "Return a room selected from SESSION with completion.")
(cl-defun ement--sync (session &key since)
;; SPEC: <https://matrix.org/docs/spec/client_server/r0.6.1#id257>.
@ -170,13 +127,33 @@ keywords are supported:
(defun ement--sync-callback (session data)
"SESSION. DATA should be the parsed JSON response."
(debug-warn session data))
(pcase-let* (((map rooms) data)
((map ('join joined-rooms)) rooms))
(mapc (apply-partially #'ement--push-joined-room-events session) joined-rooms)
(message "Sync done")))
(defun ement--load-token ()
"Return saved username and access token from file."
(when (file-exists-p ement-save-token-file)
(cl-defstruct ement-room
id summary state timeline timeline* ephemeral account-data unread-notifications)
(defun ement--push-joined-room-events (session joined-room)
(pcase-let* ((`(,id . ,event-types) joined-room)
(room (or (cl-find-if (lambda (room)
(equal id (ement-room-id room)))
(ement-session-rooms session))
(car (push (make-ement-room :id id) (ement-session-rooms session)))))
((map summary state ephemeral timeline
('account_data account-data)
('unread_notifications unread-notifications))
event-types))
(ignore account-data unread-notifications summary state ephemeral)
(cl-loop for event across (alist-get 'events timeline)
do (push event (ement-room-timeline* room)))))
(defun ement--load-session ()
"Return saved session from file."
(when (file-exists-p ement-save-session-file)
(read (with-temp-buffer
(insert-file-contents ement-save-token-file)
(insert-file-contents ement-save-session-file)
(buffer-substring-no-properties (point-min) (point-max))))))
;;;; Footer