Add functions for *uploading* media (but not sending)

- This is a large part of the work toward being able to send images/video/etc.
- We can now encrypt stuff according to whatsapp's requirements, ask for an
  upload slot, and do the uploading (but the actual uploading is outsourced to
  the library consumer right now)
- Still missing, however, is the ability to stuff the necessary bits of info
  into a WhatsApp protobuf message and actually send it.

crypto.lisp

@@ -14,12 +14,20 @@
                        -1 ; iteration count /should/ be ignored, right?
                        length)))
 
+(defun sha256 (data)
+  "Computes the SHA256 hash of DATA."
+  (ironclad:digest-sequence :sha256 data))
+
 (defun hmac-sha256 (key data)
   "Computes the HMAC-SHA256 message authentication code for DATA, using the secret KEY."
   (let ((mac (crypto:make-mac :hmac key :sha256)))
     (crypto:update-mac mac data)
     (crypto:produce-mac mac)))
 
+(defmacro vectors-concatenate (&rest args)
+  "Concatenate ARGS (all of type '(VECTOR (UNSIGNED-BYTE 8))) into a vector of the same type."
+  `(concatenate '(vector (unsigned-byte 8)) ,@args))
+
 (defun aes-encrypt (key iv plaintext)
   "Encrypts PLAINTEXT with KEY, using the AES-CBC cipher and the provided IV."
   (let* ((cipher (crypto:make-cipher :aes
@@ -67,10 +75,8 @@ Returns the encKey and macKey as two values."
          (hmac-expected (subseq secret 32 64))
          (hmac-derived (hmac-sha256
                         (subseq expanded-secret 32 64)
-                        (concatenate '(vector (unsigned-byte 8))
-                                     (subseq secret 0 32) (subseq secret 64))))
-         (keys-encrypted (concatenate '(vector (unsigned-byte 8))
-                                      (subseq expanded-secret 64) (subseq secret 64))))
+                        (vectors-concatenate (subseq secret 0 32) (subseq secret 64))))
+         (keys-encrypted (vectors-concatenate (subseq expanded-secret 64) (subseq secret 64))))
     (assert (equalp hmac-derived hmac-expected) () "HMAC validation failed:~%expected ~A~%got ~A" hmac-expected hmac-derived)
     (let ((keys-decrypted (aes-decrypt (subseq expanded-secret 0 32) keys-encrypted)))
       (values (subseq keys-decrypted 0 32) (subseq keys-decrypted 32)))))
@@ -89,11 +95,9 @@ Returns the encKey and macKey as two values."
   (let* ((block-length (crypto:block-length :aes))
          (iv (crypto:random-data block-length))
          (encrypted-message (aes-encrypt (session-enc-key session) iv message))
-         (iv-and-message (concatenate '(vector (unsigned-byte 8))
-                                      iv encrypted-message))
+         (iv-and-message (vectors-concatenate iv encrypted-message))
          (signature (hmac-sha256 (session-mac-key session) iv-and-message)))
-    (concatenate '(vector (unsigned-byte 8))
-                 signature iv-and-message)))
+    (vectors-concatenate signature iv-and-message)))
 
 (defun get-media-app-info (type)
   "Gets the HKDF application info for the media type symbol TYPE."
@@ -118,11 +122,36 @@ TYPE is a symbol (one of :IMAGE, :VIDEO, :AUDIO or :DOCUMENT) specifying what ty
          (mac-split (- (length data) 10))
          (file-data (subseq data 0 mac-split))
          (hmac-expected (subseq data mac-split))
-         (iv-and-file (concatenate '(vector (unsigned-byte 8))
-                                   iv file-data))
+         (iv-and-file (vectors-concatenate iv file-data))
          (hmac-derived (hmac-sha256 mac-key iv-and-file))
          (decrypted (aes-decrypt cipher-key iv-and-file)))
     (assert (equalp hmac-expected (subseq hmac-derived 0 10)) ()
             "HMAC validation failed~%expected ~A~%got ~A" hmac-derived hmac-expected)
     decrypted))
 
+(defun generate-media-keys (type)
+  "Generate a 32-byte random media key, and then expand it using the provided media TYPE (one of :IMAGE, :VIDEO, :AUDIO, or :DOCUMENT).
+Returns (RANDOM-KEY IV CIPHER-KEY MAC-KEY), with the latter 3 values taken as subsequences of the expanded key."
+  (check-type type (member :image :video :audio :document))
+  (let* ((random-key (crypto:random-data 32))
+         (expanded (hkdf random-key 112 (get-media-app-info type))))
+    (values random-key
+            (subseq expanded 0 16)
+            (subseq expanded 16 48)
+            (subseq expanded 48 80))))
+
+(defun encrypt-media-data (data type)
+  "Encrypt the provided DATA (a piece of encrypted media data), a piece of media of the given TYPE (one of :IMAGE, :VIDEO, :AUDIO, or :DOCUMENT).
+Returns (ENCRYPTED-BLOB RANDOM-KEY FILE-SHA256 FILE-ENC-SHA256), where ENCRYPTED-BLOB should be uploaded to WhatsApp (along with a base64-encoded FILE-ENC-SHA256), and the other fields should be used to populate an instance of class FILE-INFO."
+  (check-type data (simple-array (unsigned-byte 8)))
+  (check-type type (member :image :video :audio :document))
+  (multiple-value-bind (random-key iv cipher-key mac-key)
+      (generate-media-keys type)
+    (let* ((enc (aes-encrypt cipher-key iv data))
+           (mac (subseq (hmac-sha256 mac-key
+                                     (vectors-concatenate iv enc))
+                        0 10))
+           (file-sha-256 (sha256 data))
+           (enc-mac (vectors-concatenate enc mac))
+           (file-enc-sha-256 (sha256 enc-mac)))
+      (values enc-mac random-key file-sha-256 file-enc-sha-256))))

whatscl.lisp

@@ -194,6 +194,29 @@ CALLBACK, if provided, specifies a function to run with the reply sent by WhatsA
                         :presence
                         :callback (function-check-status :send-presence)))
 
+(defun parse-media-conn-response (resp)
+  "Parse the response to START-MEDIA-UPLOAD provided (RESP). If it is valid, return the values (AUTH-TOKEN TTL HOSTNAME-LIST); else, return NIL."
+  (labels
+      ;; This is the kind of thing the Maybe monad is excellent at. We don't have
+      ;; that, so let's do things the hacky Lisp way!
+      ((need (thing) (or thing (return-from parse-media-conn-response)))
+       (maybe-list (obj) (when obj (list obj)))
+       (extract-hostname (host) (maybe-list (cassoc :hostname host))))
+    (let* ((media-conn (need (cassoc :media--conn resp)))
+           (auth-token (need (cassoc :auth media-conn)))
+           (ttl (need (cassoc :ttl media-conn)))
+           (hosts (mapcan #'extract-hostname (need (cassoc :hosts media-conn)))))
+      (values auth-token ttl hosts))))
+
+(defun start-media-upload (conn callback)
+  "Request a media upload slot from WhatsApp. Calls CALLBACK like (FUNCALL CALLBACK CONN AUTH-TOKEN TTL HOSTS); if the slot request fails, AUTH-TOKEN, TTL, and HOSTS will all be NIL."
+  (send-ws-message conn `("query" "mediaConn")
+                   (lambda (conn resp)
+                     (multiple-value-bind (auth-token ttl hosts)
+                         (parse-media-conn-response resp)
+                       (without-wac-lock (conn)
+                         (funcall callback conn auth-token ttl hosts))))))
+
 (defun get-profile-picture (conn jid callback)
   "Try and get a profile picture thumbnail for JID. Calls CALLBACK with CONN as first argument and then a URL (or NIL if none could be found)"
   (declare (type jid jid))