You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 

200 lines
8.7 KiB

(in-package :nea/ircd)
(defparameter *groupchat-capabilities*
'(:send-message :change-roles :change-subject)
"List of defined groupchat capabilities in this implementation.")
(defparameter *standard-roles*
'((:operator . (:*))
(:voiced-user . (:send-message :change-subject))
(:user . (:send-message)))
"Alist of standard role names to the capabilities assigned to each role.")
(defun thing-to-string (obj)
"Converts a symbol to a string using SYMBOL-NAME, converts strings to strings by doing nothing, and formats other things into strings using ~A."
(typecase obj
(symbol (symbol-name obj))
(string obj)
(t (format nil "~A" obj))))
(defun create-groupchat (&optional subject)
"Creates a new groupchat, with an optional subject.
Will add the *STANDARD-ROLES* to the newly created groupchat, and add this server as a sponsoring server."
(pomo:with-logical-transaction ()
(let* ((uuid (uuid:make-v4-uuid))
(uuid-db (format nil "~A" uuid)))
(execute-one (:insert-into 'groupchats
:set 'uuid '$1 'subject '$2)
uuid-db (or subject ""))
(loop
for (name . caps) in *standard-roles*
do (progn
(let ((role-id (pomo:query (:insert-into 'groupchat_roles
:set 'groupchat_uuid '$1 'role_name '$2
:returning 'role_id)
uuid-db (symbol-name name) :single!)))
(loop
for cap in caps
do (execute-one (:insert-into 'groupchat_role_capabilities
:set 'role_id '$1 'capability '$2)
role-id (symbol-name cap))))))
uuid)))
(defun check-groupchat-exists (gcid)
"Check the groupchat with ID GCID exists."
(unless (> (pomo:query (:select (:count '*)
:from 'groupchats
:where (:= 'uuid '$1))
(format t "~A" gcid))
0)
(error "Groupchat with ID ~A does not exist." gcid)))
(defun get-role-by-name (gcid name)
"Gets the role ID for the role with name NAME (a symbol, or string) in the groupchat with ID GCID."
(declare (type uuid:uuid gcid))
(pomo:query (:select 'role_id
:from 'groupchat_roles
:where (:and
(:= 'groupchat_uuid '$1)
(:= 'role_name '$2)))
(format nil "~A" gcid) (thing-to-string name) :single!))
(defun groupchat-member-p (gcid uid)
"Returns a generalized boolean signifying whether the user with ID UID is a member of the groupchat with ID GCID."
(declare (type uuid:uuid gcid) (type integer uid))
(> (pomo:query (:select (:count '*)
:from 'groupchat_memberships
:where (:and
(:= 'groupchat_uuid '$1)
(:= 'user_id '$2)))
(format nil "~A" gcid) uid :single!)
0))
(defun insert-groupchat-membership (gcid uid role)
"Adds the user with ID UID to the groupchat with ID GCID, using the role ROLE (a symbol, or a string)."
(declare (type uuid:uuid gcid) (type integer uid))
(pomo:with-logical-transaction ()
(let* ((gcid-db (format nil "~A" gcid))
(role-id (get-role-by-name gcid role)))
(execute-one (:insert-into 'groupchat_memberships
:set 'groupchat_uuid '$1 'user_id '$2 'role_id '$3)
gcid-db uid role-id)
t)))
(defun delete-groupchat-membership (gcid uid)
"Removes the user with ID UID from the groupchat with ID GCID."
(declare (type uuid:uuid gcid) (type integer uid))
(execute-one (:delete-from 'groupchat_memberships
:where (:and
(:= 'groupchat_uuid '$1)
(:= 'user_id '$2)))
(format nil "~A" gcid) uid))
(defun update-groupchat-membership (gcid uid role)
"Updates the role for the user with ID UID to ROLE (a symbol, or a string) for the groupchat with ID GCID."
(declare (type uuid:uuid gcid) (type integer uid))
(pomo:with-logical-transaction ()
(let* ((gcid-db (format nil "~A" gcid))
(role-id (get-role-by-name gcid role)))
(execute-one (:update 'groupchat_memberships
:set 'role_id '$3
:where (:and
(:= 'groupchat_uuid '$1)
(:= 'user_id '$2)))
gcid-db uid role-id)
t)))
(defun check-groupchat-capability (gcid uid cap)
"Checks that the user with ID UID has the capability CAP in the groupchat with ID GCID. Returns a boolean."
(declare (type uuid:uuid gcid) (type integer uid))
(> (pomo:query (:select (:count '*)
:from (:as 'groupchats 'gc) (:as 'groupchat_roles 'gcr) (:as 'groupchat_role_capabilities 'gcrc) (:as 'groupchat_memberships 'gcm)
:where (:and
(:= 'gc.uuid '$1)
(:= 'gcm.user_id '$2)
(:= 'gcm.groupchat_uuid 'gc.uuid)
(:= 'gcr.groupchat_uuid 'gc.uuid)
(:= 'gcr.role_id 'gcm.role_id)
(:= 'gcrc.role_id 'gcr.role_id)
(:or
(:= 'gcrc.capability '$3)
(:= 'gcrc.capability "*"))))
(format nil "~A" gcid) uid (thing-to-string cap) :single!)
0))
(defun get-groupchat-by-directory-name (name)
"Get the ID of a groupchat with server-local directory name NAME, or return NIL if no such groupchat exists."
(pomo:query (:select 'uuid
:from 'groupchat_directory_entries
:where (:= 'name '$1))
name :single))
(defun add-groupchat-directory-entry (gcid name)
"Add a new directory entry for the groupchat with ID GCID, under NAME."
(execute-one (:insert-into 'groupchat_directory_entries
:set 'name '$1 'uuid '$2)
name (format nil "~A" gcid)))
(defun get-groupchat-names (gcid)
"Returns an alist of usernames in the groupchat with ID GCID, mapped to the name of their role."
(let ((ret nil))
(pomo:doquery ((:select 'u.username 'gcr.role_name
:from (:as 'users 'u) (:as 'groupchat_roles 'gcr) (:as 'groupchat_memberships 'gcm)
:where (:and
(:= 'gcr.groupchat_uuid '$1)
(:= 'gcr.role_id 'gcm.role_id)
(:= 'gcm.groupchat_uuid '$1)
(:= 'u.id 'gcm.user_id)))
(format nil "~A" gcid))
(username role-name)
(setf ret (acons username (intern role-name (find-package :keyword)) ret)))
ret))
(defun get-groupchats-for-user (uid)
"Returns a list of UUIDs of all groupchats the user with id UID is in."
(declare (type integer uid))
(pomo:query (:select 'groupchat_uuid
:from 'groupchat_memberships
:where (:= 'user_id '$1))
uid :column))
(defun get-groupchat-directory-name (gcid)
"Returns the directory entry name for the groupchat with ID GCID, or NIL if it doesn't exist."
(pomo:query (:select 'name
:from 'groupchat_directory_entries
:where (:= 'uuid '$1))
(format nil "~A" gcid) :single))
(defun get-groupchat-subject (gcid)
"Returns the groupchat subject for the groupchat with ID GCID, or NIL if it doesn't exist."
(pomo:query (:select 'subject
:from 'groupchats
:where (:= 'uuid '$1))
(format nil "~A" gcid) :single))
(defun update-groupchat-subject (gcid subject)
"Sets the subject for the groupchat with ID GCID to SUBJECT."
(execute-one (:update 'groupchats
:set 'subject '$1
:where (:= 'uuid '$2))
subject (format nil "~A" gcid)))
(defun get-groupchat-name (gcid)
"Returns the client groupchat name for the groupchat with ID GCID."
(let ((dirname (get-groupchat-directory-name gcid)))
(if dirname
(format nil "#~A" dirname)
(format nil "&~A" gcid))))
(defun get-or-make-groupchat-by-directory-name (name)
"Retrieves or creates a groupchat with server-local directory name #NAME, returning its groupchat ID.
Rather like joining a channel in IRC, asking for a NAME that doesn't exist results in a new groupchat being created, and a directory entry being added for it.
As a second value, returns T if the groupchat was newly created, or NIL if not."
(pomo:with-logical-transaction ()
(let ((gc-uuid (get-groupchat-by-directory-name name)))
(if gc-uuid
(values gc-uuid nil)
(progn
(let ((gc-uuid (create-groupchat)))
(add-groupchat-directory-entry gc-uuid name)
(values gc-uuid t)))))))