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

Adapt to recent changes in preserves-schema

This commit is contained in:
Tony Garnock-Jones 2021-06-08 15:38:24 +02:00
parent 601d60adc3
commit 19fc5f97bb
7 changed files with 16 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
syndicate/actor.rkt
View File

@ -8,7 +8,6 @@
(struct-out entity-ref)
attenuate-entity-ref
parse-Ref!
Ref->preserves
actor-system
@ -83,7 +82,6 @@
(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 (Ref->preserves r) r)
(struct outbound-assertion (handle peer [established? #:mutable]))

4
syndicate/distributed/tcp-server.rkt
View File

@ -26,9 +26,9 @@
(at ds (assert (Bind ds-oid ds-key ds)))
(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)
(displayln (bytes->hex-string (sturdy-encode (SturdyRef->preserves root-cap))))
(displayln (bytes->hex-string (sturdy-encode (->preserve root-cap))))
(define spawn-connection
(action (connection-custodian i o)

2
syndicate/main.rkt
View File

@ -6,6 +6,7 @@
(provide (all-from-out "actor.rkt")
(all-from-out "syntax.rkt")
(all-from-out preserves)
(all-from-out preserves-schema)
assertion-struct
message-struct
@ -16,6 +17,7 @@
(require (except-in "actor.rkt" actor-system))
(require "syntax.rkt")
(require preserves)
(require preserves-schema)
;; Thin veneers over `struct` for declaring intent.
(define-syntax-rule (assertion-struct item ...) (struct item ... #:prefab))

4
syndicate/pattern.rkt
View File

@ -28,6 +28,7 @@
(require (for-syntax syntax/id-table))
(require (for-syntax syntax/stx))
(require preserves-schema)
(require racket/match)
(require racket/list)
(require "pattern-expander.rkt")
@ -55,8 +56,7 @@
['template
(syntax-case s ()
[(_ field-stxs ...)
(syntax (#,(format-id #'ctor-stx "~a->preserves" (syntax-e #'top-type-name))
(ctor-stx field-stxs ...)))])]
(syntax (->preserve (ctor-stx field-stxs ...)))])]
['bindings
(syntax-case s ()
[(_ field-stxs ...) bindings-stx]

2
syndicate/relay.rkt
View File

@ -184,7 +184,7 @@
(define pending (reverse (tunnel-relay-pending-turn-rev tr)))
(set-tunnel-relay-pending-turn-rev! tr '())
((tunnel-relay-packet-writer tr)
(preserve->bytes (Turn->preserves pending)
(preserve->bytes (->preserve pending)
#:canonicalizing? #t
#:write-annotations? #f
#:encode-embedded encode-embedded:protocol)))))

8
syndicate/schema-compiler.rkt
View File

@ -17,7 +17,11 @@
(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
lookup-module-path
paths) options)
@ -96,7 +100,7 @@
(match def
[(Definition-or 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)
(define full-name (format-symbol "~a-~a" name variant-label-str))
(top-pat name full-name pattern alt-ty

5
syndicate/sturdy.rkt
View File

@ -24,6 +24,7 @@
(require (only-in sha hmac-sha256))
(require (only-in racket/random crypto-random-bytes))
(require preserves)
(require preserves-schema)
(require "schemas/gen/sturdy.rkt")
(define KEY_LENGTH 16) ;; 128 bits
@ -54,14 +55,14 @@
(match-define (SturdyRef oid caveatChain sig) r)
(SturdyRef oid
(append caveatChain (list attenuation))
(signature sig (sturdy-encode (Attenuation->preserves attenuation)))))
(signature sig (sturdy-encode (->preserve attenuation)))))
(define (SturdyRef-valid? r key)
(match-define (SturdyRef oid caveatChain actual-sig) r)
(define expected-sig
(for/fold [(sig (signature key (sturdy-encode oid)))]
[(attenuation (in-list caveatChain))]
(signature sig (sturdy-encode (Attenuation->preserves attenuation)))))
(signature sig (sturdy-encode (->preserve attenuation)))))
(equal? expected-sig actual-sig))
(define (validate r key)