You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
103 lines
3.1 KiB
103 lines
3.1 KiB
2 years ago
|
#lang racket
|
||
|
|
|
||
|
|
;;; Copyright 2024 Jessica Tallon
|
||
|
|
;;;
|
||
|
|
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
||
|
|
;;; you may not use this file except in compliance with the License.
|
||
|
|
;;; You may obtain a copy of the License at
|
||
|
|
;;;
|
||
|
|
;;; http://www.apache.org/licenses/LICENSE-2.0
|
||
|
|
;;;
|
||
|
|
;;; Unless required by applicable law or agreed to in writing, software
|
||
|
|
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
||
|
|
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||
|
|
;;; See the License for the specific language governing permissions and
|
||
|
|
;;; limitations under the License.
|
||
|
|
|
||
|
|
(require goblins
|
||
|
|
goblins/vat
|
||
|
|
goblins/ocapn/captp
|
||
|
|
goblins/ocapn/netlayer/onion
|
||
|
|
goblins/ocapn/structs-urls
|
||
|
|
pk)
|
||
|
|
|
||
|
|
(define a-vat (make-vat))
|
||
|
|
|
||
|
|
(define (trigger-gc)
|
||
|
|
(sleep 1)
|
||
|
|
(collect-garbage))
|
||
|
|
|
||
|
|
(define (^car _bcom color model)
|
||
|
|
(lambda ()
|
||
|
|
(format "Vroom! I am a ~a ~a car!" color model)))
|
||
|
|
|
||
|
|
(define (^car-factory _bcom)
|
||
|
|
(lambda car-specs
|
||
|
|
(pk 'car-specs car-specs)
|
||
|
|
(define cars
|
||
|
|
(for/list ([car-spec car-specs])
|
||
|
|
(apply spawn ^car car-spec)))
|
||
|
|
(apply values cars)))
|
||
|
|
|
||
|
|
(define (^car-factory-builder _bcom)
|
||
|
|
(lambda ()
|
||
|
|
(spawn ^car-factory)))
|
||
|
|
|
||
|
|
(define (^echo _bcom)
|
||
|
|
(lambda args
|
||
|
|
(syscaller-free-thread trigger-gc)
|
||
|
|
args))
|
||
|
|
|
||
|
|
(define (^greeter _bcom)
|
||
|
|
(lambda (refr)
|
||
|
|
(syscaller-free-thread trigger-gc)
|
||
|
|
(<- refr "Hello")))
|
||
|
|
|
||
|
|
(define (^promise-resolver _bcom)
|
||
|
|
(lambda ()
|
||
|
|
(define-values (vow resolver)
|
||
|
|
(spawn-promise-values))
|
||
|
|
(list vow resolver)))
|
||
|
|
|
||
|
|
(define (^sturdyref-enlivener _bcom mycapn)
|
||
|
|
(lambda (sref)
|
||
|
|
(<- mycapn 'enliven sref)))
|
||
|
|
|
||
|
|
(define (start-server)
|
||
|
|
(define-values (onion-netlayer _onion-private-key _onion-service-id)
|
||
|
|
(new-onion-netlayer))
|
||
|
|
(define mycapn (spawn-mycapn onion-netlayer))
|
||
|
|
(define nonce-registry ($ mycapn 'get-registry))
|
||
|
|
|
||
|
|
(define car-factory-builder (spawn ^car-factory-builder))
|
||
|
|
(define car-factory-builder-swiss-num (string->bytes/latin-1 "JadQ0++RzsD4M+40uLxTWVaVqM10DcBJ"))
|
||
|
|
($ nonce-registry 'register car-factory-builder car-factory-builder-swiss-num)
|
||
|
|
|
||
|
|
(define echo (spawn ^echo))
|
||
|
|
(define echo-swiss-num (string->bytes/latin-1 "IO58l1laTyhcrgDKbEzFOO32MDd6zE5w"))
|
||
|
|
($ nonce-registry 'register echo echo-swiss-num)
|
||
|
|
|
||
|
|
(define greeter (spawn ^greeter))
|
||
|
|
(define greeter-swiss-num (string->bytes/latin-1 "VMDDd1voKWarCe2GvgLbxbVFysNzRPzx"))
|
||
|
|
($ nonce-registry 'register greeter greeter-swiss-num)
|
||
|
|
|
||
|
|
(define promise-resolver (spawn ^promise-resolver))
|
||
|
|
(define promise-resolver-swiss-num (string->bytes/latin-1 "IokCxYmMj04nos2JN1TDoY1bT8dXh6Lr"))
|
||
|
|
($ nonce-registry 'register promise-resolver promise-resolver-swiss-num)
|
||
|
|
|
||
|
|
(define sturdyref-enlivener (spawn ^sturdyref-enlivener mycapn))
|
||
|
|
(define sturdyref-enlivener-swiss-num (string->bytes/latin-1 "gi02I1qghIwPiKGKleCQAOhpy3ZtYRpB"))
|
||
|
|
($ nonce-registry 'register sturdyref-enlivener sturdyref-enlivener-swiss-num)
|
||
|
|
|
||
|
|
onion-netlayer)
|
||
|
|
|
||
|
|
(a-vat
|
||
|
|
'run
|
||
|
|
(lambda ()
|
||
|
|
(define onion-netlayer (start-server))
|
||
|
|
(on (<- onion-netlayer 'our-location)
|
||
|
|
(lambda (location)
|
||
|
|
(displayln (format "Connect to: ~a" (ocapn-node->string location)))))))
|
||
|
|
|
||
|
|
(sync (make-semaphore))
|