Adapt to recent changes in preserves-schema
This commit is contained in:
parent
601d60adc3
commit
19fc5f97bb
|
@ -8,7 +8,6 @@
|
||||||
(struct-out entity-ref)
|
(struct-out entity-ref)
|
||||||
attenuate-entity-ref
|
attenuate-entity-ref
|
||||||
parse-Ref!
|
parse-Ref!
|
||||||
Ref->preserves
|
|
||||||
|
|
||||||
actor-system
|
actor-system
|
||||||
|
|
||||||
|
@ -83,7 +82,6 @@
|
||||||
|
|
||||||
(struct entity-ref (relay target attenuation) #:transparent)
|
(struct entity-ref (relay target attenuation) #:transparent)
|
||||||
(define (parse-Ref! r) (if (entity-ref? r) r (error 'parse-Ref! "Expected entity-ref; got ~v" r)))
|
(define (parse-Ref! r) (if (entity-ref? r) r (error 'parse-Ref! "Expected entity-ref; got ~v" r)))
|
||||||
(define (Ref->preserves r) r)
|
|
||||||
|
|
||||||
(struct outbound-assertion (handle peer [established? #:mutable]))
|
(struct outbound-assertion (handle peer [established? #:mutable]))
|
||||||
|
|
||||||
|
|
|
@ -26,9 +26,9 @@
|
||||||
(at ds (assert (Bind ds-oid ds-key ds)))
|
(at ds (assert (Bind ds-oid ds-key ds)))
|
||||||
|
|
||||||
(define root-cap (mint ds-oid ds-key))
|
(define root-cap (mint ds-oid ds-key))
|
||||||
(write-preserve/text (SturdyRef->preserves root-cap) #:indent 4 #:commas? #f)
|
(write-preserve/text (->preserve root-cap) #:indent 4 #:commas? #f)
|
||||||
(newline)
|
(newline)
|
||||||
(displayln (bytes->hex-string (sturdy-encode (SturdyRef->preserves root-cap))))
|
(displayln (bytes->hex-string (sturdy-encode (->preserve root-cap))))
|
||||||
|
|
||||||
(define spawn-connection
|
(define spawn-connection
|
||||||
(action (connection-custodian i o)
|
(action (connection-custodian i o)
|
||||||
|
|
|
@ -6,6 +6,7 @@
|
||||||
(provide (all-from-out "actor.rkt")
|
(provide (all-from-out "actor.rkt")
|
||||||
(all-from-out "syntax.rkt")
|
(all-from-out "syntax.rkt")
|
||||||
(all-from-out preserves)
|
(all-from-out preserves)
|
||||||
|
(all-from-out preserves-schema)
|
||||||
|
|
||||||
assertion-struct
|
assertion-struct
|
||||||
message-struct
|
message-struct
|
||||||
|
@ -16,6 +17,7 @@
|
||||||
(require (except-in "actor.rkt" actor-system))
|
(require (except-in "actor.rkt" actor-system))
|
||||||
(require "syntax.rkt")
|
(require "syntax.rkt")
|
||||||
(require preserves)
|
(require preserves)
|
||||||
|
(require preserves-schema)
|
||||||
|
|
||||||
;; Thin veneers over `struct` for declaring intent.
|
;; Thin veneers over `struct` for declaring intent.
|
||||||
(define-syntax-rule (assertion-struct item ...) (struct item ... #:prefab))
|
(define-syntax-rule (assertion-struct item ...) (struct item ... #:prefab))
|
||||||
|
|
|
@ -28,6 +28,7 @@
|
||||||
(require (for-syntax syntax/id-table))
|
(require (for-syntax syntax/id-table))
|
||||||
(require (for-syntax syntax/stx))
|
(require (for-syntax syntax/stx))
|
||||||
|
|
||||||
|
(require preserves-schema)
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
(require racket/list)
|
(require racket/list)
|
||||||
(require "pattern-expander.rkt")
|
(require "pattern-expander.rkt")
|
||||||
|
@ -55,8 +56,7 @@
|
||||||
['template
|
['template
|
||||||
(syntax-case s ()
|
(syntax-case s ()
|
||||||
[(_ field-stxs ...)
|
[(_ field-stxs ...)
|
||||||
(syntax (#,(format-id #'ctor-stx "~a->preserves" (syntax-e #'top-type-name))
|
(syntax (->preserve (ctor-stx field-stxs ...)))])]
|
||||||
(ctor-stx field-stxs ...)))])]
|
|
||||||
['bindings
|
['bindings
|
||||||
(syntax-case s ()
|
(syntax-case s ()
|
||||||
[(_ field-stxs ...) bindings-stx]
|
[(_ field-stxs ...) bindings-stx]
|
||||||
|
|
|
@ -184,7 +184,7 @@
|
||||||
(define pending (reverse (tunnel-relay-pending-turn-rev tr)))
|
(define pending (reverse (tunnel-relay-pending-turn-rev tr)))
|
||||||
(set-tunnel-relay-pending-turn-rev! tr '())
|
(set-tunnel-relay-pending-turn-rev! tr '())
|
||||||
((tunnel-relay-packet-writer tr)
|
((tunnel-relay-packet-writer tr)
|
||||||
(preserve->bytes (Turn->preserves pending)
|
(preserve->bytes (->preserve pending)
|
||||||
#:canonicalizing? #t
|
#:canonicalizing? #t
|
||||||
#:write-annotations? #f
|
#:write-annotations? #f
|
||||||
#:encode-embedded encode-embedded:protocol)))))
|
#:encode-embedded encode-embedded:protocol)))))
|
||||||
|
|
|
@ -17,7 +17,11 @@
|
||||||
|
|
||||||
(define schema-compiler-plugin-mode (make-parameter 'normal))
|
(define schema-compiler-plugin-mode (make-parameter 'normal))
|
||||||
|
|
||||||
(define (schema-compiler-plugin schema options)
|
(define (schema-compiler-plugin method)
|
||||||
|
(match method
|
||||||
|
['schema schema-compiler-plugin/schema]))
|
||||||
|
|
||||||
|
(define (schema-compiler-plugin/schema schema options)
|
||||||
(match-define (schema-compiler-options _name
|
(match-define (schema-compiler-options _name
|
||||||
lookup-module-path
|
lookup-module-path
|
||||||
paths) options)
|
paths) options)
|
||||||
|
@ -96,7 +100,7 @@
|
||||||
(match def
|
(match def
|
||||||
[(Definition-or p0 p1 pN)
|
[(Definition-or p0 p1 pN)
|
||||||
`(begin ,@(for/list [(named-alt (in-list (list* p0 p1 pN)))
|
`(begin ,@(for/list [(named-alt (in-list (list* p0 p1 pN)))
|
||||||
(alt-ty (in-list (map cadr (ty-union-variants (definition-ty def)))))]
|
(alt-ty (in-list (map ty-variant-type (ty-union-variants (definition-ty def)))))]
|
||||||
(match-define (NamedAlternative variant-label-str pattern) named-alt)
|
(match-define (NamedAlternative variant-label-str pattern) named-alt)
|
||||||
(define full-name (format-symbol "~a-~a" name variant-label-str))
|
(define full-name (format-symbol "~a-~a" name variant-label-str))
|
||||||
(top-pat name full-name pattern alt-ty
|
(top-pat name full-name pattern alt-ty
|
||||||
|
|
|
@ -24,6 +24,7 @@
|
||||||
(require (only-in sha hmac-sha256))
|
(require (only-in sha hmac-sha256))
|
||||||
(require (only-in racket/random crypto-random-bytes))
|
(require (only-in racket/random crypto-random-bytes))
|
||||||
(require preserves)
|
(require preserves)
|
||||||
|
(require preserves-schema)
|
||||||
(require "schemas/gen/sturdy.rkt")
|
(require "schemas/gen/sturdy.rkt")
|
||||||
|
|
||||||
(define KEY_LENGTH 16) ;; 128 bits
|
(define KEY_LENGTH 16) ;; 128 bits
|
||||||
|
@ -54,14 +55,14 @@
|
||||||
(match-define (SturdyRef oid caveatChain sig) r)
|
(match-define (SturdyRef oid caveatChain sig) r)
|
||||||
(SturdyRef oid
|
(SturdyRef oid
|
||||||
(append caveatChain (list attenuation))
|
(append caveatChain (list attenuation))
|
||||||
(signature sig (sturdy-encode (Attenuation->preserves attenuation)))))
|
(signature sig (sturdy-encode (->preserve attenuation)))))
|
||||||
|
|
||||||
(define (SturdyRef-valid? r key)
|
(define (SturdyRef-valid? r key)
|
||||||
(match-define (SturdyRef oid caveatChain actual-sig) r)
|
(match-define (SturdyRef oid caveatChain actual-sig) r)
|
||||||
(define expected-sig
|
(define expected-sig
|
||||||
(for/fold [(sig (signature key (sturdy-encode oid)))]
|
(for/fold [(sig (signature key (sturdy-encode oid)))]
|
||||||
[(attenuation (in-list caveatChain))]
|
[(attenuation (in-list caveatChain))]
|
||||||
(signature sig (sturdy-encode (Attenuation->preserves attenuation)))))
|
(signature sig (sturdy-encode (->preserve attenuation)))))
|
||||||
(equal? expected-sig actual-sig))
|
(equal? expected-sig actual-sig))
|
||||||
|
|
||||||
(define (validate r key)
|
(define (validate r key)
|
||||||
|
|
Loading…
Reference in New Issue