blob: 3672ae207230219f4f9d2b3db468e5b2a5f7de55 (
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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
#!/usr/bin/guile \
-e main -s
!#
;;; SPDX-FileCopyrightText: 2026 Matthew Fennell <matthew@fennell.dev>
;;;
;;; SPDX-License-Identifier: AGPL-3.0-or-later
(use-modules (ice-9 exceptions)
(ice-9 local-eval)
(ice-9 match)
(ice-9 receive)
(ice-9 string-fun)
(ice-9 threads)
(json)
(logging logger)
(logging port-log)
(oop goops)
((rnrs base) #:select (mod))
(rnrs bytevectors)
(srfi srfi-1)
(srfi srfi-9 gnu)
(srfi srfi-11)
(srfi srfi-19)
(srfi srfi-26)
(srfi srfi-45)
(web client)
(web http)
(web response)
(web uri))
(include "records.scm")
(include "config.scm")
(define logger (make <logger>))
(define handler (make <port-log> #:port (current-output-port)))
(add-handler! logger handler)
(disable-log-level! logger 'DEBUG)
(disable-log-level! logger 'SENSITIVE)
(set-default-logger! logger)
(define (login login-request)
(log-msg 'INFO "Logging in as " (login-request-username login-request))
(api-request #:method 'POST
#:path "/api/auth/customer/login"
#:request login-request
#:transformer (lambda (b)
(login-response-token
(json->login-response b)))))
(define* (times #:key
(venues default-venues)
(activities default-activities)
(dates default-dates)
(token #f))
(let*
((venues (map symbol->string venues))
(activities (map symbol->string activities))
(dates (map this dates))
(dates (filter (lambda (d) (not (equal? d (date-date (current-date))))) dates))
(dates (map date->api-string dates))
(permutations (cartesian-product venues activities dates))
(positive-spaces? (lambda (t) ((compose positive? time-data-spaces) t)))
(requests
(map
(lambda (permutation)
(match permutation
((venue activity date)
`(api-request #:method 'GET
#:path ,(string-append
"/api/activities/venue/" venue
"/activity/" activity
"/times")
#:query ,(string-append "date=" date)
#:transformer ,(lambda (b) (map time-data->booking (filter positive-spaces? ((compose time-response-data json->time-response) b))))
#:token ,token))))
permutations))
(all-times (apply append (filter identity (par-map (lambda (r) (local-eval r (the-environment))) requests)))))
all-times))
(define* (scored bookings #:key (scorer default-scorer))
(let*
((bookings (sort bookings booking-end<?))
(scores (map scorer bookings))
(scored (zip bookings scores))
(scored (stable-sort scored (lambda (a b) (and (< (second a) (second b))))))
(scored (reverse scored)))
scored))
(define* (bookings #:key (venues default-venues)
(activities default-activities)
(dates default-dates)
token)
(let ((all-bookings (api-request #:method 'GET
#:path "/api/my-account/bookings"
#:query "filter=future"
#:transformer (lambda (d)
(map bookings-response-data->booking
((compose bookings-response-data json->bookings-response) d)))
#:token token)))
(filter (lambda (b)
(and (any (cute eq? <> (booking-venue b)) venues)
(any (cute eq? <> (booking-activity b)) activities)
(any (cute eq? <> ((compose date->day-name booking-start) b)) dates)))
all-bookings)))
(define* (book booking #:key (checkout #t) token)
(define* (get-slot booking #:key (token #f))
(log-msg 'INFO "Finding a free slot for booking " booking)
(let* ((venue ((compose symbol->string booking-venue) booking))
(activity ((compose symbol->string booking-activity) booking))
(date ((compose date->api-string booking-start) booking))
(start ((compose time->api-string booking-start) booking))
(end ((compose time->api-string booking-end) booking))
(path (string-append "/api/activities/venue/" venue
"/activity/" activity
"/slots"))
(query (string-append "date=" date
"&start_time=" start
"&end_time=" end))
(transformer (lambda (b)
(car (filter (compose positive? slot-spaces)
((compose slots-response-data json->slots-response) b))))))
(api-request #:method 'GET
#:path path
#:query query
#:transformer transformer
#:token token)))
(define* (add slot #:key token)
(let
((request (make-add-request (list (make-add-item (slot-id slot)
(slot-type slot))))))
(api-request #:method 'POST
#:path "/api/activities/cart/add"
#:request request
#:token token)
#t))
(define* (get-cart #:key token)
(api-request #:method 'GET
#:path "/api/activities/cart"
#:transformer (compose cart-response-data json->cart-response)
#:token token))
(define* (apply-credit cart #:key token)
(let
((request (make-apply-credits-request "activity-booking" (list (make-credits-to-reserve (cart-total cart) "general")) 'null)))
(api-request #:method 'POST
#:path "/api/credits/apply"
#:request request
#:token token)
#t))
(define* (complete cart #:key token)
(let*
((payment (make-payment "credit" (cart-total cart) '()))
(request (make-complete-request #() `(,payment) 'null "activity-booking" #(1) (cart-item-hash cart))))
(api-request #:method 'POST
#:path "/api/checkout/complete"
#:request request
#:token token)
#t))
(define slot (get-slot booking #:token token))
(add slot #:token token)
(when checkout
(let ((cart (get-cart #:token token)))
(apply-credit cart #:token token)
(complete cart #:token token))))
(define* (book-best #:key (venues default-venues)
(activities default-activities)
(dates default-dates)
(checkout default-checkout)
(user default-user))
(let* ((token (login user))
(existing (scored (bookings #:venues venues #:activities activities #:dates dates #:token token)))
(best-existing (reduce max-score fake-score existing))
(new (scored (times #:venues venues #:activities activities #:dates dates #:token token)))
(best-new (reduce max-score fake-score new)))
(log-msg 'INFO "Best new booking: " (first best-new) " with score " (second best-new))
(log-msg 'INFO "Best existing booking: " (first best-existing) " with score " (second best-existing))
(when (score>? best-new best-existing)
(log-msg 'INFO "Booking " (first best-new))
(book (first best-new) #:checkout checkout #:token token))
(log-msg 'INFO "Done")))
(define (main args) (book-best))
|
