blob: bb451c1b5d1fb934ed59bccedd70ce009b3e612a (
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
|
;; SPDX-License-Identifier: EUPL-1.2
;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
(defpackage :ukkoclot/src/transport
(:documentation "Package dealing with HTTP calls.")
(:use :c2cl)
(:import-from :cl+ssl)
(:import-from :dex)
(:import-from :log)
(:import-from :ukkoclot/src/serializing :fixup-args :parse-value)
(:import-from :ukkoclot/src/state :bot-base-uri)
(:local-nicknames
(:jzon :com.inuoe.jzon))
(:export :do-call))
(in-package :ukkoclot/src/transport)
(defun req (uri method content)
"Wrapper function for making a request."
(let ((retrier (dex:retry-request 5 :interval 1))
;; This is needed to avoid hangs,
;; see https://github.com/fukamachi/dexador/issues/91#issuecomment-1093472364
(cl+ssl:*default-unwrap-stream-p* nil))
(handler-case (dex:request uri :method method :content content :read-timeout 60 :connect-timeout 60)
;; We deal with too many requests manually
(dex:http-request-too-many-requests (e) (dex:ignore-and-continue e))
(dex:http-request-failed (e) (funcall retrier e))
(cl+ssl::ssl-error (e) (funcall retrier e)))))
(defun do-call% (method uri out-type args-encoded)
"Internal function with the arguments already encoded.
See `do-call'."
(let* ((body (req uri method args-encoded))
(hash (jzon:parse body)))
(if (gethash "ok" hash)
(parse-value out-type (gethash "result" hash))
(let* ((error-code (gethash "error_code" hash))
(description (gethash "description" hash))
(parameters (gethash "parameters" hash))
(retry-after (when parameters (gethash "retry_after" parameters))))
(cond
(retry-after
(log:info "Should sleep for ~A seconds" retry-after)
(sleep retry-after)
(log:info "Good morning!")
(do-call% method uri out-type args-encoded))
(t
(error "TG error ~A: ~A ~:A"
error-code description parameters)))))))
(defun do-call (bot method path out-type args)
"Perform a HTTP call."
(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% method uri out-type args-encoded)))
|