aboutsummaryrefslogtreecommitdiff
path: root/telebot.scm
blob: 0db37c6c0294cc2386042d2c590dd2e6eddd909f (plain)
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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
(module telebot (getMe
                 getUpdates
                 sendMessage
                 forwardMessage
                 sendPhoto
                 sendAudio
                 sendDocument
                 sendSticker
                 sendVideo
                 sendVoice
                 sendLocation
                 sendChatAction
                 getUserProfilePhotos
                 getFile
                 pollUpdates)
  (import chicken scheme)
  (use srfi-1)
  (use openssl)
  (use http-client)
  (use medea)
  (use loops)
  (use vector-lib)

  (define-constant api-base "https://api.telegram.org/bot")

  ;;; helper functions

  (define (get-query-url token method)
    (string-append api-base token "/" method))

  (define (clean-query-parameters parameters)
    (let ((cleaned-parameters (remove (lambda (p) (equal? #f (cdr p)))
                                      parameters)))
      (if (null-list? cleaned-parameters)
        #f
        cleaned-parameters)))

  ;;; plain API wrappers, returning deserialized JSON

  (define-syntax wrap-api-method
    (syntax-rules ()
    ((wrap-api-method method(parameters ...))
     (define (method
              token
              #!key parameters ...)
       (with-input-from-request
         (get-query-url token (symbol->string 'method))
         (clean-query-parameters
           (map (lambda (l) (cons (first l) (second l)))
                (zip '(parameters ...)
                     (list parameters ...))))
         read-json)))))

  (wrap-api-method getMe())

  (wrap-api-method getUpdates(offset limit timeout))

  (wrap-api-method sendMessage(chat_id
                               text
                               parse_mode
                               disable_web_page_preview
                               disable_notification
                               reply_to_message_id
                               reply_markup))

  (wrap-api-method forwardMessage(chat_id
                                  from_chat_id
                                  message_id
                                  disable_notification))

  (wrap-api-method sendPhoto(chat_id
                             photo
                             caption
                             disable_notification
                             reply_to_message_id
                             reply_markup))

  (wrap-api-method sendAudio(chat_id
                             audio
                             duration
                             performer
                             title
                             disable_notification
                             reply_to_message_id
                             reply_markup))

  (wrap-api-method sendDocument(chat_id
                                document
                                caption
                                disable_notification
                                reply_to_message_id
                                reply_markup))

  (wrap-api-method sendSticker(chat_id
                               sticker
                               disable_notification
                               reply_to_message_id
                               reply_markup))

  (wrap-api-method sendVideo(chat_id
                             video
                             duration
                             width
                             height
                             caption
                             disable_notification
                             reply_to_message_id
                             reply_markup))

  (wrap-api-method sendVoice(chat_id
                             voice
                             duration
                             disable_notification
                             reply_to_message_id
                             reply_markup))

  (wrap-api-method sendLocation(chat_id
                                latitude
                                longitude
                                disable_notification
                                reply_to_message_id
                                reply_markup))

  (wrap-api-method sendChatAction(chat_id action))

  (wrap-api-method getUserProfilePhotos(user_id
                                        offset
                                        limit))

  (wrap-api-method getFile(file_id))

  ;;; framework

  (define (pollUpdates token handler)
    (define offset  0)
    (define process (lambda (i u)
                      (begin (handler u)
                             (set! offset (+ 1 (cdr (assv 'update_id u)))))))
    (do-forever
      (vector-for-each process
                       (cdr (assv 'result (getUpdates token
                                                      offset:  offset
                                                      timeout: 60))))))
)