mattermost.el/mattermost.el

;;; mattermost.el --- An Emacs Mattermost Chat Client

;; ToDo: LICENSE HERE

;; Author: Miguel de la Cruz (mgdelacroix@gmail.com)
;; Version: 0.1
;; Package-Requires: ((websocket))
;; Keywords: Mattermost, chat, client, Internet

;;; Code:

(require 'websocket)

(defgroup mattermost nil
  "Mattermost chat client"
  :prefix "mattermost-"
  :group 'applications)

(defcustom mattermost-login-id ""
  "The username or email to log in the Mattermost server"
  :group 'mattermost
  :type 'string)

(defcustom mattermost-host ""
  "The hostname of the Mattermost server"
  :group 'mattermost
  :type 'string)

;; ToDo: internal variables should be prefixed with mattermost--
;; instead?
(defvar mattermost-users-plist '()
  "A plist with the server users by id")

(defvar mattermost-token nil
  "The user token to access the server")

(defvar mattermost-user-id nil
  "The ID of the authenticated user")

(defvar mattermost-websocket nil
  "The websocket connected to the server")

(defvar mattermost-buffers '()
  "Plist with all the open channel buffers")

(defvar-local mattermost-prompt-marker nil
  "The marker that shows where the prompt starts")

(defvar-local mattermost-insert-marker nil
  "The marker that shows where a new message should be inserted")

(defvar-local mattermost-channel-id nil
  "The buffer channel ID")

(defconst mattermost-root-buffer-name "*Mattermost Root*"
  "The name of the root buffer")

;; ToDo: probably not the best way to get a keyword from a string
(defun mattermost-string->keyword (str)
  "Returns a keyword from a string"
  (intern (concat ":" str)))

(defun mattermost-json-parse-string (string)
  "Parses a JSON string"
  (with-temp-buffer
    (insert string)
    (beginning-of-buffer)
    (mattermost-read-json)))

(defun mattermost-read-json ()
  "Parses the JSON in the current buffer after a url-request"
  (let ((json-object-type 'plist)
        (json-array-type 'list)
        (json-key-type 'keyword))
    (set-buffer-multibyte t)
    (if (boundp 'url-http-end-of-headers)
        (goto-char url-http-end-of-headers))
    (json-read)))

(defun mattermost-read-password ()
  "Reads the password from the auth-source"
  (let ((res (auth-source-search :max 1 :host mattermost-host :user mattermost-login-id)))
    (if (and (listp res) (= (length res) 1))
        (let ((secret (plist-get (car res) :secret)))
          (if (functionp secret)
              (funcall secret)
            secret)))))

(defun mattermost--get-user (user-id)
  "Returns the user from the internal cache and fills the cache
if the user is not present"
  (let* ((user-id-keyword (mattermost-string->keyword user-id))
         (user (plist-get mattermost-users-plist user-id-keyword)))
    (if (not user)
        (let ((user (mattermost-get-user user-id)))
          (setq mattermost-users-plist (plist-put mattermost-users-plist user-id-keyword user))
          user)
      user)))

(defun mattermost--get-auth-challenge ()
  "Returns the JSON representation of the websocket authentication challenge"
  (json-encode `(:seq 1
                      :action "authentication_challenge"
                      :data (:token ,mattermost-token))))

(defun mattermost--ws-posted-to-post (msg)
  "Extracts the post from a ws posted frame and transforms it to
conform to a post plist"
  (let* ((post (plist-get (plist-get msg :data) :post)))
    (mattermost-json-parse-string post)))

(defun mattermost--process-ws-posted (msg)
  "Processes a websocket posted message"
  (let* ((channel-name (plist-get (plist-get msg :data) :channel_name))
         (channel-display-name (plist-get (plist-get msg :data) :channel_display_name))
         (post (mattermost--ws-posted-to-post msg))
         (channel-id (plist-get post :channel_id))
         (chanb (plist-get mattermost-buffers (mattermost-string->keyword channel-id))))
    ;; ToDo: check if buffer not deleted or better, hook into kill
    ;; buffer hook on mattermost-channel-mode and remove buffer from
    ;; mattermost-buffers variable so it's not found
    (if (not (null chanb))
        ;; If chanb not current buffer, add a notification, maybe both
        ;; in the modeline and in a buffer chan -> notif
        (with-current-buffer chanb
          (save-excursion
            (goto-char mattermost-insert-marker)
            (mattermost-insert-post post))))))

(defun mattermost--process-ws-frame (_ws frame)
  "Processes a websocket frame"
  (let* ((text (websocket-frame-text frame))
         (msg (mattermost-json-parse-string text))
         (event (plist-get msg :event)))
    (cond ((string= event "posted") (mattermost--process-ws-posted msg))
          (t (lwarn 'mattermost :debug (format "INCOMING> %s" msg))))))

(defun mattermost--connect-websocket ()
  "Returns a websocket configured to connect to the Mattermost
  host and to dispatch and process the incoming messages"
  (websocket-open (format "wss://%s/api/v4/websocket" mattermost-host)
                  :on-open (lambda (ws)
                             (websocket-send-text ws (mattermost--get-auth-challenge)))
                  :on-message 'mattermost--process-ws-frame
                  :on-close (lambda (ws)
                              (lwarn 'mattermost :debug "websocket connection closed"))))

;; ToDo: once mattermost-request parses headers, use it to fetch both
;; the user (set the id to a local var) and the headers (set the
;; token)
(defun mattermost-login (username password)
  "Log into the Mattermost Server"
  (let ((url-request-method "POST")
        (url-request-extra-headers '(("Content-Type" . "application/json")))
        (url-request-data (json-serialize `(:login_id ,username :password ,password))))
    (with-current-buffer (url-retrieve-synchronously (concat "https://" mattermost-host "/api/v4/users/login"))
      (beginning-of-buffer)
      (search-forward "Token: ")
      (let ((token (word-at-point))
            (response (mattermost-read-json)))
        (setq mattermost-token token)
        (setq mattermost-user-id (plist-get response :id))
        (setq mattermost-websocket (mattermost--connect-websocket))
        token))))

;; ToDo: update to parse headers as well
(defun mattermost-request (method url &optional body)
  "Builds a Mattermost request and returns the JSON response"
  (let ((url-request-method method)
        (url-request-extra-headers `(("Content-Type" . "application/json")))
        (url-request-data (if body (encode-coding-string (json-serialize body) 'utf-8))))
    (if mattermost-token
        (add-to-list 'url-request-extra-headers `("Authorization" . ,(concat "Bearer " mattermost-token))))
    (with-current-buffer (url-retrieve-synchronously (concat "https://" mattermost-host "/api/v4" url) t)
      (mattermost-read-json))))

(defun mattermost-get-user (user-id)
  "Returns the user information"
  (mattermost-request "GET" (format "/users/%s" user-id)))

(defun mattermost-get-teams ()
  "Returns the user's team list"
  (mattermost-request "GET" "/teams"))

(defun mattermost-get-channels (team-id)
  "Returns the user's channel for a given team"
  (let ((url (format "/users/%s/teams/%s/channels" mattermost-user-id team-id)))
    (mattermost-request "GET" url)))

(defun mattermost-get-channel-messages (channel-id &optional page per-page)
  "Returns a list of posts for a given channel"
  (let ((url (format "/channels/%s/posts" channel-id)))
    (mattermost-request "GET" url)))

(define-button-type 'mattermost-channel
  'face 'default
  'mouse-face 'nil
  'read-only t
  'rear-sticky t
  'front-sticky t
  'action #'(lambda (b)
              (let* ((channel (button-get b 'channel)))
                (mattermost-show-channel channel))))

(defun mattermost-create-post (message channel-id)
  "Creates a post on a channel"
  (mattermost-request "POST" "/posts" `(:channel_id ,channel-id :message ,message)))

(defun mattermost--get-channel-display-name (channel)
  "Returns the string to be used as channel display name"
  (let ((channel-display-name (plist-get channel :display_name))
        (channel-name (plist-get channel :name))
        (channel-type (plist-get channel :type)))
    (cond ((string= channel-type "D")
           (let* ((direct-message-user-id (car (split-string channel-name "__")))
                  (user (mattermost--get-user direct-message-user-id)))
             (format "@%s" (plist-get user :username))))
          (t (if (string-empty-p channel-display-name)
                 channel-name
               channel-display-name)))))

(defun mattermost-insert-channel (channel)
  "Inserts a channel button in the current buffer"
  (let* ((name (mattermost--get-channel-display-name channel)))
    (insert-text-button (format "> %s\n" name)
                        :type 'mattermost-channel
                        'channel channel)))

;; ToDo: when root buffer is closed, disconnect
(defun mattermost-show-root ()
  "Populates the Mattermost Root buffer and changes to it"
  (interactive)
  (let ((rootb (get-buffer-create mattermost-root-buffer-name)))
    (with-current-buffer rootb
      (let ((inhibit-read-only t)
            (teams (mattermost-get-teams)))
        (erase-buffer)
        (dolist (team teams)
          (let* ((team-id (plist-get team :id))
                 (team-display-name (plist-get team :display_name))
                 (channels (mattermost-get-channels team-id)))
            (insert (format "%s\n" team-display-name))
            (dolist (channel channels)
              (mattermost-insert-channel channel))))))
    (switch-to-buffer rootb)
    (mattermost-root-mode)
    (beginning-of-buffer)))

(defvar mattermost-root-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "n") #'next-line)
    (define-key map (kbd "p") #'previous-line)
    (define-key map (kbd "q") #'bury-buffer)
    (define-key map (kbd "g") #'mattermost-show-root)
    map)
  "The keymap for mattermost-root-mode")

(define-derived-mode mattermost-root-mode fundamental-mode "Mattermost Root"
  "Mode to list the Mattermost teams and channels to allow the
user to check their status and select between them")

(defun mattermost--kill-root-function ()
  "Function to call when the Mattermost root buffer is killed"
  (when (eq major-mode 'mattermost-root-mode)
    (mattermost-disconnect)))

(defvar mattermost-username-button-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map button-map)
    (define-key map (kbd "n") #'next-line)
    (define-key map (kbd "p") #'previous-line)
    map))

(define-button-type 'mattermost-username
  'face 'bold
  'mouse-face 'nil
  'read-only t
  'rear-sticky t
  'front-sticky t
  'keymap mattermost-username-button-map
  'action #'(lambda (b)
              (let* ((user (button-get b 'user)))
                (message "action for user %s!" (plist-get user :username)))))

(defvar mattermost-post-button-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map button-map)
    (define-key map (kbd "n") #'next-line)
    (define-key map (kbd "p") #'previous-line)
    map))

(define-button-type 'mattermost-post
  'face 'default
  'mouse-face 'nil
  'read-only t
  'rear-sticky t
  'front-sticky t
  'keymap mattermost-post-button-map
  'action #'(lambda (b)
              (let* ((post (button-get b 'post)))
                (message "action for post %s!" (plist-get post :id)))))

(defun mattermost-insert-post (post)
  "Inserts a post message in the current buffer"
  (let* ((inhibit-read-only t)
         (user-id (plist-get post :user_id))
         (user (mattermost--get-user user-id))
         (username (plist-get user :username))
         (msg (plist-get post :message))
         (username-text (format "[%s]" username))
         (post-text (format " %s\n" msg)))
    (insert-before-markers username-text)
    (make-text-button (- (point) (length username-text)) (point)
                      :type 'mattermost-username
                      'user user)
    (insert-before-markers post-text)
    (make-text-button (- (point) (length post-text)) (point)
                      :type 'mattermost-post
                      'post post)))

(defun mattermost-prompt ()
  "Shows the message prompt"
  (end-of-buffer)
  (set-marker mattermost-insert-marker (point))
  (setq prompt (propertize ">> "
                           'rear-nonsticky t
                           'field t
                           'front-sticky t
                           'read-only t))
  (put-text-property 0 (1- (length prompt))
                     'font-lock-face 'bold
                     prompt)
  (insert prompt)
  (set-marker mattermost-prompt-marker (point)))

(defun mattermost-channel-ret ()
  "Sends the post if on the input field or the button action
  otherwise"
  (interactive)
  (if (> (point) mattermost-prompt-marker)
      (let ((inhibit-read-only t)
            (msg (field-string-no-properties (point))))
        (mattermost-create-post msg mattermost-channel-id)
        (delete-field (point)))))

(defvar mattermost-channel-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "C-<return>") 'newline)
    (define-key map (kbd "C-m") 'mattermost-channel-ret)
    map)
  "The keymap for mattermost-channel-mode")

(define-derived-mode mattermost-channel-mode fundamental-mode "Mattermost Channel"
  "Mode use on a Mattermost channel buffer, that shows the
  messages of the channel and allows the user to post theirs")

(defun mattermost--kill-buffer-function ()
  "Function to call when a Mattermost buffer is killed"
  (when (eq major-mode 'mattermost-channel-mode)
    (setq mattermost-buffers
          (plist-put mattermost-buffers (mattermost-string->keyword mattermost-channel-id) nil))))

;; ToDo: should we receive just a channel id and fetch the channel
;; data?
(defun mattermost-show-channel (channel)
  "Populates the channel buffer with posts and the prompt"
  (let* ((inhibit-read-only t)
         (id (plist-get channel :id))
         (name (mattermost--get-channel-display-name channel))
         (chanb (get-buffer-create (format "> %s <" name))))

    ;; ToDo: somehow check if the buffer already exists to populate it
    ;; only if it doesn't

    (with-current-buffer chanb
      (erase-buffer)
      (let* ((resp (mattermost-get-channel-messages id))
             (order (seq-reverse (plist-get resp :order)))
             (posts (plist-get resp :posts)))
        (dolist (post-id order)
          (let* ((post (plist-get posts (mattermost-string->keyword post-id))))
            (mattermost-insert-post post))))
      (mattermost-channel-mode))
    (setq mattermost-buffers
          (plist-put mattermost-buffers (mattermost-string->keyword id) chanb))
    (switch-to-buffer chanb)
    (setq mattermost-channel-id id)
    (setq mattermost-prompt-marker (make-marker))
    (setq mattermost-insert-marker (make-marker))
    (mattermost-prompt)
    (end-of-buffer)))

(defun mattermost ()
  "Connect to a Mattermost instance"
  (interactive)
  (if (string-empty-p mattermost-login-id)
      ;; ToDo: throw error here
      (lwarn 'mattermost :error "`mattermost-login-id` cannot be empty"))
  (if (string-empty-p mattermost-host)
      ;; ToDo: throw error here
      (lwarn 'mattermost :error "`mattermost-host` cannot be empty"))
  (mattermost-disconnect)
  (let ((password (mattermost-read-password)))
    (mattermost-login mattermost-login-id password))
  (add-hook 'kill-buffer-hook #'mattermost--kill-root-function)
  (add-hook 'kill-buffer-hook #'mattermost--kill-buffer-function)
  (mattermost-show-root))

(defun mattermost--kill-all-buffers ()
  "Kills all Mattermost related buffers"
  (remove-hook 'kill-buffer-hook #'mattermost--kill-root-function)
  (remove-hook 'kill-buffer-hook #'mattermost--kill-buffer-function)
  (while (car mattermost-buffers)
    (let ((buf (car (cdr mattermost-buffers)))
          (tail (cddr mattermost-buffers)))
      (setq mattermost-buffers tail)
      (kill-buffer buf)))
  (setq mattermost-buffers '())
  (unless (null (get-buffer mattermost-root-buffer-name))
    (kill-buffer mattermost-root-buffer-name)))

(defun mattermost-disconnect ()
  "Closes the connection with the Mattermost server"
  (interactive)
  (mattermost--kill-all-buffers)
  (unless (null mattermost-websocket)
    (websocket-close mattermost-websocket))
  (setq mattermost-token nil
        mattermost-user-id nil
        mattermost-websocket nil))

(provide 'mattermost)
;;; mattermost.el ends here