package data-encoding
Library of JSON and binary encoding combinators
Install
Dune Dependency
Authors
Maintainers
Sources
data-encoding-v0.4.tar.gz
md5=7b687e25619637d40d2bbcd2c21b00c2
sha512=65e33b1a56e9058a2e9c7f3dc18cb72c21270e0e5b9584fe856285d16e4cb8e98adac826373d4109a5e080486ec31cdd9870b402249ac5d55c7b0de6ffb68b0a
doc/src/data-encoding/binary_slicer.ml.html
Source file binary_slicer.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441
(*****************************************************************************) (* *) (* Open Source License *) (* Copyright (c) 2021 Nomadic Labs. <contact@nomadic-labs.com> *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) (* to deal in the Software without restriction, including without limitation *) (* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) (* and/or sell copies of the Software, and to permit persons to whom the *) (* Software is furnished to do so, subject to the following conditions: *) (* *) (* The above copyright notice and this permission notice shall be included *) (* in all copies or substantial portions of the Software. *) (* *) (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) (* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) (* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) (* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) (* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) (* DEALINGS IN THE SOFTWARE. *) (* *) (*****************************************************************************) open Binary_error_types let raise e = raise (Read_error e) type slice = {name: string; value: string; pretty_printed: string} (* state management *) type slicer_state = { buffer: string; mutable offset: int; mutable remaining_bytes: int; mutable allowed_bytes: int option; mutable slices: slice list; } let make_slicer_state buffer ~offset ~length = if length < 0 || length > String.length buffer - offset then None else Some { buffer; offset; remaining_bytes = length; allowed_bytes = None; slices = []; } let check_allowed_bytes state size = match state.allowed_bytes with | Some len when len < size -> raise Size_limit_exceeded | Some len -> Some (len - size) | None -> None let check_remaining_bytes state size = if state.remaining_bytes < size then raise Not_enough_data; state.remaining_bytes - size let read_atom ?(pp = fun _ -> "") size conv name state = let offset = state.offset in state.remaining_bytes <- check_remaining_bytes state size; state.allowed_bytes <- check_allowed_bytes state size; state.offset <- state.offset + size; let value = String.sub state.buffer offset size in let result = conv state.buffer offset in state.slices <- {name; value; pretty_printed = pp result} :: state.slices; result (** Reader for all the atomic types. *) module Atom = struct let read_byte state = let size = Binary_size.int8 in let offset = state.offset in state.remaining_bytes <- check_remaining_bytes state size; state.allowed_bytes <- check_allowed_bytes state size; state.offset <- state.offset + size; TzEndian.get_int8_string state.buffer offset let uint8 = read_atom ~pp:string_of_int Binary_size.uint8 TzEndian.get_uint8_string let uint16 = read_atom ~pp:string_of_int Binary_size.int16 TzEndian.get_uint16_string let int8 = read_atom ~pp:string_of_int Binary_size.int8 TzEndian.get_int8_string let int16 = read_atom ~pp:string_of_int Binary_size.int16 TzEndian.get_int16_string let int32 = read_atom ~pp:Int32.to_string Binary_size.int32 TzEndian.get_int32_string let int64 = read_atom ~pp:Int64.to_string Binary_size.int64 TzEndian.get_int64_string let float = read_atom ~pp:string_of_float Binary_size.float TzEndian.get_double_string let bool state name = read_atom ~pp:(fun x -> string_of_bool (x <> 0)) Binary_size.int8 TzEndian.get_int8_string state name <> 0 let uint30 = read_atom ~pp:string_of_int Binary_size.uint30 @@ fun buffer ofs -> let v = Int32.to_int (TzEndian.get_int32_string buffer ofs) in if v < 0 then raise (Invalid_int {min = 0; v; max = (1 lsl 30) - 1}); v let int31 = read_atom ~pp:string_of_int Binary_size.int31 @@ fun buffer ofs -> Int32.to_int (TzEndian.get_int32_string buffer ofs) let int = function | `Int31 -> int31 | `Int16 -> int16 | `Int8 -> int8 | `Uint30 -> uint30 | `Uint16 -> uint16 | `Uint8 -> uint8 let ranged_int ~minimum ~maximum name state = let read_int = match Binary_size.range_to_size ~minimum ~maximum with | `Int8 -> int8 | `Int16 -> int16 | `Int31 -> int31 | `Uint8 -> uint8 | `Uint16 -> uint16 | `Uint30 -> uint30 in let ranged = read_int name state in let ranged = if minimum > 0 then ranged + minimum else ranged in if not (minimum <= ranged && ranged <= maximum) then raise (Invalid_int {min = minimum; v = ranged; max = maximum}); ranged let ranged_float ~minimum ~maximum name state = let ranged = float name state in if not (minimum <= ranged && ranged <= maximum) then raise (Invalid_float {min = minimum; v = ranged; max = maximum}); ranged let rec read_z res value bit_in_value name state initial_offset = let byte = read_byte state in let value = value lor ((byte land 0x7F) lsl bit_in_value) in let bit_in_value = bit_in_value + 7 in let (bit_in_value, value) = if bit_in_value < 8 then (bit_in_value, value) else ( Buffer.add_char res (Char.unsafe_chr (value land 0xFF)); (bit_in_value - 8, value lsr 8) ) in if byte land 0x80 = 0x80 then read_z res value bit_in_value name state initial_offset else ( if bit_in_value > 0 then Buffer.add_char res (Char.unsafe_chr value); if byte = 0x00 then raise Trailing_zero; let result = Z.of_bits (Buffer.contents res) in let pretty_printed = Z.to_string result in let value = String.sub state.buffer initial_offset (state.offset - initial_offset) in state.slices <- {name; value; pretty_printed} :: state.slices; result ) let n name state = let initial_offset = state.offset in let first = read_byte state in let first_value = first land 0x7F in if first land 0x80 = 0x80 then read_z (Buffer.create 100) first_value 7 name state initial_offset else let result = Z.of_int first_value in let pretty_printed = Z.to_string result in let value = String.sub state.buffer initial_offset (state.offset - initial_offset) in state.slices <- {name; value; pretty_printed} :: state.slices; result let z name state = let initial_offset = state.offset in let first = read_byte state in let first_value = first land 0x3F in let sign = first land 0x40 <> 0 in if first land 0x80 = 0x80 then let n = read_z (Buffer.create 100) first_value 6 name state initial_offset in if sign then Z.neg n else n else let n = Z.of_int first_value in if sign then Z.neg n else n let string_enum arr name state = let read_index = match Binary_size.enum_size arr with | `Uint8 -> uint8 | `Uint16 -> uint16 | `Uint30 -> uint30 in let index = read_index name state in if index >= Array.length arr then raise No_case_matched; arr.(index) let fixed_length_bytes length = read_atom length @@ fun buf ofs -> Bytes.unsafe_of_string @@ String.sub buf ofs length let fixed_length_string length = read_atom ~pp:(Format.sprintf "%S") length @@ fun buf ofs -> String.sub buf ofs length let tag = function `Uint8 -> uint8 | `Uint16 -> uint16 end (** Main recursive reading function, in continuation passing style. *) let rec read_rec : type ret. ret Encoding.t -> ?name:string -> slicer_state -> ret = fun e ?name state -> let ( !! ) x = match name with None -> x | Some name -> Format.sprintf "%S (%s)" name x in let open Encoding in match e.encoding with | Null -> () | Empty -> () | Constant _ -> () | Ignore -> () | Bool -> Atom.bool !!"bool" state | Int8 -> Atom.int8 !!"int8" state | Uint8 -> Atom.uint8 !!"uint8" state | Int16 -> Atom.int16 !!"int16" state | Uint16 -> Atom.uint16 !!"uint16" state | Int31 -> Atom.int31 !!"int31" state | Int32 -> Atom.int32 !!"int32" state | Int64 -> Atom.int64 !!"int64" state | N -> Atom.n !!"N" state | Z -> Atom.z !!"Z" state | Float -> Atom.float !!"float" state | Bytes (`Fixed n) -> Atom.fixed_length_bytes n !!"bytes" state | Bytes `Variable -> Atom.fixed_length_bytes state.remaining_bytes !!"bytes" state | String (`Fixed n) -> Atom.fixed_length_string n !!"string" state | String `Variable -> Atom.fixed_length_string state.remaining_bytes !!"string" state | Padded (e, n) -> let v = read_rec e ?name state in ignore (Atom.fixed_length_string n "padding" state : string); v | RangedInt {minimum; maximum} -> Atom.ranged_int ~minimum ~maximum !!"ranged int" state | RangedFloat {minimum; maximum} -> Atom.ranged_float ~minimum ~maximum !!"ranged float" state | String_enum (_, arr) -> Atom.string_enum arr !!"enum" state | Array (max_length, e) -> let max_length = match max_length with Some l -> l | None -> max_int in let l = read_list List_too_long max_length e ?name state in Array.of_list l | List (max_length, e) -> let max_length = match max_length with Some l -> l | None -> max_int in read_list Array_too_long max_length e ?name state | Obj (Req {encoding = e; name; _}) -> read_rec e ~name state | Obj (Dft {encoding = e; name; _}) -> read_rec e ~name state | Obj (Opt {kind = `Dynamic; encoding = e; name; _}) -> let present = Atom.bool (name ^ " presence flag") state in if not present then None else Some (read_rec e ~name:!!name state) | Obj (Opt {kind = `Variable; encoding = e; name; _}) -> if state.remaining_bytes = 0 then None else Some (read_rec e ~name:!!name state) | Objs {kind = `Fixed sz; left; right} -> ignore (check_remaining_bytes state sz : int); ignore (check_allowed_bytes state sz : int option); let left = read_rec left ?name state in let right = read_rec right ?name state in (left, right) | Objs {kind = `Dynamic; left; right} -> let left = read_rec left ?name state in let right = read_rec right ?name state in (left, right) | Objs {kind = `Variable; left; right} -> read_variable_pair left right ?name state | Tup e -> read_rec e ?name state | Tups {kind = `Fixed sz; left; right} -> ignore (check_remaining_bytes state sz : int); ignore (check_allowed_bytes state sz : int option); let left = read_rec left ?name state in let right = read_rec right ?name state in (left, right) | Tups {kind = `Dynamic; left; right} -> let left = read_rec left ?name state in let right = read_rec right ?name state in (left, right) | Tups {kind = `Variable; left; right} -> read_variable_pair left right ?name state | Conv {inj; encoding; _} -> inj (read_rec encoding ?name state) | Union {tag_size; cases; _} -> let ctag = Atom.tag tag_size "DUMMY" state in let (Case {encoding; inj; _}) = try List.find (function | Case {tag = tg; title; _} -> if Uint_option.is_some tg && Uint_option.get tg = ctag then ( let {value; pretty_printed; _} = List.hd state.slices in state.slices <- {name = title ^ " tag"; value; pretty_printed} :: List.tl state.slices; true ) else false) cases with Not_found -> raise (Unexpected_tag ctag) in inj (read_rec encoding ?name state) | Dynamic_size {kind; encoding = e} -> let sz = Atom.int kind "dynamic length" state in let remaining = check_remaining_bytes state sz in state.remaining_bytes <- sz; ignore (check_allowed_bytes state sz : int option); let v = read_rec e ?name state in if state.remaining_bytes <> 0 then raise Extra_bytes; state.remaining_bytes <- remaining; v | Check_size {limit; encoding = e} -> let old_allowed_bytes = state.allowed_bytes in let limit = match state.allowed_bytes with | None -> limit | Some current_limit -> min current_limit limit in state.allowed_bytes <- Some limit; let v = read_rec e ?name state in let allowed_bytes = match old_allowed_bytes with | None -> None | Some old_limit -> let remaining = match state.allowed_bytes with | None -> assert false | Some remaining -> remaining in let read = limit - remaining in Some (old_limit - read) in state.allowed_bytes <- allowed_bytes; v | Describe {encoding = e; id; _} -> read_rec e ~name:!!id state | Splitted {encoding = e; _} -> read_rec e ?name state | Mu {fix; name; _} -> read_rec (fix e) ~name:!!name state | Delayed f -> read_rec (f ()) ?name state and read_variable_pair : type left right. left Encoding.t -> right Encoding.t -> ?name:string -> slicer_state -> left * right = fun e1 e2 ?name state -> match (Encoding.classify e1, Encoding.classify e2) with | ((`Dynamic | `Fixed _), `Variable) -> let left = read_rec e1 ?name state in let right = read_rec e2 ?name state in (left, right) | (`Variable, `Fixed n) -> if n > state.remaining_bytes then raise Not_enough_data; state.remaining_bytes <- state.remaining_bytes - n; let left = read_rec e1 ?name state in assert (state.remaining_bytes = 0); state.remaining_bytes <- n; let right = read_rec e2 ?name state in assert (state.remaining_bytes = 0); (left, right) | _ -> assert false and read_list : type a. read_error -> int -> a Encoding.t -> ?name:string -> slicer_state -> a list = fun error max_length e ?name state -> let rec loop max_length acc = if state.remaining_bytes = 0 then List.rev acc else if max_length = 0 then raise error else let name = Option.map (fun name -> name ^ " element") name in let v = read_rec e ?name state in loop (max_length - 1) (v :: acc) in loop max_length [] (** Various entry points *) let slice_exn encoding state = let _ = read_rec encoding state in List.rev state.slices let slice encoding state = try Ok (slice_exn encoding state) with Read_error e -> Error e let slice_opt encoding state = try Some (slice_exn encoding state) with Read_error _ -> None let slice_string_exn encoding buffer = let len = String.length buffer in let state = { buffer; offset = 0; slices = []; remaining_bytes = len; allowed_bytes = None; } in let _ = read_rec encoding state in if state.offset <> len then raise Extra_bytes; List.rev state.slices let slice_string encoding buffer = try Ok (slice_string_exn encoding buffer) with Read_error e -> Error e let slice_string_opt encoding buffer = try Some (slice_string_exn encoding buffer) with Read_error _ -> None let slice_bytes e b = slice_string e (Bytes.unsafe_to_string b) let slice_bytes_opt e b = slice_string_opt e (Bytes.unsafe_to_string b) let slice_bytes_exn e b = slice_string_exn e (Bytes.unsafe_to_string b)
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>