https://gitlab.com/nomadic-labs/data-encoding/
Tip revision: 7a0495c4f29b4cdc441709e6557a36caac1d4c95 authored by Yann Regis-Gianas on 07 January 2021, 14:27:44 UTC
Introduce custom binary encoders
Introduce custom binary encoders
Tip revision: 7a0495c
binary_writer.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.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_writer_state
type state = Binary_writer_state.t
let raise error = raise (Binary_error_types.Write_error error)
(** Main recursive writing function. *)
let rec write_rec : type a. a Encoding.t -> state -> a -> unit =
fun e state value ->
let open Encoding in
match e.encoding with
| Null ->
()
| Empty ->
()
| Constant _ ->
()
| Ignore ->
()
| Bool ->
Atom.bool state value
| Int8 ->
Atom.int8 state value
| Uint8 ->
Atom.uint8 state value
| Int16 ->
Atom.int16 state value
| Uint16 ->
Atom.uint16 state value
| Int31 ->
Atom.int31 state value
| Int32 ->
Atom.int32 state value
| Int64 ->
Atom.int64 state value
| N ->
Atom.n state value
| Z ->
Atom.z state value
| Float ->
Atom.float state value
| Bytes (`Fixed n) ->
Atom.fixed_kind_bytes n state value
| Bytes `Variable ->
let length = Bytes.length value in
Atom.fixed_kind_bytes length state value
| String (`Fixed n) ->
Atom.fixed_kind_string n state value
| String `Variable ->
let length = String.length value in
Atom.fixed_kind_string length state value
| Padded (e, n) ->
write_rec e state value ;
Atom.fixed_kind_string n state (String.make n '\000')
| RangedInt {minimum; maximum} ->
Atom.ranged_int ~minimum ~maximum state value
| RangedFloat {minimum; maximum} ->
Atom.ranged_float ~minimum ~maximum state value
| String_enum (tbl, arr) ->
Atom.string_enum tbl arr state value
| Array (Some max_length, _e) when Array.length value > max_length ->
raise Array_too_long
| Array (_, e) ->
Array.iter (write_rec e state) value
| List (Some max_length, _e) when List.length value > max_length ->
raise List_too_long
| List (_, e) ->
List.iter (write_rec e state) value
| Obj (Req {encoding = e; _}) ->
write_rec e state value
| Obj (Opt {kind = `Dynamic; encoding = e; _}) -> (
match value with
| None ->
Atom.bool state false
| Some value ->
Atom.bool state true ; write_rec e state value )
| Obj (Opt {kind = `Variable; encoding = e; _}) -> (
match value with None -> () | Some value -> write_rec e state value )
| Obj (Dft {encoding = e; _}) ->
write_rec e state value
| Objs {left; right; _} ->
let (v1, v2) = value in
write_rec left state v1 ; write_rec right state v2
| Tup e ->
write_rec e state value
| Tups {left; right; _} ->
let (v1, v2) = value in
write_rec left state v1 ; write_rec right state v2
| Custom {write; _} ->
write state value
| Conv {encoding = e; proj; _} ->
write_rec e state (proj value)
| Union {tag_size; cases; _} ->
let rec write_case = function
| [] ->
raise No_case_matched
| Case {tag = Json_only; _} :: tl ->
write_case tl
| Case {encoding = e; proj; tag = Tag tag; _} :: tl -> (
match proj value with
| None ->
write_case tl
| Some value ->
Atom.tag tag_size state tag ;
write_rec e state value )
in
write_case cases
| Dynamic_size {kind; encoding = e} ->
let initial_offset = Binary_writer_state.offset state in
(* place holder for [size] *)
Atom.int kind state 0 ;
write_with_limit (Binary_size.max_int kind) e state value ;
(* patch the written [size] *)
Atom.set_int
kind
state
initial_offset
(offset state - initial_offset - Binary_size.integer_to_size kind)
| Check_size {limit; encoding = e} ->
write_with_limit limit e state value
| Describe {encoding = e; _} ->
write_rec e state value
| Splitted {encoding = e; _} ->
write_rec e state value
| Mu {fix; _} ->
write_rec (fix e) state value
| Delayed f ->
write_rec (f ()) state value
and write_with_limit : type a. int -> a Encoding.t -> state -> a -> unit =
fun limit e state value ->
(* backup the current limit *)
let old_limit = allowed_bytes state in
(* install the new limit (only if smaller than the current limit) *)
let limit =
match allowed_bytes state with
| None ->
limit
| Some old_limit ->
min old_limit limit
in
set_allowed_bytes state (Some limit) ;
write_rec e state value ;
(* restore the previous limit (minus the read bytes) *)
match old_limit with
| None ->
set_allowed_bytes state None
| Some old_limit ->
let remaining =
match allowed_bytes state with None -> assert false | Some len -> len
in
let read = limit - remaining in
set_allowed_bytes state (Some (old_limit - read))
(** ******************** *)
(** Various entry points *)
let write_state = write_rec
let write_exn e v buffer offset len =
(* By hardcoding [allowed_bytes] with the buffer length,
we ensure that [write] will never reallocate the buffer. *)
let state = Binary_writer_state.make buffer offset (Some len) in
write_rec e state v ;
Binary_writer_state.offset state
let write e v buffer offset len =
try Ok (write_exn e v buffer offset len)
with Binary_error_types.Write_error err -> Error err
let write_opt e v buffer offset len =
try Some (write_exn e v buffer offset len)
with Binary_error_types.Write_error _ -> None
let to_bytes_exn ?(buffer_size = 128) e v =
match Encoding.classify e with
| `Fixed n ->
(* Preallocate the complete buffer *)
let state = Binary_writer_state.make (Bytes.create n) 0 (Some n) in
write_rec e state v ;
Binary_writer_state.buffer state
| `Dynamic | `Variable ->
(* Preallocate a minimal buffer and let's not hardcode a
limit to its extension. *)
let state = Binary_writer_state.make (Bytes.create buffer_size) 0 None in
write_rec e state v ;
Binary_writer_state.(sub_buffer state 0 (offset state))
let to_bytes_opt ?buffer_size e v =
try Some (to_bytes_exn ?buffer_size e v)
with Binary_error_types.Write_error _ -> None
let to_bytes ?buffer_size e v =
try Ok (to_bytes_exn ?buffer_size e v)
with Binary_error_types.Write_error err -> Error err