packages/slate-cli/test/test-node-paired-direct.sgl

1(import (sigil test) (sigil core)

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

3

4(define caller-id (pairing-make-identity 1 100))

5(define acceptor-id (pairing-make-identity 1 100))

6

7(define (peer bot nick identity . revoked)

8 #{ bot-id: bot transport-nick: nick

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

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

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

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

13 created: 100 revoked: (and (pair? revoked) (car revoked)) })

14

15(define caller-peer (peer "bot-b" "node-b" acceptor-id))

16(define acceptor-peer (peer "bot-a" "node-a" caller-id))

17

18(define (exchange)

19 (let* ((c0 (paired-direct-make 'caller "bot-a" caller-id caller-peer "cn"))

20 (a0 (paired-direct-make 'acceptor "bot-b" acceptor-id acceptor-peer "an" "conn"))

21 (h (paired-direct-start c0))

22 (a1 (paired-direct-handle a0 (dict-ref h send: #f)))

23 (c1 (paired-direct-handle (dict-ref h state: #f) (dict-ref a1 send: #f)))

24 (a2 (paired-direct-handle (dict-ref a1 state: #f) (dict-ref c1 send: #f)))

25 (c2 (paired-direct-handle (dict-ref c1 state: #f) (dict-ref a2 send: #f))))

26 (list h a1 c1 a2 c2)))

27

28(test-group "unified v1 paired direct authentication"

29 (test "both peers authenticate only after key confirmation"

30 (let ((steps (exchange)))

31 (assert-false (dict-ref (list-ref steps 0) authed?: #t))

32 (assert-false (dict-ref (list-ref steps 1) authed?: #t))

33 (assert-false (dict-ref (list-ref steps 2) authed?: #t))

34 (assert-true (dict-ref (list-ref steps 3) authed?: #f))

35 (assert-true (dict-ref (list-ref steps 4) authed?: #f))

36 (assert-equal 'active

37 (paired-direct-phase (dict-ref (list-ref steps 4) state: #{})))))

38

39 (test "paired mode is explicit and broker messages are not reinterpreted"

40 (assert-true (paired-direct-message?

41 #{ t: "direct/hello" version: 1 auth: "paired" }))

42 (assert-false (paired-direct-message?

43 #{ t: "direct/hello" version: 1 auth: "broker" })))

44

45 (test "wrong static identity descriptor fails before challenge"

46 (let* ((c0 (paired-direct-make 'caller "bot-a" caller-id caller-peer "cn"))

47 (a0 (paired-direct-make 'acceptor "bot-b" acceptor-id acceptor-peer "an" "conn"))

48 (h (paired-direct-start c0))

49 (bad (dict-set (dict-ref h send: #{}) caller-key-id: "wrong"))

50 (out (paired-direct-handle a0 bad)))

51 (assert-equal 'failed (paired-direct-phase (dict-ref out state: #{})))

52 (assert-false (dict-ref out send: #f))))

53

54 (test "wrong acceptor signature reveals no caller proof"

55 (let* ((c0 (paired-direct-make 'caller "bot-a" caller-id caller-peer "cn"))

56 (a0 (paired-direct-make 'acceptor "bot-b" acceptor-id acceptor-peer "an" "conn"))

57 (h (paired-direct-start c0))

58 (a1 (paired-direct-handle a0 (dict-ref h send: #f)))

59 (bad (dict-set (dict-ref a1 send: #{}) signature: "forged"))

60 (out (paired-direct-handle (dict-ref h state: #{}) bad)))

61 (assert-equal 'failed (paired-direct-phase (dict-ref out state: #{})))

62 (assert-false (dict-ref out send: #f))))

63

64 (test "replayed challenge does not advance an active caller"

65 (let* ((steps (exchange))

66 (active (dict-ref (list-ref steps 4) state: #{}))

67 (challenge (dict-ref (list-ref steps 1) send: #{}))

68 (out (paired-direct-handle active challenge)))

69 (assert-equal 'failed (paired-direct-phase (dict-ref out state: #{})))))

70

71 (test "partial state is discarded on disconnect"

72 (let* ((c0 (paired-direct-make 'caller "bot-a" caller-id caller-peer "cn"))

73 (started (dict-ref (paired-direct-start c0) state: #{})))

74 (assert-false (paired-direct-disconnect started))))

75

76 (test "caller connector authenticates a stored endpoint"

77 (let* ((sent (vector '()))

78 (acceptor (vector

79 (paired-direct-make 'acceptor "bot-b" acceptor-id acceptor-peer

80 "an" "conn")))

81 (closed (vector #f))

82 (clock (vector 1000))

83 (transport

84 #{ open: (lambda (endpoint) 'socket)

85 send: (lambda (conn message)

86 (vector-set! sent 0

87 (append (vector-ref sent 0) (list message)))

88 #t)

89 receive:

90 (lambda (conn)

91 (let ((messages (vector-ref sent 0)))

92 (and (pair? messages)

93 (let ((out (paired-direct-handle

94 (vector-ref acceptor 0)

95 (car (reverse messages)))))

96 (vector-set! acceptor 0 (dict-ref out state: #{}))

97 (dict-ref out send: #f)))))

98 close: (lambda (conn) (vector-set! closed 0 #t))

99 now-ms: (lambda ()

100 (let ((now (vector-ref clock 0)))

101 (vector-set! clock 0 (+ now 5)) now))

102 pause: (lambda () #t) })

103 (result (paired-direct-caller-connect

104 "bot-a" caller-id caller-peer transport 100)))

105 (assert-equal 'socket (dict-ref result connection: #f))

106 (assert-false (vector-ref closed 0))))

107

108 (test "caller connector refuses an empty cached endpoint set"

109 (let ((result (paired-direct-caller-connect "bot-a" caller-id

110 (dict-set caller-peer endpoints: '()) #{} 100)))

111 (assert-equal 'unavailable (dict-ref result reason: #f))))

112

113 (test "caller waits for native transport readiness before first hello"

114 (let* ((sent (vector '()))

115 (acceptor (vector

116 (paired-direct-make 'acceptor "bot-b" acceptor-id acceptor-peer

117 "an" "conn")))

118 (ready (vector #f))

119 (polls (vector 0))

120 (clock (vector 1000))

121 (transport

122 #{ open: (lambda (endpoint) 'socket)

123 connected?: (lambda (conn) (vector-ref ready 0))

124 send: (lambda (conn message)

125 (and (vector-ref ready 0)

126 (begin

127 (vector-set! sent 0

128 (append (vector-ref sent 0) (list message)))

129 #t)))

130 receive:

131 (lambda (conn)

132 (if (not (vector-ref ready 0))

133 (begin

134 (vector-set! polls 0 (+ 1 (vector-ref polls 0)))

135 (vector-set! ready 0 #t)

136 #f)

137 (let ((messages (vector-ref sent 0)))

138 (and (pair? messages)

139 (let ((out (paired-direct-handle

140 (vector-ref acceptor 0)

141 (car (reverse messages)))))

142 (vector-set! acceptor 0

143 (dict-ref out state: #{}))

144 (dict-ref out send: #f))))))

145 close: (lambda (conn) #t)

146 now-ms: (lambda ()

147 (let ((now (vector-ref clock 0)))

148 (vector-set! clock 0 (+ now 5)) now))

149 pause: (lambda () #t) })

150 (result (paired-direct-caller-connect

151 "bot-a" caller-id caller-peer transport 100)))

152 (assert-equal 1 (vector-ref polls 0))

153 (assert-equal 'socket (dict-ref result connection: #f))))

154

155 (test "revoked pairing cannot construct an authentication state"

156 (assert-error

157 (paired-direct-make 'caller "bot-a" caller-id

158 (peer "bot-b" "node-b" acceptor-id #t) "cn"))))