aboutsummaryrefslogtreecommitdiffstats
path: root/lib/concepts
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2026-08-02 23:38:05 -0300
committerEstevan Castilho <tevo@riajuu.net>2026-08-23 03:06:53 +0000
commitb790c77c5e42a220a8419c69dbea3e392ee60fbe (patch)
tree546d27d92f470d7f90ea7a76b6720039f3ed4291 /lib/concepts
parent8d59f43f445164e8cc8bd3fe1a23bd04e807a6b3 (diff)
downloadRNT-b790c77c5e42a220a8419c69dbea3e392ee60fbe.tar.gz
RNT-b790c77c5e42a220a8419c69dbea3e392ee60fbe.zip
Revert "format"
This reverts commit fee14f4b29840357f87f02d51953f41ce90f7d9e.
Diffstat (limited to '')
-rw-r--r--lib/concepts/Branch.ml13
-rw-r--r--lib/concepts/Branch.mli1
-rw-r--r--lib/concepts/Codec.ml102
-rw-r--r--lib/concepts/Hash.ml10
-rw-r--r--lib/concepts/Multigroup.ml10
-rw-r--r--lib/concepts/Multigroup.mli1
-rw-r--r--lib/concepts/Object.ml7
-rw-r--r--lib/concepts/Object.mli4
-rw-r--r--lib/concepts/Ordering.ml3
-rw-r--r--lib/concepts/Relation.ml18
-rw-r--r--lib/concepts/Relation.mli2
11 files changed, 111 insertions, 60 deletions
diff --git a/lib/concepts/Branch.ml b/lib/concepts/Branch.ml
index 57c46b3..cd4213b 100644
--- a/lib/concepts/Branch.ml
+++ b/lib/concepts/Branch.ml
@@ -1,5 +1,8 @@
type address = Hash.hash
-type t = {name: string; target: address}
+
+type t =
+ { name: string;
+ target: address }
module Field = struct
let name = "name"
@@ -19,6 +22,7 @@ module Error = struct
end
let make ~name ~target = {name; target}
+
let name branch = branch.name
let target branch = branch.target
@@ -27,10 +31,13 @@ module Body = struct
let tag = 'b'
let malformed = Error.malformed_branch
- let equal left right = left.name = right.name && Hash.hash_equals left.target right.target
+
+ let equal left right =
+ left.name = right.name && Hash.hash_equals left.target right.target
let fields branch =
- [Field.name, Object.Field.string branch.name; Field.target, Object.Field.address branch.target]
+ [ Field.name, Object.Field.string branch.name;
+ Field.target, Object.Field.address branch.target ]
let of_fields data =
let open Utilities.Result in
diff --git a/lib/concepts/Branch.mli b/lib/concepts/Branch.mli
index 3fb6ebe..0e7e9f9 100644
--- a/lib/concepts/Branch.mli
+++ b/lib/concepts/Branch.mli
@@ -4,5 +4,6 @@ type address = Hash.hash
include Object.S with type t := t
val make : name:string -> target:address -> t
+
val name : t -> string
val target : t -> address
diff --git a/lib/concepts/Codec.ml b/lib/concepts/Codec.ml
index 97039c3..758d718 100644
--- a/lib/concepts/Codec.ml
+++ b/lib/concepts/Codec.ml
@@ -1,4 +1,4 @@
-module Error = struct
+ module Error = struct
open Condition
let unexpected_end =
@@ -16,19 +16,21 @@ module Error = struct
condition "codec-string-out-of-bounds" "A string length runs past the end of input"
("length" |=| Value.Integer length)
- let trailing_bytes = condition "codec-trailing-bytes" "Bytes remain after a complete value" empty
+ let trailing_bytes =
+ condition "codec-trailing-bytes" "Bytes remain after a complete value" empty
let tag_mismatch ~expected ~actual =
condition "codec-tag-mismatch" "A value with a different tag was expected"
- ( "expected" |=| Value.String (String.make 1 expected)
- & "actual" |=| Value.String (String.make 1 actual) )
+ ("expected" |=| Value.String (String.make 1 expected) &
+ "actual" |=| Value.String (String.make 1 actual))
let type_mismatch ~expected =
condition "codec-type-mismatch" "A Bencode value of a different shape was expected"
("expected" |=| Value.String expected)
let missing_field key =
- condition "codec-missing-field" "A required field is absent" ("field" |=| Value.String key)
+ condition "codec-missing-field" "A required field is absent"
+ ("field" |=| Value.String key)
let unexpected_object ~expected ~actual =
condition "codec-unexpected-object" "The decoded object is not of the expected kind"
@@ -47,37 +49,38 @@ end
- List "l" <element>* "e"
- Dict "d" (<String key> <value>)* "e" keys sorted on encode *)
module Bencode = struct
- type t =
- | Tagged of char * t
- | Int of int
- | String of string
- | List of t list
- | Dict of (string * t) list
+ type t = Tagged of char * t | Int of int | String of string | List of t list | Dict of (string * t) list
let rec encode buf = function
- | Tagged (tag, value) -> Buffer.add_char buf 't'; Buffer.add_char buf tag; encode buf value
+ | Tagged (tag, value) ->
+ Buffer.add_char buf 't';
+ Buffer.add_char buf tag;
+ encode buf value
| Int n ->
- Buffer.add_char buf 'i';
- Buffer.add_string buf (string_of_int n);
- Buffer.add_char buf 'e'
+ Buffer.add_char buf 'i';
+ Buffer.add_string buf (string_of_int n);
+ Buffer.add_char buf 'e'
| String s ->
- Buffer.add_string buf (string_of_int (String.length s));
- Buffer.add_char buf ':';
- Buffer.add_string buf s
+ Buffer.add_string buf (string_of_int (String.length s));
+ Buffer.add_char buf ':';
+ Buffer.add_string buf s
| List xs ->
- Buffer.add_char buf 'l';
- List.iter (encode buf) xs;
- Buffer.add_char buf 'e'
+ Buffer.add_char buf 'l';
+ List.iter (encode buf) xs;
+ Buffer.add_char buf 'e'
| Dict kvs ->
- Buffer.add_char buf 'd';
- List.iter
- (fun (k, v) -> encode buf (String k); encode buf v)
- (List.sort (fun (a, _) (b, _) -> String.compare a b) kvs);
- Buffer.add_char buf 'e'
+ Buffer.add_char buf 'd';
+ List.iter
+ (fun (k, v) ->
+ encode buf (String k);
+ encode buf v )
+ (List.sort (fun (a, _) (b, _) -> String.compare a b) kvs);
+ Buffer.add_char buf 'e'
let to_bytes (value : t) : bytes =
let buf = Buffer.create 256 in
- encode buf value; Buffer.to_bytes buf
+ encode buf value;
+ Buffer.to_bytes buf
let as_string = function String s -> Ok s | _ -> Error (Error.type_mismatch ~expected:"string")
let as_int = function Int n -> Ok n | _ -> Error (Error.type_mismatch ~expected:"integer")
@@ -89,7 +92,7 @@ module Bencode = struct
let s = Bytes.to_string bytes in
let n = String.length s in
let pos = ref 0 in
- let peek () = if !pos >= n then Error Error.unexpected_end else Ok s.[!pos] in
+ let peek () = if !pos >= n then Error (Error.unexpected_end) else Ok (s.[!pos]) in
let advance () = incr pos in
(* Read the decimal run up to (and consuming) [term]. *)
let read_int_from start term =
@@ -103,7 +106,8 @@ module Bencode = struct
| None -> Error (Error.malformed_integer digits)
end
else begin
- advance (); scan ()
+ advance ();
+ scan ()
end
in
scan ()
@@ -111,44 +115,43 @@ module Bencode = struct
let read_int term = read_int_from !pos term in
let read_char () =
let* c = peek () in
- advance (); Ok c
+ advance ();
+ Ok c
in
let rec parse () =
let* c = peek () in
advance ();
match c with
| 't' ->
- let* tag = read_char () in
- let* data = parse () in
- Ok (Tagged (tag, data))
+ let* tag = read_char () in
+ let* data = parse () in
+ Ok (Tagged (tag, data))
| 'i' ->
- let* n = read_int 'e' in
- Ok (Int n)
+ let* n = read_int 'e' in
+ Ok (Int n)
| 'l' -> parse_list []
| 'd' -> parse_dict []
| c when c >= '0' && c <= '9' -> parse_string_from (!pos - 1)
| c -> Error (Error.unexpected_byte c)
- and parse_string () = parse_string_from !pos
+ and parse_string () =
+ parse_string_from !pos
and parse_string_from start =
let* len = read_int_from start ':' in
- if len < 0 || !pos + len > n then Error (Error.string_out_of_bounds len)
+ if len < 0 || !pos + len > n then
+ Error (Error.string_out_of_bounds len)
else
let str = String.sub s !pos len in
pos := !pos + len;
Ok (String str)
and parse_list acc =
let* c = peek () in
- if c = 'e' then (
- advance ();
- Ok (List (List.rev acc)) )
+ if c = 'e' then (advance (); Ok (List (List.rev acc)))
else
let* result = parse () in
parse_list (result :: acc)
and parse_dict acc =
let* c = peek () in
- if c = 'e' then (
- advance ();
- Ok (Dict (List.rev acc)) )
+ if c = 'e' then (advance (); Ok (Dict (List.rev acc)))
else
let* key = parse_string () in
let* key = as_string key in
@@ -156,17 +159,24 @@ module Bencode = struct
parse_dict ((key, value) :: acc)
in
let* value = parse () in
- if !pos <> n then Error Error.trailing_bytes else Ok value
+ if !pos <> n then Error Error.trailing_bytes else
+ Ok value
let to_blob x = to_bytes x |> Representation.blob_of_bytes
let of_blob b = Representation.bytes_of_blob b |> of_bytes
let with_tag t = function
- | Tagged (t', v) -> if t = t' then Ok v else Error (Error.tag_mismatch ~expected:t ~actual:t')
+ | Tagged (t', v) ->
+ if t = t' then
+ Ok v
+ else
+ Error (Error.tag_mismatch ~expected:t ~actual:t')
| _ -> Error (Error.type_mismatch ~expected:"tagged")
let field key = function
| Dict kvs -> (
- match List.assoc_opt key kvs with Some v -> Ok v | None -> Error (Error.missing_field key) )
+ match List.assoc_opt key kvs with
+ | Some v -> Ok v
+ | None -> Error (Error.missing_field key) )
| _ -> Error (Error.type_mismatch ~expected:"dict")
end
diff --git a/lib/concepts/Hash.ml b/lib/concepts/Hash.ml
index a84c60d..aac7428 100644
--- a/lib/concepts/Hash.ml
+++ b/lib/concepts/Hash.ml
@@ -2,16 +2,22 @@
type hash = Digestif.SHA256.t
-let size = 256 / 8
-let compare h1 h2 = Digestif.SHA256.unsafe_compare h1 h2 |> Ordering.of_int
+let size = 256/8
+
+let compare h1 h2 = Digestif.SHA256.unsafe_compare h1 h2
+ |> Ordering.of_int
let hash_of_value (v : Value.value) =
Representation.(blob_of_value v |> bytes_of_blob) |> Digestif.SHA256.digest_bytes
let hash_of_bytes bytes = Digestif.SHA256.digest_bytes bytes
+
let hash_of_blob blob = Representation.bytes_of_blob blob |> Digestif.SHA256.digest_bytes
+
let to_raw_string hash = Digestif.SHA256.to_raw_string hash
+
let of_raw_string str = Digestif.SHA256.of_raw_string str
+
let hash_equals = Digestif.SHA256.equal
let bytes_of_hash (h : hash) = Bytes.of_string (Digestif.SHA256.to_raw_string h)
diff --git a/lib/concepts/Multigroup.ml b/lib/concepts/Multigroup.ml
index b8fc743..863cd26 100644
--- a/lib/concepts/Multigroup.ml
+++ b/lib/concepts/Multigroup.ml
@@ -1,5 +1,8 @@
type address = Hash.hash
-type t = {name: string; relations: address}
+
+type t =
+ { name: string;
+ relations: address }
module Field = struct
let name = "name"
@@ -19,6 +22,7 @@ module Error = struct
end
let make ~name ~relations = {name; relations}
+
let name multigroup = multigroup.name
let relations multigroup = multigroup.relations
@@ -27,7 +31,9 @@ module Body = struct
let tag = 'm'
let malformed = Error.malformed_multigroup
- let equal left right = left.name = right.name && Hash.hash_equals left.relations right.relations
+
+ let equal left right =
+ left.name = right.name && Hash.hash_equals left.relations right.relations
let fields multigroup =
[ Field.name, Object.Field.string multigroup.name;
diff --git a/lib/concepts/Multigroup.mli b/lib/concepts/Multigroup.mli
index ef0f8ea..1a76dce 100644
--- a/lib/concepts/Multigroup.mli
+++ b/lib/concepts/Multigroup.mli
@@ -4,5 +4,6 @@ type address = Hash.hash
include Object.S with type t := t
val make : name:string -> relations:address -> t
+
val name : t -> string
val relations : t -> address
diff --git a/lib/concepts/Object.ml b/lib/concepts/Object.ml
index aacbda6..22fb14a 100644
--- a/lib/concepts/Object.ml
+++ b/lib/concepts/Object.ml
@@ -6,10 +6,13 @@ module type S = sig
type t
val equal : t -> t -> bool
+
val to_bencode : t -> bencode
val of_bencode : bencode -> (t, Condition.condition) result
+
val to_blob : t -> Representation.blob
val of_blob : Representation.blob -> (t, Condition.condition) result
+
val to_bytes : t -> bytes
val of_bytes : bytes -> (t, Condition.condition) result
end
@@ -48,11 +51,13 @@ module Codec = struct
let to_bencode object_ = Bencode.Tagged (B.tag, Bencode.Dict (B.fields object_))
let of_bencode = function
- | Bencode.Tagged (tag, (Bencode.Dict _ as data)) when Char.equal tag B.tag -> B.of_fields data
+ | Bencode.Tagged (tag, (Bencode.Dict _ as data)) when Char.equal tag B.tag ->
+ B.of_fields data
| _ -> Error (B.malformed ())
let to_blob object_ = to_bencode object_ |> Bencode.to_blob
let of_blob blob = Bencode.of_blob blob |> Utilities.Result.fmap of_bencode
+
let to_bytes object_ = to_blob object_ |> Representation.bytes_of_blob
let of_bytes bytes = Bencode.of_bytes bytes |> Utilities.Result.fmap of_bencode
end
diff --git a/lib/concepts/Object.mli b/lib/concepts/Object.mli
index 7b0c4fd..e132673 100644
--- a/lib/concepts/Object.mli
+++ b/lib/concepts/Object.mli
@@ -4,10 +4,13 @@ module type S = sig
type t
val equal : t -> t -> bool
+
val to_bencode : t -> bencode
val of_bencode : bencode -> (t, Condition.condition) result
+
val to_blob : t -> Representation.blob
val of_blob : Representation.blob -> (t, Condition.condition) result
+
val to_bytes : t -> bytes
val of_bytes : bytes -> (t, Condition.condition) result
end
@@ -17,6 +20,7 @@ module type OBJECT = S
module Field : sig
val string : string -> bencode
val address : Hash.hash -> bencode
+
val require_string : string -> bencode -> (string, Condition.condition) result
val require_address :
diff --git a/lib/concepts/Ordering.ml b/lib/concepts/Ordering.ml
index 8952b41..42b20e5 100644
--- a/lib/concepts/Ordering.ml
+++ b/lib/concepts/Ordering.ml
@@ -1,3 +1,4 @@
type ordering = Equal | Smaller | Greater
-let of_int x = if x < 0 then Smaller else if x > 0 then Greater else Equal
+let of_int x =
+ if x < 0 then Smaller else if x > 0 then Greater else Equal
diff --git a/lib/concepts/Relation.ml b/lib/concepts/Relation.ml
index 1194804..a4fb341 100644
--- a/lib/concepts/Relation.ml
+++ b/lib/concepts/Relation.ml
@@ -1,6 +1,10 @@
type address = Hash.hash
type schema = string BatMap.String.t
-type t = {name: string; tuples: address; schema: schema}
+
+type t =
+ { name: string;
+ tuples: address;
+ schema: schema }
module Field = struct
let name = "name"
@@ -21,27 +25,31 @@ module Error = struct
end
let make ~name ~tuples ~schema = {name; tuples; schema}
+
let name relation = relation.name
let tuples relation = relation.tuples
let schema relation = relation.schema
+
let schema_empty = BatMap.String.empty
let schema_of_list fields =
- List.fold_left (fun acc (name, domain) -> BatMap.String.add name domain acc) schema_empty fields
+ List.fold_left (fun acc (name, domain) -> BatMap.String.add name domain acc) schema_empty
+ fields
let schema_to_list schema = BatMap.String.bindings schema
let schema_to_bencode schema =
Codec.Bencode.Dict
- (schema_to_list schema |> List.map (fun (name, domain) -> name, Codec.Bencode.String domain))
+ (schema_to_list schema
+ |> List.map (fun (name, domain) -> name, Codec.Bencode.String domain) )
let schema_of_bencode value =
let open Utilities.Result in
let* fields = Codec.Bencode.as_dict value in
fields
|> List.map (fun (name, domain) ->
- let* domain = Codec.Bencode.as_string domain in
- Ok (name, domain) )
+ let* domain = Codec.Bencode.as_string domain in
+ Ok (name, domain) )
|> sequence
|> Result.map schema_of_list
diff --git a/lib/concepts/Relation.mli b/lib/concepts/Relation.mli
index d370578..5319a3d 100644
--- a/lib/concepts/Relation.mli
+++ b/lib/concepts/Relation.mli
@@ -5,9 +5,11 @@ type schema
include Object.S with type t := t
val make : name:string -> tuples:address -> schema:schema -> t
+
val name : t -> string
val tuples : t -> address
val schema : t -> schema
+
val schema_empty : schema
val schema_of_list : (string * string) list -> schema
val schema_to_list : schema -> (string * string) list