New gatekeeper protocol
This commit is contained in:
parent
d701adcf11
commit
b3df469c80
|
@ -3,4 +3,4 @@
|
||||||
<require-service <relay-listener <tcp "0.0.0.0" 9001> $gatekeeper>>
|
<require-service <relay-listener <tcp "0.0.0.0" 9001> $gatekeeper>>
|
||||||
|
|
||||||
let ?ds = dataspace
|
let ?ds = dataspace
|
||||||
<bind "syndicate" #x"" $ds>
|
<bind <ref {oid: "syndicate" key: #x""}> $ds #f>
|
||||||
|
|
|
@ -12,7 +12,9 @@
|
||||||
(require (only-in file/sha1 hex-string->bytes))
|
(require (only-in file/sha1 hex-string->bytes))
|
||||||
|
|
||||||
(define me (symbol->string (strong-gensym 'user)))
|
(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)
|
(standard-actor-system (ds)
|
||||||
(define conn-facet this-facet)
|
(define conn-facet this-facet)
|
||||||
|
|
|
@ -13,15 +13,26 @@
|
||||||
|
|
||||||
(define (make-gatekeeper ds #:name [name 'gatekeeper])
|
(define (make-gatekeeper ds #:name [name 'gatekeeper])
|
||||||
(object #:name name
|
(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
|
(at ds
|
||||||
(during (Bind (SturdyRef-oid unvalidated-sturdyref) $key $target)
|
(during
|
||||||
(define sturdyref (validate unvalidated-sturdyref key))
|
(Bind (Description
|
||||||
(define attenuation (SturdyRef-caveatChain sturdyref))
|
(SturdyStepType)
|
||||||
(define attenuated-target (apply attenuate-entity-ref target attenuation))
|
(SturdyDescriptionDetail $key (Parameters-oid unvalidated-parameters)))
|
||||||
(at observer (assert (embedded attenuated-target)))))]))
|
$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)
|
(define (gatekeeper-resolve gatekeeper ref k)
|
||||||
(at gatekeeper
|
(at gatekeeper
|
||||||
(assert (Resolve ref (object #:name (list 'gatekeeper-resolve gatekeeper ref)
|
(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)])))))
|
||||||
|
|
|
@ -7,6 +7,7 @@
|
||||||
|
|
||||||
(require syndicate/relay)
|
(require syndicate/relay)
|
||||||
(require syndicate/schemas/noise)
|
(require syndicate/schemas/noise)
|
||||||
|
(require syndicate/schemas/gatekeeper)
|
||||||
(require noise-protocol)
|
(require noise-protocol)
|
||||||
|
|
||||||
(define-logger syndicate/distributed/noise)
|
(define-logger syndicate/distributed/noise)
|
||||||
|
@ -47,9 +48,9 @@
|
||||||
#:pattern pattern
|
#:pattern pattern
|
||||||
(lambda (set-peer-session! handle-message)
|
(lambda (set-peer-session! handle-message)
|
||||||
(at acceptor-ref
|
(at acceptor-ref
|
||||||
(assert (Connect service-selector
|
(assert (Resolve (Step (NoiseStepType) service-selector)
|
||||||
(object #:name 'noise-initiator
|
(object #:name 'noise-initiator
|
||||||
[#:asserted (Accept responder-session)
|
[#:asserted (Resolved-accepted responder-session)
|
||||||
(set-peer-session! responder-session)
|
(set-peer-session! responder-session)
|
||||||
#:retracted
|
#:retracted
|
||||||
(stop-current-facet)]
|
(stop-current-facet)]
|
||||||
|
@ -70,8 +71,9 @@
|
||||||
(lambda (set-peer-session! handle-message)
|
(lambda (set-peer-session! handle-message)
|
||||||
(set-peer-session! initiator-session)
|
(set-peer-session! initiator-session)
|
||||||
(at initiator-session
|
(at initiator-session
|
||||||
(assert (Accept (object #:name (list 'noise-responder initial-ref initiator-session)
|
(assert (Resolved-accepted
|
||||||
[#:message m (handle-message m)])))))))
|
(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
|
||||||
|
@ -147,7 +149,7 @@
|
||||||
(stop-current-facet)]))
|
(stop-current-facet)]))
|
||||||
|
|
||||||
(at ds
|
(at ds
|
||||||
(during (Connect 'test-service $initiator-session)
|
(during (Resolve (Step (NoiseStepType) 'test-service) $initiator-session)
|
||||||
(noise-responder #:service-selector 'test-service
|
(noise-responder #:service-selector 'test-service
|
||||||
#:static-keypair server-keys
|
#:static-keypair server-keys
|
||||||
#:initiator-session initiator-session
|
#:initiator-session initiator-session
|
||||||
|
|
|
@ -68,11 +68,14 @@
|
||||||
(standard-actor-system (ds)
|
(standard-actor-system (ds)
|
||||||
(define ds-oid "syndicate")
|
(define ds-oid "syndicate")
|
||||||
(define ds-key (make-bytes KEY_LENGTH))
|
(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))
|
(define root-cap (mint ds-oid ds-key))
|
||||||
(write-preserve/text (->preserve root-cap) #:indent 4 #:commas? #f)
|
(write-preserve/text (->preserve root-cap) #:indent 4 #:commas? #f)
|
||||||
(newline)
|
(newline)
|
||||||
(displayln (bytes->hex-string (sturdy-encode (->preserve root-cap))))
|
(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))))
|
||||||
|
|
|
@ -85,6 +85,8 @@
|
||||||
(match* ((unwrap label-pat) (unwrap fields-pat))
|
(match* ((unwrap label-pat) (unwrap fields-pat))
|
||||||
[((SimplePattern-lit label) (CompoundPattern-tuple field-pats))
|
[((SimplePattern-lit label) (CompoundPattern-tuple field-pats))
|
||||||
`(:pat:rec ',label (list ,@(map pat-pattern 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")])]
|
`#,(raise-syntax-error ',name "Record schema cannot be used as a pattern")])]
|
||||||
[(CompoundPattern-tuple pats)
|
[(CompoundPattern-tuple pats)
|
||||||
|
|
|
@ -17,6 +17,8 @@
|
||||||
mint
|
mint
|
||||||
attenuate-sturdy
|
attenuate-sturdy
|
||||||
SturdyRef-valid?
|
SturdyRef-valid?
|
||||||
|
SturdyRef-caveatChain
|
||||||
|
CaveatsField-caveats
|
||||||
validate
|
validate
|
||||||
(all-from-out "schemas/sturdy.rkt"))
|
(all-from-out "schemas/sturdy.rkt"))
|
||||||
|
|
||||||
|
@ -52,21 +54,36 @@
|
||||||
(subbytes (hmac-BLAKE2s key data) 0 KEY_LENGTH))
|
(subbytes (hmac-BLAKE2s key data) 0 KEY_LENGTH))
|
||||||
|
|
||||||
(define (mint oid key)
|
(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)
|
(define (update-signature sig caveats)
|
||||||
(for/fold [(sig sig)] [(caveat (in-list caveats))]
|
(for/fold [(sig sig)] [(caveat (in-list caveats))]
|
||||||
(signature sig (sturdy-encode (->preserve caveat)))))
|
(signature sig (sturdy-encode (->preserve caveat)))))
|
||||||
|
|
||||||
(define (attenuate-sturdy r . caveats)
|
(define (attenuate-sturdy r . caveats)
|
||||||
(match-define (SturdyRef oid caveatChain sig) r)
|
(if (null? caveats)
|
||||||
(SturdyRef oid (append caveatChain caveats) (update-signature sig 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)
|
(define (SturdyRef-valid? r key)
|
||||||
(match-define (SturdyRef oid caveatChain actual-sig) r)
|
(match-define (SturdyRef (Parameters oid actual-sig cs)) r)
|
||||||
(define expected-sig (update-signature (signature key (sturdy-encode oid)) caveatChain))
|
(define expected-sig (update-signature (signature key (sturdy-encode oid)) (CaveatsField-caveats cs)))
|
||||||
(equal? expected-sig actual-sig))
|
(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)
|
(define (validate r key)
|
||||||
(when (not (SturdyRef-valid? r key))
|
(when (not (SturdyRef-valid? r key))
|
||||||
(error 'validate "Invalid SturdyRef"))
|
(error 'validate "Invalid SturdyRef"))
|
||||||
|
|
|
@ -7,22 +7,28 @@
|
||||||
(require syndicate/sturdy)
|
(require syndicate/sturdy)
|
||||||
(require preserves)
|
(require preserves)
|
||||||
|
|
||||||
(define (C . strings) (parse-SturdyRef (string->preserve (apply string-append strings))))
|
|
||||||
|
|
||||||
(define s0 (mint "test" #""))
|
(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 #""))
|
(check-true (SturdyRef-valid? s0 #""))
|
||||||
|
|
||||||
(define s1 (attenuate-sturdy s0 'a 'b 'c))
|
(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-true (SturdyRef-valid? s1 #""))
|
||||||
(check-false (SturdyRef-valid?
|
(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?
|
(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))))
|
||||||
#""))
|
#""))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in New Issue