AtlatestRepositorysigil-youtube
sigil-youtube / tree / srcyoutube.sgl
1
;;; (youtube) - YouTube Data API v3 client library.2
;;;3
;;; Core module providing authentication, HTTP helpers, record types,4
;;; and functions for video management, channel info, search, and thumbnails.5
;;;6
;;; Quota costs are documented per function:7
;;; - Read operations: 1 unit8
;;; - Write operations: 50 units9
;;; - Search: 100 units10
;;; - Video upload: 1,600 units (see (youtube upload))12
(define-library (youtube)13
(import (sigil core)14
(sigil dict)15
(sigil string)16
(sigil struct)17
(sigil json)18
(only (sigil http) url-encode-value build-query-string)19
(sigil http client))21
(export ;; Client22
youtube-client23
youtube-client?24
youtube-client-access-token25
youtube-client-api-key26
youtube-client-base-url27
youtube-client-upload-url29
;; Records — video30
youtube-video31
youtube-video?32
youtube-video-id33
youtube-video-title34
youtube-video-description35
youtube-video-tags36
youtube-video-category-id37
youtube-video-privacy-status38
youtube-video-published-at39
youtube-video-statistics41
;; Records — channel42
youtube-channel43
youtube-channel?44
youtube-channel-id45
youtube-channel-title46
youtube-channel-subscriber-count47
youtube-channel-video-count48
youtube-channel-uploads-playlist-id50
;; Shared helpers (for sub-modules)51
youtube-auth-headers52
youtube-api-url53
youtube-upload-api-url54
youtube-get/json55
youtube-post/json56
youtube-put/json57
youtube-delete/json58
check-youtube-response60
;; Parsing61
parse-video62
parse-channel63
parse-page-info65
;; API functions66
youtube-channel-info67
youtube-channel-mine68
youtube-videos69
youtube-video-update70
youtube-video-delete71
youtube-search72
youtube-set-thumbnail)74
(begin76
;; ---------------------------------------------------------------77
;; Records78
;; ---------------------------------------------------------------80
(define-struct youtube-client81
(access-token default: #f)82
(api-key default: #f)83
(base-url default: "https://www.googleapis.com/youtube/v3")84
(upload-url default: "https://www.googleapis.com/upload/youtube/v3"))86
(define-struct youtube-video87
(id)88
(title default: "")89
(description default: "")90
(tags default: '())91
(category-id default: #f)92
(privacy-status default: "private")93
(published-at default: #f)94
(statistics default: #{}))96
(define-struct youtube-channel97
(id)98
(title default: "")99
(subscriber-count default: 0)100
(video-count default: 0)101
(uploads-playlist-id default: #f))103
;; ---------------------------------------------------------------104
;; Internal helpers105
;; ---------------------------------------------------------------107
(define (youtube-auth-headers client)108
(let ((token (youtube-client-access-token client)))109
(if token110
#{ authorization: (string-append "Bearer " token) }111
#{})))113
(define (youtube-api-url client . parts)114
(apply build-api-url (youtube-client-base-url client) parts))116
(define (youtube-upload-api-url client . parts)117
(apply build-api-url (youtube-client-upload-url client) parts))120
;;; Append api-key to query params if client has one and no access-token.121
(define (maybe-add-api-key client params)122
(let ((key (youtube-client-api-key client))123
(token (youtube-client-access-token client)))124
(if (and key (not token))125
(cons (cons "key" key) params)126
params)))128
;;; Response checker with YouTube-specific quota/auth context.129
(define check-youtube-response130
(make-response-checker131
name: "YouTube API"132
handlers: (list133
(cons 401 "Access token may be expired — refresh and retry.")134
(cons 403 "Possible quota exceeded or insufficient permissions. Check quota at console.cloud.google.com.")135
(cons 429 "Respect Retry-After header and retry with backoff."))))137
;;; Authenticated JSON GET request.138
(define (youtube-get/json client url)139
(check-youtube-response140
(http-get url headers: (youtube-auth-headers client))))142
;;; Authenticated JSON POST request.143
(define (youtube-post/json client url body)144
(check-youtube-response145
(http-post url (if (string? body) body (json-encode body))146
headers: (dict-merge (youtube-auth-headers client)147
#{ content-type: "application/json" }))))149
;;; Authenticated JSON PUT request.150
(define (youtube-put/json client url body)151
(check-youtube-response152
(http-put url (if (string? body) body (json-encode body))153
headers: (dict-merge (youtube-auth-headers client)154
#{ content-type: "application/json" }))))156
;;; Authenticated DELETE request.157
(define (youtube-delete/json client url)158
(check-youtube-response159
(http-delete url headers: (youtube-auth-headers client))))161
;; ---------------------------------------------------------------162
;; Response parsing163
;; ---------------------------------------------------------------165
;;; Extract pagination info from a list response.166
;;; Returns a dict with total-results and next-page-token.167
(define (parse-page-info data)168
(let ((page-info (dict-ref data pageInfo: #{})))169
#{ total-results: (dict-ref page-info totalResults: 0)170
next-page-token: (dict-ref data nextPageToken: #f) }))172
;;; Parse a video resource from the API into a youtube-video record.173
(define (parse-video data)174
(let ((snippet (dict-ref data snippet: #{}))175
(status (dict-ref data status: #{}))176
(stats (dict-ref data statistics: #{})))177
(youtube-video178
id: (dict-ref data id:)179
title: (dict-ref snippet title: "")180
description: (dict-ref snippet description: "")181
tags: (let ((t (dict-ref snippet tags: #f)))182
(if (and t (array? t))183
(array->list t)184
'()))185
category-id: (dict-ref snippet categoryId: #f)186
privacy-status: (dict-ref status privacyStatus: "private")187
published-at: (dict-ref snippet publishedAt: #f)188
statistics: stats)))190
;;; Parse a channel resource from the API into a youtube-channel record.191
(define (parse-channel data)192
(let ((snippet (dict-ref data snippet: #{}))193
(stats (dict-ref data statistics: #{}))194
(content (dict-ref data contentDetails: #{})))195
(let ((related (dict-ref content relatedPlaylists: #{})))196
(youtube-channel197
id: (dict-ref data id:)198
title: (dict-ref snippet title: "")199
subscriber-count: (let ((v (dict-ref stats subscriberCount: "0")))200
(if (string? v) (string->number v) v))201
video-count: (let ((v (dict-ref stats videoCount: "0")))202
(if (string? v) (string->number v) v))203
uploads-playlist-id: (dict-ref related uploads: #f)))))205
;; ---------------------------------------------------------------206
;; API functions207
;; ---------------------------------------------------------------209
;;; Get channel info by channel ID.210
;;; Quota cost: 1 unit.211
(define (youtube-channel-info client channel-id)212
(let* ((params (maybe-add-api-key client213
(list (cons "part" "snippet,statistics,contentDetails")214
(cons "id" channel-id))))215
(url (string-append216
(youtube-api-url client "channels")217
(build-query-string params)))218
(data (youtube-get/json client url))219
(items (dict-ref data items: #[])))220
(if (> (array-length items) 0)221
(parse-channel (array-ref items 0))222
#f)))224
;;; Get the authenticated user's channel info.225
;;; Quota cost: 1 unit. Requires OAuth access token.226
(define (youtube-channel-mine client)227
(if (not (youtube-client-access-token client))228
(error "youtube-channel-mine requires an OAuth access token"))229
(let* ((url (string-append230
(youtube-api-url client "channels")231
(build-query-string232
(list (cons "part" "snippet,statistics,contentDetails")233
(cons "mine" "true")))))234
(data (youtube-get/json client url))235
(items (dict-ref data items: #[])))236
(if (> (array-length items) 0)237
(parse-channel (array-ref items 0))238
#f)))240
;;; Get videos by ID(s). Pass a single ID or comma-separated IDs.241
;;; Batching multiple IDs costs only 1 unit total.242
;;; Quota cost: 1 unit.243
(define (youtube-videos client video-ids)244
(let* ((params (maybe-add-api-key client245
(list (cons "part" "snippet,statistics,status,contentDetails")246
(cons "id" video-ids))))247
(url (string-append248
(youtube-api-url client "videos")249
(build-query-string params)))250
(data (youtube-get/json client url))251
(items (dict-ref data items: #[])))252
(array->list (array-map parse-video items))))254
;;; Update video metadata. Takes a video ID and a dict of fields to update.255
;;; Only fields present in updates are sent; omitted fields are not touched.256
;;; Supported fields: title:, description:, tags:, categoryId:, privacyStatus:.257
;;;258
;;; IMPORTANT: YouTube requires both title: and categoryId: when updating259
;;; any snippet field. If you update description: or tags:, you must also260
;;; include title: and categoryId: in the updates dict. This function261
;;; raises an error if snippet fields are being updated without both262
;;; title: and categoryId: present.263
;;;264
;;; Quota cost: 50 units.265
(define (youtube-video-update client video-id updates)266
(let* ((snippet-keys '((title: . title:)267
(description: . description:)268
(tags: . tags:)269
(categoryId: . categoryId:)))270
(status-keys '((privacyStatus: . privacyStatus:)))271
(collect (lambda (key-map)272
(filter cdr273
(map (lambda (pair)274
(cons (cdr pair)275
(dict-ref updates (car pair) #f)))276
key-map))))277
(snippet-fields (collect snippet-keys))278
(status-fields (collect status-keys))279
(parts (append (if (null? snippet-fields) '() '("snippet"))280
(if (null? status-fields) '() '("status")))))281
(if (null? parts)282
(error "youtube-video-update: no fields to update"))283
;; YouTube requires both title and categoryId when snippet is in part284
(if (not (null? snippet-fields))285
(begin286
(if (not (dict-ref updates title: #f))287
(error (string-append288
"youtube-video-update: title: is required when updating "289
"snippet fields (YouTube API requirement)")))290
(if (not (dict-ref updates categoryId: #f))291
(error (string-append292
"youtube-video-update: categoryId: is required when updating "293
"snippet fields (YouTube API requirement)")))))294
(let* ((fields->dict295
(lambda (fields)296
(apply dict (apply append297
(map (lambda (p) (list (car p) (cdr p))) fields)))))298
(body (let ((b #{ id: video-id }))299
(let ((b (if (null? snippet-fields) b300
(dict-set b snippet: (fields->dict snippet-fields)))))301
(if (null? status-fields) b302
(dict-set b status: (fields->dict status-fields))))))303
(url (string-append304
(youtube-api-url client "videos")305
(build-query-string306
(list (cons "part" (string-join parts ","))))))307
(result (youtube-put/json client url body)))308
(parse-video result))))310
;;; Delete a video by ID.311
;;; Quota cost: 50 units.312
(define (youtube-video-delete client video-id)313
(let ((url (string-append314
(youtube-api-url client "videos")315
(build-query-string316
(list (cons "id" video-id))))))317
(youtube-delete/json client url)))319
;;; Search YouTube. WARNING: costs 100 quota units per call.320
;;; Prefer youtube-videos with known IDs or playlist-items when possible.321
;;;322
;;; query: search term string323
;;; Optional keyword args via opts dict:324
;;; type: "video", "channel", "playlist" (default: "video")325
;;; max-results: number (default: 25, max: 50)326
;;; order: "date", "rating", "relevance", "title", "viewCount"327
;;; page-token: for pagination328
;;; channel-id: restrict to a channel329
;;; published-after: ISO 8601 datetime330
;;; published-before: ISO 8601 datetime331
;;;332
;;; Quota cost: 100 units.333
(define (youtube-search client query . rest)334
(let ((opts (if (null? rest) #{} (car rest))))335
(let* ((params (maybe-add-api-key client336
(list (cons "part" "snippet")337
(cons "q" query)338
(cons "type" (dict-ref opts type: "video"))339
(cons "maxResults"340
(number->string341
(dict-ref opts max-results: 25)))342
(cons "order"343
(dict-ref opts order: #f))344
(cons "pageToken"345
(dict-ref opts page-token: #f))346
(cons "channelId"347
(dict-ref opts channel-id: #f))348
(cons "publishedAfter"349
(dict-ref opts published-after: #f))350
(cons "publishedBefore"351
(dict-ref opts published-before: #f)))))352
(url (string-append353
(youtube-api-url client "search")354
(build-query-string params)))355
(data (youtube-get/json client url)))356
;; Return raw results — search returns snippet-only items with357
;; id.videoId rather than full video resources358
data)))360
;;; Upload a custom thumbnail for a video.361
;;; image-data should be the raw bytes of a JPEG or PNG image.362
;;; Max size: 2 MB. Recommended: 1280x720 (min width 640px).363
;;; Quota cost: 50 units.364
(define (youtube-set-thumbnail client video-id image-data content-type)365
(let ((url (string-append366
(youtube-upload-api-url client "thumbnails" "set")367
(build-query-string368
(list (cons "videoId" video-id))))))369
(check-youtube-response370
(http-post url image-data371
headers: (dict-merge (youtube-auth-headers client)372
#{ content-type: content-type })))))374
))