blob: b57e2d3ce2b1592fb5c1959eebf7b970770231c2 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
;; 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 :ukkoclot/log)
(:import-from :anaphora :aand :acond :it)
(:import-from :dex)
(:import-from :ukkoclot/strings :lisp->snake-case)
(:local-nicknames
(:jzon :com.inuoe.jzon))
(:export
:arg-encode :bot :bot-p :make-bot :do-call
:bot-config :bot-db :bot-base-uri :bot-power-on :bot-username% :bot-id%))
(in-package :ukkoclot/bot/impl)
(defgeneric will-arg-encode (object)
(:documentation "Whether the OBJECT has any transformation done to it by arg-encode")
(:method (obj)
nil)
(:method ((obj cons))
(or (will-arg-encode (car obj))
(will-arg-encode (cdr obj)))))
(defgeneric arg-encode (object)
(:documentation "Encode the OBJECT to a form that our HTTP code is happy about.")
(:method (obj)
obj)
(:method ((obj cons))
(if (not (will-arg-encode obj))
obj
(cons (arg-encode (car obj))
(arg-encode (cdr obj))))))
(defgeneric fixup-arg (value)
(:documentation "Make sure Telegram & QURI & whatever like the arg")
(:method (value)
(error "Unsupported argument type ~S (~S)" (class-name (class-of value)) value))
(:method ((value null))
value)
(:method ((value number))
value)
(:method ((value string))
value)
(:method ((value hash-table))
(jzon:stringify 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 args-plist->alist (args-plist)
(iter (for (old-key value) on args-plist by #'cddr)
(collect
(let ((new-key (string-downcase (lisp->snake-case (symbol-name old-key)))))
(cons new-key value)))))
(defun fixup-args (args-alist)
(iter (for (name . value) in args-alist)
(collecting (cons name (fixup-arg (arg-encode value))))))
(defun req (uri method content)
;; We deal with this manually
(handler-bind ((dex:http-request-too-many-requests #'dex:ignore-and-continue))
(dex:request uri :method method :content content)))
(defun do-call% (bot method uri mapfn args-encoded)
(let ((body (req uri method args-encoded)))
(let ((hash (jzon:parse body)))
(acond
((gethash "ok" hash) (funcall mapfn (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 mapfn 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 mapfn args-plist)
(let ((uri (concatenate 'string (bot-base-uri bot) path))
(args-encoded (fixup-args (args-plist->alist args-plist))))
(log-debug "~A .../~A ~S" method path args-encoded)
(do-call% bot method uri mapfn args-encoded)))
|
