syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Better factoring

This commit is contained in:
Tony Garnock-Jones 2023-01-19 16:30:30 +01:00
parent 5d368fed95
commit 8e72496c21
1 changed files with 35 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
syndicate-noise/syndicate/distributed/noise.rkt
View File

@ -42,14 +42,23 @@
(noise* #:role 'initiator (noise* #:role 'initiator
#:service-selector service-selector #:service-selector service-selector
#:remote-static-pk remote-static-pk #:remote-static-pk remote-static-pk
#:acceptor-ref acceptor-ref
#:import import-handler #:import import-handler
#:preshared-keys psks #:preshared-keys psks
#:pattern pattern)) #:pattern pattern
(lambda (set-peer-session! handle-message)
(at acceptor-ref
(assert (Connect service-selector
(object #:name 'noise-initiator
[#:asserted (Accept responder-session)
(set-peer-session! responder-session)
#:retracted
(stop-current-facet)]
[#:message m (handle-message m)])))))))
(define (noise-responder #:service-selector service-selector (define (noise-responder #:service-selector service-selector
#:static-keypair static-keypair #:static-keypair static-keypair
#:export initial-ref #:export initial-ref
#:initiator-session initiator-session
#:preshared-keys [psks #f] #:preshared-keys [psks #f]
#:pattern [pattern #f]) #:pattern [pattern #f])
(noise* #:role 'responder (noise* #:role 'responder
@ -57,17 +66,22 @@
#:static-keypair static-keypair #:static-keypair static-keypair
#:export initial-ref #:export initial-ref
#:preshared-keys psks #:preshared-keys psks
#:pattern pattern)) #:pattern pattern
(lambda (set-peer-session! handle-message)
(set-peer-session! initiator-session)
(at initiator-session
(assert (Accept (object #:name (list 'noise-responder initial-ref initiator-session)
[#:message m (handle-message m)])))))))
(define (noise* #:role role (define (noise* #:role role
#:service-selector service-selector #:service-selector service-selector
#:static-keypair [static-keypair #f] #:static-keypair [static-keypair #f]
#:remote-static-pk [remote-static-pk #f] #:remote-static-pk [remote-static-pk #f]
#:acceptor-ref [acceptor-ref #f]
#:export [initial-ref #f] #:export [initial-ref #f]
#:import [import-handler #f] #:import [import-handler #f]
#:preshared-keys [psks #f] #:preshared-keys [psks #f]
#:pattern [pattern #f]) #:pattern [pattern #f]
f)
(define H (Noise-*-25519_ChaChaPoly_BLAKE2s (define H (Noise-*-25519_ChaChaPoly_BLAKE2s
(or pattern "NK") (or pattern "NK")
#:role role #:role role
@ -114,23 +128,7 @@
(set! peer-session session) (set! peer-session session)
(when (eq? role 'initiator) (handshake-step))) (when (eq? role 'initiator) (handshake-step)))
(match role (f set-peer-session! handle-message))
['initiator
(at acceptor-ref
(assert (Connect service-selector
(object #:name 'noise-initiator
[#:asserted (Accept responder-session)
(set-peer-session! responder-session)
#:retracted
(stop-current-facet)]
[#:message m (handle-message m)]))))]
['responder
(object #:name (list 'noise-acceptor initial-ref)
[(Connect (== service-selector) initiator-session)
(set-peer-session! initiator-session)
(at initiator-session
(assert (Accept (object #:name (list 'noise-responder initial-ref initiator-session)
[#:message m (handle-message m)]))))])]))
(module+ test (module+ test
(require libsodium) (require libsodium)
@ -140,19 +138,24 @@
(spawn #:name 'test-main (spawn #:name 'test-main
(define server-keys (make-crypto-box-keypair)) (define server-keys (make-crypto-box-keypair))
(define acceptor (define service-object
(noise-responder #:service-selector 'test-service (object [a
#:static-keypair server-keys (printf "service+: ~v\n" a)
#:export (object [a (on-stop (printf "service-: ~v\n" a))]
(printf "service+: ~v\n" a) [#:message m
(on-stop (printf "service-: ~v\n" a))] (printf "service!: ~v\n" m)
[#:message m (stop-current-facet)]))
(printf "service!: ~v\n" m)
(stop-current-facet)]))) (at ds
(during (Connect 'test-service $initiator-session)
(noise-responder #:service-selector 'test-service
#:static-keypair server-keys
#:initiator-session initiator-session
#:export service-object)))
(noise-initiator #:service-selector 'test-service (noise-initiator #:service-selector 'test-service
#:remote-static-pk (crypto-box-keypair-pk server-keys) #:remote-static-pk (crypto-box-keypair-pk server-keys)
#:acceptor-ref acceptor #:acceptor-ref ds
#:import (lambda (r) #:import (lambda (r)
(on-stop (printf "BYEEEE\n")) (on-stop (printf "BYEEEE\n"))
(at r (assert "HELLO!")) (at r (assert "HELLO!"))