src/youtube/upload.sgl — sigil-youtube

1;;; (youtube upload) - YouTube resumable upload protocol.

2;;;

3;;; Implements the Google resumable upload protocol for uploading videos

4;;; to YouTube. Supports single-request and chunked uploads with resume

5;;; capability after failures.

6;;;

7;;; Upload quota cost: 1,600 units per video.

8;;; Chunk size must be a multiple of 256 KB (262144 bytes), except final chunk.

10(define-library (youtube upload)

11 (import (sigil core)

12 (sigil dict)

13 (sigil string)

14 (sigil struct)

15 (sigil json)

16 (only (sigil http) build-query-string)

17 (sigil http client)

18 (youtube))

20 (export ;; Low-level upload operations

21 youtube-upload-init

22 youtube-upload-send

23 youtube-upload-resume

24 youtube-upload-status

26 ;; High-level helper

27 youtube-upload-video

29 ;; Constants

30 youtube-chunk-size)

32 (begin

34 ;; Default chunk size: 8 MB (multiple of 256 KB)

35 (define youtube-chunk-size (* 8 1024 1024))

37 ;; Minimum chunk alignment: 256 KB

38 (define chunk-alignment (* 256 1024))

40 ;; ---------------------------------------------------------------

41 ;; Upload initiation

42 ;; ---------------------------------------------------------------

44 ;;; Initiate a resumable upload session.

45 ;;; metadata is a dict with snippet and status fields:

46 ;;; #{ snippet: #{ title: "..." description: "..." tags: #["..."] categoryId: "22" }

47 ;;; status: #{ privacyStatus: "private" } }

48 ;;; file-size is the total size of the video file in bytes.

49 ;;; content-type is the MIME type (e.g., "video/mp4", "video/*").

50 ;;;

51 ;;; Returns the upload URI string for subsequent upload requests.

52 ;;; Quota cost: 1,600 units.

53 (define (youtube-upload-init client metadata file-size content-type)

54 (let* ((url (string-append

55 (youtube-upload-api-url client "videos")

56 (build-query-string

57 (list (cons "uploadType" "resumable")

58 (cons "part" "snippet,status")))))

59 (response (http-post url (json-encode metadata)

60 headers: (dict-merge

61 (youtube-auth-headers client)

62 #{ content-type: "application/json; charset=UTF-8"

63 x-upload-content-length: (number->string file-size)

64 x-upload-content-type: content-type }))))

65 (if (not (http-response? response))

66 (error "YouTube upload init failed: no response"))

67 (let ((status (http-response-status response)))

68 (if (>= status 400)

69 (check-youtube-response response))

70 ;; Extract Location header containing the upload URI

71 (let ((headers (http-response-headers response)))

72 (let ((location (dict-ref headers location: #f)))

73 (if (not location)

74 (error "YouTube upload init: no Location header in response"))

75 location)))))

77 ;; ---------------------------------------------------------------

78 ;; Upload data transfer

79 ;; ---------------------------------------------------------------

81 ;;; Send file data (or a chunk) to the upload URI.

82 ;;; data is the raw bytes to upload.

83 ;;; start-byte and end-byte define the range within the total file.

84 ;;; total-size is the complete file size.

85 ;;;

86 ;;; For single-request upload, start-byte=0 and end-byte=total-size-1.

87 ;;; For chunked uploads, each chunk must be chunk-alignment-aligned

88 ;;; (except the final chunk).

89 ;;;

90 ;;; Returns:

91 ;;; - A youtube-video record (parsed) on completion (status 200/201)

92 ;;; - 'incomplete if more chunks are needed (status 308)

93 ;;; - Raises error on failure

94 (define (youtube-upload-send upload-uri data start-byte end-byte total-size)

95 (let* ((content-range

96 (string-append "bytes "

97 (number->string start-byte) "-"

98 (number->string end-byte) "/"

99 (number->string total-size)))

100 (response (http-put upload-uri data

101 headers: #{ content-type: "video/*"

102 content-range: content-range })))

103 (if (not (http-response? response))

104 (error "YouTube upload send failed: no response"))

105 (let ((status (http-response-status response)))

106 (cond

107 ;; Upload complete

108 ((or (= status 200) (= status 201))

109 (let ((body (http-response-body response)))

110 (if (and body (not (string=? body "")))

111 (parse-video (json-decode body))

112 #t)))

113 ;; More chunks needed

114 ((= status 308)

115 'incomplete)

116 ;; Error

117 (else

118 (check-youtube-response response))))))

119

120 ;; ---------------------------------------------------------------

121 ;; Upload resume

122 ;; ---------------------------------------------------------------

123

124 ;;; Check the status of an upload and get the last byte received.

125 ;;; Returns the byte offset to resume from, or 'complete if done.

126 (define (youtube-upload-status upload-uri total-size)

127 (let* ((content-range

128 (string-append "bytes */" (number->string total-size)))

129 (response (http-put upload-uri ""

130 headers: #{ content-range: content-range })))

131 (if (not (http-response? response))

132 (error "YouTube upload status check failed: no response"))

133 (let ((status (http-response-status response)))

134 (cond

135 ;; Upload already complete

136 ((or (= status 200) (= status 201))

137 'complete)

138 ;; Resume incomplete — parse Range header

139 ((= status 308)

140 (let* ((headers (http-response-headers response))

141 (range (dict-ref headers range: #f)))

142 (if range

143 ;; Range header is "bytes=0-LAST_BYTE"

144 (let ((dash-pos (string-index range #\-)))

145 (if dash-pos

146 (+ 1 (string->number

147 (substring range (+ dash-pos 1)

148 (string-length range))))

149 0))

150 ;; No Range header means no bytes received yet

151 0)))

152 ;; Upload session expired (404) or other error

153 ((= status 404)

154 (error "YouTube upload session expired. Must restart upload."))

155 (else

156 (check-youtube-response response))))))

157

158 ;;; Resume an interrupted upload from where it left off.

159 ;;; get-chunk-fn is a function (start-byte end-byte) -> data

160 ;;; that returns the file data for the given byte range.

161 ;;;

162 ;;; Returns the completed youtube-video record.

163 (define (youtube-upload-resume upload-uri total-size get-chunk-fn)

164 (let ((resume-from (youtube-upload-status upload-uri total-size)))

165 (if (eq? resume-from 'complete)

166 'complete

167 (upload-chunks upload-uri resume-from total-size get-chunk-fn))))

168

169 ;; ---------------------------------------------------------------

170 ;; High-level upload helper

171 ;; ---------------------------------------------------------------

172

173 ;;; Upload a video with full lifecycle management.

174 ;;; metadata: dict with snippet/status (see youtube-upload-init)

175 ;;; file-data: the complete file contents as a string/bytevector

176 ;;; content-type: MIME type (default: "video/*")

177 ;;;

178 ;;; For small files, uploads in a single request.

179 ;;; For large files (> youtube-chunk-size), uses chunked upload.

180 ;;;

181 ;;; Note: file-data is measured with string-length. In Sigil, strings

182 ;;; are byte-strings so this gives the correct byte count for binary data.

183 ;;; For streaming large files, use youtube-upload-init + upload-chunks

184 ;;; with a get-chunk-fn that reads from a port.

185 ;;;

186 ;;; Returns the youtube-video record of the uploaded video.

187 ;;; Quota cost: 1,600 units.

188 (define (youtube-upload-video client metadata file-data . rest)

189 (let* ((content-type (if (null? rest) "video/*" (car rest)))

190 (total-size (string-length file-data))

191 (upload-uri (youtube-upload-init client metadata

192 total-size content-type)))

193 (if (<= total-size youtube-chunk-size)

194 ;; Single-request upload

195 (youtube-upload-send upload-uri file-data

196 0 (- total-size 1) total-size)

197 ;; Chunked upload

198 (upload-chunks upload-uri 0 total-size

199 (lambda (start end)

200 (substring file-data start (+ end 1)))))))

201

202 ;;; Internal: upload file data in chunks starting from offset.

203 (define (upload-chunks upload-uri start-from total-size get-chunk-fn)

204 (let loop ((offset start-from))

205 (if (>= offset total-size)

206 ;; Should not reach here — last chunk returns the video

207 (error "YouTube upload: unexpected end of chunks"))

208 (let* ((end (min (- total-size 1)

209 (- (+ offset youtube-chunk-size) 1)))

210 (chunk-data (get-chunk-fn offset end))

211 (result (youtube-upload-send upload-uri chunk-data

212 offset end total-size)))

213 (cond

214 ((eq? result 'incomplete)

215 (loop (+ end 1)))

216 ((youtube-video? result)

217 result)

218 (else result)))))

219

220 ))