1
0

server.lisp 3.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112
  1. (in-package :cl-user)
  2. (defpackage chatikbot.server
  3. (:use :cl :chatikbot.utils)
  4. (:import-from :chatikbot.bot
  5. :handle-update)
  6. (:import-from :chatikbot.telegram
  7. :*telegram-token*)
  8. (:export :def-webhook-handler
  9. :get-webhook-url
  10. :get-oauth-url))
  11. (in-package :chatikbot.server)
  12. (defvar *web-path* nil "Set to externally accessible url")
  13. (defvar *web-iface* nil "Interface to listen on")
  14. (defvar *web-port* 4242 "Port to listen on")
  15. (defvar *web-acceptor* nil "Running hunchentoot acceptor")
  16. (defun web-start ()
  17. (when *web-acceptor* (hunchentoot:stop *web-acceptor*))
  18. (when *web-path*
  19. (setf *web-acceptor*
  20. (hunchentoot:start
  21. (make-instance 'hunchentoot:easy-acceptor
  22. :address *web-iface* :port *web-port*)))))
  23. (add-hook :starting #'(lambda () (web-start) (values)))
  24. (defun telegram-hook-p (request)
  25. (and (equal (hunchentoot:request-method request) :post)
  26. (equal (concatenate 'string "/" *telegram-token*)
  27. (hunchentoot:script-name request))))
  28. (hunchentoot:define-easy-handler (telegram-webhook-handler :uri #'telegram-hook-p) ()
  29. (handler-case
  30. (let ((stream (hunchentoot:raw-post-data :want-stream t)))
  31. (setf *random-state* (make-random-state t))
  32. (setf (flex:flexi-stream-external-format stream) :utf-8)
  33. (handle-update (yason:parse stream :object-as :alist)))
  34. (error (e) (log:error e)))
  35. "OK")
  36. (defun get-oauth-url ()
  37. (quri:render-uri
  38. (quri:merge-uris (quri:uri "/oauth")
  39. (quri:uri *web-path*))))
  40. (hunchentoot:define-easy-handler (oauth-handler :uri "/oauth") (code error state)
  41. (handler-case
  42. (run-hooks :oauth code error state)
  43. (error (e)
  44. (log:error e)
  45. (hunchentoot:redirect "/error"))))
  46. (hunchentoot:define-easy-handler (error-handler :uri "/error") ()
  47. "<html>
  48. <head><title>Internal error</title></head>
  49. <body>
  50. <h1>Error :'(</h1>
  51. <p>Internal server error</p>
  52. </html>")
  53. (hunchentoot:define-easy-handler (oauth-success-handler :uri "/oauth/success") ()
  54. "<html>
  55. <head><title>Auth Success</title></head>
  56. <body>
  57. <h1>Success!</h1>
  58. <p>OAuth successfully completed. You could close this tab and go back to telegram bot</p>
  59. </html>")
  60. (hunchentoot:define-easy-handler (oauth-fail-handler :uri "/oauth/fail") ()
  61. "<html>
  62. <head><title>Auth failed</title></head>
  63. <body>
  64. <h1>Failed :(</h1>
  65. <p>OAuth failed. You probably didn't allow the access. Try again.</p>
  66. </html>")
  67. (defun webhookp (request)
  68. (let ((name (hunchentoot:script-name request)))
  69. (and (> (length name) 6)
  70. (equal (subseq name 0 6) "/hook/"))))
  71. (hunchentoot:define-easy-handler (webhook-handler :uri #'webhookp) ()
  72. (handler-case
  73. (let ((hook (subseq (hunchentoot:script-name*) 6))
  74. (data (hunchentoot:raw-post-data :external-format :utf-8)))
  75. (setf *random-state* (make-random-state t))
  76. (run-hooks :webhook hook
  77. (when data (yason:parse data :object-as :alist))
  78. (hunchentoot:headers-in*)))
  79. (error (e) (log:error e)))
  80. "OK")
  81. (defmacro def-webhook-handler (name (&rest routes) &body body)
  82. (let ((parts (gensym "parts")))
  83. `(progn
  84. (defun ,name (hook data headers)
  85. (declare (ignorable data headers))
  86. (let ((,parts (split-sequence:split-sequence #\/ hook)))
  87. (when (member (car ,parts) (list ,@routes) :test #'equal)
  88. (log:info ,parts)
  89. (handler-case
  90. (let ((paths (rest ,parts)))
  91. ,@body)
  92. (error (e) (log:error "~A" e))))))
  93. (add-hook :webhook ',name))))
  94. (defun get-webhook-url (route &rest path)
  95. (when *web-path*
  96. (quri:render-uri
  97. (quri:merge-uris (quri:uri (format nil "/hook/~A~{/~A~}" route path))
  98. (quri:uri *web-path*)))))