packages/slate-cli/test/test-node-pairing-readers.sgl

1(import (sigil test) (sigil fs) (sigil json) (sigil process) (sigil time)

2 (slate-cli node pairing) (slate-cli node pairing-management))

4(define (test-store)

5 (let ((dir (string-append "/tmp/slate-pairing-readers-"

6 (number->string (current-jiffy)))))

7 (ensure-directory dir)

8 dir))

10(define (peer-record identity)

11 #{ bot-id: "peer" transport-nick: "peer-nick"

12 peer-key-id: (dict-ref identity key-id: "")

13 peer-generation: (dict-ref identity generation: 0)

14 peer-public-key: (dict-ref identity public-key: "")

15 endpoints: '("ws://10.0.0.2:32644/node/direct")

16 created: 100 revoked: #f })

18(define (fixed-mtime! path)

19 (assert-equal 0 (process-run "touch" "-d" "@1700000000" path)))

21(test-group "pairing file readers"

22 (test "unchanged valid contents reuse their validated snapshot"

23 (let* ((dir (test-store))

24 (identity (pairing-make-identity 1 100))

25 (read-identity (make-pairing-identity-reader dir))

26 (read-records (make-pairing-records-reader dir)))

27 (pairing-save-identity! dir identity)

28 (pairing-save-records! dir (list (peer-record identity)))

29 (let ((first-identity (read-identity))

30 (first-records (read-records)))

31 (assert-equal identity first-identity)

32 (assert-equal (list (peer-record identity)) first-records)

33 (assert-true (eq? first-identity (read-identity)))

34 (assert-true (eq? first-records (read-records)))

35 ;; Replacing a file with the same contents is also safe to reuse.

36 (pairing-save-identity! dir identity)

37 (assert-true (eq? first-identity (read-identity))))))

39 (test "revocation and rotation are visible even with identical mtimes"

40 (let* ((dir (test-store))

41 (identity (pairing-make-identity 1 100))

42 (read-identity (make-pairing-identity-reader dir))

43 (read-records (make-pairing-records-reader dir)))

44 (pairing-save-identity! dir identity)

45 (pairing-save-records! dir (list (peer-record identity)))

46 (fixed-mtime! (pairing-identity-path dir))

47 (fixed-mtime! (pairing-records-path dir))

48 (assert-equal identity (read-identity))

49 (assert-false (dict-ref (car (read-records)) revoked: #t))

50 (pairing-management-revoke! dir "peer")

51 (pairing-management-rotate! dir)

52 (fixed-mtime! (pairing-identity-path dir))

53 (fixed-mtime! (pairing-records-path dir))

54 (assert-true (dict-ref (car (read-records)) revoked: #f))

55 (assert-equal 2 (dict-ref (read-identity) generation: 0))

56 (assert-false (equal? (dict-ref identity key-id: #f)

57 (dict-ref (read-identity) key-id: #f)))))

59 (test "changed keys are fully validated instead of trusting prior ids"

60 (let* ((dir (test-store))

61 (identity (pairing-make-identity 1 100))

62 (other (pairing-make-identity 1 100))

63 (read-identity (make-pairing-identity-reader dir))

64 (read-records (make-pairing-records-reader dir)))

65 (pairing-save-identity! dir identity)

66 (pairing-save-records! dir (list (peer-record identity)))

67 (assert-equal identity (read-identity))

68 (assert-true (pair? (read-records)))

69 ;; Valid encoding and unchanged key id, but a mismatched private key.

70 (write-file-string (pairing-identity-path dir)

71 (json-encode (dict-set identity private-key:

72 (dict-ref other private-key: ""))))

73 (write-file-string (pairing-records-path dir)

74 (json-encode #{ version: 1 pairings:

75 (list (dict-set (peer-record identity) peer-public-key: "bad")) }))

76 (assert-false (read-identity))

77 (assert-false (read-records))))

79 (test "invalid snapshots are discarded and valid restoration is reloaded"

80 (let* ((dir (test-store))

81 (identity (pairing-make-identity 1 100))

82 (read-identity (make-pairing-identity-reader dir))

83 (read-records (make-pairing-records-reader dir)))

84 (pairing-save-identity! dir identity)

85 (pairing-save-records! dir (list (peer-record identity)))

86 (let ((old-identity (read-identity))

87 (old-records (read-records)))

88 (write-file-string (pairing-identity-path dir) "{broken")

89 (write-file-string (pairing-records-path dir) "{broken")

90 (assert-false (read-identity))

91 (assert-false (read-records))

92 (assert-false (read-identity))

93 (pairing-save-identity! dir identity)

94 (pairing-save-records! dir (list (peer-record identity)))

95 (let ((fresh-identity (read-identity))

96 (fresh-records (read-records)))

97 (assert-equal old-identity fresh-identity)

98 (assert-equal old-records fresh-records)

99 (assert-false (eq? old-identity fresh-identity))

100 (assert-false (eq? old-records fresh-records))))))

101

102 (test "missing files and read errors never return a previous snapshot"

103 (let* ((dir (test-store))

104 (identity (pairing-make-identity 1 100))

105 (read-identity (make-pairing-identity-reader dir))

106 (read-records (make-pairing-records-reader dir)))

107 (assert-false (read-identity))

108 (assert-equal '() (read-records))

109 (pairing-save-identity! dir identity)

110 (pairing-save-records! dir (list (peer-record identity)))

111 (assert-equal identity (read-identity))

112 (assert-true (pair? (read-records)))

113 (delete-file (pairing-identity-path dir))

114 (delete-file (pairing-records-path dir))

115 (assert-false (read-identity))

116 (assert-equal '() (read-records))

117 (ensure-directory (pairing-identity-path dir))

118 (ensure-directory (pairing-records-path dir))

119 (assert-false (read-identity))

120 (assert-false (read-records))

121 (delete-directory (pairing-identity-path dir))

122 (delete-directory (pairing-records-path dir))

123 (pairing-save-identity! dir identity)

124 (pairing-save-records! dir '())

125 (assert-equal identity (read-identity))

126 (assert-equal '() (read-records))))

127

128 (test "readers are independent across stores and daemon lifetimes"

129 (let* ((a (test-store))

130 (b (test-store))

131 (identity (pairing-make-identity 1 100))

132 (read-a (make-pairing-identity-reader a))

133 (read-b (make-pairing-identity-reader b)))

134 (pairing-save-identity! a identity)

135 (pairing-save-identity! b identity)

136 (let ((first (read-a)))

137 (assert-equal first (read-b))

138 (assert-false (eq? first (read-b)))

139 (assert-false (eq? first ((make-pairing-identity-reader a)))))

140 (pairing-management-rotate! b)

141 (assert-equal 1 (dict-ref (read-a) generation: 0))

142 (assert-equal 2 (dict-ref (read-b) generation: 0)))))