diff --git a/src/auth.lisp b/src/auth.lisp index 7d2ee85..4f349fa 100644 --- a/src/auth.lisp +++ b/src/auth.lisp @@ -4,28 +4,28 @@ (defun generate-hash (passphrase salt) "Where PASSPHRASE is a string and SALT is a unsigned byte array or string, returns an unsigned byte array" - (let* ((salt (if (typep salt '(simple-array (unsigned-byte 8) (*))) - salt - (ironclad:hex-string-to-byte-array salt))) - (kdf (ironclad:make-kdf :argon2id :block-count 19456)) - (passphrase-bytes (flexi-streams:string-to-octets passphrase :external-format :utf-8)) - (hash (ironclad:derive-key kdf passphrase-bytes salt 2 16))) + (let* ((salt (if (typep salt '(simple-array (unsigned-byte 8) (*))) + salt + (ironclad:hex-string-to-byte-array salt))) + (kdf (ironclad:make-kdf :argon2id :block-count 19456)) + (passphrase-bytes (flexi-streams:string-to-octets passphrase :external-format :utf-8)) + (hash (ironclad:derive-key kdf passphrase-bytes salt 2 16))) hash)) (defun generate-hash-with-salt (passphrase) "Where PASSPHRASE is a string, returns a string ':'" (let* ((salt (ironclad:make-random-salt)) - (hash (generate-hash passphrase salt))) + (hash (generate-hash passphrase salt))) (format nil "~a:~a" - (ironclad:byte-array-to-hex-string hash) - (ironclad:byte-array-to-hex-string salt)))) + (ironclad:byte-array-to-hex-string hash) + (ironclad:byte-array-to-hex-string salt)))) (defun check-password (to-check passphrase-hash-and-salt-string) (let* ((split-passphrase-hash-and-salt (uiop:split-string - passphrase-hash-and-salt-string :separator ":")) - (passphrase-hash (first split-passphrase-hash-and-salt)) - (passphrase-salt (second split-passphrase-hash-and-salt)) - (to-check-hash (ironclad:byte-array-to-hex-string (generate-hash to-check passphrase-salt)))) + passphrase-hash-and-salt-string :separator ":")) + (passphrase-hash (first split-passphrase-hash-and-salt)) + (passphrase-salt (second split-passphrase-hash-and-salt)) + (to-check-hash (ironclad:byte-array-to-hex-string (generate-hash to-check passphrase-salt)))) (equal to-check-hash passphrase-hash))) ;; AUTH SESSION @@ -40,8 +40,8 @@ (defmethod auth-session-plist ((auth-session auth-session)) (let ((plist (list :flows `(:stages ,(stages auth-session)) - :params (params auth-session) - :session (session-id auth-session)))) + :params (params auth-session) + :session (session-id auth-session)))) (when (completed auth-session) (push (completed auth-session) plist) (push :completed plist)) @@ -70,7 +70,7 @@ We're not signaling any conditions from here because depending on whether it's a (defmethod process-input ((auth-stage (eql :|m.login.password|)) input) (destructuring-bind (&key identifier password &allow-other-keys) input (let* ((user (get-user identifier)) - (password-hash (password-hash user))) + (password-hash (password-hash user))) (check-password password password-hash)))) (defmethod process-input (auth-stage input) @@ -81,16 +81,16 @@ We're not signaling any conditions from here because depending on whether it's a (defun get-user-from-access-token (access-token) (let ((device (get-device access-token))) (if device - (get-user (user-id device))))) + (get-user (user-id device))))) (defmacro with-authentication (input-var &body body) `(let* ((access-token (matrix-input-access-token ,input-var)) - (user (if access-token (get-user-from-access-token access-token)))) + (user (if access-token (get-user-from-access-token access-token)))) (setf (matrix-input-user ,input-var)) (if user - (progn - ,@body) - (handle-auth-session)))) + (progn + ,@body) + (handle-auth-session)))) (defun get-auth-params (matrix-input) (getf (matrix-input-json-body matrix-input) :auth)) @@ -114,8 +114,8 @@ We're not signaling any conditions from here because depending on whether it's a (defun post-login (input) (let ((json-body (matrix-input-json-body input))) (if (process-input (alex:make-keyword (getf json-body :type "")) json-body) - (json-response 200 '(:msg "success!")) - (error 'forbidden-error)))) - + (json-response 200 '(:msg "success!")) + (error 'forbidden-error)))) + diff --git a/src/db.lisp b/src/db.lisp index 7b8ee71..f824180 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -25,7 +25,7 @@ ("m.id.thirdparty" (get-user-by-thirdparty identity)) ("m.id.phone" (get-user-by-phone identity)) (otherwise (error 'unknown-error - :msg (format nil "~a is not a valid identity type" type)))))) + :msg (format nil "~a is not a valid identity type" type)))))) (defun get-user-by-user (identity) (postmodern:with-connection cl-matrix-config:+database+ @@ -47,12 +47,12 @@ (defun coerce-user-id (name) (multiple-value-bind (match server-name) (ppcre:scan-to-strings *user-id-scanner* name) (if match - (if (string-equal cl-matrix-config:+server-name+ (aref server-name 0)) - name - (error 'unknown-error :msg "user id server name is not valid")) - (if (ppcre:scan *user-localpart-scanner* name) - (format nil "@~a:~a" name cl-matrix-config:+server-name+) - (error 'unknown-error :msg "user id localpart is not valid"))))) + (if (string-equal cl-matrix-config:+server-name+ (aref server-name 0)) + name + (error 'unknown-error :msg "user id server name is not valid")) + (if (ppcre:scan *user-localpart-scanner* name) + (format nil "@~a:~a" name cl-matrix-config:+server-name+) + (error 'unknown-error :msg "user id localpart is not valid"))))) (defun make-user (id password-hash) (make-instance 'user :id id :password-hash password-hash)) diff --git a/src/json.lisp b/src/json.lisp index b4d8e09..7945f6b 100644 --- a/src/json.lisp +++ b/src/json.lisp @@ -12,8 +12,8 @@ (plist-p element) (let (result) (alex:doplist (key val element result) - (push (plist-hash-table-recurse val) result) - (push key result)) + (push (plist-hash-table-recurse val) result) + (push key result)) (alex:plist-hash-table result))) ( (listp element) @@ -27,9 +27,9 @@ (hash-table-p element) (let ((result)) (maphash (lambda (key val) - (push (hash-table-plist-recurse val) result) - (push (alex:make-keyword (string-upcase key)) result)) - element) + (push (hash-table-plist-recurse val) result) + (push (alex:make-keyword (string-upcase key)) result)) + element) result)) ( (and (vectorp element) (not (stringp element))) @@ -38,7 +38,7 @@ (defun json-plist (json) (let ((parsed (handler-case - (jzon:parse json) - (error () - (error 'not-json-error))))) + (jzon:parse json) + (error () + (error 'not-json-error))))) (hash-table-plist-recurse parsed))) diff --git a/src/main.lisp b/src/main.lisp index 5e3a1fc..bc8ad7a 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -6,15 +6,15 @@ (if *running-server* (log-info "server already running") (progn - (setq *running-server* - (clack:clackup 'router :server :woo)) - (log-info "server started")))) + (setq *running-server* + (clack:clackup 'router :server :woo)) + (log-info "server started")))) (defun stop-server () (if *running-server* (progn - (clack:stop *running-server*) - (log-info "server shutdown")) + (clack:stop *running-server*) + (log-info "server shutdown")) (log-info "no running server to shutdown")) (setq *running-server* nil)) diff --git a/src/matrix.lisp b/src/matrix.lisp index 317e84e..7c9a4e8 100644 --- a/src/matrix.lisp +++ b/src/matrix.lisp @@ -16,16 +16,16 @@ (defmacro make-matrix-errors (&rest names) (loop for name-maybe in names - for name = (string name-maybe) - for snake = (loop for ch across name - with result = (copy-seq name) - for i upfrom 0 - do (if (eql ch #\-) (setf (aref result i) #\_)) - finally (return result)) - collecting `(define-condition ,(intern (format nil "~a-ERROR" (string-upcase name))) (matrix-error) - ((errcode :initform ,(format nil "M_~a" snake)))) - into defines - finally (return (append '(progn) defines)))) + for name = (string name-maybe) + for snake = (loop for ch across name + with result = (copy-seq name) + for i upfrom 0 + do (if (eql ch #\-) (setf (aref result i) #\_)) + finally (return result)) + collecting `(define-condition ,(intern (format nil "~a-ERROR" (string-upcase name))) (matrix-error) + ((errcode :initform ,(format nil "M_~a" snake)))) + into defines + finally (return (append '(progn) defines)))) (make-matrix-errors forbidden diff --git a/src/package.lisp b/src/package.lisp index 272a543..0249151 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1,4 +1,4 @@ (defpackage cl-matrix (:use #:cl) (:local-nicknames (:jzon :com.inuoe.jzon) - (:alex :alexandria))) + (:alex :alexandria))) diff --git a/src/routes.lisp b/src/routes.lisp index a264d60..67a8d7f 100644 --- a/src/routes.lisp +++ b/src/routes.lisp @@ -10,7 +10,7 @@ (defun get-access-token (env) (destructuring-bind (&key headers query-string &allow-other-keys) env (let* ((auth-token-header (get-access-token-from-header (gethash "Authorization" headers))) - (auth-token-params (get-access-token-from-params (if query-string (quri:url-decode-params query-string))))) + (auth-token-params (get-access-token-from-params (if query-string (quri:url-decode-params query-string))))) (or auth-token-header auth-token-params)))) (defun received-method-p (method) @@ -47,12 +47,12 @@ (lambda (env) (let ((matches (nth-value 1 (ppcre:scan-to-strings url-pattern (getf env :path-info))))) (if matches - (apply handler env (coerce matches 'list)))))) + (apply handler env (coerce matches 'list)))))) (defun wrap-method-match (method handler) (lambda (env) (if (eql method (getf env :request-method)) - (funcall handler env)))) + (funcall handler env)))) (defparameter *routes* nil) @@ -62,27 +62,27 @@ (wrap-method-match ,method (wrap-url-match - ,url-pattern - (lambda (env &rest rest) - ;; innermost lambda expects env and path-args for rest - (funcall (function ,handler) (initialize-matrix-input rest env))))) + ,url-pattern + (lambda (env &rest rest) + ;; innermost lambda expects env and path-args for rest + (funcall (function ,handler) (initialize-matrix-input rest env))))) *routes*) (push (wrap-method-match :options (wrap-url-match - ,url-pattern - (lambda (env &rest rest) - (json-response 200 '())))) + ,url-pattern + (lambda (env &rest rest) + (json-response 200 '())))) *routes*))) (defun router (env) (log-info (getf env :path-info)) (handler-case (loop for route in *routes* - when (funcall route env) - return it - finally (error 'unrecognized-error)) + when (funcall route env) + return it + finally (error 'unrecognized-error)) (matrix-error (c) (handle-condition c))))