From 63352e46a880985efbdfab2e539d0f4975960b94 Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Sat, 26 Sep 2026 22:29:45 -0300 Subject: add session object and protocol with pinning --- lib/protocols/Session.ml | 23 +++++++++++++++++++++++ lib/protocols/Session.mli | 13 +++++++++++++ 2 files changed, 36 insertions(+) create mode 100644 lib/protocols/Session.ml create mode 100644 lib/protocols/Session.mli (limited to 'lib/protocols') diff --git a/lib/protocols/Session.ml b/lib/protocols/Session.ml new file mode 100644 index 0000000..f740c1a --- /dev/null +++ b/lib/protocols/Session.ml @@ -0,0 +1,23 @@ +module Error = struct + open Concepts.Condition + + let not_a_session () = + condition "not-a-session" "A handle was expected to carry the session protocol and did not" + empty +end + +type state = {branch: string; snapshot: Concepts.Hash.hash} + +class type implementation = object + method state : state + method pin : state -> unit +end + +type Handle.protocol += Session of implementation +type t = implementation + +let make impl = Session (impl :> implementation) +let from handle = Handle.into handle (function Session impl -> Some impl | _ -> None) +let require handle = from handle |> Option.to_result ~none:(Error.not_a_session ()) +let state i = Handle.invoke i (fun o -> o#state) +let pin i state = Handle.invoke i (fun o -> o#pin state) diff --git a/lib/protocols/Session.mli b/lib/protocols/Session.mli new file mode 100644 index 0000000..141c250 --- /dev/null +++ b/lib/protocols/Session.mli @@ -0,0 +1,13 @@ +type state = {branch: string; snapshot: Concepts.Hash.hash} +type t + +class type implementation = object + method state : state + method pin : state -> unit +end + +val make : #implementation -> Handle.protocol +val from : Handle.t -> t Handle.interface option +val require : Handle.t -> (t Handle.interface, Concepts.Condition.condition) result +val state : t Handle.interface -> state +val pin : t Handle.interface -> state -> unit -- cgit v1.2.3