[back] User authentication with telegram

back/chad-music.asd

@@ -25,5 +25,4 @@
   :serial t
   :components ((:file "utils")
                (:file "db")
-	       (:file "rym")
                (:file "server")))

back/db.lisp

@@ -97,7 +97,7 @@
   (gethash (track-album-id track)
            (db-albums *db*)))
 
-(defun rescan (&optional (paths (mapcar 'car chad-music.server::*path-url-mappings*)))
+(defun rescan (paths)
   (declare #.*standard-optimize-settings*)
 
   (let ((added 0) (updated 0) (removed 0)

back/server.lisp

@@ -1,6 +1,6 @@
 (in-package :cl-user)
 (defpackage chad-music.server
-  (:use :cl #:alexandria #:chad-music.db #:jonathan)
+  (:use :cl #:alexandria #:chad-music.db #:chad-music.utils #:jonathan)
   (:export #:main))
 (in-package :chad-music.server)
 
@@ -51,8 +51,9 @@
     (maybe-key-value "duration" (track-duration track))
     (maybe-key-value "url" (get-url (track-path track)))))
 
-(defparameter +400+ '(400 nil #.(trivial-utf-8:string-to-utf-8-bytes "400")))
-(defparameter +404+ '(404 nil #.(trivial-utf-8:string-to-utf-8-bytes "404")))
+(defparameter +400+ '(400 nil #.(trivial-utf-8:string-to-utf-8-bytes "Bad Request")))
+(defparameter +401+ '(401 nil #.(trivial-utf-8:string-to-utf-8-bytes "Unauthorized")))
+(defparameter +404+ '(404 nil #.(trivial-utf-8:string-to-utf-8-bytes "Not found")))
 (defparameter +200-empty+ '(200 (:content-type "application/json")
                             #.(trivial-utf-8:string-to-utf-8-bytes "{}")))
 
@@ -163,7 +164,7 @@
 						       :removed removed))
 					 *rescans*))
 			       #'(lambda ()
-				   (multiple-value-bind (a u r) (rescan)
+				   (multiple-value-bind (a u r) (rescan (mapcar 'car *path-url-mappings*))
 				     (save-db)
 				     (setf added a updated u removed r))))))
 
@@ -189,10 +190,81 @@
 (defun stats (params)
   (declare #.*standard-optimize-settings* (ignorable params))
   (let ((stats (db-stats)))
-    (setf (getf stats :|duration|) (format-interval (getf stats :|duration|)))
+    (setf (getf stats :|duration|)
+	  (format-interval (getf stats :|duration|)))
     (200-json (append stats
 		      (list :|rescans| (subseq *rescans* 0 (min (length *rescans*) 10)))))))
 
+(defvar *bot-token* nil "Login bot token")
+(defun validate-user (info)
+  (let ((hash (prog1 (getf info :|hash|)
+		(remf info :|hash|)))
+	(check-string (format nil "~{~a=~a~^~%~}"
+			      (alist-plist
+			       (sort (plist-alist info) #'string-lessp :key #'(lambda (p) (symbol-name (car p)))))))
+	(hmac (crypto:make-hmac
+	       (crypto:digest-sequence :sha256 (crypto:ascii-string-to-byte-array *bot-token*)) :sha256)))
+    (crypto:update-hmac hmac (trivial-utf-8:string-to-utf-8-bytes check-string))
+    (string-equal
+     hash
+     (crypto:byte-array-to-hex-string (crypto:hmac-digest hmac)))))
+
+(defparameter +telegram-api-format+ "https://api.telegram.org/bot~A/~A")
+(defun telegram-request (method params)
+  (json-request (format nil +telegram-api-format+
+			*bot-token* method)
+		:method :post
+		:content (trivial-utf-8:string-to-utf-8-bytes
+			  (to-json params))))
+
+(defvar *bot-auth-chat-id* nil "Authentication chat id")
+(defparameter +authorized-statuses+ '("creator" "administrator" "member"))
+(defun authorize-user (info)
+  (ignore-errors
+   (let* ((response (telegram-request "getChatMember"
+				      `(:|chat_id| ,*bot-auth-chat-id*
+					 :|user_id| ,(getf info :|id|))))
+	  (chat-member (getf response :|result|))
+	  (status (getf chat-member :|status|)))
+     (member status +authorized-statuses+ :test #'equal))))
+
+(defvar *user-tokens* (make-hash-table :test #'equal))
+(defparameter +token-length+ 16)
+(defun user-token (info)
+  (let ((token (crypto:byte-array-to-hex-string
+		(crypto:random-data +token-length+))))
+    (setf (gethash token *user-tokens*) info)
+    token))
+
+(defun login (params)
+  (declare #.*standard-optimize-settings* (ignorable params))
+  (handler-case
+      (let* ((body (trivial-utf-8:read-utf-8-string
+		    (getf myway:*env* :raw-body)
+		    :stop-at-eof t))
+	     (info (parse (coerce body 'simple-string))))
+	(unless (validate-user info)
+	  (error "Bad user info"))
+	(unless (authorize-user info)
+	  (return-from login +401+))
+	(200-json (user-token info)))
+    (error (e) +400+)))
+
+(defmacro with-user ((info) &body body)
+  (with-gensyms (auth bearer)
+    `(let* ((,auth (gethash "authorization" (getf myway:*env* :headers)))
+	    (,bearer (when (and ,auth
+				(> (length ,auth) 7)
+				(equal "Bearer " (subseq ,auth 0 7)))
+		       (subseq ,auth 7)))
+	    (,info (when ,bearer (gethash ,bearer *user-tokens*))))
+       (if ,info (progn ,@body) +401+))))
+
+(defun user-info (params)
+  (declare #.*standard-optimize-settings* (ignorable params))
+  (with-user (info)
+    (200-json info)))
+
 (defvar *mapper* (myway:make-mapper))
 (myway:connect *mapper* "/api/cat/:category/size" 'get-category-size)
 (myway:connect *mapper* "/api/cat/:category" 'get-category)
@@ -200,6 +272,8 @@
 (myway:connect *mapper* "/api/album/:id/tracks" 'get-album-tracks)
 (myway:connect *mapper* "/api/stats" 'stats)
 (myway:connect *mapper* "/api/rescan" 'request-rescan :method :POST)
+(myway:connect *mapper* "/api/login" 'login :method :POST)
+(myway:connect *mapper* "/api/user" 'user-info)
 
 (defun main (&rest args &key (port 5000) (debug nil) (use-thread t) (serve-files nil) &allow-other-keys)
   ;; Load config file