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

New gatekeeper protocol

This commit is contained in:
Tony Garnock-Jones 2023-02-10 12:04:21 +01:00
parent d701adcf11
commit b3df469c80
8 changed files with 70 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
syndicate-examples/chat.pr
View File

@ -3,4 +3,4 @@
<require-service <relay-listener <tcp "0.0.0.0" 9001> $gatekeeper>>
let ?ds = dataspace
<bind "syndicate" #x"" $ds>
<bind <ref {oid: "syndicate" key: #x""}> $ds #f>

4
syndicate-examples/chat.rkt
View File

@ -12,7 +12,9 @@
(require (only-in file/sha1 hex-string->bytes))
(define me (symbol->string (strong-gensym 'user)))
(define ref (SturdyRef "syndicate" '() (hex-string->bytes "69ca300c1dbfa08fba692102dd82311a")))
(define ref (SturdyRef (Parameters "syndicate"
(hex-string->bytes "69ca300c1dbfa08fba692102dd82311a")
(CaveatsField-absent))))
(standard-actor-system (ds)
(define conn-facet this-facet)

25
syndicate/distributed/gatekeeper.rkt
View File

@ -13,15 +13,26 @@
(define (make-gatekeeper ds #:name [name 'gatekeeper])
(object #:name name
[(Resolve unvalidated-sturdyref observer)
;; TODO: I'd like to write `(SturdyStepType)` instead of `(app parse-SturdyStepType
;; (SturdyStepType))` here, and likewise for `unvalidated-parameters`, but because
;; there are `any`s in those positions, it doesn't know it needs to carry on parsing.
[(Resolve (Step (app parse-SturdyStepType (SturdyStepType))
(app parse-Parameters unvalidated-parameters))
observer)
(at ds
(during (Bind (SturdyRef-oid unvalidated-sturdyref) $key $target)
(define sturdyref (validate unvalidated-sturdyref key))
(define attenuation (SturdyRef-caveatChain sturdyref))
(define attenuated-target (apply attenuate-entity-ref target attenuation))
(at observer (assert (embedded attenuated-target)))))]))
(during
(Bind (Description
(SturdyStepType)
(SturdyDescriptionDetail $key (Parameters-oid unvalidated-parameters)))
$target
_)
(define sturdyref (validate (SturdyRef unvalidated-parameters) key))
(define attenuation (SturdyRef-caveatChain sturdyref))
(define attenuated-target (apply attenuate-entity-ref target attenuation))
(at observer (assert (Resolved-accepted attenuated-target)))))]))
(define (gatekeeper-resolve gatekeeper ref k)
(at gatekeeper
(assert (Resolve ref (object #:name (list 'gatekeeper-resolve gatekeeper ref)
[(embedded a) (k a)])))))
[(Resolved-accepted a) (k a)]
[(Resolved-Rejected r) (error 'gatekeeper-resolve "Rejected: ~v" r)])))))

12
syndicate/distributed/noise.rkt
View File

@ -7,6 +7,7 @@
(require syndicate/relay)
(require syndicate/schemas/noise)
(require syndicate/schemas/gatekeeper)
(require noise-protocol)
(define-logger syndicate/distributed/noise)
@ -47,9 +48,9 @@
#:pattern pattern
(lambda (set-peer-session! handle-message)
(at acceptor-ref
(assert (Connect service-selector
(assert (Resolve (Step (NoiseStepType) service-selector)
(object #:name 'noise-initiator
[#:asserted (Accept responder-session)
[#:asserted (Resolved-accepted responder-session)
(set-peer-session! responder-session)
#:retracted
(stop-current-facet)]
@ -70,8 +71,9 @@
(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)])))))))
(assert (Resolved-accepted
(object #:name (list 'noise-responder initial-ref initiator-session)
[#:message m (handle-message m)])))))))
(define (noise* #:role role
#:service-selector service-selector
@ -147,7 +149,7 @@
(stop-current-facet)]))
(at ds
(during (Connect 'test-service $initiator-session)
(during (Resolve (Step (NoiseStepType) 'test-service) $initiator-session)
(noise-responder #:service-selector 'test-service
#:static-keypair server-keys
#:initiator-session initiator-session

7
syndicate/distributed/tcp.rkt
View File

@ -68,11 +68,14 @@
(standard-actor-system (ds)
(define ds-oid "syndicate")
(define ds-key (make-bytes KEY_LENGTH))
(at ds (assert (Bind ds-oid ds-key ds)))
(at ds (assert (Bind (Description (SturdyStepType)
(SturdyDescriptionDetail ds-key ds-oid))
ds
(BindObserver-absent))))
(define root-cap (mint ds-oid ds-key))
(write-preserve/text (->preserve root-cap) #:indent 4 #:commas? #f)
(newline)
(displayln (bytes->hex-string (sturdy-encode (->preserve root-cap))))
(run-tcp-server-relay ds #:port 8001 #:export (make-gatekeeper ds))))
(run-tcp-server-relay ds #:port 9001 #:export (make-gatekeeper ds))))

2
syndicate/schema-compiler.rkt
View File

@ -85,6 +85,8 @@
(match* ((unwrap label-pat) (unwrap fields-pat))
[((SimplePattern-lit label) (CompoundPattern-tuple field-pats))
`(:pat:rec ',label (list ,@(map pat-pattern field-pats)))]
[((Binding name _) (CompoundPattern-tuple field-pats))
`(:pat:rec ,(escape name) (list ,@(map pat-pattern field-pats)))]
[(_ _)
`#,(raise-syntax-error ',name "Record schema cannot be used as a pattern")])]
[(CompoundPattern-tuple pats)

27
syndicate/sturdy.rkt
View File

@ -17,6 +17,8 @@
mint
attenuate-sturdy
SturdyRef-valid?
SturdyRef-caveatChain
CaveatsField-caveats
validate
(all-from-out "schemas/sturdy.rkt"))
@ -52,21 +54,36 @@
(subbytes (hmac-BLAKE2s key data) 0 KEY_LENGTH))
(define (mint oid key)
(SturdyRef oid '() (signature key (sturdy-encode oid))))
(SturdyRef (Parameters oid (signature key (sturdy-encode oid)) (CaveatsField-absent))))
(define (update-signature sig caveats)
(for/fold [(sig sig)] [(caveat (in-list caveats))]
(signature sig (sturdy-encode (->preserve caveat)))))
(define (attenuate-sturdy r . caveats)
(match-define (SturdyRef oid caveatChain sig) r)
(SturdyRef oid (append caveatChain caveats) (update-signature sig caveats)))
(if (null? caveats)
r
(match r
[(SturdyRef (Parameters oid sig cs))
(SturdyRef (Parameters oid
(update-signature sig caveats)
(CaveatsField-present
(append (CaveatsField-caveats cs) caveats))))])))
(define (SturdyRef-valid? r key)
(match-define (SturdyRef oid caveatChain actual-sig) r)
(define expected-sig (update-signature (signature key (sturdy-encode oid)) caveatChain))
(match-define (SturdyRef (Parameters oid actual-sig cs)) r)
(define expected-sig (update-signature (signature key (sturdy-encode oid)) (CaveatsField-caveats cs)))
(equal? expected-sig actual-sig))
(define (SturdyRef-caveatChain r)
(CaveatsField-caveats (Parameters-caveats (SturdyRef-parameters r))))
(define (CaveatsField-caveats c)
(match c
[(CaveatsField-absent) '()]
[(CaveatsField-present cs) cs]
[(CaveatsField-invalid _) (error 'CaveatsField-caveats "Invalid caveats field")]))
(define (validate r key)
(when (not (SturdyRef-valid? r key))
(error 'validate "Invalid SturdyRef"))

18
syndicate/test/core/sturdy.rkt
View File

@ -7,22 +7,28 @@
(require syndicate/sturdy)
(require preserves)
(define (C . strings) (parse-SturdyRef (string->preserve (apply string-append strings))))
(define s0 (mint "test" #""))
(check-equal? s0 (SturdyRef "test" '() #">\330w\326\3r{\216U`j\24\376\203\242\360"))
(check-equal? s0 (SturdyRef (Parameters "test"
#">\330w\326\3r{\216U`j\24\376\203\242\360"
(CaveatsField-absent))))
(check-true (SturdyRef-valid? s0 #""))
(define s1 (attenuate-sturdy s0 'a 'b 'c))
(check-equal? s1 (SturdyRef "test" '(a b c) #"\261\220\327\363X\317\202\251&\367\3734*\355\333\324"))
(check-equal? s1 (SturdyRef (Parameters "test"
#"\261\220\327\363X\317\202\251&\367\3734*\355\333\324"
(CaveatsField-present '(a b c)))))
(check-true (SturdyRef-valid? s1 #""))
(check-false (SturdyRef-valid?
(SturdyRef "test" '(a b c) #"\261\220\327\363X\317\202\251&\367\3734?\355\333\324")
(SturdyRef (Parameters "test"
#"\261\220\327\363X\317\202\251&\367\3734?\355\333\324"
(CaveatsField-present '(a b c))))
#""))
(check-false (SturdyRef-valid?
(SturdyRef "test" '(a c b) #"\261\220\327\363X\317\202\251&\367\3734*\355\333\324")
(SturdyRef (Parameters "test"
#"\261\220\327\363X\317\202\251&\367\3734*\355\333\324"
(CaveatsField-present '(a c b))))
#""))
)