Merge pull request #553 from talex5/variants

Replace objects with variants

README.md

@@ -1524,19 +1524,26 @@ See Eio's own tests for examples, e.g., [tests/switch.md](tests/switch.md).
 ## Provider Interfaces
 
 Eio applications use resources by calling functions (such as `Eio.Flow.write`).
-These functions are actually wrappers that call methods on the resources.
+These functions are actually wrappers that look up the implementing module and call
+the appropriate function on that.
 This allows you to define your own resources.
 
 Here's a flow that produces an endless stream of zeros (like "/dev/zero"):
 
 ```ocaml
-let zero = object
+module Zero = struct
-  inherit Eio.Flow.source
+  type t = unit
 
-  method read_into buf =
+  let single_read () buf = 
     Cstruct.memset buf 0;
     Cstruct.length buf
+
+  let read_methods = []         (* Optional optimisations *)
 end
+
+let ops = Eio.Flow.Pi.source (module Zero)
+
+let zero = Eio.Resource.T ((), ops)
 ```
 
 It can then be used like any other Eio flow:
@@ -1549,34 +1556,6 @@ It can then be used like any other Eio flow:
 - : unit = ()
 ```
 
-The `Flow.source` interface has some extra methods that can be used for optimisations
-(for example, instead of filling a buffer with zeros it could be more efficient to share
-a pre-allocated block of zeros).
-Using `inherit` provides default implementations of these methods that say no optimisations are available.
-It also protects you somewhat from API changes in future, as defaults can be provided for any new methods that get added.
-
-Although it is possible to *use* an object by calling its methods directly,
-it is recommended that you use the functions instead.
-The functions provide type information to the compiler, leading to clearer error messages,
-and may provide extra features or sanity checks.
-
-For example `Eio.Flow.single_read` is defined as:
-
-```ocaml
-let single_read (t : #Eio.Flow.source) buf =
-  let got = t#read_into buf in
-  assert (got > 0 && got <= Cstruct.length buf);
-  got
-```
-
-As an exception to this rule, it is fine to use the methods of `env` directly
-(e.g. using `main env#stdin` instead of `main (Eio.Stdenv.stdin env)`.
-Here, the compiler already has the type from the `Eio_main.run` call immediately above it,
-and `env` is acting as a simple record.
-We avoid doing that in this guide only to avoid alarming OCaml users unfamiliar with object syntax.
-
-See [Dynamic Dispatch](doc/rationale.md#dynamic-dispatch) for more discussion about the use of objects here.
-
 ## Example Applications
 
 - [gemini-eio][] is a simple Gemini browser. It shows how to integrate Eio with `ocaml-tls` and `notty`.
@@ -1729,9 +1708,8 @@ Of course, you could use `with_open_in` in this case to simplify it further.
 
 ### Casting
 
-Unlike many languages, OCaml does not automatically cast objects (polymorphic records) to super-types as needed.
+Unlike many languages, OCaml does not automatically cast to super-types as needed.
 Remember to keep the type polymorphic in your interface so users don't need to do this manually.
-This is similar to the case with polymorphic variants (where APIs should use `[< ...]` or `[> ...]`).
 
 For example, if you need an `Eio.Flow.source` then users should be able to use a `Flow.two_way`
 without having to cast it first:
@@ -1741,13 +1719,13 @@ without having to cast it first:
 (* BAD - user must cast to use function: *)
 module Message : sig
   type t
-  val read : Eio.Flow.source -> t
+  val read : Eio.Flow.source_ty r -> t
 end
 
 (* GOOD - a Flow.two_way can be used without casting: *)
 module Message : sig
   type t
-  val read : #Eio.Flow.source -> t
+  val read : _ Eio.Flow.source -> t
 end
 ```
 
@@ -1756,20 +1734,18 @@ If you want to store the argument, this may require you to cast internally:
 ```ocaml
 module Foo : sig
   type t
-  val of_source : #Eio.Flow.source -> t
+  val of_source : _ Eio.Flow.source -> t
 end = struct
   type t = {
-    src : Eio.Flow.source;
+    src : Eio.Flow.source_ty r;
   }
 
   let of_source x = {
-    src = (x :> Eio.Flow.source);
+    src = (x :> Eio.Flow.source_ty r);
   }
 end
 ```
 
-Note: the `#type` syntax only works on types defined by classes, whereas the slightly more verbose `<type; ..>` works on all object types.
-
 ### Passing env
 
 The `env` value you get from `Eio_main.run` is a powerful capability,

doc/prelude.ml

@@ -43,4 +43,4 @@ module Eio_main = struct
     end
 end
 
-let parse_config (flow : #Eio.Flow.source) = ignore
+let parse_config (flow : _ Eio.Flow.source) = ignore

doc/rationale.md

@@ -125,7 +125,7 @@ For dynamic dispatch with subtyping, objects seem to be the best choice:
   An object uses a single block to store the object's fields and a pointer to the shared method table.
 
 - First-class modules and GADTs are an advanced feature of the language.
-  The new users we hope to attract to OCaml 5.00 are likely to be familiar with objects already.
+  The new users we hope to attract to OCaml 5.0 are likely to be familiar with objects already.
 
 - It is possible to provide base classes with default implementations of some methods.
   This can allow adding new operations to the API in future without breaking existing providers.
@@ -133,24 +133,19 @@ For dynamic dispatch with subtyping, objects seem to be the best choice:
 In general, simulating objects using other features of the language leads to worse performance
 and worse ergonomics than using the language's built-in support.
 
-In Eio, we split the provider and consumer APIs:
+However, in order for Eio to be widely accepted in the OCaml community,
+we no longer use of objects and instead use a pair of a value and a function for looking up interfaces.
+There is a problem here, because each interface has a different type,
+so the function's return type depends on its input (the interface ID).
+This requires using a GADT. However, GADT's don't support sub-typing.
+To get around this, we use an extensible GADT to get the correct typing
+(but which will raise an exception if the interface isn't supported),
+and then wrap this with a polymorphic variant phantom type to help ensure
+it is used correctly.
 
-- To *provide* a flow, you implement an object type.
+This system gives the same performance as using objects and without requiring allocation.
-- To *use* a flow, you call a function (e.g. `Flow.close`).
+However, care is needed when defining new interfaces,
-
+since the compiler can't check that the resource really implements all the interfaces its phantom type suggests.
-The functions mostly just call the corresponding method on the object.
-If you call object methods directly in OCaml then you tend to get poor compiler error messages.
-This is because OCaml can only refer to the object types by listing the methods you seem to want to use.
-Using functions avoids this, because the function signature specifies the type of its argument,
-allowing type inference to work as for non-object code.
-In this way, users of Eio can be largely unaware that objects are being used at all.
-
-The function wrappers can also provide extra checks that the API is being followed correctly,
-such as asserting that a read does not return 0 bytes,
-or add extra convenience functions without forcing every implementor to add them too.
-
-Note that the use of objects in Eio is not motivated by the use of the "Object Capabilities" security model.
-Despite the name, that is not specific to objects at all.
 
 ## Results vs Exceptions
 

fuzz/fuzz_buf_read.ml

@@ -26,26 +26,30 @@ exception Buffer_limit_exceeded = Buf_read.Buffer_limit_exceeded
 let initial_size = 10
 let max_size = 100
 
-let mock_flow next = object (self)
+module Mock_flow = struct
-  inherit Eio.Flow.source
+  type t = string list ref
 
-  val mutable next = next
+  let rec single_read t buf =
-
+    match !t with
-  method read_into buf =
-    match next with
     | [] ->
       raise End_of_file
     | "" :: xs ->
-      next <- xs;
+      t := xs;
-      self#read_into buf
+      single_read t buf
     | x :: xs ->
       let len = min (Cstruct.length buf) (String.length x) in
       Cstruct.blit_from_string x 0 buf 0 len;
       let x' = String.drop x len in
-      next <- (if x' = "" then xs else x' :: xs);
+      t := (if x' = "" then xs else x' :: xs);
       len
+
+  let read_methods = []
 end
 
+let mock_flow =
+  let ops = Eio.Flow.Pi.source (module Mock_flow) in
+  fun chunks -> Eio.Resource.T (ref chunks, ops)
+
 module Model = struct
   type t = string ref
 

lib_eio/buf_read.ml

@@ -1,11 +1,13 @@
 exception Buffer_limit_exceeded
 
+open Std
+
 type t = {
   mutable buf : Cstruct.buffer;
   mutable pos : int;
   mutable len : int;
-  mutable flow : Flow.source option;    (* None if we've seen eof *)
+  mutable flow : Flow.source_ty r option;    (* None if we've seen eof *)
-  mutable consumed : int;               (* Total bytes consumed so far *)
+  mutable consumed : int;                    (* Total bytes consumed so far *)
   max_size : int;
 }
 
@@ -45,7 +47,7 @@ open Syntax
 let capacity t = Bigarray.Array1.dim t.buf
 
 let of_flow ?initial_size ~max_size flow =
-  let flow = (flow :> Flow.source) in
+  let flow = (flow :> Flow.source_ty r) in
   if max_size <= 0 then Fmt.invalid_arg "Max size %d should be positive!" max_size;
   let initial_size = Option.value initial_size ~default:(min 4096 max_size) in
   let buf = Bigarray.(Array1.create char c_layout initial_size) in
@@ -128,17 +130,22 @@ let ensure_slow_path t n =
 let ensure t n =
   if t.len < n then ensure_slow_path t n
 
-let as_flow t =
+module F = struct
-  object
+  type nonrec t = t
-    inherit Flow.source
 
-    method read_into dst =
+  let single_read t dst =
-      ensure t 1;
+    ensure t 1;
-      let len = min (buffered_bytes t) (Cstruct.length dst) in
+    let len = min (buffered_bytes t) (Cstruct.length dst) in
-      Cstruct.blit (peek t) 0 dst 0 len;
+    Cstruct.blit (peek t) 0 dst 0 len;
-      consume t len;
+    consume t len;
-      len
+    len
-  end
+
+  let read_methods = []
+end
+
+let as_flow =
+  let ops = Flow.Pi.source (module F) in
+  fun t -> Resource.T (t, ops)
 
 let get t i =
   Bigarray.Array1.get t.buf (t.pos + i)

lib_eio/buf_read.mli

@@ -9,6 +9,8 @@
     ]}
 *)
 
+open Std
+
 type t
 (** An input buffer. *)
 
@@ -21,7 +23,7 @@ type 'a parser = t -> 'a
     @raise End_of_file The flow ended without enough data to parse an ['a].
     @raise Buffer_limit_exceeded Parsing the value would exceed the configured size limit. *)
 
-val parse : ?initial_size:int -> max_size:int -> 'a parser -> #Flow.source -> ('a, [> `Msg of string]) result
+val parse : ?initial_size:int -> max_size:int -> 'a parser -> _ Flow.source -> ('a, [> `Msg of string]) result
 (** [parse p flow ~max_size] uses [p] to parse everything in [flow].
 
     It is a convenience function that does
@@ -32,7 +34,7 @@ val parse : ?initial_size:int -> max_size:int -> 'a parser -> #Flow.source -> ('
 
     @param initial_size see {!of_flow}. *)
 
-val parse_exn : ?initial_size:int -> max_size:int -> 'a parser -> #Flow.source -> 'a
+val parse_exn : ?initial_size:int -> max_size:int -> 'a parser -> _ Flow.source -> 'a
 (** [parse_exn] wraps {!parse}, but raises [Failure msg] if that returns [Error (`Msg msg)].
 
     Catching exceptions with [parse] and then raising them might seem pointless,
@@ -46,7 +48,7 @@ val parse_string : 'a parser -> string -> ('a, [> `Msg of string]) result
 val parse_string_exn : 'a parser -> string -> 'a
 (** [parse_string_exn] is like {!parse_string}, but handles errors like {!parse_exn}. *)
 
-val of_flow : ?initial_size:int -> max_size:int -> #Flow.source -> t
+val of_flow : ?initial_size:int -> max_size:int -> _ Flow.source -> t
 (** [of_flow ~max_size flow] is a buffered reader backed by [flow].
 
     @param initial_size The initial amount of memory to allocate for the buffer.
@@ -68,7 +70,7 @@ val of_buffer : Cstruct.buffer -> t
 val of_string : string -> t
 (** [of_string s] is a reader that reads from [s]. *)
 
-val as_flow : t -> Flow.source
+val as_flow : t -> Flow.source_ty r
 (** [as_flow t] is a buffered flow.
 
     Reading from it will return data from the buffer,

lib_eio/buf_write.mli

@@ -85,7 +85,7 @@ exception Flush_aborted
 
 (** {2 Running} *)
 
-val with_flow : ?initial_size:int -> #Flow.sink -> (t -> 'a) -> 'a
+val with_flow : ?initial_size:int -> _ Flow.sink -> (t -> 'a) -> 'a
 (** [with_flow flow fn] runs [fn writer], where [writer] is a buffer that flushes to [flow].
 
     Concurrently with [fn], it also runs a fiber that copies from [writer] to [flow].

lib_eio/eio.ml

@@ -3,19 +3,13 @@ include Eio__core
 module Debug = Private.Debug
 let traceln = Debug.traceln
 
-module Std = struct
+module Std = Std
-  module Promise = Promise
-  module Fiber = Fiber
-  module Switch = Switch
-  let traceln = Debug.traceln
-end
-
 module Semaphore = Semaphore
 module Mutex = Eio_mutex
 module Condition = Condition
 module Stream = Stream
 module Exn = Exn
-module Generic = Generic
+module Resource = Resource
 module Flow = Flow
 module Buf_read = Buf_read
 module Buf_write = Buf_write
@@ -28,17 +22,17 @@ module Fs = Fs
 module Path = Path
 
 module Stdenv = struct
-  let stdin  (t : <stdin  : #Flow.source; ..>) = t#stdin
+  let stdin  (t : <stdin  : _ Flow.source; ..>) = t#stdin
-  let stdout (t : <stdout : #Flow.sink;   ..>) = t#stdout
+  let stdout (t : <stdout : _ Flow.sink;   ..>) = t#stdout
-  let stderr (t : <stderr : #Flow.sink;   ..>) = t#stderr
+  let stderr (t : <stderr : _ Flow.sink;   ..>) = t#stderr
-  let net (t : <net : #Net.t; ..>) = t#net
+  let net (t : <net : _ Net.t; ..>) = t#net
   let process_mgr (t : <process_mgr : #Process.mgr; ..>) = t#process_mgr
   let domain_mgr (t : <domain_mgr : #Domain_manager.t; ..>) = t#domain_mgr
   let clock (t : <clock : #Time.clock; ..>) = t#clock
   let mono_clock (t : <mono_clock : #Time.Mono.t; ..>) = t#mono_clock
-  let secure_random (t: <secure_random : #Flow.source; ..>) = t#secure_random
+  let secure_random (t: <secure_random : _ Flow.source; ..>) = t#secure_random
-  let fs (t : <fs : #Fs.dir Path.t; ..>) = t#fs
+  let fs (t : <fs : _ Path.t; ..>) = t#fs
-  let cwd (t : <cwd : #Fs.dir Path.t; ..>) = t#cwd
+  let cwd (t : <cwd : _ Path.t; ..>) = t#cwd
   let debug (t : <debug : 'a; ..>) = t#debug
   let backend_id (t: <backend_id : string; ..>) = t#backend_id
 end

lib_eio/eio.mli

@@ -40,30 +40,18 @@ module Stream = Stream
 module Cancel = Eio__core.Cancel
 
 (** Commonly used standard features. This module is intended to be [open]ed. *)
-module Std : sig
+module Std = Std
-  module Promise = Promise
-  module Fiber = Fiber
-  module Switch = Switch
-
-  val traceln :
-    ?__POS__:string * int * int * int ->
-    ('a, Format.formatter, unit, unit) format4 -> 'a
-    (** Same as {!Eio.traceln}. *)
-end
 
 (** {1 Cross-platform OS API}
 
     The general pattern here is that each type of resource has a set of functions for using it,
-    plus an object type to allow defining your own implementations.
+    plus a provider ([Pi]) module to allow defining your own implementations.
-    To use the resources, it is recommended that you use the functions rather than calling
-    methods directly. Using the functions results in better error messages from the compiler,
-    and may provide extra features or sanity checks.
 
     The system resources are available from the environment argument provided by your event loop
     (e.g. {!Eio_main.run}). *)
 
-(** A base class for objects that can be queried at runtime for extra features. *)
+(** Defines the base resource type. *)
-module Generic = Generic
+module Resource = Resource
 
 (** Byte streams. *)
 module Flow = Flow
@@ -175,9 +163,9 @@ module Stdenv : sig
 
       To use these, see {!Flow}. *)
 
-  val stdin  : <stdin  : #Flow.source as 'a; ..> -> 'a
+  val stdin  : <stdin  : _ Flow.source as 'a; ..> -> 'a
-  val stdout : <stdout : #Flow.sink   as 'a; ..> -> 'a
+  val stdout : <stdout : _ Flow.sink   as 'a; ..> -> 'a
-  val stderr : <stderr : #Flow.sink   as 'a; ..> -> 'a
+  val stderr : <stderr : _ Flow.sink   as 'a; ..> -> 'a
 
   (** {1 File-system access}
 
@@ -201,7 +189,7 @@ module Stdenv : sig
       To use this, see {!Net}.
   *)
 
-  val net : <net : #Net.t as 'a; ..> -> 'a
+  val net : <net : _ Net.t as 'a; ..> -> 'a
   (** [net t] gives access to the process's network namespace. *)
 
   (** {1 Processes }
@@ -233,7 +221,7 @@ module Stdenv : sig
 
   (** {1 Randomness} *)
 
-  val secure_random : <secure_random : #Flow.source as 'a; ..> -> 'a
+  val secure_random : <secure_random : _ Flow.source as 'a; ..> -> 'a
   (** [secure_random t] is an infinite source of random bytes suitable for cryptographic purposes. *)
 
   (** {1 Debugging} *)

lib_eio/file.ml

@@ -1,13 +1,10 @@
-(** Tranditional Unix permissions. *)
+open Std
+
 module Unix_perm = struct
   type t = int
-  (** This is the same as {!Unix.file_perm}, but avoids a dependency on [Unix]. *)
 end
 
-(** Portable file stats. *)
 module Stat = struct
-
-  (** Kind of file from st_mode. **)
   type kind = [
     | `Unknown
     | `Fifo
@@ -19,7 +16,6 @@ module Stat = struct
     | `Socket
   ]
 
-  (** Like stat(2). *)
   type t = {
     dev : Int64.t;
     ino : Int64.t;
@@ -36,62 +32,85 @@ module Stat = struct
   }
 end
 
-(** A file opened for reading. *)
+type ro_ty = [`File | Flow.source_ty | Resource.close_ty]
-class virtual ro = object (_ : <Generic.t; Flow.source; ..>)
+
-  method probe _ = None
+type 'a ro = ([> ro_ty] as 'a) r
-  method read_methods = []
+
-  method virtual pread : file_offset:Optint.Int63.t -> Cstruct.t list -> int
+type rw_ty = [ro_ty | Flow.sink_ty]
-  method virtual stat : Stat.t
+
+type 'a rw = ([> rw_ty] as 'a) r
+
+module Pi = struct
+  module type READ = sig
+    include Flow.Pi.SOURCE
+
+    val pread : t -> file_offset:Optint.Int63.t -> Cstruct.t list -> int
+    val stat : t -> Stat.t
+    val close : t -> unit
+  end
+
+  module type WRITE = sig
+    include Flow.Pi.SINK
+    include READ with type t := t
+
+    val pwrite : t -> file_offset:Optint.Int63.t -> Cstruct.t list -> int
+  end
+
+  type (_, _, _) Resource.pi +=
+    | Read : ('t, (module READ with type t = 't), [> ro_ty]) Resource.pi
+    | Write : ('t, (module WRITE with type t = 't), [> rw_ty]) Resource.pi
+
+  let ro (type t) (module X : READ with type t = t) =
+    Resource.handler [
+      H (Flow.Pi.Source, (module X));
+      H (Read, (module X));
+      H (Resource.Close, X.close);
+    ]
+
+  let rw (type t) (module X : WRITE with type t = t) =
+    Resource.handler (
+      H (Flow.Pi.Sink, (module X)) ::
+      H (Write, (module X)) ::
+      Resource.bindings (ro (module X))
+    )
 end
 
-(** A file opened for reading and writing. *)
+let stat (Resource.T (t, ops)) =
-class virtual rw = object (_ : <Generic.t; Flow.source; Flow.sink; ..>)
+  let module X = (val (Resource.get ops Pi.Read)) in
-  inherit ro
+  X.stat t
-  method virtual pwrite : file_offset:Optint.Int63.t -> Cstruct.t list -> int
-end
 
-(** [stat t] returns the {!Stat.t} record associated with [t]. *)
-let stat (t : #ro) = t#stat
-
-(** [size t] returns the size of [t]. *)
 let size t = (stat t).size
 
-(** [pread t ~file_offset bufs] performs a single read of [t] at [file_offset] into [bufs].
+let pread (Resource.T (t, ops)) ~file_offset bufs =
-
+  let module X = (val (Resource.get ops Pi.Read)) in
-    It returns the number of bytes read, which may be less than the space in [bufs],
+  let got = X.pread t ~file_offset bufs in
-    even if more bytes are available. Use {!pread_exact} instead if you require
-    the buffer to be filled.
-
-    To read at the current offset, use {!Flow.single_read} instead. *)
-let pread (t : #ro) ~file_offset bufs =
-  let got = t#pread ~file_offset bufs in
   assert (got > 0 && got <= Cstruct.lenv bufs);
   got
 
-(** [pread_exact t ~file_offset bufs] reads from [t] into [bufs] until [bufs] is full.
+let pread_exact (Resource.T (t, ops)) ~file_offset bufs =
+  let module X = (val (Resource.get ops Pi.Read)) in
+  let rec aux ~file_offset bufs =
+    if Cstruct.lenv bufs > 0 then (
+      let got = X.pread t ~file_offset bufs in
+      let file_offset = Optint.Int63.add file_offset (Optint.Int63.of_int got) in
+      aux ~file_offset (Cstruct.shiftv bufs got)
+    )
+  in
+  aux ~file_offset bufs
 
-    @raise End_of_file if the buffer could not be filled. *)
+let pwrite_single (Resource.T (t, ops)) ~file_offset bufs =
-let rec pread_exact (t : #ro) ~file_offset bufs =
+  let module X = (val (Resource.get ops Pi.Write)) in
-  if Cstruct.lenv bufs > 0 then (
+  let got = X.pwrite t ~file_offset bufs in
-    let got = t#pread ~file_offset bufs in
-    let file_offset = Optint.Int63.add file_offset (Optint.Int63.of_int got) in
-    pread_exact t ~file_offset (Cstruct.shiftv bufs got)
-  )
-
-(** [pwrite_single t ~file_offset bufs] performs a single write operation, writing
-    data from [bufs] to location [file_offset] in [t].
-
-    It returns the number of bytes written, which may be less than the length of [bufs].
-    In most cases, you will want to use {!pwrite_all} instead. *)
-let pwrite_single (t : #rw) ~file_offset bufs =
-  let got = t#pwrite ~file_offset bufs in
   assert (got > 0 && got <= Cstruct.lenv bufs);
   got
 
-(** [pwrite_all t ~file_offset bufs] writes all the data in [bufs] to location [file_offset] in [t]. *)
+let pwrite_all (Resource.T (t, ops)) ~file_offset bufs =
-let rec pwrite_all (t : #rw) ~file_offset bufs =
+  let module X = (val (Resource.get ops Pi.Write)) in
-  if Cstruct.lenv bufs > 0 then (
+  let rec aux ~file_offset bufs =
-    let got = t#pwrite ~file_offset bufs in
+    if Cstruct.lenv bufs > 0 then (
-    let file_offset = Optint.Int63.add file_offset (Optint.Int63.of_int got) in
+      let got = X.pwrite t ~file_offset bufs in
-    pwrite_all t ~file_offset (Cstruct.shiftv bufs got)
+      let file_offset = Optint.Int63.add file_offset (Optint.Int63.of_int got) in
-  )
+      aux ~file_offset (Cstruct.shiftv bufs got)
+    )
+  in
+  aux ~file_offset bufs

lib_eio/file.mli

@@ -0,0 +1,104 @@
+open Std
+
+(** Tranditional Unix permissions. *)
+module Unix_perm : sig
+  type t = int
+  (** This is the same as {!Unix.file_perm}, but avoids a dependency on [Unix]. *)
+end
+
+(** Portable file stats. *)
+module Stat : sig
+
+  type kind = [
+    | `Unknown
+    | `Fifo
+    | `Character_special
+    | `Directory
+    | `Block_device
+    | `Regular_file
+    | `Symbolic_link
+    | `Socket
+  ]
+  (** Kind of file from st_mode. **)
+
+  type t = {
+    dev : Int64.t;
+    ino : Int64.t;
+    kind : kind;
+    perm : Unix_perm.t;
+    nlink : Int64.t;
+    uid : Int64.t;
+    gid : Int64.t;
+    rdev : Int64.t;
+    size : Optint.Int63.t;
+    atime : float;
+    mtime : float;
+    ctime : float;
+  }
+  (** Like stat(2). *)
+end
+
+type ro_ty = [`File | Flow.source_ty | Resource.close_ty]
+
+type 'a ro = ([> ro_ty] as 'a) r
+(** A file opened for reading. *)
+
+type rw_ty = [ro_ty | Flow.sink_ty]
+
+type 'a rw = ([> rw_ty] as 'a) r
+(** A file opened for reading and writing. *)
+
+module Pi : sig
+  module type READ = sig
+    include Flow.Pi.SOURCE
+
+    val pread : t -> file_offset:Optint.Int63.t -> Cstruct.t list -> int
+    val stat : t -> Stat.t
+    val close : t -> unit
+  end
+
+  module type WRITE = sig
+    include Flow.Pi.SINK
+    include READ with type t := t
+
+    val pwrite : t -> file_offset:Optint.Int63.t -> Cstruct.t list -> int
+  end
+
+  type (_, _, _) Resource.pi +=
+    | Read : ('t, (module READ with type t = 't), [> ro_ty]) Resource.pi
+    | Write : ('t, (module WRITE with type t = 't), [> rw_ty]) Resource.pi
+
+  val ro : (module READ with type t = 't) -> ('t, ro_ty) Resource.handler
+
+  val rw : (module WRITE with type t = 't) -> ('t, rw_ty) Resource.handler
+end
+
+val stat : _ ro -> Stat.t
+(** [stat t] returns the {!Stat.t} record associated with [t]. *)
+
+val size : _ ro -> Optint.Int63.t
+(** [size t] returns the size of [t]. *)
+
+val pread : _ ro -> file_offset:Optint.Int63.t -> Cstruct.t list -> int
+(** [pread t ~file_offset bufs] performs a single read of [t] at [file_offset] into [bufs].
+
+    It returns the number of bytes read, which may be less than the space in [bufs],
+    even if more bytes are available. Use {!pread_exact} instead if you require
+    the buffer to be filled.
+
+    To read at the current offset, use {!Flow.single_read} instead. *)
+
+val pread_exact : _ ro -> file_offset:Optint.Int63.t -> Cstruct.t list -> unit
+(** [pread_exact t ~file_offset bufs] reads from [t] into [bufs] until [bufs] is full.
+
+    @raise End_of_file if the buffer could not be filled. *)
+
+val pwrite_single : _ rw -> file_offset:Optint.Int63.t -> Cstruct.t list -> int
+(** [pwrite_single t ~file_offset bufs] performs a single write operation, writing
+    data from [bufs] to location [file_offset] in [t].
+
+    It returns the number of bytes written, which may be less than the length of [bufs].
+    In most cases, you will want to use {!pwrite_all} instead. *)
+
+val pwrite_all : _ rw -> file_offset:Optint.Int63.t -> Cstruct.t list -> unit
+(** [pwrite_all t ~file_offset bufs] writes all the data in [bufs] to location [file_offset] in [t]. *)

lib_eio/flow.ml

@@ -1,106 +1,169 @@
+open Std
+
 type shutdown_command = [ `Receive | `Send | `All ]
 
-type read_method = ..
+type 't read_method = ..
-type read_method += Read_source_buffer of ((Cstruct.t list -> int) -> unit)
+type 't read_method += Read_source_buffer of ('t -> (Cstruct.t list -> int) -> unit)
 
-class type close = Generic.close
+type source_ty = [`R | `Flow]
-let close = Generic.close
+type 'a source = ([> source_ty] as 'a) r
 
-class virtual source = object (_ : <Generic.t; ..>)
+type sink_ty = [`W | `Flow]
-  method probe _ = None
+type 'a sink = ([> sink_ty] as 'a) r
-  method read_methods : read_method list = []
+
-  method virtual read_into : Cstruct.t -> int
+type shutdown_ty = [`Shutdown]
+type 'a shutdown = ([> shutdown_ty] as 'a) r
+
+module Pi = struct
+  module type SOURCE = sig
+    type t
+    val read_methods : t read_method list
+    val single_read : t -> Cstruct.t -> int
+  end
+
+  module type SINK = sig
+    type t
+    val copy : t -> src:_ source -> unit
+    val write : t -> Cstruct.t list -> unit
+  end
+
+  module type SHUTDOWN = sig
+    type t
+    val shutdown : t -> shutdown_command -> unit
+  end
+
+  type (_, _, _) Resource.pi +=
+    | Source : ('t, (module SOURCE with type t = 't), [> source_ty]) Resource.pi
+    | Sink : ('t, (module SINK with type t = 't), [> sink_ty]) Resource.pi
+    | Shutdown : ('t, (module SHUTDOWN with type t = 't), [> shutdown_ty]) Resource.pi
+
+
+  let source (type t) (module X : SOURCE with type t = t) =
+    Resource.handler [H (Source, (module X))]
+
+  let sink (type t) (module X : SINK with type t = t) =
+    Resource.handler [H (Sink, (module X))]
+
+  let shutdown (type t) (module X : SHUTDOWN with type t = t) =
+    Resource.handler [ H (Shutdown, (module X))]
+
+  module type TWO_WAY = sig
+    include SHUTDOWN
+    include SOURCE with type t := t
+    include SINK with type t := t
+  end
+
+  let two_way (type t) (module X : TWO_WAY with type t = t) =
+    Resource.handler [
+      H (Shutdown, (module X));
+      H (Source, (module X));
+      H (Sink, (module X));
+    ]
 end
 
-let single_read (t : #source) buf =
+open Pi
-  let got = t#read_into buf in
+
+let close = Resource.close
+
+let single_read (Resource.T (t, ops)) buf =
+  let module X = (val (Resource.get ops Source)) in
+  let got = X.single_read t buf in
   assert (got > 0 && got <= Cstruct.length buf);
   got
 
-let read_methods (t : #source) = t#read_methods
-
 let rec read_exact t buf =
   if Cstruct.length buf > 0 then (
     let got = single_read t buf in
     read_exact t (Cstruct.shift buf got)
   )
 
-let cstruct_source data : source =
+module Cstruct_source = struct
-  object (self)
+  type t = Cstruct.t list ref
-    val mutable data = data
 
-    inherit source
+  let create data = ref data
 
-    method private read_source_buffer fn =
+  let read_source_buffer t fn =
-      let rec aux () =
+    let rec aux () =
-        match data with
+      match !t with
-        | [] -> raise End_of_file
+      | [] -> raise End_of_file
-        | x :: xs when Cstruct.length x = 0 -> data <- xs; aux ()
+      | x :: xs when Cstruct.length x = 0 -> t := xs; aux ()
-        | xs ->
+      | xs ->
-          let n = fn xs in
+        let n = fn xs in
-          data <- Cstruct.shiftv xs n 
+        t := Cstruct.shiftv xs n
-      in
+    in
-      aux ()
+    aux ()
 
-    method! read_methods =
+  let read_methods =
-      [ Read_source_buffer self#read_source_buffer ]
+    [ Read_source_buffer read_source_buffer ]
 
-    method read_into dst =
+  let single_read t dst =
-      let avail, src = Cstruct.fillv ~dst ~src:data in
+    let avail, src = Cstruct.fillv ~dst ~src:!t in
-      if avail = 0 then raise End_of_file;
+    if avail = 0 then raise End_of_file;
-      data <- src;
+    t := src;
-      avail
+    avail
-  end
 
-let string_source s : source =
-  object
-    val mutable offset = 0
-
-    inherit source
-
-    method read_into dst =
-      if offset = String.length s then raise End_of_file;
-
-      let len = min (Cstruct.length dst) (String.length s - offset) in
-      Cstruct.blit_from_string s offset dst 0 len;
-      offset <- offset + len;
-      len
-  end
-
-class virtual sink = object (self : <Generic.t; ..>)
-  method probe _ = None
-  method virtual copy : 'a. (#source as 'a) -> unit
-  method write bufs = self#copy (cstruct_source bufs)
 end
 
-let write (t : #sink) (bufs : Cstruct.t list) = t#write bufs
+let cstruct_source =
+  let ops = Pi.source (module Cstruct_source) in
+  fun data -> Resource.T (Cstruct_source.create data, ops)
 
-let copy (src : #source) (dst : #sink) = dst#copy src
+module String_source = struct
+  type t = {
+    s : string;
+    mutable offset : int;
+  }
+
+  let single_read t dst =
+    if t.offset = String.length t.s then raise End_of_file;
+    let len = min (Cstruct.length dst) (String.length t.s - t.offset) in
+    Cstruct.blit_from_string t.s t.offset dst 0 len;
+    t.offset <- t.offset + len;
+    len
+
+  let read_methods = []
+
+  let create s = { s; offset = 0 }
+end
+
+let string_source =
+  let ops = Pi.source (module String_source) in
+  fun s -> Resource.T (String_source.create s, ops)
+
+let write (Resource.T (t, ops)) bufs =
+  let module X = (val (Resource.get ops Sink)) in
+  X.write t bufs
+
+let copy src (Resource.T (t, ops)) =
+  let module X = (val (Resource.get ops Sink)) in
+  X.copy t ~src
 
 let copy_string s = copy (string_source s)
 
-let buffer_sink b =
+module Buffer_sink = struct
-  object
+  type t = Buffer.t
-    inherit sink
 
-    method copy src =
+  let copy t ~src:(Resource.T (src, ops)) =
-      let buf = Cstruct.create 4096 in
+    let module Src = (val (Resource.get ops Source)) in
-      try
+    let buf = Cstruct.create 4096 in
-        while true do
+    try
-          let got = src#read_into buf in
+      while true do
-          Buffer.add_string b (Cstruct.to_string ~len:got buf)
+        let got = Src.single_read src buf in
-        done
+        Buffer.add_string t (Cstruct.to_string ~len:got buf)
-      with End_of_file -> ()
+      done
+    with End_of_file -> ()
 
-    method! write bufs =
+  let write t bufs =
-      List.iter (fun buf -> Buffer.add_bytes b (Cstruct.to_bytes buf)) bufs
+    List.iter (fun buf -> Buffer.add_bytes t (Cstruct.to_bytes buf)) bufs
-  end
-
-class virtual two_way = object (_ : <source; sink; ..>)
-  inherit sink
-  method read_methods = []
-
-  method virtual shutdown : shutdown_command -> unit
 end
 
-let shutdown (t : #two_way) = t#shutdown
+let buffer_sink =
+  let ops = Pi.sink (module Buffer_sink) in
+  fun b -> Resource.T (b, ops)
+
+type two_way_ty = [source_ty | sink_ty | shutdown_ty]
+type 'a two_way = ([> two_way_ty] as 'a) r
+
+let shutdown (Resource.T (t, ops)) cmd =
+  let module X = (val (Resource.get ops Shutdown)) in
+  X.shutdown t cmd

lib_eio/flow.mli

@@ -4,24 +4,37 @@
 
     To read structured data (e.g. a line at a time), wrap a source using {!Buf_read}. *)
 
-(** {2 Reading} *)
+open Std
 
-type read_method = ..
+(** {2 Types} *)
+
+type source_ty = [`R | `Flow]
+type 'a source = ([> source_ty] as 'a) r
+(** A readable flow provides a stream of bytes. *)
+
+type sink_ty = [`W | `Flow]
+type 'a sink = ([> sink_ty] as 'a) r
+(** A writeable flow accepts a stream of bytes. *)
+
+type shutdown_ty = [`Shutdown]
+type 'a shutdown = ([> shutdown_ty] as 'a) r
+
+type 'a read_method = ..
 (** Sources can offer a list of ways to read them, in order of preference. *)
 
-class virtual source : object
+type shutdown_command = [
-  inherit Generic.t
+  | `Receive  (** Indicate that no more reads will be done *)
-  method read_methods : read_method list
+  | `Send     (** Indicate that no more writes will be done *)
-  method virtual read_into : Cstruct.t -> int
+  | `All      (** Indicate that no more reads or writes will be done *)
-end
+]
 
-val single_read : #source -> Cstruct.t -> int
+(** {2 Reading} *)
+
+val single_read : _ source -> Cstruct.t -> int
 (** [single_read src buf] reads one or more bytes into [buf].
 
     It returns the number of bytes read (which may be less than the
     buffer size even if there is more data to be read).
-    [single_read src] just makes a single call to [src#read_into]
-    (and asserts that the result is in range).
 
     - Use {!read_exact} instead if you want to fill [buf] completely.
     - Use {!Buf_read.line} to read complete lines.
@@ -31,24 +44,18 @@ val single_read : #source -> Cstruct.t -> int
 
     @raise End_of_file if there is no more data to read *)
 
-val read_exact : #source -> Cstruct.t -> unit
+val read_exact : _ source -> Cstruct.t -> unit
 (** [read_exact src dst] keeps reading into [dst] until it is full.
     @raise End_of_file if the buffer could not be filled. *)
 
-val read_methods : #source -> read_method list
+val string_source : string -> source_ty r
-(** [read_methods flow] is a list of extra ways of reading from [flow],
-    with the preferred (most efficient) methods first.
-
-    If no method is suitable, {!read} should be used as the fallback. *)
-
-val string_source : string -> source
 (** [string_source s] is a source that gives the bytes of [s]. *)
 
-val cstruct_source : Cstruct.t list -> source
+val cstruct_source : Cstruct.t list -> source_ty r
 (** [cstruct_source cs] is a source that gives the bytes of [cs]. *)
 
-type read_method += Read_source_buffer of ((Cstruct.t list -> int) -> unit)
+type 't read_method += Read_source_buffer of ('t -> (Cstruct.t list -> int) -> unit)
-(** If a source offers [Read_source_buffer rsb] then the user can call [rsb fn]
+(** If a source offers [Read_source_buffer rsb] then the user can call [rsb t fn]
     to borrow a view of the source's buffers. [fn] returns the number of bytes it consumed.
 
     [rsb] will raise [End_of_file] if no more data will be produced.
@@ -58,16 +65,7 @@ type read_method += Read_source_buffer of ((Cstruct.t list -> int) -> unit)
 
 (** {2 Writing} *)
 
-(** Consumer base class. *)
+val write : _ sink -> Cstruct.t list -> unit
-class virtual sink : object
-  inherit Generic.t
-  method virtual copy : 'a. (#source as 'a) -> unit
-
-  method write : Cstruct.t list -> unit
-  (** The default implementation is [copy (cstruct_source ...)], but it can be overridden for speed. *)
-end
-
-val write : #sink -> Cstruct.t list -> unit
 (** [write dst bufs] writes all bytes from [bufs].
 
     You should not perform multiple concurrent writes on the same flow
@@ -78,33 +76,23 @@ val write : #sink -> Cstruct.t list -> unit
     - {!Buf_write} to combine multiple small writes.
     - {!copy} for bulk transfers, as it allows some extra optimizations. *)
 
-val copy : #source -> #sink -> unit
+val copy : _ source -> _ sink -> unit
 (** [copy src dst] copies data from [src] to [dst] until end-of-file. *)
 
-val copy_string : string -> #sink -> unit
+val copy_string : string -> _ sink -> unit
 (** [copy_string s = copy (string_source s)] *)
 
-val buffer_sink : Buffer.t -> sink
+val buffer_sink : Buffer.t -> sink_ty r
 (** [buffer_sink b] is a sink that adds anything sent to it to [b].
 
     To collect data as a cstruct, use {!Buf_read} instead. *)
 
 (** {2 Bidirectional streams} *)
 
-type shutdown_command = [
+type two_way_ty = [source_ty | sink_ty | shutdown_ty]
-  | `Receive  (** Indicate that no more reads will be done *)
+type 'a two_way = ([> two_way_ty] as 'a) r
-  | `Send     (** Indicate that no more writes will be done *)
-  | `All      (** Indicate that no more reads or writes will be done *)
-]
 
-class virtual two_way : object
+val shutdown : _ two_way -> shutdown_command -> unit
-  inherit source
-  inherit sink
-
-  method virtual shutdown : shutdown_command -> unit
-end
-
-val shutdown : #two_way -> shutdown_command -> unit
 (** [shutdown t cmd] indicates that the caller has finished reading or writing [t]
     (depending on [cmd]).
 
@@ -116,7 +104,44 @@ val shutdown : #two_way -> shutdown_command -> unit
     Flows are usually attached to switches and closed automatically when the switch
     finishes. However, it can be useful to close them sooner manually in some cases. *)
 
-class type close = Generic.close
+val close : [> `Close] r -> unit
+(** Alias of {!Resource.close}. *)
+
+(** {2 Provider Interface} *)
+
+module Pi : sig
+  module type SOURCE = sig
+    type t
+    val read_methods : t read_method list
+    val single_read : t -> Cstruct.t -> int
+  end
+
+  module type SINK = sig
+    type t
+    val copy : t -> src:_ source -> unit
+    val write : t -> Cstruct.t list -> unit
+  end
+
+  module type SHUTDOWN = sig
+    type t
+    val shutdown : t -> shutdown_command -> unit
+  end
+
+  val source : (module SOURCE with type t = 't) -> ('t, source_ty) Resource.handler
+  val sink : (module SINK with type t = 't) -> ('t, sink_ty) Resource.handler
+  val shutdown : (module SHUTDOWN with type t = 't) -> ('t, shutdown_ty) Resource.handler
+
+  module type TWO_WAY = sig
+    include SHUTDOWN
+    include SOURCE with type t := t
+    include SINK with type t := t
+  end
+
+  val two_way : (module TWO_WAY with type t = 't) -> ('t, two_way_ty) Resource.handler
+
+  type (_, _, _) Resource.pi +=
+    | Source : ('t, (module SOURCE with type t = 't), [> source_ty]) Resource.pi
+    | Sink : ('t, (module SINK with type t = 't), [> sink_ty]) Resource.pi
+    | Shutdown : ('t, (module SHUTDOWN with type t = 't), [> shutdown_ty]) Resource.pi
+end
 
-val close : #close -> unit
-(** Alias of {!Generic.close}. *)

lib_eio/fs.ml

@@ -1,5 +1,7 @@
 (** Defines types used by file-systems. *)
 
+open Std
+
 type path = string
 
 type error =
@@ -36,24 +38,32 @@ type create = [
 ]
 (** If a new file is created, the given permissions are used for it. *)
 
+type dir_ty = [`Dir]
+type 'a dir = ([> dir_ty] as 'a) r
+
 (** Note: use the functions in {!Path} to access directories. *)
-class virtual dir = object (_ : #Generic.t)
+module Pi = struct
-  method probe _ = None
+  module type DIR = sig
-  method virtual open_in : sw:Switch.t -> path -> <File.ro; Flow.close>
+    type t
-  method virtual open_out :
+
-    sw:Switch.t ->
+    val open_in : t -> sw:Switch.t -> path -> File.ro_ty r
-    append:bool ->
+
-    create:create ->
+    val open_out :
-    path -> <File.rw; Flow.close>
+      t ->
-  method virtual mkdir : perm:File.Unix_perm.t -> path -> unit
+      sw:Switch.t ->
-  method virtual open_dir : sw:Switch.t -> path -> dir_with_close
+      append:bool ->
-  method virtual read_dir : path -> string list
+      create:create ->
-  method virtual unlink : path -> unit
+      path -> File.rw_ty r
-  method virtual rmdir : path -> unit
+
-  method virtual rename : path -> dir -> path -> unit
+    val mkdir : t -> perm:File.Unix_perm.t -> path -> unit
-  method virtual pp : Format.formatter -> unit
+    val open_dir : t -> sw:Switch.t -> path -> [`Close | dir_ty] r
-end
+    val read_dir : t -> path -> string list
-and virtual dir_with_close = object (_ : <Generic.close; ..>)
+    val unlink : t -> path -> unit
-  (* This dummy class avoids an "Error: The type < .. > is not an object type" error from the compiler. *)
+    val rmdir : t -> path -> unit
-  inherit dir
+    val rename : t -> path -> _ dir -> path -> unit
+    val pp : t Fmt.t
+  end
+
+  type (_, _, _) Resource.pi +=
+    | Dir : ('t, (module DIR with type t = 't), [> dir_ty]) Resource.pi
 end

lib_eio/generic.ml

@@ -1,13 +0,0 @@
-type 'a ty = ..
-
-class type t = object
-  method probe : 'a. 'a ty -> 'a option
-end
-
-let probe (t : #t) ty = t#probe ty
-
-class type close = object
-  method close : unit
-end
-
-let close (t : #close) = t#close

lib_eio/generic.mli

@@ -1,30 +0,0 @@
-type 'a ty = ..
-(** An ['a ty] is a query for a feature of type ['a]. *)
-
-class type t = object
-  method probe : 'a. 'a ty -> 'a option
-end
-
-val probe : #t -> 'a ty -> 'a option
-(** [probe t feature] checks whether [t] supports [feature].
-    This is mostly for internal use.
-    For example, {!Eio_unix.FD.peek_opt} uses this to get the underlying Unix file descriptor from a flow. *)
-
-(** {2 Closing}
-
-    Resources are usually attached to switches and closed automatically when the switch
-    finishes. However, it can be useful to close them sooner in some cases. *)
-
-class type close = object
-  method close : unit
-end
-
-val close : #close -> unit
-(** [close t] marks the resource as closed. It can no longer be used after this.
-
-    If [t] is already closed then this does nothing (it does not raise an exception).
-
-    Note: if an operation is currently in progress when this is called then it is not
-    necessarily cancelled, and any underlying OS resource (such as a file descriptor)
-    might not be closed immediately if other operations are using it. Closing a resource
-    only prevents new operations from starting. *)

lib_eio/mock/eio_mock.mli

@@ -34,6 +34,8 @@
     ]}
 *)
 
+open Eio.Std
+
 (** {2 Configuration} *)
 
 (** Actions that can be performed by mock handlers. *)
@@ -89,14 +91,8 @@ module Flow : sig
     | `Read_source_buffer       (** Use the {!Eio.Flow.Read_source_buffer} optimisation. *)
   ]
 
-  type t = <
+  type ty = [`Generic | `Mock] Eio.Net.stream_socket_ty
-    Eio.Flow.two_way;
+  type t = ty r
-    Eio.Flow.close;
-    on_read : string Handler.t;
-    on_copy_bytes : int Handler.t;
-    set_copy_method : copy_method -> unit;
-    attach_to_switch : Eio.Switch.t -> unit;
-  >
 
   val make : ?pp:string Fmt.t -> string -> t
   (** [make label] is a mock Eio flow.
@@ -116,30 +112,20 @@ end
 
 (** Mock {!Eio.Net} networks and sockets. *)
 module Net : sig
-  type t = <
+  type t = [`Generic | `Mock] Eio.Net.ty r
-    Eio.Net.t;
-    on_listen : Eio.Net.listening_socket Handler.t;
-    on_connect : Eio.Net.stream_socket Handler.t;
-    on_datagram_socket : Eio.Net.datagram_socket Handler.t;
-    on_getaddrinfo : Eio.Net.Sockaddr.t list Handler.t;
-    on_getnameinfo : (string * string) Handler.t;
-  >
 
-  type listening_socket = <
+  type listening_socket = [`Generic | `Mock] Eio.Net.listening_socket_ty r
-    Eio.Net.listening_socket;
-    on_accept : (Flow.t * Eio.Net.Sockaddr.stream) Handler.t;
-  >
 
   val make : string -> t
   (** [make label] is a new mock network. *)
 
-  val on_connect : t -> <Eio.Net.stream_socket; ..> Handler.actions -> unit
+  val on_connect : t -> _ Eio.Net.stream_socket Handler.actions -> unit
   (** [on_connect t actions] configures what to do when a client tries to connect somewhere. *)
 
-  val on_listen : t -> #Eio.Net.listening_socket Handler.actions -> unit
+  val on_listen : t -> _ Eio.Net.listening_socket Handler.actions -> unit
   (** [on_listen t actions] configures what to do when a server starts listening for incoming connections. *)
 
-  val on_datagram_socket : t -> <Eio.Net.datagram_socket; ..> Handler.actions -> unit
+  val on_datagram_socket : t -> _ Eio.Net.datagram_socket Handler.actions -> unit
   (** [on_datagram_socket t actions] configures how to create datagram sockets. *)
 
   val on_getaddrinfo : t -> Eio.Net.Sockaddr.t list Handler.actions -> unit

lib_eio/mock/flow.ml

@@ -5,112 +5,132 @@ type copy_method = [
   | `Read_source_buffer
 ]
 
-type t = <
+module Mock_flow = struct
-  Eio.Flow.two_way;
+  type tag = [`Generic | `Mock]
-  Eio.Flow.close;
-  on_read : string Handler.t;
-  on_copy_bytes : int Handler.t;
-  set_copy_method : copy_method -> unit;
-  attach_to_switch : Switch.t -> unit;
->
 
-let pp_default f s =
+  type t = {
-  let rec aux i =
+    label : string;
-    let nl =
+    pp : string Fmt.t;
-      match String.index_from_opt s i '\n' with
+    on_close : (unit -> unit) Queue.t;
-      | None -> String.length s
+    on_read : string Handler.t;
-      | Some x -> x + 1
+    on_copy_bytes : int Handler.t;
+    mutable copy_method : copy_method;
+  }
+
+  let pp_default f s =
+    let rec aux i =
+      let nl =
+        match String.index_from_opt s i '\n' with
+        | None -> String.length s
+        | Some x -> x + 1
+      in
+      Fmt.Dump.string f (String.sub s i (nl - i));
+      if nl < String.length s then (
+        Fmt.cut f ();
+        aux nl
+      )
     in
-    Fmt.Dump.string f (String.sub s i (nl - i));
+    aux 0
-    if nl < String.length s then (
-      Fmt.cut f ();
-      aux nl
-    )
-  in
-  aux 0
 
-let rec takev len = function
+  let rec takev len = function
-  | [] -> []
+    | [] -> []
-  | x :: _ when Cstruct.length x >= len -> [Cstruct.sub x 0 len]
+    | x :: _ when Cstruct.length x >= len -> [Cstruct.sub x 0 len]
-  | x :: xs -> x :: takev (len - Cstruct.length x) xs
+    | x :: xs -> x :: takev (len - Cstruct.length x) xs
 
-let make ?(pp=pp_default) label =
-  let on_read = Handler.make (`Raise End_of_file) in
-  let on_copy_bytes = Handler.make (`Return 4096) in
-  let copy_method = ref `Read_into in
   (* Test optimised copying using Read_source_buffer *)
-  let copy_rsb_iovec src =
+  let copy_rsb_iovec t src =
-    let size = Handler.run on_copy_bytes in
+    let size = Handler.run t.on_copy_bytes in
     let len = min (Cstruct.lenv src) size in
     let bufs = takev len src in
-    traceln "%s: wrote (rsb) @[<v>%a@]" label (Fmt.Dump.list (Fmt.using Cstruct.to_string pp)) bufs;
+    traceln "%s: wrote (rsb) @[<v>%a@]" t.label (Fmt.Dump.list (Fmt.using Cstruct.to_string t.pp)) bufs;
     len
-  in
+
-  let copy_rsb rsb =
+  let copy_rsb t rsb =
-    try while true do rsb copy_rsb_iovec done
+    try while true do rsb (copy_rsb_iovec t) done
     with End_of_file -> ()
-  in
+
   (* Test fallback copy using buffer. *)
-  let copy_via_buffer src =
+  let copy_via_buffer t src =
     try
       while true do
-        let size = Handler.run on_copy_bytes in
+        let size = Handler.run t.on_copy_bytes in
         let buf = Cstruct.create size in
         let n = Eio.Flow.single_read src buf in
-        traceln "%s: wrote @[<v>%a@]" label pp (Cstruct.to_string (Cstruct.sub buf 0 n))
+        traceln "%s: wrote @[<v>%a@]" t.label t.pp (Cstruct.to_string (Cstruct.sub buf 0 n))
       done
     with End_of_file -> ()
-  in
-  object (self)
-    inherit Eio.Flow.two_way
 
-    val on_close = Queue.create ()
+  let read_methods = []
 
-    method on_read = on_read
+  let single_read t buf =
-    method on_copy_bytes = on_copy_bytes
+    let data = Handler.run t.on_read in
+    let len = String.length data in
+    if Cstruct.length buf < len then
+      Fmt.failwith "%s: read buffer too short for %a!" t.label t.pp data;
+    Cstruct.blit_from_string data 0 buf 0 len;
+    traceln "%s: read @[<v>%a@]" t.label t.pp data;
+    len
 
-    method read_into buf =
+  let copy t ~src =
-      let data = Handler.run on_read in
+    match t.copy_method with
-      let len = String.length data in
+    | `Read_into -> copy_via_buffer t src
-      if Cstruct.length buf < len then
+    | `Read_source_buffer ->
-        Fmt.failwith "%s: read buffer too short for %a!" label pp data;
+      let Eio.Resource.T (src, ops) = src in
-      Cstruct.blit_from_string data 0 buf 0 len;
+      let module Src = (val (Eio.Resource.get ops Eio.Flow.Pi.Source)) in
-      traceln "%s: read @[<v>%a@]" label pp data;
+      let try_rsb = function
-      len
+        | Eio.Flow.Read_source_buffer rsb -> copy_rsb t (rsb src); true
+        | _ -> false
+      in
+      if not (List.exists try_rsb Src.read_methods) then
+        Fmt.failwith "Source does not offer Read_source_buffer optimisation"
 
-    method copy src =
+  let write t bufs =
-      match !copy_method with
+    copy t ~src:(Eio.Flow.cstruct_source bufs)
-      | `Read_into -> copy_via_buffer src
-      | `Read_source_buffer ->
-        let try_rsb = function
-          | Eio.Flow.Read_source_buffer rsb -> copy_rsb rsb; true
-          | _ -> false
-        in
-        if not (List.exists try_rsb (Eio.Flow.read_methods src)) then
-          Fmt.failwith "Source does not offer Read_source_buffer optimisation"
 
-    method set_copy_method m =
+  let shutdown t cmd =
-      copy_method := m
+    traceln "%s: shutdown %s" t.label @@
+    match cmd with
+    | `Receive -> "receive"
+    | `Send -> "send"
+    | `All -> "all"
 
-    method shutdown cmd =
+  let close t =
-      traceln "%s: shutdown %s" label @@
+    while not (Queue.is_empty t.on_close) do
-      match cmd with
+      Queue.take t.on_close ()
-      | `Receive -> "receive"
+    done;
-      | `Send -> "send"
+    traceln "%s: closed" t.label
-      | `All -> "all"
 
-    method attach_to_switch sw =
+  let make ?(pp=pp_default) label =
-      let hook = Switch.on_release_cancellable sw (fun () -> Eio.Flow.close self) in
+    {
-      Queue.add (fun () -> Eio.Switch.remove_hook hook) on_close
+      pp;
+      label;
+      on_close = Queue.create ();
+      on_read = Handler.make (`Raise End_of_file);
+      on_copy_bytes = Handler.make (`Return 4096);
+      copy_method = `Read_into;
+    }
+end
 
-    method close =
+type ty = [`Generic | `Mock] Eio.Net.stream_socket_ty
-      while not (Queue.is_empty on_close) do
-        Queue.take on_close ()
-      done;
-      traceln "%s: closed" label
-  end
 
-let on_read (t:t) = Handler.seq t#on_read
+type t = ty r
-let on_copy_bytes (t:t) = Handler.seq t#on_copy_bytes
+
-let set_copy_method (t:t) = t#set_copy_method
+type (_, _, _) Eio.Resource.pi += Type : ('t, 't -> Mock_flow.t, ty) Eio.Resource.pi
-let attach_to_switch (t:t) = t#attach_to_switch
+let raw (Eio.Resource.T (t, ops)) = Eio.Resource.get ops Type t
+
+let attach_to_switch t sw =
+  let t = raw t in
+  let hook = Switch.on_release_cancellable sw (fun () -> Mock_flow.close t) in
+  Queue.add (fun () -> Eio.Switch.remove_hook hook) t.on_close
+
+let on_read t = Handler.seq (raw t).on_read
+let on_copy_bytes t = Handler.seq (raw t).on_copy_bytes
+let set_copy_method t v = (raw t).copy_method <- v
+
+let handler = Eio.Resource.handler (
+    H (Type, Fun.id) ::
+    Eio.Resource.bindings (Eio.Net.Pi.stream_socket (module Mock_flow))
+  )
+
+let make ?pp label : t =
+  Eio.Resource.T (Mock_flow.make ?pp label, handler)

lib_eio/mock/net.ml

@@ -1,98 +1,138 @@
 open Eio.Std
 
-type t = <
+type ty = [`Generic | `Mock] Eio.Net.ty
-  Eio.Net.t;
+type t = ty r
-  on_listen : Eio.Net.listening_socket Handler.t;
-  on_connect : Eio.Net.stream_socket Handler.t;
-  on_datagram_socket : Eio.Net.datagram_socket Handler.t;
-  on_getaddrinfo : Eio.Net.Sockaddr.t list Handler.t;
-  on_getnameinfo : (string * string) Handler.t;
->
 
-let make label =
+module Impl = struct
-  let on_listen = Handler.make (`Raise (Failure "Mock listen handler not configured")) in
+  type tag = [`Generic]
-  let on_connect = Handler.make (`Raise (Failure "Mock connect handler not configured")) in
-  let on_datagram_socket = Handler.make (`Raise (Failure "Mock datagram_socket handler not configured")) in
-  let on_getaddrinfo = Handler.make (`Raise (Failure "Mock getaddrinfo handler not configured")) in
-  let on_getnameinfo = Handler.make (`Raise (Failure "Mock getnameinfo handler not configured")) in
-  object
-    inherit Eio.Net.t
 
-    method on_listen = on_listen
+  type t = {
-    method on_connect = on_connect
+    label : string;
-    method on_datagram_socket = on_datagram_socket
+    on_listen : tag Eio.Net.listening_socket_ty r Handler.t;
-    method on_getaddrinfo = on_getaddrinfo
+    on_connect : tag Eio.Net.stream_socket_ty r Handler.t;
-    method on_getnameinfo = on_getnameinfo
+    on_datagram_socket : tag Eio.Net.datagram_socket_ty r Handler.t;
+    on_getaddrinfo : Eio.Net.Sockaddr.t list Handler.t;
+    on_getnameinfo : (string * string) Handler.t;
+  }
 
-    method listen ~reuse_addr:_ ~reuse_port:_ ~backlog:_ ~sw addr =
+  let make label = {
-      traceln "%s: listen on %a" label Eio.Net.Sockaddr.pp addr;
+    label;
-      let socket = Handler.run on_listen in
+    on_listen = Handler.make (`Raise (Failure "Mock listen handler not configured"));
-      Switch.on_release sw (fun () -> Eio.Flow.close socket);
+    on_connect = Handler.make (`Raise (Failure "Mock connect handler not configured"));
-      socket
+    on_datagram_socket = Handler.make (`Raise (Failure "Mock datagram_socket handler not configured"));
+    on_getaddrinfo = Handler.make (`Raise (Failure "Mock getaddrinfo handler not configured"));
+    on_getnameinfo = Handler.make (`Raise (Failure "Mock getnameinfo handler not configured"));
+  }
 
-    method connect ~sw addr =
+  let on_listen t = t.on_listen
-      traceln "%s: connect to %a" label Eio.Net.Sockaddr.pp addr;
+  let on_connect t = t.on_connect
-      let socket = Handler.run on_connect in
+  let on_datagram_socket t = t.on_datagram_socket
-      Switch.on_release sw (fun () -> Eio.Flow.close socket);
+  let on_getaddrinfo t = t.on_getaddrinfo
-      socket
+  let on_getnameinfo t = t.on_getnameinfo
 
-    method datagram_socket ~reuse_addr:_ ~reuse_port:_ ~sw addr =
+  let listen t ~reuse_addr:_ ~reuse_port:_ ~backlog:_ ~sw addr =
-      (match addr with
+    traceln "%s: listen on %a" t.label Eio.Net.Sockaddr.pp addr;
-      | #Eio.Net.Sockaddr.datagram as saddr -> traceln "%s: datagram_socket %a" label Eio.Net.Sockaddr.pp saddr
+    let socket = Handler.run t.on_listen in
-      | `UdpV4 -> traceln "%s: datagram_socket UDPv4" label
+    Switch.on_release sw (fun () -> Eio.Resource.close socket);
-      | `UdpV6 -> traceln "%s: datagram_socket UDPv6" label
+    socket
-      );
-      let socket = Handler.run on_datagram_socket in
-      Switch.on_release sw (fun () -> Eio.Flow.close socket);
-      socket
 
-    method getaddrinfo ~service node =
+  let connect t ~sw addr =
-      traceln "%s: getaddrinfo ~service:%s %s" label service node;
+    traceln "%s: connect to %a" t.label Eio.Net.Sockaddr.pp addr;
-      Handler.run on_getaddrinfo
+    let socket = Handler.run t.on_connect in
+    Switch.on_release sw (fun () -> Eio.Flow.close socket);
+    socket
 
-    method getnameinfo sockaddr =
+  let datagram_socket t ~reuse_addr:_ ~reuse_port:_ ~sw addr =
-      traceln "%s: getnameinfo %a" label Eio.Net.Sockaddr.pp sockaddr;
+    (match addr with
-      Handler.run on_getnameinfo
+     | #Eio.Net.Sockaddr.datagram as saddr -> traceln "%s: datagram_socket %a" t.label Eio.Net.Sockaddr.pp saddr
-  end
+     | `UdpV4 -> traceln "%s: datagram_socket UDPv4" t.label
+     | `UdpV6 -> traceln "%s: datagram_socket UDPv6" t.label
+    );
+    let socket = Handler.run t.on_datagram_socket in
+    Switch.on_release sw (fun () -> Eio.Flow.close socket);
+    socket
+
+  let getaddrinfo t ~service node =
+    traceln "%s: getaddrinfo ~service:%s %s" t.label service node;
+    Handler.run t.on_getaddrinfo
+
+  let getnameinfo t sockaddr =
+    traceln "%s: getnameinfo %a" t.label Eio.Net.Sockaddr.pp sockaddr;
+    Handler.run t.on_getnameinfo
+
+  type (_, _, _) Eio.Resource.pi += Raw : ('t, 't -> t, ty) Eio.Resource.pi
+  let raw (Eio.Resource.T (t, ops)) = Eio.Resource.get ops Raw t
+end
+
+let make : string -> t =
+  let super = Eio.Net.Pi.network (module Impl) in
+  let handler = Eio.Resource.handler (
+      H (Impl.Raw, Fun.id) ::
+      Eio.Resource.bindings super
+    ) in
+  fun label -> Eio.Resource.T (Impl.make label, handler)
 
 let on_connect (t:t) actions =
-  let as_socket x = (x :> Eio.Net.stream_socket) in
+  let t = Impl.raw t in
-  Handler.seq t#on_connect (List.map (Action.map as_socket) actions)
+  let as_socket x = (x :> [`Generic] Eio.Net.stream_socket_ty r) in
+  Handler.seq t.on_connect (List.map (Action.map as_socket) actions)
 
 let on_listen (t:t) actions =
-  let as_socket x = (x :> Eio.Net.listening_socket) in
+  let t = Impl.raw t in
-  Handler.seq t#on_listen (List.map (Action.map as_socket) actions)
+  let as_socket x = (x :> [`Generic] Eio.Net.listening_socket_ty r) in
+  Handler.seq t.on_listen (List.map (Action.map as_socket) actions)
 
-let on_datagram_socket (t:t) actions =
+let on_datagram_socket (t:t) (actions : _ r Handler.actions) =
-  let as_socket x = (x :> Eio.Net.datagram_socket) in
+  let t = Impl.raw t in
-  Handler.seq t#on_datagram_socket (List.map (Action.map as_socket) actions)
+  let as_socket x = (x :> [`Generic] Eio.Net.datagram_socket_ty r) in
+  Handler.seq t.on_datagram_socket (List.map (Action.map as_socket) actions)
 
-let on_getaddrinfo (t:t) actions = Handler.seq t#on_getaddrinfo actions
+let on_getaddrinfo (t:t) actions = Handler.seq (Impl.raw t).on_getaddrinfo actions
 
-let on_getnameinfo (t:t) actions = Handler.seq t#on_getnameinfo actions
+let on_getnameinfo (t:t) actions = Handler.seq (Impl.raw t).on_getnameinfo actions
 
-type listening_socket = <
+type listening_socket_ty = [`Generic | `Mock] Eio.Net.listening_socket_ty
-  Eio.Net.listening_socket;
+type listening_socket = listening_socket_ty r
-  on_accept : (Flow.t * Eio.Net.Sockaddr.stream) Handler.t;
->
 
-let listening_socket label =
+module Listening_socket = struct
-  let on_accept = Handler.make (`Raise (Failure "Mock accept handler not configured")) in
+  type t = {
-  object
+    label : string;
-    inherit Eio.Net.listening_socket
+    on_accept : (Flow.t * Eio.Net.Sockaddr.stream) Handler.t;
+  }
 
-    method on_accept = on_accept
+  type tag = [`Generic]
 
-    method accept ~sw =
+  let make label =
-      let socket, addr = Handler.run on_accept in
+    {
-      Flow.attach_to_switch socket sw;
+      label;
-      traceln "%s: accepted connection from %a" label Eio.Net.Sockaddr.pp addr;
+      on_accept = Handler.make (`Raise (Failure "Mock accept handler not configured"))
-      (socket :> Eio.Net.stream_socket), addr
+    }
 
-    method close =
+  let on_accept t = t.on_accept
-      traceln "%s: closed" label
-  end
 
-let on_accept (l:listening_socket) actions =
+  let accept t ~sw =
+      let socket, addr = Handler.run t.on_accept in
+      Flow.attach_to_switch (socket : Flow.t) sw;
+      traceln "%s: accepted connection from %a" t.label Eio.Net.Sockaddr.pp addr;
+      (socket :> tag Eio.Net.stream_socket_ty r), addr
+
+  let close t =
+    traceln "%s: closed" t.label
+
+  type (_, _, _) Eio.Resource.pi += Type : ('t, 't -> t, listening_socket_ty) Eio.Resource.pi
+  let raw (Eio.Resource.T (t, ops)) = Eio.Resource.get ops Type t
+end
+
+let listening_socket_handler =
+  Eio.Resource.handler @@
+  Eio.Resource.bindings (Eio.Net.Pi.listening_socket (module Listening_socket)) @ [
+    H (Listening_socket.Type, Fun.id);
+  ]
+
+let listening_socket label : listening_socket =
+  Eio.Resource.T (Listening_socket.make label, listening_socket_handler)
+
+let on_accept l actions =
+  let r = Listening_socket.raw l in
   let as_accept_pair x = (x :> Flow.t * Eio.Net.Sockaddr.stream) in
-  Handler.seq l#on_accept (List.map (Action.map as_accept_pair) actions)
+  Handler.seq r.on_accept (List.map (Action.map as_accept_pair) actions)

lib_eio/net.ml

@@ -1,3 +1,5 @@
+open Std
+
 type connection_failure =
   | Refused of Exn.Backend.t
   | No_matching_addresses
@@ -157,30 +159,114 @@ module Sockaddr = struct
       Format.fprintf f "udp:%a:%d" Ipaddr.pp_for_uri addr port
 end
 
-class virtual socket = object (_ : <Generic.t; Generic.close; ..>)
+type socket_ty = [`Socket | `Close]
-  method probe _ = None
+type 'a socket = ([> socket_ty] as 'a) r
+
+type 'tag stream_socket_ty = [`Stream | `Platform of 'tag | `Shutdown | socket_ty | Flow.source_ty | Flow.sink_ty]
+type 'a stream_socket = 'a r
+  constraint 'a = [> [> `Generic] stream_socket_ty]
+
+type 'tag listening_socket_ty = [ `Accept | `Platform of 'tag | socket_ty]
+type 'a listening_socket = 'a r
+  constraint 'a = [> [> `Generic] listening_socket_ty]
+
+type 'a connection_handler = 'a stream_socket -> Sockaddr.stream -> unit
+
+type 'tag datagram_socket_ty = [`Datagram | `Platform of 'tag | `Shutdown | socket_ty]
+type 'a datagram_socket = 'a r
+  constraint 'a = [> [> `Generic] datagram_socket_ty]
+
+type 'tag ty = [`Network | `Platform of 'tag]
+type 'a t = 'a r
+  constraint 'a = [> [> `Generic] ty]
+
+module Pi = struct
+  module type STREAM_SOCKET = sig
+    type tag
+    include Flow.Pi.SHUTDOWN
+    include Flow.Pi.SOURCE with type t := t
+    include Flow.Pi.SINK with type t := t
+    val close : t -> unit
+  end
+
+  let stream_socket (type t tag) (module X : STREAM_SOCKET with type t = t and type tag = tag) =
+    Resource.handler @@
+    H (Resource.Close, X.close) ::
+    Resource.bindings (Flow.Pi.two_way (module X))
+
+  module type DATAGRAM_SOCKET = sig
+    type tag
+    include Flow.Pi.SHUTDOWN
+    val send : t -> ?dst:Sockaddr.datagram -> Cstruct.t list -> unit
+    val recv : t -> Cstruct.t -> Sockaddr.datagram * int
+    val close : t -> unit
+  end
+
+  type (_, _, _) Resource.pi +=
+    | Datagram_socket : ('t, (module DATAGRAM_SOCKET with type t = 't), [> _ datagram_socket_ty]) Resource.pi
+
+  let datagram_socket (type t tag) (module X : DATAGRAM_SOCKET with type t = t and type tag = tag) =
+    Resource.handler @@
+    Resource.bindings (Flow.Pi.shutdown (module X)) @ [
+      H (Datagram_socket, (module X));
+      H (Resource.Close, X.close)
+    ]
+
+  module type LISTENING_SOCKET = sig
+    type t
+    type tag
+
+    val accept : t -> sw:Switch.t -> tag stream_socket_ty r * Sockaddr.stream
+    val close : t -> unit
+  end
+
+  type (_, _, _) Resource.pi +=
+    | Listening_socket : ('t, (module LISTENING_SOCKET with type t = 't and type tag = 'tag), [> 'tag listening_socket_ty]) Resource.pi
+
+  let listening_socket (type t tag) (module X : LISTENING_SOCKET with type t = t and type tag = tag) =
+    Resource.handler [
+      H (Resource.Close, X.close);
+      H (Listening_socket, (module X))
+    ]
+
+  module type NETWORK = sig
+    type t
+    type tag
+
+    val listen : t -> reuse_addr:bool -> reuse_port:bool -> backlog:int -> sw:Switch.t -> Sockaddr.stream -> tag listening_socket_ty r
+    val connect : t -> sw:Switch.t -> Sockaddr.stream -> tag stream_socket_ty r
+    val datagram_socket :
+      t
+      -> reuse_addr:bool
+      -> reuse_port:bool
+      -> sw:Switch.t
+      -> [Sockaddr.datagram | `UdpV4 | `UdpV6]
+      -> tag datagram_socket_ty r
+
+    val getaddrinfo : t -> service:string -> string -> Sockaddr.t list
+    val getnameinfo : t -> Sockaddr.t -> (string * string)
+  end
+
+  type (_, _, _) Resource.pi +=
+    | Network : ('t, (module NETWORK with type t = 't and type tag = 'tag), [> 'tag ty]) Resource.pi
+
+  let network (type t tag) (module X : NETWORK with type t = t and type tag = tag) =
+    Resource.handler [
+      H (Network, (module X));
+    ]
 end
 
-class virtual stream_socket = object (_ : #socket)
+let accept ~sw (type tag) (Resource.T (t, ops) : [> tag listening_socket_ty] r) =
-  inherit Flow.two_way
+  let module X = (val (Resource.get ops Pi.Listening_socket)) in
-end
+  X.accept t ~sw
 
-class virtual listening_socket = object (_ : <Generic.close; ..>)
+let accept_fork ~sw (t : [> 'a listening_socket_ty] r) ~on_error handle =
-  inherit socket
-  method virtual accept : sw:Switch.t -> stream_socket * Sockaddr.stream
-end
-
-type connection_handler = stream_socket -> Sockaddr.stream -> unit
-
-let accept ~sw (t : #listening_socket) = t#accept ~sw
-
-let accept_fork ~sw (t : #listening_socket) ~on_error handle =
   let child_started = ref false in
   let flow, addr = accept ~sw t in
   Fun.protect ~finally:(fun () -> if !child_started = false then Flow.close flow)
     (fun () ->
        Fiber.fork ~sw (fun () ->
-           match child_started := true; handle (flow :> stream_socket) addr with
+           match child_started := true; handle (flow :> 'a stream_socket_ty r) addr with
            | x -> Flow.close flow; x
            | exception (Cancel.Cancelled _ as ex) ->
              Flow.close flow;
@@ -191,42 +277,37 @@ let accept_fork ~sw (t : #listening_socket) ~on_error handle =
          )
     )
 
-class virtual datagram_socket = object
+let send (Resource.T (t, ops)) ?dst bufs =
-  inherit socket
+  let module X = (val (Resource.get ops Pi.Datagram_socket)) in
-  method virtual send : ?dst:Sockaddr.datagram -> Cstruct.t list -> unit
+  X.send t ?dst bufs
-  method virtual recv : Cstruct.t -> Sockaddr.datagram * int
-end
 
-let send (t:#datagram_socket) = t#send
+let recv (Resource.T (t, ops)) buf =
-let recv (t:#datagram_socket) = t#recv
+  let module X = (val (Resource.get ops Pi.Datagram_socket)) in
+  X.recv t buf
 
-class virtual t = object
+let listen (type tag) ?(reuse_addr=false) ?(reuse_port=false) ~backlog ~sw (t:[> tag ty] r) =
-  method virtual listen : reuse_addr:bool -> reuse_port:bool -> backlog:int -> sw:Switch.t -> Sockaddr.stream -> listening_socket
+  let (Resource.T (t, ops)) = t in
-  method virtual connect : sw:Switch.t -> Sockaddr.stream -> stream_socket
+  let module X = (val (Resource.get ops Pi.Network)) in
-  method virtual datagram_socket :
+  X.listen t ~reuse_addr ~reuse_port ~backlog ~sw
-       reuse_addr:bool
-    -> reuse_port:bool
-    -> sw:Switch.t
-    -> [Sockaddr.datagram | `UdpV4 | `UdpV6]
-    -> datagram_socket
 
-  method virtual getaddrinfo : service:string -> string -> Sockaddr.t list
+let connect (type tag) ~sw (t:[> tag ty] r) addr =
-  method virtual getnameinfo : Sockaddr.t -> (string * string)
+  let (Resource.T (t, ops)) = t in
-end
+  let module X = (val (Resource.get ops Pi.Network)) in
-
+  try X.connect t ~sw addr
-let listen ?(reuse_addr=false) ?(reuse_port=false) ~backlog ~sw (t:#t) = t#listen ~reuse_addr ~reuse_port ~backlog ~sw
-
-let connect ~sw (t:#t) addr =
-  try t#connect ~sw addr
   with Exn.Io _ as ex ->
     let bt = Printexc.get_raw_backtrace () in
     Exn.reraise_with_context ex bt "connecting to %a" Sockaddr.pp addr
 
-let datagram_socket ?(reuse_addr=false) ?(reuse_port=false) ~sw (t:#t) addr =
+let datagram_socket (type tag) ?(reuse_addr=false) ?(reuse_port=false) ~sw (t:[> tag ty] r) addr =
+  let (Resource.T (t, ops)) = t in
+  let module X = (val (Resource.get ops Pi.Network)) in
   let addr = (addr :> [Sockaddr.datagram | `UdpV4 | `UdpV6]) in 
-  t#datagram_socket ~reuse_addr ~reuse_port ~sw addr
+  X.datagram_socket t ~reuse_addr ~reuse_port ~sw addr
 
-let getaddrinfo ?(service="") (t:#t) hostname = t#getaddrinfo ~service hostname
+let getaddrinfo (type tag) ?(service="") (t:[> tag ty] r) hostname =
+  let (Resource.T (t, ops)) = t in
+  let module X = (val (Resource.get ops Pi.Network)) in
+  X.getaddrinfo t ~service hostname
 
 let getaddrinfo_stream ?service t hostname =
   getaddrinfo ?service t hostname
@@ -242,9 +323,12 @@ let getaddrinfo_datagram ?service t hostname =
       | _ -> None
     )
 
-let getnameinfo (t:#t) sockaddr = t#getnameinfo sockaddr
+let getnameinfo (type tag) (t:[> tag ty] r) sockaddr =
+  let (Resource.T (t, ops)) = t in
+  let module X = (val (Resource.get ops Pi.Network)) in
+  X.getnameinfo t sockaddr
 
-let close = Generic.close
+let close = Resource.close
 
 let with_tcp_connect ?(timeout=Time.Timeout.none) ~host ~service t f =
   Switch.run @@ fun sw ->

lib_eio/net.mli

@@ -11,6 +11,8 @@
       ]}
 *)
 
+open Std
+
 type connection_failure =
   | Refused of Exn.Backend.t
   | No_matching_addresses
@@ -100,45 +102,34 @@ module Sockaddr : sig
   val pp : Format.formatter -> [< t] -> unit
 end
 
-(** {2 Provider Interfaces} *)
+(** {2 Types} *)
 
-class virtual socket : object (<Generic.close; ..>)
+type socket_ty = [`Socket | `Close]
-  inherit Generic.t
+type 'a socket = ([> socket_ty] as 'a) r
-end
 
-class virtual stream_socket : object
+type 'tag stream_socket_ty = [`Stream | `Platform of 'tag | `Shutdown | socket_ty | Flow.source_ty | Flow.sink_ty]
-  inherit socket
+type 'a stream_socket = 'a r
-  inherit Flow.two_way
+  constraint 'a = [> [> `Generic] stream_socket_ty]
-end
 
-class virtual datagram_socket : object
+type 'tag listening_socket_ty = [ `Accept | `Platform of 'tag | socket_ty]
-  inherit socket
+type 'a listening_socket = 'a r
-  method virtual send : ?dst:Sockaddr.datagram -> Cstruct.t list -> unit
+  constraint 'a = [> [> `Generic] listening_socket_ty]
-  method virtual recv : Cstruct.t -> Sockaddr.datagram * int
-end
 
-class virtual listening_socket : object (<Generic.close; ..>)
+type 'a connection_handler = 'a stream_socket -> Sockaddr.stream -> unit
-  inherit socket
+(** A [_ connection_handler] handles incoming connections from a listening socket. *)
-  method virtual accept : sw:Switch.t -> stream_socket * Sockaddr.stream
-end
 
-class virtual t : object
+type 'tag datagram_socket_ty = [`Datagram | `Platform of 'tag | `Shutdown | socket_ty]
-  method virtual listen : reuse_addr:bool -> reuse_port:bool -> backlog:int -> sw:Switch.t -> Sockaddr.stream -> listening_socket
+type 'a datagram_socket = 'a r
-  method virtual connect : sw:Switch.t -> Sockaddr.stream -> stream_socket
+  constraint 'a = [> [> `Generic] datagram_socket_ty]
-  method virtual datagram_socket :
-       reuse_addr:bool
-    -> reuse_port:bool
-    -> sw:Switch.t
-    -> [Sockaddr.datagram | `UdpV4 | `UdpV6]
-    -> datagram_socket
 
-  method virtual getaddrinfo : service:string -> string -> Sockaddr.t list
+type 'tag ty = [`Network | `Platform of 'tag]
-  method virtual getnameinfo : Sockaddr.t -> (string * string)
+
-end
+type 'a t = 'a r
+  constraint 'a = [> [> `Generic] ty]
 
 (** {2 Out-bound Connections} *)
 
-val connect : sw:Switch.t -> #t -> Sockaddr.stream -> stream_socket
+val connect : sw:Switch.t -> [> 'tag ty] t -> Sockaddr.stream -> 'tag stream_socket_ty r
 (** [connect ~sw t addr] is a new socket connected to remote address [addr].
 
     The new socket will be closed when [sw] finishes, unless closed manually first. *)
@@ -147,8 +138,8 @@ val with_tcp_connect :
   ?timeout:Time.Timeout.t ->
   host:string ->
   service:string ->
-  #t ->
+  [> 'tag ty] r ->
-  (stream_socket -> 'b) ->
+  ('tag stream_socket_ty r -> 'b) ->
   'b
 (** [with_tcp_connect ~host ~service t f] creates a tcp connection [conn] to [host] and [service] and executes 
     [f conn].
@@ -169,7 +160,9 @@ val with_tcp_connect :
 
 (** {2 Incoming Connections} *)
 
-val listen : ?reuse_addr:bool -> ?reuse_port:bool -> backlog:int -> sw:Switch.t -> #t -> Sockaddr.stream -> listening_socket
+val listen :
+  ?reuse_addr:bool -> ?reuse_port:bool -> backlog:int -> sw:Switch.t ->
+  [> 'tag ty] r -> Sockaddr.stream -> 'tag listening_socket_ty r
 (** [listen ~sw ~backlog t addr] is a new listening socket bound to local address [addr].
 
     The new socket will be closed when [sw] finishes, unless closed manually first.
@@ -183,21 +176,18 @@ val listen : ?reuse_addr:bool -> ?reuse_port:bool -> backlog:int -> sw:Switch.t
 
 val accept :
   sw:Switch.t ->
-  #listening_socket ->
+  [> 'tag listening_socket_ty] r ->
-  stream_socket * Sockaddr.stream
+  'tag stream_socket_ty r * Sockaddr.stream
 (** [accept ~sw socket] waits until a new connection is ready on [socket] and returns it.
 
     The new socket will be closed automatically when [sw] finishes, if not closed earlier.
     If you want to handle multiple connections, consider using {!accept_fork} instead. *)
 
-type connection_handler = stream_socket -> Sockaddr.stream -> unit
-(** [connection_handler] handles incoming connections from a listening socket. *)
-
 val accept_fork :
   sw:Switch.t ->
-  #listening_socket ->
+  [> 'tag listening_socket_ty] r ->
   on_error:(exn -> unit) ->
-  connection_handler ->
+  [< 'tag stream_socket_ty] connection_handler ->
   unit
 (** [accept_fork ~sw ~on_error socket fn] accepts a connection and handles it in a new fiber.
 
@@ -222,8 +212,8 @@ val run_server :
   ?additional_domains:(#Domain_manager.t * int) ->
   ?stop:'a Promise.t ->
   on_error:(exn -> unit) ->
-  #listening_socket ->
+  [> 'tag listening_socket_ty ] r ->
-  connection_handler ->
+  [< 'tag stream_socket_ty] connection_handler ->
   'a
 (** [run_server ~on_error sock connection_handler] establishes a concurrent socket server [s].
 
@@ -253,9 +243,9 @@ val datagram_socket :
      ?reuse_addr:bool
   -> ?reuse_port:bool
   -> sw:Switch.t
-  -> #t
+  -> [> 'tag ty] r
   -> [< Sockaddr.datagram | `UdpV4 | `UdpV6]
-  -> datagram_socket
+  -> 'tag datagram_socket_ty r
   (** [datagram_socket ~sw t addr] creates a new datagram socket bound to [addr]. The new 
       socket will be closed when [sw] finishes. 
 
@@ -267,19 +257,19 @@ val datagram_socket :
       @param reuse_addr Set the {!Unix.SO_REUSEADDR} socket option.
       @param reuse_port Set the {!Unix.SO_REUSEPORT} socket option. *)
 
-val send : #datagram_socket -> ?dst:Sockaddr.datagram -> Cstruct.t list -> unit
+val send : _ datagram_socket -> ?dst:Sockaddr.datagram -> Cstruct.t list -> unit
 (** [send sock buf] sends the data in [buf] using the the datagram socket [sock].
 
     @param dst If [sock] isn't connected, this provides the destination. *)
 
-val recv : #datagram_socket -> Cstruct.t -> Sockaddr.datagram * int
+val recv : _ datagram_socket -> Cstruct.t -> Sockaddr.datagram * int
 (** [recv sock buf] receives data from the socket [sock] putting it in [buf]. The number of bytes received is 
     returned along with the sender address and port. If the [buf] is too small then excess bytes may be discarded
     depending on the type of the socket the message is received from. *)
 
 (** {2 DNS queries} *)
 
-val getaddrinfo: ?service:string -> #t -> string -> Sockaddr.t list
+val getaddrinfo: ?service:string -> _ t -> string -> Sockaddr.t list
 (** [getaddrinfo ?service t node] returns a list of IP addresses for [node]. [node] is either a domain name or
     an IP address.
 
@@ -288,18 +278,84 @@ val getaddrinfo: ?service:string -> #t -> string -> Sockaddr.t list
 
     For a more thorough treatment, see {{:https://man7.org/linux/man-pages/man3/getaddrinfo.3.html} getaddrinfo}. *)
 
-val getaddrinfo_stream: ?service:string -> #t -> string -> Sockaddr.stream list
+val getaddrinfo_stream: ?service:string -> _ t -> string -> Sockaddr.stream list
 (** [getaddrinfo_stream] is like {!getaddrinfo}, but filters out non-stream protocols. *)
 
-val getaddrinfo_datagram: ?service:string -> #t -> string -> Sockaddr.datagram list
+val getaddrinfo_datagram: ?service:string -> _ t -> string -> Sockaddr.datagram list
 (** [getaddrinfo_datagram] is like {!getaddrinfo}, but filters out non-datagram protocols. *)
 
-val getnameinfo : #t -> Sockaddr.t -> (string * string)
+val getnameinfo : _ t -> Sockaddr.t -> (string * string)
 (** [getnameinfo t sockaddr] is [(hostname, service)] corresponding to [sockaddr]. [hostname] is the
     registered domain name represented by [sockaddr]. [service] is the IANA specified textual name of the
     port specified in [sockaddr], e.g. 'ftp', 'http', 'https', etc. *)
 
 (** {2 Closing} *)
 
-val close : #Generic.close -> unit
+val close : [> `Close] r -> unit
-(** Alias of {!Generic.close}. *)
+(** Alias of {!Resource.close}. *)
+
+(** {2 Provider Interface} *)
+
+module Pi : sig
+  module type STREAM_SOCKET = sig
+    type tag
+    include Flow.Pi.SHUTDOWN
+    include Flow.Pi.SOURCE with type t := t
+    include Flow.Pi.SINK with type t := t
+    val close : t -> unit
+  end
+
+  val stream_socket :
+    (module STREAM_SOCKET with type t = 't and type tag = 'tag) ->
+    ('t, 'tag stream_socket_ty) Resource.handler
+
+  module type DATAGRAM_SOCKET = sig
+    type tag
+    include Flow.Pi.SHUTDOWN
+    val send : t -> ?dst:Sockaddr.datagram -> Cstruct.t list -> unit
+    val recv : t -> Cstruct.t -> Sockaddr.datagram * int
+    val close : t -> unit
+  end
+
+  val datagram_socket :
+    (module DATAGRAM_SOCKET with type t = 't and type tag = 'tag) ->
+    ('t, 'tag datagram_socket_ty) Resource.handler
+
+  module type LISTENING_SOCKET = sig
+    type t
+    type tag
+
+    val accept : t -> sw:Switch.t -> tag stream_socket_ty r * Sockaddr.stream
+    val close : t -> unit
+  end
+
+  val listening_socket :
+    (module LISTENING_SOCKET with type t = 't and type tag = 'tag) ->
+    ('t, 'tag listening_socket_ty) Resource.handler
+
+  module type NETWORK = sig
+    type t
+    type tag
+
+    val listen :
+      t -> reuse_addr:bool -> reuse_port:bool -> backlog:int -> sw:Switch.t ->
+      Sockaddr.stream -> tag listening_socket_ty r
+
+    val connect : t -> sw:Switch.t -> Sockaddr.stream -> tag stream_socket_ty r
+
+    val datagram_socket :
+      t
+      -> reuse_addr:bool
+      -> reuse_port:bool
+      -> sw:Switch.t
+      -> [Sockaddr.datagram | `UdpV4 | `UdpV6]
+      -> tag datagram_socket_ty r
+
+    val getaddrinfo : t -> service:string -> string -> Sockaddr.t list
+    val getnameinfo : t -> Sockaddr.t -> (string * string)
+  end
+
+  val network :
+    (module NETWORK with type t = 't and type tag = 'tag) ->
+    ('t, 'tag ty) Resource.handler
+end

lib_eio/path.ml

@@ -1,4 +1,4 @@
-type 'a t = (#Fs.dir as 'a) * Fs.path
+type 'a t = 'a Fs.dir * Fs.path
 
 let ( / ) (dir, p1) p2 =
   match p1, p2 with
@@ -7,39 +7,50 @@ let ( / ) (dir, p1) p2 =
   | ".", p2 -> (dir, p2)
   | p1, p2 -> (dir, Filename.concat p1 p2)
 
-let pp f ((t:#Fs.dir), p) =
+let pp f (Resource.T (t, ops), p) =
-  if p = "" then Fmt.pf f "<%t>" t#pp
+  let module X = (val (Resource.get ops Fs.Pi.Dir)) in
-  else Fmt.pf f "<%t:%s>" t#pp (String.escaped p)
+  if p = "" then Fmt.pf f "<%a>" X.pp t
+  else Fmt.pf f "<%a:%s>" X.pp t (String.escaped p)
 
-let open_in ~sw ((t:#Fs.dir), path) =
+let open_in ~sw t =
-  try t#open_in ~sw path
+  let (Resource.T (dir, ops), path) = t in
+  let module X = (val (Resource.get ops Fs.Pi.Dir)) in
+  try X.open_in dir ~sw path
   with Exn.Io _ as ex ->
     let bt = Printexc.get_raw_backtrace () in
-    Exn.reraise_with_context ex bt "opening %a" pp (t, path)
+    Exn.reraise_with_context ex bt "opening %a" pp t
 
-let open_out ~sw ?(append=false) ~create ((t:#Fs.dir), path) =
+let open_out ~sw ?(append=false) ~create t =
-  try t#open_out ~sw ~append ~create path
+  let (Resource.T (dir, ops), path) = t in
+  let module X = (val (Resource.get ops Fs.Pi.Dir)) in
+  try X.open_out dir ~sw ~append ~create path
   with Exn.Io _ as ex ->
     let bt = Printexc.get_raw_backtrace () in
-    Exn.reraise_with_context ex bt "opening %a" pp (t, path)
+    Exn.reraise_with_context ex bt "opening %a" pp t
 
-let open_dir ~sw ((t:#Fs.dir), path) =
+let open_dir ~sw t =
-  try (t#open_dir ~sw path, "")
+  let (Resource.T (dir, ops), path) = t in
+  let module X = (val (Resource.get ops Fs.Pi.Dir)) in
+  try X.open_dir dir ~sw path, ""
   with Exn.Io _ as ex ->
     let bt = Printexc.get_raw_backtrace () in
-    Exn.reraise_with_context ex bt "opening directory %a" pp (t, path)
+    Exn.reraise_with_context ex bt "opening directory %a" pp t
 
-let mkdir ~perm ((t:#Fs.dir), path) =
+let mkdir ~perm t =
-  try t#mkdir ~perm path
+  let (Resource.T (dir, ops), path) = t in
+  let module X = (val (Resource.get ops Fs.Pi.Dir)) in
+  try X.mkdir dir ~perm path
   with Exn.Io _ as ex ->
     let bt = Printexc.get_raw_backtrace () in
-    Exn.reraise_with_context ex bt "creating directory %a" pp (t, path)
+    Exn.reraise_with_context ex bt "creating directory %a" pp t
 
-let read_dir ((t:#Fs.dir), path) =
+let read_dir t =
-  try List.sort String.compare (t#read_dir path)
+  let (Resource.T (dir, ops), path) = t in
+  let module X = (val (Resource.get ops Fs.Pi.Dir)) in
+  try List.sort String.compare (X.read_dir dir path)
   with Exn.Io _ as ex ->
     let bt = Printexc.get_raw_backtrace () in
-    Exn.reraise_with_context ex bt "reading directory %a" pp (t, path)
+    Exn.reraise_with_context ex bt "reading directory %a" pp t
 
 let with_open_in path fn =
   Switch.run @@ fun sw -> fn (open_in ~sw path)
@@ -77,20 +88,27 @@ let save ?append ~create path data =
   with_open_out ?append ~create path @@ fun flow ->
   Flow.copy_string data flow
 
-let unlink ((t:#Fs.dir), path) =
+let unlink t =
-  try t#unlink path
+  let (Resource.T (dir, ops), path) = t in
+  let module X = (val (Resource.get ops Fs.Pi.Dir)) in
+  try X.unlink dir path
   with Exn.Io _ as ex ->
     let bt = Printexc.get_raw_backtrace () in
-    Exn.reraise_with_context ex bt "removing file %a" pp (t, path)
+    Exn.reraise_with_context ex bt "removing file %a" pp t
 
-let rmdir ((t:#Fs.dir), path) =
+let rmdir t =
-  try t#rmdir path
+  let (Resource.T (dir, ops), path) = t in
+  let module X = (val (Resource.get ops Fs.Pi.Dir)) in
+  try X.rmdir dir path
   with Exn.Io _ as ex ->
     let bt = Printexc.get_raw_backtrace () in
-    Exn.reraise_with_context ex bt "removing directory %a" pp (t, path)
+    Exn.reraise_with_context ex bt "removing directory %a" pp t
 
-let rename ((t1:#Fs.dir), old_path) (t2, new_path) =
+let rename t1 t2 =
-  try t1#rename old_path (t2 :> Fs.dir) new_path
+  let (dir2, new_path) = t2 in
+  let (Resource.T (dir, ops), old_path) = t1 in
+  let module X = (val (Resource.get ops Fs.Pi.Dir)) in
+  try X.rename dir old_path (dir2 :> _ Fs.dir) new_path
   with Exn.Io _ as ex ->
     let bt = Printexc.get_raw_backtrace () in
-    Exn.reraise_with_context ex bt "renaming %a to %a" pp (t1, old_path) pp (t2, new_path)
+    Exn.reraise_with_context ex bt "renaming %a to %a" pp t1 pp t2

lib_eio/path.mli

@@ -25,9 +25,10 @@
     ]}
 *)
 
+open Std
 open Fs
 
-type 'a t = (#Fs.dir as 'a) * path
+type 'a t = 'a Fs.dir * path
 (** An OS directory FD and a path relative to it, for use with e.g. [openat(2)]. *)
 
 val ( / ) : 'a t -> string -> 'a t
@@ -47,12 +48,12 @@ val load : _ t -> string
 
     This is a convenience wrapper around {!with_open_in}. *)
 
-val open_in : sw:Switch.t -> _ t -> <File.ro; Flow.close>
+val open_in : sw:Switch.t -> _ t -> File.ro_ty r
 (** [open_in ~sw t] opens [t] for reading.
 
     Note: files are always opened in binary mode. *)
 
-val with_open_in : _ t -> (<File.ro; Flow.close> -> 'a) -> 'a
+val with_open_in : _ t -> (File.ro_ty r -> 'a) -> 'a
 (** [with_open_in] is like [open_in], but calls [fn flow] with the new flow and closes
     it automatically when [fn] returns (if it hasn't already been closed by then). *)
 
@@ -72,7 +73,7 @@ val open_out :
   sw:Switch.t ->
   ?append:bool ->
   create:create ->
-  _ t -> <File.rw; Flow.close>
+  _ t -> File.rw_ty Resource.t
 (** [open_out ~sw t] opens [t] for reading and writing.
 
     Note: files are always opened in binary mode.
@@ -82,7 +83,7 @@ val open_out :
 val with_open_out :
   ?append:bool ->
   create:create ->
-  _ t -> (<File.rw; Flow.close> -> 'a) -> 'a
+  _ t -> (File.rw_ty r -> 'a) -> 'a
 (** [with_open_out] is like [open_out], but calls [fn flow] with the new flow and closes
     it automatically when [fn] returns (if it hasn't already been closed by then). *)
 
@@ -91,12 +92,12 @@ val with_open_out :
 val mkdir : perm:File.Unix_perm.t -> _ t -> unit
 (** [mkdir ~perm t] creates a new directory [t] with permissions [perm]. *)
 
-val open_dir : sw:Switch.t -> _ t -> <dir; Flow.close> t
+val open_dir : sw:Switch.t -> _ t -> [`Close | dir_ty] t
 (** [open_dir ~sw t] opens [t].
 
     This can be passed to functions to grant access only to the subtree [t]. *)
 
-val with_open_dir : _ t -> (<dir; Flow.close> t -> 'a) -> 'a
+val with_open_dir : _ t -> ([`Close | dir_ty] t -> 'a) -> 'a
 (** [with_open_dir] is like [open_dir], but calls [fn dir] with the new directory and closes
     it automatically when [fn] returns (if it hasn't already been closed by then). *)
 

lib_eio/process.ml

@@ -1,3 +1,5 @@
+open Std
+
 type exit_status = [
   | `Exited of int
   | `Signaled of int
@@ -49,14 +51,14 @@ let signal proc = proc#signal
 class virtual mgr = object
   method virtual pipe :
     sw:Switch.t ->
-    <Flow.source; Flow.close> * <Flow.sink; Flow.close>
+    [Flow.source_ty | Resource.close_ty] r * [Flow.sink_ty | Resource.close_ty] r
 
   method virtual spawn :
     sw:Switch.t ->
-    ?cwd:Fs.dir Path.t ->
+    ?cwd:Fs.dir_ty Path.t ->
-    ?stdin:Flow.source ->
+    ?stdin:Flow.source_ty r ->
-    ?stdout:Flow.sink ->
+    ?stdout:Flow.sink_ty r ->
-    ?stderr:Flow.sink ->
+    ?stderr:Flow.sink_ty r ->
     ?env:string array ->
     ?executable:string ->
     string list ->
@@ -77,12 +79,12 @@ let pp_args = Fmt.hbox (Fmt.list ~sep:Fmt.sp pp_arg)
 
 let spawn ~sw (t:#mgr) ?cwd ?stdin ?stdout ?stderr ?env ?executable args =
   t#spawn ~sw
-    ?cwd:(cwd :> Fs.dir Path.t option)
+    ?cwd:(cwd :> Fs.dir_ty Path.t option)
     ?env
     ?executable args
-    ?stdin:(stdin :> Flow.source option)
+    ?stdin:(stdin :> Flow.source_ty r option)
-    ?stdout:(stdout :> Flow.sink option)
+    ?stdout:(stdout :> Flow.sink_ty r option)
-    ?stderr:(stderr :> Flow.sink option)
+    ?stderr:(stderr :> Flow.sink_ty r option)
 
 let run (t:#mgr) ?cwd ?stdin ?stdout ?stderr ?(is_success = Int.equal 0) ?env ?executable args =
   Switch.run @@ fun sw ->

lib_eio/process.mli

@@ -6,6 +6,8 @@
     ]}
  *)
 
+open Std
+
 (** {2 Status and error types} *)
 
 type exit_status = [
@@ -69,14 +71,14 @@ val signal : #t -> int -> unit
 class virtual mgr : object
   method virtual pipe :
     sw:Switch.t ->
-    <Flow.source; Flow.close> * <Flow.sink; Flow.close>
+    [Flow.source_ty | Resource.close_ty] r * [Flow.sink_ty | Resource.close_ty] r
 
   method virtual spawn :
     sw:Switch.t ->
-    ?cwd:Fs.dir Path.t ->
+    ?cwd:Fs.dir_ty Path.t ->
-    ?stdin:Flow.source ->
+    ?stdin:Flow.source_ty r ->
-    ?stdout:Flow.sink ->
+    ?stdout:Flow.sink_ty r ->
-    ?stderr:Flow.sink ->
+    ?stderr:Flow.sink_ty r ->
     ?env:string array ->
     ?executable:string ->
     string list ->
@@ -87,10 +89,10 @@ end
 val spawn :
   sw:Switch.t ->
   #mgr ->
-  ?cwd:#Fs.dir Path.t ->
+  ?cwd:Fs.dir_ty Path.t ->
-  ?stdin:#Flow.source ->
+  ?stdin:_ Flow.source ->
-  ?stdout:#Flow.sink ->
+  ?stdout:_ Flow.sink ->
-  ?stderr:#Flow.sink ->
+  ?stderr:_ Flow.sink ->
   ?env:string array ->
   ?executable:string ->
   string list -> t
@@ -113,10 +115,10 @@ val spawn :
 
 val run :
   #mgr ->
-  ?cwd:#Fs.dir Path.t ->
+  ?cwd:_ Path.t ->
-  ?stdin:#Flow.source ->
+  ?stdin:_ Flow.source ->
-  ?stdout:#Flow.sink ->
+  ?stdout:_ Flow.sink ->
-  ?stderr:#Flow.sink ->
+  ?stderr:_ Flow.sink ->
   ?is_success:(int -> bool) ->
   ?env:string array ->
   ?executable:string ->
@@ -132,9 +134,9 @@ val run :
 val parse_out :
   #mgr ->
   'a Buf_read.parser ->
-  ?cwd:#Fs.dir Path.t ->
+  ?cwd:_ Path.t ->
-  ?stdin:#Flow.source ->
+  ?stdin:_ Flow.source ->
-  ?stderr:#Flow.sink ->
+  ?stderr:_ Flow.sink ->
   ?is_success:(int -> bool) ->
   ?env:string array ->
   ?executable:string ->
@@ -152,7 +154,7 @@ val parse_out :
 
 (** {2 Pipes} *)
 
-val pipe : sw:Switch.t -> #mgr -> <Flow.source; Flow.close> * <Flow.sink; Flow.close>
+val pipe : sw:Switch.t -> #mgr -> [Flow.source_ty | Resource.close_ty] r * [Flow.sink_ty | Resource.close_ty] r
 (** [pipe ~sw mgr] creates a pipe backed by the OS.
 
     The flows can be used by {!spawn} without the need for extra fibers to copy the data.

lib_eio/resource.ml

@@ -0,0 +1,35 @@
+type ('t, 'impl, 'tags) pi = ..
+type _ binding = H : ('t, 'impl, 'tags) pi * 'impl -> 't binding
+type 't ops = 't binding array
+type ('t, 'tags) handler = 't ops
+type -'a t = T : ('t * 't ops) -> 'a t
+
+let not_supported () = failwith "Operation not supported!"
+
+let handler = Array.of_list
+let bindings = Array.to_list
+
+let get : 't ops -> ('t, 'impl, 'tags) pi -> 'impl = fun ops op ->
+  let rec aux i =
+    if i = Array.length ops then not_supported ();
+    let H (k, v) = ops.(i) in
+    if Obj.repr k == Obj.repr op then Obj.magic v
+    else aux (i + 1)
+  in
+  aux 0
+
+let get_opt : 't ops -> ('t, 'impl, 'tags) pi -> 'impl option = fun ops op ->
+  let rec aux i =
+    if i = Array.length ops then None
+    else (
+      let H (k, v) = ops.(i) in
+      if Obj.repr k == Obj.repr op then Some (Obj.magic v)
+      else aux (i + 1)
+    )
+  in
+  aux 0
+
+type close_ty = [`Close]
+type (_, _, _) pi += Close : ('t, 't -> unit, [> close_ty]) pi
+
+let close (T (t, ops)) = get ops Close t

lib_eio/resource.mli

@@ -0,0 +1,114 @@
+(** Resources are typically operating-system provided resources such as open files
+    and network sockets. However, they can also be pure OCaml resources (such as mocks)
+    or wrappers (such as an encrypted flow that wraps an unencrypted OS flow).
+
+    A resource's type shows which interfaces it supports. For example, a
+    [[source | sink] t] is a resource that can be used as a source or a sink.
+
+    If you are familiar with object types, this is roughly equivalent to the
+    type [<source; sink>]. We avoid using object types here as some OCaml
+    programmers find them confusing. *)
+
+(** {2 Types} *)
+
+type ('t, -'tags) handler
+(** A [('t, 'tags) handler] can be used to look up the implementation for a type ['t].
+
+    ['tags] is a phantom type to record which interfaces are supported.
+
+    Internally, a handler is a set of {!type-binding}s. *)
+
+type -'tags t = T : ('t * ('t, 'tags) handler) -> 'tags t (** *)
+(** A resource is a pair of a value and a handler for it.
+
+    Normally there will be convenience functions provided for using resources
+    and you will not need to match on [T] yourself except when defining a new interface. *)
+
+(** {2 Defining new interfaces}
+
+    These types and functions can be used to define new interfaces that others
+    can implement.
+
+    When defining a new interface, you will typically provide:
+
+    - The tags that indicate that the interface is supported (e.g. {!Flow.source_ty}).
+    - A convenience type to match all sub-types easily (e.g. {!Flow.source}).
+    - Functions allowing users to call the interface (e.g. {!Flow.single_read}).
+    - A module to let providers implement the interface (e.g. {!Flow.Pi}).
+*)
+
+type ('t, 'iface, 'tag) pi = ..
+(** A provider interface describes an interface that a resource can implement.
+
+    - ['t] is the type of the resource itself.
+    - ['iface] is the API that can be requested.
+    - ['tag] is the tag (or tags) indicating that the interface is supported.
+
+    For example, the value {!Close} (of type [(fd, fd -> unit, [> `Close]) pi]) can be
+    used with a resource backed by an [fd], and which offers at least the
+    [`Close] tag, to request its close function.
+    Often, the API requested will be a module type, but it can be a single function
+    as in this example.
+*)
+
+type _ binding = H : ('t, 'impl, 'tags) pi * 'impl -> 't binding (** *)
+(** A binding [H (pi, impl)] says to use [impl] to implement [pi].
+
+    For example: [H (Close, M.close)]. *)
+
+val handler : 't binding list -> ('t, _) handler
+(** [handler ops] is a handler that looks up interfaces using the assoc list [ops].
+
+    For example [shutdown (module Foo)] is a handler that handles the [Close] and [Shutdown]
+    interfaces for resources of type [Foo.t] by using the [Foo] module:
+
+    {[
+      let shutdown (type t) (module X : SHUTDOWN with type t = t) : (t, shutdown_ty) handler =
+        handler [
+          H (Close, X.close);
+          H (Shutdown, (module X));
+        ]
+    ]}
+
+    Be sure to give the return type explicitly, as this cannot be inferred.
+*)
+
+val bindings : ('t, _) handler -> 't binding list
+(** [bindings (handler ops) = ops].
+
+    This is useful if you want to extend an interface
+    and you already have a handler for that interface. *)
+
+val get : ('t, 'tags) handler -> ('t, 'impl, 'tags) pi -> 'impl
+(** [get handler iface] uses [handler] to get the implementation of [iface].
+
+    For example:
+    {[
+      let write (Resource.T (t, ops)) bufs =
+        let module X = (val (Resource.get ops Sink)) in
+        X.write t bufs
+    ]}
+*)
+
+val get_opt : ('t, _) handler -> ('t, 'impl, _) pi -> 'impl option
+(** [get_opt] is like {!get}, but the handler need not have a compatible type.
+    Instead, this performs a check at runtime and returns [None] if the interface
+    is not supported. *)
+
+(** {2 Closing}
+
+    Resources are usually attached to switches and closed automatically when the switch
+    finishes. However, it can be useful to close them sooner in some cases. *)
+
+type close_ty = [`Close]
+type (_, _, _) pi += Close : ('t, 't -> unit, [> close_ty]) pi
+
+val close : [> close_ty] t -> unit
+(** [close t] marks the resource as closed. It can no longer be used after this.
+
+    If [t] is already closed then this does nothing (it does not raise an exception).
+
+    Note: if an operation is currently in progress when this is called then it is not
+    necessarily cancelled, and any underlying OS resource (such as a file descriptor)
+    might not be closed immediately if other operations are using it. Closing a resource
+    only prevents new operations from starting. *)

lib_eio/std.ml

@@ -0,0 +1,5 @@
+module Promise = Eio__core.Promise
+module Fiber = Eio__core.Fiber
+module Switch = Eio__core.Switch
+type 'a r = 'a Resource.t
+let traceln = Debug.traceln

lib_eio/std.mli

@@ -0,0 +1,10 @@
+module Promise = Eio__core.Promise
+module Fiber = Eio__core.Fiber
+module Switch = Eio__core.Switch
+
+type 'a r = 'a Resource.t
+
+val traceln :
+  ?__POS__:string * int * int * int ->
+  ('a, Format.formatter, unit, unit) format4 -> 'a
+  (** Same as {!Eio.traceln}. *)

lib_eio/unix/eio_unix.ml

@@ -1,11 +1,12 @@
 [@@@alert "-unstable"]
 
+open Eio.Std
+
 module Fd = Fd
 module Resource = Resource
 module Private = Private
 
 include Types
-type socket = Net.stream_socket
 
 let await_readable = Private.await_readable
 let await_writable = Private.await_writable
@@ -32,17 +33,17 @@ module Net = Net
 
 module Stdenv = struct
   type base = <
-    stdin  : source;
+    stdin  : source_ty r;
-    stdout : sink;
+    stdout : sink_ty r;
-    stderr : sink;
+    stderr : sink_ty r;
-    net : Eio.Net.t;
+    net : [`Unix | `Generic] Eio.Net.ty r;
     domain_mgr : Eio.Domain_manager.t;
     process_mgr : Process.mgr;
     clock : Eio.Time.clock;
     mono_clock : Eio.Time.Mono.t;
-    fs : Eio.Fs.dir Eio.Path.t;
+    fs : Eio.Fs.dir_ty Eio.Path.t;
-    cwd : Eio.Fs.dir Eio.Path.t;
+    cwd : Eio.Fs.dir_ty Eio.Path.t;
-    secure_random : Eio.Flow.source;
+    secure_random : Eio.Flow.source_ty r;
     debug : Eio.Debug.t;
     backend_id: string;
   >

lib_eio/unix/eio_unix.mli

@@ -16,27 +16,58 @@ module Fd = Fd
 
 (** Eio resources backed by an OS file descriptor. *)
 module Resource : sig
-  type t = < fd : Fd.t >
+  type 'a t = ([> `Unix_fd] as 'a) Eio.Resource.t
-  (** Resources that have FDs are sub-types of [t]. *)
+  (** Resources that have FDs are tagged with [`Unix_fd]. *)
 
-  val fd : <t;..> -> Fd.t
+  type ('t, _, _) Eio.Resource.pi += T : ('t, 't -> Fd.t, [> `Unix_fd]) Eio.Resource.pi
+
+  val fd : _ t -> Fd.t
   (** [fd t] returns the FD being wrapped by a resource. *)
 
-  type _ Eio.Generic.ty += FD : Fd.t Eio.Generic.ty
+  val fd_opt : _ Eio.Resource.t -> Fd.t option
-  (** Resources that wrap FDs can handle this in their [probe] method to expose the FD. *)
-
-  val fd_opt : #Eio.Generic.t -> Fd.t option
   (** [fd_opt t] returns the FD being wrapped by a generic resource, if any.
 
       This just probes [t] using {!extension-FD}. *)
+
+  module type FLOW = sig
+    include Eio.Net.Pi.STREAM_SOCKET
+    include Eio.File.Pi.WRITE with type t := t
+
+    val fd : t -> Fd.t
+  end
+
+  val flow_handler :
+    (module FLOW with type t = 't and type tag = 'tag) ->
+    ('t, [`Unix_fd | 'tag Eio.Net.stream_socket_ty | Eio.File.rw_ty]) Eio.Resource.handler
+
+  module type DATAGRAM_SOCKET = sig
+    include Eio.Net.Pi.DATAGRAM_SOCKET
+
+    val fd : t -> Fd.t
+  end
+
+  val datagram_handler :
+    (module DATAGRAM_SOCKET with type t = 't and type tag = 'tag) ->
+    ('t, [`Unix_fd | 'tag Eio.Net.datagram_socket_ty]) Eio.Resource.handler
+
+  module type LISTENING_SOCKET = sig
+    include Eio.Net.Pi.LISTENING_SOCKET
+
+    val fd : t -> Fd.t
+  end
+
+  val listening_socket_handler :
+    (module LISTENING_SOCKET with type t = 't and type tag = 'tag) ->
+    ('t, [`Unix_fd | 'tag Eio.Net.listening_socket_ty]) Eio.Resource.handler
 end
 
 module Net = Net
 (** Extended network API with support for file descriptors. *)
 
-type source = < Eio.Flow.source;  Resource.t; Eio.Flow.close >
+type source_ty = [`Unix_fd | Eio.Resource.close_ty | Eio.Flow.source_ty]
-type sink   = < Eio.Flow.sink;    Resource.t; Eio.Flow.close >
+type sink_ty   = [`Unix_fd | Eio.Resource.close_ty | Eio.Flow.sink_ty]
-type socket = Net.stream_socket
+type 'a source = ([> source_ty] as 'a) r
+type 'a sink = ([> sink_ty] as 'a) r
 
 val await_readable : Unix.file_descr -> unit
 (** [await_readable fd] blocks until [fd] is readable (or has an error). *)
@@ -54,7 +85,7 @@ val run_in_systhread : (unit -> 'a) -> 'a
 (** [run_in_systhread fn] runs the function [fn] in a newly created system thread (a {! Thread.t}).
     This allows blocking calls to be made non-blocking. *)
 
-val pipe : Switch.t -> source * sink
+val pipe : Switch.t -> source_ty r * sink_ty r
 (** [pipe sw] returns a connected pair of flows [src] and [sink]. Data written to [sink]
     can be read from [src].
     Note that, like all FDs created by Eio, they are both marked as close-on-exec by default. *)
@@ -65,17 +96,17 @@ module Process = Process
 (** The set of resources provided to a process on a Unix-compatible system. *)
 module Stdenv : sig
   type base = <
-    stdin  : source;
+    stdin  : source_ty r;
-    stdout : sink;
+    stdout : sink_ty r;
-    stderr : sink;
+    stderr : sink_ty r;
-    net : Eio.Net.t;
+    net : [`Unix | `Generic] Eio.Net.ty r;
     domain_mgr : Eio.Domain_manager.t;
     process_mgr : Process.mgr;
     clock : Eio.Time.clock;
     mono_clock : Eio.Time.Mono.t;
-    fs : Eio.Fs.dir Eio.Path.t;
+    fs : Eio.Fs.dir_ty Eio.Path.t;
-    cwd : Eio.Fs.dir Eio.Path.t;
+    cwd : Eio.Fs.dir_ty Eio.Path.t;
-    secure_random : Eio.Flow.source;
+    secure_random : Eio.Flow.source_ty r;
     debug : Eio.Debug.t;
     backend_id : string;
   >
@@ -90,7 +121,7 @@ module Private : sig
     | Await_readable : Unix.file_descr -> unit Effect.t      (** See {!await_readable} *)
     | Await_writable : Unix.file_descr -> unit Effect.t      (** See {!await_writable} *)
     | Get_monotonic_clock : Eio.Time.Mono.t Effect.t
-    | Pipe : Eio.Switch.t -> (source * sink) Effect.t (** See {!pipe} *)
+    | Pipe : Eio.Switch.t -> (source_ty r * sink_ty r) Effect.t    (** See {!pipe} *)
 
   module Rcfd = Rcfd
 

lib_eio/unix/net.ml

@@ -1,5 +1,12 @@
 open Eio.Std
 
+type stream_socket_ty   = [`Unix_fd | [`Generic | `Unix] Eio.Net.stream_socket_ty]
+type datagram_socket_ty = [`Unix_fd | [`Generic | `Unix] Eio.Net.datagram_socket_ty]
+type listening_socket_ty = [`Unix_fd | [`Generic | `Unix] Eio.Net.listening_socket_ty]
+type 'a stream_socket = ([> stream_socket_ty] as 'a) r
+type 'a datagram_socket = ([> datagram_socket_ty] as 'a) r
+type 'a listening_socket = ([> listening_socket_ty] as 'a) r
+
 module Ipaddr = struct
   let to_unix : _ Eio.Net.Ipaddr.t -> Unix.inet_addr = Obj.magic
   let of_unix : Unix.inet_addr -> _ Eio.Net.Ipaddr.t = Obj.magic
@@ -23,14 +30,6 @@ let sockaddr_of_unix_datagram = function
     let host = Ipaddr.of_unix host in
     `Udp (host, port)
 
-class virtual stream_socket = object (_ : <Resource.t; ..>)
-  inherit Eio.Net.stream_socket
-end
-
-class virtual datagram_socket = object (_ : <Resource.t; ..>)
-  inherit Eio.Net.datagram_socket
-end
-
 let getnameinfo (sockaddr : Eio.Net.Sockaddr.t) =
   let options =
     match sockaddr with
@@ -42,28 +41,30 @@ let getnameinfo (sockaddr : Eio.Net.Sockaddr.t) =
     let Unix.{ni_hostname; ni_service} = Unix.getnameinfo sockaddr options in
     (ni_hostname, ni_service))
 
-class virtual t = object
+type t = [`Generic | `Unix] Eio.Net.ty r
-  inherit Eio.Net.t
-
-  method getnameinfo = getnameinfo
-end
 
 [@@@alert "-unstable"]
 
 type _ Effect.t +=
-  | Import_socket_stream : Switch.t * bool * Unix.file_descr -> stream_socket Effect.t
+  | Import_socket_stream : Switch.t * bool * Unix.file_descr -> stream_socket_ty r Effect.t
-  | Import_socket_datagram : Switch.t * bool * Unix.file_descr -> datagram_socket Effect.t
+  | Import_socket_datagram : Switch.t * bool * Unix.file_descr -> datagram_socket_ty r Effect.t
   | Socketpair_stream : Switch.t * Unix.socket_domain * int ->
-      (stream_socket * stream_socket) Effect.t
+      (stream_socket_ty r * stream_socket_ty r) Effect.t
   | Socketpair_datagram : Switch.t * Unix.socket_domain * int ->
-      (datagram_socket * datagram_socket) Effect.t
+      (datagram_socket_ty r * datagram_socket_ty r) Effect.t
 
-let import_socket_stream ~sw ~close_unix fd = Effect.perform (Import_socket_stream (sw, close_unix, fd))
+let open_stream s = (s : _ stream_socket :> [< stream_socket_ty] r)
+let open_datagram s = (s : _ datagram_socket :> [< datagram_socket_ty] r)
 
-let import_socket_datagram ~sw ~close_unix fd = Effect.perform (Import_socket_datagram (sw, close_unix, fd))
+let import_socket_stream ~sw ~close_unix fd =
+  open_stream @@ Effect.perform (Import_socket_stream (sw, close_unix, fd))
+
+let import_socket_datagram ~sw ~close_unix fd =
+  open_datagram @@ Effect.perform (Import_socket_datagram (sw, close_unix, fd))
 
 let socketpair_stream ~sw ?(domain=Unix.PF_UNIX) ?(protocol=0) () =
-  Effect.perform (Socketpair_stream (sw, domain, protocol))
+  let a, b = Effect.perform (Socketpair_stream (sw, domain, protocol)) in
+  (open_stream a, open_stream b)
 
 let socketpair_datagram ~sw ?(domain=Unix.PF_UNIX) ?(protocol=0) () =
   Effect.perform (Socketpair_datagram (sw, domain, protocol))

lib_eio/unix/net.mli

@@ -4,19 +4,14 @@ open Eio.Std
 
     These extend the types in {!Eio.Net} with support for file descriptors. *)
 
-class virtual stream_socket : object (<Resource.t; ..>)
+type stream_socket_ty   = [`Unix_fd | [`Generic | `Unix] Eio.Net.stream_socket_ty]
-  inherit Eio.Net.stream_socket
+type datagram_socket_ty = [`Unix_fd | [`Generic | `Unix] Eio.Net.datagram_socket_ty]
-end
+type listening_socket_ty = [`Unix_fd | [`Generic | `Unix] Eio.Net.listening_socket_ty]
+type 'a stream_socket = ([> stream_socket_ty] as 'a) r
+type 'a datagram_socket = ([> datagram_socket_ty] as 'a) r
+type 'a listening_socket = ([> listening_socket_ty] as 'a) r
 
-class virtual datagram_socket : object (<Resource.t; ..>)
+type t = [`Generic | `Unix] Eio.Net.ty r
-  inherit Eio.Net.datagram_socket
-end
-
-class virtual t : object
-  inherit Eio.Net.t
-
-  method getnameinfo : Eio.Net.Sockaddr.t -> (string * string)
-end
 
 (** {2 Unix address conversions}
 
@@ -39,7 +34,7 @@ end
 
 (** {2 Creating or importing sockets} *)
 
-val import_socket_stream : sw:Switch.t -> close_unix:bool -> Unix.file_descr -> stream_socket
+val import_socket_stream : sw:Switch.t -> close_unix:bool -> Unix.file_descr -> stream_socket_ty r
 (** [import_socket_stream ~sw ~close_unix:true fd] is an Eio flow that uses [fd].
 
     It can be cast to e.g. {!source} for a one-way flow.
@@ -47,7 +42,7 @@ val import_socket_stream : sw:Switch.t -> close_unix:bool -> Unix.file_descr ->
 
     The [close_unix] and [sw] arguments are passed to {!Fd.of_unix}. *)
 
-val import_socket_datagram : sw:Switch.t -> close_unix:bool -> Unix.file_descr -> datagram_socket
+val import_socket_datagram : sw:Switch.t -> close_unix:bool -> Unix.file_descr -> datagram_socket_ty r
 (** [import_socket_datagram ~sw ~close_unix:true fd] is an Eio datagram socket that uses [fd].
 
     The socket object will be closed when [sw] finishes.
@@ -59,7 +54,7 @@ val socketpair_stream :
   ?domain:Unix.socket_domain ->
   ?protocol:int ->
   unit ->
-  stream_socket * stream_socket
+  stream_socket_ty r * stream_socket_ty r
 (** [socketpair_stream ~sw ()] returns a connected pair of flows, such that writes to one can be read by the other.
 
     This creates OS-level resources using [socketpair(2)].
@@ -70,7 +65,7 @@ val socketpair_datagram :
   ?domain:Unix.socket_domain ->
   ?protocol:int ->
   unit ->
-  datagram_socket * datagram_socket
+  datagram_socket_ty r * datagram_socket_ty r
 (** [socketpair_datagram ~sw ()] returns a connected pair of flows, such that writes to one can be read by the other.
 
     This creates OS-level resources using [socketpair(2)].
@@ -83,11 +78,11 @@ val getnameinfo : Eio.Net.Sockaddr.t -> (string * string)
 
 type _ Effect.t +=
   | Import_socket_stream :
-      Switch.t * bool * Unix.file_descr -> stream_socket Effect.t       (** See {!import_socket_stream} *)
+      Switch.t * bool * Unix.file_descr -> stream_socket_ty r Effect.t            (** See {!import_socket_stream} *)
   | Import_socket_datagram :
-      Switch.t * bool * Unix.file_descr -> datagram_socket Effect.t     (** See {!import_socket_datagram} *)
+      Switch.t * bool * Unix.file_descr -> datagram_socket_ty r Effect.t          (** See {!import_socket_datagram} *)
   | Socketpair_stream : Eio.Switch.t * Unix.socket_domain * int ->
-      (stream_socket * stream_socket) Effect.t                    (** See {!socketpair_stream} *)
+      (stream_socket_ty r * stream_socket_ty r) Effect.t                          (** See {!socketpair_stream} *)
   | Socketpair_datagram : Eio.Switch.t * Unix.socket_domain * int ->
-      (datagram_socket * datagram_socket) Effect.t                (** See {!socketpair_datagram} *)
+      (datagram_socket_ty r * datagram_socket_ty r) Effect.t                      (** See {!socketpair_datagram} *)
 [@@alert "-unstable"]

lib_eio/unix/private.ml

@@ -7,7 +7,7 @@ type _ Effect.t +=
   | Await_readable : Unix.file_descr -> unit Effect.t
   | Await_writable : Unix.file_descr -> unit Effect.t
   | Get_monotonic_clock : Eio.Time.Mono.t Effect.t
-  | Pipe : Switch.t -> (source * sink) Effect.t
+  | Pipe : Switch.t -> (source_ty r * sink_ty r) Effect.t
 
 let await_readable fd = Effect.perform (Await_readable fd)
 let await_writable fd = Effect.perform (Await_writable fd)

lib_eio/unix/process.ml

@@ -72,11 +72,13 @@ let get_env = function
 class virtual mgr = object (self)
   inherit Eio.Process.mgr
 
-  method pipe ~sw = (Private.pipe sw :> <Eio.Flow.source; Eio.Flow.close> * <Eio.Flow.sink; Eio.Flow.close>)
+  method pipe ~sw =
+    (Private.pipe sw :> ([Eio.Resource.close_ty | Eio.Flow.source_ty] r *
+                         [Eio.Resource.close_ty | Eio.Flow.sink_ty] r))
 
   method virtual spawn_unix :
     sw:Switch.t ->
-    ?cwd:Eio.Fs.dir Eio.Path.t ->
+    ?cwd:Eio.Fs.dir_ty Eio.Path.t ->
     env:string array ->
     fds:(int * Fd.t * Fork_action.blocking) list ->
     executable:string ->

lib_eio/unix/process.mli

@@ -7,11 +7,11 @@ class virtual mgr : object
 
   method pipe :
     sw:Switch.t ->
-    <Eio.Flow.source; Eio.Flow.close> * <Eio.Flow.sink; Eio.Flow.close>
+    [Eio.Flow.source_ty | Eio.Resource.close_ty] r * [Eio.Flow.sink_ty | Eio.Resource.close_ty] r
 
   method virtual spawn_unix :
     sw:Switch.t ->
-    ?cwd:Eio.Fs.dir Eio.Path.t ->
+    ?cwd:Eio.Fs.dir_ty Eio.Path.t ->
     env:string array ->
     fds:(int * Fd.t * Fork_action.blocking) list ->
     executable:string ->
@@ -20,10 +20,10 @@ class virtual mgr : object
 
   method spawn :
     sw:Switch.t ->
-    ?cwd:Eio.Fs.dir Eio.Path.t ->
+    ?cwd:Eio.Fs.dir_ty Eio.Path.t ->
-    ?stdin:Eio.Flow.source ->
+    ?stdin:Eio.Flow.source_ty r ->
-    ?stdout:Eio.Flow.sink ->
+    ?stdout:Eio.Flow.sink_ty r ->
-    ?stderr:Eio.Flow.sink ->
+    ?stderr:Eio.Flow.sink_ty r ->
     ?env:string array ->
     ?executable:string ->
     string list ->
@@ -34,7 +34,7 @@ end
 val spawn_unix :
     sw:Switch.t ->
     #mgr ->
-    ?cwd:Eio.Fs.dir Eio.Path.t ->
+    ?cwd:Eio.Fs.dir_ty Eio.Path.t ->
     fds:(int * Fd.t * Fork_action.blocking) list ->
     ?env:string array ->
     ?executable:string ->

lib_eio/unix/resource.ml

@@ -1,6 +1,48 @@
-type t = < fd : Fd.t >
+type 'a t = ([> `Unix_fd] as 'a) Eio.Resource.t
 
-type _ Eio.Generic.ty += FD : Fd.t Eio.Generic.ty
+type ('t, _, _) Eio.Resource.pi += T : ('t, 't -> Fd.t, [> `Unix_fd]) Eio.Resource.pi
+let fd (Eio.Resource.T (t, ops)) = Eio.Resource.get ops T t
 
-let fd t = t#fd
+let fd_opt (Eio.Resource.T (t, ops)) =
-let fd_opt t = Eio.Generic.probe t FD
+  match Eio.Resource.get_opt ops T with
+  | Some f -> Some (f t)
+  | None -> None
+
+module type FLOW = sig
+  include Eio.Net.Pi.STREAM_SOCKET
+  include Eio.File.Pi.WRITE with type t := t
+
+  val fd : t -> Fd.t
+end
+
+let flow_handler (type t tag) (module X : FLOW with type t = t and type tag = tag) : (t, _) Eio.Resource.handler =
+  Eio.Resource.handler @@
+  Eio.Resource.bindings (Eio.Net.Pi.stream_socket (module X)) @
+  Eio.Resource.bindings (Eio.File.Pi.rw (module X)) @ [
+    H (T, X.fd);
+  ]
+
+module type DATAGRAM_SOCKET = sig
+  include Eio.Net.Pi.DATAGRAM_SOCKET
+
+  val fd : t -> Fd.t
+end
+
+let datagram_handler (type t tag) (module X : DATAGRAM_SOCKET with type t = t and type tag = tag) : (t, _) Eio.Resource.handler =
+  Eio.Resource.handler @@
+  Eio.Resource.bindings (Eio.Net.Pi.datagram_socket (module X)) @ [
+    H (T, X.fd);
+  ]
+
+module type LISTENING_SOCKET = sig
+  include Eio.Net.Pi.LISTENING_SOCKET
+
+  val fd : t -> Fd.t
+end
+
+let listening_socket_handler (type t tag) (module X : LISTENING_SOCKET with type t = t and type tag = tag)
+  : (t, _) Eio.Resource.handler =
+  Eio.Resource.handler @@
+  Eio.Resource.bindings (Eio.Net.Pi.listening_socket (module X)) @ [
+    H (T, X.fd);
+  ]

lib_eio/unix/types.ml

@@ -1,2 +1,4 @@
-type source = < Eio.Flow.source;  Resource.t; Eio.Flow.close >
+type source_ty = [`Unix_fd | Eio.Resource.close_ty | Eio.Flow.source_ty]
-type sink   = < Eio.Flow.sink;    Resource.t; Eio.Flow.close >
+type sink_ty   = [`Unix_fd | Eio.Resource.close_ty | Eio.Flow.sink_ty]
+type 'a source = ([> source_ty] as 'a) Eio.Resource.t
+type 'a sink = ([> sink_ty] as 'a) Eio.Resource.t

lib_eio_linux/eio_linux.ml

@@ -29,11 +29,14 @@ module Lf_queue = Eio_utils.Lf_queue
 
 module Low_level = Low_level
 
-type _ Eio.Generic.ty += Dir_fd : Low_level.dir_fd Eio.Generic.ty
+(* When renaming, we get a plain [Eio.Fs.dir]. We need extra access to check
-let get_dir_fd_opt t = Eio.Generic.probe t Dir_fd
+   that the new location is within its sandbox. *)
+type ('t, _, _) Eio.Resource.pi += Dir_fd : ('t, 't -> Low_level.dir_fd, [> `Dir_fd]) Eio.Resource.pi
 
-type source = Eio_unix.source
+let get_dir_fd_opt (Eio.Resource.T (t, ops)) =
-type sink   = Eio_unix.sink
+  match Eio.Resource.get_opt ops Dir_fd with
+  | Some f -> Some (f t)
+  | None -> None
 
 (* When copying between a source with an FD and a sink with an FD, we can share the chunk
    and avoid copying. *)
@@ -83,13 +86,13 @@ let copy_with_rsb rsb dst =
 (* Copy by allocating a chunk from the pre-shared buffer and asking
    the source to write into it. This used when the other methods
    aren't available. *)
-let fallback_copy src dst =
+let fallback_copy (type src) (module Src : Eio.Flow.Pi.SOURCE with type t = src) src dst =
   let fallback () =
     (* No chunks available. Use regular memory instead. *)
     let buf = Cstruct.create 4096 in
     try
       while true do
-        let got = Eio.Flow.single_read src buf in
+        let got = Src.single_read src buf in
         Low_level.writev dst [Cstruct.sub buf 0 got]
       done
     with End_of_file -> ()
@@ -98,99 +101,127 @@ let fallback_copy src dst =
   let chunk_cs = Uring.Region.to_cstruct chunk in
   try
     while true do
-      let got = Eio.Flow.single_read src chunk_cs in
+      let got = Src.single_read src chunk_cs in
       Low_level.write dst chunk got
     done
   with End_of_file -> ()
 
-let datagram_socket sock = object
+module Datagram_socket = struct
-  inherit Eio.Net.datagram_socket
+  type tag = [`Generic | `Unix]
 
-  method fd = sock
+  type t = Eio_unix.Fd.t
 
-  method close = Fd.close sock
+  let fd t = t
 
-  method send ?dst buf =
+  let close = Eio_unix.Fd.close
+
+  let send t ?dst buf =
     let dst = Option.map Eio_unix.Net.sockaddr_to_unix dst in
-    let sent = Low_level.send_msg sock ?dst buf in
+    let sent = Low_level.send_msg t ?dst buf in
     assert (sent = Cstruct.lenv buf)
 
-  method recv buf =
+  let recv t buf =
-    let addr, recv = Low_level.recv_msg sock [buf] in
+    let addr, recv = Low_level.recv_msg t [buf] in
     Eio_unix.Net.sockaddr_of_unix_datagram (Uring.Sockaddr.get addr), recv
+
+  let shutdown t cmd =
+    Low_level.shutdown t @@ match cmd with
+    | `Receive -> Unix.SHUTDOWN_RECEIVE
+    | `Send -> Unix.SHUTDOWN_SEND
+    | `All -> Unix.SHUTDOWN_ALL
 end
 
+let datagram_handler = Eio_unix.Resource.datagram_handler (module Datagram_socket)
+
+let datagram_socket fd =
+  Eio.Resource.T (fd, datagram_handler)
+
+module Flow = struct
+  type tag = [`Generic | `Unix]
+
+  type t = Eio_unix.Fd.t
+
+  let fd t = t
+
+  let close = Eio_unix.Fd.close
+
+  let is_tty t = Fd.use_exn "isatty" t Unix.isatty
+
+  let stat = Low_level.fstat
+
+  let single_read t buf =
+    if is_tty t then (
+      (* Work-around for https://github.com/axboe/liburing/issues/354
+         (should be fixed in Linux 5.14) *)
+      Low_level.await_readable t
+    );
+    Low_level.readv t [buf]
+
+  let pread t ~file_offset bufs =
+    Low_level.readv ~file_offset t bufs
+
+  let pwrite t ~file_offset bufs =
+    Low_level.writev_single ~file_offset t bufs
+
+  let read_methods = []
+
+  let write t bufs = Low_level.writev t bufs
+
+  let copy t ~src =
+    match Eio_unix.Resource.fd_opt src with
+    | Some src -> fast_copy_try_splice src t
+    | None ->
+      let Eio.Resource.T (src, ops) = src in
+      let module Src = (val (Eio.Resource.get ops Eio.Flow.Pi.Source)) in
+      let rec aux = function
+        | Eio.Flow.Read_source_buffer rsb :: _ -> copy_with_rsb (rsb src) t
+        | _ :: xs -> aux xs
+        | [] -> fallback_copy (module Src) src t
+      in
+      aux Src.read_methods
+
+  let shutdown t cmd =
+    Low_level.shutdown t @@ match cmd with
+    | `Receive -> Unix.SHUTDOWN_RECEIVE
+    | `Send -> Unix.SHUTDOWN_SEND
+    | `All -> Unix.SHUTDOWN_ALL
+end
+
+let flow_handler = Eio_unix.Resource.flow_handler (module Flow)
+
 let flow fd =
-  let is_tty = Fd.use_exn "isatty" fd Unix.isatty in
+  let r = Eio.Resource.T (fd, flow_handler) in
-  object (_ : <source; sink; ..>)
+  (r : [Eio_unix.Net.stream_socket_ty | Eio.File.rw_ty] r :>
-    method fd = fd
+     [< Eio_unix.Net.stream_socket_ty | Eio.File.rw_ty] r)
-    method close = Fd.close fd
 
-    method stat = Low_level.fstat fd
+let source fd = (flow fd :> _ Eio_unix.source)
+let sink   fd = (flow fd :> _ Eio_unix.sink)
 
-    method probe : type a. a Eio.Generic.ty -> a option = function
+module Listening_socket = struct
-      | Eio_unix.Resource.FD -> Some fd
+  type t = Fd.t
-      | _ -> None
 
-    method read_into buf =
+  type tag = [`Generic | `Unix]
-      if is_tty then (
-        (* Work-around for https://github.com/axboe/liburing/issues/354
-           (should be fixed in Linux 5.14) *)
-        Low_level.await_readable fd
-      );
-      Low_level.readv fd [buf]
 
-    method pread ~file_offset bufs =
+  let fd t = t
-      Low_level.readv ~file_offset fd bufs
 
-    method pwrite ~file_offset bufs =
+  let close = Fd.close
-      Low_level.writev_single ~file_offset fd bufs
 
-    method read_methods = []
+  let accept t ~sw =
-
-    method write bufs = Low_level.writev fd bufs
-
-    method copy src =
-      match Eio_unix.Resource.fd_opt src with
-      | Some src -> fast_copy_try_splice src fd
-      | None ->
-        let rec aux = function
-          | Eio.Flow.Read_source_buffer rsb :: _ -> copy_with_rsb rsb fd
-          | _ :: xs -> aux xs
-          | [] -> fallback_copy src fd
-        in
-        aux (Eio.Flow.read_methods src)
-
-    method shutdown cmd =
-      Low_level.shutdown fd @@ match cmd with
-      | `Receive -> Unix.SHUTDOWN_RECEIVE
-      | `Send -> Unix.SHUTDOWN_SEND
-      | `All -> Unix.SHUTDOWN_ALL
-  end
-
-let source fd = (flow fd :> source)
-let sink   fd = (flow fd :> sink)
-
-let listening_socket fd = object
-  inherit Eio.Net.listening_socket
-
-  method close = Fd.close fd
-
-  method accept ~sw =
     Switch.check sw;
-    let client, client_addr = Low_level.accept ~sw fd in
+    let client, client_addr = Low_level.accept ~sw t in
     let client_addr = match client_addr with
       | Unix.ADDR_UNIX path         -> `Unix path
       | Unix.ADDR_INET (host, port) -> `Tcp (Eio_unix.Net.Ipaddr.of_unix host, port)
     in
-    let flow = (flow client :> Eio.Net.stream_socket) in
+    let flow = (flow client :> _ Eio.Net.stream_socket) in
     flow, client_addr
-
-  method! probe : type a. a Eio.Generic.ty -> a option = function
-    | Eio_unix.Resource.FD -> Some fd
-    | _ -> None
 end
 
+let listening_handler = Eio_unix.Resource.listening_socket_handler (module Listening_socket)
+
+let listening_socket fd =
+  Eio.Resource.T (fd, listening_handler)
+
 let socket_domain_of = function
   | `Unix _ -> Unix.PF_UNIX
   | `UdpV4 -> Unix.PF_INET
@@ -206,12 +237,13 @@ let connect ~sw connect_addr =
   let sock_unix = Unix.socket ~cloexec:true (socket_domain_of connect_addr) Unix.SOCK_STREAM 0 in
   let sock = Fd.of_unix ~sw ~seekable:false ~close_unix:true sock_unix in
   Low_level.connect sock addr;
-  (flow sock :> Eio.Net.stream_socket)
+  (flow sock :> _ Eio_unix.Net.stream_socket)
 
-let net = object
+module Impl = struct
-  inherit Eio_unix.Net.t
+  type t = unit
+  type tag = [`Unix | `Generic]
 
-  method listen ~reuse_addr ~reuse_port ~backlog ~sw listen_addr =
+  let listen () ~reuse_addr ~reuse_port ~backlog ~sw listen_addr =
     if reuse_addr then (
       match listen_addr with
       | `Tcp _ -> ()
@@ -238,11 +270,11 @@ let net = object
       Unix.setsockopt sock_unix Unix.SO_REUSEPORT true;
     Unix.bind sock_unix addr;
     Unix.listen sock_unix backlog;
-    listening_socket sock
+    (listening_socket sock :> _ Eio.Net.listening_socket_ty r)
 
-  method connect = connect
+  let connect () ~sw addr = (connect ~sw addr :> [`Generic | `Unix] Eio.Net.stream_socket_ty r)
 
-  method datagram_socket ~reuse_addr ~reuse_port ~sw saddr =
+  let datagram_socket () ~reuse_addr ~reuse_port ~sw saddr =
     if reuse_addr then (
       match saddr with
       | `Udp _ | `UdpV4 | `UdpV6 -> ()
@@ -265,11 +297,16 @@ let net = object
       Unix.bind sock_unix addr
     | `UdpV4 | `UdpV6 -> ()
     end;
-    (datagram_socket sock :> Eio.Net.datagram_socket)
+    (datagram_socket sock :> [`Generic | `Unix] Eio.Net.datagram_socket_ty r)
 
-  method getaddrinfo = Low_level.getaddrinfo
+  let getaddrinfo () = Low_level.getaddrinfo
+  let getnameinfo () = Eio_unix.Net.getnameinfo
 end
 
+let net =
+  let handler = Eio.Net.Pi.network (module Impl) in
+  Eio.Resource.T ((), handler)
+
 type stdenv = Eio_unix.Stdenv.base
 
 module Process = Low_level.Process
@@ -377,22 +414,31 @@ let clock = object
     Eio.Time.Mono.sleep mono_clock d
 end
 
-class dir ~label (fd : Low_level.dir_fd) = object
+module rec Dir : sig
-  inherit Eio.Fs.dir
+  include Eio.Fs.Pi.DIR
 
-  method! probe : type a. a Eio.Generic.ty -> a option = function
+  val v : label:string -> Low_level.dir_fd -> t
-    | Dir_fd -> Some fd
-    | _ -> None
 
-  method open_in ~sw path =
+  val close : t -> unit
-    let fd = Low_level.openat ~sw fd path
+
+  val fd : t -> Low_level.dir_fd
+end = struct
+  type t = {
+    fd : Low_level.dir_fd;
+    label : string;
+  }
+
+  let v ~label fd = { fd; label }
+
+  let open_in t ~sw path =
+    let fd = Low_level.openat ~sw t.fd path
         ~access:`R
         ~flags:Uring.Open_flags.cloexec
         ~perm:0
     in
-    (flow fd :> <Eio.File.ro; Eio.Flow.close>)
+    (flow fd :> Eio.File.ro_ty r)
 
-  method open_out ~sw ~append ~create path =
+  let open_out t ~sw ~append ~create path =
     let perm, flags =
       match create with
       | `Never            -> 0,    Uring.Open_flags.empty
@@ -401,56 +447,75 @@ class dir ~label (fd : Low_level.dir_fd) = object
       | `Exclusive   perm -> perm, Uring.Open_flags.(creat + excl)
     in
     let flags = if append then Uring.Open_flags.(flags + append) else flags in
-    let fd = Low_level.openat ~sw fd path
+    let fd = Low_level.openat ~sw t.fd path
         ~access:`RW
         ~flags:Uring.Open_flags.(cloexec + flags)
         ~perm
     in
-    (flow fd :> <Eio.File.rw; Eio.Flow.close>)
+    (flow fd :> Eio.File.rw_ty r)
 
-  method open_dir ~sw path =
+  let open_dir t ~sw path =
-    let fd = Low_level.openat ~sw ~seekable:false fd (if path = "" then "." else path)
+    let fd = Low_level.openat ~sw ~seekable:false t.fd (if path = "" then "." else path)
         ~access:`R
         ~flags:Uring.Open_flags.(cloexec + path + directory)
         ~perm:0
     in
     let label = Filename.basename path in
-    (new dir ~label (Low_level.FD fd) :> <Eio.Fs.dir; Eio.Flow.close>)
+    let d = v ~label (Low_level.FD fd) in
+    Eio.Resource.T (d, Dir_handler.v)
 
-  method mkdir ~perm path = Low_level.mkdir_beneath ~perm fd path
+  let mkdir t ~perm path = Low_level.mkdir_beneath ~perm t.fd path
 
-  method read_dir path =
+  let read_dir t path =
     Switch.run @@ fun sw ->
-    let fd = Low_level.open_dir ~sw fd (if path = "" then "." else path) in
+    let fd = Low_level.open_dir ~sw t.fd (if path = "" then "." else path) in
     Low_level.read_dir fd
 
-  method close =
+  let close t =
-    match fd with
+    match t.fd with
     | FD x -> Fd.close x
     | Cwd | Fs -> failwith "Can't close non-FD directory!"
 
-  method unlink path = Low_level.unlink ~rmdir:false fd path
+  let unlink t path = Low_level.unlink ~rmdir:false t.fd path
-  method rmdir path = Low_level.unlink ~rmdir:true fd path
+  let rmdir t path = Low_level.unlink ~rmdir:true t.fd path
 
-  method rename old_path t2 new_path =
+  let rename t old_path t2 new_path =
     match get_dir_fd_opt t2 with
-    | Some fd2 -> Low_level.rename fd old_path fd2 new_path
+    | Some fd2 -> Low_level.rename t.fd old_path fd2 new_path
     | None -> raise (Unix.Unix_error (Unix.EXDEV, "rename-dst", new_path))
 
-  method pp f = Fmt.string f (String.escaped label)
+  let pp f t = Fmt.string f (String.escaped t.label)
+
+  let fd t = t.fd
+end
+and Dir_handler : sig
+  val v : (Dir.t, [`Dir | `Close]) Eio.Resource.handler
+end = struct
+  let v = Eio.Resource.handler [
+      H (Eio.Fs.Pi.Dir, (module Dir));
+      H (Eio.Resource.Close, Dir.close);
+      H (Dir_fd, Dir.fd);
+    ]
 end
 
-let secure_random = object
+let dir ~label fd = Eio.Resource.T (Dir.v ~label fd, Dir_handler.v)
-  inherit Eio.Flow.source
+
-  method read_into buf = Low_level.getrandom buf; Cstruct.length buf
+module Secure_random = struct
+  type t = unit
+  let single_read () buf = Low_level.getrandom buf; Cstruct.length buf
+  let read_methods = []
 end
 
+let secure_random =
+  let ops = Eio.Flow.Pi.source (module Secure_random) in
+  Eio.Resource.T ((), ops)
+
 let stdenv ~run_event_loop =
   let stdin = source Eio_unix.Fd.stdin in
   let stdout = sink Eio_unix.Fd.stdout in
   let stderr = sink Eio_unix.Fd.stderr in
-  let fs = (new dir ~label:"fs" Fs, "") in
+  let fs = (dir ~label:"fs" Fs, "") in
-  let cwd = (new dir ~label:"cwd" Cwd, "") in
+  let cwd = (dir ~label:"cwd" Cwd, "") in
   object (_ : stdenv)
     method stdin  = stdin
     method stdout = stdout
@@ -460,8 +525,8 @@ let stdenv ~run_event_loop =
     method domain_mgr = domain_mgr ~run_event_loop
     method clock = clock
     method mono_clock = mono_clock
-    method fs = (fs :> Eio.Fs.dir Eio.Path.t)
+    method fs = (fs :> Eio.Fs.dir_ty Eio.Path.t)
-    method cwd = (cwd :> Eio.Fs.dir Eio.Path.t)
+    method cwd = (cwd :> Eio.Fs.dir_ty Eio.Path.t)
     method secure_random = secure_random
     method debug = Eio.Private.Debug.v
     method backend_id = "linux"
@@ -476,7 +541,7 @@ let run_event_loop (type a) ?fallback config (main : _ -> a) arg : a =
       | Eio_unix.Private.Get_monotonic_clock -> Some (fun k -> continue k mono_clock)
       | Eio_unix.Net.Import_socket_stream (sw, close_unix, fd) -> Some (fun k ->
           let fd = Fd.of_unix ~sw ~seekable:false ~close_unix fd in
-          continue k (flow fd :> Eio_unix.Net.stream_socket)
+          continue k (flow fd :> _ Eio_unix.Net.stream_socket)
         )
       | Eio_unix.Net.Import_socket_datagram (sw, close_unix, fd) -> Some (fun k ->
           let fd = Fd.of_unix ~sw ~seekable:false ~close_unix fd in
@@ -487,7 +552,7 @@ let run_event_loop (type a) ?fallback config (main : _ -> a) arg : a =
             let a, b = Unix.socketpair ~cloexec:true domain Unix.SOCK_STREAM protocol in
             let a = Fd.of_unix ~sw ~seekable:false ~close_unix:true a |> flow in
             let b = Fd.of_unix ~sw ~seekable:false ~close_unix:true b |> flow in
-            ((a :> Eio_unix.Net.stream_socket), (b :> Eio_unix.Net.stream_socket))
+            ((a :> _ Eio_unix.Net.stream_socket), (b :> _ Eio_unix.Net.stream_socket))
           with
           | r -> continue k r
           | exception Unix.Unix_error (code, name, arg) ->
@@ -498,7 +563,7 @@ let run_event_loop (type a) ?fallback config (main : _ -> a) arg : a =
             let a, b = Unix.socketpair ~cloexec:true domain Unix.SOCK_DGRAM protocol in
             let a = Fd.of_unix ~sw ~seekable:false ~close_unix:true a |> datagram_socket in
             let b = Fd.of_unix ~sw ~seekable:false ~close_unix:true b |> datagram_socket in
-            ((a :> Eio_unix.Net.datagram_socket), (b :> Eio_unix.Net.datagram_socket))
+            ((a :> _ Eio_unix.Net.datagram_socket), (b :> _ Eio_unix.Net.datagram_socket))
           with
           | r -> continue k r
           | exception Unix.Unix_error (code, name, arg) ->
@@ -507,8 +572,8 @@ let run_event_loop (type a) ?fallback config (main : _ -> a) arg : a =
       | Eio_unix.Private.Pipe sw -> Some (fun k ->
           match
             let r, w = Low_level.pipe ~sw in
-            let r = (flow r :> Eio_unix.source) in
+            let r = (flow r :> _ Eio_unix.source) in
-            let w = (flow w :> Eio_unix.sink) in
+            let w = (flow w :> _ Eio_unix.sink) in
             (r, w)
           with
           | r -> continue k r

lib_eio_linux/eio_linux.mli

@@ -25,15 +25,10 @@ open Eio.Std
 
 type fd := Eio_unix.Fd.t
 
-(** {1 Eio API} *)
+(** {1 Main Loop} *)
-
-type source = Eio_unix.source
-type sink   = Eio_unix.sink
 
 type stdenv = Eio_unix.Stdenv.base
 
-(** {1 Main Loop} *)
-
 val run :
   ?queue_depth:int ->
   ?n_blocks:int ->

lib_eio_posix/domain_mgr.ml

@@ -20,7 +20,7 @@ open Eio.Std
 
 module Fd = Eio_unix.Fd
 
-let socketpair k ~sw ~domain ~ty ~protocol ~wrap =
+let socketpair k ~sw ~domain ~ty ~protocol wrap_a wrap_b =
   let open Effect.Deep in
   match
     let unix_a, unix_b = Unix.socketpair ~cloexec:true domain ty protocol in
@@ -28,7 +28,7 @@ let socketpair k ~sw ~domain ~ty ~protocol ~wrap =
     let b = Fd.of_unix ~sw ~blocking:false ~close_unix:true unix_b in
     Unix.set_nonblock unix_a;
     Unix.set_nonblock unix_b;
-    (wrap a, wrap b)
+    (wrap_a a, wrap_b b)
   with
   | r -> continue k r
   | exception Unix.Unix_error (code, name, arg) ->
@@ -45,7 +45,7 @@ let run_event_loop fn x =
       | Eio_unix.Net.Import_socket_stream (sw, close_unix, unix_fd) -> Some (fun k ->
           let fd = Fd.of_unix ~sw ~blocking:false ~close_unix unix_fd in
           Unix.set_nonblock unix_fd;
-          continue k (Flow.of_fd fd :> Eio_unix.Net.stream_socket)
+          continue k (Flow.of_fd fd :> _ Eio_unix.Net.stream_socket)
         )
       | Eio_unix.Net.Import_socket_datagram (sw, close_unix, unix_fd) -> Some (fun k ->
           let fd = Fd.of_unix ~sw ~blocking:false ~close_unix unix_fd in
@@ -53,18 +53,18 @@ let run_event_loop fn x =
           continue k (Net.datagram_socket fd)
         )
       | Eio_unix.Net.Socketpair_stream (sw, domain, protocol) -> Some (fun k ->
-          socketpair k ~sw ~domain ~protocol ~ty:Unix.SOCK_STREAM
+          let wrap fd = (Flow.of_fd fd :> _ Eio_unix.Net.stream_socket) in
-            ~wrap:(fun fd -> (Flow.of_fd fd :> Eio_unix.Net.stream_socket))
+          socketpair k ~sw ~domain ~protocol ~ty:Unix.SOCK_STREAM wrap wrap
         )
       | Eio_unix.Net.Socketpair_datagram (sw, domain, protocol) -> Some (fun k ->
-          socketpair k ~sw ~domain ~protocol ~ty:Unix.SOCK_DGRAM
+          let wrap fd = Net.datagram_socket fd in
-            ~wrap:(fun fd -> Net.datagram_socket fd)
+          socketpair k ~sw ~domain ~protocol ~ty:Unix.SOCK_DGRAM wrap wrap
         )
       | Eio_unix.Private.Pipe sw -> Some (fun k ->
           match
             let r, w = Low_level.pipe ~sw in
-            let source = (Flow.of_fd r :> Eio_unix.source) in
+            let source = Flow.of_fd r in
-            let sink = (Flow.of_fd w :> Eio_unix.sink) in
+            let sink = Flow.of_fd w in
             (source, sink)
           with
           | r -> continue k r

lib_eio_posix/eio_posix.ml

@@ -22,9 +22,9 @@ let run main =
   (* SIGPIPE makes no sense in a modern application. *)
   Sys.(set_signal sigpipe Signal_ignore);
   Eio_unix.Process.install_sigchld_handler ();
-  let stdin = (Flow.of_fd Eio_unix.Fd.stdin :> Eio_unix.source) in
+  let stdin = (Flow.of_fd Eio_unix.Fd.stdin :> _ Eio_unix.source) in
-  let stdout = (Flow.of_fd Eio_unix.Fd.stdout :> Eio_unix.sink) in
+  let stdout = (Flow.of_fd Eio_unix.Fd.stdout :> _ Eio_unix.sink) in
-  let stderr = (Flow.of_fd Eio_unix.Fd.stderr :> Eio_unix.sink) in
+  let stderr = (Flow.of_fd Eio_unix.Fd.stderr :> _ Eio_unix.sink) in
   Domain_mgr.run_event_loop main @@ object (_ : stdenv)
     method stdin = stdin
     method stdout = stdout
@@ -35,8 +35,8 @@ let run main =
     method net = Net.v
     method process_mgr = Process.v
     method domain_mgr = Domain_mgr.v
-    method cwd = ((Fs.cwd, "") :> Eio.Fs.dir Eio.Path.t)
+    method cwd = ((Fs.cwd, "") :> Eio.Fs.dir_ty Eio.Path.t)
-    method fs = ((Fs.fs, "") :> Eio.Fs.dir Eio.Path.t)
+    method fs = ((Fs.fs, "") :> Eio.Fs.dir_ty Eio.Path.t)
     method secure_random = Flow.secure_random
     method backend_id = "posix"
   end

lib_eio_posix/flow.ml

@@ -1,98 +1,108 @@
+open Eio.Std
+
 module Fd = Eio_unix.Fd
 
-let fstat fd =
+module Impl = struct
-  try
+  type tag = [`Generic | `Unix]
-    let ust = Low_level.fstat fd in
-    let st_kind : Eio.File.Stat.kind =
-      match ust.st_kind with
-      | Unix.S_REG  -> `Regular_file
-      | Unix.S_DIR  -> `Directory
-      | Unix.S_CHR  -> `Character_special
-      | Unix.S_BLK  -> `Block_device
-      | Unix.S_LNK  -> `Symbolic_link
-      | Unix.S_FIFO -> `Fifo
-      | Unix.S_SOCK -> `Socket
-    in
-    Eio.File.Stat.{
-      dev     = ust.st_dev   |> Int64.of_int;
-      ino     = ust.st_ino   |> Int64.of_int;
-      kind    = st_kind;
-      perm    = ust.st_perm;
-      nlink   = ust.st_nlink |> Int64.of_int;
-      uid     = ust.st_uid   |> Int64.of_int;
-      gid     = ust.st_gid   |> Int64.of_int;
-      rdev    = ust.st_rdev  |> Int64.of_int;
-      size    = ust.st_size  |> Optint.Int63.of_int64;
-      atime   = ust.st_atime;
-      mtime   = ust.st_mtime;
-      ctime   = ust.st_ctime;
-    }
-  with Unix.Unix_error (code, name, arg) -> raise @@ Err.wrap code name arg
 
-let write_bufs fd bufs =
+  type t = Eio_unix.Fd.t
-  try
-    let rec loop = function
-      | [] -> ()
-      | bufs ->
-        let wrote = Low_level.writev fd (Array.of_list bufs) in
-        loop (Cstruct.shiftv bufs wrote)
-    in
-    loop bufs
-  with Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg)
 
-let copy src dst =
+  let stat t =
-  let buf = Cstruct.create 4096 in
+    try
-  try
+      let ust = Low_level.fstat t in
-    while true do
+      let st_kind : Eio.File.Stat.kind =
-      let got = Eio.Flow.single_read src buf in
+        match ust.st_kind with
-      write_bufs dst [Cstruct.sub buf 0 got]
+        | Unix.S_REG  -> `Regular_file
-    done
+        | Unix.S_DIR  -> `Directory
-  with End_of_file -> ()
+        | Unix.S_CHR  -> `Character_special
+        | Unix.S_BLK  -> `Block_device
+        | Unix.S_LNK  -> `Symbolic_link
+        | Unix.S_FIFO -> `Fifo
+        | Unix.S_SOCK -> `Socket
+      in
+      Eio.File.Stat.{
+        dev     = ust.st_dev   |> Int64.of_int;
+        ino     = ust.st_ino   |> Int64.of_int;
+        kind    = st_kind;
+        perm    = ust.st_perm;
+        nlink   = ust.st_nlink |> Int64.of_int;
+        uid     = ust.st_uid   |> Int64.of_int;
+        gid     = ust.st_gid   |> Int64.of_int;
+        rdev    = ust.st_rdev  |> Int64.of_int;
+        size    = ust.st_size  |> Optint.Int63.of_int64;
+        atime   = ust.st_atime;
+        mtime   = ust.st_mtime;
+        ctime   = ust.st_ctime;
+      }
+    with Unix.Unix_error (code, name, arg) -> raise @@ Err.wrap code name arg
 
-let read fd buf =
+  let write t bufs =
-  match Low_level.readv fd [| buf |] with
+    try
-  | 0 -> raise End_of_file
+      let rec loop = function
-  | got -> got
+        | [] -> ()
-  | exception (Unix.Unix_error (code, name, arg)) -> raise (Err.wrap code name arg)
+        | bufs ->
+          let wrote = Low_level.writev t (Array.of_list bufs) in
+          loop (Cstruct.shiftv bufs wrote)
+      in
+      loop bufs
+    with Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg)
 
-let shutdown fd cmd =
+  let copy dst ~src =
-  try
+    let buf = Cstruct.create 4096 in
-    Low_level.shutdown fd @@ match cmd with
+    try
-    | `Receive -> Unix.SHUTDOWN_RECEIVE
+      while true do
-    | `Send -> Unix.SHUTDOWN_SEND
+        let got = Eio.Flow.single_read src buf in
-    | `All -> Unix.SHUTDOWN_ALL
+        write dst [Cstruct.sub buf 0 got]
-  with
+      done
-  | Unix.Unix_error (Unix.ENOTCONN, _, _) -> ()
+    with End_of_file -> ()
-  | Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg)
 
-let of_fd fd = object (_ : <Eio_unix.Net.stream_socket; Eio.File.rw>)
+  let single_read t buf =
-  method fd = fd
+    match Low_level.readv t [| buf |] with
+    | 0 -> raise End_of_file
+    | got -> got
+    | exception (Unix.Unix_error (code, name, arg)) -> raise (Err.wrap code name arg)
 
-  method read_methods = []
+  let shutdown t cmd =
-  method copy src = copy src fd
+    try
+      Low_level.shutdown t @@ match cmd with
+      | `Receive -> Unix.SHUTDOWN_RECEIVE
+      | `Send -> Unix.SHUTDOWN_SEND
+      | `All -> Unix.SHUTDOWN_ALL
+    with
+    | Unix.Unix_error (Unix.ENOTCONN, _, _) -> ()
+    | Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg)
 
-  method pread ~file_offset bufs =
+  let read_methods = []
-    let got = Low_level.preadv ~file_offset fd (Array.of_list bufs) in
+
+  let pread t ~file_offset bufs =
+    let got = Low_level.preadv ~file_offset t (Array.of_list bufs) in
     if got = 0 then raise End_of_file
     else got
 
-  method pwrite ~file_offset bufs = Low_level.pwritev ~file_offset fd (Array.of_list bufs)
+  let pwrite t ~file_offset bufs = Low_level.pwritev ~file_offset t (Array.of_list bufs)
 
-  method stat = fstat fd
+  let fd t = t
-  method read_into buf = read fd buf
-  method write bufs = write_bufs fd bufs
-  method shutdown cmd = shutdown fd cmd
-  method close = Fd.close fd
 
-  method probe : type a. a Eio.Generic.ty -> a option = function
+  let close = Eio_unix.Fd.close
-    | Eio_unix.Resource.FD -> Some fd
-    | _ -> None
 end
 
-let secure_random = object
+let handler = Eio_unix.Resource.flow_handler (module Impl)
-  inherit Eio.Flow.source
 
-  method read_into buf =
+let of_fd fd =
+  let r = Eio.Resource.T (fd, handler) in
+  (r : [`Unix_fd | Eio_unix.Net.stream_socket_ty | Eio.File.rw_ty] r :>
+     [< `Unix_fd | Eio_unix.Net.stream_socket_ty | Eio.File.rw_ty] r)
+
+module Secure_random = struct
+  type t = unit
+
+  let single_read () buf =
     Low_level.getrandom buf;
     Cstruct.length buf
+
+  let read_methods = []
 end
+
+let secure_random =
+  let ops = Eio.Flow.Pi.source (module Secure_random) in
+  Eio.Resource.T ((), ops)

lib_eio_posix/fs.ml

@@ -26,43 +26,77 @@ open Eio.Std
 
 module Fd = Eio_unix.Fd
 
-class virtual posix_dir = object
+module rec Dir : sig
-  inherit Eio.Fs.dir
+  include Eio.Fs.Pi.DIR
 
-  val virtual opt_nofollow : Low_level.Open_flags.t
+  val v : label:string -> sandbox:bool -> string -> t
-  (** Extra flags for open operations. Sandboxes will add [O_NOFOLLOW] here. *)
 
-  method virtual private resolve : string -> string
+  val resolve : t -> string -> string
-  (** [resolve path] returns the real path that should be used to access [path].
+  (** [resolve t path] returns the real path that should be used to access [path].
       For sandboxes, this is [realpath path] (and it checks that it is within the sandbox).
-      For unrestricted access, this is the identity function. *)
+      For unrestricted access, this returns [path] unchanged.
+      @raise Eio.Fs.Permission_denied if sandboxed and [path] is outside of [dir_path]. *)
 
-  method virtual with_parent_dir : 'a. (string -> (Fd.t option -> string -> 'a) -> 'a)
+  val with_parent_dir : t -> string -> (Fd.t option -> string -> 'a) -> 'a
-  (** [with_parent_dir path fn] runs [fn dir_fd rel_path],
+  (** [with_parent_dir t path fn] runs [fn dir_fd rel_path],
       where [rel_path] accessed relative to [dir_fd] gives access to [path].
       For unrestricted access, this just runs [fn None path].
       For sandboxes, it opens the parent of [path] as [dir_fd] and runs [fn (Some dir_fd) (basename path)]. *)
-end
+end = struct
+  type t = {
+    dir_path : string;
+    sandbox : bool;
+    label : string;
+    mutable closed : bool;
+  }
 
-(* When renaming, we get a plain [Eio.Fs.dir]. We need extra access to check
+  let resolve t path =
-   that the new location is within its sandbox. *)
+    if t.sandbox then (
-type _ Eio.Generic.ty += Posix_dir : posix_dir Eio.Generic.ty
+      if t.closed then Fmt.invalid_arg "Attempt to use closed directory %S" t.dir_path;
-let as_posix_dir x = Eio.Generic.probe x Posix_dir
+      if Filename.is_relative path then (
+        let dir_path = Err.run Low_level.realpath t.dir_path in
+        let full = Err.run Low_level.realpath (Filename.concat dir_path path) in
+        let prefix_len = String.length dir_path + 1 in
+        if String.length full >= prefix_len && String.sub full 0 prefix_len = dir_path ^ Filename.dir_sep then
+          full
+        else if full = dir_path then
+          full
+        else
+          raise @@ Eio.Fs.err (Permission_denied (Err.Outside_sandbox (full, dir_path)))
+      ) else (
+        raise @@ Eio.Fs.err (Permission_denied Err.Absolute_path)
+      )
+    ) else path
 
-class virtual dir ~label = object (self)
+  let with_parent_dir t path fn =
-  inherit posix_dir
+    if t.sandbox then (
+      if t.closed then Fmt.invalid_arg "Attempt to use closed directory %S" t.dir_path;
+      let dir, leaf = Filename.dirname path, Filename.basename path in
+      if leaf = ".." then (
+        (* We could be smarter here and normalise the path first, but '..'
+           doesn't make sense for any of the current uses of [with_parent_dir]
+           anyway. *)
+        raise (Eio.Fs.err (Permission_denied (Err.Invalid_leaf leaf)))
+      ) else (
+        let dir = resolve t dir in
+        Switch.run @@ fun sw ->
+        let dirfd = Low_level.openat ~sw ~mode:0 dir Low_level.Open_flags.(directory + rdonly + nofollow) in
+        fn (Some dirfd) leaf
+      )
+    ) else fn None path
 
-  val mutable closed = false
+  let v ~label ~sandbox dir_path = { dir_path; sandbox; label; closed = false }
 
-  method! probe : type a. a Eio.Generic.ty -> a option = function
+  (* Sandboxes use [O_NOFOLLOW] when opening files ([resolve] already removed any symlinks).
-    | Posix_dir -> Some (self :> posix_dir)
+     This avoids a race where symlink might be added after [realpath] returns. *)
-    | _ -> None
+  let opt_nofollow t =
+    if t.sandbox then Low_level.Open_flags.nofollow else Low_level.Open_flags.empty
 
-  method open_in ~sw path =
+  let open_in t ~sw path =
-    let fd = Err.run (Low_level.openat ~mode:0 ~sw (self#resolve path)) Low_level.Open_flags.(opt_nofollow + rdonly) in
+    let fd = Err.run (Low_level.openat ~mode:0 ~sw (resolve t path)) Low_level.Open_flags.(opt_nofollow t + rdonly) in
-    (Flow.of_fd fd :> <Eio.File.ro; Eio.Flow.close>)
+    (Flow.of_fd fd :> Eio.File.ro_ty Eio.Resource.t)
 
-  method open_out ~sw ~append ~create path =
+  let rec open_out t ~sw ~append ~create path =
     let mode, flags =
       match create with
       | `Never            -> 0,    Low_level.Open_flags.empty
@@ -71,12 +105,12 @@ class virtual dir ~label = object (self)
       | `Exclusive   perm -> perm, Low_level.Open_flags.(creat + excl)
     in
     let flags = if append then Low_level.Open_flags.(flags + append) else flags in
-    let flags = Low_level.Open_flags.(flags + rdwr + opt_nofollow) in
+    let flags = Low_level.Open_flags.(flags + rdwr + opt_nofollow t) in
     match
-      self#with_parent_dir path @@ fun dirfd path ->
+      with_parent_dir t path @@ fun dirfd path ->
       Low_level.openat ?dirfd ~sw ~mode path flags
     with
-    | fd -> (Flow.of_fd fd :> <Eio.File.rw; Eio.Flow.close>)
+    | fd -> (Flow.of_fd fd :> Eio.File.rw_ty r)
     | exception Unix.Unix_error (ELOOP, _, _) ->
       (* The leaf was a symlink (or we're unconfined and the main path changed, but ignore that).
          A leaf symlink might be OK, but we need to check it's still in the sandbox.
@@ -87,96 +121,67 @@ class virtual dir ~label = object (self)
           Filename.concat (Filename.dirname path) target
         else target
       in
-      self#open_out ~sw ~append ~create full_target
+      open_out t ~sw ~append ~create full_target
     | exception Unix.Unix_error (code, name, arg) ->
       raise (Err.wrap code name arg)
 
-  method mkdir ~perm path =
+  let mkdir t ~perm path =
-    self#with_parent_dir path @@ fun dirfd path ->
+    with_parent_dir t path @@ fun dirfd path ->
     Err.run (Low_level.mkdir ?dirfd ~mode:perm) path
 
-  method unlink path =
+  let unlink t path =
-    self#with_parent_dir path @@ fun dirfd path ->
+    with_parent_dir t path @@ fun dirfd path ->
     Err.run (Low_level.unlink ?dirfd ~dir:false) path
 
-  method rmdir path =
+  let rmdir t path =
-    self#with_parent_dir path @@ fun dirfd path ->
+    with_parent_dir t path @@ fun dirfd path ->
     Err.run (Low_level.unlink ?dirfd ~dir:true) path
 
-  method read_dir path =
+  let read_dir t path =
     (* todo: need fdopendir here to avoid races *)
-    let path = self#resolve path in
+    let path = resolve t path in
     Err.run Low_level.readdir path
     |> Array.to_list
 
-  method rename old_path new_dir new_path =
+  let rename t old_path new_dir new_path =
-    match as_posix_dir new_dir with
+    match Handler.as_posix_dir new_dir with
     | None -> invalid_arg "Target is not an eio_posix directory!"
     | Some new_dir ->
-      self#with_parent_dir old_path @@ fun old_dir old_path ->
+      with_parent_dir t old_path @@ fun old_dir old_path ->
-      new_dir#with_parent_dir new_path @@ fun new_dir new_path ->
+      with_parent_dir new_dir new_path @@ fun new_dir new_path ->
       Err.run (Low_level.rename ?old_dir old_path ?new_dir) new_path
 
-  method open_dir ~sw path =
+  let close t = t.closed <- true
+
+  let open_dir t ~sw path =
     Switch.check sw;
     let label = Filename.basename path in
-    let d = new sandbox ~label (self#resolve path) in
+    let d = v ~label (resolve t path) ~sandbox:true in
-    Switch.on_release sw (fun () -> d#close);
+    Switch.on_release sw (fun () -> close d);
-    (d :> Eio.Fs.dir_with_close)
+    Eio.Resource.T (d, Handler.v)
 
-  method close = closed <- true
+  let pp f t = Fmt.string f (String.escaped t.label)
-
-  method pp f = Fmt.string f (String.escaped label)
 end
+and Handler : sig
+  val v : (Dir.t, [`Dir | `Close]) Eio.Resource.handler
 
-and sandbox ~label dir_path = object (self)
+  val as_posix_dir : [> `Dir] r -> Dir.t option
-  inherit dir ~label
+end = struct
+  (* When renaming, we get a plain [Eio.Fs.dir]. We need extra access to check
+     that the new location is within its sandbox. *)
+  type (_, _, _) Eio.Resource.pi += Posix_dir : ('t, 't -> Dir.t, [> `Posix_dir]) Eio.Resource.pi
 
-  val opt_nofollow = Low_level.Open_flags.nofollow
+  let as_posix_dir (Eio.Resource.T (t, ops)) =
+    match Eio.Resource.get_opt ops Posix_dir with
+    | None -> None
+    | Some fn -> Some (fn t)
 
-  (* Resolve a relative path to an absolute one, with no symlinks.
+  let v = Eio.Resource.handler [
-     @raise Eio.Fs.Permission_denied if it's outside of [dir_path]. *)
+      H (Eio.Fs.Pi.Dir, (module Dir));
-  method private resolve path =
+      H (Posix_dir, Fun.id);
-    if closed then Fmt.invalid_arg "Attempt to use closed directory %S" dir_path;
+    ]
-    if Filename.is_relative path then (
-      let dir_path = Err.run Low_level.realpath dir_path in
-      let full = Err.run Low_level.realpath (Filename.concat dir_path path) in
-      let prefix_len = String.length dir_path + 1 in
-      if String.length full >= prefix_len && String.sub full 0 prefix_len = dir_path ^ Filename.dir_sep then
-        full
-      else if full = dir_path then
-        full
-      else
-        raise @@ Eio.Fs.err (Permission_denied (Err.Outside_sandbox (full, dir_path)))
-    ) else (
-      raise @@ Eio.Fs.err (Permission_denied Err.Absolute_path)
-    )
-
-  method with_parent_dir path fn =
-    if closed then Fmt.invalid_arg "Attempt to use closed directory %S" dir_path;
-    let dir, leaf = Filename.dirname path, Filename.basename path in
-    if leaf = ".." then (
-      (* We could be smarter here and normalise the path first, but '..'
-         doesn't make sense for any of the current uses of [with_parent_dir]
-         anyway. *)
-      raise (Eio.Fs.err (Permission_denied (Err.Invalid_leaf leaf)))
-    ) else (
-      let dir = self#resolve dir in
-      Switch.run @@ fun sw ->
-      let dirfd = Low_level.openat ~sw ~mode:0 dir Low_level.Open_flags.(directory + rdonly + nofollow) in
-      fn (Some dirfd) leaf
-    )
 end
 
 (* Full access to the filesystem. *)
-let fs = object
+let fs = Eio.Resource.T (Dir.v ~label:"fs" ~sandbox:false ".", Handler.v)
-  inherit dir ~label:"fs"
+let cwd = Eio.Resource.T (Dir.v ~label:"cwd" ~sandbox:true ".", Handler.v)
-
-  val opt_nofollow = Low_level.Open_flags.empty
-
-  (* No checks *)
-  method private resolve path = path
-  method private with_parent_dir path fn = fn None path
-end
-
-let cwd = new sandbox ~label:"cwd" "."

lib_eio_posix/net.ml

@@ -12,44 +12,71 @@ let socket_domain_of = function
       ~v4:(fun _ -> Unix.PF_INET)
       ~v6:(fun _ -> Unix.PF_INET6)
 
-let listening_socket ~hook fd = object
+module Listening_socket = struct
-  inherit Eio.Net.listening_socket
+  type t = {
+    hook : Switch.hook;
+    fd : Fd.t;
+  }
 
-  method close =
+  type tag = [`Generic | `Unix]
-    Switch.remove_hook hook;
-    Fd.close fd
 
-  method accept ~sw =
+  let make ~hook fd = { hook; fd }
-    let client, client_addr = Err.run (Low_level.accept ~sw) fd in
+
+  let fd t = t.fd
+
+  let close t =
+    Switch.remove_hook t.hook;
+    Fd.close t.fd
+
+  let accept t ~sw =
+    let client, client_addr = Err.run (Low_level.accept ~sw) t.fd in
     let client_addr = match client_addr with
       | Unix.ADDR_UNIX path         -> `Unix path
       | Unix.ADDR_INET (host, port) -> `Tcp (Eio_unix.Net.Ipaddr.of_unix host, port)
     in
-    let flow = (Flow.of_fd client :> Eio.Net.stream_socket) in
+    let flow = (Flow.of_fd client :> _ Eio.Net.stream_socket) in
     flow, client_addr
-
-  method! probe : type a. a Eio.Generic.ty -> a option = function
-    | Eio_unix.Resource.FD -> Some fd
-    | _ -> None
 end
 
-let datagram_socket sock = object
+let listening_handler = Eio_unix.Resource.listening_socket_handler (module Listening_socket)
-  inherit Eio_unix.Net.datagram_socket
 
-  method close = Fd.close sock
+let listening_socket ~hook fd =
+  Eio.Resource.T (Listening_socket.make ~hook fd, listening_handler)
 
-  method fd = sock
+module Datagram_socket = struct
+  type tag = [`Generic | `Unix]
 
-  method send ?dst buf =
+  type t = Eio_unix.Fd.t
+
+  let close = Fd.close
+
+  let fd t = t
+
+  let send t ?dst buf =
     let dst = Option.map Eio_unix.Net.sockaddr_to_unix dst in
-    let sent = Err.run (Low_level.send_msg sock ?dst) (Array.of_list buf) in
+    let sent = Err.run (Low_level.send_msg t ?dst) (Array.of_list buf) in
     assert (sent = Cstruct.lenv buf)
 
-  method recv buf =
+  let recv t buf =
-    let addr, recv = Err.run (Low_level.recv_msg sock) [| buf |] in
+    let addr, recv = Err.run (Low_level.recv_msg t) [| buf |] in
     Eio_unix.Net.sockaddr_of_unix_datagram addr, recv
+
+  let shutdown t cmd =
+    try
+      Low_level.shutdown t @@ match cmd with
+      | `Receive -> Unix.SHUTDOWN_RECEIVE
+      | `Send -> Unix.SHUTDOWN_SEND
+      | `All -> Unix.SHUTDOWN_ALL
+    with
+    | Unix.Unix_error (Unix.ENOTCONN, _, _) -> ()
+    | Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg)
 end
 
+let datagram_handler = Eio_unix.Resource.datagram_handler (module Datagram_socket)
+
+let datagram_socket fd =
+  Eio.Resource.T (fd, datagram_handler)
+
 (* https://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml *)
 let getaddrinfo ~service node =
   let to_eio_sockaddr_t {Unix.ai_family; ai_addr; ai_socktype; ai_protocol; _ } =
@@ -105,7 +132,7 @@ let listen ~reuse_addr ~reuse_port ~backlog ~sw (listen_addr : Eio.Net.Sockaddr.
       Unix.bind fd addr;
       Unix.listen fd backlog;
     );
-  listening_socket ~hook sock
+  (listening_socket ~hook sock :> _ Eio.Net.listening_socket_ty r)
 
 let connect ~sw connect_addr =
   let socket_type, addr =
@@ -118,7 +145,7 @@ let connect ~sw connect_addr =
   let sock = Low_level.socket ~sw (socket_domain_of connect_addr) socket_type 0 in
   try
     Low_level.connect sock addr;
-    (Flow.of_fd sock :> Eio.Net.stream_socket)
+    (Flow.of_fd sock :> _ Eio_unix.Net.stream_socket)
   with Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg)
 
 let create_datagram_socket ~reuse_addr ~reuse_port ~sw saddr =
@@ -135,13 +162,26 @@ let create_datagram_socket ~reuse_addr ~reuse_port ~sw saddr =
         )
     | `UdpV4 | `UdpV6 -> ()
   end;
-  (datagram_socket sock :> Eio.Net.datagram_socket)
+  datagram_socket sock
 
-let v = object
+module Impl = struct
-  inherit Eio_unix.Net.t
+  type t = unit
+  type tag = [`Generic | `Unix]
 
-  method listen = listen
+  let listen () = listen
-  method connect = connect
+
-  method datagram_socket = create_datagram_socket
+  let connect () ~sw addr =
-  method getaddrinfo = getaddrinfo
+    let socket = connect ~sw addr in
+    (socket :> [`Generic | `Unix] Eio.Net.stream_socket_ty r)
+
+  let datagram_socket () ~reuse_addr ~reuse_port ~sw saddr =
+    let socket = create_datagram_socket ~reuse_addr ~reuse_port ~sw saddr in
+    (socket :> [`Generic | `Unix] Eio.Net.datagram_socket_ty r)
+
+  let getaddrinfo () = getaddrinfo
+  let getnameinfo () = Eio_unix.Net.getnameinfo
 end
+
+let v : Impl.tag Eio.Net.ty r =
+  let handler = Eio.Net.Pi.network (module Impl) in
+  Eio.Resource.T ((), handler)

lib_eio_posix/process.ml

@@ -24,11 +24,11 @@ let v = object
     ] in
     let with_actions cwd fn = match cwd with
       | None -> fn actions
-      | Some ((dir, path) : Eio.Fs.dir Eio.Path.t) ->
+      | Some ((dir, path) : Eio.Fs.dir_ty Eio.Path.t) ->
-        match Eio.Generic.probe dir Fs.Posix_dir with
+        match Fs.Handler.as_posix_dir dir with
         | None -> Fmt.invalid_arg "cwd is not an OS directory!"
         | Some posix ->
-          posix#with_parent_dir path @@ fun dirfd s ->
+          Fs.Dir.with_parent_dir posix path @@ fun dirfd s ->
           Switch.run @@ fun launch_sw ->
           let cwd = Low_level.openat ?dirfd ~sw:launch_sw ~mode:0 s Low_level.Open_flags.(rdonly + directory) in
           fn (Process.Fork_action.fchdir cwd :: actions)

lib_eio_windows/domain_mgr.ml

@@ -20,7 +20,7 @@ open Eio.Std
 
 module Fd = Eio_unix.Fd
 
-let socketpair k ~sw ~domain ~ty ~protocol ~wrap =
+let socketpair k ~sw ~domain ~ty ~protocol wrap_a wrap_b =
   let open Effect.Deep in
   match
     let unix_a, unix_b = Unix.socketpair ~cloexec:true domain ty protocol in
@@ -28,7 +28,7 @@ let socketpair k ~sw ~domain ~ty ~protocol ~wrap =
     let b = Fd.of_unix ~sw ~blocking:false ~close_unix:true unix_b in
     Unix.set_nonblock unix_a;
     Unix.set_nonblock unix_b;
-    (wrap a, wrap b)
+    (wrap_a a, wrap_b b)
   with
   | r -> continue k r
   | exception Unix.Unix_error (code, name, arg) ->
@@ -46,7 +46,7 @@ let run_event_loop fn x =
           let fd = Fd.of_unix ~sw ~blocking:false ~close_unix unix_fd in
           (* TODO: On Windows, if the FD from Unix.pipe () is passed this will fail *)
           (try Unix.set_nonblock unix_fd with Unix.Unix_error (Unix.ENOTSOCK, _, _) -> ());
-          continue k (Flow.of_fd fd :> Eio_unix.Net.stream_socket)
+          continue k (Flow.of_fd fd :> _ Eio_unix.Net.stream_socket)
         )
       | Eio_unix.Net.Import_socket_datagram (sw, close_unix, unix_fd) -> Some (fun k ->
           let fd = Fd.of_unix ~sw ~blocking:false ~close_unix unix_fd in
@@ -54,18 +54,18 @@ let run_event_loop fn x =
           continue k (Net.datagram_socket fd)
         )
       | Eio_unix.Net.Socketpair_stream (sw, domain, protocol) -> Some (fun k ->
-          socketpair k ~sw ~domain ~protocol ~ty:Unix.SOCK_STREAM
+          let wrap fd = (Flow.of_fd fd :> _ Eio_unix.Net.stream_socket) in
-            ~wrap:(fun fd -> (Flow.of_fd fd :> Eio_unix.Net.stream_socket))
+          socketpair k ~sw ~domain ~protocol ~ty:Unix.SOCK_STREAM wrap wrap
         )
       | Eio_unix.Net.Socketpair_datagram (sw, domain, protocol) -> Some (fun k ->
-          socketpair k ~sw ~domain ~protocol ~ty:Unix.SOCK_DGRAM
+          let wrap fd = Net.datagram_socket fd in
-            ~wrap:(fun fd -> Net.datagram_socket fd)
+          socketpair k ~sw ~domain ~protocol ~ty:Unix.SOCK_DGRAM wrap wrap
         )
       | Eio_unix.Private.Pipe sw -> Some (fun k ->
           match
             let r, w = Low_level.pipe ~sw in
-            let source = (Flow.of_fd r :> Eio_unix.source) in
+            let source = Flow.of_fd r in
-            let sink = (Flow.of_fd w :> Eio_unix.sink) in
+            let sink = Flow.of_fd w in
             (source, sink)
           with
           | r -> continue k r

lib_eio_windows/eio_windows.ml

@@ -19,9 +19,9 @@ module Low_level = Low_level
 type stdenv = Eio_unix.Stdenv.base
 
 let run main =
-  let stdin = (Flow.of_fd Eio_unix.Fd.stdin :> Eio_unix.source) in
+  let stdin = (Flow.of_fd Eio_unix.Fd.stdin :> _ Eio_unix.source) in
-  let stdout = (Flow.of_fd Eio_unix.Fd.stdout :> Eio_unix.sink) in
+  let stdout = (Flow.of_fd Eio_unix.Fd.stdout :> _ Eio_unix.sink) in
-  let stderr = (Flow.of_fd Eio_unix.Fd.stderr :> Eio_unix.sink) in
+  let stderr = (Flow.of_fd Eio_unix.Fd.stderr :> _ Eio_unix.sink) in
   Domain_mgr.run_event_loop main @@ object (_ : stdenv)
     method stdin = stdin
     method stdout = stdout
@@ -31,8 +31,8 @@ let run main =
     method mono_clock = Time.mono_clock
     method net = Net.v
     method domain_mgr = Domain_mgr.v
-    method cwd = ((Fs.cwd, "") :> Eio.Fs.dir Eio.Path.t)
+    method cwd = ((Fs.cwd, "") :> Eio.Fs.dir_ty Eio.Path.t)
-    method fs = ((Fs.fs, "") :> Eio.Fs.dir Eio.Path.t)
+    method fs = ((Fs.fs, "") :> Eio.Fs.dir_ty Eio.Path.t)
     method process_mgr = failwith "process operations not supported on Windows yet"
     method secure_random = Flow.secure_random
     method backend_id = "windows"

lib_eio_windows/flow.ml

@@ -1,92 +1,101 @@
+open Eio.Std
+
 module Fd = Eio_unix.Fd
 
-let fstat fd =
+module Impl = struct
-  try
+  type tag = [`Generic | `Unix]
-    let ust = Low_level.fstat fd in
-    let st_kind : Eio.File.Stat.kind =
-      match ust.st_kind with
-      | Unix.S_REG  -> `Regular_file
-      | Unix.S_DIR  -> `Directory
-      | Unix.S_CHR  -> `Character_special
-      | Unix.S_BLK  -> `Block_device
-      | Unix.S_LNK  -> `Symbolic_link
-      | Unix.S_FIFO -> `Fifo
-      | Unix.S_SOCK -> `Socket
-    in
-    Eio.File.Stat.{
-      dev     = ust.st_dev   |> Int64.of_int;
-      ino     = ust.st_ino   |> Int64.of_int;
-      kind    = st_kind;
-      perm    = ust.st_perm;
-      nlink   = ust.st_nlink |> Int64.of_int;
-      uid     = ust.st_uid   |> Int64.of_int;
-      gid     = ust.st_gid   |> Int64.of_int;
-      rdev    = ust.st_rdev  |> Int64.of_int;
-      size    = ust.st_size  |> Optint.Int63.of_int64;
-      atime   = ust.st_atime;
-      mtime   = ust.st_mtime;
-      ctime   = ust.st_ctime;
-    }
-  with Unix.Unix_error (code, name, arg) -> raise @@ Err.wrap code name arg
 
-let write_bufs fd bufs =
+  type t = Eio_unix.Fd.t
-  try
-    Low_level.writev fd bufs
-  with Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg)
 
-let copy src dst =
+  let stat t =
-  let buf = Cstruct.create 4096 in
+    try
-  try
+      let ust = Low_level.fstat t in
-    while true do
+      let st_kind : Eio.File.Stat.kind =
-      let got = Eio.Flow.single_read src buf in
+        match ust.st_kind with
-      write_bufs dst [Cstruct.sub buf 0 got]
+        | Unix.S_REG  -> `Regular_file
-    done
+        | Unix.S_DIR  -> `Directory
-  with End_of_file -> ()
+        | Unix.S_CHR  -> `Character_special
+        | Unix.S_BLK  -> `Block_device
+        | Unix.S_LNK  -> `Symbolic_link
+        | Unix.S_FIFO -> `Fifo
+        | Unix.S_SOCK -> `Socket
+      in
+      Eio.File.Stat.{
+        dev     = ust.st_dev   |> Int64.of_int;
+        ino     = ust.st_ino   |> Int64.of_int;
+        kind    = st_kind;
+        perm    = ust.st_perm;
+        nlink   = ust.st_nlink |> Int64.of_int;
+        uid     = ust.st_uid   |> Int64.of_int;
+        gid     = ust.st_gid   |> Int64.of_int;
+        rdev    = ust.st_rdev  |> Int64.of_int;
+        size    = ust.st_size  |> Optint.Int63.of_int64;
+        atime   = ust.st_atime;
+        mtime   = ust.st_mtime;
+        ctime   = ust.st_ctime;
+      }
+    with Unix.Unix_error (code, name, arg) -> raise @@ Err.wrap code name arg
 
-let read fd buf =
+  let write t bufs =
-  match Low_level.read_cstruct fd buf with
+    try Low_level.writev t bufs
-  | 0 -> raise End_of_file
+    with Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg)
-  | got -> got
-  | exception (Unix.Unix_error (code, name, arg)) -> raise (Err.wrap code name arg)
 
-let shutdown fd cmd =
+  let copy dst ~src =
-  try
+    let buf = Cstruct.create 4096 in
-    Low_level.shutdown fd @@ match cmd with
+    try
-    | `Receive -> Unix.SHUTDOWN_RECEIVE
+      while true do
-    | `Send -> Unix.SHUTDOWN_SEND
+        let got = Eio.Flow.single_read src buf in
-    | `All -> Unix.SHUTDOWN_ALL
+        write dst [Cstruct.sub buf 0 got]
-  with
+      done
-  | Unix.Unix_error (Unix.ENOTCONN, _, _) -> ()
+    with End_of_file -> ()
-  | Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg)
 
-let of_fd fd = object (_ : <Eio_unix.Net.stream_socket; Eio.File.rw>)
+  let single_read t buf =
-  method fd = fd
+    match Low_level.read_cstruct t buf with
+    | 0 -> raise End_of_file
+    | got -> got
+    | exception (Unix.Unix_error (code, name, arg)) -> raise (Err.wrap code name arg)
 
-  method read_methods = []
+  let shutdown t cmd =
-  method copy src = copy src fd
+    try
+      Low_level.shutdown t @@ match cmd with
+      | `Receive -> Unix.SHUTDOWN_RECEIVE
+      | `Send -> Unix.SHUTDOWN_SEND
+      | `All -> Unix.SHUTDOWN_ALL
+    with
+    | Unix.Unix_error (Unix.ENOTCONN, _, _) -> ()
+    | Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg)
 
-  method pread ~file_offset bufs =
+  let read_methods = []
-    let got = Low_level.preadv ~file_offset fd (Array.of_list bufs) in
+
+  let pread t ~file_offset bufs =
+    let got = Low_level.preadv ~file_offset t (Array.of_list bufs) in
     if got = 0 then raise End_of_file
     else got
 
-  method pwrite ~file_offset bufs = Low_level.pwritev ~file_offset fd (Array.of_list bufs)
+  let pwrite t ~file_offset bufs = Low_level.pwritev ~file_offset t (Array.of_list bufs)
 
-  method stat = fstat fd
+  let fd t = t
-  method read_into buf = read fd buf
-  method write bufs = write_bufs fd bufs
-  method shutdown cmd = shutdown fd cmd
-  method close = Fd.close fd
 
-  method probe : type a. a Eio.Generic.ty -> a option = function
+  let close = Eio_unix.Fd.close
-    | Eio_unix.Resource.FD -> Some fd
-    | _ -> None
 end
 
-let secure_random = object
+let handler = Eio_unix.Resource.flow_handler (module Impl)
-  inherit Eio.Flow.source
 
-  method read_into buf =
+let of_fd fd =
+  let r = Eio.Resource.T (fd, handler) in
+  (r : [Eio_unix.Net.stream_socket_ty | Eio.File.rw_ty] r :>
+     [< Eio_unix.Net.stream_socket_ty | Eio.File.rw_ty] r)
+
+module Secure_random = struct
+  type t = unit
+
+  let single_read () buf =
     Low_level.getrandom buf;
     Cstruct.length buf
+
+  let read_methods = []
 end
+
+let secure_random =
+  let ops = Eio.Flow.Pi.source (module Secure_random) in
+  Eio.Resource.T ((), ops)

lib_eio_windows/fs.ml

@@ -26,44 +26,80 @@ open Eio.Std
 
 module Fd = Eio_unix.Fd
 
-class virtual posix_dir = object
+module rec Dir : sig
-  inherit Eio.Fs.dir
+  include Eio.Fs.Pi.DIR
 
-  val virtual opt_nofollow : bool
+  val v : label:string -> sandbox:bool -> string -> t
-  (** Emulate [O_NOFOLLOW] here. *)
 
-  method virtual private resolve : string -> string
+  val resolve : t -> string -> string
-  (** [resolve path] returns the real path that should be used to access [path].
+  (** [resolve t path] returns the real path that should be used to access [path].
       For sandboxes, this is [realpath path] (and it checks that it is within the sandbox).
-      For unrestricted access, this is the identity function. *)
+      For unrestricted access, this returns [path] unchanged.
+      @raise Eio.Fs.Permission_denied if sandboxed and [path] is outside of [dir_path]. *)
 
-  method virtual with_parent_dir : 'a. (string -> (Fd.t option -> string -> 'a) -> 'a)
+  val with_parent_dir : t -> string -> (Fd.t option -> string -> 'a) -> 'a
-  (** [with_parent_dir path fn] runs [fn dir_fd rel_path],
+  (** [with_parent_dir t path fn] runs [fn dir_fd rel_path],
       where [rel_path] accessed relative to [dir_fd] gives access to [path].
       For unrestricted access, this just runs [fn None path].
       For sandboxes, it opens the parent of [path] as [dir_fd] and runs [fn (Some dir_fd) (basename path)]. *)
-end
+end = struct
+  type t = {
+    dir_path : string;
+    sandbox : bool;
+    label : string;
+    mutable closed : bool;
+  }
 
-(* When renaming, we get a plain [Eio.Fs.dir]. We need extra access to check
+  let resolve t path =
-   that the new location is within its sandbox. *)
+    if t.sandbox then (
-type _ Eio.Generic.ty += Posix_dir : posix_dir Eio.Generic.ty
+      if t.closed then Fmt.invalid_arg "Attempt to use closed directory %S" t.dir_path;
-let as_posix_dir x = Eio.Generic.probe x Posix_dir
+      if Filename.is_relative path then (
+        let dir_path = Err.run Low_level.realpath t.dir_path in
+        let full = Err.run Low_level.realpath (Filename.concat dir_path path) in
+        let prefix_len = String.length dir_path + 1 in
+        (* \\??\\ Is necessary with NtCreateFile. *)
+        if String.length full >= prefix_len && String.sub full 0 prefix_len = dir_path ^ Filename.dir_sep then begin
+          "\\??\\" ^ full
+        end else if full = dir_path then
+          "\\??\\" ^ full
+        else
+          raise @@ Eio.Fs.err (Permission_denied (Err.Outside_sandbox (full, dir_path)))
+      ) else (
+        raise @@ Eio.Fs.err (Permission_denied Err.Absolute_path)
+      )
+    ) else path
 
-class virtual dir ~label = object (self)
+  let with_parent_dir t path fn =
-  inherit posix_dir
+    if t.sandbox then (
+      if t.closed then Fmt.invalid_arg "Attempt to use closed directory %S" t.dir_path;
+      let dir, leaf = Filename.dirname path, Filename.basename path in
+      if leaf = ".." then (
+        (* We could be smarter here and normalise the path first, but '..'
+           doesn't make sense for any of the current uses of [with_parent_dir]
+           anyway. *)
+        raise (Eio.Fs.err (Permission_denied (Err.Invalid_leaf leaf)))
+      ) else (
+        let dir = resolve t dir in
+        Switch.run @@ fun sw ->
+        let open Low_level in
+        let dirfd = Low_level.openat ~sw ~nofollow:true dir Flags.Open.(generic_read + synchronise) Flags.Disposition.(open_if) Flags.Create.(directory) in
+        fn (Some dirfd) leaf
+      )
+    ) else fn None path
 
-  val mutable closed = false
+  let v ~label ~sandbox dir_path = { dir_path; sandbox; label; closed = false }
 
-  method! probe : type a. a Eio.Generic.ty -> a option = function
+  (* Sandboxes use [O_NOFOLLOW] when opening files ([resolve] already removed any symlinks).
-    | Posix_dir -> Some (self :> posix_dir)
+     This avoids a race where symlink might be added after [realpath] returns.
-    | _ -> None
+     TODO: Emulate [O_NOFOLLOW] here. *)
+  let opt_nofollow t = t.sandbox
 
-  method open_in ~sw path =
+  let open_in t ~sw path =
     let open Low_level in
-    let fd = Err.run (Low_level.openat ~sw ~nofollow:opt_nofollow (self#resolve path)) Low_level.Flags.Open.(generic_read + synchronise) Flags.Disposition.(open_if) Flags.Create.(non_directory) in
+    let fd = Err.run (Low_level.openat ~sw ~nofollow:(opt_nofollow t) (resolve t path)) Low_level.Flags.Open.(generic_read + synchronise) Flags.Disposition.(open_if) Flags.Create.(non_directory) in
-    (Flow.of_fd fd :> <Eio.File.ro; Eio.Flow.close>)
+    (Flow.of_fd fd :> Eio.File.ro_ty Eio.Resource.t)
 
-  method open_out ~sw ~append ~create path =
+  let rec open_out t ~sw ~append ~create path =
     let open Low_level in
     let _mode, disp =
       match create with
@@ -72,12 +108,15 @@ class virtual dir ~label = object (self)
       | `Or_truncate perm -> perm, Low_level.Flags.Disposition.overwrite_if
       | `Exclusive   perm -> perm, Low_level.Flags.Disposition.create
     in
-    let flags = if append then Low_level.Flags.Open.(synchronise + append) else Low_level.Flags.Open.(generic_write + synchronise) in
+    let flags =
+      if append then Low_level.Flags.Open.(synchronise + append)
+      else Low_level.Flags.Open.(generic_write + synchronise)
+    in
     match
-      self#with_parent_dir path @@ fun dirfd path ->
+      with_parent_dir t path @@ fun dirfd path ->
-      Low_level.openat ?dirfd ~nofollow:opt_nofollow ~sw path flags disp Flags.Create.(non_directory)
+      Low_level.openat ?dirfd ~nofollow:(opt_nofollow t) ~sw path flags disp Flags.Create.(non_directory)
     with
-    | fd -> (Flow.of_fd fd :> <Eio.File.rw; Eio.Flow.close>)
+    | fd -> (Flow.of_fd fd :> Eio.File.rw_ty r)
     (* This is the result of raising [caml_unix_error(ELOOP,...)] *)
     | exception Unix.Unix_error (EUNKNOWNERR 114, _, _) ->
       print_endline "UNKNOWN";
@@ -90,98 +129,67 @@ class virtual dir ~label = object (self)
           Filename.concat (Filename.dirname path) target
         else target
       in
-      self#open_out ~sw ~append ~create full_target
+      open_out t ~sw ~append ~create full_target
     | exception Unix.Unix_error (code, name, arg) ->
       raise (Err.wrap code name arg)
 
-  method mkdir ~perm path =
+  let mkdir t ~perm path =
-    self#with_parent_dir path @@ fun dirfd path ->
+    with_parent_dir t path @@ fun dirfd path ->
     Err.run (Low_level.mkdir ?dirfd ~mode:perm) path
 
-  method unlink path =
+  let unlink t path =
-    self#with_parent_dir path @@ fun dirfd path ->
+    with_parent_dir t path @@ fun dirfd path ->
     Err.run (Low_level.unlink ?dirfd ~dir:false) path
 
-  method rmdir path =
+  let rmdir t path =
-    self#with_parent_dir path @@ fun dirfd path ->
+    with_parent_dir t path @@ fun dirfd path ->
     Err.run (Low_level.unlink ?dirfd ~dir:true) path
 
-  method read_dir path =
+  let read_dir t path =
     (* todo: need fdopendir here to avoid races *)
-    let path = self#resolve path in
+    let path = resolve t path in
     Err.run Low_level.readdir path
     |> Array.to_list
 
-  method rename old_path new_dir new_path =
+  let rename t old_path new_dir new_path =
-    match as_posix_dir new_dir with
+    match Handler.as_posix_dir new_dir with
     | None -> invalid_arg "Target is not an eio_posix directory!"
     | Some new_dir ->
-      self#with_parent_dir old_path @@ fun old_dir old_path ->
+      with_parent_dir t old_path @@ fun old_dir old_path ->
-      new_dir#with_parent_dir new_path @@ fun new_dir new_path ->
+      with_parent_dir new_dir new_path @@ fun new_dir new_path ->
       Err.run (Low_level.rename ?old_dir old_path ?new_dir) new_path
 
-  method open_dir ~sw path =
+  let close t = t.closed <- true
+
+  let open_dir t ~sw path =
     Switch.check sw;
     let label = Filename.basename path in
-    let d = new sandbox ~label (self#resolve path) in
+    let d = v ~label (resolve t path) ~sandbox:true in
-    Switch.on_release sw (fun () -> d#close);
+    Switch.on_release sw (fun () -> close d);
-    (d :> Eio.Fs.dir_with_close)
+    Eio.Resource.T (d, Handler.v)
 
-  method close = closed <- true
+  let pp f t = Fmt.string f (String.escaped t.label)
-
-  method pp f = Fmt.string f (String.escaped label)
 end
+and Handler : sig
+  val v : (Dir.t, [`Dir | `Close]) Eio.Resource.handler
 
-and sandbox ~label dir_path = object (self)
+  val as_posix_dir : [> `Dir] r -> Dir.t option
-  inherit dir ~label
+end = struct
+  (* When renaming, we get a plain [Eio.Fs.dir]. We need extra access to check
+     that the new location is within its sandbox. *)
+  type (_, _, _) Eio.Resource.pi += Posix_dir : ('t, 't -> Dir.t, [> `Posix_dir]) Eio.Resource.pi
 
-  val opt_nofollow = true
+  let as_posix_dir (Eio.Resource.T (t, ops)) =
+    match Eio.Resource.get_opt ops Posix_dir with
+    | None -> None
+    | Some fn -> Some (fn t)
 
-  (* Resolve a relative path to an absolute one, with no symlinks.
+  let v = Eio.Resource.handler [
-     @raise Eio.Fs.Permission_denied if it's outside of [dir_path]. *)
+      H (Eio.Fs.Pi.Dir, (module Dir));
-  method private resolve path =
+      H (Posix_dir, Fun.id);
-    if closed then Fmt.invalid_arg "Attempt to use closed directory %S" dir_path;
+    ]
-    if Filename.is_relative path then (
-      let dir_path = Err.run Low_level.realpath dir_path in
-      let full = Err.run Low_level.realpath (Filename.concat dir_path path) in
-      let prefix_len = String.length dir_path + 1 in
-      (* \\??\\ Is necessary with NtCreateFile. *)
-      if String.length full >= prefix_len && String.sub full 0 prefix_len = dir_path ^ Filename.dir_sep then begin
-        "\\??\\" ^ full
-      end else if full = dir_path then
-        "\\??\\" ^ full
-      else
-        raise @@ Eio.Fs.err (Permission_denied (Err.Outside_sandbox (full, dir_path)))
-    ) else (
-      raise @@ Eio.Fs.err (Permission_denied Err.Absolute_path)
-    )
-
-  method with_parent_dir path fn =
-    if closed then Fmt.invalid_arg "Attempt to use closed directory %S" dir_path;
-    let dir, leaf = Filename.dirname path, Filename.basename path in
-    if leaf = ".." then (
-      (* We could be smarter here and normalise the path first, but '..'
-         doesn't make sense for any of the current uses of [with_parent_dir]
-         anyway. *)
-      raise (Eio.Fs.err (Permission_denied (Err.Invalid_leaf leaf)))
-    ) else (
-      let dir = self#resolve dir in
-      Switch.run @@ fun sw ->
-      let open Low_level in
-      let dirfd = Low_level.openat ~sw ~nofollow:true dir Flags.Open.(generic_read + synchronise) Flags.Disposition.(open_if) Flags.Create.(directory) in
-      fn (Some dirfd) leaf
-    )
 end
 
 (* Full access to the filesystem. *)
-let fs = object
+let fs = Eio.Resource.T (Dir.v ~label:"fs" ~sandbox:false ".", Handler.v)
-  inherit dir ~label:"fs"
+let cwd = Eio.Resource.T (Dir.v ~label:"cwd" ~sandbox:true ".", Handler.v)
-
-  val opt_nofollow = false
-
-  (* No checks *)
-  method private resolve path = path
-  method private with_parent_dir path fn = fn None path
-end
-
-let cwd = new sandbox ~label:"cwd" "."

lib_eio_windows/net.ml

@@ -12,47 +12,73 @@ let socket_domain_of = function
       ~v4:(fun _ -> Unix.PF_INET)
       ~v6:(fun _ -> Unix.PF_INET6)
 
-let listening_socket ~hook fd = object
+module Listening_socket = struct
-  inherit Eio.Net.listening_socket
+  type t = {
+    hook : Switch.hook;
+    fd : Fd.t;
+  }
 
-  method close =
+  type tag = [`Generic | `Unix]
-    Switch.remove_hook hook;
-    Fd.close fd
 
-  method accept ~sw =
+  let make ~hook fd = { hook; fd }
-    let client, client_addr = Err.run (Low_level.accept ~sw) fd in
+
+  let fd t = t.fd
+
+  let close t =
+    Switch.remove_hook t.hook;
+    Fd.close t.fd
+
+  let accept t ~sw =
+    let client, client_addr = Err.run (Low_level.accept ~sw) t.fd in
     let client_addr = match client_addr with
       | Unix.ADDR_UNIX path         -> `Unix path
       | Unix.ADDR_INET (host, port) -> `Tcp (Eio_unix.Net.Ipaddr.of_unix host, port)
     in
-    let flow = (Flow.of_fd client :> Eio.Net.stream_socket) in
+    let flow = (Flow.of_fd client :> _ Eio.Net.stream_socket) in
     flow, client_addr
-
-  method! probe : type a. a Eio.Generic.ty -> a option = function
-    | Eio_unix.Resource.FD -> Some fd
-    | _ -> None
 end
 
-(* todo: would be nice to avoid copying between bytes and cstructs here *)
+let listening_handler = Eio_unix.Resource.listening_socket_handler (module Listening_socket)
-let datagram_socket sock = object
-  inherit Eio_unix.Net.datagram_socket
 
-  method close = Fd.close sock
+let listening_socket ~hook fd =
+  Eio.Resource.T (Listening_socket.make ~hook fd, listening_handler)
 
-  method fd = sock
+module Datagram_socket = struct
+  type tag = [`Generic | `Unix]
 
-  method send ?dst buf =
+  type t = Eio_unix.Fd.t
+
+  let close = Fd.close
+
+  let fd t = t
+
+  let send t ?dst buf =
     let dst = Option.map Eio_unix.Net.sockaddr_to_unix dst in
-    let sent = Err.run (Low_level.send_msg sock ?dst) (Bytes.unsafe_of_string (Cstruct.copyv buf)) in
+    let sent = Err.run (Low_level.send_msg t ?dst) (Bytes.unsafe_of_string (Cstruct.copyv buf)) in
     assert (sent = Cstruct.lenv buf)
 
-  method recv buf =
+  let recv t buf =
     let b = Bytes.create (Cstruct.length buf) in
-    let recv, addr = Err.run (Low_level.recv_msg sock) b in
+    let recv, addr = Err.run (Low_level.recv_msg t) b in
     Cstruct.blit_from_bytes b 0 buf 0 recv;
     Eio_unix.Net.sockaddr_of_unix_datagram addr, recv
+
+  let shutdown t cmd =
+    try
+      Low_level.shutdown t @@ match cmd with
+      | `Receive -> Unix.SHUTDOWN_RECEIVE
+      | `Send -> Unix.SHUTDOWN_SEND
+      | `All -> Unix.SHUTDOWN_ALL
+    with
+    | Unix.Unix_error (Unix.ENOTCONN, _, _) -> ()
+    | Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg)
 end
 
+let datagram_handler = Eio_unix.Resource.datagram_handler (module Datagram_socket)
+
+let datagram_socket fd =
+  Eio.Resource.T (fd, datagram_handler)
+
 (* https://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml *)
 let getaddrinfo ~service node =
   let to_eio_sockaddr_t {Unix.ai_family; ai_addr; ai_socktype; ai_protocol; _ } =
@@ -110,7 +136,7 @@ let listen ~reuse_addr ~reuse_port ~backlog ~sw (listen_addr : Eio.Net.Sockaddr.
       Unix.bind fd addr;
       Unix.listen fd backlog
     );
-  listening_socket ~hook sock
+  (listening_socket ~hook sock :> _ Eio.Net.listening_socket_ty r)
 
 let connect ~sw connect_addr =
   let socket_type, addr =
@@ -123,7 +149,7 @@ let connect ~sw connect_addr =
   let sock = Low_level.socket ~sw (socket_domain_of connect_addr) socket_type 0 in
   try
     Low_level.connect sock addr;
-    (Flow.of_fd sock :> Eio.Net.stream_socket)
+    (Flow.of_fd sock :> _ Eio_unix.Net.stream_socket)
   with Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg)
 
 let create_datagram_socket ~reuse_addr ~reuse_port ~sw saddr =
@@ -140,13 +166,26 @@ let create_datagram_socket ~reuse_addr ~reuse_port ~sw saddr =
         )
     | `UdpV4 | `UdpV6 -> ()
   end;
-  (datagram_socket sock :> Eio.Net.datagram_socket)
+  datagram_socket sock
 
-let v = object
+module Impl = struct
-  inherit Eio_unix.Net.t
+  type t = unit
+  type tag = [`Generic | `Unix]
 
-  method listen = listen
+  let listen () = listen
-  method connect = connect
+
-  method datagram_socket = create_datagram_socket
+  let connect () ~sw addr =
-  method getaddrinfo = getaddrinfo
+    let socket = connect ~sw addr in
+    (socket :> [`Generic | `Unix] Eio.Net.stream_socket_ty r)
+
+  let datagram_socket () ~reuse_addr ~reuse_port ~sw saddr =
+    let socket = create_datagram_socket ~reuse_addr ~reuse_port ~sw saddr in
+    (socket :> [`Generic | `Unix] Eio.Net.datagram_socket_ty r)
+
+  let getaddrinfo () = getaddrinfo
+  let getnameinfo () = Eio_unix.Net.getnameinfo
 end
+
+let v : Impl.tag Eio.Net.ty r =
+  let handler = Eio.Net.Pi.network (module Impl) in
+  Eio.Resource.T ((), handler)

lib_eio_windows/test/test_net.ml

@@ -85,8 +85,8 @@ let test_wrap_socket pipe_or_socketpair () =
     | `Pipe -> Unix.pipe ()
     | `Socketpair -> Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0
   in
-  let source = (Eio_unix.Net.import_socket_stream ~sw ~close_unix:true r :> Eio.Flow.source) in
+  let source = (Eio_unix.Net.import_socket_stream ~sw ~close_unix:true r :> Eio.Flow.source_ty r) in
-  let sink = (Eio_unix.Net.import_socket_stream ~sw ~close_unix:true w :> Eio.Flow.sink) in
+  let sink = (Eio_unix.Net.import_socket_stream ~sw ~close_unix:true w :> Eio.Flow.sink_ty r) in
   let msg = "Hello" in
   Fiber.both
     (fun () -> Eio.Flow.copy_string (msg ^ "\n") sink)

tests/buf_reader.md

@@ -19,24 +19,27 @@ let ensure t n =
 (* The next data to be returned by `mock_flow`. `[]` to raise `End_of_file`: *)
 let next = ref []
 
-let mock_flow = object
+let mock_flow =
-  inherit Eio.Flow.source
+  let module X = struct
+    type t = unit
 
-  method read_methods = []
+    let read_methods = []
 
-  method read_into buf =
+    let single_read () buf =
-    match !next with
+      match !next with
-    | [] ->
+      | [] ->
-      traceln "mock_flow returning Eof";
+        traceln "mock_flow returning Eof";
-      raise End_of_file
+        raise End_of_file
-    | x :: xs ->
+      | x :: xs ->
-      let len = min (Cstruct.length buf) (String.length x) in
+        let len = min (Cstruct.length buf) (String.length x) in
-      traceln "mock_flow returning %d bytes" len;
+        traceln "mock_flow returning %d bytes" len;
-      Cstruct.blit_from_string x 0 buf 0 len;
+        Cstruct.blit_from_string x 0 buf 0 len;
-      let x' = String.sub x len (String.length x - len) in
+        let x' = String.sub x len (String.length x - len) in
-      next := (if x' = "" then xs else x' :: xs);
+        next := (if x' = "" then xs else x' :: xs);
-      len
+        len
-end
+  end in
+  let ops = Eio.Flow.Pi.source (module X) in
+  Eio.Resource.T ((), ops)
 
 let read flow n =
   let buf = Cstruct.create n in
@@ -238,7 +241,7 @@ Exception: End_of_file.
 
 ```ocaml
 # let bflow = R.of_flow mock_flow ~max_size:100 |> R.as_flow;;
-val bflow : Eio.Flow.source = <obj>
+val bflow : Eio.Flow.source_ty Eio.Std.r = Eio__.Resource.T (<poly>, <abstr>)
 # next := ["foo"; "bar"]; read bflow 2;;
 +mock_flow returning 3 bytes
 +Read "fo"

tests/buf_write.md

@@ -216,9 +216,10 @@ the whole batch to be flushed.
 Check flush waits for the write to succeed:
 
 ```ocaml
-let slow_writer = object
+module Slow_writer = struct
-  inherit Eio.Flow.sink
+  type t = unit
-  method copy src =
+
+  let copy t ~src =
     let buf = Cstruct.create 10 in
     try
       while true do
@@ -227,7 +228,12 @@ let slow_writer = object
         traceln "Write %S" (Cstruct.to_string buf ~len)
       done
     with End_of_file -> ()
+
+  let write t bufs = copy t ~src:(Eio.Flow.cstruct_source bufs)
 end
+let slow_writer =
+  let ops = Eio.Flow.Pi.sink (module Slow_writer) in
+  Eio.Resource.T ((), ops)
 ```
 
 ```ocaml

tests/flow.md

@@ -12,23 +12,23 @@ let run fn =
   Eio_main.run @@ fun _ ->
   fn ()
 
-let mock_source items =
+let mock_source =
-  object
+  let module X = struct
-    inherit Eio.Flow.source
+    type t = Cstruct.t list ref
 
-    val mutable items = items
+    let read_methods = []
 
-    method read_methods = []
+    let single_read t buf =
-
+      match !t with
-    method read_into buf =
-      match items with
       | [] -> raise End_of_file
       | x :: xs ->
         let len = min (Cstruct.length buf) (Cstruct.length x) in
         Cstruct.blit x 0 buf 0 len;
-        items <- Cstruct.shiftv (x :: xs) len;
+        t := Cstruct.shiftv (x :: xs) len;
         len
-  end
+  end in
+  let ops = Eio.Flow.Pi.source (module X) in
+  fun items -> Eio.Resource.T (ref items, ops)
 ```
 
 ## read_exact

tests/network.md

@@ -8,7 +8,7 @@
 ```ocaml
 open Eio.Std
 
-let run (fn : net:#Eio.Net.t -> Switch.t -> unit) =
+let run (fn : net:_ Eio.Net.t -> Switch.t -> unit) =
   Eio_main.run @@ fun env ->
   let net = Eio.Stdenv.net env in
   Switch.run (fn ~net)
@@ -361,8 +361,8 @@ Wrapping a Unix FD as an Eio stream socket:
 # Eio_main.run @@ fun _ ->
   Switch.run @@ fun sw ->
   let r, w = Unix.pipe () in
-  let source = (Eio_unix.Net.import_socket_stream ~sw ~close_unix:true r :> Eio.Flow.source) in
+  let source = (Eio_unix.Net.import_socket_stream ~sw ~close_unix:true r :> _ Eio.Flow.source) in
-  let sink = (Eio_unix.Net.import_socket_stream ~sw ~close_unix:true w :> Eio.Flow.sink) in
+  let sink = (Eio_unix.Net.import_socket_stream ~sw ~close_unix:true w :> _ Eio.Flow.sink) in
   Fiber.both
     (fun () -> Eio.Flow.copy_string "Hello\n!" sink)
     (fun () ->
@@ -998,3 +998,18 @@ Limiting to 2 concurrent connections:
 +flow3: closed
 - : unit = ()
 ```
+
+We keep the polymorphism when using a Unix network:
+
+```ocaml
+let _check_types ~(net:Eio_unix.Net.t) =
+  Switch.run @@ fun sw ->
+  let addr = `Unix "/socket" in
+  let server : [`Generic | `Unix] Eio.Net.listening_socket_ty r =
+    Eio.Net.listen ~sw net addr ~backlog:5
+  in
+  Eio.Net.accept_fork ~sw ~on_error:raise server
+    (fun (_flow : [`Generic | `Unix] Eio.Net.stream_socket_ty r) _addr -> assert false);
+  let _client : [`Generic | `Unix] Eio.Net.stream_socket_ty r = Eio.Net.connect ~sw net addr in
+  ();;
+```