(require 'url)
(require 'json)
(require 'org-id)

(defvar note-importer-server-url "https://notes.fredgruber.org/")
(defvar note-importer-handwritten-notes-dir nil)
(defvar note-importer-images-subdir "images")
(defvar note-importer--auth-token nil)

(defun note-importer-login ()
  (interactive)
  (setq note-importer--auth-token (read-passwd "Password: "))
  (message "Token set"))

(defun note-importer-get-notes-dir ()
  (or note-importer-handwritten-notes-dir
      (expand-file-name "handwritten_notes"
                        (if (boundp (quote org-roam-directory))
                            org-roam-directory
                          "~/notes/roam/"))))

(defun note-importer-get-images-dir ()
  (expand-file-name note-importer-images-subdir
                    (note-importer-get-notes-dir)))

(defun note-importer-fetch-inbox (&optional source)
  (let ((url (concat note-importer-server-url "/inbox"
                     (if source (concat "?source=" source) "")))
        (buf nil))
    (setq url-request-method "GET")
    (setq url-request-extra-headers
          (list (cons "Authorization" (format "Bearer %s" note-importer--auth-token))))
    (setq buf (url-retrieve-synchronously url t))
    (when buf
      (with-current-buffer buf
        (goto-char (point-min))
        (re-search-forward "^$")
        (let ((data (json-read)))
          (if (vectorp data)
              (append data nil)
            data))))))

(defun note-importer-download-file (url filename)
  (let ((buf nil))
    (setq url-request-method "GET")
    (setq url-request-extra-headers
          (list (cons "Authorization" (format "Bearer %s" note-importer--auth-token))))
    (setq buf (url-retrieve-synchronously url t))
    (when buf
      (with-current-buffer buf
        (goto-char (point-min))
        (if (search-forward "\r\n\r\n" nil t)
            (delete-region (point-min) (point))
          (if (search-forward "\n\n" nil t)
              (delete-region (point-min) (point))))
        (let ((inhibit-read-only t))
          (write-file filename))
        (kill-buffer)))))

(defun note-importer-archive-on-server (upload-ids)
  (let ((url (concat note-importer-server-url "/archive"))
        (buf nil))
    (setq url-request-method "POST")
    (setq url-request-extra-headers
          (list (cons "Authorization" (format "Bearer %s" note-importer--auth-token))
                (cons "Content-Type" "application/json")))
    (setq url-request-data (json-encode (list (cons "upload_ids" upload-ids))))
    (setq buf (url-retrieve-synchronously url t))
    (when buf (kill-buffer buf))))

(defun note-importer-delete-on-server (upload-ids)
  (let ((url (concat note-importer-server-url "/delete"))
        (buf nil))
    (setq url-request-method "POST")
    (setq url-request-extra-headers
          (list (cons "Authorization" (format "Bearer %s" note-importer--auth-token))
                (cons "Content-Type" "application/json")))
    (setq url-request-data (json-encode (list (cons "upload_ids" upload-ids))))
    (setq buf (url-retrieve-synchronously url t))
    (when buf (kill-buffer buf))))

(defun note-importer-set-waiting (waiting)
  "Tell the server whether Emacs is waiting for a shared image.
WAITING is non-nil when `org-image' is active."
  (let ((url (concat note-importer-server-url "/api/waiting"))
        (buf nil))
    (setq url-request-method "POST")
    (setq url-request-extra-headers
          (list (cons "Authorization" (format "Bearer %s" note-importer--auth-token))
                (cons "Content-Type" "application/json")))
    (setq url-request-data (json-encode (list (cons "waiting" (and waiting t)))))
    (setq buf (url-retrieve-synchronously url t))
    (when buf (kill-buffer buf))))

(defun note-importer-create-simple-note (image-path title)
  (let* ((notes-dir (note-importer-get-notes-dir))
         (images-dir (note-importer-get-images-dir))
         (org-file (expand-file-name (concat title ".org") notes-dir))
         (img-ext (file-name-extension image-path))
         (img-file (concat title "_1." img-ext))
         (img-dest (expand-file-name img-file images-dir)))
    (make-directory notes-dir t)
    (make-directory images-dir t)
    (copy-file image-path img-dest t)
    (with-temp-file org-file
      (insert ":PROPERTIES:\n")
      (insert ":ID:       " (org-id-new) "\n")
      (insert ":END:\n")
      (insert "#+title: " title "\n")
      (insert "#+created: [" (format-time-string "%Y-%m-%d %a") "]\n")
      (insert "#+last_modified: [" (format-time-string "%Y-%m-%d %a %H:%M") "]\n")
      (insert "\n")
      (insert "[[./" note-importer-images-subdir "/" img-file "]]\n"))
    (message "Created: %s" org-file)))

(defun note-importer-create-daily-note (image-paths date-string)
  (let* ((notes-dir (note-importer-get-notes-dir))
         (images-dir (note-importer-get-images-dir))
         (daily-dir (expand-file-name "daily" notes-dir))
         (org-file (expand-file-name (concat date-string ".org") daily-dir)))
    (make-directory notes-dir t)
    (make-directory daily-dir t)
    (make-directory images-dir t)
    (dolist (p image-paths)
      (let* ((ext (file-name-extension p))
             (img (concat date-string "_img." ext))
             (dest (expand-file-name img images-dir)))
        (copy-file p dest t)))
    (if (file-exists-p org-file)
        (progn
          (with-temp-buffer
            (insert-file-contents org-file)
            (goto-char (point-max))
            (insert "\n")
            (dolist (p image-paths)
              (let* ((ext (file-name-extension p))
                     (img (concat date-string "_img." ext)))
                (insert "[[" note-importer-images-subdir "/" img "]]\n")))
            (write-file org-file))
          (message "Added to: %s" org-file))
      (with-temp-file org-file
        (insert ":PROPERTIES:\n")
        (insert ":ID:       " (org-id-new) "\n")
        (insert ":END:\n")
        (insert "#+title: " date-string "\n")
        (insert "\n")
        (dolist (p image-paths)
          (let* ((ext (file-name-extension p))
                 (img (concat date-string "_img." ext)))
            (insert "[[./" note-importer-images-subdir "/" img "]]\n")))
        (message "Created: %s" org-file)))))

(defun note-importer-download-all (items)
  (let ((temp-dir (make-temp-file "note-importer-" t))
        (downloaded nil))
    (dolist (item items)
      (let* ((url (concat note-importer-server-url (cdr (assoc 'url item))))
             (filename (cdr (assoc 'filename item)))
             (temp-file (expand-file-name filename temp-dir)))
        (note-importer-download-file url temp-file)
        (push temp-file downloaded)))
    (nreverse downloaded)))

(defun note-importer-create-batch-note (image-paths title)
  (let* ((notes-dir (note-importer-get-notes-dir))
         (images-dir (note-importer-get-images-dir))
         (org-file (expand-file-name (concat title ".org") notes-dir))
         (n 1))
    (make-directory notes-dir t)
    (make-directory images-dir t)
    (dolist (p image-paths)
      (let* ((ext (file-name-extension p))
             (img-file (format "%s_%d.%s" title n ext))
             (img-dest (expand-file-name img-file images-dir)))
        (copy-file p img-dest t)
        (setq n (1+ n))))
    (with-temp-file org-file
      (insert ":PROPERTIES:\n")
      (insert ":ID:       " (org-id-new) "\n")
      (insert ":END:\n")
      (insert "#+title: " title "\n")
      (insert "#+created: [" (format-time-string "%Y-%m-%d %a") "]\n")
      (insert "#+last_modified: [" (format-time-string "%Y-%m-%d %a %H:%M") "]\n")
      (insert "\n")
      (setq n 1)
      (dolist (p image-paths)
        (let* ((ext (file-name-extension p))
               (img-file (format "%s_%d.%s" title n ext)))
          (insert "[[./" note-importer-images-subdir "/" img-file "]]\n")
          (setq n (1+ n)))))
    (message "Created: %s" org-file)))

(defun note-importer-import-batch ()
  (interactive)
  (let* ((inbox (note-importer-fetch-inbox))
         (choices nil)
         (choices-with-numbers nil)
         (selected-list nil)
         (title nil)
         (temp-files nil))
    (dolist (item inbox)
      (let* ((title-val (cdr (assoc 'title item)))
             (filename-val (cdr (assoc 'filename item)))
             (note-type-val (cdr (assoc 'note_type item)))
             (display-name (or title-val filename-val "unknown")))
        (push (cons (format "%s - %s" display-name note-type-val) item) choices)))
    (setq choices (nreverse choices))
    (setq choices-with-numbers (let ((n 1))
                                 (mapcar (lambda (c)
                                           (prog1
                                               (cons (format "%d: %s" n (car c))
                                                     (cdr c))
                                             (setq n (1+ n))))
                                         choices)))
    (message "Select uploads (press RET to finish):")
    (let ((choice-strings (mapcar #'car choices-with-numbers)))
      (while t
        (let ((sel (completing-read (if selected-list
                                         (format "Select (%d selected): " (length selected-list))
                                       "Select: ")
                                    choice-strings nil t)))
          (if (string= sel "")
              (if selected-list
                  (progn
                    (message "Selected %d items" (length selected-list))
                    (setq title (read-string "Note title: "))
                    (when (and title (> (length title) 0))
                      (setq temp-files (note-importer-download-all selected-list))
                      (note-importer-create-batch-note temp-files title)
                      (message "Imported %d images as '%s'" (length temp-files) title)))
                (message "No items selected"))
            (let ((selected (assoc sel choices-with-numbers)))
              (when selected
                (push (cdr selected) selected-list)
                (setq choice-strings (delete sel choice-strings))))
            (if (null choice-strings)
                (progn
                  (message "No more items to select")
                  (when selected-list
                    (setq title (read-string "Note title: "))
                    (when (and title (> (length title) 0))
                      (setq temp-files (note-importer-download-all selected-list))
                      (note-importer-create-batch-note temp-files title)
                      (message "Imported %d images as '%s'" (length temp-files) title))))
              (unless (string= sel "")
                (message "Selected: %s" sel)))))))))

(defvar org-image-poll-interval 2
  "Seconds between inbox polls while waiting for a shared image.")
(defvar org-image-timeout 600
  "Seconds to keep waiting for a shared image before giving up.")

(defvar org-image--timer nil)
(defvar org-image--target-buffer nil)
(defvar org-image--target-point nil)
(defvar org-image--wait-start nil)
(defvar org-image--waiting nil)

(defun org-image ()
  "Wait for an image shared from a phone or Boox tablet, then insert
it into the current Org buffer at point.

The image is saved to ./figures/ next to the current Org file and a link
`[[file:figures/boox-YYYYMMDD-HHMMSS.<ext>]]' is inserted at point."
  (interactive)
  (if org-image--waiting
      (message "Already waiting for a Boox image (M-x org-image-cancel to stop).")
    (setq org-image--target-buffer (current-buffer))
    (setq org-image--target-point (point))
    (setq org-image--waiting t)
    (setq org-image--wait-start (current-time))
    (setq org-image--timer
          (run-at-time org-image-poll-interval org-image-poll-interval
                       #'org-image--poll))
    (note-importer-set-waiting t)
    (message "Waiting for Boox image... (M-x org-image-cancel to stop)")))

(defun org-image-cancel ()
  "Stop waiting for a shared image."
  (interactive)
  (if (not org-image--waiting)
      (message "Not waiting for a Boox image.")
    (org-image--finish nil "Cancelled waiting for Boox image.")))

(defun org-image--poll ()
  (if (or (not org-image--waiting)
          (> (float-time (time-subtract (current-time) org-image--wait-start))
             org-image-timeout))
      (when org-image--waiting
        (org-image--finish nil "Gave up waiting for Boox image (timeout)."))
    (let ((pending (note-importer-fetch-inbox "share")))
      (when pending
        (org-image--receive (car pending))))))

(defcustom org-image-inline-width 350
  "Width in pixels for the `#+ATTR_ORG' property inserted above new image links.
Set to 0 to insert no property."
  :type 'integer
  :group 'note-importer)

(defun org-image--receive (item)
  (let* ((upload-id (cdr (assoc 'id item)))
         (server-file (cdr (assoc 'filename item)))
         (url (cdr (assoc 'url item)))
         (ext (file-name-extension server-file))
         (target-buf org-image--target-buffer)
         (target-point org-image--target-point)
         (buf-dir (file-name-directory
                   (or (buffer-file-name target-buf)
                       (error "Target buffer is not visiting a file"))))
         (figures-dir (expand-file-name "figures" buf-dir))
         (stamp (format-time-string "%Y%m%d-%H%M%S"))
         (img-file (format "boox-%s.%s" stamp (or ext "png")))
         (dest (expand-file-name img-file figures-dir)))
    (make-directory figures-dir t)
    (condition-case err
        (progn
          (note-importer-download-file (concat note-importer-server-url url) dest)
          (unless (file-exists-p dest)
            (error "Downloaded file not found: %s" dest))
          (note-importer-delete-on-server (list upload-id))
          (with-current-buffer target-buf
            (goto-char target-point)
            (unless (bolp) (insert "\n"))
            (unless (and (> org-image-inline-width 0)
                         (save-excursion
                           (and (/= (point) (point-min))
                                (forward-line -1)
                                (string-match-p
                                 "^#\\+ATTR"
                                 (buffer-substring-no-properties
                                  (point) (line-end-position))))))
              (when (> org-image-inline-width 0)
                (insert (format "#+ATTR_ORG: :width %d\n" org-image-inline-width))))
            (insert (format "[[file:figures/%s]]\n" img-file)))
          (when (fboundp 'org-redisplay-inline-images)
            (org-redisplay-inline-images))
          (org-image--finish t (format "Inserted file:figures/%s" img-file)))
      (error
       (org-image--finish nil
                          (format "Failed to receive Boox image: %s"
                                  (error-message-string err)))))))

(defun org-image--finish (inserted-p message)
  (setq org-image--waiting nil)
  (when org-image--timer
    (cancel-timer org-image--timer)
    (setq org-image--timer nil))
  (note-importer-set-waiting nil)
  (message "%s" message))

(defcustom org-image-edit-command
  (pcase system-type
    ('windows-nt "mspaint")
    ('darwin "open")
    (_ "gimp"))
  "External command used by `org-image-edit' to edit images.
May include arguments, e.g. \"gimp\" or \"code\"."
  :type 'string
  :group 'note-importer)

(defun org-image--link-target-at-point ()
  "Return the file path of an org link at point, or nil.
Supports `[[file:PATH]]', `[[file:PATH][DESC]]' and plain
`[[PATH]]' links whose PATH is not a URL or other link type."
  (let ((target (org-image--link-target-org-element)))
    (or target (org-image--link-target-regex))))

(defun org-image--link-target-org-element ()
  "Resolve the file link at point via Org's element parser."
  (catch 'found
    (save-excursion
      (dolist (pos (list (point) (1- (point))))
        (ignore-errors
          (goto-char pos)
          (let ((el (org-element-context)))
            (when (and (eq (org-element-type el) 'link)
                       (string= (org-element-property :type el) "file"))
              (let ((path (org-element-property :path el)))
                (when path
                  (throw 'found (org-image--expand-link-path path)))))))))))

(defun org-image--link-target-regex ()
  "Fallback: resolve a plain `[[PATH]]' or `[[file:PATH][DESC]]'
link at point by scanning the current line."
  (save-excursion
    (let ((orig-point (point))
          (limit (line-end-position))
          (target nil))
      (goto-char (line-beginning-position))
      (while (and (not target)
                  (re-search-forward "\\[\\[" limit t))
        (let* ((start (match-beginning 0))
               (end (org-image--span-end))
               (span (when end (buffer-substring-no-properties start end))))
          (when (and end (<= start orig-point) (<= orig-point end))
            (let* ((inner (substring span 2 -2))
                   (parts (split-string inner "\\]\\["))
                   (path (string-trim (car parts))))
              (when (or (string-prefix-p "file:" path)
                        (string-match-p "^[\\./~]" path))
                (setq target (org-image--expand-link-path path)))))))
      target)))

(defun org-image--span-end ()
  "Return the end position of the `[[...]]' span starting just
after point, or nil.  Handles `[[path]]' and `[[path][desc]]'."
  (let ((limit (line-end-position)))
    (catch 'done
      (let ((i (point)))
        (while (< i (1- limit))
          (let ((c (char-after i))
                (d (char-after (1+ i))))
            (when (eq c ?\])
              (cond
               ((eq d ?\]) (throw 'done (+ i 2)))
               ((eq d ?\[) (setq i (1+ i)))
               (t nil)))
            (setq i (1+ i)))))
      nil)))

(defun org-image--expand-link-path (path)
  (when (string-prefix-p "file:" path)
    (setq path (substring path 5)))
  (expand-file-name
   (string-trim path)
   (file-name-directory (or (buffer-file-name) default-directory))))

(defun org-image-edit (&optional external)
  "Continue editing the figure linked at point on the web canvas.

The figure is uploaded to the server and the waiting flag is set;
open the Draw tab on any device to load it and keep drawing.  The
edited result overwrites this figure in place and inline images are
refreshed.  With a prefix argument, edit locally with
`org-image-edit-command' instead."
  (interactive "P")
  (if external
      (org-image-edit-external)
    (org-image-edit-canvas)))

(defun org-image-edit-external ()
  "Edit the image file linked at point with an external editor.
The editor is `org-image-edit-command'.  Inline images in the
current Org buffer are refreshed once the editor exits."
  (interactive)
  (let ((file (org-image--link-target-at-point)))
    (unless file
      (user-error "No file link at point"))
    (unless (file-exists-p file)
      (user-error "Image not found: %s" file))
    (let* ((parts (split-string org-image-edit-command))
           (program (car parts))
           (args (append (cdr parts) (list file)))
           (proc (apply #'start-process
                        "org-image-edit" nil program args)))
      (process-put proc :org-image-file file)
      (process-put proc :org-image-buffer (current-buffer))
      (set-process-sentinel
       proc
       (lambda (proc event)
         (when (string-prefix-p "finished" event)
           (let ((file (process-get proc :org-image-file))
                 (buf (process-get proc :org-image-buffer)))
              (when (buffer-live-p buf)
                (with-current-buffer buf
                  (when (fboundp 'org-display-inline-images)
                    (org-display-inline-images t t))))
             (message "Edited %s" (file-name-nondirectory file))))))
      (message "Editing %s with %s..." (file-name-nondirectory file) program))))

(defvar org-image-edit--busy nil
  "Non-nil while a canvas edit session is waiting for the edited figure.")
(defvar org-image-edit--timer nil)
(defvar org-image-edit--figure-file nil
  "The local figure file that the next canvas edit result will overwrite.")
(defvar org-image-edit--wait-start nil)
(defvar org-image-edit--request-id nil
  "Server upload_id of the edit request this session queued, so the
poll can tell it apart from the canvas edit result.")

(defun org-image-edit-canvas ()
  "Send the figure linked at point to the web canvas for further drawing."
  (interactive)
  (if org-image-edit--busy
      (message "Already editing a figure in the canvas (M-x org-image-edit-cancel to stop).")
    (let ((file (org-image--link-target-at-point)))
      (unless file
        (user-error "No file link at point"))
      (unless (file-exists-p file)
        (user-error "Image not found: %s" file))
      (let* ((orpd (org-image--orpd-extract file))
             (strokes-b64 (and orpd (base64-encode-string orpd t))))
        (org-image-edit--purge-pending)
        (condition-case err
            (setq org-image-edit--request-id (note-importer-post-edit file strokes-b64))
          (error
           (user-error "Failed to start canvas edit: %s"
                       (error-message-string err))))
        (setq org-image-edit--figure-file file)
        (setq org-image-edit--wait-start (current-time))
        (setq org-image-edit--busy t)
        (setq org-image-edit--timer
              (run-at-time org-image-poll-interval org-image-poll-interval
                           #'org-image-edit--poll))
        (note-importer-set-waiting t)
        (message "Editing %s on the web canvas (open the Draw tab). \
M-x org-image-edit-cancel to stop."
                 (file-name-nondirectory file))))))

(defun org-image-edit-cancel ()
  "Cancel the current canvas edit session."
  (interactive)
  (if (not org-image-edit--busy)
      (message "No canvas edit in progress.")
    (org-image-edit--finish "Cancelled canvas edit.")))

(defun org-image-edit--poll ()
  (if (or (not org-image-edit--busy)
          (> (float-time (time-subtract (current-time) org-image-edit--wait-start))
             org-image-timeout))
      (when org-image-edit--busy
        (org-image-edit--finish
       "Gave up waiting for edited figure (timeout). \
Nothing arrived from the canvas - was the Draw tab open, \
figure loaded, and Send to Emacs pressed?"))
    (let ((pending (note-importer-fetch-inbox "edit"))
          result)
      (dolist (item pending)
        (unless (equal (cdr (assoc 'id item)) org-image-edit--request-id)
          (setq result item)))
      (when result
        (org-image-edit--receive result)))))

(defun org-image-edit--receive (item)
  "Overwrite the figure being edited with ITEM from the server."
  (let* ((upload-id (cdr (assoc 'id item)))
         (url (cdr (assoc 'url item)))
         (dest org-image-edit--figure-file))
    (condition-case err
        (progn
          (unless (file-directory-p (file-name-directory dest))
            (make-directory (file-name-directory dest) t))
          (note-importer-download-file (concat note-importer-server-url url) dest)
          (unless (file-exists-p dest)
            (error "Downloaded file not found: %s" dest))
          (note-importer-delete-on-server (list upload-id))
          (org-image-edit--finish
           (format "Updated %s (canvas edit saved)."
                   (file-name-nondirectory dest)))
          (org-image-edit--refresh dest))
      (error
       (org-image-edit--finish
        (format "Failed to receive edited figure: %s"
                (error-message-string err)))))))

(defun org-image-edit--refresh (file)
  "Refresh inline images in Org buffers that show FILE."
  (let ((basename (file-name-nondirectory file)))
    (dolist (buf (buffer-list))
      (with-current-buffer buf
        (when (and (derived-mode-p 'org-mode)
                   (save-excursion
                     (goto-char (point-min))
                     (search-forward basename nil t)))
          (cond ((fboundp 'org-redisplay-inline-images)
                 (org-redisplay-inline-images))
                ((fboundp 'org-display-inline-images)
                 (org-display-inline-images t t))))))))

(defun org-image-edit--purge-pending ()
  "Delete any leftover pending `edit' items on the server."
  (let ((pending (note-importer-fetch-inbox "edit")))
    (when pending
      (note-importer-delete-on-server
       (mapcar (lambda (item) (cdr (assoc 'id item))) pending)))))

(defun org-image-edit--finish (message)
  "End the canvas edit session, clearing server waiting state."
  (setq org-image-edit--busy nil)
  (when org-image-edit--timer
    (cancel-timer org-image-edit--timer)
    (setq org-image-edit--timer nil))
  (ignore-errors (org-image-edit--purge-pending))
  (note-importer-set-waiting nil)
  (message "%s" message))

(defun note-importer-read-binary (file)
  "Return the raw unibyte contents of FILE."
  (with-temp-buffer
    (set-buffer-multibyte nil)
    (let ((coding-system-for-read 'binary))
      (insert-file-contents-literally file))
    (buffer-string)))

(defun note-importer-file-base64 (file)
  "Return the base64 encoding (no line breaks) of FILE's contents."
  (base64-encode-string (note-importer-read-binary file) t))

(defun note-importer-post-edit (file strokes-b64)
  "POST figure FILE to the server /edit endpoint.
STROKES-B64 is the optional base64 tldraw JSON (or nil for a raster
figure).  Signals an error unless the server responds 2xx; returns the
server upload_id of the queued edit item (string, or nil if the body
could not be parsed)."
  (let* ((url (concat note-importer-server-url "/edit"))
         (payload (list (cons "image_b64" (note-importer-file-base64 file))
                        (cons "filename" (file-name-nondirectory file))
                        (cons "replaces" (file-name-nondirectory file))
                        (cons "title" "Drawing")
                        (cons "strokes_b64" strokes-b64)))
         (status-text nil)
         (body "")
         buf)
    (setq url-request-method "POST")
    (setq url-request-extra-headers
          (list (cons "Authorization"
                      (format "Bearer %s" note-importer--auth-token))
                (cons "Content-Type" "application/json")))
    (setq url-request-data (json-encode payload))
    (setq buf (url-retrieve-synchronously url t))
    (unless buf
      (error "note-importer: /edit request failed (no response received)"))
    (with-current-buffer buf
      (goto-char (point-min))
      (when (re-search-forward "^HTTP/[0-9.]+ \\([0-9]\\{3\\}\\)" nil t)
        (setq status-text (match-string 1)))
      (when (re-search-forward "^\r?$" nil t)
        (setq body (buffer-substring-no-properties (point) (point-max))))
      (kill-buffer buf))
    (unless (and status-text (string-match-p "^2[0-9][0-9]$" status-text))
      (error "note-importer: /edit failed with status %s: %s"
             (or status-text "unknown") (string-trim body)))
    (condition-case nil
        (let ((json-object-type 'alist) (json-key-type 'string))
          (cdr (assoc "upload_id" (json-read-from-string (string-trim body)))))
      (error nil))))

(defun org-image--be32 (bytes pos)
  "Return the big-endian 32-bit integer in unibyte BYTES at POS."
  (logior (ash (aref bytes pos) 24)
          (ash (aref bytes (+ pos 1)) 16)
          (ash (aref bytes (+ pos 2)) 8)
          (aref bytes (+ pos 3))))

(defun org-image--png-chunks (bytes)
  "Parse unibyte PNG BYTES into ((TYPE . DATA) ...) or nil when not a PNG.
TYPE is a 4-character string chunk name; DATA is its unibyte payload.
The signature and IEND are not validated."
  (if (not (string-prefix-p
            (unibyte-string #x89 ?P ?N ?G #x0d #x0a #x1a #x0a) bytes))
      nil
    (let ((pos 8) (len (length bytes)) (out nil) (ok t))
      (condition-case nil
          (while (and ok (<= (+ pos 8) len))
            (let* ((length (org-image--be32 bytes pos))
                   (type (substring bytes (+ pos 4) (+ pos 8)))
                   (data-start (+ pos 8))
                   (data-end (+ data-start length)))
              (if (or (> data-end len) (< length 0))
                  (setq ok nil)
                (setq out (append out (list (cons type
                                                  (substring bytes data-start data-end))))
                      pos (+ data-end 4)))))
        (error (setq ok nil)))
      (and ok out))))

(defun org-image--orpd-extract (file)
  "Return the embedded tldraw drawing JSON in FILE, or nil.

Only reads the `orPd' private chunk with format byte 0x02 (web
/tldraw).  Since it only extracts (never rewrites) a figure, the
server's rendered PNG is preserved verbatim."
  (let* ((bytes (ignore-errors (note-importer-read-binary file)))
         (chunks (and bytes (org-image--png-chunks bytes))))
    (when chunks
      (let ((orpd (cdr (assoc "orPd" chunks))))
        (when (and orpd (> (length orpd) 0)
                   (= (aref orpd 0) #x02))
          (substring orpd 1))))))

(provide 'note-importer)