packages/slate-cli/test/test-transfer-file.sgl

1(import (sigil test) (sigil core) (sigil fs) (sigil path)

2 (sigil system grant)

3 (slate-cli resource transfer)

4 (slate-cli resource transfer file)

5 (slate-cli wire))

7(define ROOT (make-temp-directory))

8(define GRANTS (make-grants principal: "web:test"))

9(grant-add! GRANTS (string-append "fs:rw:" ROOT))

11(define (frame-list-bytes frames)

12 (let loop ((rest frames) (out (make-bytevector 0 0)))

13 (if (null? rest) out

14 (let* ((frame (decode-stream-frame (car rest)))

15 (batch (decode-transfer-batch frame)))

16 (if batch

17 (loop (cdr rest) (bytevector-append out (dict-ref batch bytes: #f)))

18 (loop (cdr rest) out))))))

20(test-group "streaming file transfer adapter"

21 (test "upload is invisible until exact end then publishes atomically"

22 (let* ((m (make-file-transfer-manager))

23 (path (path-join ROOT "upload.bin"))

24 (body (bytevector 1 2 3 4 5)))

25 (write-file-string path "old")

26 (assert-equal 'ready

27 (dict-ref (file-upload-open! m GRANTS 1 path 5) status: #f))

28 (assert-equal 'accepted

29 (dict-ref (file-upload-batch! m

30 (decode-stream-frame (encode-transfer-batch 1 0 body)))

31 status: #f))

32 (assert-equal "old" (read-file-string path))

33 (assert-equal 'complete

34 (dict-ref (file-transfer-end! m

35 (decode-stream-frame (encode-transfer-end 1 1 5)))

36 status: #f))

37 (let ((actual (read-file-bytes path)))

38 (assert-equal 5 (bytevector-length actual))

39 (assert-equal 1 (bytevector-u8-ref actual 0))

40 (assert-equal 5 (bytevector-u8-ref actual 4)))

41 (assert-equal 0 (file-transfer-count m))))

43 (test "cancel and connection close preserve destination and remove state"

44 (let* ((m (make-file-transfer-manager))

45 (a (path-join ROOT "cancel-a.bin"))

46 (b (path-join ROOT "cancel-b.bin")))

47 (write-file-string a "before-a")

48 (write-file-string b "before-b")

49 (assert-equal 'ready

50 (dict-ref (file-upload-open! m GRANTS 2 a 3) status: #f))

51 (assert-equal 'ready

52 (dict-ref (file-upload-open! m GRANTS 3 b 3) status: #f))

53 (assert-equal 2 (file-transfer-count m))

54 (file-upload-batch! m

55 (decode-stream-frame (encode-transfer-batch 2 0 (bytevector 1))))

56 (assert-equal 'cancelled

57 (dict-ref (file-transfer-cancel! m 2 'user) status: #f))

58 (assert-equal 1 (file-transfer-count m))

59 (assert-equal 1 (file-transfer-close-all! m 'connection-lost))

60 (assert-equal "before-a" (read-file-string a))

61 (assert-equal "before-b" (read-file-string b))

62 (assert-equal 0 (file-transfer-count m))))

64 (test "download obeys credit and emits an exact end"

65 (let* ((m (make-file-transfer-manager))

66 (path (path-join ROOT "download.bin"))

67 (body (make-bytevector (+ transfer-chunk-bytes 7) 42)))

68 (write-file-bytes path body)

69 (assert-equal 'ready

70 (dict-ref (file-download-open! m GRANTS 4 path) status: #f))

71 (let ((first (file-download-credit! m

72 (decode-stream-frame

73 (encode-transfer-credit 4 transfer-chunk-bytes)))))

74 (assert-equal 'active (dict-ref first status: #f))

75 (assert-equal transfer-chunk-bytes (dict-ref first progress: #f))

76 (assert-equal transfer-chunk-bytes

77 (bytevector-length (frame-list-bytes (dict-ref first frames: '())))))

78 (let ((last (file-download-credit! m

79 (decode-stream-frame (encode-transfer-credit 4 7)))))

80 (assert-equal 'complete (dict-ref last status: #f))

81 (assert-equal 2 (length (dict-ref last frames: '())))

82 (assert-equal 7

83 (bytevector-length (frame-list-bytes (dict-ref last frames: '())))))

84 (assert-equal 0 (file-transfer-count m))))

86 (test "grant denial opens no transfer"

87 (let ((m (make-file-transfer-manager))

88 (none (make-grants principal: "web:none")))

89 (assert-equal 'refused

90 (dict-ref (file-upload-open! m none 5

91 (path-join ROOT "denied.bin") 1) status: #f))

92 (assert-equal 0 (file-transfer-count m))))

93 )