more stuff -- lost track

This commit is contained in:
dominik martinez 2025-03-09 00:35:19 -08:00
parent cfb760c3b2
commit 456a66bb44
7 changed files with 58 additions and 33 deletions

View file

@ -20,6 +20,7 @@
:components :components
((:file "package") ((:file "package")
(:file "logging") (:file "logging")
(:file "json")
(:file "db") (:file "db")
(:file "auth") (:file "auth")
(:file "matrix") (:file "matrix")

View file

@ -28,6 +28,8 @@
(to-check-hash (ironclad:byte-array-to-hex-string (generate-hash to-check passphrase-salt)))) (to-check-hash (ironclad:byte-array-to-hex-string (generate-hash to-check passphrase-salt))))
(equal to-check-hash passphrase-hash))) (equal to-check-hash passphrase-hash)))
;; AUTH SESSION
(defvar *auth-sessions* (make-hash-table :test 'equal)) (defvar *auth-sessions* (make-hash-table :test 'equal))
(defclass auth-session () (defclass auth-session ()
@ -48,15 +50,24 @@
(defclass password-auth-session (auth-session) (defclass password-auth-session (auth-session)
((stages :initform (list (make-instance 'password-auth-stage))))) ((stages :initform (list (make-instance 'password-auth-stage)))))
;;
;; AUTH STAGE
(defclass auth-stage () (defclass auth-stage ()
((type :reader auth-stage-type))) ((type :reader auth-stage-type)))
(defclass password-auth-stage (auth-stage) (defclass password-auth-stage (auth-stage)
((type :initform "m.login.password."))) ((type :initform "m.login.password.")))
(defgeneric process-input (auth-stage input)) (defgeneric process-input (auth-stage input)
(:documentation
"Process the plist INPUT as specified by AUTH-STAGE. Return two values, the first being T if the input is successful, NIL if not. The second value is when the first is NIL and there's additional information regarding the failure."))
(defmethod process-input ((auth-stage password-auth-stage) input)) (defmethod process-input ((auth-stage (eql '|m.login.password|)) input)
(destructuring-bind (&key identifier password &allow-other-keys) input
(let ((user (db:get-user identifier))))))
;;
(defun get-user-from-access-token (access-token) (defun get-user-from-access-token (access-token)
(let ((device (get-device access-token))) (let ((device (get-device access-token)))
@ -80,9 +91,14 @@
(continue-auth-session matrix-input) (continue-auth-session matrix-input)
(start-auth-session matrix-input))) (start-auth-session matrix-input)))
(defun start-auth-session (matrix-input) ;; (defun start-auth-session (matrix-input)
(let ((auth-session (make-instance 'password-auth-session))) ;; (let ((auth-session (make-instance 'password-auth-session)))
(setf (gethash (session-id auth-session) *auth-sessions*) auth-session) ;; (setf (gethash (session-id auth-session) *auth-sessions*) auth-session)
(json-response 401 (auth-session-plist auth-session)))) ;; (json-response 401 (auth-session-plist auth-session))))
;; ENDPOINTS
(defun get-login (input)
(log-info input))

View file

@ -1,9 +1,11 @@
(in-package :cl-matrix) (in-package :cl-matrix-db)
(defmethod insert (dao-model) (defmethod insert (dao-model)
(postmodern:with-connection cl-matrix-config:+database+ (postmodern:with-connection cl-matrix-config:+database+
(postmodern:insert-dao dao-model))) (postmodern:insert-dao dao-model)))
;; USER
(defclass user () (defclass user ()
((id :col-type string :initarg :id :reader id) ((id :col-type string :initarg :id :reader id)
(password-hash :col-type string :initarg :password-hash :accessor password-hash)) (password-hash :col-type string :initarg :password-hash :accessor password-hash))
@ -11,13 +13,21 @@
(:keys id) (:keys id)
(:table-name users)) (:table-name users))
(defun get-user (id) (defun get-id (identity)
(cl-matrix::log-info (intern (getf identity :type "")))
(case (alex:make-keyword (getf identity :type ""))
(:|m.id.user| (getf identity :user))
(otherwise (error 'cl-matrix::forbidden-error))))
(defun get-user (identity)
(postmodern:with-connection cl-matrix-config:+database+ (postmodern:with-connection cl-matrix-config:+database+
(postmodern:get-dao 'user id))) (postmodern:get-dao 'user (get-id identity))))
(defun make-user (id password-hash) (defun make-user (id password-hash)
(make-instance 'user :id id :password-hash password-hash)) (make-instance 'user :id id :password-hash password-hash))
;; DEVICE
(defclass device () (defclass device ()
((user-id :col-type string :col-references ((user id)) :initarg :user-id :reader user-id) ((user-id :col-type string :col-references ((user id)) :initarg :user-id :reader user-id)
(id :col-type string :initarg :id :accessor id) (id :col-type string :initarg :id :accessor id)
@ -31,16 +41,18 @@
(postmodern:with-connection cl-matrix-config:+database+ (postmodern:with-connection cl-matrix-config:+database+
(postmodern:get-dao 'device access-token))) (postmodern:get-dao 'device access-token)))
(defun db-create-tables () ;; UTILS
(defun create-tables ()
(postmodern:with-connection cl-matrix-config:+database+ (postmodern:with-connection cl-matrix-config:+database+
(postmodern:execute (postmodern:dao-table-definition 'user)) (postmodern:execute (postmodern:dao-table-definition 'user))
(postmodern:execute (postmodern:dao-table-definition 'device)))) (postmodern:execute (postmodern:dao-table-definition 'device))))
(defun db-drop-tables () (defun drop-tables ()
(postmodern:with-connection cl-matrix-config:+database+ (postmodern:with-connection cl-matrix-config:+database+
(postmodern:execute "DROP TABLE users;") (postmodern:execute "DROP TABLE users;")
(postmodern:execute "DROP TABLE devices;"))) (postmodern:execute "DROP TABLE devices;")))
(defun db-seed () (defun seed ()
(let ((harry-dubois (make-user "@harry:rcm.org" (generate-hash-with-salt "martinaise")))) (let ((harry-dubois (make-user "@harry:rcm.org" (cl-matrix::generate-hash-with-salt "martinaise"))))
(insert harry-dubois))) (insert harry-dubois)))

View file

@ -2,7 +2,7 @@
(defparameter *running-server* nil) (defparameter *running-server* nil)
(defun server-start () (defun start-server ()
(if *running-server* (if *running-server*
(log-info "server already running") (log-info "server already running")
(progn (progn
@ -10,7 +10,7 @@
(clack:clackup 'router :server :woo)) (clack:clackup 'router :server :woo))
(log-info "server started")))) (log-info "server started"))))
(defun server-stop () (defun stop-server ()
(if *running-server* (if *running-server*
(progn (progn
(clack:stop *running-server*) (clack:stop *running-server*)
@ -18,6 +18,6 @@
(log-info "no running server to shutdown")) (log-info "no running server to shutdown"))
(setq *running-server* nil)) (setq *running-server* nil))
(defun server-restart () (defun restart-server ()
(server-stop) (stop-server)
(server-start)) (start-server))

View file

@ -62,9 +62,6 @@
threepid-in-use) threepid-in-use)
(defun versions (input) (defun versions (input)
(json-response 200 '(:versions ("v1.1" "v1.2" "v1.3" "v1.4" "v1.5" "v1.6" "v1.7" "v1.8" "v1.9" "v1.10" "v1.11" "v1.12" "v1.13")))) (json-response 200 '(:versions ("r0.0.1" "r0.1.0" "r0.2.0" "r0.3.0" "r0.4.0" "r0.5.0" "r0.6.0" "r0.6.1" "v1.1" "v1.2" "v1.3" "v1.4" "v1.5" "v1.6" "v1.7" "v1.8" "v1.9" "v1.10" "v1.11" "v1.12" "v1.13"))))
(defun get-logins (input)
(log-info input))

View file

@ -1,7 +1,10 @@
(defpackage cl-matrix-db (defpackage cl-matrix-db
(:use #:cl)) (:use #:cl)
(:local-nicknames (:alex :alexandria))
(:export :get-user))
(defpackage cl-matrix (defpackage cl-matrix
(:use #:cl) (:use #:cl)
(:local-nicknames (:jzon :com.inuoe.jzon) (:local-nicknames (:jzon :com.inuoe.jzon)
(:alex :alexandria))) (:alex :alexandria)
(:db :cl-matrix-db)))

View file

@ -40,10 +40,8 @@
(defmethod handle-condition ((err matrix-error)) (defmethod handle-condition ((err matrix-error))
(json-response 400 `(:errcode ,(errcode err) :error ,(msg err)))) (json-response 400 `(:errcode ,(errcode err) :error ,(msg err))))
(define-condition route-not-found (error) ()) (defmethod handle-condition ((err unrecognized-error))
(json-response 404 `(:errcode ,(errcode err) :error ,(msg err))))
(defmethod handle-condition ((err route-not-found))
(json-response 404 nil))
(defun wrap-url-match (url-pattern handler) (defun wrap-url-match (url-pattern handler)
(lambda (env) (lambda (env)
@ -62,19 +60,17 @@
*routes*)) *routes*))
(defun router (env) (defun router (env)
(log-info env) (log-info (getf env :path-info))
(handler-case (handler-case
(loop for route in *routes* (loop for route in *routes*
when (funcall route env) when (funcall route env)
return it return it
finally (error 'route-not-found)) finally (error 'unrecognized-error))
(matrix-error (c) (matrix-error (c)
(handle-condition c))
(route-not-found (c)
(handle-condition c)))) (handle-condition c))))
;; earlier defined routes have lower precedence ;; earlier defined routes have lower precedence
(defroute :get "^/_matrix/client/versions$" versions) (defroute :get "^/_matrix/client/versions$" versions)
(defroute :get "^/_matrix/client/login" get-logins) (defroute :get "^/_matrix/client/v3/login" get-login)