substrate-lang 0.9.3 → 0.10.0

package/substrate/host/fs.sub

@@ -1,11 +1,10 @@
 ;; Files: the host module "fs", on paths and on open files. fs-list stores a directory's names
 ;; at into, and fs-read-link, fs-real-path, fs-make-temp-dir, fs-make-temp-file and fs-cwd a path, as host calls give
 ;; them. fs-stat fills an fs-info, and fs-lstat does too without following a link at the end of the path. fs-remove
-;; removes a file, a link or an empty directory, or when recursive a directory and everything in it. The calls return
-;; 0, or -1 when they fail, and store a failure's reason at err.
+;; removes a file, a link or an empty directory, or when recursive a directory and everything in it.
 (provide fs-read-file fs-write-file fs-make-dir fs-info fs-stat fs-lstat fs-list fs-remove fs-rename
          fs-read-link fs-real-path fs-symlink fs-copy fs-chmod fs-make-temp-dir fs-make-temp-file
-         fs-cwd fs-file fs-directory fs-link fs-other
+         fs-cwd fs-kind fs-none fs-file fs-directory fs-link fs-other
          fs-open-file fs-read-at fs-write-at fs-set-size fs-sync fs-size fs-close-file fs-read-stream fs-write-stream
          fs-read-flag fs-write-flag fs-append-flag fs-truncate-flag fs-create-flag fs-create-new-flag)
 
@@ -32,92 +31,106 @@
 (import file_stream "fs" "file_stream" (i32 i32 f64 i32 i32 -> i32))
 
 ;; An fs-info's kind.
-(const fs-file i32 1)
-(const fs-directory i32 2)
-(const fs-link i32 3)
-(const fs-other i32 4)
+(enum fs-kind fs-none fs-file fs-directory fs-link fs-other)
 
 ;; modified is in milliseconds since 1970, and mode is the file's mode bits, its type's included.
-(struct fs-info [kind i32] [size i64] [modified f64] [mode u32])
+(struct fs-info [kind fs-kind] [size i64] [modified f64] [mode u32])
 
-(define (fs-make-dir [path string] [err (ptr string)]) -> i32
-  (make_dir (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 err)))
+(define (done [r i32] [why (ptr string)] [err (ptr error)]) -> bool (or (== r 0) (host-failed! why err)))
 
-(define (stat-of [path string] [follow bool] [i (ptr fs-info)] [err (ptr string)]) -> i32
-  (let ([(kind size modified mode) (info (cast i32 (-> path bytes)) (cast i32 (-> path length)) follow (cast i32 err))])
-    (set! (-> i kind) kind)
-    (set! (-> i size) (cast i64 size))
-    (set! (-> i modified) modified)
-    (set! (-> i mode) (cast u32 mode))
-    (if (== kind 0) -1 0)))
+(define (fs-make-dir [path string] [err (ptr error)]) -> bool
+  (let ([why string])
+    (done (make_dir (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 (& why))) (& why) err)))
 
-(define (fs-stat [path string] [i (ptr fs-info)] [err (ptr string)]) -> i32 (stat-of path #t i err))
+(define (stat-of [path string] [follow bool] [i (ptr fs-info)] [err (ptr error)]) -> bool
+  (let ([why string])
+    (let ([(kind size modified mode)
+           (info (cast i32 (-> path bytes)) (cast i32 (-> path length)) follow (cast i32 (& why)))])
+      (set! (-> i kind) (cast fs-kind kind))
+      (set! (-> i size) (cast i64 size))
+      (set! (-> i modified) modified)
+      (set! (-> i mode) (cast u32 mode))
+      (or (!= kind 0) (host-failed! (& why) err)))))
 
-(define (fs-lstat [path string] [i (ptr fs-info)] [err (ptr string)]) -> i32 (stat-of path #f i err))
+(define (fs-stat [path string] [i (ptr fs-info)] [err (ptr error)]) -> bool (stat-of path #t i err))
 
-(define (fs-list [path string] [into (ptr (slice string))] [err (ptr string)]) -> i32
-  (let* ([n u32 0] [p (list (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 (& n)) (cast i32 err))])
-    (set! (@ into) (entry-strings (cast (ptr u8) p) n))
-    (if (== p 0) -1 0)))
-
-(define (fs-remove [path string] [recursive bool] [err (ptr string)]) -> i32
-  (if recursive
-      (remove_all (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 err))
-      (remove (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 err))))
+(define (fs-lstat [path string] [i (ptr fs-info)] [err (ptr error)]) -> bool (stat-of path #f i err))
 
-(define (fs-rename [from string] [to string] [err (ptr string)]) -> i32
-  (rename (cast i32 (-> from bytes)) (cast i32 (-> from length)) (cast i32 (-> to bytes)) (cast i32 (-> to length))
-          (cast i32 err)))
-
-(define (path-given [p i32] [n u32] [into (ptr string)]) -> i32
+(define (fs-list [path string] [into (ptr (slice string))] [err (ptr error)]) -> bool
+  (let* ([why string] [n u32 0]
+         [p (list (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 (& n)) (cast i32 (& why)))])
+    (set! (@ into) (entry-strings (cast (ptr u8) p) n))
+    (or (!= p 0) (host-failed! (& why) err))))
+
+(define (fs-remove [path string] [recursive bool] [err (ptr error)]) -> bool
+  (let ([why string])
+    (done (if recursive
+              (remove_all (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 (& why)))
+              (remove (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 (& why))))
+          (& why) err)))
+
+(define (fs-rename [from string] [to string] [err (ptr error)]) -> bool
+  (let ([why string])
+    (done (rename (cast i32 (-> from bytes)) (cast i32 (-> from length)) (cast i32 (-> to bytes))
+                  (cast i32 (-> to length)) (cast i32 (& why)))
+          (& why) err)))
+
+(define (path-given [p i32] [n u32] [into (ptr string)] [why (ptr string)] [err (ptr error)]) -> bool
   (set! (@ into) (cast string (slice (cast (ptr u8) p) n)))
-  (if (== p 0) -1 0))
+  (or (!= p 0) (host-failed! why err)))
 
-(define (fs-read-link [path string] [into (ptr string)] [err (ptr string)]) -> i32
-  (let* ([n u32 0] [p (read_link (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 (& n)) (cast i32 err))])
-    (path-given p n into)))
+(define (fs-read-link [path string] [into (ptr string)] [err (ptr error)]) -> bool
+  (let* ([why string] [n u32 0]
+         [p (read_link (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 (& n)) (cast i32 (& why)))])
+    (path-given p n into (& why) err)))
 
-(define (fs-real-path [path string] [into (ptr string)] [err (ptr string)]) -> i32
-  (let* ([n u32 0] [p (real_path (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 (& n)) (cast i32 err))])
-    (path-given p n into)))
+(define (fs-real-path [path string] [into (ptr string)] [err (ptr error)]) -> bool
+  (let* ([why string] [n u32 0]
+         [p (real_path (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 (& n)) (cast i32 (& why)))])
+    (path-given p n into (& why) err)))
 
 ;; fs-symlink makes a link at path to target, which needs all of -R and -W, as Deno's symlink does.
-(define (fs-symlink [target string] [path string] [err (ptr string)]) -> i32
-  (symlink (cast i32 (-> target bytes)) (cast i32 (-> target length)) (cast i32 (-> path bytes)) (cast i32 (-> path length))
-           (cast i32 err)))
-
-(define (fs-copy [from string] [to string] [err (ptr string)]) -> i32
-  (copy_file (cast i32 (-> from bytes)) (cast i32 (-> from length)) (cast i32 (-> to bytes)) (cast i32 (-> to length))
-             (cast i32 err)))
-
-(define (fs-chmod [path string] [mode u32] [err (ptr string)]) -> i32
-  (chmod (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 mode) (cast i32 err)))
+(define (fs-symlink [target string] [path string] [err (ptr error)]) -> bool
+  (let ([why string])
+    (done (symlink (cast i32 (-> target bytes)) (cast i32 (-> target length)) (cast i32 (-> path bytes))
+                   (cast i32 (-> path length)) (cast i32 (& why)))
+          (& why) err)))
+
+(define (fs-copy [from string] [to string] [err (ptr error)]) -> bool
+  (let ([why string])
+    (done (copy_file (cast i32 (-> from bytes)) (cast i32 (-> from length)) (cast i32 (-> to bytes))
+                     (cast i32 (-> to length)) (cast i32 (& why)))
+          (& why) err)))
+
+(define (fs-chmod [path string] [mode u32] [err (ptr error)]) -> bool
+  (let ([why string])
+    (done (chmod (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 mode) (cast i32 (& why)))
+          (& why) err)))
 
 ;; The temporary calls make a new directory or file named prefix, random hexadecimal digits and suffix, in dir, or in
 ;; the system's temporary directory when dir is empty, and give its path.
-(define (make-temp [dir string] [prefix string] [suffix string] [file bool] [into (ptr string)] [err (ptr string)])
-  -> i32
-  (let* ([n u32 0]
+(define (make-temp [dir string] [prefix string] [suffix string] [file bool] [into (ptr string)] [err (ptr error)])
+  -> bool
+  (let* ([why string] [n u32 0]
          [p (make_temp (cast i32 (-> dir bytes)) (cast i32 (-> dir length)) (cast i32 (-> prefix bytes))
                        (cast i32 (-> prefix length)) (cast i32 (-> suffix bytes)) (cast i32 (-> suffix length)) file
-                       (cast i32 (& n)) (cast i32 err))])
-    (path-given p n into)))
+                       (cast i32 (& n)) (cast i32 (& why)))])
+    (path-given p n into (& why) err)))
 
-(define (fs-make-temp-dir [dir string] [prefix string] [suffix string] [into (ptr string)] [err (ptr string)]) -> i32
+(define (fs-make-temp-dir [dir string] [prefix string] [suffix string] [into (ptr string)] [err (ptr error)]) -> bool
   (make-temp dir prefix suffix #f into err))
 
-(define (fs-make-temp-file [dir string] [prefix string] [suffix string] [into (ptr string)] [err (ptr string)]) -> i32
+(define (fs-make-temp-file [dir string] [prefix string] [suffix string] [into (ptr string)] [err (ptr error)]) -> bool
   (make-temp dir prefix suffix #t into err))
 
-(define (fs-cwd [into (ptr string)] [err (ptr string)]) -> i32
-  (let* ([n u32 0] [p (cwd (cast i32 (& n)) (cast i32 err))]) (path-given p n into)))
+(define (fs-cwd [into (ptr string)] [err (ptr error)]) -> bool
+  (let* ([why string] [n u32 0] [p (cwd (cast i32 (& n)) (cast i32 (& why)))]) (path-given p n into (& why) err)))
 
 ;; Open files, read and written at a position. fs-open-file gives a handle opened as flags say, to read when they say
-;; neither read nor write, or 0 when it fails; writing, appending, creating and truncating need -W, and reading -R.
-;; fs-read-at gives the number of bytes it read, fewer at the end of the file, and fs-size the file's size, or -1 when
-;; it fails. fs-read-stream and fs-write-stream make a handle a stream from start, which closes the handle when it
-;; closes, or give 0 when they fail, closing it. fs-read-file stores a file's bytes, from malloc, at into, and
-;; fs-write-file makes a file hold b.
+;; neither read nor write; writing, appending, creating and truncating need -W, and reading -R. fs-read-at gives the
+;; number of bytes it read, fewer at the end of the file, and fs-size the file's size. fs-read-stream and
+;; fs-write-stream make a handle a stream from start, which closes the handle when it closes. If they fail, they close
+;; the handle. fs-read-file stores a file's bytes, from malloc, at into, and fs-write-file makes a file hold b.
 (const fs-read-flag u32 1)
 (const fs-write-flag u32 2)
 (const fs-append-flag u32 4)
@@ -125,61 +138,78 @@
 (const fs-create-flag u32 16)
 (const fs-create-new-flag u32 32)
 
-(define (fs-open-file [path string] [flags u32] [err (ptr string)]) -> u32
-  (cast u32 (open_file (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 flags) (cast i32 err))))
-
-(define (fs-read-at [h u32] [into (slice u8)] [at i64] [err (ptr string)]) -> i32
-  (read_at (cast i32 h) (cast i32 (-> into items)) (cast i32 (-> into length)) (cast f64 at) (cast i32 err)))
-
-(define (fs-write-at [h u32] [b (slice u8)] [at i64] [err (ptr string)]) -> i32
-  (write_at (cast i32 h) (cast i32 (-> b items)) (cast i32 (-> b length)) (cast f64 at) (cast i32 err)))
-
-(define (fs-set-size [h u32] [n i64] [err (ptr string)]) -> i32 (set_file_size (cast i32 h) (cast f64 n) (cast i32 err)))
-
-(define (fs-sync [h u32] [err (ptr string)]) -> i32 (sync_file (cast i32 h) (cast i32 err)))
-
-(define (fs-size [h u32] [err (ptr string)]) -> i64 (cast i64 (file_size (cast i32 h) (cast i32 err))))
-
-(define (fs-close-file [h u32] [err (ptr string)]) -> i32 (close_file (cast i32 h) (cast i32 err)))
-
-(define (fs-read-stream [h u32] [start i64] [tag (ptr void)] [err (ptr string)]) -> u32
-  (cast u32 (file_stream (cast i32 h) 0 (cast f64 start) (cast i32 tag) (cast i32 err))))
-
-(define (fs-write-stream [h u32] [start i64] [tag (ptr void)] [err (ptr string)]) -> u32
-  (cast u32 (file_stream (cast i32 h) 1 (cast f64 start) (cast i32 tag) (cast i32 err))))
-
-(define (fs-read-file [path string] [into (ptr (slice u8))] [err (ptr string)]) -> i32
-  (let* ([h (fs-open-file path fs-read-flag err)] [size i64 0] [room u32 0] [p (ptr u8) 0] [more (ptr u8) 0] [n u32 0]
-         [got i32 0])
+(define (fs-open-file [path string] [flags u32] [h (ptr u32)] [err (ptr error)]) -> bool
+  (let ([why string] [n u32 0])
+    (set! n (cast u32 (open_file (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 flags)
+                                 (cast i32 (& why)))))
+    (unless (== h 0) (set! (@ h) n))
+    (or (!= n 0) (host-failed! (& why) err))))
+
+(define (fs-read-at [h u32] [into (slice u8)] [at i64] [n (ptr u32)] [err (ptr error)]) -> bool
+  (let* ([why string]
+         [r (read_at (cast i32 h) (cast i32 (-> into items)) (cast i32 (-> into length)) (cast f64 at)
+                     (cast i32 (& why)))])
+    (set! (@ n) (if (< r 0) 0 (cast u32 r)))
+    (or (>= r 0) (host-failed! (& why) err))))
+
+(define (fs-write-at [h u32] [b (slice u8)] [at i64] [err (ptr error)]) -> bool
+  (let ([why string])
+    (done (write_at (cast i32 h) (cast i32 (-> b items)) (cast i32 (-> b length)) (cast f64 at) (cast i32 (& why)))
+          (& why) err)))
+
+(define (fs-set-size [h u32] [n i64] [err (ptr error)]) -> bool
+  (let ([why string]) (done (set_file_size (cast i32 h) (cast f64 n) (cast i32 (& why))) (& why) err)))
+
+(define (fs-sync [h u32] [err (ptr error)]) -> bool
+  (let ([why string]) (done (sync_file (cast i32 h) (cast i32 (& why))) (& why) err)))
+
+(define (fs-size [h u32] [size (ptr i64)] [err (ptr error)]) -> bool
+  (let* ([why string] [s (file_size (cast i32 h) (cast i32 (& why)))])
+    (set! (@ size) (if (< s 0.0) 0 (cast i64 s)))
+    (or (>= s 0.0) (host-failed! (& why) err))))
+
+(define (fs-close-file [h u32] [err (ptr error)]) -> bool
+  (let ([why string]) (done (close_file (cast i32 h) (cast i32 (& why))) (& why) err)))
+
+(define (file-stream [h u32] [write i32] [start i64] [tag (ptr void)] [id (ptr u32)] [err (ptr error)]) -> bool
+  (let ([why string] [n u32 0])
+    (set! n (cast u32 (file_stream (cast i32 h) write (cast f64 start) (cast i32 tag) (cast i32 (& why)))))
+    (unless (== id 0) (set! (@ id) n))
+    (or (!= n 0) (host-failed! (& why) err))))
+
+(define (fs-read-stream [h u32] [start i64] [tag (ptr void)] [id (ptr u32)] [err (ptr error)]) -> bool
+  (file-stream h 0 start tag id err))
+
+(define (fs-write-stream [h u32] [start i64] [tag (ptr void)] [id (ptr u32)] [err (ptr error)]) -> bool
+  (file-stream h 1 start tag id err))
+
+(define (fs-read-file [path string] [into (ptr (slice u8))] [err (ptr error)]) -> bool
+  (let ([h u32 0] [size i64 0] [room u32 0] [p (ptr u8) 0] [more (ptr u8) 0] [n u32 0] [got u32 0])
     (set! (@ into) (slice (cast (ptr u8) 0) 0))
-    (when (== h 0) (return -1))
-    (set! size (fs-size h err))
+    (unless (fs-open-file path fs-read-flag (& h) err) (return #f))
+    (fs-size h (& size) 0)
     (set! room (if (> size 0) (+ (cast u32 (if (> size 2147483583) 2147483583 size)) 1) 4096))
-    (set! p (cast (ptr u8) (try-malloc room)))
+    (set! p (try-malloc room))
     (while (!= p 0)
-      (set! got (fs-read-at h (slice (+ p n) (- room n)) (cast i64 n) err))
-      (when (< got 0)
-        (free (cast (ptr void) p))
+      (unless (fs-read-at h (slice (+ p n) (- room n)) (cast i64 n) (& got) err)
+        (free p)
         (fs-close-file h 0)
-        (return -1))
-      (+= n (cast u32 got))
+        (return #f))
+      (+= n got)
       (when (< n room)
         (fs-close-file h 0)
         (set! (@ into) (slice p n))
-        (return 0))
-      (set! more (cast (ptr u8) (try-realloc (cast (ptr void) p) (* room 2))))
-      (when (== more 0) (free (cast (ptr void) p)))
+        (return #t))
+      (set! more (try-realloc p (* room 2)))
+      (when (== more 0) (free p))
       (set! p more)
       (set! room (* room 2)))
     (fs-close-file h 0)
-    (when (!= err 0) (set! (@ err) (string-copy "File too large")))
-    -1))
-
-(define (fs-write-file [path string] [b (slice u8)] [err (ptr string)]) -> i32
-  (let ([h (fs-open-file path (bit-or fs-write-flag fs-create-flag fs-truncate-flag) err)] [r i32 0])
-    (when (== h 0) (return -1))
-    (set! r (fs-write-at h b 0 err))
-    (if (< r 0)
-        (fs-close-file h 0)
-        (set! r (fs-close-file h err)))
-    r))
+    (error-fail! err error-other "File too large")))
+
+(define (fs-write-file [path string] [b (slice u8)] [err (ptr error)]) -> bool
+  (let ([h u32 0])
+    (and (fs-open-file path (bit-or fs-write-flag fs-create-flag fs-truncate-flag) (& h) err)
+         (if (fs-write-at h b 0 err)
+             (fs-close-file h err)
+             (begin (fs-close-file h 0) #f)))))

package/substrate/host/grants.mjs

@@ -247,7 +247,7 @@ export function within(asked, parent) {
     if (beyond) {
       const subnet = beyond.bits === undefined ? '' : `/${beyond.bits}`;
       const item = k === 'net' ? `${beyond.host}${subnet}${beyond.port === null ? '' : `:${beyond.port}`}` : beyond;
-      throw new Error(`${beyond === true ? `all ${k}` : `${k} ${item}`} reaches beyond the parent's grants`);
+      throw notGranted(`${beyond === true ? `all ${k}` : `${k} ${item}`} reaches beyond the parent's grants`);
     }
     const deny = { all: a.deny.all || p.deny.all, items: [...a.deny.items, ...p.deny.items] };
     out[k] = { all: a.all, items: [...a.items], deny };

package/substrate/host/grants.sub

@@ -8,18 +8,14 @@
 ;;   tls-cert tls-key          a file
 ;; grants-parse! reads flags as people type them, like -R=a,b, where ",," is a comma inside an item, and grants-add! a
 ;; clause as manifests and tests write one, like (read "a" "b"), (all net) or (tls "cert.pem" "key.pem").
-(provide grant grants grant-read grant-write grant-net grant-env grant-run make-grants grants-allow! grants-deny!
+(provide grant grants grant-kind grant-read grant-write grant-net grant-env grant-run make-grants grants-allow! grants-deny!
          grants-allow-all! grants-deny-all! grants-all! grants-inherit! grants-fake! grants-fetch! grants-tls!
          grants-join! grants-parse! grants-flag? grants-add! grants-entries! grants-arguments)
 
 (struct grant [kind string] [item string])
 (struct grants [list buffer])
 
-(const grant-read u32 0)
-(const grant-write u32 1)
-(const grant-net u32 2)
-(const grant-env u32 3)
-(const grant-run u32 4)
+(enum grant-kind grant-read grant-write grant-net grant-env grant-run)
 
 (define (make-grants) -> grants
   (let ([g grants])
@@ -30,22 +26,24 @@
   (let ([e (grant #:kind kind #:item item)])
     (buffer-add! (& (-> g list)) (slice (cast (ptr u8) (& e)) (sizeof grant)))))
 
-(define (allowed [k u32]) -> string (let ([names (array-of string "read" "write" "net" "env" "run")]) (@ names k)))
+(define (allowed [k grant-kind]) -> string
+  (match k [grant-read "read"] [grant-write "write"] [grant-net "net"] [grant-env "env"] [grant-run "run"]))
 
-(define (denied [k u32]) -> string
-  (let ([names (array-of string "deny-read" "deny-write" "deny-net" "deny-env" "deny-run")]) (@ names k)))
+(define (denied [k grant-kind]) -> string
+  (match k [grant-read "deny-read"] [grant-write "deny-write"] [grant-net "deny-net"] [grant-env "deny-env"] [grant-run "deny-run"]))
 
-(define (grants-allow! [g (ptr grants)] [k u32] [item string]) (added! g (allowed k) item))
+(define (grants-allow! [g (ptr grants)] [k grant-kind] [item string]) (added! g (allowed k) item))
 
-(define (grants-deny! [g (ptr grants)] [k u32] [item string]) (added! g (denied k) item))
+(define (grants-deny! [g (ptr grants)] [k grant-kind] [item string]) (added! g (denied k) item))
 
-(define (grants-allow-all! [g (ptr grants)] [k u32]) (added! g "all" (allowed k)))
+(define (grants-allow-all! [g (ptr grants)] [k grant-kind]) (added! g "all" (allowed k)))
 
-(define (grants-deny-all! [g (ptr grants)] [k u32]) (added! g "all" (denied k)))
+(define (grants-deny-all! [g (ptr grants)] [k grant-kind]) (added! g "all" (denied k)))
 
-(define (grants-all! [g (ptr grants)]) (for ([k u32 0]) (< k 5) (+= k 1) (grants-allow-all! g k)))
+(define (grants-all! [g (ptr grants)]) (for ([k u32 0]) (< k 5) (+= k 1) (grants-allow-all! g (cast grant-kind k))))
 
-(define (grants-inherit! [g (ptr grants)]) (for ([k u32 0]) (< k 5) (+= k 1) (added! g "inherit" (allowed k))))
+(define (grants-inherit! [g (ptr grants)])
+  (for ([k u32 0]) (< k 5) (+= k 1) (added! g "inherit" (allowed (cast grant-kind k)))))
 
 (define (grants-fake! [g (ptr grants)] [name string]) (added! g "fake" name))
 
@@ -87,33 +85,34 @@
   (for ([i u32 0]) (< i (-> s length)) (+= i 1) (when (== (@ s i) #\=) (return i)))
   (-> s length))
 
-(define (kind-of [name string] [k (ptr u32)]) -> bool
+(define (kind-of [name string] [k (ptr grant-kind)]) -> bool
   (let ([shorts (array-of string "-R" "-W" "-N" "-E" "--allow-run")]
         [longs (array-of string "--allow-read" "--allow-write" "--allow-net" "--allow-env" "--allow-run")])
     (for ([i u32 0]) (< i 5) (+= i 1)
       (when (or (== name (@ shorts i)) (== name (@ longs i)))
-        (set! (@ k) i)
+        (set! (@ k) (cast grant-kind i))
         (return #t)))
     #f))
 
-(define (denial-of [name string] [k (ptr u32)]) -> bool
+(define (denial-of [name string] [k (ptr grant-kind)]) -> bool
   (let ([names (array-of string "--deny-read" "--deny-write" "--deny-net" "--deny-env" "--deny-run")])
     (for ([i u32 0]) (< i 5) (+= i 1)
       (when (== name (@ names i))
-        (set! (@ k) i)
+        (set! (@ k) (cast grant-kind i))
         (return #t)))
     #f))
 
-(define (refused [err (ptr string)] [a string] [b string]) -> bool
+(define (refused [err (ptr error)] [a string] [b string]) -> bool
   (let ([m (make-buffer)])
     (buffer-add-string! (& m) a)
     (buffer-add-string! (& m) b)
-    (set! (@ err) (buffer-string (& m)))
+    (error-fail! err error-invalid (buffer-string (& m)))
+    (buffer-free! (& m))
     #f))
 
 (define (pushed! [b (ptr buffer)] [s string]) (buffer-add! b (slice (cast (ptr u8) (& s)) (sizeof string))))
 
-(define (split [flag string] [list string] [into (ptr buffer)] [err (ptr string)]) -> bool
+(define (split [flag string] [list string] [into (ptr buffer)] [err (ptr error)]) -> bool
   (let ([item (make-buffer)] [i u32 0] [n (-> list length)])
     (while (<= i n)
       (cond [(and (< (+ i 1) n) (== (@ list i) #\,) (== (@ list (+ i 1)) #\,))
@@ -132,13 +131,13 @@
 (define (strings-in [b (ptr buffer)]) -> (slice string)
   (slice (cast (ptr string) (-> b bytes)) (/ (-> b length) (sizeof string))))
 
-(define (listed! [g (ptr grants)] [kind string] [flag string] [list string] [err (ptr string)]) -> bool
+(define (listed! [g (ptr grants)] [kind string] [flag string] [list string] [err (ptr error)]) -> bool
   (let ([items (make-buffer)])
     (unless (split flag list (& items) err) (return #f))
     (let ([l (strings-in (& items))]) (for ([i u32 0]) (< i (-> l length)) (+= i 1) (added! g kind (@ l i))))
     #t))
 
-(define (fakes! [g (ptr grants)] [flag string] [list string] [err (ptr string)]) -> bool
+(define (fakes! [g (ptr grants)] [flag string] [list string] [err (ptr error)]) -> bool
   (let ([items (make-buffer)])
     (unless (split flag list (& items) err) (return #f))
     (let ([l (strings-in (& items))])
@@ -157,10 +156,10 @@
   (for ([i u32 0]) (< i (-> s length)) (+= i 1) (when (== (@ s i) #\:) (return i)))
   (-> s length))
 
-(define (grants-parse! [g (ptr grants)] [flags (slice string)] [err (ptr string)]) -> bool
+(define (grants-parse! [g (ptr grants)] [flags (slice string)] [err (ptr error)]) -> bool
   (for ([i u32 0]) (< i (-> flags length)) (+= i 1)
     (let* ([flag (@ flags i)] [eq (equals-at flag)] [name (slice flag 0 eq)] [listed (< eq (-> flag length))]
-           [value (if listed (slice flag (+ eq 1) (-> flag length)) "")] [k u32 0])
+           [value (if listed (slice flag (+ eq 1) (-> flag length)) "")] [k grant-kind])
       (cond [(or (== name "-A") (== name "--allow-all"))
              (when listed (return (refused err name " takes no list")))
              (grants-all! g)]
@@ -178,21 +177,22 @@
   #t)
 
 (define (grants-flag? [s string]) -> bool
-  (let ([name (slice s 0 (equals-at s))] [k u32 0])
+  (let ([name (slice s 0 (equals-at s))] [k grant-kind])
     (or (== name "-A") (== name "--allow-all") (kind-of name (& k)) (denial-of name (& k)) (== name "--fake")
         (== name "--tls-cert") (== name "--tls-key"))))
 
 ;; ---- clauses ----
 
-(define (kind-named [name string] [deny bool] [k (ptr u32)]) -> bool
+(define (kind-named [name string] [deny bool] [k (ptr grant-kind)]) -> bool
   (for ([i u32 0]) (< i 5) (+= i 1)
-    (when (== name (if deny (denied i) (allowed i)))
-      (set! (@ k) i)
-      (return #t)))
+    (let ([c (cast grant-kind i)])
+      (when (== name (if deny (denied c) (allowed c)))
+        (set! (@ k) c)
+        (return #t))))
   #f)
 
-(define (grants-add! [g (ptr grants)] [head string] [items (slice string)] [err (ptr string)]) -> bool
-  (let ([k u32 0] [n (-> items length)])
+(define (grants-add! [g (ptr grants)] [head string] [items (slice string)] [err (ptr error)]) -> bool
+  (let ([k grant-kind] [n (-> items length)])
     (when (== n 0) (return (refused err head " has no items")))
     (for ([i u32 0]) (< i n) (+= i 1)
       (when (== (-> (@ items i) length) 0) (return (refused err head " has an empty item"))))

package/substrate/host/modules/fake.mjs

@@ -122,7 +122,7 @@ export function fakeModules(setup, read) {
       connect(up, ul, pp, pl, hp, hl, tag, err) {
         const url = new URL(caller.string(up, ul));
         if (!mayUrl(setup.grants.net, url)) {
-          caller.fail(err, `websocket.connect: ${url.host} is not granted (--allow-net)`);
+          caller.fail(err, `websocket.connect: ${url.host} is not granted (--allow-net)`, errors.notGranted);
           return 0;
         }
         const [protocol = ''] = entries(caller.string(pp, pl));

package/substrate/host/modules/websocket.mjs

@@ -1,5 +1,5 @@
 // The host module "websocket" (websocket.sub).
-import { errors } from '../errors.mjs';
+import { errors, errorOf } from '../errors.mjs';
 import { entries } from '../entries.mjs';
 import { mayUrl, portOfUrl } from '../grants.mjs';
 
@@ -46,7 +46,7 @@ export function websocket(grants, guard, node = false) {
       connect(up, ul, pp, pl, hp, hl, tag, err) {
         const url = caller.string(up, ul);
         if (URL.canParse(url) && !mayUrl(grants.net, new URL(url))) {
-          caller.fail(err, `websocket.connect: ${new URL(url).host} is not granted (--allow-net)`);
+          caller.fail(err, `websocket.connect: ${new URL(url).host} is not granted (--allow-net)`, errors.notGranted);
           return 0;
         }
         const protocols = entries(caller.string(pp, pl));
@@ -54,7 +54,7 @@ export function websocket(grants, guard, node = false) {
         const headers = [];
         for (let i = 0; i + 1 < list.length; i += 2) headers.push([list[i], list[i + 1]]);
         if (headers.length > 0 && !node) {
-          caller.fail(err, 'websocket.connect: a page cannot send headers');
+          caller.fail(err, 'websocket.connect: a page cannot send headers', errors.invalid);
           return 0;
         }
         const s = { ws: null, tag, polling: false, opened: false, denied: null };
@@ -65,7 +65,7 @@ export function websocket(grants, guard, node = false) {
           const dispatcher = guard && URL.canParse(url) ? guard(portOfUrl(new URL(url)), denied) : undefined;
           s.ws = node ? new WebSocket(url, { protocols, headers, dispatcher }) : new WebSocket(url, protocols);
         } catch (e) {
-          caller.fail(err, e.message);
+          caller.fail(err, e.message, errorOf(e));
           return 0;
         }
         const id = next++;

package/substrate/host/modules/websocket.sub

@@ -25,19 +25,21 @@
   (set! (-> o protocols) 0)
   (set! (-> o headers) 0))
 
-(define (websocket-connect [url string] [o (ptr websocket-options)] [tag (ptr void)] [err (ptr string)]) -> u32
-  (let ([defaults websocket-options] [p o] [protocols (make-buffer)] [headers (make-buffer)] [id u32 0])
+(define (websocket-connect [url string] [o (ptr websocket-options)] [tag (ptr void)] [id (ptr u32)] [err (ptr error)])
+  -> bool
+  (let ([defaults websocket-options] [p o] [protocols (make-buffer)] [headers (make-buffer)] [why string] [n u32 0])
     (when (== p 0)
       (websocket-options-init! (& defaults))
       (set! p (& defaults)))
     (buffer-add-entries! (& protocols) (-> p protocols))
     (buffer-add-entries! (& headers) (-> p headers))
-    (set! id (cast u32 (connect (cast i32 (-> url bytes)) (cast i32 (-> url length)) (cast i32 (-> protocols bytes))
-                                (cast i32 (-> protocols length)) (cast i32 (-> headers bytes)) (cast i32 (-> headers length))
-                                (cast i32 tag) (cast i32 err))))
+    (set! n (cast u32 (connect (cast i32 (-> url bytes)) (cast i32 (-> url length)) (cast i32 (-> protocols bytes))
+                               (cast i32 (-> protocols length)) (cast i32 (-> headers bytes))
+                               (cast i32 (-> headers length)) (cast i32 tag) (cast i32 (& why)))))
     (buffer-free! (& protocols))
     (buffer-free! (& headers))
-    id))
+    (unless (== id 0) (set! (@ id) n))
+    (or (!= n 0) (host-failed! (& why) err))))
 
 (define (websocket-send [id u32] [b (slice u8)] [kind i32]) -> i32
   (send (cast i32 id) (cast i32 (-> b items)) (cast i32 (-> b length)) kind))

package/substrate/host/node/env.mjs

@@ -1,5 +1,6 @@
 // The host module "env" (env.sub).
 import { joined } from '../entries.mjs';
+import { errors } from '../errors.mjs';
 import { mayEnv, unlimited } from '../grants.mjs';
 
 const utf8 = new TextEncoder();
@@ -9,11 +10,11 @@ export function env(grants) {
     const named = (call, ptr, len, err) => {
       const name = caller.string(ptr, len);
       if (name === '' || /[=\0]/.test(name)) {
-        caller.fail(err, `${call}: a variable's name cannot be empty or hold = or NUL`);
+        caller.fail(err, `${call}: a variable's name cannot be empty or hold = or NUL`, errors.invalid);
         return null;
       }
       if (!mayEnv(grants.env, name)) {
-        caller.fail(err, `${call}: ${name} is not granted (--allow-env)`);
+        caller.fail(err, `${call}: ${name} is not granted (--allow-env)`, errors.notGranted);
         return null;
       }
       return name;
@@ -21,15 +22,20 @@ export function env(grants) {
     return {
       get(ptr, len, out, err) {
         const name = named('env.get', ptr, len, err);
-        const value = name === null ? undefined : process.env[name];
-        return value === undefined ? 0 : caller.give(utf8.encode(value), out);
+        if (name === null) return 0;
+        const value = process.env[name];
+        if (value === undefined) {
+          caller.fail(err, `env.get: ${name} is not set`, errors.missing);
+          return 0;
+        }
+        return caller.give(utf8.encode(value), out);
       },
       set(np, nl, vp, vl, err) {
         const name = named('env.set', np, nl, err);
         if (name === null) return -1;
         const value = caller.string(vp, vl);
         if (value.includes('\0')) {
-          caller.fail(err, "env.set: a variable's value cannot hold NUL");
+          caller.fail(err, "env.set: a variable's value cannot hold NUL", errors.invalid);
           return -1;
         }
         process.env[name] = value;
@@ -44,7 +50,7 @@ export function env(grants) {
       list(out, err) {
         const all = unlimited(grants.env);
         if (!all && (grants.env.deny.all || (!grants.env.all && grants.env.items.length === 0))) {
-          caller.fail(err, 'env.list: the environment is not granted (--allow-env)');
+          caller.fail(err, 'env.list: the environment is not granted (--allow-env)', errors.notGranted);
           return 0;
         }
         const names = Object.keys(process.env)