From b3df469c800e085d9e398c438ec4675406df296c Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Fri, 10 Feb 2023 12:04:21 +0100 Subject: [PATCH] New gatekeeper protocol --- syndicate-examples/chat.pr | 2 +- syndicate-examples/chat.rkt | 4 +++- syndicate/distributed/gatekeeper.rkt | 25 ++++++++++++++++++------- syndicate/distributed/noise.rkt | 12 +++++++----- syndicate/distributed/tcp.rkt | 7 +++++-- syndicate/schema-compiler.rkt | 2 ++ syndicate/sturdy.rkt | 27 ++++++++++++++++++++++----- syndicate/test/core/sturdy.rkt | 18 ++++++++++++------ 8 files changed, 70 insertions(+), 27 deletions(-) diff --git a/syndicate-examples/chat.pr b/syndicate-examples/chat.pr index bedae17..c6e784b 100644 --- a/syndicate-examples/chat.pr +++ b/syndicate-examples/chat.pr @@ -3,4 +3,4 @@ $gatekeeper>> let ?ds = dataspace - + $ds #f> diff --git a/syndicate-examples/chat.rkt b/syndicate-examples/chat.rkt index c6f8e6e..3d5087f 100644 --- a/syndicate-examples/chat.rkt +++ b/syndicate-examples/chat.rkt @@ -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) diff --git a/syndicate/distributed/gatekeeper.rkt b/syndicate/distributed/gatekeeper.rkt index 4d508ad..6a55008 100644 --- a/syndicate/distributed/gatekeeper.rkt +++ b/syndicate/distributed/gatekeeper.rkt @@ -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)]))))) diff --git a/syndicate/distributed/noise.rkt b/syndicate/distributed/noise.rkt index 0d22600..65b227c 100644 --- a/syndicate/distributed/noise.rkt +++ b/syndicate/distributed/noise.rkt @@ -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 diff --git a/syndicate/distributed/tcp.rkt b/syndicate/distributed/tcp.rkt index 06353ea..bb09652 100644 --- a/syndicate/distributed/tcp.rkt +++ b/syndicate/distributed/tcp.rkt @@ -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)))) diff --git a/syndicate/schema-compiler.rkt b/syndicate/schema-compiler.rkt index e7ccc13..2b7f558 100644 --- a/syndicate/schema-compiler.rkt +++ b/syndicate/schema-compiler.rkt @@ -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) diff --git a/syndicate/sturdy.rkt b/syndicate/sturdy.rkt index 4657be5..16dd188 100644 --- a/syndicate/sturdy.rkt +++ b/syndicate/sturdy.rkt @@ -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")) diff --git a/syndicate/test/core/sturdy.rkt b/syndicate/test/core/sturdy.rkt index b6fe337..ef4da56 100644 --- a/syndicate/test/core/sturdy.rkt +++ b/syndicate/test/core/sturdy.rkt @@ -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)))) #"")) )