From e8a2e00fa21443b276a0142606bb0e3e2fdc08f5 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Wed, 9 Jun 2021 15:06:58 +0200 Subject: [PATCH] TAttenuate --- syndicate/actor.rkt | 15 +-------------- syndicate/distributed/tcp-server.rkt | 1 + syndicate/entity-ref.rkt | 13 +++++++++++++ syndicate/main.rkt | 2 ++ syndicate/private/install.rkt | 2 +- syndicate/relay.rkt | 1 + syndicate/rewrite.rkt | 14 +++++++++++++- syndicate/schemas/dataspace.prs | 2 +- syndicate/schemas/gatekeeper.prs | 2 +- syndicate/schemas/secure-chat-protocol.prs | 2 +- syndicate/schemas/simple-chat-protocol.prs | 2 +- syndicate/schemas/sturdy.prs | 3 ++- syndicate/schemas/worker.prs | 2 +- 13 files changed, 39 insertions(+), 22 deletions(-) create mode 100644 syndicate/entity-ref.rkt diff --git a/syndicate/actor.rkt b/syndicate/actor.rkt index 89dd682..e36fbef 100644 --- a/syndicate/actor.rkt +++ b/syndicate/actor.rkt @@ -5,10 +5,6 @@ (provide (except-out (struct-out entity) entity) (rename-out [make-entity entity]) - (struct-out entity-ref) - attenuate-entity-ref - parse-Ref! - actor-system actor? @@ -63,6 +59,7 @@ (require "rewrite.rkt") (require "engine.rkt") +(require "entity-ref.rkt") (require "dataflow.rkt") (require "field.rkt") (require "support/counter.rkt") @@ -80,9 +77,6 @@ #:sync [entity-sync #f] #:data [entity-data (void)])) -(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))) - (struct outbound-assertion (handle peer [established? #:mutable])) (struct actor (id @@ -471,10 +465,3 @@ (define (deliver maybe-proc . args) (when maybe-proc (apply maybe-proc args))) - -;; TODO: prove to myself I've gotten the order correct. (Right-to-left, wasn't it?!?!) -(define (attenuate-entity-ref r . caveats) - (match-define (entity-ref relay target previous-attenuation) r) - (if (null? caveats) - r - (entity-ref relay target (append previous-attenuation caveats)))) diff --git a/syndicate/distributed/tcp-server.rkt b/syndicate/distributed/tcp-server.rkt index e0e0b5b..40a5d70 100644 --- a/syndicate/distributed/tcp-server.rkt +++ b/syndicate/distributed/tcp-server.rkt @@ -8,6 +8,7 @@ (require (only-in racket/list append-map)) (require syndicate/relay) +(require syndicate/rewrite) (require syndicate/sturdy) (require syndicate/schemas/gen/gatekeeper) (require syndicate/sturdy) diff --git a/syndicate/entity-ref.rkt b/syndicate/entity-ref.rkt new file mode 100644 index 0000000..6769d81 --- /dev/null +++ b/syndicate/entity-ref.rkt @@ -0,0 +1,13 @@ +#lang racket/base +;;; SPDX-License-Identifier: LGPL-3.0-or-later +;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones + +(provide (struct-out entity-ref) + parse-Ref!) + +(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))) diff --git a/syndicate/main.rkt b/syndicate/main.rkt index b7ad7da..e9cf71f 100644 --- a/syndicate/main.rkt +++ b/syndicate/main.rkt @@ -4,6 +4,7 @@ #lang racket/base (provide (all-from-out "actor.rkt") + (all-from-out "entity-ref.rkt") (all-from-out "syntax.rkt") (all-from-out preserves) (all-from-out preserves-schema) @@ -14,6 +15,7 @@ :pattern) (require (except-in "actor.rkt" actor-system)) +(require "entity-ref.rkt") (require "syntax.rkt") (require preserves) (require preserves-schema) diff --git a/syndicate/private/install.rkt b/syndicate/private/install.rkt index a5024c6..3c96b60 100644 --- a/syndicate/private/install.rkt +++ b/syndicate/private/install.rkt @@ -17,7 +17,7 @@ (delete-directory/files output-directory #:must-exist? #f) (parameterize ((schema-compiler-plugin-mode 'meta)) (batch-compile #:inputs (list (build-path syndicate-path "schemas/**.prs")) - #:additional-modules (hash '(Actor) 'syndicate/actor) + #:additional-modules (hash '(EntityRef) 'syndicate/entity-ref) #:output-directory output-directory #:plugins (list schema-compiler-plugin)))) diff --git a/syndicate/relay.rkt b/syndicate/relay.rkt index 272be9a..b245505 100644 --- a/syndicate/relay.rkt +++ b/syndicate/relay.rkt @@ -11,6 +11,7 @@ (require "main.rkt") (require "engine.rkt") +(require "rewrite.rkt") (require "schemas/gen/protocol.rkt") (require (prefix-in sturdy: "schemas/gen/sturdy.rkt")) diff --git a/syndicate/rewrite.rkt b/syndicate/rewrite.rkt index 472a1b0..98a570a 100644 --- a/syndicate/rewrite.rkt +++ b/syndicate/rewrite.rkt @@ -2,12 +2,14 @@ ;;; SPDX-License-Identifier: LGPL-3.0-or-later ;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones -(provide run-rewrites) +(provide run-rewrites + attenuate-entity-ref) (require racket/match) (require racket/dict) (require preserves) +(require "entity-ref.rkt") (require "schemas/gen/sturdy.rkt") (define (match-Pattern p v) @@ -59,6 +61,9 @@ (define (instantiate-Template t bindings) (let walk ((t t)) (match t + [(Template-TAttenuate (TAttenuate t (Attenuation attenuation))) + (match-define (embedded v) (walk t)) + (embedded (apply attenuate-entity-ref v attenuation))] [(Template-TRef (TRef name)) (hash-ref bindings name (lambda () (error 'instantiate-Template "Missing binding: ~v" name)))] [(Template-Lit (Lit v)) v] @@ -104,3 +109,10 @@ [(cons stage remaining) (match (examine-alternatives stage v) [(? void?) (void)] [rewritten (loop remaining rewritten)])]))) + +;; TODO: prove to myself I've gotten the order correct. (Right-to-left, wasn't it?!?!) +(define (attenuate-entity-ref r . caveats) + (match-define (entity-ref relay target previous-attenuation) r) + (if (null? caveats) + r + (entity-ref relay target (append previous-attenuation caveats)))) diff --git a/syndicate/schemas/dataspace.prs b/syndicate/schemas/dataspace.prs index 3160df1..b9f26ea 100644 --- a/syndicate/schemas/dataspace.prs +++ b/syndicate/schemas/dataspace.prs @@ -1,4 +1,4 @@ version 1 . -embeddedType Actor.Ref . +embeddedType EntityRef.Ref . Observe = . diff --git a/syndicate/schemas/gatekeeper.prs b/syndicate/schemas/gatekeeper.prs index d8be377..a25d6c3 100644 --- a/syndicate/schemas/gatekeeper.prs +++ b/syndicate/schemas/gatekeeper.prs @@ -1,5 +1,5 @@ version 1 . -embeddedType Actor.Ref . +embeddedType EntityRef.Ref . Resolve = . Bind = . diff --git a/syndicate/schemas/secure-chat-protocol.prs b/syndicate/schemas/secure-chat-protocol.prs index c20c8e0..09e9e7e 100644 --- a/syndicate/schemas/secure-chat-protocol.prs +++ b/syndicate/schemas/secure-chat-protocol.prs @@ -1,5 +1,5 @@ version 1 . -embeddedType Actor.Ref . +embeddedType EntityRef.Ref . UserId = int . diff --git a/syndicate/schemas/simple-chat-protocol.prs b/syndicate/schemas/simple-chat-protocol.prs index 987c1f4..33804eb 100644 --- a/syndicate/schemas/simple-chat-protocol.prs +++ b/syndicate/schemas/simple-chat-protocol.prs @@ -1,5 +1,5 @@ version 1 . -embeddedType Actor.Ref . +embeddedType EntityRef.Ref . Present = . Says = . diff --git a/syndicate/schemas/sturdy.prs b/syndicate/schemas/sturdy.prs index 630f395..f82dd4e 100644 --- a/syndicate/schemas/sturdy.prs +++ b/syndicate/schemas/sturdy.prs @@ -36,7 +36,8 @@ PNot = . PCompound = . PCompoundMembers = { any: Pattern ...:... }. -Template = TRef / Lit / TCompound . +Template = TAttenuate / TRef / Lit / TCompound . +TAttenuate = . TRef = . TCompound = . TCompoundMembers = { any: Template ...:... }. diff --git a/syndicate/schemas/worker.prs b/syndicate/schemas/worker.prs index e35abd9..25783b5 100644 --- a/syndicate/schemas/worker.prs +++ b/syndicate/schemas/worker.prs @@ -1,4 +1,4 @@ version 1 . -embeddedType Actor.Ref . +embeddedType EntityRef.Ref . Instance = .