;; SPDX-License-Identifier: EUPL-1.2
;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
(defpackage :ukkoclot/bot/impl
  (:use :c2cl :iterate :ukkoclot/config)
  (:import-from :anaphora :aand :acond :it)
  (:import-from :cl+ssl)
  (:import-from :dex)
  (:import-from :log)
  (:import-from :ukkoclot/strings :lisp->snake-case)
  (:local-nicknames
   (:jzon :com.inuoe.jzon))
  (:export
   :bot :bot-p :make-bot :fixup-value :do-call :parse-value

   :bot-config :bot-db :bot-base-uri :bot-power-on :bot-username% :bot-id%))
(in-package :ukkoclot/bot/impl)

(defgeneric parse-value (type json)
  (:documentation "Parse value of TYPE from the parsed JSON")
  (:method (type json)
    (log:error "I don't know how to parse simple type ~A!" type)
    (error "I don't know how to parse simple type ~A!" type))
  (:method ((type (eql 'boolean)) json)
    (check-type json boolean)
    json)
  (:method ((type (eql 'integer)) json)
    (check-type json integer)
    json)
  (:method ((type (eql 'null)) json)
    (check-type json null)
    json)
  (:method ((type (eql 'string)) json)
    (check-type json string)
    json))

(defun try-parse-value (type json)
  (handler-case (values t (parse-value type json))
    (error () (values nil nil))))

(defmethod parse-value ((type cons) json)
  (cond ((and (eq (car type) 'array)
              (null (cddr type)))
         (when json
           (let ((element-type (cadr type)))
             (iter (for element in-vector json)
               (collect (parse-value element-type element) result-type vector)))))
        ((eq (car type) 'or)
         (iter (for el-type in (cdr type))
           (multiple-value-bind (success res) (try-parse-value el-type json)
             (when success
               (return res)))
           (finally
            (error "Failed to parse ~S as ~A!" json type))))
        (t
         (error "I don't know how to parse complex type ~A!" type))))

(defgeneric fixup-value (value)
  (:documentation "Fixup top-level VALUE before passing it onto telegram")
  (:method (value)
    (jzon:stringify value :pretty *print-pretty*))
  (:method ((value null))
    value)
  (:method ((value number))
    value)
  (:method ((value pathname))
    value)
  (:method ((value string))
    value))

(defstruct (bot (:constructor make-bot%))
  (config (error "No value given for config") :read-only t)
  (db (error "No value given for DB") :read-only t)
  (base-uri (error "No value given for base-uri") :read-only t)
  (power-on t :type boolean)
  (username% nil :type (or string null))
  (id% nil :type (or integer null)))

(defun make-bot (config db)
  (let ((base-uri (concatenate 'string
                               "https://api.telegram.org/bot"
                               (config-bot-token config) "/")))
    (make-bot% :config config :db db :base-uri base-uri)))

(defun fixup-args (args)
  (iter (for (key . value) in args)
    (collect
        (cons (string-downcase (lisp->snake-case (symbol-name key)))
              (fixup-value value)))))

(defun req (uri method content)
  (let ((retrier (dex:retry-request 5 :interval 1)))
    (handler-case (dex:request uri :method method :content content)
      (dex:http-request-too-many-requests (e) (dex:ignore-and-continue e)) ; We deal with too many reqs manually
      (dex:http-request-failed (e) (funcall retrier e))
      (cl+ssl::ssl-error (e) (funcall retrier e)))))

(defun do-call% (bot method uri type args-encoded)
  (let ((body (req uri method args-encoded)))
    (let ((hash (jzon:parse body)))
      (acond
        ((gethash "ok" hash) (parse-value type (gethash "result" hash)))
        ((aand (gethash "parameters" hash)
               (gethash "retry_after" it))
         (log:info "Should sleep for ~A seconds" it)
         (sleep it)
         (log:info "Good morning!")
         (do-call% bot method uri type args-encoded))
        (t (error "TG error ~A: ~A ~:A"
                  (gethash "error_code" hash)
                  (gethash "description" hash)
                  (gethash "parameters" hash)))))))

(defun do-call (bot method path type args)
  (let ((uri (concatenate 'string (bot-base-uri bot) path))
        (args-encoded (fixup-args args)))
    (log:debug "~A .../~A ~S" method path args-encoded)
    (do-call% bot method uri type args-encoded)))