Add function for uploading (but not sending) media, clean up threads
- The new PUT-WHATSAPP-MEDIA-FILE can encrypt and upload a blob of file data to
WhatsApp, and returns everything we'd need to make a protobuf message out of
that.
- However, important functionality is still absent: whatscl needs to gain some
support for sending protobuf messages for file uploads, and we'd also need to
integrate with some image/video libraries in order to do related processing
tasks.
- For example, uploading an image requires producing a JPEG thumbnail for it,
as well as figuring out its size.
- Uploading audio would require conversion to Opus.
- Maybe we could attempt to integrate with ffmpeg or something? This is likely
to get tricky.
This commit is contained in:
eta
parent
efbda1a002
commit
28a6303371
56
stuff.lisp
56
stuff.lisp
|
|
@ -135,6 +135,51 @@ Commands:
|
|||
do (handle-setup-user comp user))
|
||||
(trivial-timers:schedule-timer (component-reconnect-timer comp) *reconnect-every-secs*))))
|
||||
|
||||
(defun put-whatsapp-media-file (conn file-data media-type)
|
||||
"Encrypts and uploads FILE-DATA (an octet vector), a WhatsApp media file of type MEDIA-TYPE (one of :IMAGE, :VIDEO, :AUDIO, or :DOCUMENT) to WhatsApp, returning a promise that resolves with (URL MEDIA-KEY FILE-SHA256 FILE-ENC-SHA256 ENCRYPTED-LENGTH) when done."
|
||||
(check-type file-data (simple-array (unsigned-byte 8)))
|
||||
(check-type media-type (member :image :video :audio :document))
|
||||
(attach
|
||||
(with-promise (resolve reject)
|
||||
(format *debug-io* "~&requesting WhatsApp upload slot~%")
|
||||
(whatscl::start-media-upload
|
||||
conn
|
||||
(lambda (conn auth-token ttl hosts)
|
||||
(declare (ignore conn))
|
||||
(if auth-token
|
||||
(resolve auth-token ttl hosts)
|
||||
(reject (make-condition 'error
|
||||
"WhatsApp upload slot request rejected"))))))
|
||||
(lambda (auth-token ttl hosts)
|
||||
(declare (ignore ttl))
|
||||
(with-promise-from-thread ()
|
||||
(multiple-value-bind (encrypted-blob media-key file-sha256 file-enc-sha256)
|
||||
(whatscl::encrypt-media-data file-data media-type)
|
||||
(let* ((token (qbase64:encode-bytes file-enc-sha256 :scheme :uri))
|
||||
(url-to-use (format nil "https://~A/mms/~(~A~)/~A"
|
||||
(first hosts) (symbol-name media-type) token))
|
||||
(headers `(("Origin" . "https://web.whatsapp.com")
|
||||
("Referer" . "https://web.whatsapp.com")))
|
||||
(qs-params `(("auth" . ,auth-token) ("token" . ,token))))
|
||||
(format *debug-io* "~&uploading encrypted media file (length ~A) to ~A"
|
||||
(length encrypted-blob) url-to-use)
|
||||
(multiple-value-bind (response status-code)
|
||||
(drakma:http-request url-to-use
|
||||
:method :post
|
||||
:content encrypted-blob
|
||||
:content-type "application/octet-stream"
|
||||
:parameters qs-params
|
||||
:additional-headers headers)
|
||||
(let ((response (babel:octets-to-string response)))
|
||||
(unless (eql status-code 200)
|
||||
(format *debug-io* "~&whatsapp upload failed! status ~A / ~A" status-code response)
|
||||
(error "Downloading media failed with status ~A / ~A" status-code response))
|
||||
(let* ((json-response (cl-json:decode-json-from-string response))
|
||||
(url (or (whatscl::cassoc :url json-response)
|
||||
(error "No :URL field in upload response ~A" json-response))))
|
||||
(format *debug-io* "~&got whatsapp uploaded media url ~A~%" url)
|
||||
(values url media-key file-sha256 file-enc-sha256 (length encrypted-blob)))))))))))
|
||||
|
||||
(defun upload-whatsapp-media-file (comp file-info media-type &optional filename)
|
||||
"Downloads the WhatsApp media file specified by FILE-INFO, uploads it via COMP, and returns a promise which resolves to the URL of the uploaded media.
|
||||
MEDIA-TYPE is one of (:image :video :audio :document)."
|
||||
|
|
@ -158,11 +203,7 @@ MEDIA-TYPE is one of (:image :video :audio :document)."
|
|||
(lambda (slot)
|
||||
(destructuring-bind ((put-url . headers) get-url) slot
|
||||
(format *debug-io* "~&got put-url: ~A~% get-url: ~A~%" put-url get-url)
|
||||
(with-promise (resolve reject)
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(handler-case
|
||||
(progn
|
||||
(with-promise-from-thread ()
|
||||
(format *debug-io* "~&fetching whatsapp media url: ~A~%" url)
|
||||
(multiple-value-bind (file-data status-code)
|
||||
(drakma:http-request url)
|
||||
|
|
@ -184,9 +225,8 @@ MEDIA-TYPE is one of (:image :video :audio :document)."
|
|||
(unless (and (>= status-code 200) (< status-code 300))
|
||||
(format *debug-io* "~&upload failed! status ~A, body ~A~%" status-code body)
|
||||
(error "HTTP upload failed with status ~A" status-code))
|
||||
(resolve get-url)))))
|
||||
(error (e) (reject e))))
|
||||
:name "whatsapp media download thread")))))))))
|
||||
get-url))))
|
||||
:name "whatsapp media download thread"))))))))
|
||||
|
||||
(defun send-qrcode (comp jid text)
|
||||
"Send a QR code containing TEXT to JID."
|
||||
|
|
|
|||
11
utils.lisp
11
utils.lisp
|
|
@ -16,3 +16,14 @@
|
|||
(defun child-elements (node)
|
||||
"Returns the child elements (excluding text nodes) of the CXML DOM node NODE."
|
||||
(remove-if-not #'dom:element-p (dom:child-nodes node)))
|
||||
|
||||
(defmacro with-promise-from-thread (() &body forms)
|
||||
"Return a promise that executes FORMS in a new thread, resolving the promise with the return value of (PROGN ,@FORMS) or rejecting it if an ERROR condition is thrown (with said condition)."
|
||||
(let ((resolve (gensym))
|
||||
(reject (gensym)))
|
||||
`(with-promise (,resolve ,reject)
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(handler-case
|
||||
(,resolve (progn ,@forms))
|
||||
(error (e) (,reject e))))))))
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@
|
|||
(:file "xmpp")
|
||||
(:file "xep-0030")
|
||||
(:file "xep-0363")
|
||||
(:file "xep-0115")
|
||||
(:file "sqlite")
|
||||
(:file "db")
|
||||
(:file "stuff")))
|
||||
|
|
|
|||
Loading…
Reference in a new issue