ligo/lib_base/block_header.ml
Grégoire Henry b6449cae87 Jbuilder: split src/utils/ in multiple OPAM packages
* `lib_stdlib`: basic extended OCaml stdlib and generic data structures

* `lib_data_encoding`: almost independant 'Data_encoding'
* `lib_error_monad`: almost independant 'Error_monad'

* `lib_stdlib_lwt`: extended Lwt library
* `lib_crypto`: all the crypto stuff (hashing, signing, cryptobox).

* `lib_base`:
  - basic type definitions (Block_header, Operation, ...)
  - a module `TzPervasives` to bind them all and to be the
    single module opened everywhere.

In the process, I splitted `Tezos_data` and `Hash` in multiple
submodules, thus removing a lot of `-open`.

The following two modules may not have found their place yet:
- Base58 (currently in `lib_crypto`)
- Cli_entries (currently in `lib_stdlib_lwt`)
2017-12-04 16:05:54 +01:00

91 lines
3.2 KiB
OCaml

(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
type shell_header = {
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
timestamp: Time.t ;
validation_passes: int ; (* uint8 *)
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
}
let shell_header_encoding =
let open Data_encoding in
conv
(fun { level ; proto_level ; predecessor ;
timestamp ; validation_passes ; operations_hash ; fitness } ->
(level, proto_level, predecessor,
timestamp, validation_passes, operations_hash, fitness))
(fun (level, proto_level, predecessor,
timestamp, validation_passes, operations_hash, fitness) ->
{ level ; proto_level ; predecessor ;
timestamp ; validation_passes ; operations_hash ; fitness })
(obj7
(req "level" int32)
(req "proto" uint8)
(req "predecessor" Block_hash.encoding)
(req "timestamp" Time.encoding)
(req "validation_pass" uint8)
(req "operations_hash" Operation_list_list_hash.encoding)
(req "fitness" Fitness.encoding))
type t = {
shell: shell_header ;
proto: MBytes.t ;
}
let encoding =
let open Data_encoding in
conv
(fun { shell ; proto } -> (shell, proto))
(fun (shell, proto) -> { shell ; proto })
(merge_objs
shell_header_encoding
(obj1 (req "data" Variable.bytes)))
let pp fmt op =
Format.pp_print_string fmt @@
Data_encoding_ezjsonm.to_string (Data_encoding.Json.construct encoding op)
let compare b1 b2 =
let (>>) x y = if x = 0 then y () else x in
let rec list compare xs ys =
match xs, ys with
| [], [] -> 0
| _ :: _, [] -> -1
| [], _ :: _ -> 1
| x :: xs, y :: ys ->
compare x y >> fun () -> list compare xs ys in
Block_hash.compare b1.shell.predecessor b2.shell.predecessor >> fun () ->
compare b1.proto b2.proto >> fun () ->
Operation_list_list_hash.compare
b1.shell.operations_hash b2.shell.operations_hash >> fun () ->
Time.compare b1.shell.timestamp b2.shell.timestamp >> fun () ->
list compare b1.shell.fitness b2.shell.fitness
let equal b1 b2 = compare b1 b2 = 0
let (=) = equal
let (<>) x y = compare x y <> 0
let (<) x y = compare x y < 0
let (<=) x y = compare x y <= 0
let (>=) x y = compare x y >= 0
let (>) x y = compare x y > 0
let min x y = if x <= y then x else y
let max x y = if x <= y then y else x
let to_bytes v = Data_encoding.Binary.to_bytes encoding v
let of_bytes b = Data_encoding.Binary.of_bytes encoding b
let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b
let hash block = Block_hash.hash_bytes [to_bytes block]
let hash_raw bytes = Block_hash.hash_bytes [bytes]