more stuff -- lost track

cl-matrix.asd

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

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))
 
     

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)))

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))

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"))))
 
 

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)))

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)