summaryrefslogtreecommitdiff
path: root/src/transport.lisp
blob: 12e09f4f87249c5b091d819c3b0ec8e0a13e4b81 (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
;; 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 :serapeum :->)
  (:import-from :state :base-uri)
  (:import-from :ukkoclot/src/serializing :fixup-args :parse-value)
  (:local-nicknames
   (:jzon :com.inuoe.jzon))
  (:export :do-call :http-method))
(in-package :ukkoclot/src/transport)

;; Yes I know there are more, these are all I care about though
(deftype http-method ()
  '(member :GET :POST))

;; TODO: Better type for the list, it's an alist of string to t
(-> req (string http-method list) (or string null))
(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)))))

;; TODO: (alist string t)
(-> do-call% (http-method string t list) t)
(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)))))))

;; TODO: (alist t t)
(-> do-call (http-method string t list) t)
(defun do-call (method path out-type args)
  "Perform a HTTP call."
  (let ((uri (concatenate 'string (base-uri) path))
        (args-encoded (fixup-args args)))
    (log:debug "~A .../~A ~S" method path args-encoded)
    (do-call% method uri out-type args-encoded)))