this repo has no description
Add (partial) OCaml bindings
+238
-24
+12
.gitignore
+12
.gitignore
+2
-1
README.md
+2
-1
README.md
-18
mvp/bellairs.mli
-18
mvp/bellairs.mli
···
1
-
2
-
type dir
3
-
type file
4
-
5
-
type entry = {
6
-
name: string;
7
-
file: file;
8
-
}
9
-
10
-
val root : dir
11
-
val list : dir -> entry list
12
-
13
-
val create : dir -> string -> file
14
-
val open_ : dir -> string -> file
15
-
val delete : dir -> string -> unit
16
-
17
-
val size : file -> int64
18
-
val read : file -> ?off:int64 -> ?len:int64 -> string
mvp/bellairs.schema
mvp/schema/storage.capnp
mvp/bellairs.schema
mvp/schema/storage.capnp
-4
mvp/dune
-4
mvp/dune
-1
mvp/dune-project
-1
mvp/dune-project
···
1
-
(lang dune 3.17)
+1
mvp/ocaml/bellairs.ml
+1
mvp/ocaml/bellairs.ml
···
1
+
include Bellairs_intf
+1
mvp/ocaml/bellairs.mli
+1
mvp/ocaml/bellairs.mli
···
1
+
include Bellairs_intf.Sigs
+16
mvp/ocaml/bellairs_intf.ml
+16
mvp/ocaml/bellairs_intf.ml
···
1
+
module type Storage = sig
2
+
type dir
3
+
type file
4
+
type entry = { name : string; file : file }
5
+
6
+
val list : dir -> entry list
7
+
val create : dir -> string -> file
8
+
val open_ : dir -> string -> file
9
+
val delete : dir -> string -> unit
10
+
val size : file -> int64
11
+
val read : ?off:int64 -> ?len:int64 -> file -> string
12
+
end
13
+
14
+
module type Sigs = sig
15
+
module type Storage = Storage
16
+
end
+59
mvp/ocaml/client/client.ml
+59
mvp/ocaml/client/client.ml
···
1
+
open Capnp_rpc.Std
2
+
open Eio.Std
3
+
4
+
module Storage :
5
+
Bellairs.Storage
6
+
with type file = [ `File_e62ce624f782d37e ] Capability.t
7
+
and type dir = [ `Directory_8e98f5ea254aace5 ] Capability.t = struct
8
+
module API = Schema.Storage.MakeRPC (Capnp_rpc)
9
+
10
+
type file = API.Client.File.t Capability.t
11
+
type dir = API.Client.Directory.t Capability.t
12
+
type entry = { name : string; file : file }
13
+
14
+
let entry r =
15
+
let name = API.Reader.Directory.Entry.name_get r in
16
+
let file = API.Reader.Directory.Entry.file_get r in
17
+
match file with
18
+
| Some file -> { name; file }
19
+
| None -> failwith "missing entry.file"
20
+
21
+
let todo msg = failwith ("Storage." ^ msg)
22
+
23
+
let list t =
24
+
let open API.Client.Directory.List in
25
+
let request = Capability.Request.create_no_args () in
26
+
let results = Capability.call_for_value_exn t method_id request in
27
+
let entries = Results.entries_get_list results in
28
+
List.map entry entries
29
+
30
+
let create _ = todo "create"
31
+
let open_ _ = todo "open"
32
+
let delete _ = todo "delete"
33
+
let size _ = todo "size"
34
+
let read ?off:_ ?len:_ _ = todo "read"
35
+
end
36
+
37
+
let ls net uri =
38
+
Switch.run @@ fun sw ->
39
+
let client_vat = Capnp_rpc_unix.client_only_vat ~sw net in
40
+
let sr = Capnp_rpc_unix.Vat.import_exn client_vat uri in
41
+
let entries = Capnp_rpc_unix.with_cap_exn sr Storage.list in
42
+
List.iter (fun { Storage.name; _ } -> Fmt.pr "- %s\n" name) entries
43
+
44
+
open Cmdliner
45
+
46
+
let () =
47
+
Logs.set_level (Some Logs.Warning);
48
+
Logs.set_reporter (Logs_fmt.reporter ())
49
+
50
+
let connect_addr =
51
+
let i = Arg.info [] ~docv:"ADDR" ~doc:"Address of server (capnp://...)" in
52
+
Arg.(required @@ pos 0 (some Capnp_rpc_unix.sturdy_uri) None i)
53
+
54
+
let ls_cmd env =
55
+
let doc = "run the client" in
56
+
let info = Cmd.info "ls" ~doc in
57
+
Cmd.v info Term.(const (ls env#net) $ connect_addr)
58
+
59
+
let () = exit @@ Eio_main.run @@ fun env -> Cmd.eval (ls_cmd env)
+1
mvp/ocaml/client/client.mli
+1
mvp/ocaml/client/client.mli
···
1
+
(* empty *)
+3
mvp/ocaml/client/dune
+3
mvp/ocaml/client/dune
+3
mvp/ocaml/server/dune
+3
mvp/ocaml/server/dune
+139
mvp/ocaml/server/server.ml
+139
mvp/ocaml/server/server.ml
···
1
+
open Eio.Std
2
+
open Capnp_rpc_net
3
+
4
+
let cap_file = "storage.cap"
5
+
6
+
module API = Schema.Storage.MakeRPC (Capnp_rpc)
7
+
open Capnp_rpc.Std
8
+
9
+
let todo msg = failwith ("TODO: " ^ msg)
10
+
11
+
module Impl : sig
12
+
include Bellairs.Storage
13
+
14
+
val root : unit -> dir
15
+
end = struct
16
+
type file = { content : string; size : int64 }
17
+
type dir = (string, file) Hashtbl.t
18
+
type entry = { name : string; file : file }
19
+
20
+
let create files name =
21
+
let file = { content = ""; size = 0L } in
22
+
Hashtbl.add files name file;
23
+
file
24
+
25
+
let root () =
26
+
let tbl = Hashtbl.create 10 in
27
+
let _ = create tbl "foo" in
28
+
let _ = create tbl "bar" in
29
+
tbl
30
+
31
+
let open_ (files : dir) name =
32
+
try Hashtbl.find files name with Not_found -> failwith "file not found"
33
+
34
+
let delete files name = Hashtbl.remove files name
35
+
36
+
let read ?(off = 0L) ?(len = Int64.max_int) file =
37
+
let content_len = String.length file.content in
38
+
let off = Int64.to_int off in
39
+
let len = Int64.to_int len in
40
+
let off = max 0 (min off content_len) in
41
+
let max_len = content_len - off in
42
+
let len = if len >= max_len then max_len else len in
43
+
String.sub file.content off len
44
+
45
+
let size file = file.size
46
+
47
+
let list files =
48
+
Hashtbl.fold (fun name file acc -> { name; file } :: acc) files []
49
+
end
50
+
51
+
module File = struct
52
+
let local file =
53
+
let module File = API.Service.File in
54
+
File.local
55
+
@@ object
56
+
inherit File.service
57
+
58
+
method read_impl params release_param_caps =
59
+
let open File.Read in
60
+
let off = Stdint.Int64.of_uint64 (Params.off_get params) in
61
+
let len = Stdint.Int64.of_uint64 (Params.len_get params) in
62
+
release_param_caps ();
63
+
let response, results =
64
+
Service.Response.create Results.init_pointer
65
+
in
66
+
let data = Impl.read file ~off ~len in
67
+
Results.data_set results data;
68
+
Service.return response
69
+
70
+
method size_impl _ release_param_caps =
71
+
let open File.Size in
72
+
release_param_caps ();
73
+
let response, results =
74
+
Service.Response.create Results.init_pointer
75
+
in
76
+
let size = Stdint.Int64.to_uint64 (Impl.size file) in
77
+
Results.size_set results size;
78
+
Service.return response
79
+
end
80
+
end
81
+
82
+
module Directory = struct
83
+
let local dir =
84
+
let module Directory = API.Service.Directory in
85
+
Directory.local
86
+
@@ object
87
+
inherit Directory.service
88
+
method create_impl _ = todo "create_impl"
89
+
90
+
method list_impl _ release_param_caps =
91
+
let open Directory.List in
92
+
release_param_caps ();
93
+
let response, results =
94
+
Service.Response.create Results.init_pointer
95
+
in
96
+
let entries = Impl.list dir in
97
+
98
+
let entries_array =
99
+
Results.entries_init results (List.length entries)
100
+
in
101
+
List.iteri
102
+
(fun i e ->
103
+
let entry = Capnp.Array.get entries_array i in
104
+
API.Builder.Directory.Entry.name_set entry e.Impl.name;
105
+
API.Builder.Directory.Entry.file_set entry
106
+
(Some (File.local e.Impl.file)))
107
+
entries;
108
+
109
+
Service.return response
110
+
111
+
method size_impl _ = todo "size_impl"
112
+
method open_impl _ = todo "open_impl"
113
+
method delete_impl _ = todo "delete_impl"
114
+
end
115
+
end
116
+
117
+
let serve config =
118
+
Switch.run @@ fun sw ->
119
+
let service_id = Capnp_rpc_unix.Vat_config.derived_id config "main" in
120
+
let restore = Restorer.single service_id (Directory.local (Impl.root ())) in
121
+
let vat = Capnp_rpc_unix.serve ~sw ~restore config in
122
+
match Capnp_rpc_unix.Cap_file.save_service vat service_id cap_file with
123
+
| Error (`Msg m) -> failwith m
124
+
| Ok () ->
125
+
traceln "Server running. Connect using %S." cap_file;
126
+
Fiber.await_cancel ()
127
+
128
+
open Cmdliner
129
+
130
+
let () =
131
+
Logs.set_level (Some Logs.Warning);
132
+
Logs.set_reporter (Logs_fmt.reporter ())
133
+
134
+
let serve_cmd env =
135
+
let doc = "run the server" in
136
+
let info = Cmd.info "serve" ~doc in
137
+
Cmd.v info Term.(const serve $ Capnp_rpc_unix.Vat_config.cmd env)
138
+
139
+
let () = exit @@ Eio_main.run @@ fun env -> Cmd.eval (serve_cmd env)
+1
mvp/ocaml/server/server.mli
+1
mvp/ocaml/server/server.mli
···
1
+
(* empty *)