gomuks.el/gomuks.el

;;; gomuks.el --- summary -*- lexical-binding: t -*-

;; This file is not part of GNU Emacs

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.


;;; Commentary:

;; commentary

;;; Code:

(cl-defstruct gomuks-state rooms spaces)
(cl-defstruct room id name topic events)
(cl-defstruct message row-id id sender body)

(defvar client-state (make-gomuks-state :rooms '() :spaces '()))

(defvar gomuks-server-buffer (get-buffer-create "*gomuks-server*"))
(defvar gomuks-socket-buffer "*gomuks-socket-frame*")
(defvar gomuks-server-name "*gomuks-server*")
(defvar gomuks-server-bin "~/Downloads/gomuks")
(defvar gomuks-server-proc
  (start-process gomuks-server-name gomuks-server-buffer gomuks-server-bin))

(defvar gomuks-url "http://localhost:29325")
(defvar gomuks-auth-endpoint (concat gomuks-url "/_gomuks/auth"))
(defvar gomuks-auth-cookie )

(defvar gomuks-ws-endpoint (concat gomuks-url "/_gomuks/websocket"))

(defvar gomuks-auth-cookie nil)
(defvar gomuks-websocket nil)
(defvar gomuks-ping-timer nil)
(defun gomuks-connect (gomuks-username)
  "Opens a websocket connection with the specified gomuks endpoint"
  (interactive "sGomuks Username: \n")
  (let ((gomuks-password (read-passwd "Gomuks Password:")))
    (setq gomuks-auth-cookie (let ((request--curl-cookie-jar (expand-file-name (make-temp-name "gomuks-cookie-")
									       temporary-file-directory)))
			       (request gomuks-auth-endpoint
				 :type "POST"
				 :headers `(("Authorization" .
					     ,(concat "Basic "
						      (base64-encode-string
						       (concat gomuks-username ":" gomuks-password))))))
			       (sleep-for 0.5)
			       (cdar (request--netscape-get-cookies request--curl-cookie-jar "localhost" "/_gomuks" t)))))
  (setq gomuks-ping-timer (run-with-timer
			   0
			   15
			   (lambda ()
			     (message "pinging")
			     (websocket-send-text gomuks-websocket
						  "{\"command\":\"ping\"}"))))
  (setq gomuks-websocket (websocket-open "ws://localhost:29325/_gomuks/websocket"
					 :custom-header-alist
					 `(("Cookie" . ,(concat "gomuks_auth=" gomuks-auth-cookie)))
					 :on-message (lambda (_ws frame)
						       (message "frame %s %s" (websocket-frame-completep frame) (websocket-frame-text 
														 frame))
						       (cond
							((not (websocket-frame-completep frame))
							 (message "frame incomplete")
							 (with-current-buffer (get-buffer-create gomuks-socket-buffer)
							   (goto-char (point-max))
							   (insert (websocket-frame-payload frame))))
							(t
							 (message "frame complete")
							 (let* ((combined-payload
								 (unwind-protect
								     (with-current-buffer (get-buffer-create gomuks-socket-buffer)
								       (goto-char (point-max))
								       (insert (websocket-frame-payload frame))
								       (message "%s" (buffer-string))
								       (buffer-string))
								   (kill-buffer (get-buffer-create gomuks-socket-buffer))))
								(msg (json-parse-string (decode-coding-string combined-payload 'utf-8)
											:object-type 'alist
											:array-type 'list
											:null-object '())))
							   (message "test %S" msg)
							   (cond ((equal (alist-get 'command msg) "sync_complete")
								  (gomuks-sync-state (alist-get 'data msg)))))))))))

(defun gomuks-disconnect ()
  "Disconnect the gomuks websocket."
  (interactive)
  (cancel-timer gomuks-ping-timer)
  (websocket-close gomuks-websocket))

(defun gomuks-process-initial-events (events)
  (mapcar
   (lambda (event)
     (cond
      ((and (or
	     (equal (alist-get 'type event) "m.room.message")
	     (equal (alist-get 'decrypted_type event) "m.room.message"))
	    (not (assoc 'relation_type event))) ;; Not an edit
       (cons
	(alist-get 'event_id event)
	(make-message :row-id (alist-get 'rowid event)
		      :id (alist-get 'event_id event)
		      :sender (alist-get 'sender event)
		      :body (if (assoc 'decrypted event)
				(alist-get 'body (alist-get 'decrypted event))
			      (alist-get 'body (alist-get 'content event))))))
      (t
       (cons (alist-get 'event_id event)
	     nil))))
   events))

(defun gomuks-sync-state (data)
  (let ((spaces (alist-get 'top_level_spaces data))
	(rooms (alist-get 'rooms data)))
    (when (< 0 (length spaces))
      (setf (gomuks-state-spaces client-state) spaces))
    (when (< 0 (length rooms))
      (dolist (rm rooms)
	(when (not (alist-get 'tombstone (alist-get 'meta (cdr rm))))
	  (if (not (alist-get (car rm) (gomuks-state-rooms client-state)))
	      (setf (gomuks-state-rooms client-state)
		    (cons (cons
			   (car rm)
			   (make-room :id (car rm)
				      :name (alist-get 'name (alist-get 'meta (cdr rm)))
				      :topic (alist-get 'topic (alist-get 'meta (cdr rm)))
				      :events (gomuks-process-initial-events (alist-get 'events (cdr rm)))))
			  (gomuks-state-rooms client-state)))
	    (let ((target-room (alist-get (car rm) (gomuks-state-rooms client-state))))
	      (setf (room-name target-room) (alist-get 'name (alist-get 'meta (cdr rm))))
	      (setf (room-topic target-room) (alist-get 'topic (alist-get 'meta (cdr rm))))
	      (setf (room-events target-room) (append (room-events target-room)
						      (gomuks-process-initial-events (alist-get 'events (cdr rm))))))))))))

(provide 'gomuks)

;;; gomuks.el ends here