From 1c514073a5f1ec0d7ed4c35f398f17505e171939 Mon Sep 17 00:00:00 2001
From: Jessica Tallon <jessica@spritely.institute>
Date: Mon, 22 Jan 2024 14:56:07 +0100
Subject: [PATCH] Add file to allow for running OCapN test suite

---
 misc/ocapn-test-suite.scm | 102 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 102 insertions(+)
 create mode 100644 misc/ocapn-test-suite.scm

diff --git a/misc/ocapn-test-suite.scm b/misc/ocapn-test-suite.scm
new file mode 100644
index 0000000..d45ea3d
--- /dev/null
+++ b/misc/ocapn-test-suite.scm
@@ -0,0 +1,102 @@
+#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))