diff --git a/cl-matrix.asd b/cl-matrix.asd index 4729b65..e8f9b6c 100644 --- a/cl-matrix.asd +++ b/cl-matrix.asd @@ -20,6 +20,7 @@ :components ((:file "package") (:file "logging") + (:file "json") (:file "db") (:file "auth") (:file "matrix") diff --git a/src/auth.lisp b/src/auth.lisp index 51723f5..94bcd03 100644 --- a/src/auth.lisp +++ b/src/auth.lisp @@ -28,6 +28,8 @@ (to-check-hash (ironclad:byte-array-to-hex-string (generate-hash to-check passphrase-salt)))) (equal to-check-hash passphrase-hash))) +;; AUTH SESSION + (defvar *auth-sessions* (make-hash-table :test 'equal)) (defclass auth-session () @@ -48,15 +50,24 @@ (defclass password-auth-session (auth-session) ((stages :initform (list (make-instance 'password-auth-stage))))) +;; + +;; AUTH STAGE (defclass auth-stage () ((type :reader auth-stage-type))) (defclass password-auth-stage (auth-stage) ((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) (let ((device (get-device access-token))) @@ -80,9 +91,14 @@ (continue-auth-session matrix-input) (start-auth-session matrix-input))) -(defun start-auth-session (matrix-input) - (let ((auth-session (make-instance 'password-auth-session))) - (setf (gethash (session-id auth-session) *auth-sessions*) auth-session) - (json-response 401 (auth-session-plist auth-session)))) +;; (defun start-auth-session (matrix-input) +;; (let ((auth-session (make-instance 'password-auth-session))) +;; (setf (gethash (session-id auth-session) *auth-sessions*) auth-session) +;; (json-response 401 (auth-session-plist auth-session)))) + +;; ENDPOINTS + +(defun get-login (input) + (log-info input)) diff --git a/src/db.lisp b/src/db.lisp index e64dc81..1112922 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -1,9 +1,11 @@ -(in-package :cl-matrix) +(in-package :cl-matrix-db) (defmethod insert (dao-model) (postmodern:with-connection cl-matrix-config:+database+ (postmodern:insert-dao dao-model))) +;; USER + (defclass user () ((id :col-type string :initarg :id :reader id) (password-hash :col-type string :initarg :password-hash :accessor password-hash)) @@ -11,13 +13,21 @@ (:keys id) (: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:get-dao 'user id))) + (postmodern:get-dao 'user (get-id identity)))) (defun make-user (id password-hash) (make-instance 'user :id id :password-hash password-hash)) +;; DEVICE + (defclass device () ((user-id :col-type string :col-references ((user id)) :initarg :user-id :reader user-id) (id :col-type string :initarg :id :accessor id) @@ -31,16 +41,18 @@ (postmodern:with-connection cl-matrix-config:+database+ (postmodern:get-dao 'device access-token))) -(defun db-create-tables () +;; UTILS + +(defun create-tables () (postmodern:with-connection cl-matrix-config:+database+ (postmodern:execute (postmodern:dao-table-definition 'user)) (postmodern:execute (postmodern:dao-table-definition 'device)))) -(defun db-drop-tables () +(defun drop-tables () (postmodern:with-connection cl-matrix-config:+database+ (postmodern:execute "DROP TABLE users;") (postmodern:execute "DROP TABLE devices;"))) -(defun db-seed () - (let ((harry-dubois (make-user "@harry:rcm.org" (generate-hash-with-salt "martinaise")))) +(defun seed () + (let ((harry-dubois (make-user "@harry:rcm.org" (cl-matrix::generate-hash-with-salt "martinaise")))) (insert harry-dubois))) diff --git a/src/main.lisp b/src/main.lisp index 0549569..5e3a1fc 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -2,7 +2,7 @@ (defparameter *running-server* nil) -(defun server-start () +(defun start-server () (if *running-server* (log-info "server already running") (progn @@ -10,7 +10,7 @@ (clack:clackup 'router :server :woo)) (log-info "server started")))) -(defun server-stop () +(defun stop-server () (if *running-server* (progn (clack:stop *running-server*) @@ -18,6 +18,6 @@ (log-info "no running server to shutdown")) (setq *running-server* nil)) -(defun server-restart () - (server-stop) - (server-start)) +(defun restart-server () + (stop-server) + (start-server)) diff --git a/src/matrix.lisp b/src/matrix.lisp index 85efb4c..4c122b3 100644 --- a/src/matrix.lisp +++ b/src/matrix.lisp @@ -62,9 +62,6 @@ threepid-in-use) (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")))) - -(defun get-logins (input) - (log-info input)) + (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")))) diff --git a/src/package.lisp b/src/package.lisp index dcc8fd0..28225ee 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1,7 +1,10 @@ (defpackage cl-matrix-db - (:use #:cl)) + (:use #:cl) + (:local-nicknames (:alex :alexandria)) + (:export :get-user)) (defpackage cl-matrix (:use #:cl) (:local-nicknames (:jzon :com.inuoe.jzon) - (:alex :alexandria))) + (:alex :alexandria) + (:db :cl-matrix-db))) diff --git a/src/routes.lisp b/src/routes.lisp index e945f02..e9ba987 100644 --- a/src/routes.lisp +++ b/src/routes.lisp @@ -40,10 +40,8 @@ (defmethod handle-condition ((err matrix-error)) (json-response 400 `(:errcode ,(errcode err) :error ,(msg err)))) -(define-condition route-not-found (error) ()) - -(defmethod handle-condition ((err route-not-found)) - (json-response 404 nil)) +(defmethod handle-condition ((err unrecognized-error)) + (json-response 404 `(:errcode ,(errcode err) :error ,(msg err)))) (defun wrap-url-match (url-pattern handler) (lambda (env) @@ -62,19 +60,17 @@ *routes*)) (defun router (env) - (log-info env) + (log-info (getf env :path-info)) (handler-case (loop for route in *routes* when (funcall route env) return it - finally (error 'route-not-found)) + finally (error 'unrecognized-error)) (matrix-error (c) - (handle-condition c)) - (route-not-found (c) (handle-condition c)))) ;; earlier defined routes have lower precedence (defroute :get "^/_matrix/client/versions$" versions) -(defroute :get "^/_matrix/client/login" get-logins) +(defroute :get "^/_matrix/client/v3/login" get-login)