diff options
| author | Marcos Magueta <maguetamarcos@gmail.com> | 2026-08-02 23:38:05 -0300 |
|---|---|---|
| committer | Estevan Castilho <tevo@riajuu.net> | 2026-08-23 03:06:53 +0000 |
| commit | b790c77c5e42a220a8419c69dbea3e392ee60fbe (patch) | |
| tree | 546d27d92f470d7f90ea7a76b6720039f3ed4291 /lib/concepts | |
| parent | 8d59f43f445164e8cc8bd3fe1a23bd04e807a6b3 (diff) | |
| download | RNT-b790c77c5e42a220a8419c69dbea3e392ee60fbe.tar.gz RNT-b790c77c5e42a220a8419c69dbea3e392ee60fbe.zip | |
Revert "format"
This reverts commit fee14f4b29840357f87f02d51953f41ce90f7d9e.
Diffstat (limited to '')
| -rw-r--r-- | lib/concepts/Branch.ml | 13 | ||||
| -rw-r--r-- | lib/concepts/Branch.mli | 1 | ||||
| -rw-r--r-- | lib/concepts/Codec.ml | 102 | ||||
| -rw-r--r-- | lib/concepts/Hash.ml | 10 | ||||
| -rw-r--r-- | lib/concepts/Multigroup.ml | 10 | ||||
| -rw-r--r-- | lib/concepts/Multigroup.mli | 1 | ||||
| -rw-r--r-- | lib/concepts/Object.ml | 7 | ||||
| -rw-r--r-- | lib/concepts/Object.mli | 4 | ||||
| -rw-r--r-- | lib/concepts/Ordering.ml | 3 | ||||
| -rw-r--r-- | lib/concepts/Relation.ml | 18 | ||||
| -rw-r--r-- | lib/concepts/Relation.mli | 2 |
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 |
