Merge branch 'feature/babylon' into 'dev'

upgrade to babylon

See merge request ligolang/ligo!141

src/main/run/of_michelson.ml

@@ -11,15 +11,15 @@ let run ?options (* ?(is_input_value = false) *) (program:compiled_program) (inp
   let (Ex_ty input_ty) = input in
   let (Ex_ty output_ty) = output in
   (* let%bind input_ty_mich =
-   *   Trace.trace_tzresult_lwt (simple_error "error unparsing input ty") @@
+    Trace.trace_tzresult_lwt (simple_error "error unparsing input ty") @@
-   *   Memory_proto_alpha.unparse_michelson_ty input_ty in
+    Memory_proto_alpha.unparse_michelson_ty input_ty in
-   * let%bind output_ty_mich =
+  let%bind output_ty_mich =
-   *   Trace.trace_tzresult_lwt (simple_error "error unparsing output ty") @@
+    Trace.trace_tzresult_lwt (simple_error "error unparsing output ty") @@
-   *   Memory_proto_alpha.unparse_michelson_ty output_ty in
+    Memory_proto_alpha.unparse_michelson_ty output_ty in
-   * Format.printf "code: %a\n" Michelson.pp program.body ;
+  Format.printf "code: %a\n" Michelson.pp program.body ;
-   * Format.printf "input_ty: %a\n" Michelson.pp input_ty_mich ;
+  Format.printf "input_ty: %a\n" Michelson.pp input_ty_mich ;
-   * Format.printf "output_ty: %a\n" Michelson.pp output_ty_mich ;
+  Format.printf "output_ty: %a\n" Michelson.pp output_ty_mich ;
-   * Format.printf "input: %a\n" Michelson.pp input_michelson ; *)
+  Format.printf "input: %a\n" Michelson.pp input_michelson ; *)
   let%bind input =
     Trace.trace_tzresult_lwt (simple_error "error parsing input") @@
     Memory_proto_alpha.parse_michelson_data input_michelson input_ty

src/passes/6-transpiler/transpiler.ml

@@ -287,21 +287,7 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re
   | E_application (a, b) ->
       let%bind a = transpile_annotated_expression a in
       let%bind b = transpile_annotated_expression b in
-      let%bind contains_closure =
+      return @@ E_application (a, b)
-        Self_mini_c.Helpers.fold_type_value
-          (fun contains_closure exp ->
-            ok (contains_closure
-                || match exp with
-                   | T_deep_closure _ -> true
-                   | _ -> false))
-          false
-          b.type_value in
-      if contains_closure
-      then
-        let errmsg = Format.asprintf "Cannot apply closure in function arguments: %a\n"
-                       Mini_c.PP.expression_with_type b in
-        fail @@ simple_error errmsg
-      else return @@ E_application (a, b)
   | E_constructor (m, param) -> (
       let%bind param' = transpile_annotated_expression param in
       let (param'_expr , param'_tv) = Combinators.Expression.(get_content param' , get_type param') in

src/passes/8-compiler/compiler_environment.ml

@@ -14,31 +14,46 @@ let get : environment -> string -> michelson result = fun e s ->
       error title content in
     generic_try error @@
     (fun () -> Environment.get_i s e) in
-  let rec aux = fun n ->
+  let rec aux_bubble = fun n ->
     match n with
     | 0 -> i_dup
     | n -> seq [
-        dip @@ aux (n - 1) ;
+        dip @@ aux_bubble (n - 1) ;
         i_swap ;
       ]
   in
-  let code = aux position in
+  let aux_dig = fun n -> seq [
+      dipn n i_dup ;
+      i_dig n ;
+    ]
+  in
+  let code =
+    if position < 2
+    then aux_bubble position
+    else aux_dig position in
 
   ok code
 
 let set : environment -> string -> michelson result = fun e s ->
   let%bind (_ , position) =
-    generic_try (simple_error "Environment.get") @@
+    generic_try (simple_error "Environment.set") @@
     (fun () -> Environment.get_i s e) in
-  let rec aux = fun n ->
+  let rec aux_bubble = fun n ->
     match n with
     | 0 -> dip i_drop
     | n -> seq [
         i_swap ;
-        dip (aux (n - 1)) ;
+        dip (aux_bubble (n - 1)) ;
       ]
   in
-  let code = aux position in
+  let aux_dug = fun n -> seq [
+      dipn (n + 1) i_drop ;
+      i_dug n ;
+    ] in
+  let code =
+    if position < 2
+    then aux_bubble position
+    else aux_dug position in
 
   ok code
 
@@ -73,5 +88,12 @@ let pack_closure : environment -> selector -> michelson result = fun e lst ->
   ok code
 
 let unpack_closure : environment -> michelson result = fun e ->
-  let aux = fun code _ -> seq [ i_unpair ; dip code ] in
+  match e with
-  ok (List.fold_right' aux (seq []) e)
+  | [] -> ok @@ seq []
+  | _ :: tl -> (
+      let aux = fun code _ -> seq [ i_unpair ; dip code ] in
+      let unpairs = (List.fold_right' aux (seq []) tl) in
+      ok @@ seq [ i_unpiar ; dip unpairs ]
+    )
+  (* let aux = fun code _ -> seq [ i_unpair ; dip code ] in
+   * ok (List.fold_right' aux (seq []) e) *)

src/passes/8-compiler/compiler_program.ml

@@ -151,33 +151,21 @@ and translate_expression (expr:expression) (env:environment) : michelson result
           return @@ seq [
             closure_pack_code ;
             i_push lambda_ty lambda_body_code ;
-            i_pair ;
+            i_swap ;
+            i_apply ;
           ]
         )
       | _ -> simple_fail "expected closure type"
     )
   | E_application (f , arg) -> (
-      match Combinators.Expression.get_type f with
+      trace (simple_error "Compiling quote application") @@
-      | T_function _ -> (
+      let%bind f = translate_expression f env in
-          trace (simple_error "Compiling quote application") @@
+      let%bind arg = translate_expression arg env in
-          let%bind f = translate_expression f env in
+      return @@ seq [
-          let%bind arg = translate_expression arg env in
+        arg ;
-          return @@ seq [
+        dip f ;
-            arg ;
+        prim I_EXEC ;
-            dip f ;
+      ]
-            prim I_EXEC ;
-          ]
-        )
-      | T_deep_closure (_ , _ , _) -> (
-          let%bind f_code = translate_expression f env in
-          let%bind arg_code = translate_expression arg env in
-          return @@ seq [
-            arg_code ;
-            dip (seq [ f_code ; i_unpair ; i_swap ]) ; i_pair ;
-            prim I_EXEC ;
-          ]
-        )
-      | _ -> simple_fail "E_applicationing something not appliable"
     )
   | E_variable x ->
     let%bind code = Compiler_environment.get env x in

src/passes/8-compiler/compiler_type.ml

@@ -32,24 +32,24 @@ module Ty = struct
   let mutez = Mutez_t None
   let string = String_t None
   let key = Key_t None
-  let list a = List_t (a, None)
+  let list a = List_t (a, None , has_big_map a)
   let set a = Set_t (a, None)
   let address = Address_t None
-  let option a = Option_t ((a, None), None, None)
+  let option a = Option_t (a, None , has_big_map a)
   let contract a = Contract_t (a, None)
   let lambda a b = Lambda_t (a, b, None)
   let timestamp = Timestamp_t None
-  let map a b = Map_t (a, b, None)
+  let map a b = Map_t (a, b, None , has_big_map b)
-  let pair a b = Pair_t ((a, None, None), (b, None, None), None)
+  let pair a b = Pair_t ((a, None, None), (b, None, None), None , has_big_map a || has_big_map b)
-  let union a b = Union_t ((a, None), (b, None), None)
+  let union a b = Union_t ((a, None), (b, None), None , has_big_map a || has_big_map b)
 
   let field_annot = Option.map (fun ann -> `Field_annot ann)
 
   let union_ann (anna, a) (annb, b) =
-    Union_t ((a, field_annot anna), (b, field_annot annb), None)
+    Union_t ((a, field_annot anna), (b, field_annot annb), None , has_big_map a || has_big_map b)
 
   let pair_ann (anna, a) (annb, b) =
-    Pair_t ((a, field_annot anna, None), (b, field_annot annb, None), None)
+    Pair_t ((a, field_annot anna, None), (b, field_annot annb, None), None , has_big_map a || has_big_map b)
 
   let not_comparable name () = error (thunk "not a comparable type") (fun () -> name) ()
   let not_compilable_type name () = error (thunk "not a compilable type") (fun () -> name) ()
@@ -115,11 +115,10 @@ module Ty = struct
         let%bind (Ex_ty arg) = type_ arg in
         let%bind (Ex_ty ret) = type_ ret in
         ok @@ Ex_ty (lambda arg ret)
-    | T_deep_closure (c, arg, ret) ->
+    | T_deep_closure (_, arg, ret) ->
-        let%bind (Ex_ty capture) = environment_representation c in
         let%bind (Ex_ty arg) = type_ arg in
         let%bind (Ex_ty ret) = type_ ret in
-        ok @@ Ex_ty (pair (lambda (pair arg capture) ret) capture)
+        ok @@ Ex_ty (lambda arg ret)
     | T_map (k, v) ->
         let%bind (Ex_comparable_ty k') = comparable_type k in
         let%bind (Ex_ty v') = type_ v in
@@ -219,10 +218,10 @@ let rec type_ : type_value -> O.michelson result =
       let%bind arg = type_ arg in
       let%bind ret = type_ ret in
       ok @@ O.prim ~children:[arg;ret] T_lambda
-  | T_deep_closure (c , arg , ret) ->
+  | T_deep_closure (_ , arg , ret) ->
-      let%bind capture = environment_closure c in
+      let%bind arg = type_ arg in
-      let%bind lambda = lambda_closure (c , arg , ret) in
+      let%bind ret = type_ ret in
-      ok @@ O.t_pair lambda capture
+      ok @@ O.prim ~children:[arg;ret] T_lambda
 
 and annotated : type_value annotated -> O.michelson result =
   function
@@ -243,7 +242,7 @@ and lambda_closure = fun (c , arg , ret) ->
   let%bind capture = environment_closure c in
   let%bind arg = type_ arg in
   let%bind ret = type_ ret in
-  ok @@ O.t_lambda (O.t_pair arg capture) ret
+  ok @@ O.t_lambda (O.t_pair capture arg) ret
 
 and environment_closure =
   function

src/passes/8-compiler/uncompiler.ml

@@ -8,16 +8,16 @@ open Script_ir_translator
 
 let rec translate_value ?bm_opt (Ex_typed_value (ty, value)) : value result =
   match (ty, value) with
-  | Pair_t ((a_ty, _, _), (b_ty, _, _), _), (a, b) -> (
+  | Pair_t ((a_ty, _, _), (b_ty, _, _), _ , _), (a, b) -> (
       let%bind a = translate_value ?bm_opt @@ Ex_typed_value(a_ty, a) in
       let%bind b = translate_value ?bm_opt @@ Ex_typed_value(b_ty, b) in
       ok @@ D_pair(a, b)
     )
-  | Union_t ((a_ty, _), _, _), L a -> (
+  | Union_t ((a_ty, _), _, _ , _), L a -> (
       let%bind a = translate_value ?bm_opt @@ Ex_typed_value(a_ty, a) in
       ok @@ D_left a
     )
-  | Union_t (_, (b_ty, _), _), R b -> (
+  | Union_t (_, (b_ty, _), _ , _), R b -> (
       let%bind b = translate_value ?bm_opt @@ Ex_typed_value(b_ty, b) in
       ok @@ D_right b
     )
@@ -47,16 +47,16 @@ let rec translate_value ?bm_opt (Ex_typed_value (ty, value)) : value result =
       ok @@ D_string s
   | (Bytes_t _), b ->
       ok @@ D_bytes (Tezos_stdlib.MBytes.to_bytes b)
-  | (Address_t _), s ->
+  | (Address_t _), (s , _) ->
       ok @@ D_string (Alpha_context.Contract.to_b58check s)
   | (Unit_t _), () ->
       ok @@ D_unit
   | (Option_t _), None ->
       ok @@ D_none
-  | (Option_t ((o_ty, _), _, _)), Some s ->
+  | (Option_t (o_ty, _, _)), Some s ->
       let%bind s' = translate_value @@ Ex_typed_value (o_ty, s) in
       ok @@ D_some s'
-  | (Map_t (k_cty, v_ty, _)), m ->
+  | (Map_t (k_cty, v_ty, _ , _)), m ->
       let k_ty = Script_ir_translator.ty_of_comparable_ty k_cty in
       let lst =
         let aux k v acc = (k, v) :: acc in
@@ -95,7 +95,7 @@ let rec translate_value ?bm_opt (Ex_typed_value (ty, value)) : value result =
           | None -> ok orig_rem in
         bind_fold_list aux original_big_map lst in
       ok @@ D_big_map lst'
-  | (List_t (ty, _)), lst ->
+  | (List_t (ty, _ , _)), lst ->
       let%bind lst' =
         let aux = fun t -> translate_value (Ex_typed_value (ty, t)) in
         bind_map_list aux lst
@@ -113,7 +113,7 @@ let rec translate_value ?bm_opt (Ex_typed_value (ty, value)) : value result =
       in
       ok @@ D_set lst''
     )
-  | (Operation_t _) , op ->
+  | (Operation_t _) , (op , _) ->
       ok @@ D_operation op
   | ty, v ->
       let%bind error =

src/passes/9-self_michelson/self_michelson.ml

@@ -92,6 +92,11 @@ let arity : prim -> int option = function
  | I_ISNAT -> Some 1
  | I_CAST -> None
  | I_RENAME -> None
+ | I_CHAIN_ID -> Some 0
+ | I_EMPTY_BIG_MAP -> Some 0
+ | I_APPLY -> None
+ | I_DIG -> None
+ | I_DUG -> None
 
  | K_parameter
  | K_storage
@@ -126,7 +131,9 @@ let arity : prim -> int option = function
  | T_timestamp
  | T_unit
  | T_operation
- | T_address -> None
+ | T_address
+ | T_chain_id
+   -> None
 
 let is_nullary_op (p : prim) : bool =
   match arity p with

src/test/contracts/high-order.ligo

@@ -8,21 +8,20 @@ function foobar (const i : int) : int is
 
 // higher order function with more than one argument
 function higher2(const i: int; const f: int -> int): int is
-    block { 
+  block { 
-        const ii: int = f(i)
+      const ii: int = f(i)
-     } with ii
+   } with ii
 
 function foobar2 (const i : int) : int is
   function foo2 (const i : int) : int is
     block { skip } with i;
   block { skip } with higher2(i,foo2)
 
-// This is not supported yet:
+const a : int = 0;
-// const a : int = 123;
+function foobar3 (const i : int) : int is
-// function foobar3 (const i : int) : int is
+  function foo2 (const i : int) : int is
-//   function foo2 (const i : int) : int is
+    block { skip } with (a+i);
-//     block { skip } with (a+i);
+  block { skip } with higher2(i,foo2)
-//   block { skip } with higher2(i,foo2)
 
 function f (const i : int) : int is
   block { skip }
@@ -35,3 +34,16 @@ function g (const i : int) : int is
 function foobar4 (const i : int) : int is
   block { skip }
   with g(g(i))
+
+function higher3(const i: int; const f: int -> int; const g: int -> int): int is
+  block { 
+      const ii: int = f(g(i));
+   } with ii
+
+function foobar5 (const i : int) : int is
+  const a : int = 0;
+  function foo (const i : int) : int is
+    block { skip } with (a+i);
+  function goo (const i : int) : int is
+    block { skip } with foo(i);
+  block { skip } with higher3(i,foo,goo)

src/test/integration_tests.ml

@@ -113,9 +113,9 @@ let higher_order () : unit result =
   let make_expect = fun n -> n in
   let%bind _ = expect_eq_n_int program "foobar" make_expect in
   let%bind _ = expect_eq_n_int program "foobar2" make_expect in
-  (* not supported yet:
+  let%bind _ = expect_eq_n_int program "foobar3" make_expect in
-  let%bind _ = expect_eq_n_int program "foobar3" make_expect in *)
   let%bind _ = expect_eq_n_int program "foobar4" make_expect in
+  let%bind _ = expect_eq_n_int program "foobar5" make_expect in
   ok () 
 
 let shared_function () : unit result =

vendors/ligo-utils/memory-proto-alpha/dune

@@ -3,6 +3,6 @@
   (public_name tezos-memory-proto-alpha)
   (libraries
     tezos-protocol-environment
-    tezos-protocol-alpha
+    tezos-protocol-005-PsBabyM1
   )
 )

vendors/ligo-utils/memory-proto-alpha/memory_proto_alpha.ml

@@ -1,9 +1,9 @@
 module Name = struct let name = "alpha" end
-module Alpha_environment = Tezos_protocol_alpha.Protocol.Environment
+module Alpha_environment = Tezos_protocol_005_PsBabyM1.Protocol.Environment
 
 
 type alpha_error = Alpha_environment.Error_monad.error
 type 'a alpha_tzresult = 'a Alpha_environment.Error_monad.tzresult
 module Alpha_error_monad = Alpha_environment.Error_monad
-module Proto = Tezos_protocol_alpha
+module Proto = Tezos_protocol_005_PsBabyM1
 include Proto

vendors/ligo-utils/memory-proto-alpha/tezos-memory-proto-alpha.opam

@@ -10,7 +10,7 @@ bug-reports: "https://gitlab.com/ligolang/tezos/issues"
 depends: [
   "dune"
   "tezos-protocol-environment"
-  "tezos-protocol-alpha"
+  "tezos-protocol-005-PsBabyM1"
 ]
 build: [
   ["dune" "build" "-p" name]

vendors/ligo-utils/proto-alpha-utils/cast.ml

@@ -56,183 +56,222 @@ include struct
   open Michelson_v1_primitives
   open Protocol.Environment
 
+
+
   let rec unparse_data_generic
-          : type a. context -> ?mapper:(ex_typed_value -> Script.node option tzresult Lwt.t) ->
+    : type a. context -> ?mapper:_ -> unparsing_mode -> a ty -> a -> (Script.node * context) tzresult Lwt.t
-                 unparsing_mode -> a ty -> a -> (Script.node * context) tzresult Lwt.t
     = fun ctxt ?(mapper = fun _ -> return None) mode ty a ->
-    Lwt.return (Gas.consume ctxt Unparse_costs.cycle) >>=? fun ctxt ->
+      Lwt.return (Gas.consume ctxt Unparse_costs.cycle) >>=? fun ctxt ->
-    mapper (Ex_typed_value (ty, a)) >>=? function
+      mapper (Ex_typed_value (ty, a)) >>=? function
-    | Some x -> return (x, ctxt)
+      | Some x -> return (x , ctxt)
-    | None -> (
+      | None -> (
-      match ty, a with
+          match ty, a with
-      | Unit_t _, () ->
+          | Unit_t _, () ->
-         Lwt.return (Gas.consume ctxt Unparse_costs.unit) >>=? fun ctxt ->
+            Lwt.return (Gas.consume ctxt Unparse_costs.unit) >>=? fun ctxt ->
-         return (Prim (-1, D_Unit, [], []), ctxt)
+            return (Prim (-1, D_Unit, [], []), ctxt)
-      | Int_t _, v ->
+          | Int_t _, v ->
-         Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->
+            Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->
-         return (Int (-1, Script_int.to_zint v), ctxt)
+            return (Int (-1, Script_int.to_zint v), ctxt)
-      | Nat_t _, v ->
+          | Nat_t _, v ->
-         Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->
+            Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->
-         return (Int (-1, Script_int.to_zint v), ctxt)
+            return (Int (-1, Script_int.to_zint v), ctxt)
-      | String_t _, s ->
+          | String_t _, s ->
-         Lwt.return (Gas.consume ctxt (Unparse_costs.string s)) >>=? fun ctxt ->
+            Lwt.return (Gas.consume ctxt (Unparse_costs.string s)) >>=? fun ctxt ->
-         return (String (-1, s), ctxt)
+            return (String (-1, s), ctxt)
-      | Bytes_t _, s ->
+          | Bytes_t _, s ->
-         Lwt.return (Gas.consume ctxt (Unparse_costs.bytes s)) >>=? fun ctxt ->
+            Lwt.return (Gas.consume ctxt (Unparse_costs.bytes s)) >>=? fun ctxt ->
-         return (Bytes (-1, s), ctxt)
+            return (Bytes (-1, s), ctxt)
-      | Bool_t _, true ->
+          | Bool_t _, true ->
-         Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->
+            Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->
-         return (Prim (-1, D_True, [], []), ctxt)
+            return (Prim (-1, D_True, [], []), ctxt)
-      | Bool_t _, false ->
+          | Bool_t _, false ->
-         Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->
+            Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->
-         return (Prim (-1, D_False, [], []), ctxt)
+            return (Prim (-1, D_False, [], []), ctxt)
-      | Timestamp_t _, t ->
+          | Timestamp_t _, t ->
-         Lwt.return (Gas.consume ctxt (Unparse_costs.timestamp t)) >>=? fun ctxt ->
+            Lwt.return (Gas.consume ctxt (Unparse_costs.timestamp t)) >>=? fun ctxt ->
-         begin
+            begin
-           match mode with
+              match mode with
-           | Optimized -> return (Int (-1, Script_timestamp.to_zint t), ctxt)
+              | Optimized -> return (Int (-1, Script_timestamp.to_zint t), ctxt)
-           | Readable ->
+              | Readable ->
-              match Script_timestamp.to_notation t with
+                match Script_timestamp.to_notation t with
-              | None -> return (Int (-1, Script_timestamp.to_zint t), ctxt)
+                | None -> return (Int (-1, Script_timestamp.to_zint t), ctxt)
-              | Some s -> return (String (-1, s), ctxt)
+                | Some s -> return (String (-1, s), ctxt)
-         end
+            end
-      | Address_t _, c  ->
+          | Address_t _, (c, entrypoint)  ->
-         Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->
+            Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->
-         begin
+            begin
-           match mode with
+              match mode with
-           | Optimized ->
+              | Optimized ->
-              let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in
+                let entrypoint = match entrypoint with "default" -> "" | name -> name in
-              return (Bytes (-1, bytes), ctxt)
+                let bytes = Data_encoding.Binary.to_bytes_exn
-           | Readable -> return (String (-1, Contract.to_b58check c), ctxt)
+                    Data_encoding.(tup2 Contract.encoding Variable.string)
-         end
+                    (c, entrypoint) in
-      | Contract_t _, (_, c)  ->
+                return (Bytes (-1, bytes), ctxt)
-         Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->
+              | Readable ->
-         begin
+                let notation = match entrypoint with
-           match mode with
+                  | "default" -> Contract.to_b58check c
-           | Optimized ->
+                  | entrypoint -> Contract.to_b58check c ^ "%" ^ entrypoint in
-              let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in
+                return (String (-1, notation), ctxt)
-              return (Bytes (-1, bytes), ctxt)
+            end
-           | Readable -> return (String (-1, Contract.to_b58check c), ctxt)
+          | Contract_t _, (_, (c, entrypoint))  ->
-         end
+            Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->
-      | Signature_t _, s ->
+            begin
-         Lwt.return (Gas.consume ctxt Unparse_costs.signature) >>=? fun ctxt ->
+              match mode with
-         begin
+              | Optimized ->
-           match mode with
+                let entrypoint = match entrypoint with "default" -> "" | name -> name in
-           | Optimized ->
+                let bytes = Data_encoding.Binary.to_bytes_exn
-              let bytes = Data_encoding.Binary.to_bytes_exn Signature.encoding s in
+                    Data_encoding.(tup2 Contract.encoding Variable.string)
-              return (Bytes (-1, bytes), ctxt)
+                    (c, entrypoint) in
-           | Readable ->
+                return (Bytes (-1, bytes), ctxt)
-              return (String (-1, Signature.to_b58check s), ctxt)
+              | Readable ->
-         end
+                let notation = match entrypoint with
-      | Mutez_t _, v ->
+                  | "default" -> Contract.to_b58check c
-         Lwt.return (Gas.consume ctxt Unparse_costs.tez) >>=? fun ctxt ->
+                  | entrypoint -> Contract.to_b58check c ^ "%" ^ entrypoint in
-         return (Int (-1, Z.of_int64 (Tez.to_mutez v)), ctxt)
+                return (String (-1, notation), ctxt)
-      | Key_t _, k ->
+            end
-         Lwt.return (Gas.consume ctxt Unparse_costs.key) >>=? fun ctxt ->
+          | Signature_t _, s ->
-         begin
+            Lwt.return (Gas.consume ctxt Unparse_costs.signature) >>=? fun ctxt ->
-           match mode with
+            begin
-           | Optimized ->
+              match mode with
-              let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k in
+              | Optimized ->
-              return (Bytes (-1, bytes), ctxt)
+                let bytes = Data_encoding.Binary.to_bytes_exn Signature.encoding s in
-           | Readable ->
+                return (Bytes (-1, bytes), ctxt)
-              return (String (-1, Signature.Public_key.to_b58check k), ctxt)
+              | Readable ->
-         end
+                return (String (-1, Signature.to_b58check s), ctxt)
-      | Key_hash_t _, k ->
+            end
-         Lwt.return (Gas.consume ctxt Unparse_costs.key_hash) >>=? fun ctxt ->
+          | Mutez_t _, v ->
-         begin
+            Lwt.return (Gas.consume ctxt Unparse_costs.tez) >>=? fun ctxt ->
-           match mode with
+            return (Int (-1, Z.of_int64 (Tez.to_mutez v)), ctxt)
-           | Optimized ->
+          | Key_t _, k ->
-              let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding k in
+            Lwt.return (Gas.consume ctxt Unparse_costs.key) >>=? fun ctxt ->
-              return (Bytes (-1, bytes), ctxt)
+            begin
-           | Readable ->
+              match mode with
-              return (String (-1, Signature.Public_key_hash.to_b58check k), ctxt)
+              | Optimized ->
-         end
+                let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k in
-      | Operation_t _, op ->
+                return (Bytes (-1, bytes), ctxt)
-         let bytes = Data_encoding.Binary.to_bytes_exn Alpha_context.Operation.internal_operation_encoding op in
+              | Readable ->
-         Lwt.return (Gas.consume ctxt (Unparse_costs.operation bytes)) >>=? fun ctxt ->
+                return (String (-1, Signature.Public_key.to_b58check k), ctxt)
-         return (Bytes (-1, bytes), ctxt)
+            end
-      | Pair_t ((tl, _, _), (tr, _, _), _), (l, r) ->
+          | Key_hash_t _, k ->
-         Lwt.return (Gas.consume ctxt Unparse_costs.pair) >>=? fun ctxt ->
+            Lwt.return (Gas.consume ctxt Unparse_costs.key_hash) >>=? fun ctxt ->
-         unparse_data_generic ~mapper ctxt mode tl l >>=? fun (l, ctxt) ->
+            begin
-         unparse_data_generic ~mapper ctxt mode tr r >>=? fun (r, ctxt) ->
+              match mode with
-         return (Prim (-1, D_Pair, [ l; r ], []), ctxt)
+              | Optimized ->
-      | Union_t ((tl, _), _, _), L l ->
+                let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding k in
-         Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->
+                return (Bytes (-1, bytes), ctxt)
-         unparse_data_generic ~mapper ctxt mode tl l >>=? fun (l, ctxt) ->
+              | Readable ->
-         return (Prim (-1, D_Left, [ l ], []), ctxt)
+                return (String (-1, Signature.Public_key_hash.to_b58check k), ctxt)
-      | Union_t (_, (tr, _), _), R r ->
+            end
-         Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->
+          | Operation_t _, (op, _big_map_diff) ->
-         unparse_data_generic ~mapper ctxt mode tr r >>=? fun (r, ctxt) ->
+            let bytes = Data_encoding.Binary.to_bytes_exn Alpha_context.Operation.internal_operation_encoding op in
-         return (Prim (-1, D_Right, [ r ], []), ctxt)
+            Lwt.return (Gas.consume ctxt (Unparse_costs.operation bytes)) >>=? fun ctxt ->
-      | Option_t ((t, _), _, _), Some v ->
+            return (Bytes (-1, bytes), ctxt)
-         Lwt.return (Gas.consume ctxt Unparse_costs.some) >>=? fun ctxt ->
+          | Chain_id_t _, chain_id ->
-         unparse_data_generic ~mapper ctxt mode t v >>=? fun (v, ctxt) ->
+            let bytes = Data_encoding.Binary.to_bytes_exn Chain_id.encoding chain_id in
-         return (Prim (-1, D_Some, [ v ], []), ctxt)
+            Lwt.return (Gas.consume ctxt (Unparse_costs.chain_id bytes)) >>=? fun ctxt ->
-      | Option_t _, None ->
+            return (Bytes (-1, bytes), ctxt)
-         Lwt.return (Gas.consume ctxt Unparse_costs.none) >>=? fun ctxt ->
+          | Pair_t ((tl, _, _), (tr, _, _), _, _), (l, r) ->
-         return (Prim (-1, D_None, [], []), ctxt)
+            Lwt.return (Gas.consume ctxt Unparse_costs.pair) >>=? fun ctxt ->
-      | List_t (t, _), items ->
+            unparse_data_generic ctxt mode tl l >>=? fun (l, ctxt) ->
-         fold_left_s
+            unparse_data_generic ctxt mode tr r >>=? fun (r, ctxt) ->
-           (fun (l, ctxt) element ->
+            return (Prim (-1, D_Pair, [ l; r ], []), ctxt)
-             Lwt.return (Gas.consume ctxt Unparse_costs.list_element) >>=? fun ctxt ->
+          | Union_t ((tl, _), _, _, _), L l ->
-             unparse_data_generic ~mapper ctxt mode t element >>=? fun (unparsed, ctxt) ->
+            Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->
-             return (unparsed :: l, ctxt))
+            unparse_data_generic ctxt mode tl l >>=? fun (l, ctxt) ->
-           ([], ctxt)
+            return (Prim (-1, D_Left, [ l ], []), ctxt)
-           items >>=? fun (items, ctxt) ->
+          | Union_t (_, (tr, _), _, _), R r ->
-         return (Micheline.Seq (-1, List.rev items), ctxt)
+            Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->
-      | Set_t (t, _), set ->
+            unparse_data_generic ctxt mode tr r >>=? fun (r, ctxt) ->
-         let t = ty_of_comparable_ty t in
+            return (Prim (-1, D_Right, [ r ], []), ctxt)
-         fold_left_s
+          | Option_t (t, _, _), Some v ->
-           (fun (l, ctxt) item ->
+            Lwt.return (Gas.consume ctxt Unparse_costs.some) >>=? fun ctxt ->
-             Lwt.return (Gas.consume ctxt Unparse_costs.set_element) >>=? fun ctxt ->
+            unparse_data_generic ctxt mode t v >>=? fun (v, ctxt) ->
-             unparse_data_generic ~mapper ctxt mode t item >>=? fun (item, ctxt) ->
+            return (Prim (-1, D_Some, [ v ], []), ctxt)
-             return (item :: l, ctxt))
+          | Option_t _, None ->
-           ([], ctxt)
+            Lwt.return (Gas.consume ctxt Unparse_costs.none) >>=? fun ctxt ->
-           (set_fold (fun e acc -> e :: acc) set []) >>=? fun (items, ctxt) ->
+            return (Prim (-1, D_None, [], []), ctxt)
-         return (Micheline.Seq (-1, items), ctxt)
+          | List_t (t, _, _), items ->
-      | Map_t (kt, vt, _), map ->
+            fold_left_s
-         let kt = ty_of_comparable_ty kt in
+              (fun (l, ctxt) element ->
-         fold_left_s
+                 Lwt.return (Gas.consume ctxt Unparse_costs.list_element) >>=? fun ctxt ->
-           (fun (l, ctxt) (k, v) ->
+                 unparse_data_generic ctxt mode t element >>=? fun (unparsed, ctxt) ->
-             Lwt.return (Gas.consume ctxt Unparse_costs.map_element) >>=? fun ctxt ->
+                 return (unparsed :: l, ctxt))
-             unparse_data_generic ~mapper ctxt mode kt k >>=? fun (key, ctxt) ->
+              ([], ctxt)
-             unparse_data_generic ~mapper ctxt mode vt v >>=? fun (value, ctxt) ->
+              items >>=? fun (items, ctxt) ->
-             return (Prim (-1, D_Elt, [ key ; value ], []) :: l, ctxt))
+            return (Micheline.Seq (-1, List.rev items), ctxt)
-           ([], ctxt)
+          | Set_t (t, _), set ->
-           (map_fold (fun k v acc -> (k, v) :: acc) map []) >>=? fun (items, ctxt) ->
+            let t = ty_of_comparable_ty t in
-         return (Micheline.Seq (-1, items), ctxt)
+            fold_left_s
-      | Big_map_t (_kt, _kv, _), _map ->
+              (fun (l, ctxt) item ->
-         return (Micheline.Seq (-1, []), ctxt)
+                 Lwt.return (Gas.consume ctxt Unparse_costs.set_element) >>=? fun ctxt ->
-      | Lambda_t _, Lam (_, original_code) ->
+                 unparse_data_generic ctxt mode t item >>=? fun (item, ctxt) ->
-         unparse_code_generic ~mapper ctxt mode (root original_code)
+                 return (item :: l, ctxt))
-    )
+              ([], ctxt)
+              (set_fold (fun e acc -> e :: acc) set []) >>=? fun (items, ctxt) ->
+            return (Micheline.Seq (-1, items), ctxt)
+          | Map_t (kt, vt, _, _), map ->
+            let kt = ty_of_comparable_ty kt in
+            fold_left_s
+              (fun (l, ctxt) (k, v) ->
+                 Lwt.return (Gas.consume ctxt Unparse_costs.map_element) >>=? fun ctxt ->
+                 unparse_data_generic ctxt mode kt k >>=? fun (key, ctxt) ->
+                 unparse_data_generic ctxt mode vt v >>=? fun (value, ctxt) ->
+                 return (Prim (-1, D_Elt, [ key ; value ], []) :: l, ctxt))
+              ([], ctxt)
+              (map_fold (fun k v acc -> (k, v) :: acc) map []) >>=? fun (items, ctxt) ->
+            return (Micheline.Seq (-1, items), ctxt)
+          | Big_map_t (kt, vt, _), { id = None ; diff = (module Diff) ; _ } ->
+            (* this branch is to allow roundtrip of big map literals *)
+            let kt = ty_of_comparable_ty kt in
+            fold_left_s
+              (fun (l, ctxt) (k, v) ->
+                 Lwt.return (Gas.consume ctxt Unparse_costs.map_element) >>=? fun ctxt ->
+                 unparse_data_generic ctxt mode kt k >>=? fun (key, ctxt) ->
+                 unparse_data_generic ctxt mode vt v >>=? fun (value, ctxt) ->
+                 return (Prim (-1, D_Elt, [ key ; value ], []) :: l, ctxt))
+              ([], ctxt)
+              (Diff.OPS.fold
+                 (fun k v acc -> match v with | None -> acc | Some v -> (k, v) :: acc)
+                 (fst Diff.boxed) []) >>=? fun (items, ctxt) ->
+            return (Micheline.Seq (-1, items), ctxt)
+          | Big_map_t (_kt, _kv, _), { id = Some id ; diff = (module Diff) ; _ } ->
+            if Compare.Int.(Diff.OPS.cardinal (fst Diff.boxed) = 0) then
+              return (Micheline.Int (-1, id), ctxt)
+            else
+              (* this can only be the result of an execution and the map
+                 must have been flushed at this point *)
+              assert false
+          | Lambda_t _, Lam (_, original_code) ->
+            unparse_code_generic ctxt ~mapper mode original_code
+        )
 
-  and unparse_code_generic ctxt ?mapper mode = function
+  and unparse_code_generic ctxt ?mapper mode =
+    let legacy = true in
+    function
     | Prim (loc, I_PUSH, [ ty ; data ], annot) ->
-       Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false ty) >>=? fun (Ex_ty t, ctxt) ->
+      Lwt.return (parse_packable_ty ctxt ~legacy ty) >>=? fun (Ex_ty t, ctxt) ->
-       parse_data ctxt t data >>=? fun (data, ctxt) ->
+      parse_data ctxt ~legacy t data >>=? fun (data, ctxt) ->
-       unparse_data_generic ?mapper ctxt mode t data >>=? fun (data, ctxt) ->
+      unparse_data_generic ctxt ?mapper mode t data >>=? fun (data, ctxt) ->
-       Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 2 annot)) >>=? fun ctxt ->
+      Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 2 annot)) >>=? fun ctxt ->
-       return (Prim (loc, I_PUSH, [ ty ; data ], annot), ctxt)
+      return (Prim (loc, I_PUSH, [ ty ; data ], annot), ctxt)
     | Seq (loc, items) ->
-       fold_left_s
+      fold_left_s
-         (fun (l, ctxt) item ->
+        (fun (l, ctxt) item ->
-           unparse_code_generic ?mapper ctxt mode item >>=? fun (item, ctxt) ->
+           unparse_code_generic ctxt ?mapper mode item >>=? fun (item, ctxt) ->
            return (item :: l, ctxt))
-         ([], ctxt) items >>=? fun (items, ctxt) ->
+        ([], ctxt) items >>=? fun (items, ctxt) ->
-       Lwt.return (Gas.consume ctxt (Unparse_costs.seq_cost (List.length items))) >>=? fun ctxt ->
+      Lwt.return (Gas.consume ctxt (Unparse_costs.seq_cost (List.length items))) >>=? fun ctxt ->
-       return (Micheline.Seq (loc, List.rev items), ctxt)
+      return (Micheline.Seq (loc, List.rev items), ctxt)
     | Prim (loc, prim, items, annot) ->
-       fold_left_s
+      fold_left_s
-         (fun (l, ctxt) item ->
+        (fun (l, ctxt) item ->
-           unparse_code_generic ?mapper ctxt mode item >>=? fun (item, ctxt) ->
+           unparse_code_generic ctxt ?mapper mode item >>=? fun (item, ctxt) ->
            return (item :: l, ctxt))
-         ([], ctxt) items >>=? fun (items, ctxt) ->
+        ([], ctxt) items >>=? fun (items, ctxt) ->
-       Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 3 annot)) >>=? fun ctxt ->
+      Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 3 annot)) >>=? fun ctxt ->
-       return (Prim (loc, prim, List.rev items, annot), ctxt)
+      return (Prim (loc, prim, List.rev items, annot), ctxt)
     | Int _ | String _ | Bytes _ as atom -> return (atom, ctxt)
 
-
 end
 
 let rec mapper (Ex_typed_value (ty, a)) =

vendors/ligo-utils/proto-alpha-utils/dune

@@ -4,7 +4,7 @@
   (libraries
     tezos-error-monad
     tezos-stdlib-unix
-    tezos-protocol-alpha-parameters
+    tezos-protocol-005-PsBabyM1-parameters
     tezos-memory-proto-alpha
     simple-utils
     tezos-utils

vendors/ligo-utils/proto-alpha-utils/init_proto_alpha.ml

@@ -96,26 +96,6 @@ module Context_init = struct
     return context
 
   let genesis
-        ?(preserved_cycles = Constants_repr.default.preserved_cycles)
-        ?(blocks_per_cycle = Constants_repr.default.blocks_per_cycle)
-        ?(blocks_per_commitment = Constants_repr.default.blocks_per_commitment)
-        ?(blocks_per_roll_snapshot = Constants_repr.default.blocks_per_roll_snapshot)
-        ?(blocks_per_voting_period = Constants_repr.default.blocks_per_voting_period)
-        ?(time_between_blocks = Constants_repr.default.time_between_blocks)
-        ?(endorsers_per_block = Constants_repr.default.endorsers_per_block)
-        ?(hard_gas_limit_per_operation = Constants_repr.default.hard_gas_limit_per_operation)
-        ?(hard_gas_limit_per_block = Constants_repr.default.hard_gas_limit_per_block)
-        ?(proof_of_work_threshold = Int64.(neg one))
-        ?(tokens_per_roll = Constants_repr.default.tokens_per_roll)
-        ?(michelson_maximum_type_size = Constants_repr.default.michelson_maximum_type_size)
-        ?(seed_nonce_revelation_tip = Constants_repr.default.seed_nonce_revelation_tip)
-        ?(origination_size = Constants_repr.default.origination_size)
-        ?(block_security_deposit = Constants_repr.default.block_security_deposit)
-        ?(endorsement_security_deposit = Constants_repr.default.endorsement_security_deposit)
-        ?(block_reward = Constants_repr.default.block_reward)
-        ?(endorsement_reward = Constants_repr.default.endorsement_reward)
-        ?(cost_per_byte = Constants_repr.default.cost_per_byte)
-        ?(hard_storage_limit_per_operation = Constants_repr.default.hard_storage_limit_per_operation)
         ?(commitments = [])
         ?(security_deposit_ramp_up_cycles = None)
         ?(no_reward_cycles = None)
@@ -125,45 +105,7 @@ module Context_init = struct
       Pervasives.failwith "Must have one account with a roll to bake";
 
     (* Check there is at least one roll *)
-    let open Tezos_base.TzPervasives.Error_monad in
+    let constants : Constants_repr.parametric = Tezos_protocol_005_PsBabyM1_parameters.Default_parameters.constants_test in
-    begin try
-        let (>>?=) x y = match x with
-          | Ok(a) -> y a
-          | Error(b) -> fail @@ List.hd b in
-        fold_left_s (fun acc (_, amount) ->
-            Alpha_environment.wrap_error @@
-              Tez_repr.(+?) acc amount >>?= fun acc ->
-                                            if acc >= tokens_per_roll then
-                                              raise Exit
-                                            else return acc
-          ) Tez_repr.zero initial_accounts >>=? fun _ ->
-        failwith "Insufficient tokens in initial accounts to create one roll"
-      with Exit -> return ()
-    end >>=? fun () ->
-
-    let constants : Constants_repr.parametric = Tezos_protocol_alpha_parameters.Default_parameters.({
-        preserved_cycles ;
-        blocks_per_cycle ;
-        blocks_per_commitment ;
-        blocks_per_roll_snapshot ;
-        blocks_per_voting_period ;
-        time_between_blocks ;
-        endorsers_per_block ;
-        hard_gas_limit_per_operation ;
-        hard_gas_limit_per_block ;
-        proof_of_work_threshold ;
-        tokens_per_roll ;
-        michelson_maximum_type_size ;
-        seed_nonce_revelation_tip ;
-        origination_size ;
-        block_security_deposit ;
-        endorsement_security_deposit ;
-        block_reward ;
-        endorsement_reward ;
-        cost_per_byte ;
-        hard_storage_limit_per_operation ;
-        test_chain_duration = constants_mainnet.test_chain_duration ;
-      }) in
     check_constants_consistency constants >>=? fun () ->
 
     let hash =
@@ -187,8 +129,6 @@ module Context_init = struct
 
   let init
         ?(slow=false)
-        ?preserved_cycles
-        ?endorsers_per_block
         ?commitments
         n =
     let open Error_monad in
@@ -198,18 +138,10 @@ module Context_init = struct
     begin
       if slow then
         genesis
-          ?preserved_cycles
-          ?endorsers_per_block
           ?commitments
           accounts
       else
         genesis
-          ?preserved_cycles
-          ~blocks_per_cycle:32l
-          ~blocks_per_commitment:4l
-          ~blocks_per_roll_snapshot:8l
-          ~blocks_per_voting_period:(Int32.mul 32l 8l)
-          ?endorsers_per_block
           ?commitments
           accounts
     end >>=? fun ctxt ->

vendors/ligo-utils/proto-alpha-utils/proto-alpha-utils.opam

@@ -42,7 +42,7 @@ depends: [
   "tezos-data-encoding"
   "tezos-protocol-environment"
   "tezos-protocol-alpha"
-  "tezos-protocol-alpha-parameters"
+  "tezos-protocol-005-PsBabyM1-parameters"
   "michelson-parser"
   "simple-utils"
   "tezos-utils"

vendors/ligo-utils/tezos-protocol-alpha-parameters/default_parameters.ml

@@ -25,86 +25,90 @@
 
 open Protocol
 
-let constants_mainnet =
+let constants_mainnet = Constants_repr.{
-  Constants_repr.
+    preserved_cycles = 5 ;
-    {
+    blocks_per_cycle = 4096l ;
-      preserved_cycles = 5;
+    blocks_per_commitment = 32l ;
-      blocks_per_cycle = 4096l;
+    blocks_per_roll_snapshot = 256l ;
-      blocks_per_commitment = 32l;
+    blocks_per_voting_period = 32768l ;
-      blocks_per_roll_snapshot = 256l;
+    time_between_blocks =
-      blocks_per_voting_period = 32768l;
+      List.map Period_repr.of_seconds_exn [ 60L ; 40L ] ;
-      time_between_blocks = List.map Period_repr.of_seconds_exn [60L; 75L];
+    endorsers_per_block = 32 ;
-      endorsers_per_block = 32;
+    hard_gas_limit_per_operation = Z.of_int 800_000 ;
-      hard_gas_limit_per_operation = Z.of_int 800_000;
+    hard_gas_limit_per_block = Z.of_int 8_000_000 ;
-      hard_gas_limit_per_block = Z.of_int 8_000_000;
+    proof_of_work_threshold =
-      proof_of_work_threshold = Int64.(sub (shift_left 1L 46) 1L);
+      Int64.(sub (shift_left 1L 46) 1L) ;
-      tokens_per_roll = Tez_repr.(mul_exn one 8_000);
+    tokens_per_roll = Tez_repr.(mul_exn one 8_000) ;
-      michelson_maximum_type_size = 1000;
+    michelson_maximum_type_size = 1000 ;
-      seed_nonce_revelation_tip =
+    seed_nonce_revelation_tip = begin
-        (match Tez_repr.(one /? 8L) with Ok c -> c | Error _ -> assert false);
+      match Tez_repr.(one /? 8L) with
-      origination_size = 257;
+      | Ok c -> c
-      block_security_deposit = Tez_repr.(mul_exn one 512);
+      | Error _ -> assert false
-      endorsement_security_deposit = Tez_repr.(mul_exn one 64);
+    end ;
-      block_reward = Tez_repr.(mul_exn one 16);
+    origination_size = 257 ;
-      endorsement_reward = Tez_repr.(mul_exn one 2);
+    block_security_deposit = Tez_repr.(mul_exn one 512) ;
-      hard_storage_limit_per_operation = Z.of_int 60_000;
+    endorsement_security_deposit = Tez_repr.(mul_exn one 64) ;
-      cost_per_byte = Tez_repr.of_mutez_exn 1_000L;
+    block_reward = Tez_repr.(mul_exn one 16) ;
-      test_chain_duration = Int64.mul 32768L 60L;
+    endorsement_reward = Tez_repr.(mul_exn one 2) ;
-    }
+    hard_storage_limit_per_operation = Z.of_int 60_000 ;
+    cost_per_byte = Tez_repr.of_mutez_exn 1_000L ;
+    test_chain_duration = Int64.mul 32768L 60L ;
+    quorum_min = 20_00l ; (* quorum is in centile of a percentage *)
+    quorum_max = 70_00l ;
+    min_proposal_quorum = 5_00l ;
+    initial_endorsers = 24 ;
+    delay_per_missing_endorsement = Period_repr.of_seconds_exn 8L ;
+  }
 
-let constants_sandbox =
+let constants_sandbox = Constants_repr.{
-  Constants_repr.
+    constants_mainnet with
-    {
+    preserved_cycles = 2 ;
-      constants_mainnet with
+    blocks_per_cycle = 8l ;
-      preserved_cycles = 2;
+    blocks_per_commitment = 4l ;
-      blocks_per_cycle = 8l;
+    blocks_per_roll_snapshot = 4l ;
-      blocks_per_commitment = 4l;
+    blocks_per_voting_period = 64l ;
-      blocks_per_roll_snapshot = 4l;
+    time_between_blocks =
-      blocks_per_voting_period = 64l;
+      List.map Period_repr.of_seconds_exn [ 1L ; 0L ] ;
-      time_between_blocks = List.map Period_repr.of_seconds_exn [1L; 0L];
+    proof_of_work_threshold = Int64.of_int (-1) ;
-      proof_of_work_threshold = Int64.of_int (-1);
+    initial_endorsers = 1 ;
-    }
+    delay_per_missing_endorsement = Period_repr.of_seconds_exn 1L ;
+  }
 
-let constants_test =
+let constants_test = Constants_repr.{
-  Constants_repr.
+    constants_mainnet with
-    {
+    blocks_per_cycle = 128l ;
-      constants_mainnet with
+    blocks_per_commitment = 4l ;
-      blocks_per_cycle = 128l;
+    blocks_per_roll_snapshot = 32l ;
-      blocks_per_commitment = 4l;
+    blocks_per_voting_period = 256l ;
-      blocks_per_roll_snapshot = 32l;
+    time_between_blocks =
-      blocks_per_voting_period = 256l;
+      List.map Period_repr.of_seconds_exn [ 1L ; 0L ] ;
-      time_between_blocks = List.map Period_repr.of_seconds_exn [1L; 0L];
+    proof_of_work_threshold = Int64.of_int (-1) ;
-      proof_of_work_threshold = Int64.of_int (-1);
+    initial_endorsers = 1 ;
-    }
+    delay_per_missing_endorsement = Period_repr.of_seconds_exn 1L ;
-
+  }
-let bootstrap_accounts_strings =
-  [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav";
-    "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9";
-    "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV";
-    "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU";
-    "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n" ]
 
+let bootstrap_accounts_strings = [
+  "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" ;
+  "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9" ;
+  "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV" ;
+  "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU" ;
+  "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n" ;
+]
 let boostrap_balance = Tez_repr.of_mutez_exn 4_000_000_000_000L
-
+let bootstrap_accounts = List.map (fun s ->
-let bootstrap_accounts =
+    let public_key = Signature.Public_key.of_b58check_exn s in
-  List.map
+    let public_key_hash = Signature.Public_key.hash public_key in
-    (fun s ->
+    Parameters_repr.{
-      let public_key = Signature.Public_key.of_b58check_exn s in
+      public_key_hash ;
-      let public_key_hash = Signature.Public_key.hash public_key in
+      public_key = Some public_key ;
-      Parameters_repr.
+      amount = boostrap_balance ;
-        {
+    })
-          public_key_hash;
-          public_key = Some public_key;
-          amount = boostrap_balance;
-        })
     bootstrap_accounts_strings
 
 (* TODO this could be generated from OCaml together with the faucet
    for now these are harcoded values in the tests *)
 let commitments =
-  let json_result =
+  let json_result = Data_encoding.Json.from_string {json|
-    Data_encoding.Json.from_string
-      {json|
   [
     [ "btz1bRL4X5BWo2Fj4EsBdUwexXqgTf75uf1qa", "23932454669343" ],
     [ "btz1SxjV1syBgftgKy721czKi3arVkVwYUFSv", "72954577464032" ],
@@ -119,28 +123,27 @@ let commitments =
   ]|json}
   in
   match json_result with
-  | Error err ->
+  | Error err -> raise (Failure err)
-      raise (Failure err)
+  | Ok json -> Data_encoding.Json.destruct
-  | Ok json ->
+                 (Data_encoding.list Commitment_repr.encoding) json
-      Data_encoding.Json.destruct
-        (Data_encoding.list Commitment_repr.encoding)
-        json
 
 let make_bootstrap_account (pkh, pk, amount) =
-  Parameters_repr.{public_key_hash = pkh; public_key = Some pk; amount}
+  Parameters_repr.{ public_key_hash = pkh ; public_key = Some pk ; amount }
 
-let parameters_of_constants ?(bootstrap_accounts = bootstrap_accounts)
+let parameters_of_constants
-    ?(bootstrap_contracts = []) ?(with_commitments = false) constants =
+    ?(bootstrap_accounts = bootstrap_accounts)
+    ?(bootstrap_contracts = [])
+    ?(with_commitments = false)
+    constants =
   let commitments = if with_commitments then commitments else [] in
-  Parameters_repr.
+  Parameters_repr.{
-    {
+    bootstrap_accounts ;
-      bootstrap_accounts;
+    bootstrap_contracts ;
-      bootstrap_contracts;
+    commitments ;
-      commitments;
+    constants ;
-      constants;
+    security_deposit_ramp_up_cycles = None ;
-      security_deposit_ramp_up_cycles = None;
+    no_reward_cycles = None ;
-      no_reward_cycles = None;
+  }
-    }
 
 let json_of_parameters parameters =
   Data_encoding.Json.construct Parameters_repr.encoding parameters

vendors/ligo-utils/tezos-protocol-alpha-parameters/default_parameters.mli

@@ -25,21 +25,18 @@
 
 open Protocol
 
-val constants_mainnet : Constants_repr.parametric
+val constants_mainnet: Constants_repr.parametric
+val constants_sandbox: Constants_repr.parametric
+val constants_test: Constants_repr.parametric
 
-val constants_sandbox : Constants_repr.parametric
+val make_bootstrap_account:
-
-val constants_test : Constants_repr.parametric
-
-val make_bootstrap_account :
   Signature.public_key_hash * Signature.public_key * Tez_repr.t ->
   Parameters_repr.bootstrap_account
 
-val parameters_of_constants :
+val parameters_of_constants:
   ?bootstrap_accounts:Parameters_repr.bootstrap_account list ->
   ?bootstrap_contracts:Parameters_repr.bootstrap_contract list ->
   ?with_commitments:bool ->
-  Constants_repr.parametric ->
+  Constants_repr.parametric -> Parameters_repr.t
-  Parameters_repr.t
 
-val json_of_parameters : Parameters_repr.t -> Data_encoding.json
+val json_of_parameters: Parameters_repr.t -> Data_encoding.json

vendors/ligo-utils/tezos-protocol-alpha-parameters/dune

@@ -1,22 +1,22 @@
 (library
- (name tezos_protocol_alpha_parameters)
+ (name tezos_protocol_005_PsBabyM1_parameters)
- (public_name tezos-protocol-alpha-parameters)
+ (public_name tezos-protocol-005-PsBabyM1-parameters)
  (modules :standard \ gen)
  (libraries tezos-base
             tezos-protocol-environment
-            tezos-protocol-alpha)
+            tezos-protocol-005-PsBabyM1)
  (flags (:standard -open Tezos_base__TzPervasives
-                   -open Tezos_protocol_alpha
+                   -open Tezos_protocol_005_PsBabyM1
                    -linkall))
 )
 
 (executable
  (name gen)
  (libraries tezos-base
-            tezos-protocol-alpha-parameters)
+            tezos-protocol-005-PsBabyM1-parameters)
  (modules gen)
  (flags (:standard -open Tezos_base__TzPervasives
-                   -open Tezos_protocol_alpha_parameters
+                   -open Tezos_protocol_005_PsBabyM1_parameters
                    -linkall)))
 
 (rule

vendors/ligo-utils/tezos-protocol-alpha-parameters/gen.ml

@@ -29,19 +29,18 @@
 
 let () =
   let print_usage_and_fail s =
-    Printf.eprintf "Usage: %s [ --sandbox | --test | --mainnet ]" Sys.argv.(0) ;
+    Printf.eprintf "Usage: %s [ --sandbox | --test | --mainnet ]"
+      Sys.argv.(0) ;
     raise (Invalid_argument s)
   in
   let dump parameters file =
-    let str =
+    let str = Data_encoding.Json.to_string
-      Data_encoding.Json.to_string
+        (Default_parameters.json_of_parameters parameters) in
-        (Default_parameters.json_of_parameters parameters)
-    in
     let fd = open_out file in
-    output_string fd str ; close_out fd
+    output_string fd str ;
+    close_out fd
   in
-  if Array.length Sys.argv < 2 then print_usage_and_fail ""
+  if Array.length Sys.argv < 2 then print_usage_and_fail "" else
-  else
     match Sys.argv.(1) with
     | "--sandbox" ->
         dump
@@ -49,13 +48,10 @@ let () =
           "sandbox-parameters.json"
     | "--test" ->
         dump
-          Default_parameters.(
+          Default_parameters.(parameters_of_constants ~with_commitments:true constants_sandbox)
-            parameters_of_constants ~with_commitments:true constants_sandbox)
           "test-parameters.json"
     | "--mainnet" ->
         dump
-          Default_parameters.(
+          Default_parameters.(parameters_of_constants ~with_commitments:true constants_mainnet)
-            parameters_of_constants ~with_commitments:true constants_mainnet)
           "mainnet-parameters.json"
-    | s ->
+    | s -> print_usage_and_fail s
-        print_usage_and_fail s

vendors/ligo-utils/tezos-protocol-alpha-parameters/tezos-protocol-005-PsBabyM1-parameters.opam

@@ -1,5 +1,4 @@
 opam-version: "2.0"
-version: "dev"
 maintainer: "contact@tezos.com"
 authors: [ "Tezos devteam" ]
 homepage: "https://www.tezos.com/"
@@ -12,10 +11,9 @@ depends: [
   "dune" { build & >= "1.7" }
   "tezos-base"
   "tezos-protocol-environment"
-  "tezos-protocol-alpha"
+  "tezos-protocol-005-PsBabyM1"
 ]
 build: [
-  ["dune" "build" "-p" name "-j" jobs]
+  [ "dune" "build" "-p" name "-j" jobs ]
-  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
 ]
 synopsis: "Tezos/Protocol: parameters"

vendors/ligo-utils/tezos-protocol-alpha/TEZOS_PROTOCOL

@@ -1,5 +1,5 @@
 {
-    "hash": "ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK",
+    "hash": "PsBabyM1eUXZseaJdmXFApDSBqj8YBfwELoxZHHW77EMcAbbwAS",
     "modules": [
         "Misc",
         "Storage_description",
@@ -25,6 +25,7 @@
         "Script_timestamp_repr",
         "Michelson_v1_primitives",
         "Script_repr",
+        "Legacy_script_support_repr",
         "Contract_repr",
         "Roll_repr",
         "Vote_repr",

vendors/ligo-utils/tezos-protocol-alpha/alpha_context.ml

@@ -62,9 +62,16 @@ module Script_int = Script_int_repr
 module Script_timestamp = struct
   include Script_timestamp_repr
   let now ctxt =
-    Raw_context.current_timestamp ctxt
+    let { Constants_repr.time_between_blocks ; _ } =
-    |> Timestamp.to_seconds
+      Raw_context.constants ctxt in
-    |> of_int64
+    match time_between_blocks with
+    | [] -> failwith "Internal error: 'time_between_block' constants \
+                      is an empty list."
+    | first_delay :: _ ->
+        let current_timestamp = Raw_context.predecessor_timestamp ctxt in
+        Time.add current_timestamp (Period_repr.to_seconds first_delay)
+        |> Timestamp.to_seconds
+        |> of_int64
 end
 module Script = struct
   include Michelson_v1_primitives
@@ -79,6 +86,7 @@ module Script = struct
       (Script_repr.force_bytes lexpr >>? fun (b, cost) ->
        Raw_context.consume_gas ctxt cost >|? fun ctxt ->
        (b, ctxt))
+  module Legacy_support = Legacy_script_support_repr
 end
 module Fees = Fees_storage
 
@@ -113,13 +121,30 @@ module Contract = struct
   include Contract_repr
   include Contract_storage
 
-  let originate c contract ~balance ~manager ?script ~delegate
+  let originate c contract ~balance ~script ~delegate =
-      ~spendable ~delegatable =
+    originate c contract ~balance ~script ~delegate
-    originate c contract ~balance ~manager ?script ~delegate
-      ~spendable ~delegatable
   let init_origination_nonce = Raw_context.init_origination_nonce
   let unset_origination_nonce = Raw_context.unset_origination_nonce
 end
+module Big_map = struct
+  type id = Z.t
+  let fresh = Storage.Big_map.Next.incr
+  let fresh_temporary = Raw_context.fresh_temporary_big_map
+  let mem c m k = Storage.Big_map.Contents.mem (c, m) k
+  let get_opt c m k = Storage.Big_map.Contents.get_option (c, m) k
+  let rpc_arg = Storage.Big_map.rpc_arg
+  let cleanup_temporary c =
+    Raw_context.temporary_big_maps c Storage.Big_map.remove_rec c >>= fun c ->
+    Lwt.return (Raw_context.reset_temporary_big_map c)
+  let exists c id =
+    Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero)) >>=? fun c ->
+    Storage.Big_map.Key_type.get_option c id >>=? fun kt ->
+    match kt with
+    | None -> return (c, None)
+    | Some kt ->
+        Storage.Big_map.Value_type.get c id >>=? fun kv ->
+        return (c, Some (kt, kv))
+end
 module Delegate = Delegate_storage
 module Roll = struct
   include Roll_repr
@@ -148,8 +173,8 @@ module Commitment = struct
 end
 
 module Global = struct
-  let get_last_block_priority = Storage.Last_block_priority.get
+  let get_block_priority = Storage.Block_priority.get
-  let set_last_block_priority = Storage.Last_block_priority.set
+  let set_block_priority = Storage.Block_priority.set
 end
 
 let prepare_first_block = Init_storage.prepare_first_block
@@ -169,6 +194,7 @@ let fork_test_chain = Raw_context.fork_test_chain
 let record_endorsement = Raw_context.record_endorsement
 let allowed_endorsements = Raw_context.allowed_endorsements
 let init_endorsements = Raw_context.init_endorsements
+let included_endorsements = Raw_context.included_endorsements
 
 let reset_internal_nonce = Raw_context.reset_internal_nonce
 let fresh_internal_nonce = Raw_context.fresh_internal_nonce

vendors/ligo-utils/tezos-protocol-alpha/alpha_context.mli

@@ -65,11 +65,13 @@ module Period : sig
 
   include BASIC_DATA
   type period = t
+  val rpc_arg: period RPC_arg.arg
 
   val of_seconds: int64 -> period tzresult
   val to_seconds: period -> int64
   val mult: int32 -> period -> period tzresult
 
+  val zero: period
   val one_second: period
   val one_minute: period
   val one_hour: period
@@ -81,6 +83,7 @@ module Timestamp : sig
   include BASIC_DATA with type t = Time.t
   type time = t
   val (+?) : time -> Period.t -> time tzresult
+  val (-?) : time -> time -> Period.t tzresult
 
   val of_notation: string -> time option
   val to_notation: time -> string
@@ -143,6 +146,7 @@ module Gas : sig
   type error += Gas_limit_too_high (* `Permanent *)
 
   val free : cost
+  val atomic_step_cost : int -> cost
   val step_cost : int -> cost
   val alloc_cost : int -> cost
   val alloc_bytes_cost : int -> cost
@@ -209,6 +213,7 @@ module Script : sig
     | I_BALANCE
     | I_CAR
     | I_CDR
+    | I_CHAIN_ID
     | I_CHECK_SIGNATURE
     | I_COMPARE
     | I_CONCAT
@@ -220,10 +225,12 @@ module Script : sig
     | I_DROP
     | I_DUP
     | I_EDIV
+    | I_EMPTY_BIG_MAP
     | I_EMPTY_MAP
     | I_EMPTY_SET
     | I_EQ
     | I_EXEC
+    | I_APPLY
     | I_FAILWITH
     | I_GE
     | I_GET
@@ -275,6 +282,8 @@ module Script : sig
     | I_ISNAT
     | I_CAST
     | I_RENAME
+    | I_DIG
+    | I_DUG
     | T_bool
     | T_contract
     | T_int
@@ -297,6 +306,8 @@ module Script : sig
     | T_unit
     | T_operation
     | T_address
+    | T_chain_id
+
 
   type location = Micheline.canonical_location
 
@@ -336,6 +347,27 @@ module Script : sig
   val minimal_deserialize_cost : lazy_expr -> Gas.cost
   val force_decode : context -> lazy_expr -> (expr * context) tzresult Lwt.t
   val force_bytes : context -> lazy_expr -> (MBytes.t * context) tzresult Lwt.t
+
+  val unit_parameter : lazy_expr
+
+  module Legacy_support : sig
+    val manager_script_code: lazy_expr
+    val add_do:
+      manager_pkh: Signature.Public_key_hash.t ->
+      script_code: lazy_expr ->
+      script_storage: lazy_expr ->
+      (lazy_expr * lazy_expr) tzresult Lwt.t
+    val add_set_delegate:
+      manager_pkh: Signature.Public_key_hash.t ->
+      script_code: lazy_expr ->
+      script_storage: lazy_expr ->
+      (lazy_expr * lazy_expr) tzresult Lwt.t
+    val has_default_entrypoint: lazy_expr -> bool
+    val add_root_entrypoint:
+      script_code: lazy_expr ->
+      lazy_expr tzresult Lwt.t
+  end
+
 end
 
 module Constants : sig
@@ -380,6 +412,11 @@ module Constants : sig
     cost_per_byte: Tez.t ;
     hard_storage_limit_per_operation: Z.t ;
     test_chain_duration: int64;
+    quorum_min: int32 ;
+    quorum_max: int32 ;
+    min_proposal_quorum : int32 ;
+    initial_endorsers: int ;
+    delay_per_missing_endorsement : Period.t ;
   }
   val parametric_encoding: parametric Data_encoding.t
   val parametric: context -> parametric
@@ -390,6 +427,8 @@ module Constants : sig
   val blocks_per_voting_period: context -> int32
   val time_between_blocks: context -> Period.t list
   val endorsers_per_block: context -> int
+  val initial_endorsers: context -> int
+  val delay_per_missing_endorsement: context -> Period.t
   val hard_gas_limit_per_operation: context -> Z.t
   val hard_gas_limit_per_block: context -> Z.t
   val cost_per_byte: context -> Tez.t
@@ -404,6 +443,9 @@ module Constants : sig
   val block_security_deposit: context -> Tez.t
   val endorsement_security_deposit: context -> Tez.t
   val test_chain_duration: context -> int64
+  val quorum_min: context -> int32
+  val quorum_max: context -> int32
+  val min_proposal_quorum: context -> int32
 
   (** All constants: fixed and parametric *)
   type t = {
@@ -531,6 +573,17 @@ module Seed : sig
 
 end
 
+module Big_map: sig
+  type id = Z.t
+  val fresh : context -> (context * id) tzresult Lwt.t
+  val fresh_temporary : context -> context * id
+  val mem : context -> id -> Script_expr_hash.t -> (context * bool) tzresult Lwt.t
+  val get_opt : context -> id -> Script_expr_hash.t -> (context * Script.expr option) tzresult Lwt.t
+  val rpc_arg : id RPC_arg.t
+  val cleanup_temporary : context -> context Lwt.t
+  val exists : context -> id -> (context * (Script.expr * Script.expr) option) tzresult Lwt.t
+end
+
 module Contract : sig
 
   include BASIC_DATA
@@ -551,27 +604,22 @@ module Contract : sig
 
   val list: context -> contract list Lwt.t
 
-  val get_manager:
-    context -> contract -> public_key_hash tzresult Lwt.t
-
   val get_manager_key:
-    context -> contract -> public_key tzresult Lwt.t
+    context -> public_key_hash -> public_key tzresult Lwt.t
   val is_manager_key_revealed:
-    context -> contract -> bool tzresult Lwt.t
+    context -> public_key_hash -> bool tzresult Lwt.t
 
   val reveal_manager_key:
-    context -> contract -> public_key -> context tzresult Lwt.t
+    context -> public_key_hash -> public_key -> context tzresult Lwt.t
 
-  val is_delegatable:
+  val get_script_code:
-    context -> contract -> bool tzresult Lwt.t
+    context -> contract -> (context * Script.lazy_expr option) tzresult Lwt.t
-  val is_spendable:
-    context -> contract -> bool tzresult Lwt.t
   val get_script:
     context -> contract -> (context * Script.t option) tzresult Lwt.t
   val get_storage:
     context -> contract -> (context * Script.expr option) tzresult Lwt.t
 
-  val get_counter: context -> contract -> Z.t tzresult Lwt.t
+  val get_counter: context -> public_key_hash -> Z.t tzresult Lwt.t
   val get_balance:
     context -> contract -> Tez.t tzresult Lwt.t
 
@@ -580,29 +628,34 @@ module Contract : sig
   val fresh_contract_from_current_nonce : context -> (context * t) tzresult Lwt.t
   val originated_from_current_nonce: since: context -> until:context -> contract list tzresult Lwt.t
 
-  type big_map_diff_item = {
+  type big_map_diff_item =
-    diff_key : Script_repr.expr;
+  | Update of {
-    diff_key_hash : Script_expr_hash.t;
+      big_map : Big_map.id ;
-    diff_value : Script_repr.expr option;
+      diff_key : Script.expr;
-  }
+      diff_key_hash : Script_expr_hash.t;
+      diff_value : Script.expr option;
+    }
+  | Clear of Big_map.id
+  | Copy of Big_map.id * Big_map.id
+  | Alloc of {
+      big_map : Big_map.id;
+      key_type : Script.expr;
+      value_type : Script.expr;
+    }
   type big_map_diff = big_map_diff_item list
   val big_map_diff_encoding : big_map_diff Data_encoding.t
 
   val originate:
     context -> contract ->
     balance: Tez.t ->
-    manager: public_key_hash ->
+    script: (Script.t * big_map_diff option) ->
-    ?script: (Script.t * big_map_diff option) ->
     delegate: public_key_hash option ->
-    spendable: bool ->
+    context tzresult Lwt.t
-    delegatable: bool -> context tzresult Lwt.t
 
   type error += Balance_too_low of contract * Tez.t * Tez.t
 
   val spend:
     context -> contract -> Tez.t -> context tzresult Lwt.t
-  val spend_from_script:
-    context -> contract -> Tez.t -> context tzresult Lwt.t
 
   val credit:
     context -> contract -> Tez.t -> context tzresult Lwt.t
@@ -615,17 +668,10 @@ module Contract : sig
   val used_storage_space: context -> t -> Z.t tzresult Lwt.t
 
   val increment_counter:
-    context -> contract -> context tzresult Lwt.t
+    context -> public_key_hash -> context tzresult Lwt.t
 
   val check_counter_increment:
-    context -> contract -> Z.t -> unit tzresult Lwt.t
+    context -> public_key_hash -> Z.t -> unit tzresult Lwt.t
-
-  module Big_map : sig
-    val mem:
-      context -> contract -> Script_expr_hash.t -> (context * bool) tzresult Lwt.t
-    val get_opt:
-      context -> contract -> Script_expr_hash.t -> (context * Script_repr.expr option) tzresult Lwt.t
-  end
 
   (**/**)
   (* Only for testing *)
@@ -658,9 +704,6 @@ module Delegate : sig
   val set:
     context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t
 
-  val set_from_script:
-    context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t
-
   val fold:
     context ->
     init:'a -> f:(public_key_hash -> 'a -> 'a Lwt.t) -> 'a Lwt.t
@@ -713,7 +756,7 @@ module Delegate : sig
 
   val delegated_contracts:
     context -> Signature.Public_key_hash.t ->
-    Contract_hash.t list Lwt.t
+    Contract_repr.t list Lwt.t
 
   val delegated_balance:
     context -> Signature.Public_key_hash.t ->
@@ -775,7 +818,9 @@ module Vote : sig
     context -> Voting_period.kind -> context tzresult Lwt.t
 
   val get_current_quorum: context -> int32 tzresult Lwt.t
-  val set_current_quorum: context -> int32 -> context tzresult Lwt.t
+
+  val get_participation_ema: context -> int32 tzresult Lwt.t
+  val set_participation_ema: context -> int32 -> context tzresult Lwt.t
 
   val get_current_proposal:
     context -> proposal tzresult Lwt.t
@@ -892,7 +937,7 @@ and _ contents =
       ballot: Vote.ballot ;
     } -> Kind.ballot contents
   | Manager_operation : {
-      source: Contract.contract ;
+      source: Signature.Public_key_hash.t ;
       fee: Tez.tez ;
       counter: counter ;
       operation: 'kind manager_operation ;
@@ -904,15 +949,13 @@ and _ manager_operation =
   | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
   | Transaction : {
       amount: Tez.tez ;
-      parameters: Script.lazy_expr option ;
+      parameters: Script.lazy_expr ;
+      entrypoint: string ;
       destination: Contract.contract ;
     } -> Kind.transaction manager_operation
   | Origination : {
-      manager: Signature.Public_key_hash.t ;
       delegate: Signature.Public_key_hash.t option ;
-      script: Script.t option ;
+      script: Script.t ;
-      spendable: bool ;
-      delegatable: bool ;
       credit: Tez.tez ;
       preorigination: Contract.t option ;
     } -> Kind.origination manager_operation
@@ -1111,8 +1154,8 @@ end
 
 module Global : sig
 
-  val get_last_block_priority: context -> int tzresult Lwt.t
+  val get_block_priority: context -> int tzresult Lwt.t
-  val set_last_block_priority: context -> int -> context tzresult Lwt.t
+  val set_block_priority: context -> int -> context tzresult Lwt.t
 
 end
 
@@ -1128,6 +1171,7 @@ val prepare_first_block:
 val prepare:
   Context.t ->
   level:Int32.t ->
+  predecessor_timestamp:Time.t ->
   timestamp:Time.t ->
   fitness:Fitness.t ->
   context tzresult Lwt.t
@@ -1146,6 +1190,8 @@ val init_endorsements:
   context ->
   (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ->
   context
+val included_endorsements:
+  context -> int
 
 val reset_internal_nonce: context -> context
 val fresh_internal_nonce: context -> (context * int) tzresult

vendors/ligo-utils/tezos-protocol-alpha/amendment.ml

@@ -26,34 +26,46 @@
 open Alpha_context
 
 (** Returns the proposal submitted by the most delegates.
-    Returns None in case of a tie or if there are no proposals. *)
+    Returns None in case of a tie, if proposal quorum is below required
-let select_winning_proposal proposals =
+    minimum or if there are no proposals. *)
+let select_winning_proposal ctxt =
+  Vote.get_proposals ctxt >>=? fun proposals ->
   let merge proposal vote winners =
     match winners with
     | None -> Some ([proposal], vote)
     | Some (winners, winners_vote) as previous ->
         if Compare.Int32.(vote = winners_vote) then
           Some (proposal :: winners, winners_vote)
-        else if Compare.Int32.(vote >= winners_vote) then
+        else if Compare.Int32.(vote > winners_vote) then
           Some ([proposal], vote)
         else
           previous in
   match Protocol_hash.Map.fold merge proposals None with
-  | None -> None
+  | Some ([proposal], vote) ->
-  | Some ([proposal], _) -> Some proposal
+      Vote.listing_size ctxt >>=? fun max_vote ->
-  | Some _ -> None (* in case of a tie, lets do nothing. *)
+      let min_proposal_quorum = Constants.min_proposal_quorum ctxt in
+      let min_vote_to_pass =
+        Int32.div (Int32.mul min_proposal_quorum max_vote) 100_00l in
+      if Compare.Int32.(vote >= min_vote_to_pass) then
+        return_some proposal
+      else
+        return_none
+  | _ ->
+      return_none (* in case of a tie, let's do nothing. *)
 
 (** A proposal is approved if it has supermajority and the participation reaches
     the current quorum.
     Supermajority means the yays are more 8/10 of casted votes.
     The participation is the ratio of all received votes, including passes, with
-    respect to the number of possible votes. The quorum starts at 80% and at
+    respect to the number of possible votes.
-    each vote is updated using the last expected quorum and the current
+    The participation EMA (exponential moving average) uses the last
-    participation with the following weights:
+    participation EMA and the current participation./
-    newQ = oldQ * 8/10 + participation * 2/10 *)
+    The expected quorum is calculated using the last participation EMA, capped
-let check_approval_and_update_quorum ctxt =
+    by the min/max quorum protocol constants. *)
+let check_approval_and_update_participation_ema ctxt =
   Vote.get_ballots ctxt >>=? fun ballots ->
   Vote.listing_size ctxt >>=? fun maximum_vote ->
+  Vote.get_participation_ema ctxt >>=? fun participation_ema ->
   Vote.get_current_quorum ctxt >>=? fun expected_quorum ->
   (* Note overflows: considering a maximum of 8e8 tokens, with roll size as
      small as 1e3, there is a maximum of 8e5 rolls and thus votes.
@@ -64,15 +76,18 @@ let check_approval_and_update_quorum ctxt =
   let all_votes = Int32.add casted_votes ballots.pass in
   let supermajority = Int32.div (Int32.mul 8l casted_votes) 10l in
   let participation = (* in centile of percentage *)
-    Int64.to_int32
+    Int64.(to_int32
-      (Int64.div
+             (div
-         (Int64.mul (Int64.of_int32 all_votes) 100_00L)
+                (mul (of_int32 all_votes) 100_00L)
-         (Int64.of_int32 maximum_vote)) in
+                (of_int32 maximum_vote))) in
   let outcome = Compare.Int32.(participation >= expected_quorum &&
                                ballots.yay >= supermajority) in
-  let updated_quorum =
+  let new_participation_ema =
-    Int32.div (Int32.add (Int32.mul 8l expected_quorum) (Int32.mul 2l participation)) 10l in
+    Int32.(div (add
-  Vote.set_current_quorum ctxt updated_quorum >>=? fun ctxt ->
+                  (mul 8l participation_ema)
+                  (mul 2l participation))
+             10l) in
+  Vote.set_participation_ema ctxt new_participation_ema >>=? fun ctxt ->
   return (ctxt, outcome)
 
 (** Implements the state machine of the amendment procedure.
@@ -82,10 +97,10 @@ let check_approval_and_update_quorum ctxt =
 let start_new_voting_period ctxt =
   Vote.get_current_period_kind ctxt >>=? function
   | Proposal -> begin
-      Vote.get_proposals ctxt >>=? fun proposals ->
+      select_winning_proposal ctxt >>=? fun proposal ->
       Vote.clear_proposals ctxt >>= fun ctxt ->
       Vote.clear_listings ctxt >>=? fun ctxt ->
-      match select_winning_proposal proposals with
+      match proposal with
       | None ->
           Vote.freeze_listings ctxt >>=? fun ctxt ->
           return ctxt
@@ -96,7 +111,7 @@ let start_new_voting_period ctxt =
           return ctxt
     end
   | Testing_vote ->
-      check_approval_and_update_quorum ctxt >>=? fun (ctxt, approved) ->
+      check_approval_and_update_participation_ema ctxt >>=? fun (ctxt, approved) ->
       Vote.clear_ballots ctxt >>= fun ctxt ->
       Vote.clear_listings ctxt >>=? fun ctxt ->
       if approved then
@@ -116,7 +131,7 @@ let start_new_voting_period ctxt =
       Vote.set_current_period_kind ctxt Promotion_vote >>=? fun ctxt ->
       return ctxt
   | Promotion_vote ->
-      check_approval_and_update_quorum ctxt >>=? fun (ctxt, approved) ->
+      check_approval_and_update_participation_ema ctxt >>=? fun (ctxt, approved) ->
       begin
         if approved then
           Vote.get_current_proposal ctxt >>=? fun proposal ->

vendors/ligo-utils/tezos-protocol-alpha/apply.ml

@@ -33,8 +33,6 @@ type error += Duplicate_endorsement of Signature.Public_key_hash.t (* `Branch *)
 type error += Invalid_endorsement_level
 type error += Invalid_commitment of { expected: bool }
 type error += Internal_operation_replay of packed_internal_operation
-type error += Cannot_originate_spendable_smart_contract (* `Permanent *)
-type error += Cannot_originate_non_spendable_account (* `Permanent *)
 
 type error += Invalid_double_endorsement_evidence (* `Permanent *)
 type error += Inconsistent_double_endorsement_evidence
@@ -60,6 +58,12 @@ type error += Outdated_double_baking_evidence
 type error += Invalid_activation of { pkh : Ed25519.Public_key_hash.t }
 type error += Multiple_revelation
 type error += Gas_quota_exceeded_init_deserialize (* Permanent *)
+type error +=
+    Not_enough_endorsements_for_priority of
+      { required : int ;
+        priority : int ;
+        endorsements : int ;
+        timestamp: Time.t }
 
 let () =
   register_error_kind
@@ -135,30 +139,6 @@ let () =
     Operation.internal_operation_encoding
     (function Internal_operation_replay op -> Some op | _ -> None)
     (fun op -> Internal_operation_replay op) ;
-  register_error_kind
-    `Permanent
-    ~id:"cannot_originate_non_spendable_account"
-    ~title:"Cannot originate non spendable account"
-    ~description:"An origination was attempted \
-                  that would create a non spendable, non scripted contract"
-    ~pp:(fun ppf () ->
-        Format.fprintf ppf "It is not possible anymore to originate \
-                            a non scripted contract that is not spendable.")
-    Data_encoding.empty
-    (function Cannot_originate_non_spendable_account -> Some () | _ -> None)
-    (fun () -> Cannot_originate_non_spendable_account) ;
-  register_error_kind
-    `Permanent
-    ~id:"cannot_originate_spendable_smart_contract"
-    ~title:"Cannot originate spendable smart contract"
-    ~description:"An origination was attempted \
-                  that would create a spendable scripted contract"
-    ~pp:(fun ppf () ->
-        Format.fprintf ppf "It is not possible anymore to originate \
-                            a scripted contract that is spendable.")
-    Data_encoding.empty
-    (function Cannot_originate_spendable_smart_contract -> Some () | _ -> None)
-    (fun () -> Cannot_originate_spendable_smart_contract) ;
   register_error_kind
     `Permanent
     ~id:"block.invalid_double_endorsement_evidence"
@@ -372,34 +352,49 @@ let () =
                   parse within the provided gas bounds."
     Data_encoding.empty
     (function Gas_quota_exceeded_init_deserialize -> Some () | _ -> None)
-    (fun () -> Gas_quota_exceeded_init_deserialize)
+    (fun () -> Gas_quota_exceeded_init_deserialize) ;
+  register_error_kind
+    `Permanent
+    ~id:"operation.not_enought_endorsements_for_priority"
+    ~title:"Not enough endorsements for priority"
+    ~description:"The block being validated does not include the \
+                  required minimum number of endorsements for this priority."
+    ~pp:(fun ppf (required, endorsements, priority, timestamp) ->
+        Format.fprintf ppf "Wrong number of endorsements (%i) for \
+                            priority (%i), %i are expected at %a"
+          endorsements priority required Time.pp_hum timestamp)
+    Data_encoding.(obj4
+                     (req "required" int31)
+                     (req "endorsements" int31)
+                     (req "priority" int31)
+                     (req "timestamp" Time.encoding))
+    (function Not_enough_endorsements_for_priority
+        { required ; endorsements ; priority ; timestamp } ->
+        Some (required, endorsements, priority, timestamp) | _ -> None)
+    (fun (required, endorsements, priority, timestamp) ->
+       Not_enough_endorsements_for_priority
+         { required ; endorsements ; priority ; timestamp })
 
 open Apply_results
 
 let apply_manager_operation_content :
   type kind.
   ( Alpha_context.t -> Script_ir_translator.unparsing_mode -> payer:Contract.t -> source:Contract.t ->
-    internal:bool -> kind manager_operation ->
+    chain_id:Chain_id.t -> internal:bool -> kind manager_operation ->
     (context * kind successful_manager_operation_result * packed_internal_operation list) tzresult Lwt.t ) =
-  fun ctxt mode ~payer ~source ~internal operation ->
+  fun ctxt mode ~payer ~source ~chain_id ~internal operation ->
     let before_operation =
       (* This context is not used for backtracking. Only to compute
          gas consumption and originations for the operation result. *)
       ctxt in
     Contract.must_exist ctxt source >>=? fun () ->
-    let spend =
-      (* Ignore the spendable flag for smart contracts. *)
-      if internal then Contract.spend_from_script else Contract.spend in
-    let set_delegate =
-      (* Ignore the delegatable flag for smart contracts. *)
-      if internal then Delegate.set_from_script else Delegate.set in
     Lwt.return (Gas.consume ctxt Michelson_v1_gas.Cost_of.manager_operation) >>=? fun ctxt ->
     match operation with
     | Reveal _ ->
         return (* No-op: action already performed by `precheck_manager_contents`. *)
           (ctxt, (Reveal_result { consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt } : kind successful_manager_operation_result), [])
-    | Transaction { amount ; parameters ; destination } -> begin
+    | Transaction { amount ; parameters ; destination ; entrypoint  } -> begin
-        spend ctxt source amount >>=? fun ctxt ->
+        Contract.spend ctxt source amount >>=? fun ctxt ->
         begin match Contract.is_implicit destination with
           | None -> return (ctxt, [], false)
           | Some _ ->
@@ -413,20 +408,21 @@ let apply_manager_operation_content :
         Contract.get_script ctxt destination >>=? fun (ctxt, script) ->
         match script with
         | None -> begin
-            match parameters with
+            begin match entrypoint with
-            | None -> return ctxt
+              | "default" -> return ()
-            | Some arg ->
+              | entrypoint -> fail (Script_tc_errors.No_such_entrypoint entrypoint)
-                Script.force_decode ctxt arg >>=? fun (arg, ctxt) -> (* see [note] *)
+            end >>=? fun () ->
-                (* [note]: for toplevel ops, cost is nil since the
+            Script.force_decode ctxt parameters >>=? fun (arg, ctxt) -> (* see [note] *)
-                   lazy value has already been forced at precheck, so
+            (* [note]: for toplevel ops, cost is nil since the
-                   we compute and consume the full cost again *)
+               lazy value has already been forced at precheck, so
-                let cost_arg = Script.deserialized_cost arg in
+               we compute and consume the full cost again *)
-                Lwt.return (Gas.consume ctxt cost_arg) >>=? fun ctxt ->
+            let cost_arg = Script.deserialized_cost arg in
-                match Micheline.root arg with
+            Lwt.return (Gas.consume ctxt cost_arg) >>=? fun ctxt ->
-                | Prim (_, D_Unit, [], _) ->
+            match Micheline.root arg with
-                    (* Allow [Unit] parameter to non-scripted contracts. *)
+            | Prim (_, D_Unit, [], _) ->
-                    return ctxt
+                (* Allow [Unit] parameter to non-scripted contracts. *)
-                | _ -> fail (Script_interpreter.Bad_contract_parameter destination)
+                return ctxt
+            | _ -> fail (Script_interpreter.Bad_contract_parameter destination)
           end >>=? fun ctxt ->
             let result =
               Transaction_result
@@ -445,20 +441,18 @@ let apply_manager_operation_content :
                 } in
             return (ctxt, result, [])
         | Some script ->
-            begin match parameters with
+            Script.force_decode ctxt parameters >>=? fun (parameter, ctxt) -> (* see [note] *)
-              | None ->
+            let cost_parameter = Script.deserialized_cost parameter in
-                  (* Forge a [Unit] parameter that will be checked by [execute]. *)
+            Lwt.return (Gas.consume ctxt cost_parameter) >>=? fun ctxt ->
-                  let unit = Micheline.strip_locations (Prim (0, Script.D_Unit, [], [])) in
+            let step_constants =
-                  return (ctxt, unit)
+              let open Script_interpreter in
-              | Some parameters ->
+              { source ;
-                  Script.force_decode ctxt parameters >>=? fun (arg, ctxt) -> (* see [note] *)
+                payer ;
-                  let cost_arg = Script.deserialized_cost arg in
+                self = destination ;
-                  Lwt.return (Gas.consume ctxt cost_arg) >>=? fun ctxt ->
+                amount ;
-                  return (ctxt, arg)
+                chain_id } in
-            end >>=? fun (ctxt, parameter) ->
             Script_interpreter.execute
-              ctxt mode
+              ctxt mode step_constants ~script ~parameter ~entrypoint
-              ~source ~payer ~self:(destination, script) ~amount ~parameter
             >>=? fun { ctxt ; storage ; big_map_diff ; operations } ->
             Contract.update_script_storage
               ctxt destination storage big_map_diff >>=? fun ctxt ->
@@ -483,27 +477,20 @@ let apply_manager_operation_content :
                   allocated_destination_contract } in
             return (ctxt, result, operations)
       end
-    | Origination { manager ; delegate ; script ; preorigination ;
+    | Origination { delegate ; script ; preorigination ; credit } ->
-                    spendable ; delegatable ; credit } ->
+        Script.force_decode ctxt script.storage >>=? fun (unparsed_storage, ctxt) -> (* see [note] *)
-        begin match script with
+        Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_storage)) >>=? fun ctxt ->
-          | None ->
+        Script.force_decode ctxt script.code >>=? fun (unparsed_code, ctxt) -> (* see [note] *)
-              if spendable then
+        Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_code)) >>=? fun ctxt ->
-                return (None, ctxt)
+        Script_ir_translator.parse_script ctxt ~legacy:false script >>=? fun (Ex_script parsed_script, ctxt) ->
-              else
+        Script_ir_translator.collect_big_maps ctxt parsed_script.storage_type parsed_script.storage >>=? fun (to_duplicate, ctxt) ->
-                fail Cannot_originate_non_spendable_account
+        let to_update = Script_ir_translator.no_big_map_id in
-          | Some script ->
+        Script_ir_translator.extract_big_map_diff ctxt Optimized parsed_script.storage_type parsed_script.storage
-              if spendable then
+          ~to_duplicate ~to_update ~temporary:false >>=? fun (storage, big_map_diff, ctxt) ->
-                fail Cannot_originate_spendable_smart_contract
+        Script_ir_translator.unparse_data ctxt Optimized parsed_script.storage_type storage >>=? fun (storage, ctxt) ->
-              else
+        let storage = Script.lazy_expr (Micheline.strip_locations storage) in
-                Script.force_decode ctxt script.storage >>=? fun (unparsed_storage, ctxt) -> (* see [note] *)
+        let script = { script with storage } in
-                Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_storage)) >>=? fun ctxt ->
+        Contract.spend ctxt source credit >>=? fun ctxt ->
-                Script.force_decode ctxt script.code >>=? fun (unparsed_code, ctxt) -> (* see [note] *)
-                Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_code)) >>=? fun ctxt ->
-                Script_ir_translator.parse_script ctxt script >>=? fun (ex_script, ctxt) ->
-                Script_ir_translator.big_map_initialization ctxt Optimized ex_script >>=? fun (big_map_diff, ctxt) ->
-                return (Some (script, big_map_diff), ctxt)
-        end >>=? fun (script, ctxt) ->
-        spend ctxt source credit >>=? fun ctxt ->
         begin match preorigination with
           | Some contract ->
               assert internal ;
@@ -515,14 +502,14 @@ let apply_manager_operation_content :
               Contract.fresh_contract_from_current_nonce ctxt
         end >>=? fun (ctxt, contract) ->
         Contract.originate ctxt contract
-          ~manager ~delegate ~balance:credit
+          ~delegate ~balance:credit
-          ?script
+          ~script:(script, big_map_diff) >>=? fun ctxt ->
-          ~spendable ~delegatable >>=? fun ctxt ->
         Fees.origination_burn ctxt >>=? fun (ctxt, origination_burn) ->
         Fees.record_paid_storage_space ctxt contract >>=? fun (ctxt, size, paid_storage_size_diff, fees) ->
         let result =
           Origination_result
-            { balance_updates =
+            { big_map_diff ;
+              balance_updates =
                 Delegate.cleanup_balance_updates
                   [ Contract payer, Debited fees ;
                     Contract payer, Debited origination_burn ;
@@ -534,10 +521,10 @@ let apply_manager_operation_content :
               paid_storage_size_diff } in
         return (ctxt, result, [])
     | Delegation delegate ->
-        set_delegate ctxt source delegate >>=? fun ctxt ->
+        Delegate.set ctxt source delegate >>=? fun ctxt ->
         return (ctxt, Delegation_result { consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt }, [])
 
-let apply_internal_manager_operations ctxt mode ~payer ops =
+let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops =
   let rec apply ctxt applied worklist =
     match worklist with
     | [] -> Lwt.return (`Success ctxt, List.rev applied)
@@ -549,7 +536,7 @@ let apply_internal_manager_operations ctxt mode ~payer ops =
           else
             let ctxt = record_internal_nonce ctxt nonce in
             apply_manager_operation_content
-              ctxt mode ~source ~payer ~internal:true operation
+              ctxt mode ~source ~payer ~chain_id ~internal:true operation
         end >>= function
         | Error errors ->
             let result =
@@ -573,20 +560,20 @@ let precheck_manager_contents
   Lwt.return (Gas.check_limit ctxt gas_limit) >>=? fun () ->
   let ctxt = Gas.set_limit ctxt gas_limit in
   Lwt.return (Fees.check_storage_limit ctxt storage_limit) >>=? fun () ->
-  Contract.must_be_allocated ctxt source >>=? fun () ->
+  Contract.must_be_allocated ctxt (Contract.implicit_contract source) >>=? fun () ->
   Contract.check_counter_increment ctxt source counter >>=? fun () ->
   begin
     match operation with
     | Reveal pk ->
         Contract.reveal_manager_key ctxt source pk
-    | Transaction { parameters = Some arg ; _ } ->
+    | Transaction { parameters ; _ } ->
         (* Fail quickly if not enough gas for minimal deserialization cost *)
         Lwt.return @@ record_trace Gas_quota_exceeded_init_deserialize @@
-        Gas.check_enough ctxt (Script.minimal_deserialize_cost arg) >>=? fun () ->
+        Gas.check_enough ctxt (Script.minimal_deserialize_cost parameters) >>=? fun () ->
         (* Fail if not enough gas for complete deserialization cost *)
         trace Gas_quota_exceeded_init_deserialize @@
-        Script.force_decode ctxt arg >>|? fun (_arg, ctxt) -> ctxt
+        Script.force_decode ctxt parameters >>|? fun (_arg, ctxt) -> ctxt
-    | Origination { script = Some script ; _ } ->
+    | Origination { script ; _ } ->
         (* Fail quickly if not enough gas for minimal deserialization cost *)
         Lwt.return @@ record_trace Gas_quota_exceeded_init_deserialize @@
         (Gas.consume ctxt (Script.minimal_deserialize_cost script.code) >>? fun ctxt ->
@@ -606,12 +593,12 @@ let precheck_manager_contents
      sequence of transactions.  *)
   Operation.check_signature public_key chain_id raw_operation >>=? fun () ->
   Contract.increment_counter ctxt source >>=? fun ctxt ->
-  Contract.spend ctxt source fee >>=? fun ctxt ->
+  Contract.spend ctxt (Contract.implicit_contract source) fee >>=? fun ctxt ->
   add_fees ctxt fee >>=? fun ctxt ->
   return ctxt
 
 let apply_manager_contents
-    (type kind) ctxt mode (op : kind Kind.manager contents)
+    (type kind) ctxt mode chain_id (op : kind Kind.manager contents)
   : ([ `Success of context | `Failure ] *
      kind manager_operation_result *
      packed_internal_operation_result list) Lwt.t =
@@ -619,11 +606,12 @@ let apply_manager_contents
       { source ; operation ; gas_limit ; storage_limit } = op in
   let ctxt = Gas.set_limit ctxt gas_limit in
   let ctxt = Fees.start_counting_storage_fees ctxt in
+  let source = Contract.implicit_contract source in
   apply_manager_operation_content ctxt mode
-    ~source ~payer:source ~internal:false operation >>= function
+    ~source ~payer:source ~internal:false ~chain_id operation >>= function
   | Ok (ctxt, operation_results, internal_operations) -> begin
       apply_internal_manager_operations
-        ctxt mode ~payer:source internal_operations >>= function
+        ctxt mode ~payer:source ~chain_id internal_operations >>= function
       | (`Success ctxt, internal_operations_results) -> begin
           Fees.burn_storage_fees ctxt ~storage_limit ~payer:source >>= function
           | Ok ctxt ->
@@ -654,6 +642,7 @@ let rec mark_skipped
     baker : Signature.Public_key_hash.t -> Level.t -> kind Kind.manager contents_list ->
   kind Kind.manager contents_result_list = fun ~baker level -> function
   | Single (Manager_operation { source ; fee ; operation } ) ->
+      let source = Contract.implicit_contract source in
       Single_result
         (Manager_operation_result
            { balance_updates =
@@ -663,6 +652,7 @@ let rec mark_skipped
              operation_result = skipped_operation_result operation ;
              internal_operation_results = [] })
   | Cons (Manager_operation { source ; fee ; operation } , rest) ->
+      let source = Contract.implicit_contract source in
       Cons_result
         (Manager_operation_result {
             balance_updates =
@@ -688,14 +678,15 @@ let rec precheck_manager_contents_list
 let rec apply_manager_contents_list_rec
   : type kind.
     Alpha_context.t -> Script_ir_translator.unparsing_mode ->
-    public_key_hash -> kind Kind.manager contents_list ->
+    public_key_hash -> Chain_id.t -> kind Kind.manager contents_list ->
     ([ `Success of context | `Failure ] *
      kind Kind.manager contents_result_list) Lwt.t =
-  fun ctxt mode baker contents_list ->
+  fun ctxt mode baker chain_id contents_list ->
     let level = Level.current ctxt in
     match contents_list with
     | Single (Manager_operation { source ; fee ; _ } as op) -> begin
-        apply_manager_contents ctxt mode op
+        let source = Contract.implicit_contract source in
+        apply_manager_contents ctxt mode chain_id op
         >>= fun (ctxt_result, operation_result, internal_operation_results) ->
         let result =
           Manager_operation_result {
@@ -709,7 +700,8 @@ let rec apply_manager_contents_list_rec
         Lwt.return (ctxt_result, Single_result (result))
       end
     | Cons (Manager_operation { source ; fee ; _ } as op, rest) ->
-        apply_manager_contents ctxt mode op >>= function
+        let source = Contract.implicit_contract source in
+        apply_manager_contents ctxt mode chain_id op >>= function
         | (`Failure, operation_result, internal_operation_results) ->
             let result =
               Manager_operation_result {
@@ -731,7 +723,7 @@ let rec apply_manager_contents_list_rec
                 operation_result ;
                 internal_operation_results ;
               } in
-            apply_manager_contents_list_rec ctxt mode baker rest >>= fun (ctxt_result, results) ->
+            apply_manager_contents_list_rec ctxt mode baker chain_id rest >>= fun (ctxt_result, results) ->
             Lwt.return (ctxt_result, Cons_result (result, results))
 
 let mark_backtracked results =
@@ -765,14 +757,16 @@ let mark_backtracked results =
       | Applied result -> Backtracked (result, None) in
   mark_contents_list results
 
-let apply_manager_contents_list ctxt mode baker contents_list =
+let apply_manager_contents_list ctxt mode baker chain_id contents_list =
-  apply_manager_contents_list_rec ctxt mode baker contents_list >>= fun (ctxt_result, results) ->
+  apply_manager_contents_list_rec ctxt mode baker chain_id contents_list >>= fun (ctxt_result, results) ->
   match ctxt_result with
   | `Failure -> Lwt.return (ctxt (* backtracked *), mark_backtracked results)
-  | `Success ctxt -> Lwt.return (ctxt, results)
+  | `Success ctxt ->
+      Big_map.cleanup_temporary ctxt >>= fun ctxt ->
+      Lwt.return (ctxt, results)
 
 let apply_contents_list
-    (type kind) ctxt ~partial chain_id mode pred_block baker
+    (type kind) ctxt chain_id mode pred_block baker
     (operation : kind operation)
     (contents_list : kind contents_list)
   : (context * kind contents_result_list) tzresult Lwt.t =
@@ -791,18 +785,12 @@ let apply_contents_list
       else
         let ctxt = record_endorsement ctxt delegate in
         let gap = List.length slots in
-        let ctxt = Fitness.increase ~gap ctxt in
         Lwt.return
           Tez.(Constants.endorsement_security_deposit ctxt *?
                Int64.of_int gap) >>=? fun deposit ->
-        begin
+        Delegate.freeze_deposit ctxt delegate deposit >>=? fun ctxt ->
-          if partial then
+        Global.get_block_priority ctxt >>=? fun block_priority ->
-            Delegate.freeze_deposit ctxt delegate deposit
+        Baking.endorsing_reward ctxt ~block_priority gap >>=? fun reward ->
-          else
-            add_deposit ctxt delegate deposit
-        end >>=? fun ctxt ->
-        Global.get_last_block_priority ctxt >>=? fun block_priority ->
-        Baking.endorsement_reward ctxt ~block_priority gap >>=? fun reward ->
         Delegate.freeze_rewards ctxt delegate reward >>=? fun ctxt ->
         let level = Level.from_raw ctxt level in
         return (ctxt, Single_result
@@ -944,17 +932,17 @@ let apply_contents_list
       return (ctxt, Single_result Ballot_result)
   | Single (Manager_operation _) as op ->
       precheck_manager_contents_list ctxt chain_id operation op >>=? fun ctxt ->
-      apply_manager_contents_list ctxt mode baker op >>= fun (ctxt, result) ->
+      apply_manager_contents_list ctxt mode baker chain_id op >>= fun (ctxt, result) ->
       return (ctxt, result)
   | Cons (Manager_operation _, _) as op ->
       precheck_manager_contents_list ctxt chain_id operation op >>=? fun ctxt ->
-      apply_manager_contents_list ctxt mode baker op >>= fun (ctxt, result) ->
+      apply_manager_contents_list ctxt mode baker chain_id op >>= fun (ctxt, result) ->
       return (ctxt, result)
 
-let apply_operation ctxt ~partial chain_id mode pred_block baker hash operation =
+let apply_operation ctxt chain_id mode pred_block baker hash operation =
   let ctxt = Contract.init_origination_nonce ctxt hash in
   apply_contents_list
-    ctxt ~partial chain_id mode pred_block baker operation
+    ctxt chain_id mode pred_block baker operation
     operation.protocol_data.contents >>=? fun (ctxt, result) ->
   let ctxt = Gas.set_unlimited ctxt in
   let ctxt = Contract.unset_origination_nonce ctxt in
@@ -983,15 +971,17 @@ let may_start_new_cycle ctxt =
       return (ctxt, update_balances, deactivated)
 
 let begin_full_construction ctxt pred_timestamp protocol_data =
+  Alpha_context.Global.set_block_priority ctxt
+    protocol_data.Block_header.priority >>=? fun ctxt ->
   Baking.check_baking_rights
-    ctxt protocol_data pred_timestamp >>=? fun delegate_pk ->
+    ctxt protocol_data pred_timestamp >>=? fun (delegate_pk, block_delay) ->
   let ctxt = Fitness.increase ctxt in
   match Level.pred ctxt (Level.current ctxt) with
   | None -> assert false (* genesis *)
   | Some pred_level ->
       Baking.endorsement_rights ctxt pred_level >>=? fun rights ->
       let ctxt = init_endorsements ctxt rights in
-      return (ctxt, protocol_data, delegate_pk)
+      return (ctxt, protocol_data, delegate_pk, block_delay)
 
 let begin_partial_construction ctxt =
   let ctxt = Fitness.increase ctxt in
@@ -1003,11 +993,14 @@ let begin_partial_construction ctxt =
       return ctxt
 
 let begin_application ctxt chain_id block_header pred_timestamp =
+  Alpha_context.Global.set_block_priority ctxt
+    block_header.Block_header.protocol_data.contents.priority >>=? fun ctxt ->
   let current_level = Alpha_context.Level.current ctxt in
   Baking.check_proof_of_work_stamp ctxt block_header >>=? fun () ->
   Baking.check_fitness_gap ctxt block_header >>=? fun () ->
   Baking.check_baking_rights
-    ctxt block_header.protocol_data.contents pred_timestamp >>=? fun delegate_pk ->
+    ctxt block_header.protocol_data.contents pred_timestamp
+  >>=? fun (delegate_pk, block_delay) ->
   Baking.check_signature block_header chain_id delegate_pk >>=? fun () ->
   let has_commitment =
     match block_header.protocol_data.contents.seed_nonce_hash with
@@ -1023,12 +1016,27 @@ let begin_application ctxt chain_id block_header pred_timestamp =
   | Some pred_level ->
       Baking.endorsement_rights ctxt pred_level >>=? fun rights ->
       let ctxt = init_endorsements ctxt rights in
-      return (ctxt, delegate_pk)
+      return (ctxt, delegate_pk, block_delay)
 
-let finalize_application ctxt protocol_data delegate =
+let check_minimum_endorsements ctxt protocol_data block_delay included_endorsements =
+  let minimum = Baking.minimum_allowed_endorsements ctxt ~block_delay in
+  let timestamp = Timestamp.current ctxt in
+  fail_unless Compare.Int.(included_endorsements >= minimum)
+    (Not_enough_endorsements_for_priority
+       { required = minimum ;
+         priority = protocol_data.Block_header.priority ;
+         endorsements = included_endorsements ;
+         timestamp })
+
+let finalize_application ctxt protocol_data delegate ~block_delay =
+  let included_endorsements = included_endorsements ctxt in
+  check_minimum_endorsements ctxt
+    protocol_data block_delay included_endorsements >>=? fun () ->
   let deposit = Constants.block_security_deposit ctxt in
   add_deposit ctxt delegate deposit >>=? fun ctxt ->
-  let reward = (Constants.block_reward ctxt) in
+
+  Baking.baking_reward ctxt
+    ~block_priority:protocol_data.priority ~included_endorsements >>=? fun reward ->
   add_rewards ctxt reward >>=? fun ctxt ->
   Signature.Public_key_hash.Map.fold
     (fun delegate deposit ctxt ->
@@ -1048,8 +1056,6 @@ let finalize_application ctxt protocol_data delegate =
         Nonce.record_hash ctxt
           { nonce_hash ; delegate ; rewards ; fees }
   end >>=? fun ctxt ->
-  Alpha_context.Global.set_last_block_priority
-    ctxt protocol_data.priority >>=? fun ctxt ->
   (* end of cycle *)
   may_snapshot_roll ctxt >>=? fun ctxt ->
   may_start_new_cycle ctxt >>=? fun (ctxt, balance_updates, deactivated) ->

vendors/ligo-utils/tezos-protocol-alpha/apply_results.ml

@@ -56,7 +56,8 @@ type _ successful_manager_operation_result =
         allocated_destination_contract : bool ;
       } -> Kind.transaction successful_manager_operation_result
   | Origination_result :
-      { balance_updates : Delegate.balance_updates ;
+      { big_map_diff : Contract.big_map_diff option ;
+        balance_updates : Delegate.balance_updates ;
         originated_contracts : Contract.t list ;
         consumed_gas : Z.t ;
         storage_size : Z.t ;
@@ -215,7 +216,8 @@ module Manager_result = struct
     make
       ~op_case: Operation.Encoding.Manager_operations.origination_case
       ~encoding:
-        (obj5
+        (obj6
+           (opt "big_map_diff" Contract.big_map_diff_encoding)
            (dft "balance_updates" Delegate.balance_updates_encoding [])
            (dft "originated_contracts" (list Contract.encoding) [])
            (dft "consumed_gas" z Z.zero)
@@ -234,19 +236,19 @@ module Manager_result = struct
       ~proj:
         (function
           | Origination_result
-              { balance_updates ;
+              { big_map_diff ; balance_updates ;
                 originated_contracts ; consumed_gas ;
                 storage_size ; paid_storage_size_diff } ->
-              (balance_updates,
+              (big_map_diff, balance_updates,
                originated_contracts, consumed_gas,
                storage_size, paid_storage_size_diff))
       ~kind: Kind.Origination_manager_kind
       ~inj:
-        (fun (balance_updates,
+        (fun (big_map_diff, balance_updates,
               originated_contracts, consumed_gas,
               storage_size, paid_storage_size_diff) ->
           Origination_result
-            { balance_updates ;
+            { big_map_diff ; balance_updates ;
               originated_contracts ; consumed_gas ;
               storage_size ; paid_storage_size_diff })
 

vendors/ligo-utils/tezos-protocol-alpha/apply_results.mli

@@ -100,7 +100,8 @@ and _ successful_manager_operation_result =
         allocated_destination_contract : bool ;
       } -> Kind.transaction successful_manager_operation_result
   | Origination_result :
-      { balance_updates : Delegate.balance_updates ;
+      { big_map_diff : Contract.big_map_diff option ;
+        balance_updates : Delegate.balance_updates ;
         originated_contracts : Contract.t list ;
         consumed_gas : Z.t ;
         storage_size : Z.t ;

vendors/ligo-utils/tezos-protocol-alpha/baking.ml

@@ -142,17 +142,19 @@ let earlier_predecessor_timestamp ctxt level =
 let check_timestamp c priority pred_timestamp =
   minimal_time c priority pred_timestamp >>=? fun minimal_time ->
   let timestamp = Alpha_context.Timestamp.current c in
-  fail_unless Timestamp.(minimal_time <= timestamp)
+  Lwt.return
-    (Timestamp_too_early (minimal_time, timestamp))
+    (record_trace (Timestamp_too_early (minimal_time, timestamp))
+       Timestamp.(timestamp -? minimal_time))
 
 let check_baking_rights c { Block_header.priority ; _ }
     pred_timestamp =
   let level = Level.current c in
   Roll.baking_rights_owner c level ~priority >>=? fun delegate ->
-  check_timestamp c priority pred_timestamp >>=? fun () ->
+  check_timestamp c priority pred_timestamp >>=? fun block_delay ->
-  return delegate
+  return (delegate, block_delay)
 
 type error += Incorrect_priority (* `Permanent *)
+type error += Incorrect_number_of_endorsements (* `Permanent *)
 
 let () =
   register_error_kind
@@ -166,7 +168,34 @@ let () =
     (function Incorrect_priority -> Some () | _ -> None)
     (fun () -> Incorrect_priority)
 
-let endorsement_reward ctxt ~block_priority:prio n =
+let () =
+  let description = "The number of endorsements must be non-negative and \
+                     at most the endosers_per_block constant." in
+  register_error_kind
+    `Permanent
+    ~id:"incorrect_number_of_endorsements"
+    ~title:"Incorrect number of endorsements"
+    ~description
+    ~pp:(fun ppf () -> Format.fprintf ppf "%s" description)
+    Data_encoding.unit
+    (function Incorrect_number_of_endorsements -> Some () | _ -> None)
+    (fun () -> Incorrect_number_of_endorsements)
+
+let baking_reward ctxt ~block_priority:prio ~included_endorsements:num_endo =
+  fail_unless Compare.Int.(prio >= 0) Incorrect_priority >>=? fun () ->
+  let max_endorsements = Constants.endorsers_per_block ctxt in
+  fail_unless Compare.Int.(num_endo >= 0 && num_endo <= max_endorsements)
+    Incorrect_number_of_endorsements >>=? fun () ->
+  let prio_factor_denominator = Int64.(succ (of_int prio)) in
+  let endo_factor_numerator = Int64.of_int (8 + 2 * num_endo / max_endorsements) in
+  let endo_factor_denominator = 10L in
+  Lwt.return
+    Tez.(
+      Constants.block_reward ctxt *? endo_factor_numerator >>? fun val1 ->
+      val1 /? endo_factor_denominator >>? fun val2 ->
+      val2 /? prio_factor_denominator)
+
+let endorsing_reward ctxt ~block_priority:prio n =
   if Compare.Int.(prio >= 0)
   then
     Lwt.return
@@ -271,9 +300,7 @@ let check_signature block chain_id key =
     fail (Invalid_block_signature (Block_header.hash block,
                                    Signature.Public_key.hash key))
 
-let max_fitness_gap ctxt =
+let max_fitness_gap _ctxt = 1L
-  let slots = Int64.of_int (Constants.endorsers_per_block ctxt + 1) in
-  Int64.add slots 1L
 
 let check_fitness_gap ctxt (block : Block_header.t) =
   let current_fitness = Fitness.current ctxt in
@@ -294,3 +321,36 @@ let dawn_of_a_new_cycle ctxt =
     return_some level.cycle
   else
     return_none
+
+let minimum_allowed_endorsements ctxt ~block_delay =
+  let minimum = Constants.initial_endorsers ctxt in
+  let delay_per_missing_endorsement =
+    Int64.to_int
+      (Period.to_seconds
+         (Constants.delay_per_missing_endorsement ctxt))
+  in
+  let reduced_time_constraint =
+    let delay = Int64.to_int (Period.to_seconds block_delay) in
+    if Compare.Int.(delay_per_missing_endorsement = 0) then
+      delay
+    else
+      delay / delay_per_missing_endorsement
+  in
+  Compare.Int.max 0 (minimum - reduced_time_constraint)
+
+let minimal_valid_time ctxt ~priority ~endorsing_power =
+  let predecessor_timestamp = Timestamp.current ctxt in
+  minimal_time ctxt
+    priority predecessor_timestamp >>=? fun minimal_time ->
+  let minimal_required_endorsements = Constants.initial_endorsers ctxt in
+  let delay_per_missing_endorsement =
+    Constants.delay_per_missing_endorsement ctxt
+  in
+  let missing_endorsements =
+    Compare.Int.max 0 (minimal_required_endorsements - endorsing_power) in
+  match Period.mult
+          (Int32.of_int missing_endorsements)
+          delay_per_missing_endorsement with
+  | Ok delay ->
+      return (Time.add minimal_time (Period.to_seconds delay))
+  | Error _ as err -> Lwt.return err

vendors/ligo-utils/tezos-protocol-alpha/baking.mli

@@ -47,7 +47,7 @@ val minimal_time: context -> int -> Time.t -> Time.t tzresult Lwt.t
 *)
 val check_baking_rights:
   context -> Block_header.contents -> Time.t ->
-  public_key tzresult Lwt.t
+  (public_key * Period.t) tzresult Lwt.t
 
 (** For a given level computes who has the right to
     include an endorsement in the next block.
@@ -63,8 +63,15 @@ val check_endorsement_rights:
   context -> Chain_id.t -> Kind.endorsement Operation.t ->
   (public_key_hash * int list * bool) tzresult Lwt.t
 
-(** Returns the endorsement reward calculated w.r.t a given priority.  *)
+(** Returns the baking reward calculated w.r.t a given priority [p] and a
-val endorsement_reward: context -> block_priority:int -> int -> Tez.t tzresult Lwt.t
+    number [e] of included endorsements as follows:
+      (block_reward / (p+1)) * (0.8 + 0.2 * e / endorsers_per_block)
+*)
+val baking_reward: context ->
+  block_priority:int -> included_endorsements:int -> Tez.t tzresult Lwt.t
+
+(** Returns the endorsing reward calculated w.r.t a given priority.  *)
+val endorsing_reward: context -> block_priority:int -> int -> Tez.t tzresult Lwt.t
 
 (** [baking_priorities ctxt level] is the lazy list of contract's
     public key hashes that are allowed to bake for [level]. *)
@@ -106,3 +113,39 @@ val check_fitness_gap:
 val dawn_of_a_new_cycle: context -> Cycle.t option tzresult Lwt.t
 
 val earlier_predecessor_timestamp: context -> Level.t -> Timestamp.t tzresult Lwt.t
+
+(** Since Emmy+
+
+    A block is valid only if its timestamp has a minimal delay with
+    respect to the previous block's timestamp, and this minimal delay
+    depends not only on the block's priority but also on the number of
+    endorsement operations included in the block.
+
+    In Emmy+, blocks' fitness increases by one unit with each level.
+
+    In this way, Emmy+ simplifies the optimal baking strategy: The
+    bakers used to have to choose whether to wait for more endorsements
+    to include in their block, or to publish the block immediately,
+    without waiting. The incentive for including more endorsements was
+    to increase the fitness and win against unknown blocks. However,
+    when a block was produced too late in the priority period, there
+    was the risk that the block did not reach endorsers before the
+    block of next priority. In Emmy+, the baker does not need to take
+    such a decision, because the baker cannot publish a block too
+    early. *)
+
+(** Given a delay of a block's timestamp with respect to the minimum
+    time to bake at the block's priority (as returned by
+    `minimum_time`), it returns the minimum number of endorsements that
+    the block has to contain *)
+val minimum_allowed_endorsements: context -> block_delay:Period.t -> int
+
+(** This is the somehow the dual of the previous function. Given a
+    block priority and a number of endorsement slots (given by the
+    `endorsing_power` argument), it returns the minimum time at which
+    the next block can be baked. *)
+val minimal_valid_time:
+  context ->
+  priority:int ->
+  endorsing_power: int ->
+  Time.t tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/bootstrap_storage.ml

@@ -31,7 +31,7 @@ let init_account ctxt
   Contract_storage.credit ctxt contract amount >>=? fun ctxt ->
   match public_key with
   | Some public_key ->
-      Contract_storage.reveal_manager_key ctxt contract public_key >>=? fun ctxt ->
+      Contract_storage.reveal_manager_key ctxt public_key_hash public_key >>=? fun ctxt ->
       Delegate_storage.set ctxt contract (Some public_key_hash) >>=? fun ctxt ->
       return ctxt
   | None -> return ctxt
@@ -43,11 +43,8 @@ let init_contract ~typecheck ctxt
   Contract_storage.originate ctxt contract
     ~balance:amount
     ~prepaid_bootstrap_storage:true
-    ~manager:Signature.Public_key_hash.zero
     ~script
-    ~delegate:(Some delegate)
+    ~delegate:(Some delegate) >>=? fun ctxt ->
-    ~spendable:false
-    ~delegatable:false >>=? fun ctxt ->
   return ctxt
 
 let init ctxt ~typecheck ?ramp_up_cycles ?no_reward_cycles accounts contracts =

vendors/ligo-utils/tezos-protocol-alpha/constants_repr.ml

@@ -23,7 +23,8 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-let version_number = "\000"
+let version_number_004 = "\000"
+let version_number = "\001"
 let proof_of_work_nonce_size = 8
 let nonce_length = 32
 let max_revelations_per_block = 32
@@ -95,37 +96,11 @@ type parametric = {
   cost_per_byte: Tez_repr.t ;
   hard_storage_limit_per_operation: Z.t ;
   test_chain_duration: int64 ;  (* in seconds *)
-}
+  quorum_min: int32 ;
-
+  quorum_max: int32 ;
-let default = {
+  min_proposal_quorum: int32 ;
-  preserved_cycles = 5 ;
+  initial_endorsers: int ;
-  blocks_per_cycle = 4096l ;
+  delay_per_missing_endorsement: Period_repr.t ;
-  blocks_per_commitment = 32l ;
-  blocks_per_roll_snapshot = 256l ;
-  blocks_per_voting_period = 32768l ;
-  time_between_blocks =
-    List.map Period_repr.of_seconds_exn [ 60L ; 75L ] ;
-  endorsers_per_block = 32 ;
-  hard_gas_limit_per_operation = Z.of_int 800_000 ;
-  hard_gas_limit_per_block = Z.of_int 8_000_000 ;
-  proof_of_work_threshold =
-    Int64.(sub (shift_left 1L 46) 1L) ;
-  tokens_per_roll =
-    Tez_repr.(mul_exn one 8_000) ;
-  michelson_maximum_type_size = 1000 ;
-  seed_nonce_revelation_tip = begin
-    match Tez_repr.(one /? 8L) with
-    | Ok c -> c
-    | Error _ -> assert false
-  end ;
-  origination_size = 257 ;
-  block_security_deposit = Tez_repr.(mul_exn one 512) ;
-  endorsement_security_deposit = Tez_repr.(mul_exn one 64) ;
-  block_reward = Tez_repr.(mul_exn one 16) ;
-  endorsement_reward = Tez_repr.(mul_exn one 2) ;
-  hard_storage_limit_per_operation = Z.of_int 60_000 ;
-  cost_per_byte = Tez_repr.of_mutez_exn 1_000L ;
-  test_chain_duration = Int64.mul 32768L 60L;
 }
 
 let parametric_encoding =
@@ -152,7 +127,13 @@ let parametric_encoding =
          (c.endorsement_reward,
           c.cost_per_byte,
           c.hard_storage_limit_per_operation,
-          c.test_chain_duration))) )
+          c.test_chain_duration,
+          c.quorum_min,
+          c.quorum_max,
+          c.min_proposal_quorum,
+          c.initial_endorsers,
+          c.delay_per_missing_endorsement
+         ))) )
     (fun (( preserved_cycles,
             blocks_per_cycle,
             blocks_per_commitment,
@@ -173,7 +154,12 @@ let parametric_encoding =
            (endorsement_reward,
             cost_per_byte,
             hard_storage_limit_per_operation,
-            test_chain_duration))) ->
+            test_chain_duration,
+            quorum_min,
+            quorum_max,
+            min_proposal_quorum,
+            initial_endorsers,
+            delay_per_missing_endorsement))) ->
       { preserved_cycles ;
         blocks_per_cycle ;
         blocks_per_commitment ;
@@ -195,6 +181,11 @@ let parametric_encoding =
         cost_per_byte ;
         hard_storage_limit_per_operation ;
         test_chain_duration ;
+        quorum_min ;
+        quorum_max ;
+        min_proposal_quorum ;
+        initial_endorsers ;
+        delay_per_missing_endorsement ;
       } )
     (merge_objs
        (obj9
@@ -217,11 +208,17 @@ let parametric_encoding =
              (req "block_security_deposit" Tez_repr.encoding)
              (req "endorsement_security_deposit" Tez_repr.encoding)
              (req "block_reward" Tez_repr.encoding))
-          (obj4
+          (obj9
              (req "endorsement_reward" Tez_repr.encoding)
              (req "cost_per_byte" Tez_repr.encoding)
              (req "hard_storage_limit_per_operation" z)
-             (req "test_chain_duration" int64))))
+             (req "test_chain_duration" int64)
+             (req "quorum_min" int32)
+             (req "quorum_max" int32)
+             (req "min_proposal_quorum" int32)
+             (req "initial_endorsers" uint16)
+             (req "delay_per_missing_endorsement" Period_repr.encoding)
+          )))
 
 type t = {
   fixed : fixed ;

vendors/ligo-utils/tezos-protocol-alpha/constants_storage.ml

@@ -44,6 +44,12 @@ let time_between_blocks c =
 let endorsers_per_block c =
   let constants = Raw_context.constants c in
   constants.endorsers_per_block
+let initial_endorsers c =
+  let constants = Raw_context.constants c in
+  constants.initial_endorsers
+let delay_per_missing_endorsement c =
+  let constants = Raw_context.constants c in
+  constants.delay_per_missing_endorsement
 let hard_gas_limit_per_operation c =
   let constants = Raw_context.constants c in
   constants.hard_gas_limit_per_operation
@@ -86,5 +92,14 @@ let endorsement_reward c =
 let test_chain_duration c =
   let constants = Raw_context.constants c in
   constants.test_chain_duration
+let quorum_min c =
+  let constants = Raw_context.constants c in
+  constants.quorum_min
+let quorum_max c =
+  let constants = Raw_context.constants c in
+  constants.quorum_max
+let min_proposal_quorum c =
+  let constants = Raw_context.constants c in
+  constants.min_proposal_quorum
 let parametric c =
   Raw_context.constants c

vendors/ligo-utils/tezos-protocol-alpha/contract_repr.ml

@@ -109,6 +109,8 @@ let () =
 
 let implicit_contract id = Implicit id
 
+let originated_contract_004 id = Originated id
+
 let is_implicit = function
   | Implicit m -> Some m
   | Originated _ -> None

vendors/ligo-utils/tezos-protocol-alpha/contract_repr.mli

@@ -30,13 +30,16 @@ type contract = t
 
 include Compare.S with type t := contract
 
-(** {2 Implicit contracts} *****************************************************)
+(** {2 Implicit contracts} *)
 
 val implicit_contract : Signature.Public_key_hash.t -> contract
 
+(** Only for migration from proto_004  *)
+val originated_contract_004 : Contract_hash.t -> contract
+
 val is_implicit : contract -> Signature.Public_key_hash.t option
 
-(** {2 Originated contracts} **************************************************)
+(** {2 Originated contracts} *)
 
 (** Originated contracts handles are crafted from the hash of the
     operation that triggered their origination (and nothing else).
@@ -56,7 +59,7 @@ val incr_origination_nonce : origination_nonce -> origination_nonce
 val is_originated : contract -> Contract_hash.t option
 
 
-(** {2 Human readable notation} ***********************************************)
+(** {2 Human readable notation} *)
 
 type error += Invalid_contract_notation of string (* `Permanent *)
 
@@ -68,7 +71,7 @@ val pp: Format.formatter -> contract -> unit
 
 val pp_short: Format.formatter -> contract -> unit
 
-(** {2 Serializers} ***********************************************************)
+(** {2 Serializers} *)
 
 val encoding : contract Data_encoding.t
 

vendors/ligo-utils/tezos-protocol-alpha/contract_services.ml

@@ -28,35 +28,28 @@ open Alpha_context
 let custom_root =
   (RPC_path.(open_root / "context" / "contracts") : RPC_context.t RPC_path.context)
 
+let big_map_root =
+  (RPC_path.(open_root / "context" / "big_maps") : RPC_context.t RPC_path.context)
+
 type info = {
-  manager: public_key_hash ;
   balance: Tez.t ;
-  spendable: bool ;
+  delegate: public_key_hash option ;
-  delegate: bool * public_key_hash option ;
+  counter: counter option ;
-  counter: counter ;
   script: Script.t option ;
 }
 
 let info_encoding =
   let open Data_encoding in
   conv
-    (fun {manager ; balance ; spendable ; delegate ;
+    (fun {balance ; delegate ; script ; counter } ->
-          script ; counter } ->
+      (balance, delegate, script, counter))
-      (manager, balance, spendable, delegate,
+    (fun (balance, delegate, script, counter) ->
-       script, counter))
+      {balance ; delegate ; script ; counter}) @@
-    (fun (manager, balance, spendable, delegate,
+  obj4
-          script, counter) ->
-      {manager ; balance ; spendable ; delegate ;
-       script ; counter}) @@
-  obj6
-    (req "manager" Signature.Public_key_hash.encoding)
     (req "balance" Tez.encoding)
-    (req "spendable" bool)
+    (opt "delegate" Signature.Public_key_hash.encoding)
-    (req "delegate" @@ obj2
-       (req "setable" bool)
-       (opt "value" Signature.Public_key_hash.encoding))
     (opt "script" Script.encoding)
-    (req "counter" n)
+    (opt "counter" n)
 
 module S = struct
 
@@ -69,20 +62,11 @@ module S = struct
       ~output: Tez.encoding
       RPC_path.(custom_root /: Contract.rpc_arg / "balance")
 
-  let manager =
-    RPC_service.get_service
-      ~description: "Access the manager of a contract."
-      ~query: RPC_query.empty
-      ~output: Signature.Public_key_hash.encoding
-      RPC_path.(custom_root /: Contract.rpc_arg / "manager")
-
   let manager_key =
     RPC_service.get_service
       ~description: "Access the manager of a contract."
       ~query: RPC_query.empty
-      ~output: (obj2
+      ~output: (option Signature.Public_key.encoding)
-                  (req "manager" Signature.Public_key_hash.encoding)
-                  (opt "key" Signature.Public_key.encoding))
       RPC_path.(custom_root /: Contract.rpc_arg / "manager_key")
 
   let delegate =
@@ -99,20 +83,6 @@ module S = struct
       ~output: z
       RPC_path.(custom_root /: Contract.rpc_arg / "counter")
 
-  let spendable =
-    RPC_service.get_service
-      ~description: "Tells if the contract tokens can be spent by the manager."
-      ~query: RPC_query.empty
-      ~output: bool
-      RPC_path.(custom_root /: Contract.rpc_arg / "spendable")
-
-  let delegatable =
-    RPC_service.get_service
-      ~description: "Tells if the contract delegate can be changed."
-      ~query: RPC_query.empty
-      ~output: bool
-      RPC_path.(custom_root /: Contract.rpc_arg / "delegatable")
-
   let script =
     RPC_service.get_service
       ~description: "Access the code and data of the contract."
@@ -127,15 +97,43 @@ module S = struct
       ~output: Script.expr_encoding
       RPC_path.(custom_root /: Contract.rpc_arg / "storage")
 
-  let big_map_get =
+  let entrypoint_type =
-    RPC_service.post_service
+    RPC_service.get_service
-      ~description: "Access the value associated with a key in the big map storage  of the contract."
+      ~description: "Return the type of the given entrypoint of the contract"
       ~query: RPC_query.empty
-      ~input: (obj2
+      ~output: Script.expr_encoding
-                 (req "key" Script.expr_encoding)
+      RPC_path.(custom_root /: Contract.rpc_arg / "entrypoints" /: RPC_arg.string)
-                 (req "type" Script.expr_encoding))
+
-      ~output: (option Script.expr_encoding)
+
-      RPC_path.(custom_root /: Contract.rpc_arg / "big_map_get")
+  let list_entrypoints =
+    RPC_service.get_service
+      ~description: "Return the list of entrypoints of the contract"
+      ~query: RPC_query.empty
+      ~output: (obj2
+                  (dft "unreachable"
+                     (Data_encoding.list
+                        (obj1 (req "path" (Data_encoding.list Michelson_v1_primitives.prim_encoding))))
+                     [])
+                  (req "entrypoints"
+                     (assoc Script.expr_encoding)))
+      RPC_path.(custom_root /: Contract.rpc_arg / "entrypoints")
+
+  let contract_big_map_get_opt =
+     RPC_service.post_service
+       ~description: "Access the value associated with a key in a big map of the contract (deprecated)."
+       ~query: RPC_query.empty
+       ~input: (obj2
+                  (req "key" Script.expr_encoding)
+                  (req "type" Script.expr_encoding))
+       ~output: (option Script.expr_encoding)
+       RPC_path.(custom_root /: Contract.rpc_arg / "big_map_get")
+
+  let big_map_get =
+    RPC_service.get_service
+      ~description: "Access the value associated with a key in a big map."
+      ~query: RPC_query.empty
+      ~output: Script.expr_encoding
+      RPC_path.(big_map_root /: Big_map.rpc_arg /: Script_expr_hash.rpc_arg)
 
   let info =
     RPC_service.get_service
@@ -170,20 +168,39 @@ let register () =
          f ctxt a1 >>=? function
          | None -> raise Not_found
          | Some v -> return v) in
+  let do_big_map_get ctxt id key =
+    let open Script_ir_translator in
+    let ctxt = Gas.set_unlimited ctxt in
+    Big_map.exists ctxt id >>=? fun (ctxt, types) ->
+    match types with
+    | None -> raise Not_found
+    | Some (_, value_type) ->
+        Lwt.return (parse_ty ctxt
+                      ~legacy:true ~allow_big_map:false ~allow_operation:false ~allow_contract:true
+                      (Micheline.root value_type))
+        >>=? fun (Ex_ty value_type, ctxt) ->
+        Big_map.get_opt ctxt id key >>=? fun (_ctxt, value) ->
+        match value with
+        | None -> raise Not_found
+        | Some value ->
+            parse_data ctxt ~legacy:true value_type (Micheline.root value) >>=? fun (value, ctxt) ->
+            unparse_data ctxt Readable value_type value >>=? fun (value, _ctxt) ->
+            return (Micheline.strip_locations value) in
   register_field S.balance Contract.get_balance ;
-  register_field S.manager Contract.get_manager ;
+  register1 S.manager_key
-  register_field S.manager_key
+    (fun ctxt contract () () ->
-    (fun ctxt c ->
+       match Contract.is_implicit contract with
-       Contract.get_manager ctxt c >>=? fun mgr ->
+       | None -> raise Not_found
-       Contract.is_manager_key_revealed ctxt c >>=? fun revealed ->
+       | Some mgr ->
-       if revealed then
+           Contract.is_manager_key_revealed ctxt mgr >>=? function
-         Contract.get_manager_key ctxt c >>=? fun key ->
+           | false -> return_none
-         return (mgr, Some key)
+           | true -> Contract.get_manager_key ctxt mgr >>=? return_some) ;
-       else return (mgr, None)) ;
   register_opt_field S.delegate Delegate.get ;
-  register_field S.counter Contract.get_counter ;
+  register1 S.counter
-  register_field S.spendable Contract.is_spendable ;
+    (fun ctxt contract () () ->
-  register_field S.delegatable Contract.is_delegatable ;
+       match Contract.is_implicit contract with
+       | None -> raise Not_found
+       | Some mgr -> Contract.get_counter ctxt mgr) ;
   register_opt_field S.script
     (fun c v -> Contract.get_script c v >>=? fun (_, v) -> return v) ;
   register_opt_field S.storage (fun ctxt contract ->
@@ -193,39 +210,95 @@ let register () =
       | Some script ->
           let ctxt = Gas.set_unlimited ctxt in
           let open Script_ir_translator in
-          parse_script ctxt script >>=? fun (Ex_script script, ctxt) ->
+          parse_script ctxt ~legacy:true script >>=? fun (Ex_script script, ctxt) ->
           unparse_script ctxt Readable script >>=? fun (script, ctxt) ->
           Script.force_decode ctxt script.storage >>=? fun (storage, _ctxt) ->
           return_some storage) ;
-  register1 S.big_map_get (fun ctxt contract () (key, key_type) ->
+  register2 S.entrypoint_type
-      let open Script_ir_translator in
+    (fun ctxt v entrypoint () () -> Contract.get_script_code ctxt v >>=? fun (_, expr) ->
-      let ctxt = Gas.set_unlimited ctxt in
+      match expr with
-      Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false (Micheline.root key_type))
+      | None -> raise Not_found
-      >>=? fun (Ex_ty key_type, ctxt) ->
+      | Some expr ->
-      parse_data ctxt key_type (Micheline.root key) >>=? fun (key, ctxt) ->
+          let ctxt = Gas.set_unlimited ctxt in
-      hash_data ctxt key_type key >>=? fun (key_hash, ctxt) ->
+          let legacy = true in
-      Contract.Big_map.get_opt ctxt contract key_hash >>=? fun (_ctxt, value) ->
+          let open Script_ir_translator in
-      return value) ;
+          Script.force_decode ctxt expr >>=? fun (expr, _) ->
+          Lwt.return
+            begin
+              parse_toplevel ~legacy expr >>? fun (arg_type, _, _, root_name) ->
+              parse_ty ctxt ~legacy
+                ~allow_big_map:true ~allow_operation:false
+                ~allow_contract:true arg_type >>? fun (Ex_ty arg_type, _) ->
+              Script_ir_translator.find_entrypoint ~root_name arg_type
+                entrypoint
+            end >>= function
+            Ok (_f , Ex_ty ty)->
+              unparse_ty ctxt ty >>=? fun (ty_node, _) ->
+              return (Micheline.strip_locations ty_node)
+          | Error _ -> raise Not_found) ;
+  register1 S.list_entrypoints
+    (fun ctxt v () () -> Contract.get_script_code ctxt v >>=? fun (_, expr) ->
+      match expr with
+      | None -> raise Not_found
+      | Some expr ->
+          let ctxt = Gas.set_unlimited ctxt in
+          let legacy = true in
+          let open Script_ir_translator in
+          Script.force_decode ctxt expr >>=? fun (expr, _) ->
+          Lwt.return
+            begin
+              parse_toplevel ~legacy expr >>? fun (arg_type, _, _, root_name) ->
+              parse_ty ctxt ~legacy
+                ~allow_big_map:true ~allow_operation:false
+                ~allow_contract:true arg_type >>? fun (Ex_ty arg_type, _) ->
+              Script_ir_translator.list_entrypoints ~root_name arg_type ctxt
+            end >>=? fun (unreachable_entrypoint,map) ->
+          return
+            (unreachable_entrypoint,
+             Entrypoints_map.fold
+               begin fun entry (_,ty) acc ->
+                 (entry , Micheline.strip_locations ty) ::acc end
+               map [])
+    ) ;
+  register1 S.contract_big_map_get_opt (fun ctxt contract () (key, key_type) ->
+      Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
+      Lwt.return (Script_ir_translator.parse_packable_ty ctxt ~legacy:true (Micheline.root key_type)) >>=? fun (Ex_ty key_type, ctxt) ->
+      Script_ir_translator.parse_data ctxt ~legacy:true key_type (Micheline.root key) >>=? fun (key, ctxt) ->
+      Script_ir_translator.hash_data ctxt key_type key >>=? fun (key, ctxt) ->
+      match script with
+      | None -> raise Not_found
+      | Some script ->
+          let ctxt = Gas.set_unlimited ctxt in
+          let open Script_ir_translator in
+          parse_script ctxt ~legacy:true script >>=? fun (Ex_script script, ctxt) ->
+          Script_ir_translator.collect_big_maps ctxt script.storage_type script.storage >>=? fun (ids, _ctxt) ->
+          let ids = Script_ir_translator.list_of_big_map_ids ids in
+          let rec find = function
+            | [] -> return_none
+            | (id : Z.t) :: ids -> try do_big_map_get ctxt id key >>=? return_some with Not_found -> find ids in
+          find ids) ;
+  register2 S.big_map_get (fun ctxt id key () () ->
+      do_big_map_get ctxt id key) ;
   register_field S.info (fun ctxt contract ->
       Contract.get_balance ctxt contract >>=? fun balance ->
-      Contract.get_manager ctxt contract >>=? fun manager ->
       Delegate.get ctxt contract >>=? fun delegate ->
-      Contract.get_counter ctxt contract >>=? fun counter ->
+      begin match Contract.is_implicit contract with
-      Contract.is_delegatable ctxt contract >>=? fun delegatable ->
+        | Some manager ->
-      Contract.is_spendable ctxt contract >>=? fun spendable ->
+            Contract.get_counter ctxt manager >>=? fun counter ->
+            return_some counter
+        | None -> return None
+      end >>=? fun counter ->
       Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
       begin match script with
         | None -> return (None, ctxt)
         | Some script ->
             let ctxt = Gas.set_unlimited ctxt in
             let open Script_ir_translator in
-            parse_script ctxt script >>=? fun (Ex_script script, ctxt) ->
+            parse_script ctxt ~legacy:true script >>=? fun (Ex_script script, ctxt) ->
             unparse_script ctxt Readable script >>=? fun (script, ctxt) ->
             return (Some script, ctxt)
       end >>=? fun (script, _ctxt) ->
-      return { manager ; balance ;
+      return { balance ; delegate ; script ; counter })
-               spendable ; delegate = (delegatable, delegate) ;
-               script ; counter })
 
 let list ctxt block =
   RPC_context.make_call0 S.list ctxt block () ()
@@ -236,11 +309,8 @@ let info ctxt block contract =
 let balance ctxt block contract =
   RPC_context.make_call1 S.balance ctxt block contract () ()
 
-let manager ctxt block contract =
+let manager_key ctxt block mgr =
-  RPC_context.make_call1 S.manager ctxt block contract () ()
+  RPC_context.make_call1 S.manager_key ctxt block (Contract.implicit_contract mgr) () ()
-
-let manager_key ctxt block contract =
-  RPC_context.make_call1 S.manager_key ctxt block contract () ()
 
 let delegate ctxt block contract =
   RPC_context.make_call1 S.delegate ctxt block contract () ()
@@ -248,14 +318,8 @@ let delegate ctxt block contract =
 let delegate_opt ctxt block contract =
   RPC_context.make_opt_call1 S.delegate ctxt block contract () ()
 
-let counter ctxt block contract =
+let counter ctxt block mgr =
-  RPC_context.make_call1 S.counter ctxt block contract () ()
+  RPC_context.make_call1 S.counter ctxt block (Contract.implicit_contract mgr) () ()
-
-let is_delegatable ctxt block contract =
-  RPC_context.make_call1 S.delegatable ctxt block contract () ()
-
-let is_spendable ctxt block contract =
-  RPC_context.make_call1 S.spendable ctxt block contract () ()
 
 let script ctxt block contract =
   RPC_context.make_call1 S.script ctxt block contract () ()
@@ -266,8 +330,17 @@ let script_opt ctxt block contract =
 let storage ctxt block contract =
   RPC_context.make_call1 S.storage ctxt block contract () ()
 
+let entrypoint_type ctxt block contract entrypoint =
+  RPC_context.make_call2 S.entrypoint_type ctxt block contract entrypoint () ()
+
+let list_entrypoints ctxt block contract =
+  RPC_context.make_call1 S.list_entrypoints ctxt block contract () ()
+
 let storage_opt ctxt block contract =
   RPC_context.make_opt_call1 S.storage ctxt block contract () ()
 
-let big_map_get_opt ctxt block contract key =
+let big_map_get ctxt block id key =
-  RPC_context.make_call1 S.big_map_get ctxt block contract () key
+  RPC_context.make_call2 S.big_map_get ctxt block id key () ()
+
+let contract_big_map_get_opt ctxt block contract key =
+  RPC_context.make_call1 S.contract_big_map_get_opt ctxt block contract () key

vendors/ligo-utils/tezos-protocol-alpha/contract_services.mli

@@ -29,11 +29,9 @@ val list:
   'a #RPC_context.simple -> 'a -> Contract.t list shell_tzresult Lwt.t
 
 type info = {
-  manager: public_key_hash ;
   balance: Tez.t ;
-  spendable: bool ;
+  delegate: public_key_hash option ;
-  delegate: bool * public_key_hash option ;
+  counter: counter option ;
-  counter: counter ;
   script: Script.t option ;
 }
 
@@ -45,11 +43,8 @@ val info:
 val balance:
   'a #RPC_context.simple -> 'a -> Contract.t -> Tez.t shell_tzresult Lwt.t
 
-val manager:
-  'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash shell_tzresult Lwt.t
-
 val manager_key:
-  'a #RPC_context.simple -> 'a -> Contract.t -> (public_key_hash * public_key option) shell_tzresult Lwt.t
+  'a #RPC_context.simple -> 'a -> public_key_hash -> public_key option shell_tzresult Lwt.t
 
 val delegate:
   'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash shell_tzresult Lwt.t
@@ -57,14 +52,8 @@ val delegate:
 val delegate_opt:
   'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash option shell_tzresult Lwt.t
 
-val is_delegatable:
-  'a #RPC_context.simple -> 'a -> Contract.t -> bool shell_tzresult Lwt.t
-
-val is_spendable:
-  'a #RPC_context.simple -> 'a -> Contract.t -> bool shell_tzresult Lwt.t
-
 val counter:
-  'a #RPC_context.simple -> 'a -> Contract.t -> counter shell_tzresult Lwt.t
+  'a #RPC_context.simple -> 'a -> public_key_hash -> counter shell_tzresult Lwt.t
 
 val script:
   'a #RPC_context.simple -> 'a -> Contract.t -> Script.t shell_tzresult Lwt.t
@@ -75,12 +64,22 @@ val script_opt:
 val storage:
   'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr shell_tzresult Lwt.t
 
+val entrypoint_type:
+  'a #RPC_context.simple -> 'a -> Contract.t -> string -> Script.expr shell_tzresult Lwt.t
+
+val list_entrypoints:
+  'a #RPC_context.simple -> 'a -> Contract.t ->
+  (Michelson_v1_primitives.prim list list *
+   (string * Script.expr) list) shell_tzresult Lwt.t
+
 val storage_opt:
   'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr option shell_tzresult Lwt.t
 
-val big_map_get_opt:
+val big_map_get:
-  'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr * Script.expr ->
+  'a #RPC_context.simple -> 'a -> Z.t -> Script_expr_hash.t ->
-  Script.expr option shell_tzresult Lwt.t
+  Script.expr shell_tzresult Lwt.t
 
+val contract_big_map_get_opt:
+  'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr * Script.expr -> Script.expr option shell_tzresult Lwt.t
 
 val register: unit -> unit

vendors/ligo-utils/tezos-protocol-alpha/contract_storage.ml

@@ -202,96 +202,185 @@ let () =
 
 let failwith msg = fail (Failure msg)
 
-type big_map_diff_item = {
+type big_map_diff_item =
-  diff_key : Script_repr.expr;
+  | Update of {
-  diff_key_hash : Script_expr_hash.t;
+      big_map : Z.t;
-  diff_value : Script_repr.expr option;
+      diff_key : Script_repr.expr;
-}
+      diff_key_hash : Script_expr_hash.t;
+      diff_value : Script_repr.expr option;
+    }
+  | Clear of Z.t
+  | Copy of Z.t * Z.t
+  | Alloc of {
+      big_map : Z.t;
+      key_type : Script_repr.expr;
+      value_type : Script_repr.expr;
+    }
+
 type big_map_diff = big_map_diff_item list
 
 let big_map_diff_item_encoding =
   let open Data_encoding in
-  conv
+  union
-    (fun { diff_key_hash ; diff_key ; diff_value } -> (diff_key_hash, diff_key, diff_value))
+    [ case (Tag 0) ~title:"update"
-    (fun (diff_key_hash, diff_key, diff_value) -> { diff_key_hash ; diff_key ; diff_value })
+        (obj5
-    (obj3
+           (req "action" (constant "update"))
-       (req "key_hash" Script_expr_hash.encoding)
+           (req "big_map" z)
-       (req "key" Script_repr.expr_encoding)
+           (req "key_hash" Script_expr_hash.encoding)
-       (opt "value" Script_repr.expr_encoding))
+           (req "key" Script_repr.expr_encoding)
+           (opt "value" Script_repr.expr_encoding))
+        (function
+          | Update { big_map ; diff_key_hash ; diff_key ; diff_value } ->
+              Some ((), big_map, diff_key_hash, diff_key, diff_value)
+          | _ -> None )
+        (fun ((), big_map, diff_key_hash, diff_key, diff_value) ->
+           Update { big_map ; diff_key_hash ; diff_key ; diff_value }) ;
+      case (Tag 1) ~title:"remove"
+        (obj2
+           (req "action" (constant "remove"))
+           (req "big_map" z))
+        (function
+          | Clear big_map ->
+              Some ((), big_map)
+          | _ -> None )
+        (fun ((), big_map) ->
+           Clear big_map) ;
+      case (Tag 2) ~title:"copy"
+        (obj3
+           (req "action" (constant "copy"))
+           (req "source_big_map" z)
+           (req "destination_big_map" z))
+        (function
+          | Copy (src, dst) ->
+              Some ((), src, dst)
+          | _ -> None )
+        (fun ((), src, dst) ->
+           Copy (src, dst)) ;
+      case (Tag 3) ~title:"alloc"
+        (obj4
+           (req "action" (constant "alloc"))
+           (req "big_map" z)
+           (req "key_type" Script_repr.expr_encoding)
+           (req "value_type" Script_repr.expr_encoding))
+        (function
+          | Alloc { big_map ; key_type ; value_type } ->
+              Some ((), big_map, key_type, value_type)
+          | _ -> None )
+        (fun ((), big_map, key_type, value_type) ->
+           Alloc { big_map ; key_type ; value_type }) ]
 
 let big_map_diff_encoding =
   let open Data_encoding in
   def "contract.big_map_diff" @@
   list big_map_diff_item_encoding
 
-let update_script_big_map c contract = function
+let big_map_key_cost = 65
+let big_map_cost = 33
+
+let update_script_big_map c = function
   | None -> return (c, Z.zero)
   | Some diff ->
-      fold_left_s (fun (c, total) diff_item ->
+      fold_left_s (fun (c, total) -> function
-          match diff_item.diff_value with
+          | Clear id ->
-          | None ->
+              Storage.Big_map.Total_bytes.get c id >>=? fun size ->
-              Storage.Contract.Big_map.remove (c, contract) diff_item.diff_key_hash
+              Storage.Big_map.remove_rec c id >>= fun c ->
-              >>=? fun (c, freed) ->
+              if Compare.Z.(id < Z.zero) then
-              return (c, Z.sub total (Z.of_int freed))
+                return (c, total)
-          | Some v ->
+              else
-              Storage.Contract.Big_map.init_set (c, contract) diff_item.diff_key_hash v
+                return (c, Z.sub (Z.sub total size) (Z.of_int big_map_cost))
-              >>=? fun (c, size_diff) ->
+          | Copy (from, to_) ->
-              return (c, Z.add total (Z.of_int size_diff)))
+              Storage.Big_map.copy c ~from ~to_ >>=? fun c ->
+              if Compare.Z.(to_ < Z.zero) then
+                return (c, total)
+              else
+                Storage.Big_map.Total_bytes.get c from >>=? fun size ->
+                return (c, Z.add (Z.add total size) (Z.of_int big_map_cost))
+          | Alloc  { big_map ; key_type ; value_type } ->
+              Storage.Big_map.Total_bytes.init c big_map Z.zero >>=? fun c ->
+              (* Annotations are erased to allow sharing on
+                 [Copy]. The types from the contract code are used,
+                 these ones are only used to make sure they are
+                 compatible during transmissions between contracts,
+                 and only need to be compatible, annotations
+                 nonwhistanding. *)
+              let key_type = Micheline.strip_locations (Script_repr.strip_annotations (Micheline.root key_type)) in
+              let value_type = Micheline.strip_locations (Script_repr.strip_annotations (Micheline.root value_type)) in
+              Storage.Big_map.Key_type.init c big_map key_type >>=? fun c ->
+              Storage.Big_map.Value_type.init c big_map value_type >>=? fun c ->
+              if Compare.Z.(big_map < Z.zero) then
+                return (c, total)
+              else
+                return (c, Z.add total (Z.of_int big_map_cost))
+          | Update { big_map ; diff_key_hash ; diff_value = None } ->
+              Storage.Big_map.Contents.remove (c, big_map) diff_key_hash
+              >>=? fun (c, freed, existed) ->
+              let freed = if existed then freed + big_map_key_cost else freed in
+              Storage.Big_map.Total_bytes.get c big_map >>=? fun size ->
+              Storage.Big_map.Total_bytes.set c big_map (Z.sub size (Z.of_int freed)) >>=? fun c ->
+              if Compare.Z.(big_map < Z.zero) then
+                return (c, total)
+              else
+                return (c, Z.sub total (Z.of_int freed))
+          | Update { big_map ; diff_key_hash ; diff_value = Some v } ->
+              Storage.Big_map.Contents.init_set (c, big_map) diff_key_hash v
+              >>=? fun (c, size_diff, existed) ->
+              let size_diff = if existed then size_diff else size_diff + big_map_key_cost in
+              Storage.Big_map.Total_bytes.get c big_map >>=? fun size ->
+              Storage.Big_map.Total_bytes.set c big_map (Z.add size (Z.of_int size_diff)) >>=? fun c ->
+              if Compare.Z.(big_map < Z.zero) then
+                return (c, total)
+              else
+                return (c, Z.add total (Z.of_int size_diff)))
         (c, Z.zero) diff
 
 let create_base c
     ?(prepaid_bootstrap_storage=false) (* Free space for bootstrap contracts *)
     contract
-    ~balance ~manager ~delegate ?script ~spendable ~delegatable =
+    ~balance ~manager ~delegate ?script () =
-  (match Contract_repr.is_implicit contract with
+  begin match Contract_repr.is_implicit contract with
-   | None -> return Z.zero
+    | None -> return c
-   | Some _ -> Storage.Contract.Global_counter.get c) >>=? fun counter ->
+    | Some _ ->
+        Storage.Contract.Global_counter.get c >>=? fun counter ->
+        Storage.Contract.Counter.init c contract counter
+  end >>=? fun c ->
   Storage.Contract.Balance.init c contract balance >>=? fun c ->
-  Storage.Contract.Manager.init c contract (Manager_repr.Hash manager) >>=? fun c ->
+  begin match manager with
+    | Some manager ->
+        Storage.Contract.Manager.init c contract (Manager_repr.Hash manager)
+    | None -> return c
+  end >>=? fun c ->
   begin
     match delegate with
     | None -> return c
     | Some delegate ->
         Delegate_storage.init c contract delegate
   end >>=? fun c ->
-  Storage.Contract.Spendable.set c contract spendable >>= fun c ->
+  match script with
-  Storage.Contract.Delegatable.set c contract delegatable >>= fun c ->
+  | Some ({ Script_repr.code ; storage }, big_map_diff) ->
-  Storage.Contract.Counter.init c contract counter >>=? fun c ->
+      Storage.Contract.Code.init c contract code >>=? fun (c, code_size) ->
-  (match script with
+      Storage.Contract.Storage.init c contract storage >>=? fun (c, storage_size) ->
-   | Some ({ Script_repr.code ; storage }, big_map_diff) ->
+      update_script_big_map c big_map_diff >>=? fun (c, big_map_size) ->
-       Storage.Contract.Code.init c contract code >>=? fun (c, code_size) ->
+      let total_size = Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size)) big_map_size in
-       Storage.Contract.Storage.init c contract storage >>=? fun (c, storage_size) ->
+      assert Compare.Z.(total_size >= Z.zero) ;
-       update_script_big_map c contract big_map_diff >>=? fun (c, big_map_size) ->
+      let prepaid_bootstrap_storage =
-       let total_size = Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size)) big_map_size in
+        if prepaid_bootstrap_storage then
-       assert Compare.Z.(total_size >= Z.zero) ;
+          total_size
-       let prepaid_bootstrap_storage =
+        else
-         if prepaid_bootstrap_storage then
+          Z.zero
-           total_size
+      in
-         else
+      Storage.Contract.Paid_storage_space.init c contract prepaid_bootstrap_storage >>=? fun c ->
-           Z.zero
+      Storage.Contract.Used_storage_space.init c contract total_size
-       in
+  | None ->
-       Storage.Contract.Paid_storage_space.init c contract prepaid_bootstrap_storage >>=? fun c ->
+      return c
-       Storage.Contract.Used_storage_space.init c contract total_size
-   | None -> begin
-       match Contract_repr.is_implicit contract with
-       | None ->
-           Storage.Contract.Paid_storage_space.init c contract Z.zero >>=? fun c ->
-           Storage.Contract.Used_storage_space.init c contract Z.zero
-       | Some _ ->
-           return c
-     end >>=? fun c ->
-       return c) >>=? fun c ->
-  return c
 
 let originate c ?prepaid_bootstrap_storage contract
-    ~balance ~manager ?script ~delegate ~spendable ~delegatable =
+    ~balance ~script ~delegate =
-  create_base c ?prepaid_bootstrap_storage contract ~balance ~manager
+  create_base c ?prepaid_bootstrap_storage contract ~balance
-    ~delegate ?script ~spendable ~delegatable
+    ~manager:None ~delegate ~script ()
 
 let create_implicit c manager ~balance =
   create_base c (Contract_repr.implicit_contract manager)
-    ~balance ~manager ?script:None ~delegate:None
+    ~balance ~manager:(Some manager) ?script:None ~delegate:None ()
-    ~spendable:true ~delegatable:false
 
 let delete c contract =
   match Contract_repr.is_implicit contract with
@@ -302,17 +391,15 @@ let delete c contract =
       Delegate_storage.remove c contract >>=? fun c ->
       Storage.Contract.Balance.delete c contract >>=? fun c ->
       Storage.Contract.Manager.delete c contract >>=? fun c ->
-      Storage.Contract.Spendable.del c contract >>= fun c ->
-      Storage.Contract.Delegatable.del c contract >>= fun c ->
       Storage.Contract.Counter.delete c contract >>=? fun c ->
-      Storage.Contract.Code.remove c contract >>=? fun (c, _) ->
+      Storage.Contract.Code.remove c contract >>=? fun (c, _, _) ->
-      Storage.Contract.Storage.remove c contract >>=? fun (c, _) ->
+      Storage.Contract.Storage.remove c contract >>=? fun (c, _, _) ->
       Storage.Contract.Paid_storage_space.remove c contract >>= fun c ->
       Storage.Contract.Used_storage_space.remove c contract >>= fun c ->
       return c
 
 let allocated c contract =
-  Storage.Contract.Counter.get_option c contract >>=? function
+  Storage.Contract.Balance.get_option c contract >>=? function
   | None -> return_false
   | Some _ -> return_true
 
@@ -349,7 +436,8 @@ let originated_from_current_nonce ~since: ctxt_since ~until: ctxt_until =
        | false -> return_none)
     (Contract_repr.originated_contracts ~since ~until)
 
-let check_counter_increment c contract counter =
+let check_counter_increment c manager counter =
+  let contract = Contract_repr.implicit_contract manager in
   Storage.Contract.Counter.get c contract >>=? fun contract_counter ->
   let expected = Z.succ contract_counter in
   if Compare.Z.(expected = counter)
@@ -359,12 +447,16 @@ let check_counter_increment c contract counter =
   else
     fail (Counter_in_the_future (contract, expected, counter))
 
-let increment_counter c contract =
+let increment_counter c manager =
+  let contract = Contract_repr.implicit_contract manager in
   Storage.Contract.Global_counter.get c >>=? fun global_counter ->
   Storage.Contract.Global_counter.set c (Z.succ global_counter) >>=? fun c ->
   Storage.Contract.Counter.get c contract >>=? fun contract_counter ->
   Storage.Contract.Counter.set c contract (Z.succ contract_counter)
 
+let get_script_code c contract =
+  Storage.Contract.Code.get_option c contract
+
 let get_script c contract =
   Storage.Contract.Code.get_option c contract >>=? fun (c, code) ->
   Storage.Contract.Storage.get_option c contract >>=? fun (c, storage) ->
@@ -381,7 +473,8 @@ let get_storage ctxt contract =
       Lwt.return (Raw_context.consume_gas ctxt cost) >>=? fun ctxt ->
       return (ctxt, Some storage)
 
-let get_counter c contract =
+let get_counter c manager =
+  let contract = Contract_repr.implicit_contract manager in
   Storage.Contract.Counter.get_option c contract >>=? function
   | None -> begin
       match Contract_repr.is_implicit contract with
@@ -390,7 +483,7 @@ let get_counter c contract =
     end
   | Some v -> return v
 
-let get_manager c contract =
+let get_manager_004 c contract =
   Storage.Contract.Manager.get_option c contract >>=? function
   | None -> begin
       match Contract_repr.is_implicit contract with
@@ -400,19 +493,22 @@ let get_manager c contract =
   | Some (Manager_repr.Hash v) -> return v
   | Some (Manager_repr.Public_key v) -> return (Signature.Public_key.hash v)
 
-let get_manager_key c contract =
+let get_manager_key c manager =
+  let contract = Contract_repr.implicit_contract manager in
   Storage.Contract.Manager.get_option c contract >>=? function
   | None -> failwith "get_manager_key"
   | Some (Manager_repr.Hash _) -> fail (Unrevealed_manager_key contract)
   | Some (Manager_repr.Public_key v) -> return v
 
-let is_manager_key_revealed c contract =
+let is_manager_key_revealed c manager =
+  let contract = Contract_repr.implicit_contract manager in
   Storage.Contract.Manager.get_option c contract >>=? function
   | None -> return_false
   | Some (Manager_repr.Hash _) -> return_false
   | Some (Manager_repr.Public_key _) -> return_true
 
-let reveal_manager_key c contract public_key =
+let reveal_manager_key c manager public_key =
+  let contract = Contract_repr.implicit_contract manager in
   Storage.Contract.Manager.get c contract >>=? function
   | Public_key _ -> fail (Previously_revealed_key contract)
   | Hash v ->
@@ -432,22 +528,15 @@ let get_balance c contract =
     end
   | Some v -> return v
 
-let is_delegatable = Delegate_storage.is_delegatable
-let is_spendable c contract =
-  match Contract_repr.is_implicit contract with
-  | Some _ -> return_true
-  | None ->
-      Storage.Contract.Spendable.mem c contract >>= return
-
 let update_script_storage c contract storage big_map_diff =
   let storage = Script_repr.lazy_expr storage in
-  update_script_big_map c contract big_map_diff >>=? fun (c, big_map_size_diff) ->
+  update_script_big_map c big_map_diff >>=? fun (c, big_map_size_diff) ->
   Storage.Contract.Storage.set c contract storage >>=? fun (c, size_diff) ->
   Storage.Contract.Used_storage_space.get c contract >>=? fun previous_size ->
   let new_size = Z.add previous_size (Z.add big_map_size_diff (Z.of_int size_diff)) in
   Storage.Contract.Used_storage_space.set c contract new_size
 
-let spend_from_script c contract amount =
+let spend c contract amount =
   Storage.Contract.Balance.get c contract >>=? fun balance ->
   match Tez_repr.(balance -? amount) with
   | Error _ ->
@@ -490,12 +579,6 @@ let credit c contract amount =
       Storage.Contract.Balance.set c contract balance >>=? fun c ->
       Roll_storage.Contract.add_amount c contract amount
 
-let spend c contract amount =
-  is_spendable c contract >>=? fun spendable ->
-  if not spendable
-  then fail (Unspendable_contract contract)
-  else spend_from_script c contract amount
-
 let init c =
   Storage.Contract.Global_counter.init c Z.zero
 
@@ -517,10 +600,3 @@ let set_paid_storage_space_and_return_fees_to_pay c contract new_storage_space =
     let to_pay = Z.sub new_storage_space already_paid_space in
     Storage.Contract.Paid_storage_space.set c contract new_storage_space >>=? fun c ->
     return (to_pay, c)
-
-module Big_map = struct
-  let mem ctxt contract key =
-    Storage.Contract.Big_map.mem (ctxt, contract) key
-  let get_opt ctxt contract key =
-    Storage.Contract.Big_map.get_option (ctxt, contract) key
-end

vendors/ligo-utils/tezos-protocol-alpha/contract_storage.mli

@@ -47,42 +47,49 @@ val must_be_allocated: Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t
 val list: Raw_context.t -> Contract_repr.t list Lwt.t
 
 val check_counter_increment:
-  Raw_context.t -> Contract_repr.t -> Z.t -> unit tzresult Lwt.t
+  Raw_context.t -> Signature.Public_key_hash.t -> Z.t -> unit tzresult Lwt.t
 
 val increment_counter:
-  Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t
+  Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t
 
-val is_delegatable:
+val get_manager_004:
-  Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
-
-val is_spendable: Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
-
-val get_manager:
   Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t tzresult Lwt.t
 
 val get_manager_key:
-  Raw_context.t -> Contract_repr.t -> Signature.Public_key.t tzresult Lwt.t
+  Raw_context.t -> Signature.Public_key_hash.t -> Signature.Public_key.t tzresult Lwt.t
 val is_manager_key_revealed:
-  Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
+  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
 
 val reveal_manager_key:
-  Raw_context.t -> Contract_repr.t -> Signature.Public_key.t  ->
+  Raw_context.t -> Signature.Public_key_hash.t -> Signature.Public_key.t  ->
   Raw_context.t tzresult Lwt.t
 
 val get_balance: Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
-val get_counter: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
+val get_counter: Raw_context.t -> Signature.Public_key_hash.t -> Z.t tzresult Lwt.t
 
+val get_script_code:
+  Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.lazy_expr option) tzresult Lwt.t
 val get_script:
   Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.t option) tzresult Lwt.t
 val get_storage:
   Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
 
 
-type big_map_diff_item = {
+type big_map_diff_item =
-  diff_key : Script_repr.expr;
+  | Update of {
-  diff_key_hash : Script_expr_hash.t;
+      big_map : Z.t ;
-  diff_value : Script_repr.expr option;
+      diff_key : Script_repr.expr;
-}
+      diff_key_hash : Script_expr_hash.t;
+      diff_value : Script_repr.expr option;
+    }
+  | Clear of Z.t
+  | Copy of Z.t * Z.t
+  | Alloc of {
+      big_map : Z.t;
+      key_type : Script_repr.expr;
+      value_type : Script_repr.expr;
+    }
+
 type big_map_diff = big_map_diff_item list
 
 val big_map_diff_encoding : big_map_diff Data_encoding.t
@@ -96,26 +103,17 @@ val credit:
   Raw_context.t -> Contract_repr.t -> Tez_repr.t ->
   Raw_context.t tzresult Lwt.t
 
-(** checks that the contract is spendable and decrease_balance *)
 val spend:
   Raw_context.t -> Contract_repr.t -> Tez_repr.t ->
   Raw_context.t tzresult Lwt.t
 
-(** decrease_balance even if the contract is not spendable *)
-val spend_from_script:
-  Raw_context.t -> Contract_repr.t -> Tez_repr.t ->
-  Raw_context.t tzresult Lwt.t
-
 val originate:
   Raw_context.t ->
   ?prepaid_bootstrap_storage:bool ->
   Contract_repr.t ->
   balance:Tez_repr.t ->
-  manager:Signature.Public_key_hash.t ->
+  script:(Script_repr.t * big_map_diff option) ->
-  ?script:(Script_repr.t * big_map_diff option) ->
   delegate:Signature.Public_key_hash.t option ->
-  spendable:bool ->
-  delegatable:bool ->
   Raw_context.t tzresult Lwt.t
 
 val fresh_contract_from_current_nonce :
@@ -131,10 +129,3 @@ val init:
 val used_storage_space: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
 val paid_storage_space: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
 val set_paid_storage_space_and_return_fees_to_pay: Raw_context.t -> Contract_repr.t -> Z.t -> (Z.t * Raw_context.t) tzresult Lwt.t
-
-module Big_map : sig
-  val mem :
-    Raw_context.t -> Contract_repr.t -> Script_expr_hash.t -> (Raw_context.t * bool) tzresult Lwt.t
-  val get_opt :
-    Raw_context.t -> Contract_repr.t -> Script_expr_hash.t -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
-end

vendors/ligo-utils/tezos-protocol-alpha/delegate_services.ml

@@ -30,7 +30,7 @@ type info = {
   frozen_balance: Tez.t ;
   frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ;
   staking_balance: Tez.t ;
-  delegated_contracts: Contract_hash.t list ;
+  delegated_contracts: Contract_repr.t list ;
   delegated_balance: Tez.t ;
   deactivated: bool ;
   grace_period: Cycle.t ;
@@ -56,7 +56,7 @@ let info_encoding =
        (req "frozen_balance" Tez.encoding)
        (req "frozen_balance_by_cycle" Delegate.frozen_balance_by_cycle_encoding)
        (req "staking_balance" Tez.encoding)
-       (req "delegated_contracts" (list Contract_hash.encoding))
+       (req "delegated_contracts" (list Contract_repr.encoding))
        (req "delegated_balance" Tez.encoding)
        (req "deactivated" bool)
        (req "grace_period" Cycle.encoding))
@@ -140,7 +140,7 @@ module S = struct
       ~description:
         "Returns the list of contracts that delegate to a given delegate."
       ~query: RPC_query.empty
-      ~output: (list Contract_hash.encoding)
+      ~output: (list Contract_repr.encoding)
       RPC_path.(path / "delegated_contracts")
 
   let delegated_balance =
@@ -281,7 +281,7 @@ let requested_levels ~default ctxt cycles levels =
           Level.compare
           (List.concat (List.map (Level.from_raw ctxt) levels ::
                         List.map (Level.levels_in_cycle ctxt) cycles)) in
-      map_p
+      map_s
         (fun level ->
            let current_level = Level.current ctxt in
            if Level.(level <= current_level) then
@@ -410,7 +410,7 @@ module Baking_rights = struct
         match q.max_priority with
         | None -> 64
         | Some max -> max in
-      map_p (baking_priorities ctxt max_priority) levels >>=? fun rights ->
+      map_s (baking_priorities ctxt max_priority) levels >>=? fun rights ->
       let rights =
         if q.all then
           rights
@@ -516,7 +516,7 @@ module Endorsing_rights = struct
       requested_levels
         ~default: (Level.current ctxt, Some (Timestamp.current ctxt))
         ctxt q.cycles q.levels >>=? fun levels ->
-      map_p (endorsement_slots ctxt) levels >>=? fun rights ->
+      map_s (endorsement_slots ctxt) levels >>=? fun rights ->
       let rights = List.concat rights in
       match q.delegates with
       | [] -> return rights
@@ -534,10 +534,128 @@ module Endorsing_rights = struct
 
 end
 
+module Endorsing_power = struct
+
+  let endorsing_power ctxt (operation, chain_id) =
+    let Operation_data data = operation.protocol_data in
+    match data.contents with
+    | Single Endorsement _ ->
+        Baking.check_endorsement_rights ctxt chain_id {
+          shell = operation.shell ;
+          protocol_data = data ;
+        } >>=? fun (_, slots, _) ->
+        return (List.length slots)
+    | _ ->
+        failwith "Operation is not an endorsement"
+
+  module S = struct
+    let endorsing_power =
+      let open Data_encoding in
+      RPC_service.post_service
+        ~description:"Get the endorsing power of an endorsement, that is, \
+                      the number of slots that the endorser has"
+        ~query: RPC_query.empty
+        ~input: (obj2
+                   (req "endorsement_operation" Operation.encoding)
+                   (req "chain_id" Chain_id.encoding))
+        ~output: int31
+        RPC_path.(open_root / "endorsing_power")
+  end
+
+  let register () =
+    let open Services_registration in
+    register0 S.endorsing_power begin fun ctxt () (op, chain_id) ->
+      endorsing_power ctxt (op, chain_id)
+    end
+
+  let get ctxt block op chain_id =
+    RPC_context.make_call0 S.endorsing_power ctxt block () (op, chain_id)
+
+end
+
+module Required_endorsements = struct
+
+  let required_endorsements ctxt block_delay =
+    return (Baking.minimum_allowed_endorsements ctxt ~block_delay)
+
+  module S = struct
+
+    type t = { block_delay : Period.t }
+
+    let required_endorsements_query =
+      let open RPC_query in
+      query (fun block_delay -> { block_delay })
+      |+ field "block_delay" Period.rpc_arg Period.zero (fun t -> t.block_delay)
+      |> seal
+
+    let required_endorsements =
+      let open Data_encoding in
+      RPC_service.get_service
+        ~description:"Minimum number of endorsements for a block to be \
+                      valid, given a delay of the block's timestamp with \
+                      respect to the minimum time to bake at the \
+                      block's priority"
+        ~query: required_endorsements_query
+        ~output: int31
+        RPC_path.(open_root / "required_endorsements")
+  end
+
+  let register () =
+    let open Services_registration in
+    register0 S.required_endorsements begin fun ctxt ({ block_delay }) () ->
+      required_endorsements ctxt block_delay
+    end
+
+  let get ctxt block block_delay =
+    RPC_context.make_call0 S.required_endorsements ctxt block { block_delay } ()
+
+end
+
+module Minimal_valid_time = struct
+
+  let minimal_valid_time ctxt ~priority ~endorsing_power =
+    Baking.minimal_valid_time ctxt
+      ~priority ~endorsing_power
+
+  module S = struct
+
+    type t = { priority : int ;
+               endorsing_power : int }
+
+    let minimal_valid_time_query =
+      let open RPC_query in
+      query (fun priority endorsing_power ->
+          {  priority ; endorsing_power })
+      |+ field "priority" RPC_arg.int 0 (fun t -> t.priority)
+      |+ field "endorsing_power" RPC_arg.int 0 (fun t -> t.endorsing_power)
+      |> seal
+
+    let minimal_valid_time =
+      RPC_service.get_service
+        ~description: "Minimal valid time for a block given a priority \
+                       and an endorsing power."
+        ~query: minimal_valid_time_query
+        ~output: Time.encoding
+        RPC_path.(open_root / "minimal_valid_time")
+  end
+
+  let register () =
+    let open Services_registration in
+    register0 S.minimal_valid_time begin fun ctxt { priority ; endorsing_power } () ->
+      minimal_valid_time ctxt ~priority ~endorsing_power
+    end
+
+  let get ctxt block priority endorsing_power =
+    RPC_context.make_call0 S.minimal_valid_time ctxt block { priority ; endorsing_power } ()
+end
+
 let register () =
   register () ;
   Baking_rights.register () ;
-  Endorsing_rights.register ()
+  Endorsing_rights.register () ;
+  Endorsing_power.register () ;
+  Required_endorsements.register () ;
+  Minimal_valid_time.register ()
 
 let endorsement_rights ctxt level =
   Endorsing_rights.endorsement_slots ctxt (level, None) >>=? fun l ->
@@ -551,3 +669,12 @@ let baking_rights ctxt max_priority =
           List.map
             (fun { Baking_rights.delegate ; timestamp ; _ } ->
                (delegate, timestamp)) l)
+
+let endorsing_power ctxt operation =
+  Endorsing_power.endorsing_power ctxt operation
+
+let required_endorsements ctxt delay =
+  Required_endorsements.required_endorsements ctxt delay
+
+let minimal_valid_time ctxt priority endorsing_power =
+  Minimal_valid_time.minimal_valid_time ctxt priority endorsing_power

vendors/ligo-utils/tezos-protocol-alpha/delegate_services.mli

@@ -36,7 +36,7 @@ type info = {
   frozen_balance: Tez.t ;
   frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ;
   staking_balance: Tez.t ;
-  delegated_contracts: Contract_hash.t list ;
+  delegated_contracts: Contract_repr.t list ;
   delegated_balance: Tez.t ;
   deactivated: bool ;
   grace_period: Cycle.t ;
@@ -72,7 +72,7 @@ val staking_balance:
 val delegated_contracts:
   'a #RPC_context.simple -> 'a ->
   Signature.Public_key_hash.t ->
-  Contract_hash.t list shell_tzresult Lwt.t
+  Contract_repr.t list shell_tzresult Lwt.t
 
 val delegated_balance:
   'a #RPC_context.simple -> 'a ->
@@ -162,6 +162,32 @@ module Endorsing_rights : sig
 
 end
 
+module Endorsing_power : sig
+
+  val get:
+    'a #RPC_context.simple -> 'a ->
+    Alpha_context.packed_operation ->
+    Chain_id.t ->
+    int shell_tzresult Lwt.t
+
+end
+
+module Required_endorsements : sig
+
+  val get:
+    'a #RPC_context.simple -> 'a ->
+    Period.t -> int shell_tzresult Lwt.t
+
+end
+
+module Minimal_valid_time : sig
+
+  val get:
+    'a #RPC_context.simple -> 'a ->
+    int -> int -> Time.t shell_tzresult Lwt.t
+
+end
+
 (* temporary export for deprecated unit test *)
 val endorsement_rights:
   Alpha_context.t ->
@@ -173,4 +199,20 @@ val baking_rights:
   int option ->
   (Raw_level.t * (public_key_hash * Time.t option) list) tzresult Lwt.t
 
+val endorsing_power:
+  Alpha_context.t ->
+  (Alpha_context.packed_operation * Chain_id.t) ->
+  int tzresult Lwt.t
+
+val required_endorsements:
+  Alpha_context.t ->
+  Alpha_context.Period.t ->
+  int tzresult Lwt.t
+
+val minimal_valid_time:
+  Alpha_context.t ->
+  int ->
+  int ->
+  Time.t tzresult Lwt.t
+
 val register: unit -> unit

vendors/ligo-utils/tezos-protocol-alpha/delegate_storage.ml

@@ -123,7 +123,6 @@ let frozen_balance_encoding =
        (req "rewards" Tez_repr.encoding))
 
 type error +=
-  | Non_delegatable_contract of Contract_repr.contract (* `Permanent *)
   | No_deletion of Signature.Public_key_hash.t (* `Permanent *)
   | Active_delegate (* `Temporary *)
   | Current_delegate (* `Temporary *)
@@ -134,18 +133,6 @@ type error +=
         balance : Tez_repr.t } (* `Temporary *)
 
 let () =
-  register_error_kind
-    `Permanent
-    ~id:"contract.undelegatable_contract"
-    ~title:"Non delegatable contract"
-    ~description:"Tried to delegate an implicit contract \
-                  or a non delegatable originated contract"
-    ~pp:(fun ppf contract ->
-        Format.fprintf ppf "Contract %a is not delegatable"
-          Contract_repr.pp contract)
-    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
-    (function Non_delegatable_contract c -> Some c | _ -> None)
-    (fun c -> Non_delegatable_contract c) ;
   register_error_kind
     `Permanent
     ~id:"delegate.no_deletion"
@@ -212,33 +199,21 @@ let () =
        Some (delegate, balance, deposit) | _ -> None)
     (fun (delegate, balance, deposit) -> Balance_too_low_for_deposit { delegate ; balance ; deposit } )
 
-let is_delegatable c contract =
+let link c contract delegate =
-  match Contract_repr.is_implicit contract with
+  Storage.Contract.Balance.get c contract >>=? fun balance ->
-  | Some _ ->
-      return_false
-  | None ->
-      Storage.Contract.Delegatable.mem c contract >>= return
-
-let link c contract delegate balance =
   Roll_storage.Delegate.add_amount c delegate balance >>=? fun c ->
-  match Contract_repr.is_originated contract with
+  Storage.Contract.Delegated.add (c, Contract_repr.implicit_contract delegate) contract >>= fun c ->
-  | None -> return c
+  return c
-  | Some h ->
-      Storage.Contract.Delegated.add
-        (c, Contract_repr.implicit_contract delegate) h >>= fun c ->
-      return c
 
-let unlink c contract balance =
+let unlink c contract =
+  Storage.Contract.Balance.get c contract >>=? fun balance ->
   Storage.Contract.Delegate.get_option c contract >>=? function
   | None -> return c
   | Some delegate ->
+      (* Removes the balance of the contract from the delegate *)
       Roll_storage.Delegate.remove_amount c delegate balance >>=? fun c ->
-      match Contract_repr.is_originated contract with
+      Storage.Contract.Delegated.del (c, Contract_repr.implicit_contract delegate) contract >>= fun c ->
-      | None -> return c
+      return c
-      | Some h ->
-          Storage.Contract.Delegated.del
-            (c, Contract_repr.implicit_contract delegate) h >>= fun c ->
-          return c
 
 let known c delegate =
   Storage.Contract.Manager.get_option
@@ -246,55 +221,55 @@ let known c delegate =
   | None | Some (Manager_repr.Hash _) -> return_false
   | Some (Manager_repr.Public_key _) -> return_true
 
-(* A delegate is registered if its "implicit account"
+(* A delegate is registered if its "implicit account" delegates to itself. *)
-   delegates to itself. *)
 let registered c delegate =
-  Storage.Contract.Delegate.mem
+  Storage.Contract.Delegate.get_option
-    c (Contract_repr.implicit_contract delegate)
+    c (Contract_repr.implicit_contract delegate) >>=? function
+  | Some current_delegate ->
+      return @@ Signature.Public_key_hash.equal delegate current_delegate
+  | None ->
+      return_false
 
 let init ctxt contract delegate =
   known ctxt delegate >>=? fun known_delegate ->
   fail_unless
     known_delegate
     (Roll_storage.Unregistered_delegate delegate) >>=? fun () ->
-  registered ctxt delegate >>= fun is_registered ->
+  registered ctxt delegate >>=? fun is_registered ->
   fail_unless
     is_registered
     (Roll_storage.Unregistered_delegate delegate) >>=? fun () ->
   Storage.Contract.Delegate.init ctxt contract delegate >>=? fun ctxt ->
-  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
+  link ctxt contract delegate
-  link ctxt contract delegate balance
 
 let get = Roll_storage.get_contract_delegate
 
-let set_base c is_delegatable contract delegate =
+let set c contract delegate =
   match delegate with
   | None -> begin
+      let delete () =
+        unlink c contract >>=? fun c ->
+        Storage.Contract.Delegate.remove c contract >>= fun c ->
+        return c in
       match Contract_repr.is_implicit contract with
       | Some pkh ->
-          fail (No_deletion pkh)
+          (* check if contract is a registered delegate *)
-      | None ->
+          registered c pkh >>=? fun is_registered ->
-          is_delegatable c contract >>=? fun delegatable ->
+          if is_registered then
-          if delegatable then
+            fail (No_deletion pkh)
-            Storage.Contract.Balance.get c contract >>=? fun balance ->
-            unlink c contract balance >>=? fun c ->
-            Storage.Contract.Delegate.remove c contract >>= fun c ->
-            return c
           else
-            fail (Non_delegatable_contract contract)
+            delete ()
+      | None -> delete ()
     end
   | Some delegate ->
       known c delegate >>=? fun known_delegate ->
-      registered c delegate >>= fun registered_delegate ->
+      registered c delegate >>=? fun registered_delegate ->
-      is_delegatable c contract >>=? fun delegatable ->
       let self_delegation =
         match Contract_repr.is_implicit contract with
         | Some pkh -> Signature.Public_key_hash.equal pkh delegate
         | None -> false in
       if not known_delegate || not (registered_delegate || self_delegation) then
         fail (Roll_storage.Unregistered_delegate delegate)
-      else if not (delegatable || self_delegation) then
-        fail (Non_delegatable_contract contract)
       else
         begin
           Storage.Contract.Delegate.get_option c contract >>=? function
@@ -308,14 +283,26 @@ let set_base c is_delegatable contract delegate =
                 fail Current_delegate
           | None | Some _ -> return_unit
         end >>=? fun () ->
+        (* check if contract is a registered delegate *)
+        begin
+          match Contract_repr.is_implicit contract with
+          | Some pkh ->
+              registered c pkh >>=? fun is_registered ->
+              (* allow self-delegation to re-activate *)
+              if not self_delegation && is_registered then
+                fail (No_deletion pkh)
+              else
+                return_unit
+          | None ->
+              return_unit
+        end >>=? fun () ->
         Storage.Contract.Balance.mem c contract >>= fun exists ->
         fail_when
           (self_delegation && not exists)
           (Empty_delegate_account delegate) >>=? fun () ->
-        Storage.Contract.Balance.get c contract >>=? fun balance ->
+        unlink c contract >>=? fun c ->
-        unlink c contract balance >>=? fun c ->
         Storage.Contract.Delegate.init_set c contract delegate >>= fun c ->
-        link c contract delegate balance >>=? fun c ->
+        link c contract delegate >>=? fun c ->
         begin
           if self_delegation then
             Storage.Delegates.add c delegate >>= fun c ->
@@ -326,15 +313,8 @@ let set_base c is_delegatable contract delegate =
         end >>=? fun c ->
         return c
 
-let set c contract delegate =
-  set_base c is_delegatable contract delegate
-
-let set_from_script c contract delegate =
-  set_base c (fun _ _ -> return_true) contract delegate
-
 let remove ctxt contract =
-  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
+  unlink ctxt contract
-  unlink ctxt contract balance
 
 let delegated_contracts ctxt delegate =
   let contract = Contract_repr.implicit_contract delegate in

vendors/ligo-utils/tezos-protocol-alpha/delegate_storage.mli

@@ -49,10 +49,6 @@ type frozen_balance = {
   rewards : Tez_repr.t ;
 }
 
-(** Is the contract eligible to delegation ? *)
-val is_delegatable:
-  Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
-
 (** Allow to register a delegate when creating an account. *)
 val init:
   Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t ->
@@ -67,26 +63,19 @@ val get:
   Raw_context.t -> Contract_repr.t ->
   Signature.Public_key_hash.t option tzresult Lwt.t
 
-val registered: Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t
+val registered: Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
 
 (** Updating the delegate of a contract.
 
-    When calling this function on an "implicit contract" this function
+    When calling this function on an "implicit contract" and setting
-    fails, unless when the registered delegate is the contract manager.
+    the delegate to the contract manager registers it as a delegate. One
-    In the that case, the manager is now registered as a delegate. One
+    cannot unregister a delegate for now. The associate contract is now
-    cannot unregister a delegate for now. The associate contract is
+    'undeletable'. *)
-    now 'undeletable'. *)
 val set:
   Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t option ->
   Raw_context.t tzresult Lwt.t
 
-(** Same as {!set} ignoring the [delegatable] flag. *)
-val set_from_script:
-  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t option ->
-  Raw_context.t tzresult Lwt.t
-
 type error +=
-  | Non_delegatable_contract of Contract_repr.contract (* `Permanent *)
   | No_deletion of Signature.Public_key_hash.t (* `Permanent *)
   | Active_delegate (* `Temporary *)
   | Current_delegate (* `Temporary *)
@@ -169,10 +158,10 @@ val staking_balance:
   Raw_context.t -> Signature.Public_key_hash.t ->
   Tez_repr.t tzresult Lwt.t
 
-(** Returns the list of contract that delegated towards a given delegate *)
+(** Returns the list of contracts (implicit or originated) that delegated towards a given delegate *)
 val delegated_contracts:
   Raw_context.t -> Signature.Public_key_hash.t ->
-  Contract_hash.t list Lwt.t
+  Contract_repr.t list Lwt.t
 
 val delegated_balance:
   Raw_context.t -> Signature.Public_key_hash.t ->

vendors/ligo-utils/tezos-protocol-alpha/dune.inc

@@ -11,22 +11,22 @@
  (targets environment.ml)
  (action
   (write-file %{targets}
-              "module Name = struct let name = \"alpha\" end
+              "module Name = struct let name = \"005-PsBabyM1\" end
 include Tezos_protocol_environment.MakeV1(Name)()
 module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end
 ")))
 
 (rule
  (targets registerer.ml)
- (deps misc.mli misc.ml storage_description.mli storage_description.ml state_hash.ml nonce_hash.ml script_expr_hash.ml contract_hash.ml blinded_public_key_hash.mli blinded_public_key_hash.ml qty_repr.ml tez_repr.mli tez_repr.ml period_repr.mli period_repr.ml time_repr.mli time_repr.ml constants_repr.ml fitness_repr.ml raw_level_repr.mli raw_level_repr.ml voting_period_repr.mli voting_period_repr.ml cycle_repr.mli cycle_repr.ml level_repr.mli level_repr.ml seed_repr.mli seed_repr.ml gas_limit_repr.mli gas_limit_repr.ml script_int_repr.mli script_int_repr.ml script_timestamp_repr.mli script_timestamp_repr.ml michelson_v1_primitives.mli michelson_v1_primitives.ml script_repr.mli script_repr.ml contract_repr.mli contract_repr.ml roll_repr.mli roll_repr.ml vote_repr.mli vote_repr.ml block_header_repr.mli block_header_repr.ml operation_repr.mli operation_repr.ml manager_repr.mli manager_repr.ml commitment_repr.mli commitment_repr.ml parameters_repr.mli parameters_repr.ml raw_context.mli raw_context.ml storage_sigs.ml storage_functors.mli storage_functors.ml storage.mli storage.ml constants_storage.ml level_storage.mli level_storage.ml nonce_storage.mli nonce_storage.ml seed_storage.mli seed_storage.ml roll_storage.mli roll_storage.ml delegate_storage.mli delegate_storage.ml contract_storage.mli contract_storage.ml bootstrap_storage.mli bootstrap_storage.ml fitness_storage.ml vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml init_storage.ml fees_storage.mli fees_storage.ml alpha_context.mli alpha_context.ml script_typed_ir.ml script_tc_errors.ml michelson_v1_gas.mli michelson_v1_gas.ml script_ir_annot.mli script_ir_annot.ml script_ir_translator.mli script_ir_translator.ml script_tc_errors_registration.ml script_interpreter.mli script_interpreter.ml baking.mli baking.ml amendment.mli amendment.ml apply_results.mli apply_results.ml apply.ml services_registration.ml constants_services.mli constants_services.ml contract_services.mli contract_services.ml delegate_services.mli delegate_services.ml helpers_services.mli helpers_services.ml voting_services.mli voting_services.ml alpha_services.mli alpha_services.ml main.mli main.ml
+ (deps misc.mli misc.ml storage_description.mli storage_description.ml state_hash.ml nonce_hash.ml script_expr_hash.ml contract_hash.ml blinded_public_key_hash.mli blinded_public_key_hash.ml qty_repr.ml tez_repr.mli tez_repr.ml period_repr.mli period_repr.ml time_repr.mli time_repr.ml constants_repr.ml fitness_repr.ml raw_level_repr.mli raw_level_repr.ml voting_period_repr.mli voting_period_repr.ml cycle_repr.mli cycle_repr.ml level_repr.mli level_repr.ml seed_repr.mli seed_repr.ml gas_limit_repr.mli gas_limit_repr.ml script_int_repr.mli script_int_repr.ml script_timestamp_repr.mli script_timestamp_repr.ml michelson_v1_primitives.mli michelson_v1_primitives.ml script_repr.mli script_repr.ml legacy_script_support_repr.mli legacy_script_support_repr.ml contract_repr.mli contract_repr.ml roll_repr.mli roll_repr.ml vote_repr.mli vote_repr.ml block_header_repr.mli block_header_repr.ml operation_repr.mli operation_repr.ml manager_repr.mli manager_repr.ml commitment_repr.mli commitment_repr.ml parameters_repr.mli parameters_repr.ml raw_context.mli raw_context.ml storage_sigs.ml storage_functors.mli storage_functors.ml storage.mli storage.ml constants_storage.ml level_storage.mli level_storage.ml nonce_storage.mli nonce_storage.ml seed_storage.mli seed_storage.ml roll_storage.mli roll_storage.ml delegate_storage.mli delegate_storage.ml contract_storage.mli contract_storage.ml bootstrap_storage.mli bootstrap_storage.ml fitness_storage.ml vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml init_storage.ml fees_storage.mli fees_storage.ml alpha_context.mli alpha_context.ml script_typed_ir.ml script_tc_errors.ml michelson_v1_gas.mli michelson_v1_gas.ml script_ir_annot.mli script_ir_annot.ml script_ir_translator.mli script_ir_translator.ml script_tc_errors_registration.ml script_interpreter.mli script_interpreter.ml baking.mli baking.ml amendment.mli amendment.ml apply_results.mli apply_results.ml apply.ml services_registration.ml constants_services.mli constants_services.ml contract_services.mli contract_services.ml delegate_services.mli delegate_services.ml helpers_services.mli helpers_services.ml voting_services.mli voting_services.ml alpha_services.mli alpha_services.ml main.mli main.ml
        (:src_dir TEZOS_PROTOCOL))
  (action
   (with-stdout-to %{targets}
-                  (chdir %{workspace_root} (run %{bin:tezos-embedded-protocol-packer} "%{src_dir}" "alpha")))))
+                  (chdir %{workspace_root} (run %{bin:tezos-embedded-protocol-packer} "%{src_dir}" "005_PsBabyM1")))))
 
 (rule
  (targets functor.ml)
- (deps misc.mli misc.ml storage_description.mli storage_description.ml state_hash.ml nonce_hash.ml script_expr_hash.ml contract_hash.ml blinded_public_key_hash.mli blinded_public_key_hash.ml qty_repr.ml tez_repr.mli tez_repr.ml period_repr.mli period_repr.ml time_repr.mli time_repr.ml constants_repr.ml fitness_repr.ml raw_level_repr.mli raw_level_repr.ml voting_period_repr.mli voting_period_repr.ml cycle_repr.mli cycle_repr.ml level_repr.mli level_repr.ml seed_repr.mli seed_repr.ml gas_limit_repr.mli gas_limit_repr.ml script_int_repr.mli script_int_repr.ml script_timestamp_repr.mli script_timestamp_repr.ml michelson_v1_primitives.mli michelson_v1_primitives.ml script_repr.mli script_repr.ml contract_repr.mli contract_repr.ml roll_repr.mli roll_repr.ml vote_repr.mli vote_repr.ml block_header_repr.mli block_header_repr.ml operation_repr.mli operation_repr.ml manager_repr.mli manager_repr.ml commitment_repr.mli commitment_repr.ml parameters_repr.mli parameters_repr.ml raw_context.mli raw_context.ml storage_sigs.ml storage_functors.mli storage_functors.ml storage.mli storage.ml constants_storage.ml level_storage.mli level_storage.ml nonce_storage.mli nonce_storage.ml seed_storage.mli seed_storage.ml roll_storage.mli roll_storage.ml delegate_storage.mli delegate_storage.ml contract_storage.mli contract_storage.ml bootstrap_storage.mli bootstrap_storage.ml fitness_storage.ml vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml init_storage.ml fees_storage.mli fees_storage.ml alpha_context.mli alpha_context.ml script_typed_ir.ml script_tc_errors.ml michelson_v1_gas.mli michelson_v1_gas.ml script_ir_annot.mli script_ir_annot.ml script_ir_translator.mli script_ir_translator.ml script_tc_errors_registration.ml script_interpreter.mli script_interpreter.ml baking.mli baking.ml amendment.mli amendment.ml apply_results.mli apply_results.ml apply.ml services_registration.ml constants_services.mli constants_services.ml contract_services.mli contract_services.ml delegate_services.mli delegate_services.ml helpers_services.mli helpers_services.ml voting_services.mli voting_services.ml alpha_services.mli alpha_services.ml main.mli main.ml
+ (deps misc.mli misc.ml storage_description.mli storage_description.ml state_hash.ml nonce_hash.ml script_expr_hash.ml contract_hash.ml blinded_public_key_hash.mli blinded_public_key_hash.ml qty_repr.ml tez_repr.mli tez_repr.ml period_repr.mli period_repr.ml time_repr.mli time_repr.ml constants_repr.ml fitness_repr.ml raw_level_repr.mli raw_level_repr.ml voting_period_repr.mli voting_period_repr.ml cycle_repr.mli cycle_repr.ml level_repr.mli level_repr.ml seed_repr.mli seed_repr.ml gas_limit_repr.mli gas_limit_repr.ml script_int_repr.mli script_int_repr.ml script_timestamp_repr.mli script_timestamp_repr.ml michelson_v1_primitives.mli michelson_v1_primitives.ml script_repr.mli script_repr.ml legacy_script_support_repr.mli legacy_script_support_repr.ml contract_repr.mli contract_repr.ml roll_repr.mli roll_repr.ml vote_repr.mli vote_repr.ml block_header_repr.mli block_header_repr.ml operation_repr.mli operation_repr.ml manager_repr.mli manager_repr.ml commitment_repr.mli commitment_repr.ml parameters_repr.mli parameters_repr.ml raw_context.mli raw_context.ml storage_sigs.ml storage_functors.mli storage_functors.ml storage.mli storage.ml constants_storage.ml level_storage.mli level_storage.ml nonce_storage.mli nonce_storage.ml seed_storage.mli seed_storage.ml roll_storage.mli roll_storage.ml delegate_storage.mli delegate_storage.ml contract_storage.mli contract_storage.ml bootstrap_storage.mli bootstrap_storage.ml fitness_storage.ml vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml init_storage.ml fees_storage.mli fees_storage.ml alpha_context.mli alpha_context.ml script_typed_ir.ml script_tc_errors.ml michelson_v1_gas.mli michelson_v1_gas.ml script_ir_annot.mli script_ir_annot.ml script_ir_translator.mli script_ir_translator.ml script_tc_errors_registration.ml script_interpreter.mli script_interpreter.ml baking.mli baking.ml amendment.mli amendment.ml apply_results.mli apply_results.ml apply.ml services_registration.ml constants_services.mli constants_services.ml contract_services.mli contract_services.ml delegate_services.mli delegate_services.ml helpers_services.mli helpers_services.ml voting_services.mli voting_services.ml alpha_services.mli alpha_services.ml main.mli main.ml
        (:src_dir TEZOS_PROTOCOL))
  (action (with-stdout-to %{targets}
                          (chdir %{workspace_root}
@@ -34,70 +34,70 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end
 
 (rule
  (targets protocol.ml)
- (deps misc.mli misc.ml storage_description.mli storage_description.ml state_hash.ml nonce_hash.ml script_expr_hash.ml contract_hash.ml blinded_public_key_hash.mli blinded_public_key_hash.ml qty_repr.ml tez_repr.mli tez_repr.ml period_repr.mli period_repr.ml time_repr.mli time_repr.ml constants_repr.ml fitness_repr.ml raw_level_repr.mli raw_level_repr.ml voting_period_repr.mli voting_period_repr.ml cycle_repr.mli cycle_repr.ml level_repr.mli level_repr.ml seed_repr.mli seed_repr.ml gas_limit_repr.mli gas_limit_repr.ml script_int_repr.mli script_int_repr.ml script_timestamp_repr.mli script_timestamp_repr.ml michelson_v1_primitives.mli michelson_v1_primitives.ml script_repr.mli script_repr.ml contract_repr.mli contract_repr.ml roll_repr.mli roll_repr.ml vote_repr.mli vote_repr.ml block_header_repr.mli block_header_repr.ml operation_repr.mli operation_repr.ml manager_repr.mli manager_repr.ml commitment_repr.mli commitment_repr.ml parameters_repr.mli parameters_repr.ml raw_context.mli raw_context.ml storage_sigs.ml storage_functors.mli storage_functors.ml storage.mli storage.ml constants_storage.ml level_storage.mli level_storage.ml nonce_storage.mli nonce_storage.ml seed_storage.mli seed_storage.ml roll_storage.mli roll_storage.ml delegate_storage.mli delegate_storage.ml contract_storage.mli contract_storage.ml bootstrap_storage.mli bootstrap_storage.ml fitness_storage.ml vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml init_storage.ml fees_storage.mli fees_storage.ml alpha_context.mli alpha_context.ml script_typed_ir.ml script_tc_errors.ml michelson_v1_gas.mli michelson_v1_gas.ml script_ir_annot.mli script_ir_annot.ml script_ir_translator.mli script_ir_translator.ml script_tc_errors_registration.ml script_interpreter.mli script_interpreter.ml baking.mli baking.ml amendment.mli amendment.ml apply_results.mli apply_results.ml apply.ml services_registration.ml constants_services.mli constants_services.ml contract_services.mli contract_services.ml delegate_services.mli delegate_services.ml helpers_services.mli helpers_services.ml voting_services.mli voting_services.ml alpha_services.mli alpha_services.ml main.mli main.ml)
+ (deps misc.mli misc.ml storage_description.mli storage_description.ml state_hash.ml nonce_hash.ml script_expr_hash.ml contract_hash.ml blinded_public_key_hash.mli blinded_public_key_hash.ml qty_repr.ml tez_repr.mli tez_repr.ml period_repr.mli period_repr.ml time_repr.mli time_repr.ml constants_repr.ml fitness_repr.ml raw_level_repr.mli raw_level_repr.ml voting_period_repr.mli voting_period_repr.ml cycle_repr.mli cycle_repr.ml level_repr.mli level_repr.ml seed_repr.mli seed_repr.ml gas_limit_repr.mli gas_limit_repr.ml script_int_repr.mli script_int_repr.ml script_timestamp_repr.mli script_timestamp_repr.ml michelson_v1_primitives.mli michelson_v1_primitives.ml script_repr.mli script_repr.ml legacy_script_support_repr.mli legacy_script_support_repr.ml contract_repr.mli contract_repr.ml roll_repr.mli roll_repr.ml vote_repr.mli vote_repr.ml block_header_repr.mli block_header_repr.ml operation_repr.mli operation_repr.ml manager_repr.mli manager_repr.ml commitment_repr.mli commitment_repr.ml parameters_repr.mli parameters_repr.ml raw_context.mli raw_context.ml storage_sigs.ml storage_functors.mli storage_functors.ml storage.mli storage.ml constants_storage.ml level_storage.mli level_storage.ml nonce_storage.mli nonce_storage.ml seed_storage.mli seed_storage.ml roll_storage.mli roll_storage.ml delegate_storage.mli delegate_storage.ml contract_storage.mli contract_storage.ml bootstrap_storage.mli bootstrap_storage.ml fitness_storage.ml vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml init_storage.ml fees_storage.mli fees_storage.ml alpha_context.mli alpha_context.ml script_typed_ir.ml script_tc_errors.ml michelson_v1_gas.mli michelson_v1_gas.ml script_ir_annot.mli script_ir_annot.ml script_ir_translator.mli script_ir_translator.ml script_tc_errors_registration.ml script_interpreter.mli script_interpreter.ml baking.mli baking.ml amendment.mli amendment.ml apply_results.mli apply_results.ml apply.ml services_registration.ml constants_services.mli constants_services.ml contract_services.mli contract_services.ml delegate_services.mli delegate_services.ml helpers_services.mli helpers_services.ml voting_services.mli voting_services.ml alpha_services.mli alpha_services.ml main.mli main.ml)
  (action
   (write-file %{targets}
-    "module Environment = Tezos_protocol_environment_alpha.Environment
+    "module Environment = Tezos_protocol_environment_005_PsBabyM1.Environment
-let hash = Tezos_crypto.Protocol_hash.of_b58check_exn \"ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK\"
+let hash = Tezos_crypto.Protocol_hash.of_b58check_exn \"PsBabyM1eUXZseaJdmXFApDSBqj8YBfwELoxZHHW77EMcAbbwAS\"
 let name = Environment.Name.name
-include Tezos_raw_protocol_alpha
+include Tezos_raw_protocol_005_PsBabyM1
-include Tezos_raw_protocol_alpha.Main
+include Tezos_raw_protocol_005_PsBabyM1.Main
 ")))
 
 (library
- (name tezos_protocol_environment_alpha)
+ (name tezos_protocol_environment_005_PsBabyM1)
- (public_name tezos-protocol-alpha.environment)
+ (public_name tezos-protocol-005-PsBabyM1.environment)
  (library_flags (:standard -linkall))
  (libraries tezos-protocol-environment)
  (modules Environment))
 
 (library
- (name tezos_raw_protocol_alpha)
+ (name tezos_raw_protocol_005_PsBabyM1)
- (public_name tezos-protocol-alpha.raw)
+ (public_name tezos-protocol-005-PsBabyM1.raw)
- (libraries tezos_protocol_environment_alpha)
+ (libraries tezos_protocol_environment_005_PsBabyM1)
  (library_flags (:standard -linkall))
  (flags (:standard -nopervasives -nostdlib
                    -w +a-4-6-7-9-29-32-40..42-44-45-48
                    -warn-error -a+8
-                   -open Tezos_protocol_environment_alpha__Environment
+                   -open Tezos_protocol_environment_005_PsBabyM1__Environment
                    -open Pervasives
                    -open Error_monad))
- (modules Misc Storage_description State_hash Nonce_hash Script_expr_hash Contract_hash Blinded_public_key_hash Qty_repr Tez_repr Period_repr Time_repr Constants_repr Fitness_repr Raw_level_repr Voting_period_repr Cycle_repr Level_repr Seed_repr Gas_limit_repr Script_int_repr Script_timestamp_repr Michelson_v1_primitives Script_repr Contract_repr Roll_repr Vote_repr Block_header_repr Operation_repr Manager_repr Commitment_repr Parameters_repr Raw_context Storage_sigs Storage_functors Storage Constants_storage Level_storage Nonce_storage Seed_storage Roll_storage Delegate_storage Contract_storage Bootstrap_storage Fitness_storage Vote_storage Commitment_storage Init_storage Fees_storage Alpha_context Script_typed_ir Script_tc_errors Michelson_v1_gas Script_ir_annot Script_ir_translator Script_tc_errors_registration Script_interpreter Baking Amendment Apply_results Apply Services_registration Constants_services Contract_services Delegate_services Helpers_services Voting_services Alpha_services Main))
+ (modules Misc Storage_description State_hash Nonce_hash Script_expr_hash Contract_hash Blinded_public_key_hash Qty_repr Tez_repr Period_repr Time_repr Constants_repr Fitness_repr Raw_level_repr Voting_period_repr Cycle_repr Level_repr Seed_repr Gas_limit_repr Script_int_repr Script_timestamp_repr Michelson_v1_primitives Script_repr Legacy_script_support_repr Contract_repr Roll_repr Vote_repr Block_header_repr Operation_repr Manager_repr Commitment_repr Parameters_repr Raw_context Storage_sigs Storage_functors Storage Constants_storage Level_storage Nonce_storage Seed_storage Roll_storage Delegate_storage Contract_storage Bootstrap_storage Fitness_storage Vote_storage Commitment_storage Init_storage Fees_storage Alpha_context Script_typed_ir Script_tc_errors Michelson_v1_gas Script_ir_annot Script_ir_translator Script_tc_errors_registration Script_interpreter Baking Amendment Apply_results Apply Services_registration Constants_services Contract_services Delegate_services Helpers_services Voting_services Alpha_services Main))
 
 (install
  (section lib)
- (package tezos-protocol-alpha)
+ (package tezos-protocol-005-PsBabyM1)
  (files (TEZOS_PROTOCOL as raw/TEZOS_PROTOCOL)))
 
 (library
- (name tezos_protocol_alpha)
+ (name tezos_protocol_005_PsBabyM1)
- (public_name tezos-protocol-alpha)
+ (public_name tezos-protocol-005-PsBabyM1)
  (libraries
       tezos-protocol-environment
       tezos-protocol-environment-sigs
-      tezos_raw_protocol_alpha)
+      tezos_raw_protocol_005_PsBabyM1)
  (flags -w "+a-4-6-7-9-29-40..42-44-45-48"
         -warn-error "-a+8"
         -nopervasives)
  (modules Protocol))
 
 (library
- (name tezos_protocol_alpha_functor)
+ (name tezos_protocol_005_PsBabyM1_functor)
- (public_name tezos-protocol-alpha.functor)
+ (public_name tezos-protocol-005-PsBabyM1.functor)
  (libraries
       tezos-protocol-environment
       tezos-protocol-environment-sigs
-      tezos_raw_protocol_alpha)
+      tezos_raw_protocol_005_PsBabyM1)
  (flags -w "+a-4-6-7-9-29-40..42-44-45-48"
         -warn-error "-a+8"
         -nopervasives)
  (modules Functor))
 
 (library
- (name tezos_embedded_protocol_alpha)
+ (name tezos_embedded_protocol_005_PsBabyM1)
- (public_name tezos-embedded-protocol-alpha)
+ (public_name tezos-embedded-protocol-005-PsBabyM1)
  (library_flags (:standard -linkall))
- (libraries tezos-protocol-alpha
+ (libraries tezos-protocol-005-PsBabyM1
             tezos-protocol-updater
             tezos-protocol-environment)
  (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48
@@ -106,4 +106,4 @@ include Tezos_raw_protocol_alpha.Main
 
 (alias
  (name runtest_sandbox)
- (deps .tezos_protocol_alpha.objs/native/tezos_protocol_alpha.cmx))
+ (deps .tezos_protocol_005_PsBabyM1.objs/native/tezos_protocol_005_PsBabyM1.cmx))

vendors/ligo-utils/tezos-protocol-alpha/fees_storage.ml

@@ -97,7 +97,7 @@ let burn_storage_fees c ~storage_limit ~payer =
     else
       trace Cannot_pay_storage_fee
         (Contract_storage.must_exist c payer >>=? fun () ->
-         Contract_storage.spend_from_script c payer to_burn) >>=? fun c ->
+         Contract_storage.spend c payer to_burn) >>=? fun c ->
       return c
 
 let check_storage_limit c ~storage_limit =

vendors/ligo-utils/tezos-protocol-alpha/fitness_repr.ml

@@ -57,5 +57,10 @@ let to_int64 = function
     when Compare.String.
            (MBytes.to_string version = Constants_repr.version_number) ->
       int64_of_bytes fitness
+  | [ version ;
+      _fitness (* ignored since higher version takes priority *) ]
+    when Compare.String.
+           (MBytes.to_string version = Constants_repr.version_number_004) ->
+      ok 0L
   | [] -> ok 0L
   | _ -> error Invalid_fitness

vendors/ligo-utils/tezos-protocol-alpha/gas_limit_repr.ml

@@ -27,6 +27,8 @@ type t =
   | Unaccounted
   | Limited of { remaining : Z.t }
 
+type internal_gas = Z.t
+
 type cost =
   { allocations : Z.t ;
     steps : Z.t ;
@@ -90,37 +92,60 @@ let write_base_weight = Z.of_int 160
 let byte_read_weight = Z.of_int 10
 let byte_written_weight = Z.of_int 15
 
-let consume block_gas operation_gas cost = match operation_gas with
+let rescaling_bits = 7
-  | Unaccounted -> ok (block_gas, Unaccounted)
+let rescaling_mask =
-  | Limited { remaining } ->
+  Z.sub (Z.shift_left Z.one rescaling_bits) Z.one
-      let weighted_cost =
-        Z.add
-          (Z.add
-             (Z.mul allocation_weight cost.allocations)
-             (Z.mul step_weight cost.steps))
-          (Z.add
-             (Z.add
-                (Z.mul read_base_weight cost.reads)
-                (Z.mul write_base_weight cost.writes))
-             (Z.add
-                (Z.mul byte_read_weight cost.bytes_read)
-                (Z.mul byte_written_weight cost.bytes_written))) in
-      let remaining =
-        Z.sub remaining weighted_cost in
-      let block_remaining =
-        Z.sub block_gas weighted_cost in
-      if Compare.Z.(remaining < Z.zero)
-      then error Operation_quota_exceeded
-      else if Compare.Z.(block_remaining < Z.zero)
-      then error Block_quota_exceeded
-      else ok (block_remaining, Limited { remaining })
 
-let check_enough block_gas operation_gas cost =
+let scale (z : Z.t) = Z.shift_left z rescaling_bits
-  consume block_gas operation_gas cost
+let rescale (z : Z.t) = Z.shift_right z rescaling_bits
-  >|? fun (_block_remainig, _remaining) -> ()
+
+let cost_to_internal_gas (cost : cost) : internal_gas =
+  Z.add
+    (Z.add
+       (Z.mul cost.allocations allocation_weight)
+       (Z.mul cost.steps step_weight))
+    (Z.add
+       (Z.add
+          (Z.mul cost.reads read_base_weight)
+          (Z.mul cost.writes write_base_weight))
+       (Z.add
+          (Z.mul cost.bytes_read byte_read_weight)
+          (Z.mul cost.bytes_written byte_written_weight)))
+
+let internal_gas_to_gas internal_gas : Z.t * internal_gas =
+  let gas  = rescale internal_gas in
+  let rest = Z.logand internal_gas rescaling_mask in
+  (gas, rest)
+
+let consume block_gas operation_gas internal_gas cost =
+  match operation_gas with
+  | Unaccounted -> ok (block_gas, Unaccounted, internal_gas)
+  | Limited { remaining } ->
+      let cost_internal_gas  = cost_to_internal_gas cost in
+      let total_internal_gas =
+        Z.add cost_internal_gas internal_gas in
+      let gas, rest = internal_gas_to_gas total_internal_gas in
+      if Compare.Z.(gas > Z.zero) then
+        let remaining =
+          Z.sub remaining gas in
+        let block_remaining =
+          Z.sub block_gas gas in
+        if Compare.Z.(remaining < Z.zero)
+        then error Operation_quota_exceeded
+        else if Compare.Z.(block_remaining < Z.zero)
+        then error Block_quota_exceeded
+        else ok (block_remaining, Limited { remaining }, rest)
+      else
+        ok (block_gas, operation_gas, total_internal_gas)
+
+let check_enough block_gas operation_gas internal_gas cost =
+  consume block_gas operation_gas internal_gas cost
+  >|? fun (_block_remainig, _remaining, _internal_gas) -> ()
+
+let internal_gas_zero : internal_gas = Z.zero
 
 let alloc_cost n =
-  { allocations = Z.of_int (n + 1) ;
+  { allocations = scale (Z.of_int (n + 1)) ;
     steps = Z.zero ;
     reads = Z.zero ;
     writes = Z.zero ;
@@ -133,9 +158,17 @@ let alloc_bytes_cost n =
 let alloc_bits_cost n =
   alloc_cost ((n + 63) / 64)
 
+let atomic_step_cost n =
+  { allocations = Z.zero ;
+    steps = Z.of_int (2 * n) ;
+    reads = Z.zero ;
+    writes = Z.zero ;
+    bytes_read = Z.zero ;
+    bytes_written = Z.zero }
+
 let step_cost n =
   { allocations = Z.zero ;
-    steps = Z.of_int n ;
+    steps = scale (Z.of_int n) ;
     reads = Z.zero ;
     writes = Z.zero ;
     bytes_read = Z.zero ;
@@ -152,9 +185,9 @@ let free =
 let read_bytes_cost n =
   { allocations = Z.zero ;
     steps = Z.zero ;
-    reads = Z.one ;
+    reads = scale Z.one ;
     writes = Z.zero ;
-    bytes_read = n ;
+    bytes_read = scale n ;
     bytes_written = Z.zero }
 
 let write_bytes_cost n =
@@ -163,7 +196,7 @@ let write_bytes_cost n =
     reads = Z.zero ;
     writes = Z.one ;
     bytes_read = Z.zero ;
-    bytes_written = n }
+    bytes_written = scale n }
 
 let ( +@ ) x y =
   { allocations = Z.add x.allocations y.allocations ;

vendors/ligo-utils/tezos-protocol-alpha/gas_limit_repr.mli

@@ -27,6 +27,8 @@ type t =
   | Unaccounted
   | Limited of { remaining : Z.t }
 
+type internal_gas
+
 val encoding : t Data_encoding.encoding
 val pp : Format.formatter -> t -> unit
 
@@ -38,10 +40,13 @@ val pp_cost : Format.formatter -> cost -> unit
 type error += Block_quota_exceeded (* `Temporary *)
 type error += Operation_quota_exceeded (* `Temporary *)
 
-val consume : Z.t -> t -> cost -> (Z.t * t) tzresult
+val consume : Z.t -> t -> internal_gas -> cost -> (Z.t * t * internal_gas) tzresult
-val check_enough : Z.t -> t -> cost -> unit tzresult
+val check_enough : Z.t -> t -> internal_gas -> cost -> unit tzresult
+
+val internal_gas_zero : internal_gas
 
 val free : cost
+val atomic_step_cost : int -> cost
 val step_cost : int -> cost
 val alloc_cost : int -> cost
 val alloc_bytes_cost : int -> cost

vendors/ligo-utils/tezos-protocol-alpha/helpers_services.ml

@@ -59,14 +59,16 @@ module Scripts = struct
     let path = RPC_path.(path / "scripts")
 
     let run_code_input_encoding =
-      (obj7
+      (obj9
          (req "script" Script.expr_encoding)
          (req "storage" Script.expr_encoding)
          (req "input" Script.expr_encoding)
          (req "amount" Tez.encoding)
+         (req "chain_id" Chain_id.encoding)
          (opt "source" Contract.encoding)
          (opt "payer" Contract.encoding)
-         (opt "gas" z))
+         (opt "gas" z)
+         (dft "entrypoint" string "default"))
 
     let trace_encoding =
       def "scripted.trace" @@
@@ -147,10 +149,39 @@ module Scripts = struct
         ~description:
           "Run an operation without signature checks"
         ~query: RPC_query.empty
-        ~input: Operation.encoding
+        ~input: (obj2
+                   (req "operation" Operation.encoding)
+                   (req "chain_id" Chain_id.encoding))
         ~output: Apply_results.operation_data_and_metadata_encoding
         RPC_path.(path / "run_operation")
 
+    let entrypoint_type =
+      RPC_service.post_service
+        ~description: "Return the type of the given entrypoint"
+        ~query: RPC_query.empty
+        ~input: (obj2
+                   (req "script" Script.expr_encoding)
+                   (dft "entrypoint" string "default"))
+        ~output: (obj1
+                    (req "entrypoint_type" Script.expr_encoding))
+        RPC_path.(path / "entrypoint")
+
+
+    let list_entrypoints =
+      RPC_service.post_service
+        ~description: "Return the list of entrypoints of the given script"
+        ~query: RPC_query.empty
+        ~input: (obj1
+                   (req "script" Script.expr_encoding))
+        ~output: (obj2
+                    (dft "unreachable"
+                       (Data_encoding.list
+                          (obj1 (req "path" (Data_encoding.list Michelson_v1_primitives.prim_encoding))))
+                       [])
+                    (req "entrypoints"
+                       (assoc Script.expr_encoding)))
+        RPC_path.(path / "entrypoints")
+
   end
 
   let register () =
@@ -163,14 +194,11 @@ module Scripts = struct
         | None -> assert false in
       Contract.originate ctxt dummy_contract
         ~balance
-        ~manager: Signature.Public_key_hash.zero
         ~delegate: None
-        ~spendable: false
-        ~delegatable: false
         ~script: (script, None) >>=? fun ctxt ->
       return (ctxt, dummy_contract) in
     register0 S.run_code begin fun ctxt ()
-      (code, storage, parameter, amount, source, payer, gas) ->
+      (code, storage, parameter, amount, chain_id, source, payer, gas, entrypoint) ->
       let storage = Script.lazy_expr storage in
       let code = Script.lazy_expr code in
       originate_dummy_contract ctxt { storage ; code } >>=? fun (ctxt, dummy_contract) ->
@@ -183,17 +211,24 @@ module Scripts = struct
         | Some gas -> gas
         | None -> Constants.hard_gas_limit_per_operation ctxt in
       let ctxt = Gas.set_limit ctxt gas in
+      let step_constants =
+        let open Script_interpreter in
+        { source ;
+          payer ;
+          self = dummy_contract ;
+          amount ;
+          chain_id } in
       Script_interpreter.execute
         ctxt Readable
-        ~source
+        step_constants
-        ~payer
+        ~script:{ storage ; code }
-        ~self:(dummy_contract, { storage ; code })
+        ~entrypoint
-        ~amount ~parameter
+        ~parameter
       >>=? fun { Script_interpreter.storage ; operations ; big_map_diff ; _ } ->
       return (storage, operations, big_map_diff)
     end ;
     register0 S.trace_code begin fun ctxt ()
-      (code, storage, parameter, amount, source, payer, gas) ->
+      (code, storage, parameter, amount, chain_id, source, payer, gas, entrypoint) ->
       let storage = Script.lazy_expr storage in
       let code = Script.lazy_expr code in
       originate_dummy_contract ctxt { storage ; code } >>=? fun (ctxt, dummy_contract) ->
@@ -206,12 +241,19 @@ module Scripts = struct
         | Some gas -> gas
         | None -> Constants.hard_gas_limit_per_operation ctxt in
       let ctxt = Gas.set_limit ctxt gas in
+      let step_constants =
+        let open Script_interpreter in
+        { source ;
+          payer ;
+          self = dummy_contract ;
+          amount ;
+          chain_id } in
       Script_interpreter.trace
         ctxt Readable
-        ~source
+        step_constants
-        ~payer
+        ~script:{ storage ; code }
-        ~self:(dummy_contract, { storage ; code })
+        ~entrypoint
-        ~amount ~parameter
+        ~parameter
       >>=? fun ({ Script_interpreter.storage ; operations ; big_map_diff ; _ }, trace) ->
       return (storage, operations, trace, big_map_diff)
     end ;
@@ -234,13 +276,13 @@ module Scripts = struct
       let ctxt = match maybe_gas with
         | None -> Gas.set_unlimited ctxt
         | Some gas -> Gas.set_limit ctxt gas in
-      Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false (Micheline.root typ)) >>=? fun (Ex_ty typ, ctxt) ->
+      Lwt.return (parse_packable_ty ctxt ~legacy:true (Micheline.root typ)) >>=? fun (Ex_ty typ, ctxt) ->
-      parse_data ctxt typ (Micheline.root expr) >>=? fun (data, ctxt) ->
+      parse_data ctxt ~legacy:true typ (Micheline.root expr) >>=? fun (data, ctxt) ->
       Script_ir_translator.pack_data ctxt typ data >>=? fun (bytes, ctxt) ->
       return (bytes, Gas.level ctxt)
     end ;
     register0 S.run_operation begin fun ctxt ()
-      { shell ; protocol_data = Operation_data protocol_data } ->
+      ({ shell ; protocol_data = Operation_data protocol_data }, chain_id) ->
       (* this code is a duplicate of Apply without signature check *)
       let partial_precheck_manager_contents
           (type kind) ctxt (op : kind Kind.manager contents)
@@ -249,15 +291,15 @@ module Scripts = struct
         Lwt.return (Gas.check_limit ctxt gas_limit) >>=? fun () ->
         let ctxt = Gas.set_limit ctxt gas_limit in
         Lwt.return (Fees.check_storage_limit ctxt storage_limit) >>=? fun () ->
-        Contract.must_be_allocated ctxt source >>=? fun () ->
+        Contract.must_be_allocated ctxt (Contract.implicit_contract source) >>=? fun () ->
         Contract.check_counter_increment ctxt source counter >>=? fun () ->
         begin
           match operation with
           | Reveal pk ->
               Contract.reveal_manager_key ctxt source pk
-          | Transaction { parameters = Some arg ; _ } ->
+          | Transaction { parameters ; _ } ->
               (* Here the data comes already deserialized, so we need to fake the deserialization to mimic apply *)
-              let arg_bytes = Data_encoding.Binary.to_bytes_exn Script.lazy_expr_encoding arg in
+              let arg_bytes = Data_encoding.Binary.to_bytes_exn Script.lazy_expr_encoding parameters in
               let arg = match Data_encoding.Binary.of_bytes Script.lazy_expr_encoding arg_bytes with
                 | Some arg -> arg
                 | None -> assert false in
@@ -267,7 +309,7 @@ module Scripts = struct
               (* Fail if not enough gas for complete deserialization cost *)
               trace Apply.Gas_quota_exceeded_init_deserialize @@
               Script.force_decode ctxt arg >>|? fun (_arg, ctxt) -> ctxt
-          | Origination { script = Some script ; _ } ->
+          | Origination { script = script ; _ } ->
               (* Here the data comes already deserialized, so we need to fake the deserialization to mimic apply *)
               let script_bytes = Data_encoding.Binary.to_bytes_exn Script.encoding script in
               let script = match Data_encoding.Binary.of_bytes Script.encoding script_bytes with
@@ -287,7 +329,7 @@ module Scripts = struct
         Contract.get_manager_key ctxt source >>=? fun _public_key ->
         (* signature check unplugged from here *)
         Contract.increment_counter ctxt source >>=? fun ctxt ->
-        Contract.spend ctxt source fee >>=? fun ctxt ->
+        Contract.spend ctxt (Contract.implicit_contract source) fee >>=? fun ctxt ->
         return ctxt in
       let rec partial_precheck_manager_contents_list
         : type kind.
@@ -310,27 +352,61 @@ module Scripts = struct
       match protocol_data.contents with
       | Single (Manager_operation _) as op ->
           partial_precheck_manager_contents_list ctxt op >>=? fun ctxt ->
-          Apply.apply_manager_contents_list ctxt Optimized baker op >>= fun (_ctxt, result) ->
+          Apply.apply_manager_contents_list ctxt Optimized baker chain_id op >>= fun (_ctxt, result) ->
           return result
       | Cons (Manager_operation _, _) as op ->
           partial_precheck_manager_contents_list ctxt op >>=? fun ctxt ->
-          Apply.apply_manager_contents_list ctxt Optimized baker op >>= fun (_ctxt, result) ->
+          Apply.apply_manager_contents_list ctxt Optimized baker chain_id op >>= fun (_ctxt, result) ->
           return result
       | _ ->
           Apply.apply_contents_list
-            ctxt ~partial:true Chain_id.zero Optimized shell.branch baker operation
+            ctxt chain_id Optimized shell.branch baker operation
             operation.protocol_data.contents >>=? fun (_ctxt, result) ->
           return result
-
+    end;
+    register0 S.entrypoint_type begin fun ctxt () (expr, entrypoint) ->
+      let ctxt = Gas.set_unlimited ctxt in
+      let legacy = false in
+      let open Script_ir_translator in
+      Lwt.return
+        begin
+          parse_toplevel ~legacy expr >>? fun (arg_type, _, _, root_name) ->
+          parse_ty ctxt ~legacy
+            ~allow_big_map:true ~allow_operation:false
+            ~allow_contract:true arg_type >>? fun (Ex_ty arg_type, _) ->
+          Script_ir_translator.find_entrypoint ~root_name arg_type
+            entrypoint
+        end >>=? fun (_f , Ex_ty ty)->
+      unparse_ty ctxt ty >>=? fun (ty_node, _) ->
+      return (Micheline.strip_locations ty_node)
+    end ;
+    register0 S.list_entrypoints begin fun ctxt () expr ->
+      let ctxt = Gas.set_unlimited ctxt in
+      let legacy = false in
+      let open Script_ir_translator in
+      Lwt.return
+        begin
+          parse_toplevel ~legacy expr >>? fun (arg_type, _, _, root_name) ->
+          parse_ty ctxt ~legacy
+            ~allow_big_map:true ~allow_operation:false
+            ~allow_contract:true arg_type >>? fun (Ex_ty arg_type, _) ->
+          Script_ir_translator.list_entrypoints ~root_name arg_type ctxt
+        end >>=? fun (unreachable_entrypoint,map) ->
+      return
+        (unreachable_entrypoint,
+         Entrypoints_map.fold
+           begin fun entry (_,ty) acc ->
+             (entry , Micheline.strip_locations ty) ::acc end
+           map [])
     end
 
-  let run_code ctxt block code (storage, input, amount, source, payer, gas) =
+  let run_code ctxt block code (storage, input, amount, chain_id, source, payer, gas, entrypoint) =
     RPC_context.make_call0 S.run_code ctxt
-      block () (code, storage, input, amount, source, payer, gas)
+      block () (code, storage, input, amount, chain_id, source, payer, gas, entrypoint)
 
-  let trace_code ctxt block code (storage, input, amount, source, payer, gas) =
+  let trace_code ctxt block code (storage, input, amount, chain_id, source, payer, gas, entrypoint) =
     RPC_context.make_call0 S.trace_code ctxt
-      block () (code, storage, input, amount, source, payer, gas)
+      block () (code, storage, input, amount, chain_id, source, payer, gas, entrypoint)
 
   let typecheck_code ctxt block =
     RPC_context.make_call0 S.typecheck_code ctxt block ()
@@ -344,6 +420,13 @@ module Scripts = struct
   let run_operation ctxt block =
     RPC_context.make_call0 S.run_operation ctxt block ()
 
+  let entrypoint_type ctxt block =
+    RPC_context.make_call0 S.entrypoint_type ctxt block ()
+
+  let list_entrypoints ctxt block =
+    RPC_context.make_call0 S.list_entrypoints ctxt block ()
+
+
 end
 
 module Forge = struct
@@ -403,7 +486,7 @@ module Forge = struct
         ~gas_limit ~storage_limit operations =
       Contract_services.manager_key ctxt block source >>= function
       | Error _ as e -> Lwt.return e
-      | Ok (_, revealed) ->
+      | Ok revealed ->
           let ops =
             List.map
               (fun (Manager operation) ->
@@ -431,28 +514,23 @@ module Forge = struct
 
     let transaction ctxt
         block ~branch ~source ?sourcePubKey ~counter
-        ~amount ~destination ?parameters
+        ~amount ~destination ?(entrypoint = "default") ?parameters
         ~gas_limit ~storage_limit ~fee ()=
-      let parameters = Option.map ~f:Script.lazy_expr parameters in
+      let parameters = Option.unopt_map ~f:Script.lazy_expr ~default:Script.unit_parameter parameters in
       operations ctxt block ~branch ~source ?sourcePubKey ~counter
         ~fee ~gas_limit ~storage_limit
-        [Manager (Transaction { amount ; parameters ; destination })]
+        [Manager (Transaction { amount ; parameters ; destination ; entrypoint })]
 
     let origination ctxt
         block ~branch
         ~source ?sourcePubKey ~counter
-        ~managerPubKey ~balance
+        ~balance
-        ?(spendable = true)
+        ?delegatePubKey ~script
-        ?(delegatable = true)
-        ?delegatePubKey ?script
         ~gas_limit ~storage_limit ~fee () =
       operations ctxt block ~branch ~source ?sourcePubKey ~counter
         ~fee ~gas_limit ~storage_limit
-        [Manager (Origination { manager = managerPubKey ;
+        [Manager (Origination { delegate = delegatePubKey ;
-                                delegate = delegatePubKey ;
                                 script ;
-                                spendable ;
-                                delegatable ;
                                 credit = balance ;
                                 preorigination = None })]
 

vendors/ligo-utils/tezos-protocol-alpha/helpers_services.mli

@@ -40,7 +40,7 @@ module Scripts : sig
   val run_code:
     'a #RPC_context.simple ->
     'a -> Script.expr ->
-    (Script.expr * Script.expr * Tez.t * Contract.t option * Contract.t option * Z.t option) ->
+    (Script.expr * Script.expr * Tez.t * Chain_id.t * Contract.t option * Contract.t option * Z.t option * string) ->
     (Script.expr *
      packed_internal_operation list *
      Contract.big_map_diff option) shell_tzresult Lwt.t
@@ -48,7 +48,7 @@ module Scripts : sig
   val trace_code:
     'a #RPC_context.simple ->
     'a -> Script.expr ->
-    (Script.expr * Script.expr * Tez.t * Contract.t option * Contract.t option* Z.t option) ->
+    (Script.expr * Script.expr * Tez.t * Chain_id.t * Contract.t option * Contract.t option * Z.t option * string) ->
     (Script.expr *
      packed_internal_operation list *
      Script_interpreter.execution_trace *
@@ -69,9 +69,19 @@ module Scripts : sig
 
   val run_operation:
     'a #RPC_context.simple ->
-    'a -> packed_operation ->
+    'a -> packed_operation * Chain_id.t ->
     (packed_protocol_data * Apply_results.packed_operation_metadata) shell_tzresult Lwt.t
 
+  val entrypoint_type:
+    'a #RPC_context.simple ->
+    'a -> Script.expr * string -> Script.expr shell_tzresult Lwt.t
+
+  val list_entrypoints:
+    'a #RPC_context.simple ->
+    'a -> Script.expr ->
+    (Michelson_v1_primitives.prim list list *
+     (string * Script.expr) list) shell_tzresult Lwt.t
+
 end
 
 module Forge : sig
@@ -81,7 +91,7 @@ module Forge : sig
     val operations:
       'a #RPC_context.simple -> 'a ->
       branch:Block_hash.t ->
-      source:Contract.t ->
+      source:public_key_hash ->
       ?sourcePubKey:public_key ->
       counter:counter ->
       fee:Tez.t ->
@@ -92,7 +102,7 @@ module Forge : sig
     val reveal:
       'a #RPC_context.simple -> 'a ->
       branch:Block_hash.t ->
-      source:Contract.t ->
+      source:public_key_hash ->
       sourcePubKey:public_key ->
       counter:counter ->
       fee:Tez.t ->
@@ -101,11 +111,12 @@ module Forge : sig
     val transaction:
       'a #RPC_context.simple -> 'a ->
       branch:Block_hash.t ->
-      source:Contract.t ->
+      source:public_key_hash ->
       ?sourcePubKey:public_key ->
       counter:counter ->
       amount:Tez.t ->
       destination:Contract.t ->
+      ?entrypoint:string ->
       ?parameters:Script.expr ->
       gas_limit:Z.t ->
       storage_limit:Z.t ->
@@ -115,15 +126,12 @@ module Forge : sig
     val origination:
       'a #RPC_context.simple -> 'a ->
       branch:Block_hash.t ->
-      source:Contract.t ->
+      source:public_key_hash ->
       ?sourcePubKey:public_key ->
       counter:counter ->
-      managerPubKey:public_key_hash ->
       balance:Tez.t ->
-      ?spendable:bool ->
-      ?delegatable:bool ->
       ?delegatePubKey: public_key_hash ->
-      ?script:Script.t ->
+      script:Script.t ->
       gas_limit:Z.t ->
       storage_limit:Z.t ->
       fee:Tez.t->
@@ -132,7 +140,7 @@ module Forge : sig
     val delegation:
       'a #RPC_context.simple -> 'a ->
       branch:Block_hash.t ->
-      source:Contract.t ->
+      source:public_key_hash ->
       ?sourcePubKey:public_key ->
       counter:counter ->
       fee:Tez.t ->

vendors/ligo-utils/tezos-protocol-alpha/init_storage.ml

@@ -2,6 +2,7 @@
 (*                                                                           *)
 (* Open Source License                                                       *)
 (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 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"),*)
@@ -23,10 +24,324 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-(* This is the genesis protocol: initialise the state *)
+(* Delegated storage changed type of value from Contract_hash to
+   Contract_repr. Move all 'delegated' data into a storage with
+   the original type, then copy over into the new storage. *)
+let migrate_delegated ctxt contract =
+  let path = "contracts" :: (* module Contract *)
+             "index" :: (* module Indexed_context *)
+             Contract_repr.Index.to_path contract [
+               "delegated" ; (* module Delegated *)
+             ] in
+  let path_tmp = "contracts" :: (* module Contract *)
+                 "index" :: (* module Indexed_context *)
+                 Contract_repr.Index.to_path contract [
+                   "delegated_004" ; (* module Delegated *)
+                 ] in
+  Raw_context.dir_mem ctxt path >>= fun exists ->
+  if exists then
+    Raw_context.copy ctxt path path_tmp >>=? fun ctxt ->
+    Raw_context.remove_rec ctxt path >>= fun ctxt ->
+    Storage.Contract.Delegated_004.fold (ctxt, contract) ~init:(Ok ctxt) ~f:(fun delegated ctxt ->
+        Lwt.return ctxt >>=? fun ctxt ->
+        let originated = Contract_repr.originated_contract_004 delegated in
+        Storage.Contract.Delegated.add (ctxt, contract) originated >>= fun ctxt ->
+        return ctxt
+      ) >>=? fun ctxt ->
+    Raw_context.remove_rec ctxt path_tmp >>= fun ctxt ->
+    return ctxt
+  else
+    return ctxt
+
+let transform_script:
+  (manager_pkh: Signature.Public_key_hash.t ->
+   script_code: Script_repr.lazy_expr ->
+   script_storage: Script_repr.lazy_expr ->
+   (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t) ->
+  manager_pkh: Signature.Public_key_hash.t ->
+  Raw_context.t ->
+  Contract_repr.t ->
+  Script_repr.lazy_expr ->
+  Raw_context.t tzresult Lwt.t =
+  fun transformation ~manager_pkh ctxt contract code ->
+  Storage.Contract.Storage.get ctxt contract >>=? fun (_ctxt, storage) ->
+  transformation manager_pkh code storage >>=? fun (migrated_code, migrated_storage) ->
+  (* Set the migrated script code for free *)
+  Storage.Contract.Code.set_free ctxt contract migrated_code >>=? fun (ctxt, code_size_diff) ->
+  (* Set the migrated script storage for free *)
+  Storage.Contract.Storage.set_free ctxt contract migrated_storage >>=? fun (ctxt, storage_size_diff) ->
+  Storage.Contract.Used_storage_space.get ctxt contract >>=? fun used_space ->
+  let total_size = Z.(add (of_int code_size_diff) (add (of_int storage_size_diff) used_space)) in
+  (* Free storage space for migrated contracts *)
+  Storage.Contract.Used_storage_space.set ctxt contract total_size >>=? fun ctxt ->
+  Storage.Contract.Paid_storage_space.get ctxt contract >>=? fun paid_space ->
+  if Compare.Z.(paid_space < total_size) then
+    Storage.Contract.Paid_storage_space.set ctxt contract total_size >>=? fun ctxt ->
+    return ctxt
+  else
+    return ctxt
+
+let manager_script_storage: Signature.Public_key_hash.t -> Script_repr.lazy_expr =
+  fun manager_pkh ->
+  let open Micheline in
+  Script_repr.lazy_expr @@ strip_locations @@
+  (* store in optimized binary representation - as unparsed with [Optimized]. *)
+  let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding manager_pkh in
+  Bytes (0, bytes)
+
+(* If the given contract is not allocated, we'll allocate it with 1 mutez,
+   so that the migrated contracts' managers don't have to pay origination burn *)
+let allocate_contract ctxt contract =
+  Contract_storage.allocated ctxt contract >>=? function
+  | true ->
+      return ctxt
+  | false ->
+      Contract_storage.credit ctxt contract Tez_repr.one_mutez
+
+(* Process an individual contract *)
+let process_contract_add_manager contract ctxt =
+  let open Legacy_script_support_repr in
+  match Contract_repr.is_originated contract with
+  | None -> return ctxt (* Only process originated contracts *)
+  | Some _ -> begin
+      Storage.Contract.Counter.remove ctxt contract >>= fun ctxt ->
+      Storage.Contract.Spendable_004.mem ctxt contract >>= fun is_spendable ->
+      Storage.Contract.Delegatable_004.mem ctxt contract >>= fun is_delegatable ->
+      Storage.Contract.Spendable_004.del ctxt contract >>= fun ctxt ->
+      Storage.Contract.Delegatable_004.del ctxt contract >>= fun ctxt ->
+      (* Try to get script code (ignore ctxt update to discard the initialization) *)
+      Storage.Contract.Code.get_option ctxt contract >>=? fun (_ctxt, code) ->
+      (* Get the manager of the originated contract *)
+      Contract_storage.get_manager_004 ctxt contract >>=? fun manager_pkh ->
+      let manager = Contract_repr.implicit_contract manager_pkh in
+      Storage.Contract.Manager.remove ctxt contract >>= fun ctxt ->
+      match code with
+      | Some code ->
+          (*
+          | spendable | delegatable | template         |
+          |-----------+-------------+------------------|
+          | true      | true        | add_do           |
+          | true      | false       | add_do           |
+          | false     | true        | add_set_delegate |
+          | false     | false       | nothing          |
+          *)
+          if is_spendable then
+            transform_script add_do ~manager_pkh ctxt contract code >>=? fun ctxt ->
+            allocate_contract ctxt manager
+          else if is_delegatable then
+            transform_script add_set_delegate ~manager_pkh ctxt contract code >>=? fun ctxt ->
+            allocate_contract ctxt manager
+          else if has_default_entrypoint code then
+            transform_script
+              (fun ~manager_pkh:_ ~script_code  ~script_storage ->
+                 add_root_entrypoint script_code >>=? fun script_code ->
+                 return (script_code, script_storage))
+              ~manager_pkh ctxt contract code
+          else
+            return ctxt
+      | None -> begin
+          (* Initialize the script code for free *)
+          Storage.Contract.Code.init_free ctxt contract manager_script_code >>=? fun (ctxt, code_size) ->
+          let storage = manager_script_storage manager_pkh in
+          (* Initialize the script storage for free *)
+          Storage.Contract.Storage.init_free ctxt contract storage >>=? fun (ctxt, storage_size) ->
+          let total_size = Z.(add (of_int code_size) (of_int storage_size)) in
+          (* Free storage space for migrated contracts *)
+          Storage.Contract.Paid_storage_space.init_set ctxt contract total_size >>= fun ctxt ->
+          Storage.Contract.Used_storage_space.init_set ctxt contract total_size >>= fun ctxt ->
+          allocate_contract ctxt manager
+        end
+    end
+
+(* The [[update_contract_script]] function returns a copy of its
+   argument (the Micheline AST of a contract script) with "ADDRESS"
+   replaced by "ADDRESS; CHAIN_ID; PAIR".
+
+   [[Micheline.strip_locations]] should be called on the resulting
+   Micheline AST to get meaningful locations. *)
+
+let rec update_contract_script : ('l, 'p) Micheline.node -> ('l, 'p) Micheline.node
+  = function
+    | Micheline.Seq (_,
+                     Micheline.Prim (_, Michelson_v1_primitives.I_ADDRESS, [], []) ::
+                     l) ->
+        Micheline.Seq (0,
+                       Micheline.Prim (0, Michelson_v1_primitives.I_ADDRESS, [], []) ::
+                       Micheline.Prim (0, Michelson_v1_primitives.I_CHAIN_ID, [], []) ::
+                       Micheline.Prim (0, Michelson_v1_primitives.I_PAIR, [], []) :: l)
+    | Micheline.Seq (_, a :: l) ->
+        let a' = update_contract_script a in
+        let b = Micheline.Seq (0, l) in
+        let b' = update_contract_script b in
+        begin match b' with
+          | Micheline.Seq (_, l') ->
+              Micheline.Seq (0, a' :: l')
+          | _ -> assert false
+        end
+    | Micheline.Prim (_, p, l, annot) ->
+        Micheline.Prim (0, p, List.map update_contract_script l, annot)
+    | script -> script
+
+let migrate_multisig_script (ctxt : Raw_context.t) (contract : Contract_repr.t)
+    (code : Script_repr.expr) : Raw_context.t tzresult Lwt.t =
+  let migrated_code =
+    Script_repr.lazy_expr @@ Micheline.strip_locations @@
+    update_contract_script @@ Micheline.root code
+  in
+  Storage.Contract.Code.set_free ctxt contract migrated_code >>=? fun (ctxt, _code_size_diff) ->
+  (* Set the spendable and delegatable flags to false so that no entrypoint gets added by
+     the [[process_contract_add_manager]] function. *)
+  Storage.Contract.Spendable_004.set ctxt contract false >>= fun ctxt ->
+  Storage.Contract.Delegatable_004.set ctxt contract false >>= fun ctxt ->
+  return ctxt
+
+(* The hash of the multisig contract; only contracts with this exact
+   hash are going to be updated by the [[update_contract_script]]
+   function. *)
+let multisig_hash : Script_expr_hash.t =
+  Script_expr_hash.of_bytes_exn @@
+  MBytes.of_hex @@
+  `Hex "475e37a6386d0b85890eb446db1faad67f85fc814724ad07473cac8c0a124b31"
+
+let process_contract_multisig (contract : Contract_repr.t) (ctxt : Raw_context.t) =
+  Contract_storage.get_script ctxt contract >>=? fun (ctxt, script_opt) ->
+  match script_opt with
+  | None ->
+      (* Do nothing on scriptless contracts *)
+      return ctxt
+  | Some { Script_repr.code = code ; Script_repr.storage = _storage } ->
+      (* The contract has some script, only try to modify it if it has
+         the hash of the multisig contract *)
+      Lwt.return (Script_repr.force_decode code) >>=? fun (code, _gas_cost) ->
+      let bytes =
+        Data_encoding.Binary.to_bytes_exn Script_repr.expr_encoding code
+      in
+      let hash = Script_expr_hash.hash_bytes [ bytes ] in
+      if Script_expr_hash.(hash = multisig_hash) then
+        migrate_multisig_script ctxt contract code
+      else
+        return ctxt
+
+(* Process an individual contract *)
+let process_contract contract ctxt =
+  process_contract_multisig contract ctxt >>=? fun ctxt ->
+  process_contract_add_manager contract ctxt >>=? fun ctxt ->
+  return ctxt
+
+let invoice_contract ctxt kt1_addr amount =
+  let amount = Tez_repr.of_mutez_exn (Int64.(mul 1_000_000L (of_int amount))) in
+  match Contract_repr.of_b58check kt1_addr with
+  | Ok recipient -> begin
+      Contract_storage.credit ctxt recipient amount >>= function
+      | Ok ctxt -> return ctxt
+      | Error _ -> return ctxt end
+  | Error _ -> return ctxt
+
+(* Extract Big_maps from their parent contract directory,
+   recompute their used space, and assign them an ID. *)
+let migrate_contract_big_map ctxt contract =
+  Storage.Contract.Code.get_option ctxt contract >>=? function
+  | ctxt, None -> return ctxt
+  | ctxt, Some code ->
+      Storage.Contract.Storage.get ctxt contract >>=? fun (ctxt, storage) ->
+      let extract_big_map_types expr =
+        let open Michelson_v1_primitives in
+        let open Micheline in
+        match Micheline.root expr with
+        | Seq (_, [ Prim (_, K_storage, [ expr ], _) ; _ ; _ ])
+        | Seq (_, [ _ ; Prim (_, K_storage, [ expr ], _) ; _ ])
+        | Seq (_, [ _ ; _ ; Prim (_, K_storage, [ expr ], _) ]) ->
+            begin match expr with
+              | Prim (_, T_pair, [ Prim (_, T_big_map, [ kt ; vt ], _ ) ; _ ], _) -> Some (kt, vt)
+              | _ -> None
+            end
+        | _ -> None in
+      let rewrite_big_map expr id =
+        let open Michelson_v1_primitives in
+        let open Micheline in
+        match Micheline.root expr with
+        | Prim (_, D_Pair, [ Seq (_, _ (* ignore_unused_origination_literal *)) ; pannot ], sannot) ->
+            Micheline.strip_locations (Prim (0, D_Pair, [ Int (0, id) ; pannot ], sannot))
+        | _ -> assert false in
+      Lwt.return (Script_repr.force_decode code) >>=? fun (code, _) ->
+      match extract_big_map_types code with
+      | None -> return ctxt
+      | Some (kt, vt) ->
+          Lwt.return (Script_repr.force_decode storage) >>=? fun (storage, _) ->
+          Storage.Big_map.Next.incr ctxt >>=? fun (ctxt, id) ->
+          let contract_path suffix =
+            "contracts" :: (* module Contract *)
+            "index" :: (* module Indexed_context *)
+            Contract_repr.Index.to_path contract suffix in
+          let old_path = contract_path [ "big_map" ] in
+          let storage = rewrite_big_map storage id in
+          Storage.Contract.Storage.set ctxt contract (Script_repr.lazy_expr storage) >>=? fun (ctxt, _) ->
+          let kt = Micheline.strip_locations (Script_repr.strip_annotations kt) in
+          let vt = Micheline.strip_locations (Script_repr.strip_annotations vt) in
+          Storage.Big_map.Key_type.init ctxt id kt >>=? fun ctxt ->
+          Storage.Big_map.Value_type.init ctxt id vt >>=? fun ctxt ->
+          Raw_context.dir_mem ctxt old_path >>= fun exists ->
+          if exists then
+            let read_size ctxt key =
+              Raw_context.get ctxt key >>=? fun len ->
+              match Data_encoding.(Binary.of_bytes int31) len with
+              | None -> assert false
+              | Some len -> return len in
+            let iter_sizes f (ctxt, acc) =
+              let rec dig i path (ctxt, acc) =
+                if Compare.Int.(i <= 0) then
+                  Raw_context.fold ctxt path ~init:(ok (ctxt, acc)) ~f:begin fun k acc ->
+                    Lwt.return acc >>=? fun (ctxt, acc) ->
+                    match k with
+                    | `Dir _ -> return (ctxt, acc)
+                    | `Key file ->
+                        match List.rev file with
+                        | last :: _ when Compare.String.(last = "data") ->
+                            return (ctxt, acc)
+                        | last :: _ when Compare.String.(last = "len") ->
+                            read_size ctxt file >>=? fun len ->
+                            return (ctxt, f len acc)
+                        | _ -> assert false
+                  end
+                else
+                  Raw_context.fold ctxt path ~init:(ok (ctxt, acc)) ~f:begin fun k acc ->
+                    Lwt.return acc >>=? fun (ctxt, acc) ->
+                    match k with
+                    | `Dir k -> dig (i-1) k (ctxt, acc)
+                    | `Key _ -> return (ctxt, acc)
+                  end in
+              dig Script_expr_hash.path_length old_path (ctxt, acc) in
+            iter_sizes
+              (fun s acc -> (acc |> Z.add (Z.of_int s) |> Z.add (Z.of_int 65)))
+              (ctxt, (Z.of_int 0)) >>=? fun (ctxt, total_bytes) ->
+            Storage.Big_map.Total_bytes.init ctxt id total_bytes >>=? fun ctxt ->
+            let new_path = "big_maps" :: (* module Big_map *)
+                           "index" :: (* module Indexed_context *)
+                           Storage.Big_map.Index.to_path id [
+                             "contents" ; (* module Delegated *)
+                           ] in
+            Raw_context.copy ctxt old_path new_path >>=? fun ctxt ->
+            Raw_context.remove_rec ctxt old_path >>= fun ctxt ->
+            read_size ctxt (contract_path [ "len" ; "code" ]) >>=? fun code_size ->
+            read_size ctxt (contract_path [ "len" ; "storage" ]) >>=? fun storage_size ->
+            let total_bytes =
+              total_bytes |>
+              Z.add (Z.of_int 33) |>
+              Z.add (Z.of_int code_size) |>
+              Z.add (Z.of_int storage_size) in
+            Storage.Contract.Used_storage_space.get ctxt contract >>=? fun previous_size ->
+            Storage.Contract.Paid_storage_space.get ctxt contract >>=? fun paid_bytes ->
+            let change = Z.sub paid_bytes previous_size in
+            Storage.Contract.Used_storage_space.set ctxt contract total_bytes >>=? fun ctxt ->
+            Storage.Contract.Paid_storage_space.set ctxt contract (Z.add total_bytes change)
+          else
+            Storage.Big_map.Total_bytes.init ctxt id Z.zero >>=? fun ctxt ->
+            return ctxt
+
 let prepare_first_block ctxt ~typecheck ~level ~timestamp ~fitness =
   Raw_context.prepare_first_block
     ~level ~timestamp ~fitness ctxt >>=? fun (previous_protocol, ctxt) ->
+  Storage.Big_map.Next.init ctxt >>=? fun ctxt ->
   match previous_protocol with
   | Genesis param ->
       Commitment_storage.init ctxt param.commitments >>=? fun ctxt ->
@@ -41,11 +356,24 @@ let prepare_first_block ctxt ~typecheck ~level ~timestamp ~fitness =
         param.bootstrap_contracts >>=? fun ctxt ->
       Roll_storage.init_first_cycles ctxt >>=? fun ctxt ->
       Vote_storage.init ctxt >>=? fun ctxt ->
-      Storage.Last_block_priority.init ctxt 0 >>=? fun ctxt ->
+      Storage.Block_priority.init ctxt 0 >>=? fun ctxt ->
       Vote_storage.freeze_listings ctxt >>=? fun ctxt ->
       return ctxt
-  | Alpha_previous ->
+  | Athens_004 ->
+      Storage.Vote.Current_quorum_004.get ctxt >>=? fun quorum ->
+      Storage.Vote.Participation_ema.init ctxt quorum >>=? fun ctxt ->
+      Storage.Vote.Current_quorum_004.delete ctxt >>=? fun ctxt ->
+      Storage.Block_priority.init ctxt 0 >>=? fun ctxt ->
+      Storage.Last_block_priority.delete ctxt >>=? fun ctxt ->
+      Storage.Contract.fold ctxt ~init:(Ok ctxt)
+        ~f:(fun contract ctxt ->
+            Lwt.return ctxt >>=? fun ctxt ->
+            migrate_delegated ctxt contract >>=? fun ctxt ->
+            migrate_contract_big_map ctxt contract >>=? fun ctxt ->
+            process_contract contract ctxt)
+      >>=? fun ctxt ->
+      invoice_contract ctxt "KT1DUfaMfTRZZkvZAYQT5b3byXnvqoAykc43" 500 >>=? fun ctxt ->
       return ctxt
 
-let prepare ctxt ~level ~timestamp ~fitness =
+let prepare ctxt ~level ~predecessor_timestamp ~timestamp ~fitness =
-  Raw_context.prepare ~level ~timestamp ~fitness ctxt
+  Raw_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt

vendors/ligo-utils/tezos-protocol-alpha/legacy_script_support_repr.ml

@@ -0,0 +1,532 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs <contact@nomadic-labs.com>                *)
+(* Copyright (c) 2019 Cryptium Labs <contact@cryptium-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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+let manager_script_code: Script_repr.lazy_expr =
+  let open Micheline in
+  let open Michelson_v1_primitives in
+  Script_repr.lazy_expr @@ strip_locations @@
+  Seq (0, [
+      Prim (0, K_parameter, [
+          Prim (0, T_or, [
+              Prim (0, T_lambda, [
+                  Prim (0, T_unit, [], []);
+                  Prim (0, T_list, [
+                      Prim (0, T_operation, [], [])
+                    ], [])
+                ], ["%do"]);
+              Prim (0, T_unit, [], ["%default"])
+            ], [])
+        ], []);
+      Prim (0, K_storage, [
+          Prim (0, T_key_hash, [], [])
+        ], []);
+      Prim (0, K_code, [
+          Seq (0, [
+              Seq (0, [
+                  Seq (0, [
+                      Prim (0, I_DUP, [], []);
+                      Prim (0, I_CAR, [], []);
+                      Prim (0, I_DIP, [
+                          Seq (0, [
+                              Prim (0, I_CDR, [], [])
+                            ])
+                        ], [])
+                    ])
+                ]);
+              Prim (0, I_IF_LEFT, [
+                  Seq (0, [
+                      Prim (0, I_PUSH, [
+                          Prim (0, T_mutez, [], []);
+                          Int (0, Z.zero)
+                        ], []);
+                      Prim (0, I_AMOUNT, [], []);
+                      Seq (0, [
+                          Seq (0, [
+                              Prim (0, I_COMPARE, [], []);
+                              Prim (0, I_EQ, [], [])
+                            ]);
+                          Prim (0, I_IF, [
+                              Seq (0, []);
+                              Seq (0, [
+                                  Seq (0, [
+                                      Prim (0, I_UNIT, [], []);
+                                      Prim (0, I_FAILWITH, [], [])
+                                    ])
+                                ])
+                            ], [])
+                        ]);
+                      Seq (0, [
+                          Prim (0, I_DIP, [
+                              Seq (0, [
+                                  Prim (0, I_DUP, [], [])
+                                ])
+                            ], []);
+                          Prim (0, I_SWAP, [], [])
+                        ]);
+                      Prim (0, I_IMPLICIT_ACCOUNT, [], []);
+                      Prim (0, I_ADDRESS, [], []);
+                      Prim (0, I_SENDER, [], []);
+                      Seq (0, [
+                          Seq (0, [
+                              Prim (0, I_COMPARE, [], []);
+                              Prim (0, I_EQ, [], [])
+                            ]);
+                          Prim (0, I_IF, [
+                              Seq (0, []);
+                              Seq (0, [
+                                  Seq (0, [
+                                      Prim (0, I_UNIT, [], []);
+                                      Prim (0, I_FAILWITH, [], [])
+                                    ])
+                                ])
+                            ], [])
+                        ]);
+                      Prim (0, I_UNIT, [], []);
+                      Prim (0, I_EXEC, [], []);
+                      Prim (0, I_PAIR, [], [])
+                    ]);
+                  Seq (0, [
+                      Prim (0, I_DROP, [], []);
+                      Prim (0, I_NIL, [
+                          Prim (0, T_operation, [], [])
+                        ], []);
+                      Prim (0, I_PAIR, [], [])
+                    ])
+                ], [])
+            ])
+        ], [])
+    ])
+
+(* Find the toplevel expression with a given prim type from list,
+   because they can be in arbitrary order. *)
+let find_toplevel toplevel exprs =
+  let open Micheline in
+  let rec iter toplevel = function
+    | (Prim (_, prim, _, _) as found) :: _
+      when String.equal toplevel (Michelson_v1_primitives.string_of_prim prim) ->
+        Some found
+    | _ :: rest ->
+        iter toplevel rest
+    | [] ->
+        None in
+  iter (Michelson_v1_primitives.string_of_prim toplevel) exprs
+
+let add_do:
+  manager_pkh: Signature.Public_key_hash.t ->
+  script_code: Script_repr.lazy_expr ->
+  script_storage: Script_repr.lazy_expr ->
+  (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t =
+  fun ~manager_pkh ~script_code ~script_storage ->
+  let open Micheline in
+  let open Michelson_v1_primitives in
+  Lwt.return (Script_repr.force_decode script_code) >>=? fun (script_code_expr, _gas_cost) ->
+  Lwt.return (Script_repr.force_decode script_storage) >>|? fun (script_storage_expr, _gas_cost) ->
+  let storage_expr = root script_storage_expr in
+  match root script_code_expr with
+  | Seq (_, toplevel)
+    -> begin
+        match find_toplevel K_parameter toplevel,
+              find_toplevel K_storage toplevel,
+              find_toplevel K_code toplevel with
+          Some (Prim (_, K_parameter, [
+              Prim (_, parameter_type, parameter_expr, parameter_annot)
+            ], prim_param_annot)),
+          Some (Prim (_, K_storage, [
+              Prim (_, code_storage_type, code_storage_expr, code_storage_annot)
+            ], k_storage_annot)),
+          Some (Prim (_, K_code, [code_expr], code_annot)) ->
+            (* Note that we intentionally don't deal with potential duplicate entrypoints in this migration as there already might be some in contracts that we don't touch. *)
+
+            let migrated_code =
+              Seq (0, [
+                  Prim (0, K_parameter, [
+                      Prim (0, T_or, [
+                          Prim (0, T_lambda, [
+                              Prim (0, T_unit, [], []);
+                              Prim (0, T_list, [
+                                  Prim (0, T_operation, [], [])
+                                ], [])
+                            ], ["%do"]);
+                          Prim (0, parameter_type, parameter_expr, "%default" :: parameter_annot)
+                        ], [])
+                    ], prim_param_annot);
+                  Prim (0, K_storage, [
+                      Prim (0, T_pair, [
+                          Prim (0, T_key_hash, [], []);
+                          Prim (0, code_storage_type, code_storage_expr, code_storage_annot)
+                        ], [])
+                    ], k_storage_annot);
+                  Prim (0, K_code, [
+                      Seq (0, [
+                          Prim (0, I_DUP, [], []);
+                          Prim (0, I_CAR, [], []);
+                          Prim (0, I_IF_LEFT, [
+                              Seq (0, [
+                                  Prim (0, I_PUSH, [
+                                      Prim (0, T_mutez, [], []);
+                                      Int (0, Z.zero)
+                                    ], []);
+                                  Prim (0, I_AMOUNT, [], []);
+                                  Seq (0, [
+                                      Seq (0, [
+                                          Prim (0, I_COMPARE, [], []);
+                                          Prim (0, I_EQ, [], [])
+                                        ]);
+                                      Prim (0, I_IF, [
+                                          Seq (0, []);
+                                          Seq (0, [
+                                              Seq (0, [
+                                                  Prim (0, I_UNIT, [], []);
+                                                  Prim (0, I_FAILWITH, [], [])
+                                                ])
+                                            ])
+                                        ], [])
+                                    ]);
+                                  Seq (0, [
+                                      Prim (0, I_DIP, [
+                                          Seq (0, [
+                                              Prim (0, I_DUP, [], [])
+                                            ])
+                                        ], []);
+                                      Prim (0, I_SWAP, [], [])
+                                    ]);
+                                  Prim (0, I_CDR, [], []);
+                                  Prim (0, I_CAR, [], []);
+                                  Prim (0, I_IMPLICIT_ACCOUNT, [], []);
+                                  Prim (0, I_ADDRESS, [], []);
+                                  Prim (0, I_SENDER, [], []);
+                                  Seq (0, [
+                                      Prim (0, I_COMPARE, [], []);
+                                      Prim (0, I_NEQ, [], []);
+                                      Prim (0, I_IF, [
+                                          Seq (0, [
+                                              Prim (0, I_SENDER, [], []);
+                                              Prim (0, I_PUSH, [
+                                                  Prim (0, T_string, [], []);
+                                                  String (0, "Only the owner can operate.")
+                                                ], []);
+                                              Prim (0, I_PAIR, [], []);
+                                              Prim (0, I_FAILWITH, [], [])
+                                            ]);
+                                          Seq (0, [
+                                              Prim (0, I_UNIT, [], []);
+                                              Prim (0, I_EXEC, [], []);
+                                              Prim (0, I_DIP, [
+                                                  Seq (0, [
+                                                      Prim (0, I_CDR, [], [])
+                                                    ])
+                                                ], []);
+                                              Prim (0, I_PAIR, [], [])
+                                            ])
+                                        ], [])
+                                    ])
+                                ]);
+                              Seq (0, [
+                                  Prim (0, I_DIP, [
+                                      Seq (0, [
+                                          Prim (0, I_CDR, [], []);
+                                          Prim (0, I_DUP, [], []);
+                                          Prim (0, I_CDR, [], [])
+                                        ])
+                                    ], []);
+                                  Prim (0, I_PAIR, [], []);
+
+                                  code_expr;
+
+                                  Prim (0, I_SWAP, [], []);
+                                  Prim (0, I_CAR, [], []);
+                                  Prim (0, I_SWAP, [], []);
+                                  Seq (0, [
+                                      Seq (0, [
+                                          Prim (0, I_DUP, [], []);
+                                          Prim (0, I_CAR, [], []);
+                                          Prim (0, I_DIP, [
+                                              Seq (0, [
+                                                  Prim (0, I_CDR, [], [])
+                                                ])
+                                            ], [])
+                                        ])
+                                    ]);
+                                  Prim (0, I_DIP, [
+                                      Seq (0, [
+                                          Prim (0, I_SWAP, [], []);
+                                          Prim (0, I_PAIR, [], [])
+                                        ])
+                                    ], []);
+                                  Prim (0, I_PAIR, [], [])
+                                ])
+                            ], [])
+                        ])
+                    ], code_annot)
+                ])
+            in
+            let migrated_storage = Prim (0, D_Pair, [
+                (* Instead of
+                   `String (0, Signature.Public_key_hash.to_b58check manager_pkh)`
+                   the storage is written as unparsed with [Optimized] *)
+                Bytes (0, Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding manager_pkh) ;
+                storage_expr
+              ], []) in
+            Script_repr.lazy_expr @@ strip_locations migrated_code,
+            Script_repr.lazy_expr @@ strip_locations migrated_storage
+        | _ ->
+            script_code, script_storage
+      end
+  | _ ->
+      script_code, script_storage
+
+
+
+let add_set_delegate:
+  manager_pkh: Signature.Public_key_hash.t ->
+  script_code: Script_repr.lazy_expr ->
+  script_storage: Script_repr.lazy_expr ->
+  (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t =
+  fun ~manager_pkh ~script_code ~script_storage ->
+  let open Micheline in
+  let open Michelson_v1_primitives in
+  Lwt.return (Script_repr.force_decode script_code) >>=? fun (script_code_expr, _gas_cost) ->
+  Lwt.return (Script_repr.force_decode script_storage) >>|? fun (script_storage_expr, _gas_cost) ->
+  let storage_expr = root script_storage_expr in
+  match root script_code_expr with
+  | Seq (_, toplevel)
+    -> begin
+        match find_toplevel K_parameter toplevel,
+              find_toplevel K_storage toplevel,
+              find_toplevel K_code toplevel with
+          Some (Prim (_, K_parameter, [
+              Prim (_, parameter_type, parameter_expr, parameter_annot)
+            ], prim_param_annot)),
+          Some (Prim (_, K_storage, [
+              Prim (_, code_storage_type, code_storage_expr, code_storage_annot)
+            ], k_storage_annot)),
+          Some (Prim (_, K_code, [code_expr], code_annot)) ->
+            (* Note that we intentionally don't deal with potential duplicate entrypoints in this migration as there already might be some in contracts that we don't touch. *)
+
+            let migrated_code =
+              Seq (0, [
+                  Prim (0, K_parameter, [
+                      Prim (0, T_or, [
+                          Prim (0, T_or, [
+                              Prim (0, T_key_hash, [], ["%set_delegate"]);
+                              Prim (0, T_unit, [], ["%remove_delegate"])
+                            ], []);
+                          Prim (0, parameter_type, parameter_expr, "%default" :: parameter_annot)
+                        ], [])
+                    ], prim_param_annot);
+                  Prim (0, K_storage, [
+                      Prim (0, T_pair, [
+                          Prim (0, T_key_hash, [], []);
+                          Prim (0, code_storage_type, code_storage_expr, code_storage_annot)
+                        ], [])
+                    ], k_storage_annot);
+                  Prim (0, K_code, [
+                      Seq (0, [
+                          Prim (0, I_DUP, [], []);
+                          Prim (0, I_CAR, [], []);
+                          Prim (0, I_IF_LEFT, [
+                              Seq (0, [
+                                  Prim (0, I_PUSH, [
+                                      Prim (0, T_mutez, [], []);
+                                      Int (0, Z.zero)
+                                    ], []);
+                                  Prim (0, I_AMOUNT, [], []);
+                                  Seq (0, [
+                                      Seq (0, [
+                                          Prim (0, I_COMPARE, [], []);
+                                          Prim (0, I_EQ, [], [])
+                                        ]);
+                                      Prim (0, I_IF, [
+                                          Seq (0, []);
+                                          Seq (0, [
+                                              Seq (0, [
+                                                  Prim (0, I_UNIT, [], []);
+                                                  Prim (0, I_FAILWITH, [], [])
+                                                ])
+                                            ])
+                                        ], [])
+                                    ]);
+                                  Seq (0, [
+                                      Prim (0, I_DIP, [
+                                          Seq (0, [
+                                              Prim (0, I_DUP, [], [])
+                                            ])
+                                        ], []);
+                                      Prim (0, I_SWAP, [], [])
+                                    ]);
+                                  Prim (0, I_CDR, [], []);
+                                  Prim (0, I_CAR, [], []);
+                                  Prim (0, I_IMPLICIT_ACCOUNT, [], []);
+                                  Prim (0, I_ADDRESS, [], []);
+                                  Prim (0, I_SENDER, [], []);
+                                  Seq (0, [
+                                      Prim (0, I_COMPARE, [], []);
+                                      Prim (0, I_NEQ, [], []);
+                                      Prim (0, I_IF, [
+                                          Seq (0, [
+                                              Prim (0, I_SENDER, [], []);
+                                              Prim (0, I_PUSH, [
+                                                  Prim (0, T_string, [], []);
+                                                  String (0, "Only the owner can operate.")
+                                                ], []);
+                                              Prim (0, I_PAIR, [], []);
+                                              Prim (0, I_FAILWITH, [], [])
+                                            ]);
+                                          Seq (0, [
+                                              Prim (0, I_DIP, [
+                                                  Seq (0, [
+                                                      Prim (0, I_CDR, [], []);
+                                                      Prim (0, I_NIL, [
+                                                          Prim (0, T_operation, [], [])
+                                                        ], [])
+                                                    ])
+                                                ], []);
+                                              Prim (0, I_IF_LEFT, [
+                                                  Seq (0, [
+                                                      Prim (0, I_SOME, [], []);
+                                                      Prim (0, I_SET_DELEGATE, [], []);
+                                                      Prim (0, I_CONS, [], []);
+                                                      Prim (0, I_PAIR, [], [])
+                                                    ]);
+                                                  Seq (0, [
+                                                      Prim (0, I_DROP, [], []);
+                                                      Prim (0, I_NONE, [
+                                                          Prim (0, T_key_hash, [], [])
+                                                        ], []);
+                                                      Prim (0, I_SET_DELEGATE, [], []);
+                                                      Prim (0, I_CONS, [], []);
+                                                      Prim (0, I_PAIR, [], [])
+                                                    ])
+                                                ], [])
+                                            ])
+                                        ], [])
+                                    ])
+                                ]);
+                              Seq (0, [
+                                  Prim (0, I_DIP, [
+                                      Seq (0, [
+                                          Prim (0, I_CDR, [], []);
+                                          Prim (0, I_DUP, [], []);
+                                          Prim (0, I_CDR, [], [])
+                                        ])
+                                    ], []);
+                                  Prim (0, I_PAIR, [], []);
+
+                                  code_expr;
+
+                                  Prim (0, I_SWAP, [], []);
+                                  Prim (0, I_CAR, [], []);
+                                  Prim (0, I_SWAP, [], []);
+                                  Seq (0, [
+                                      Seq (0, [
+                                          Prim (0, I_DUP, [], []);
+                                          Prim (0, I_CAR, [], []);
+                                          Prim (0, I_DIP, [
+                                              Seq (0, [
+                                                  Prim (0, I_CDR, [], [])
+                                                ])
+                                            ], [])
+                                        ])
+                                    ]);
+                                  Prim (0, I_DIP, [
+                                      Seq (0, [
+                                          Prim (0, I_SWAP, [], []);
+                                          Prim (0, I_PAIR, [], [])
+                                        ])
+                                    ], []);
+                                  Prim (0, I_PAIR, [], [])
+                                ])
+                            ], [])
+                        ])
+                    ], code_annot)
+                ])
+            in
+            let migrated_storage = Prim (0, D_Pair, [
+                (* Instead of
+                   `String (0, Signature.Public_key_hash.to_b58check manager_pkh)`
+                   the storage is written as unparsed with [Optimized] *)
+                Bytes (0, Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding manager_pkh) ;
+                storage_expr
+              ], []) in
+            Script_repr.lazy_expr @@ strip_locations migrated_code,
+            Script_repr.lazy_expr @@ strip_locations migrated_storage
+        | _ ->
+            script_code, script_storage
+      end
+  | _ ->
+      script_code, script_storage
+
+let has_default_entrypoint expr =
+  let open Micheline in
+  let open Michelson_v1_primitives in
+  match Script_repr.force_decode expr with
+  | Error _ -> false
+  | Ok (expr, _) ->
+      match root expr with
+      | Seq (_, toplevel) -> begin
+          match find_toplevel K_parameter toplevel with
+          | Some (Prim (_, K_parameter, [ _ ], [ "%default" ])) -> false
+          | Some (Prim (_, K_parameter, [ parameter_expr ], _)) ->
+              let rec has_default = function
+                | Prim (_, T_or, [ l ; r ], annots) ->
+                    List.exists (String.equal "%default") annots || has_default l || has_default r
+                | Prim (_, _, _, annots) ->
+                    List.exists (String.equal "%default") annots
+                | _ -> false
+              in
+              has_default parameter_expr
+          | Some _ | None -> false
+        end
+      | _ -> false
+
+let add_root_entrypoint
+  : script_code: Script_repr.lazy_expr -> Script_repr.lazy_expr tzresult Lwt.t
+  = fun ~script_code ->
+    let open Micheline in
+    let open Michelson_v1_primitives in
+    Lwt.return (Script_repr.force_decode script_code) >>|? fun (script_code_expr, _gas_cost) ->
+    match root script_code_expr with
+    | Seq (_, toplevel) ->
+        let migrated_code =
+          Seq (0, List.map (function
+              | Prim (_, K_parameter, [ parameter_expr ], _) ->
+                  Prim (0, K_parameter, [ parameter_expr ], [ "%root" ])
+              | Prim (_, K_code, exprs, annots) ->
+                  let rec rewrite_self = function
+                    | Int _ | String _ | Bytes _ | Prim (_, I_CREATE_CONTRACT, _, _) as leaf -> leaf
+                    | Prim (_, I_SELF, [], annots) ->
+                        Prim (0, I_SELF, [], "%root" :: annots)
+                    | Prim (_, name, args, annots) ->
+                        Prim (0, name, List.map rewrite_self args, annots)
+                    | Seq (_, args) ->
+                        Seq (0, List.map rewrite_self args) in
+                  Prim (0, K_code, List.map rewrite_self exprs, annots)
+              | other -> other)
+              toplevel) in
+        Script_repr.lazy_expr @@ strip_locations migrated_code
+    | _ ->
+        script_code

vendors/ligo-utils/tezos-protocol-alpha/legacy_script_support_repr.mli

@@ -0,0 +1,69 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs <contact@nomadic-labs.com>                *)
+(* Copyright (c) 2019 Cryptium Labs <contact@cryptium-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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** This code mimics the now defunct scriptless KT1s.
+
+    The manager contract is from:
+    https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/manager.tz
+    The formal proof is at:
+    https://gitlab.com/nomadic-labs/mi-cho-coq/blob/a7603e12021166e15890f6d504feebec2f945502/src/contracts_coq/manager.v *)
+val manager_script_code: Script_repr.lazy_expr
+
+(** This code mimics the now defunct "spendable" flags of KT1s by
+    adding a [do] entrypoint, preserving the original script's at
+    'default' entrypoint.
+
+    The pseudo-code for the applied transformations is from:
+    https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/transform/add_do.tz *)
+val add_do:
+  manager_pkh: Signature.Public_key_hash.t ->
+  script_code: Script_repr.lazy_expr ->
+  script_storage: Script_repr.lazy_expr ->
+  (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t
+
+(** This code mimics the now defunct "spendable" flags of KT1s by
+    adding a [do] entrypoint, preserving the original script's at
+    'default' entrypoint.
+
+    The pseudo-code for the applied transformations is from:
+    https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/transform/add_set_delegate.tz *)
+val add_set_delegate:
+  manager_pkh: Signature.Public_key_hash.t ->
+  script_code: Script_repr.lazy_expr ->
+  script_storage: Script_repr.lazy_expr ->
+  (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t
+
+(** Checks if a contract was declaring a default entrypoint somewhere
+   else than at the root, in which case its type changes when
+   entrypoints are activated. *)
+val has_default_entrypoint:
+  Script_repr.lazy_expr -> bool
+
+(** Adds a [%root] annotation on the toplevel parameter construct. *)
+val add_root_entrypoint:
+  script_code: Script_repr.lazy_expr ->
+  Script_repr.lazy_expr tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/main.ml

@@ -54,7 +54,6 @@ type operation = Alpha_context.packed_operation = {
   protocol_data: operation_data ;
 }
 
-
 let acceptable_passes = Alpha_context.Operation.acceptable_passes
 
 let max_block_length =
@@ -81,10 +80,12 @@ type validation_mode =
   | Application of {
       block_header : Alpha_context.Block_header.t ;
       baker : Alpha_context.public_key_hash ;
+      block_delay : Alpha_context.Period.t ;
     }
   | Partial_application of {
       block_header : Alpha_context.Block_header.t ;
       baker : Alpha_context.public_key_hash ;
+      block_delay : Alpha_context.Period.t ;
     }
   | Partial_construction of {
       predecessor : Block_hash.t ;
@@ -93,6 +94,7 @@ type validation_mode =
       predecessor : Block_hash.t ;
       protocol_data : Alpha_context.Block_header.contents ;
       baker : Alpha_context.public_key_hash ;
+      block_delay : Alpha_context.Period.t ;
     }
 
 type validation_state =
@@ -114,12 +116,12 @@ let begin_partial_application
   let level = block_header.shell.level in
   let fitness = predecessor_fitness in
   let timestamp = block_header.shell.timestamp in
-  Alpha_context.prepare ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->
+  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt >>=? fun ctxt ->
   Apply.begin_application
-    ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker) ->
+    ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker, block_delay) ->
   let mode =
     Partial_application
-      { block_header ; baker = Signature.Public_key.hash baker } in
+      { block_header ; baker = Signature.Public_key.hash baker ; block_delay } in
   return { mode ; chain_id ; ctxt ; op_count = 0 }
 
 let begin_application
@@ -131,16 +133,17 @@ let begin_application
   let level = block_header.shell.level in
   let fitness = predecessor_fitness in
   let timestamp = block_header.shell.timestamp in
-  Alpha_context.prepare ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->
+  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt >>=? fun ctxt ->
   Apply.begin_application
-    ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker) ->
+    ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker, block_delay) ->
-  let mode = Application { block_header ; baker = Signature.Public_key.hash baker } in
+  let mode =
+    Application { block_header ; baker = Signature.Public_key.hash baker ; block_delay } in
   return { mode ; chain_id ; ctxt ; op_count = 0 }
 
 let begin_construction
     ~chain_id
     ~predecessor_context:ctxt
-    ~predecessor_timestamp:pred_timestamp
+    ~predecessor_timestamp
     ~predecessor_level:pred_level
     ~predecessor_fitness:pred_fitness
     ~predecessor
@@ -149,7 +152,7 @@ let begin_construction
     () =
   let level = Int32.succ pred_level in
   let fitness = pred_fitness in
-  Alpha_context.prepare ~timestamp ~level ~fitness ctxt >>=? fun ctxt ->
+  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt >>=? fun ctxt ->
   begin
     match protocol_data with
     | None ->
@@ -158,11 +161,11 @@ let begin_construction
         return (mode, ctxt)
     | Some proto_header ->
         Apply.begin_full_construction
-          ctxt pred_timestamp
+          ctxt predecessor_timestamp
-          proto_header.contents >>=? fun (ctxt, protocol_data, baker) ->
+          proto_header.contents >>=? fun (ctxt, protocol_data, baker, block_delay) ->
         let mode =
           let baker = Signature.Public_key.hash baker in
-          Full_construction { predecessor ; baker ; protocol_data } in
+          Full_construction { predecessor ; baker ; protocol_data ; block_delay } in
         return (mode, ctxt)
   end >>=? fun (mode, ctxt) ->
   return { mode ; chain_id ; ctxt ; op_count = 0 }
@@ -192,13 +195,7 @@ let apply_operation
         | Partial_construction { predecessor }
           -> predecessor, Signature.Public_key_hash.zero
       in
-      let partial =
+      Apply.apply_operation ctxt chain_id Optimized predecessor baker
-        match mode with
-        | Partial_construction _ -> true
-        | Application _
-        | Full_construction _
-        | Partial_application _ -> false in
-      Apply.apply_operation ~partial ctxt chain_id Optimized predecessor baker
         (Alpha_context.Operation.hash operation)
         operation >>=? fun (ctxt, result) ->
       let op_count = op_count + 1 in
@@ -224,8 +221,12 @@ let finalize_block { mode ; ctxt ; op_count } =
                                     consumed_gas = Z.zero ;
                                     deactivated = [];
                                     balance_updates = []})
-  | Partial_application { baker ; _ } ->
+  | Partial_application { block_header ; baker ; block_delay } ->
-      let level = Alpha_context. Level.current ctxt in
+      let level = Alpha_context.Level.current ctxt in
+      let included_endorsements = Alpha_context.included_endorsements ctxt in
+      Apply.check_minimum_endorsements ctxt
+        block_header.protocol_data.contents
+        block_delay included_endorsements >>=? fun () ->
       Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind ->
       let ctxt = Alpha_context.finalize ctxt in
       return (ctxt, Apply_results.{ baker ;
@@ -236,16 +237,16 @@ let finalize_block { mode ; ctxt ; op_count } =
                                     deactivated = [];
                                     balance_updates = []})
   | Application
-      { baker ;  block_header = { protocol_data = { contents = protocol_data ; _ } ; _ } }
+      { baker ; block_delay ; block_header = { protocol_data = { contents = protocol_data ; _ } ; _ } }
-  | Full_construction { protocol_data ; baker ; _ } ->
+  | Full_construction { protocol_data ; baker ; block_delay ; _ } ->
-      Apply.finalize_application ctxt protocol_data baker >>=? fun (ctxt, receipt) ->
+      Apply.finalize_application ctxt protocol_data baker ~block_delay >>=? fun (ctxt, receipt) ->
       let level = Alpha_context.Level.current ctxt in
       let priority = protocol_data.priority in
       let raw_level = Alpha_context.Raw_level.to_int32 level.level in
       let fitness = Alpha_context.Fitness.current ctxt in
       let commit_message =
         Format.asprintf
-          "lvl %ld, fit %Ld, prio %d, %d ops"
+          "lvl %ld, fit 1:%Ld, prio %d, %d ops"
           raw_level fitness priority op_count in
       let ctxt = Alpha_context.finalize ~commit_message ctxt in
       return (ctxt, receipt)
@@ -298,11 +299,17 @@ let init ctxt block_header =
   let fitness = block_header.fitness in
   let timestamp = block_header.timestamp in
   let typecheck (ctxt:Alpha_context.context) (script:Alpha_context.Script.t) =
-    Script_ir_translator.parse_script ctxt script >>=? fun (ex_script, ctxt) ->
+    Script_ir_translator.parse_script ctxt ~legacy:false script >>=? fun (Ex_script parsed_script, ctxt) ->
-    Script_ir_translator.big_map_initialization ctxt Optimized ex_script >>=? fun (big_map_diff, ctxt) ->
+    Script_ir_translator.extract_big_map_diff ctxt Optimized parsed_script.storage_type parsed_script.storage
-    return ((script, big_map_diff), ctxt)
+      ~to_duplicate: Script_ir_translator.no_big_map_id
+      ~to_update: Script_ir_translator.no_big_map_id
+      ~temporary:false >>=? fun (storage, big_map_diff, ctxt) ->
+    Script_ir_translator.unparse_data ctxt Optimized parsed_script.storage_type storage >>=? fun (storage, ctxt) ->
+    let storage = Alpha_context.Script.lazy_expr (Micheline.strip_locations storage) in
+    return (({ script with storage }, big_map_diff), ctxt)
   in
   Alpha_context.prepare_first_block
     ~typecheck
     ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->
   return (Alpha_context.finalize ctxt)
+(* Vanity nonce: 415767323 *)

vendors/ligo-utils/tezos-protocol-alpha/main.mli

@@ -29,10 +29,12 @@ type validation_mode =
   | Application of {
       block_header : Alpha_context.Block_header.t ;
       baker : Alpha_context.public_key_hash ;
+      block_delay : Alpha_context.Period.t ;
     }
   | Partial_application of {
       block_header : Alpha_context.Block_header.t ;
       baker : Alpha_context.public_key_hash ;
+      block_delay : Alpha_context.Period.t ;
     }
   | Partial_construction of {
       predecessor : Block_hash.t ;
@@ -41,6 +43,7 @@ type validation_mode =
       predecessor : Block_hash.t ;
       protocol_data : Alpha_context.Block_header.contents ;
       baker : Alpha_context.public_key_hash ;
+      block_delay : Alpha_context.Period.t ;
     }
 
 type validation_state =

vendors/ligo-utils/tezos-protocol-alpha/michelson_v1_gas.ml

@@ -27,48 +27,6 @@ open Alpha_context
 open Gas
 
 module Cost_of = struct
-  let cycle = step_cost 1
-  let nop = free
-
-  let stack_op = step_cost 1
-
-  let bool_binop _ _ = step_cost 1
-  let bool_unop _ = step_cost 1
-
-  let pair = alloc_cost 2
-  let pair_access = step_cost 1
-
-  let cons = alloc_cost 2
-
-  let variant_no_data = alloc_cost 1
-
-  let branch = step_cost 2
-
-  let string length =
-    alloc_bytes_cost length
-
-  let bytes length =
-    alloc_mbytes_cost length
-
-  let zint z =
-    alloc_bits_cost (Z.numbits z)
-
-  let concat cost length ss =
-    let rec cum acc = function
-      | [] -> acc
-      | s :: ss -> cum (cost (length s) +@ acc) ss in
-    cum free ss
-
-  let concat_string ss = concat string String.length ss
-  let concat_bytes ss = concat bytes MBytes.length ss
-
-  let slice_string length = string length
-  let slice_bytes = alloc_cost 0
-
-  (* Cost per cycle of a loop, fold, etc *)
-  let loop_cycle = step_cost 2
-
-  let list_size = step_cost 1
 
   let log2 =
     let rec help acc = function
@@ -76,174 +34,265 @@ module Cost_of = struct
       | n -> help (acc + 1) (n / 2)
     in help 1
 
-  let module_cost = alloc_cost 10
+  let z_bytes (z : Z.t) =
+    let bits = Z.numbits z in
+    (7 + bits) / 8
 
-  let map_access : type key value. (key, value) Script_typed_ir.map -> int
+  let int_bytes (z : 'a Script_int.num) =
-    = fun (module Box) ->
+    z_bytes (Script_int.to_zint z)
-      log2 (snd Box.boxed)
 
-  let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost
+  let timestamp_bytes (t : Script_timestamp.t) =
-    = fun (module Box) ->
+    let z = Script_timestamp.to_zint t in
-      let size = snd Box.boxed in
+    z_bytes z
-      3 *@ alloc_cost size
 
-  let map_mem _key map = step_cost (map_access map)
+  (* For now, returns size in bytes, but this could get more complicated... *)
+  let rec size_of_comparable : type a b. (a, b) Script_typed_ir.comparable_struct -> a -> int =
+    fun wit v ->
+      match wit with
+      | Int_key _ -> int_bytes v
+      | Nat_key _ -> int_bytes v
+      | String_key _ -> String.length v
+      | Bytes_key _ -> MBytes.length v
+      | Bool_key _ -> 8
+      | Key_hash_key _ -> Signature.Public_key_hash.size
+      | Timestamp_key _ -> timestamp_bytes v
+      | Address_key _ -> Signature.Public_key_hash.size
+      | Mutez_key _ -> 8
+      | Pair_key ((l, _), (r, _), _) ->
+          let (lval, rval) = v in
+          size_of_comparable l lval + size_of_comparable r rval
 
-  let map_get = map_mem
+  let string length =
+    alloc_bytes_cost length
 
-  let map_update _ _ map =
+  let bytes length =
-    map_access map *@ alloc_cost 3
+    alloc_mbytes_cost length
-
-  let map_size = step_cost 2
-
-  let big_map_mem _key _map = step_cost 50
-  let big_map_get _key _map = step_cost 50
-  let big_map_update _key _value _map = step_cost 10
-
-  let set_access : type elt. elt -> elt Script_typed_ir.set -> int
-    = fun _key (module Box) ->
-      log2 @@ Box.size
-
-  let set_mem key set = step_cost (set_access key set)
-
-  let set_update key _presence set =
-    set_access key set *@ alloc_cost 3
-
-  (* for LEFT, RIGHT, SOME *)
-  let wrap = alloc_cost 1
-
-  let mul n1 n2 =
-    let steps =
-      (Z.numbits (Script_int.to_zint n1))
-      * (Z.numbits (Script_int.to_zint n2)) in
-    let bits =
-      (Z.numbits (Script_int.to_zint n1))
-      + (Z.numbits (Script_int.to_zint n2)) in
-    step_cost steps +@ alloc_bits_cost bits
-
-  let div n1 n2 =
-    mul n1 n2 +@ alloc_cost 2
-
-  let add_sub_z n1 n2 =
-    let bits =
-      Compare.Int.max (Z.numbits n1) (Z.numbits n2) in
-    step_cost bits +@ alloc_cost bits
-
-  let add n1 n2 =
-    add_sub_z (Script_int.to_zint n1) (Script_int.to_zint n2)
-
-  let sub = add
-
-  let abs n =
-    alloc_bits_cost (Z.numbits @@ Script_int.to_zint n)
-
-  let neg = abs
-  let int _ = step_cost 1
-
-  let add_timestamp t n =
-    add_sub_z (Script_timestamp.to_zint t) (Script_int.to_zint n)
-
-  let sub_timestamp t n =
-    add_sub_z (Script_timestamp.to_zint t) (Script_int.to_zint n)
-
-  let diff_timestamps t1 t2 =
-    add_sub_z (Script_timestamp.to_zint t1) (Script_timestamp.to_zint t2)
-
-  let empty_set = module_cost
-
-  let set_size = step_cost 2
-
-  let set_to_list : type item. item Script_typed_ir.set -> cost
-    = fun (module Box) ->
-      alloc_cost @@ Pervasives.(Box.size * 2)
-
-  let empty_map = module_cost
-
-  let int64_op = step_cost 1 +@ alloc_cost 1
-
-  let z_to_int64 = step_cost 2 +@ alloc_cost 1
-
-  let int64_to_z = step_cost 2 +@ alloc_cost 1
-
-  let bitwise_binop n1 n2 =
-    let bits = Compare.Int.max (Z.numbits (Script_int.to_zint n1)) (Z.numbits (Script_int.to_zint n2)) in
-    step_cost bits +@ alloc_bits_cost bits
-
-  let logor = bitwise_binop
-  let logand = bitwise_binop
-  let logxor = bitwise_binop
-  let lognot n =
-    let bits = Z.numbits @@ Script_int.to_zint n in
-    step_cost bits +@ alloc_cost bits
-
-  let unopt ~default = function
-    | None -> default
-    | Some x -> x
-
-  let max_int = 1073741823
-
-  let shift_left x y =
-    alloc_bits_cost
-      (Z.numbits (Script_int.to_zint x) +
-       (unopt (Script_int.to_int y) ~default:max_int))
-
-  let shift_right x y =
-    alloc_bits_cost
-      (Compare.Int.max 1
-         (Z.numbits (Script_int.to_zint x) -
-          unopt (Script_int.to_int y) ~default:max_int))
-
-  let exec = step_cost 1
-
-  let push = step_cost 1
-
-  let compare_res = step_cost 1
-
-  let unpack_failed bytes =
-    (* We cannot instrument failed deserialization,
-       so we take worst case fees: a set of size 1 bytes values. *)
-    let len = MBytes.length bytes in
-    (len *@ alloc_mbytes_cost 1) +@
-    (len *@ (log2 len *@ (alloc_cost 3 +@ step_cost 1)))
-
-  let address = step_cost 1
-  let contract = Gas.read_bytes_cost Z.zero +@ step_cost 10000
-  let transfer = step_cost 10
-  let create_account = step_cost 10
-  let create_contract = step_cost 10
-  let implicit_account = step_cost 10
-  let set_delegate = step_cost 10 +@ write_bytes_cost (Z.of_int 32)
-  let balance = step_cost 1 +@ read_bytes_cost (Z.of_int 8)
-  let now = step_cost 5
-  let check_signature = step_cost 1000
-  let hash_key = step_cost 3 +@ bytes 20
-  let hash data len = 10 *@ step_cost (MBytes.length data) +@ bytes len
-  let steps_to_quota = step_cost 1
-  let source = step_cost 1
-  let self = step_cost 1
-  let amount = step_cost 1
-  let compare_bool _ _ = step_cost 1
-  let compare_string s1 s2 =
-    step_cost ((7 + Compare.Int.max (String.length s1) (String.length s2)) / 8) +@ step_cost 1
-  let compare_bytes s1 s2 =
-    step_cost ((7 + Compare.Int.max (MBytes.length s1) (MBytes.length s2)) / 8) +@ step_cost 1
-  let compare_tez _ _ = step_cost 1
-  let compare_zint n1 n2 = step_cost ((7 + Compare.Int.max (Z.numbits n1) (Z.numbits n2)) / 8) +@ step_cost 1
-  let compare_int n1 n2 = compare_zint (Script_int.to_zint n1) (Script_int.to_zint n2)
-  let compare_nat = compare_int
-  let compare_key_hash _ _ = alloc_bytes_cost 36
-  let compare_timestamp t1 t2 = compare_zint (Script_timestamp.to_zint t1) (Script_timestamp.to_zint t2)
-  let compare_address _ _ = step_cost 20
 
   let manager_operation = step_cost 10_000
 
+  module Legacy = struct
+    let zint z =
+      alloc_bits_cost (Z.numbits z)
+
+    let set_to_list : type item. item Script_typed_ir.set -> cost
+      = fun (module Box) ->
+        alloc_cost @@ Pervasives.(Box.size * 2)
+
+    let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost
+      = fun (module Box) ->
+        let size = snd Box.boxed in
+        3 *@ alloc_cost size
+
+    let z_to_int64 = step_cost 2 +@ alloc_cost 1
+
+    let hash data len = 10 *@ step_cost (MBytes.length data) +@ bytes len
+
+    let set_access : type elt. elt -> elt Script_typed_ir.set -> int
+      = fun _key (module Box) ->
+        log2 @@ Box.size
+
+    let set_update key _presence set =
+      set_access key set *@ alloc_cost 3
+  end
+
+  module Interpreter = struct
+    let cycle = atomic_step_cost 10
+    let nop = free
+    let stack_op = atomic_step_cost 10
+    let push = atomic_step_cost 10
+    let wrap = atomic_step_cost 10
+    let variant_no_data = atomic_step_cost 10
+    let branch = atomic_step_cost 10
+    let pair = atomic_step_cost 10
+    let pair_access = atomic_step_cost 10
+    let cons = atomic_step_cost 10
+    let loop_size = atomic_step_cost 5
+    let loop_cycle = atomic_step_cost 10
+    let loop_iter = atomic_step_cost 20
+    let loop_map = atomic_step_cost 30
+    let empty_set = atomic_step_cost 10
+    let set_to_list : type elt. elt Script_typed_ir.set -> cost =
+      fun (module Box) ->
+        atomic_step_cost (Box.size * 20)
+
+    let set_mem : type elt. elt -> elt Script_typed_ir.set -> cost =
+      fun elt (module Box) ->
+        let elt_bytes = size_of_comparable Box.elt_ty elt in
+        atomic_step_cost ((1 + (elt_bytes / 82)) * log2 Box.size)
+
+    let set_update : type elt. elt -> bool -> elt Script_typed_ir.set -> cost =
+      fun elt _ (module Box) ->
+        let elt_bytes = size_of_comparable Box.elt_ty elt in
+        atomic_step_cost ((1 + (elt_bytes / 82)) * log2 Box.size)
+
+    let set_size = atomic_step_cost 10
+    let empty_map = atomic_step_cost 10
+    let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost =
+      fun (module Box) ->
+        let size = snd Box.boxed in
+        atomic_step_cost (size * 20)
+
+    let map_access : type key value. key -> (key, value) Script_typed_ir.map -> cost
+      = fun key (module Box) ->
+        let map_card  = snd Box.boxed in
+        let key_bytes = size_of_comparable Box.key_ty key in
+        atomic_step_cost ((1 + (key_bytes / 70)) * log2 map_card)
+
+    let map_mem = map_access
+    let map_get = map_access
+
+    let map_update : type key value. key -> value option -> (key, value) Script_typed_ir.map -> cost
+      = fun key _value (module Box) ->
+        let map_card  = snd Box.boxed in
+        let key_bytes = size_of_comparable Box.key_ty key in
+        atomic_step_cost ((1 + (key_bytes / 38)) * log2 map_card)
+
+    let map_size = atomic_step_cost 10
+
+    let add_timestamp (t1 : Script_timestamp.t) (t2 : 'a Script_int.num) =
+      let bytes1 = timestamp_bytes t1 in
+      let bytes2 = int_bytes t2 in
+      atomic_step_cost (51 + (Compare.Int.max bytes1 bytes2 / 62))
+    let sub_timestamp = add_timestamp
+    let diff_timestamps (t1 : Script_timestamp.t) (t2 : Script_timestamp.t) =
+      let bytes1 = timestamp_bytes t1 in
+      let bytes2 = timestamp_bytes t2 in
+      atomic_step_cost (51 + (Compare.Int.max bytes1 bytes2 / 62))
+
+    let rec concat_loop l acc =
+      match l with
+      | [] -> 30
+      | _ :: tl -> concat_loop tl (acc + 30)
+
+    let concat_string string_list =
+      atomic_step_cost (concat_loop string_list 0)
+
+    let slice_string string_length =
+      atomic_step_cost (40 + (string_length / 70))
+
+    let concat_bytes bytes_list =
+      atomic_step_cost (concat_loop bytes_list 0)
+
+    let int64_op = atomic_step_cost 61
+    let z_to_int64 = atomic_step_cost 20
+    let int64_to_z = atomic_step_cost 20
+    let bool_binop _ _ = atomic_step_cost 10
+    let bool_unop _ = atomic_step_cost 10
+
+    let abs int = atomic_step_cost (61 + ((int_bytes int) / 70))
+    let int _int = free
+    let neg = abs
+    let add i1 i2 = atomic_step_cost (51 + (Compare.Int.max (int_bytes i1) (int_bytes i2) / 62))
+    let sub = add
+
+    let mul i1 i2 =
+      let bytes = Compare.Int.max (int_bytes i1) (int_bytes i2) in
+      atomic_step_cost (51 + (bytes / 6 * log2 bytes))
+
+    let indic_lt x y = if Compare.Int.(x < y) then 1 else 0
+
+    let div i1 i2 =
+      let bytes1 = int_bytes i1 in
+      let bytes2 = int_bytes i2 in
+      let cost = indic_lt bytes2 bytes1 * (bytes1 - bytes2) * bytes2 in
+      atomic_step_cost (51 + (cost / 3151))
+
+    let shift_left _i _shift_bits = atomic_step_cost 30
+    let shift_right _i _shift_bits = atomic_step_cost 30
+    let logor i1 i2 =
+      let bytes1 = int_bytes i1 in
+      let bytes2 = int_bytes i2 in
+      atomic_step_cost (51 + ((Compare.Int.max bytes1 bytes2) / 70))
+    let logand i1 i2 =
+      let bytes1 = int_bytes i1 in
+      let bytes2 = int_bytes i2 in
+      atomic_step_cost (51 + ((Compare.Int.min bytes1 bytes2) / 70))
+    let logxor = logor
+    let lognot i = atomic_step_cost (51 + ((int_bytes i) / 20))
+    let exec = atomic_step_cost 10
+    let compare_bool _ _ = atomic_step_cost 30
+
+    let compare_string s1 s2 =
+      let bytes1 = String.length s1 in
+      let bytes2 = String.length s2 in
+      atomic_step_cost (30 + ((Compare.Int.min bytes1 bytes2) / 123))
+    let compare_bytes b1 b2 =
+      let bytes1 = MBytes.length b1 in
+      let bytes2 = MBytes.length b2 in
+      atomic_step_cost (30 + ((Compare.Int.min bytes1 bytes2) / 123))
+    let compare_tez _ _ = atomic_step_cost 30
+    let compare_zint i1 i2 =
+      atomic_step_cost (51 + ((Compare.Int.min (int_bytes i1) (int_bytes i2)) / 82))
+    let compare_key_hash _ _ = atomic_step_cost 92
+
+    let compare_timestamp t1 t2 =
+      let bytes1 = timestamp_bytes t1 in
+      let bytes2 = timestamp_bytes t2 in
+      atomic_step_cost (51 + ((Compare.Int.min bytes1 bytes2) / 82))
+
+    let compare_address _ _ = atomic_step_cost 92
+    let compare_res = atomic_step_cost 30
+    let unpack_failed bytes =
+      (* We cannot instrument failed deserialization,
+         so we take worst case fees: a set of size 1 bytes values. *)
+      let len = MBytes.length bytes in
+      (len *@ alloc_mbytes_cost 1) +@
+      (len *@ (log2 len *@ (alloc_cost 3 +@ step_cost 1)))
+    let address = atomic_step_cost 10
+    let contract = step_cost 10000
+    let transfer = step_cost 10
+    let create_account = step_cost 10
+    let create_contract = step_cost 10
+    let implicit_account = step_cost 10
+    let set_delegate = step_cost 10 +@ write_bytes_cost (Z.of_int 32)
+    let balance = atomic_step_cost 10
+    let now = atomic_step_cost 10
+    let check_signature_secp256k1 bytes = atomic_step_cost (10342 + (bytes / 5))
+    let check_signature_ed25519 bytes = atomic_step_cost (36864 + (bytes / 5))
+    let check_signature_p256 bytes = atomic_step_cost (36864 + (bytes / 5))
+    let check_signature (pkey : Signature.public_key) bytes =
+      match pkey with
+      | Ed25519 _ -> check_signature_ed25519 (MBytes.length bytes)
+      | Secp256k1 _ -> check_signature_secp256k1 (MBytes.length bytes)
+      | P256 _ ->  check_signature_p256 (MBytes.length bytes)
+    let hash_key = atomic_step_cost 30
+    let hash_blake2b b = atomic_step_cost (102 + ((MBytes.length b) / 5))
+    let hash_sha256 b = atomic_step_cost (409 + (MBytes.length b))
+    let hash_sha512 b =
+      let bytes = MBytes.length b in atomic_step_cost (409 + ((bytes lsr 1) + (bytes lsr 4)))
+    let steps_to_quota = atomic_step_cost 10
+    let source = atomic_step_cost 10
+    let self = atomic_step_cost 10
+    let amount = atomic_step_cost 10
+    let chain_id = step_cost 1
+    let stack_n_op n = atomic_step_cost (20 + (((n lsr 1) + (n lsr 2)) + (n lsr 4)))
+    let apply = alloc_cost 8 +@ step_cost 1
+
+    let rec compare : type a s. (a, s) Script_typed_ir.comparable_struct -> a -> a -> cost = fun ty x y ->
+      match ty with
+      | Bool_key _ -> compare_bool x y
+      | String_key _ -> compare_string x y
+      | Bytes_key _ -> compare_bytes x y
+      | Mutez_key _ -> compare_tez x y
+      | Int_key _ -> compare_zint x y
+      | Nat_key _ -> compare_zint x y
+      | Key_hash_key _ -> compare_key_hash x y
+      | Timestamp_key _ -> compare_timestamp x y
+      | Address_key _ -> compare_address x y
+      | Pair_key ((tl, _), (tr, _), _) ->
+          (* Reasonable over-approximation of the cost of lexicographic comparison. *)
+          let (xl, xr) = x and (yl, yr) = y in
+          compare tl xl yl +@ compare tr xr yr
+
+  end
+
   module Typechecking = struct
     let cycle = step_cost 1
     let bool = free
     let unit = free
     let string = string
     let bytes = bytes
-    let z = zint
+    let z = Legacy.zint
     let int_of_string str =
       alloc_cost @@ (Pervasives.(/) (String.length str) 5)
     let tez = step_cost 1 +@ alloc_cost 1
@@ -251,6 +300,7 @@ module Cost_of = struct
     let key = step_cost 3 +@ alloc_cost 3
     let key_hash = step_cost 1 +@ alloc_cost 1
     let signature = step_cost 1 +@ alloc_cost 1
+    let chain_id = step_cost 1 +@ alloc_cost 1
     let contract = step_cost 5
     let get_script = step_cost 20 +@ alloc_cost 5
     let contract_exists = step_cost 15 +@ alloc_cost 5
@@ -308,6 +358,7 @@ module Cost_of = struct
         | Map_get -> alloc_cost 1
         | Map_update -> alloc_cost 1
         | Map_size -> alloc_cost 1
+        | Empty_big_map _ -> alloc_cost 2
         | Big_map_mem -> alloc_cost 1
         | Big_map_get -> alloc_cost 1
         | Big_map_update -> alloc_cost 1
@@ -365,6 +416,7 @@ module Cost_of = struct
         | Loop_left _ -> alloc_cost 5
         | Dip _ -> alloc_cost 4
         | Exec -> alloc_cost 1
+        | Apply _ -> alloc_cost 1
         | Lambda _ -> alloc_cost 2
         | Failwith _ -> alloc_cost 1
         | Nop -> alloc_cost 0
@@ -381,6 +433,12 @@ module Cost_of = struct
         | Create_account -> alloc_cost 2
         | Implicit_account -> alloc_cost 1
         | Create_contract _ -> alloc_cost 8
+        (* Deducted the cost of removed arguments manager, spendable and delegatable:
+           - manager: key_hash = 1
+           - spendable: bool = 0
+           - delegatable: bool = 0
+        *)
+        | Create_contract_2 _ -> alloc_cost 7
         | Set_delegate -> alloc_cost 1
         | Now -> alloc_cost 1
         | Balance -> alloc_cost 1
@@ -396,6 +454,11 @@ module Cost_of = struct
         | Sender -> alloc_cost 1
         | Self _ -> alloc_cost 2
         | Amount -> alloc_cost 1
+        | Dig (n,_) -> n *@ alloc_cost 1 (* _ is a unary development of n *)
+        | Dug (n,_) -> n *@ alloc_cost 1
+        | Dipn (n,_,_) -> n *@ alloc_cost 1
+        | Dropn (n,_) -> n *@ alloc_cost 1
+        | ChainId -> alloc_cost 1
   end
 
   module Unparse = struct
@@ -415,6 +478,7 @@ module Cost_of = struct
     let tez = Script.int_node_cost_of_numbits 60 (* int64 bound *)
     let timestamp x = Script_timestamp.to_zint x |> Script_int.of_zint |> int
     let operation bytes = Script.bytes_node_cost bytes
+    let chain_id bytes = Script.bytes_node_cost bytes
     let key = string_cost 54
     let key_hash = string_cost 36
     let signature = string_cost 128
@@ -429,8 +493,8 @@ module Cost_of = struct
     let one_arg_type = prim_cost 1
     let two_arg_type = prim_cost 2
 
-    let set_to_list = set_to_list
+    let set_to_list = Legacy.set_to_list
-    let map_to_list = map_to_list
+    let map_to_list = Legacy.map_to_list
   end
 
 end

vendors/ligo-utils/tezos-protocol-alpha/michelson_v1_gas.mli

@@ -26,93 +26,94 @@
 open Alpha_context
 
 module Cost_of : sig
-  val cycle : Gas.cost
-  val loop_cycle : Gas.cost
-  val list_size : Gas.cost
-  val nop : Gas.cost
-  val stack_op : Gas.cost
-  val bool_binop : 'a -> 'b -> Gas.cost
-  val bool_unop : 'a -> Gas.cost
-  val pair : Gas.cost
-  val pair_access : Gas.cost
-  val cons : Gas.cost
-  val variant_no_data : Gas.cost
-  val branch : Gas.cost
-  val concat_string : string list -> Gas.cost
-  val concat_bytes : MBytes.t list -> Gas.cost
-  val slice_string : int -> Gas.cost
-  val slice_bytes : Gas.cost
-  val map_mem :
-    'a -> ('b, 'c) Script_typed_ir.map -> Gas.cost
-  val map_to_list :
-    ('b, 'c) Script_typed_ir.map -> Gas.cost
-  val map_get :
-    'a -> ('b, 'c) Script_typed_ir.map -> Gas.cost
-  val map_update :
-    'a -> 'b -> ('c, 'd) Script_typed_ir.map -> Gas.cost
-  val map_size : Gas.cost
-  val big_map_mem : 'key -> ('key, 'value) Script_typed_ir.big_map -> Gas.cost
-  val big_map_get : 'key -> ('key, 'value) Script_typed_ir.big_map -> Gas.cost
-  val big_map_update : 'key -> 'value option -> ('key, 'value) Script_typed_ir.big_map -> Gas.cost
-  val set_to_list : 'a Script_typed_ir.set -> Gas.cost
-  val set_update : 'a -> bool -> 'a Script_typed_ir.set -> Gas.cost
-  val set_mem : 'a -> 'a Script_typed_ir.set -> Gas.cost
-  val mul : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
-  val div : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
-  val add : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
-  val sub : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
-  val abs : 'a Script_int.num -> Gas.cost
-  val neg : 'a Script_int.num -> Gas.cost
-  val int : 'a -> Gas.cost
-  val add_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost
-  val sub_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost
-  val diff_timestamps : Script_timestamp.t -> Script_timestamp.t -> Gas.cost
-  val empty_set : Gas.cost
-  val set_size : Gas.cost
-  val empty_map : Gas.cost
-  val int64_op : Gas.cost
-  val z_to_int64 : Gas.cost
-  val int64_to_z : Gas.cost
-  val bitwise_binop : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
-  val logor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
-  val logand : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
-  val logxor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
-  val lognot : 'a Script_int.num -> Gas.cost
-  val shift_left : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
-  val shift_right : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
-  val exec : Gas.cost
-  val push : Gas.cost
-  val compare_res : Gas.cost
-  val unpack_failed : MBytes.t -> Gas.cost
-  val address : Gas.cost
-  val contract : Gas.cost
-  val transfer : Gas.cost
-  val create_account : Gas.cost
-  val create_contract : Gas.cost
-  val implicit_account : Gas.cost
-  val set_delegate : Gas.cost
-  val balance : Gas.cost
-  val now : Gas.cost
-  val check_signature : Gas.cost
-  val hash_key : Gas.cost
-  val hash : MBytes.t -> int -> Gas.cost
-  val steps_to_quota : Gas.cost
-  val source : Gas.cost
-  val self : Gas.cost
-  val amount : Gas.cost
-  val wrap : Gas.cost
-  val compare_bool : 'a -> 'b -> Gas.cost
-  val compare_string : string -> string -> Gas.cost
-  val compare_bytes : MBytes.t -> MBytes.t -> Gas.cost
-  val compare_tez : 'a -> 'b -> Gas.cost
-  val compare_int : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
-  val compare_nat : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
-  val compare_key_hash : 'a -> 'b -> Gas.cost
-  val compare_timestamp : Script_timestamp.t -> Script_timestamp.t -> Gas.cost
-  val compare_address : Contract.t -> Contract.t -> Gas.cost
 
   val manager_operation : Gas.cost
 
+  module Legacy : sig
+    val z_to_int64 : Gas.cost
+    val hash : MBytes.t -> int -> Gas.cost
+    val map_to_list :
+      ('b, 'c) Script_typed_ir.map -> Gas.cost
+    val set_update : 'a -> bool -> 'a Script_typed_ir.set -> Gas.cost
+  end
+
+  module Interpreter : sig
+    val cycle : Gas.cost
+    val loop_cycle : Gas.cost
+    val loop_size : Gas.cost
+    val loop_iter : Gas.cost
+    val loop_map : Gas.cost
+    val nop : Gas.cost
+    val stack_op : Gas.cost
+    val stack_n_op : int -> Gas.cost
+    val bool_binop : 'a -> 'b -> Gas.cost
+    val bool_unop : 'a -> Gas.cost
+    val pair : Gas.cost
+    val pair_access : Gas.cost
+    val cons : Gas.cost
+    val variant_no_data : Gas.cost
+    val branch : Gas.cost
+    val concat_string : string list -> Gas.cost
+    val concat_bytes : MBytes.t list -> Gas.cost
+    val slice_string : int -> Gas.cost
+    val map_mem :  'a -> ('a, 'b) Script_typed_ir.map -> Gas.cost
+    val map_to_list : ('a, 'b) Script_typed_ir.map -> Gas.cost
+    val map_get : 'a -> ('a, 'b) Script_typed_ir.map -> Gas.cost
+    val map_update : 'a -> 'b option -> ('a, 'b) Script_typed_ir.map -> Gas.cost
+    val map_size : Gas.cost
+    val set_to_list : 'a Script_typed_ir.set -> Gas.cost
+    val set_update : 'a -> bool -> 'a Script_typed_ir.set -> Gas.cost
+    val set_mem : 'a -> 'a Script_typed_ir.set -> Gas.cost
+    val mul : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+    val div : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+    val add : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+    val sub : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+    val abs : 'a Script_int.num -> Gas.cost
+    val neg : 'a Script_int.num -> Gas.cost
+    val int : 'a -> Gas.cost
+    val add_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost
+    val sub_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost
+    val diff_timestamps : Script_timestamp.t -> Script_timestamp.t -> Gas.cost
+    val empty_set : Gas.cost
+    val set_size : Gas.cost
+    val empty_map : Gas.cost
+    val int64_op : Gas.cost
+    val z_to_int64 : Gas.cost
+    val int64_to_z : Gas.cost
+    val logor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+    val logand : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+    val logxor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+    val lognot : 'a Script_int.num -> Gas.cost
+    val shift_left : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+    val shift_right : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+    val exec : Gas.cost
+    val push : Gas.cost
+    val compare_res : Gas.cost
+    val unpack_failed : MBytes.t -> Gas.cost
+    val address : Gas.cost
+    val contract : Gas.cost
+    val transfer : Gas.cost
+    val create_account : Gas.cost
+    val create_contract : Gas.cost
+    val implicit_account : Gas.cost
+    val set_delegate : Gas.cost
+    val balance : Gas.cost
+    val now : Gas.cost
+    val check_signature : public_key -> MBytes.t -> Gas.cost
+    val hash_key : Gas.cost
+    val hash_blake2b : MBytes.t -> Gas.cost
+    val hash_sha256 : MBytes.t -> Gas.cost
+    val hash_sha512 : MBytes.t -> Gas.cost
+    val steps_to_quota : Gas.cost
+    val source : Gas.cost
+    val self : Gas.cost
+    val amount : Gas.cost
+    val chain_id : Gas.cost
+    val wrap : Gas.cost
+    val compare : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> Gas.cost
+    val apply : Gas.cost
+  end
+
   module Typechecking : sig
     val cycle : Gas.cost
     val unit : Gas.cost
@@ -126,6 +127,7 @@ module Cost_of : sig
     val key : Gas.cost
     val key_hash : Gas.cost
     val signature : Gas.cost
+    val chain_id : Gas.cost
 
     val contract : Gas.cost
 
@@ -177,6 +179,7 @@ module Cost_of : sig
     val key_hash : Gas.cost
     val signature : Gas.cost
     val operation : MBytes.t -> Gas.cost
+    val chain_id : MBytes.t -> Gas.cost
 
     val contract : Gas.cost
 

vendors/ligo-utils/tezos-protocol-alpha/michelson_v1_primitives.ml

@@ -54,6 +54,7 @@ type prim =
   | I_BALANCE
   | I_CAR
   | I_CDR
+  | I_CHAIN_ID
   | I_CHECK_SIGNATURE
   | I_COMPARE
   | I_CONCAT
@@ -65,10 +66,12 @@ type prim =
   | I_DROP
   | I_DUP
   | I_EDIV
+  | I_EMPTY_BIG_MAP
   | I_EMPTY_MAP
   | I_EMPTY_SET
   | I_EQ
   | I_EXEC
+  | I_APPLY
   | I_FAILWITH
   | I_GE
   | I_GET
@@ -120,6 +123,8 @@ type prim =
   | I_ISNAT
   | I_CAST
   | I_RENAME
+  | I_DIG
+  | I_DUG
   | T_bool
   | T_contract
   | T_int
@@ -142,6 +147,7 @@ type prim =
   | T_unit
   | T_operation
   | T_address
+  | T_chain_id
 
 let valid_case name =
   let is_lower = function  '_' | 'a'..'z' -> true | _ -> false in
@@ -187,6 +193,7 @@ let string_of_prim = function
   | I_BALANCE -> "BALANCE"
   | I_CAR -> "CAR"
   | I_CDR -> "CDR"
+  | I_CHAIN_ID -> "CHAIN_ID"
   | I_CHECK_SIGNATURE -> "CHECK_SIGNATURE"
   | I_COMPARE -> "COMPARE"
   | I_CONCAT -> "CONCAT"
@@ -198,10 +205,12 @@ let string_of_prim = function
   | I_DROP -> "DROP"
   | I_DUP -> "DUP"
   | I_EDIV -> "EDIV"
+  | I_EMPTY_BIG_MAP -> "EMPTY_BIG_MAP"
   | I_EMPTY_MAP -> "EMPTY_MAP"
   | I_EMPTY_SET -> "EMPTY_SET"
   | I_EQ -> "EQ"
   | I_EXEC -> "EXEC"
+  | I_APPLY -> "APPLY"
   | I_FAILWITH -> "FAILWITH"
   | I_GE -> "GE"
   | I_GET -> "GET"
@@ -253,6 +262,8 @@ let string_of_prim = function
   | I_ISNAT -> "ISNAT"
   | I_CAST -> "CAST"
   | I_RENAME -> "RENAME"
+  | I_DIG -> "DIG"
+  | I_DUG -> "DUG"
   | T_bool -> "bool"
   | T_contract -> "contract"
   | T_int -> "int"
@@ -275,6 +286,7 @@ let string_of_prim = function
   | T_unit -> "unit"
   | T_operation -> "operation"
   | T_address -> "address"
+  | T_chain_id -> "chain_id"
 
 let prim_of_string = function
   | "parameter" -> ok K_parameter
@@ -301,6 +313,7 @@ let prim_of_string = function
   | "BALANCE" -> ok I_BALANCE
   | "CAR" -> ok I_CAR
   | "CDR" -> ok I_CDR
+  | "CHAIN_ID" -> ok I_CHAIN_ID
   | "CHECK_SIGNATURE" -> ok I_CHECK_SIGNATURE
   | "COMPARE" -> ok I_COMPARE
   | "CONCAT" -> ok I_CONCAT
@@ -312,10 +325,12 @@ let prim_of_string = function
   | "DROP" -> ok I_DROP
   | "DUP" -> ok I_DUP
   | "EDIV" -> ok I_EDIV
+  | "EMPTY_BIG_MAP" -> ok I_EMPTY_BIG_MAP
   | "EMPTY_MAP" -> ok I_EMPTY_MAP
   | "EMPTY_SET" -> ok I_EMPTY_SET
   | "EQ" -> ok I_EQ
   | "EXEC" -> ok I_EXEC
+  | "APPLY" -> ok I_APPLY
   | "FAILWITH" -> ok I_FAILWITH
   | "GE" -> ok I_GE
   | "GET" -> ok I_GET
@@ -367,6 +382,8 @@ let prim_of_string = function
   | "ISNAT" -> ok I_ISNAT
   | "CAST" -> ok I_CAST
   | "RENAME" -> ok I_RENAME
+  | "DIG" -> ok I_DIG
+  | "DUG" -> ok I_DUG
   | "bool" -> ok T_bool
   | "contract" -> ok T_contract
   | "int" -> ok T_int
@@ -389,6 +406,7 @@ let prim_of_string = function
   | "unit" -> ok T_unit
   | "operation" -> ok T_operation
   | "address" -> ok T_address
+  | "chain_id" -> ok T_chain_id
   | n ->
       if valid_case n then
         error (Unknown_primitive_name n)
@@ -436,6 +454,7 @@ let prim_encoding =
   let open Data_encoding in
   def "michelson.v1.primitives" @@
   string_enum [
+    (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
     ("parameter", K_parameter) ;
     ("storage", K_storage) ;
     ("code", K_code) ;
@@ -446,6 +465,7 @@ let prim_encoding =
     ("Pair", D_Pair) ;
     ("Right", D_Right) ;
     ("Some", D_Some) ;
+    (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
     ("True", D_True) ;
     ("Unit", D_Unit) ;
     ("PACK", I_PACK) ;
@@ -456,6 +476,7 @@ let prim_encoding =
     ("ABS", I_ABS) ;
     ("ADD", I_ADD) ;
     ("AMOUNT", I_AMOUNT) ;
+    (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
     ("AND", I_AND) ;
     ("BALANCE", I_BALANCE) ;
     ("CAR", I_CAR) ;
@@ -466,6 +487,7 @@ let prim_encoding =
     ("CONS", I_CONS) ;
     ("CREATE_ACCOUNT", I_CREATE_ACCOUNT) ;
     ("CREATE_CONTRACT", I_CREATE_CONTRACT) ;
+    (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
     ("IMPLICIT_ACCOUNT", I_IMPLICIT_ACCOUNT) ;
     ("DIP", I_DIP) ;
     ("DROP", I_DROP) ;
@@ -476,6 +498,7 @@ let prim_encoding =
     ("EQ", I_EQ) ;
     ("EXEC", I_EXEC) ;
     ("FAILWITH", I_FAILWITH) ;
+    (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
     ("GE", I_GE) ;
     ("GET", I_GET) ;
     ("GT", I_GT) ;
@@ -486,6 +509,7 @@ let prim_encoding =
     ("IF_NONE", I_IF_NONE) ;
     ("INT", I_INT) ;
     ("LAMBDA", I_LAMBDA) ;
+    (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
     ("LE", I_LE) ;
     ("LEFT", I_LEFT) ;
     ("LOOP", I_LOOP) ;
@@ -496,6 +520,7 @@ let prim_encoding =
     ("MEM", I_MEM) ;
     ("MUL", I_MUL) ;
     ("NEG", I_NEG) ;
+    (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
     ("NEQ", I_NEQ) ;
     ("NIL", I_NIL) ;
     ("NONE", I_NONE) ;
@@ -506,6 +531,7 @@ let prim_encoding =
     ("PUSH", I_PUSH) ;
     ("RIGHT", I_RIGHT) ;
     ("SIZE", I_SIZE) ;
+    (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
     ("SOME", I_SOME) ;
     ("SOURCE", I_SOURCE) ;
     ("SENDER", I_SENDER) ;
@@ -516,6 +542,7 @@ let prim_encoding =
     ("TRANSFER_TOKENS", I_TRANSFER_TOKENS) ;
     ("SET_DELEGATE", I_SET_DELEGATE) ;
     ("UNIT", I_UNIT) ;
+    (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
     ("UPDATE", I_UPDATE) ;
     ("XOR", I_XOR) ;
     ("ITER", I_ITER) ;
@@ -526,6 +553,7 @@ let prim_encoding =
     ("CAST", I_CAST) ;
     ("RENAME", I_RENAME) ;
     ("bool", T_bool) ;
+    (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
     ("contract", T_contract) ;
     ("int", T_int) ;
     ("key", T_key) ;
@@ -536,6 +564,7 @@ let prim_encoding =
     ("big_map", T_big_map) ;
     ("nat", T_nat) ;
     ("option", T_option) ;
+    (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
     ("or", T_or) ;
     ("pair", T_pair) ;
     ("set", T_set) ;
@@ -546,9 +575,18 @@ let prim_encoding =
     ("timestamp", T_timestamp) ;
     ("unit", T_unit) ;
     ("operation", T_operation) ;
+    (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
     ("address", T_address) ;
     (* Alpha_002 addition *)
     ("SLICE", I_SLICE) ;
+    (* Alpha_005 addition *)
+    ("DIG", I_DIG) ;
+    ("DUG", I_DUG) ;
+    ("EMPTY_BIG_MAP", I_EMPTY_BIG_MAP) ;
+    ("APPLY", I_APPLY) ;
+    ("chain_id", T_chain_id) ;
+    ("CHAIN_ID", I_CHAIN_ID)
+    (* New instructions must be added here, for backward compatibility of the encoding. *)
   ]
 
 let () =

vendors/ligo-utils/tezos-protocol-alpha/michelson_v1_primitives.mli

@@ -52,6 +52,7 @@ type prim =
   | I_BALANCE
   | I_CAR
   | I_CDR
+  | I_CHAIN_ID
   | I_CHECK_SIGNATURE
   | I_COMPARE
   | I_CONCAT
@@ -63,10 +64,12 @@ type prim =
   | I_DROP
   | I_DUP
   | I_EDIV
+  | I_EMPTY_BIG_MAP
   | I_EMPTY_MAP
   | I_EMPTY_SET
   | I_EQ
   | I_EXEC
+  | I_APPLY
   | I_FAILWITH
   | I_GE
   | I_GET
@@ -118,6 +121,8 @@ type prim =
   | I_ISNAT
   | I_CAST
   | I_RENAME
+  | I_DIG
+  | I_DUG
   | T_bool
   | T_contract
   | T_int
@@ -140,6 +145,7 @@ type prim =
   | T_unit
   | T_operation
   | T_address
+  | T_chain_id
 
 val prim_encoding : prim Data_encoding.encoding
 

vendors/ligo-utils/tezos-protocol-alpha/misc.mli

@@ -23,7 +23,7 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-(** {2 Stuff} ****************************************************************)
+(** {2 Helper functions} *)
 
 type 'a lazyt = unit -> 'a
 type 'a lazy_list_t = LCons of 'a * ('a lazy_list_t tzresult Lwt.t lazyt)

vendors/ligo-utils/tezos-protocol-alpha/operation_repr.ml

@@ -98,7 +98,7 @@ and _ contents =
       ballot: Vote_repr.ballot ;
     } -> Kind.ballot contents
   | Manager_operation : {
-      source: Contract_repr.contract ;
+      source: Signature.public_key_hash ;
       fee: Tez_repr.tez ;
       counter: counter ;
       operation: 'kind manager_operation ;
@@ -110,15 +110,13 @@ and _ manager_operation =
   | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
   | Transaction : {
       amount: Tez_repr.tez ;
-      parameters: Script_repr.lazy_expr option ;
+      parameters: Script_repr.lazy_expr ;
+      entrypoint: string ;
       destination: Contract_repr.contract ;
     } -> Kind.transaction manager_operation
   | Origination : {
-      manager: Signature.Public_key_hash.t ;
       delegate: Signature.Public_key_hash.t option ;
-      script: Script_repr.t option ;
+      script: Script_repr.t ;
-      spendable: bool ;
-      delegatable: bool ;
       credit: Tez_repr.tez ;
       preorigination: Contract_repr.t option ;
     } -> Kind.origination manager_operation
@@ -225,6 +223,22 @@ module Encoding = struct
           (fun pkh -> Reveal pkh)
       }
 
+    let entrypoint_encoding =
+      def
+        ~title:"entrypoint"
+        ~description:"Named entrypoint to a Michelson smart contract"
+        "entrypoint" @@
+      let builtin_case tag name =
+        Data_encoding.case (Tag tag) ~title:name
+          (constant name)
+          (fun n -> if Compare.String.(n = name) then Some () else None) (fun () -> name) in
+      union [ builtin_case 0 "default" ;
+              builtin_case 1 "root" ;
+              builtin_case 2 "do" ;
+              builtin_case 3 "set_delegate" ;
+              builtin_case 4 "remove_delegate" ;
+              Data_encoding.case (Tag 255) ~title:"named" (Bounded.string 31) (fun s -> Some s) (fun s -> s) ]
+
     let transaction_case =
       MCase {
         tag = 1 ;
@@ -233,18 +247,29 @@ module Encoding = struct
           (obj3
              (req "amount" Tez_repr.encoding)
              (req "destination" Contract_repr.encoding)
-             (opt "parameters" Script_repr.lazy_expr_encoding)) ;
+             (opt "parameters"
+                (obj2
+                   (req "entrypoint" entrypoint_encoding)
+                   (req "value" Script_repr.lazy_expr_encoding)))) ;
         select =
           (function
             | Manager (Transaction _ as op) -> Some op
             | _ -> None) ;
         proj =
           (function
-            | Transaction { amount ; destination ; parameters } ->
+            | Transaction { amount ; destination ; parameters ; entrypoint } ->
+                let parameters =
+                  if Script_repr.is_unit_parameter parameters && Compare.String.(entrypoint = "default") then
+                    None
+                  else
+                    Some (entrypoint, parameters) in
                 (amount, destination, parameters)) ;
         inj =
           (fun (amount, destination, parameters) ->
-             Transaction { amount ; destination ; parameters })
+             let entrypoint, parameters = match parameters with
+               | None -> "default", Script_repr.unit_parameter
+               | Some (entrypoint, value) -> entrypoint, value in
+             Transaction { amount ; destination ; parameters ; entrypoint })
       }
 
     let origination_case =
@@ -252,32 +277,26 @@ module Encoding = struct
         tag = 2 ;
         name = "origination" ;
         encoding =
-          (obj6
+          (obj3
-             (req "manager_pubkey" Signature.Public_key_hash.encoding)
              (req "balance" Tez_repr.encoding)
-             (dft "spendable" bool true)
-             (dft "delegatable" bool true)
              (opt "delegate" Signature.Public_key_hash.encoding)
-             (opt "script" Script_repr.encoding)) ;
+             (req "script" Script_repr.encoding)) ;
         select =
           (function
             | Manager (Origination _ as op) -> Some op
             | _ -> None) ;
         proj =
           (function
-            | Origination { manager ; credit ; spendable ;
+            | Origination { credit ; delegate ; script ;
-                            delegatable ; delegate ; script ;
                             preorigination = _
                             (* the hash is only used internally
                                when originating from smart
                                contracts, don't serialize it *) } ->
-                (manager, credit, spendable,
+                (credit, delegate, script)) ;
-                 delegatable, delegate, script)) ;
         inj =
-          (fun (manager, credit, spendable, delegatable, delegate, script) ->
+          (fun (credit, delegate, script) ->
              Origination
-               {manager ; credit ; spendable ; delegatable ;
+               {credit ; delegate ; script ; preorigination = None })
-                delegate ; script ; preorigination = None })
       }
 
     let delegation_case =
@@ -482,7 +501,7 @@ module Encoding = struct
 
   let manager_encoding =
     (obj5
-       (req "source" Contract_repr.encoding)
+       (req "source" Signature.Public_key_hash.encoding)
        (req "fee" Tez_repr.encoding)
        (req "counter" (check_size 10 n))
        (req "gas_limit" (check_size 10 n))
@@ -526,10 +545,10 @@ module Encoding = struct
            (rebuild op (mcase.inj contents)))
     }
 
-  let reveal_case = make_manager_case 7 Manager_operations.reveal_case
+  let reveal_case = make_manager_case 107 Manager_operations.reveal_case
-  let transaction_case = make_manager_case 8 Manager_operations.transaction_case
+  let transaction_case = make_manager_case 108 Manager_operations.transaction_case
-  let origination_case = make_manager_case 9 Manager_operations.origination_case
+  let origination_case = make_manager_case 109 Manager_operations.origination_case
-  let delegation_case = make_manager_case 10 Manager_operations.delegation_case
+  let delegation_case = make_manager_case 110 Manager_operations.delegation_case
 
   let contents_encoding =
     let make (Case { tag ; name ; encoding ; select ; proj ; inj }) =
@@ -668,12 +687,12 @@ let check_signature_sync (type kind) key chain_id ({ shell ; protocol_data } : k
     if Signature.check ~watermark key signature unsigned_operation then
       Ok ()
     else
-      Error [Invalid_signature] in
+      error Invalid_signature in
   match protocol_data.contents, protocol_data.signature with
   | Single _, None ->
-      Error [Missing_signature]
+      error Missing_signature
   | Cons _, None ->
-      Error [Missing_signature]
+      error Missing_signature
   | Single (Endorsement _) as contents, Some signature ->
       check ~watermark:(Endorsement chain_id) (Contents_list contents) signature
   | Single _ as contents, Some signature ->

vendors/ligo-utils/tezos-protocol-alpha/operation_repr.mli

@@ -99,7 +99,7 @@ and _ contents =
       ballot: Vote_repr.ballot ;
     } -> Kind.ballot contents
   | Manager_operation : {
-      source: Contract_repr.contract ;
+      source: Signature.Public_key_hash.t ;
       fee: Tez_repr.tez ;
       counter: counter ;
       operation: 'kind manager_operation ;
@@ -111,15 +111,13 @@ and _ manager_operation =
   | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
   | Transaction : {
       amount: Tez_repr.tez ;
-      parameters: Script_repr.lazy_expr option ;
+      parameters: Script_repr.lazy_expr ;
+      entrypoint: string ;
       destination: Contract_repr.contract ;
     } -> Kind.transaction manager_operation
   | Origination : {
-      manager: Signature.Public_key_hash.t ;
       delegate: Signature.Public_key_hash.t option ;
-      script: Script_repr.t option ;
+      script: Script_repr.t ;
-      spendable: bool ;
-      delegatable: bool ;
       credit: Tez_repr.tez ;
       preorigination: Contract_repr.t option ;
     } -> Kind.origination manager_operation

vendors/ligo-utils/tezos-protocol-alpha/parameters_repr.ml

@@ -85,196 +85,6 @@ let bootstrap_contract_encoding =
        (req "amount" Tez_repr.encoding)
        (req "script" Script_repr.encoding))
 
-(* This encoding is used to read configuration files (e.g. sandbox.json)
-   where some fields can be missing, in that case they are replaced by
-   the default. *)
-let constants_encoding =
-  let open Data_encoding in
-  conv
-    (fun (c : Constants_repr.parametric) ->
-       let module Compare_time_between_blocks = Compare.List (Period_repr) in
-       let module Compare_keys = Compare.List (Ed25519.Public_key) in
-       let opt (=) def v = if def = v then None else Some v in
-       let default = Constants_repr.default in
-       let preserved_cycles =
-         opt Compare.Int.(=)
-           default.preserved_cycles c.preserved_cycles
-       and blocks_per_cycle =
-         opt Compare.Int32.(=)
-           default.blocks_per_cycle c.blocks_per_cycle
-       and blocks_per_commitment =
-         opt Compare.Int32.(=)
-           default.blocks_per_commitment c.blocks_per_commitment
-       and blocks_per_roll_snapshot =
-         opt Compare.Int32.(=)
-           default.blocks_per_roll_snapshot c.blocks_per_roll_snapshot
-       and blocks_per_voting_period =
-         opt Compare.Int32.(=)
-           default.blocks_per_voting_period c.blocks_per_voting_period
-       and time_between_blocks =
-         opt Compare_time_between_blocks.(=)
-           default.time_between_blocks c.time_between_blocks
-       and endorsers_per_block =
-         opt Compare.Int.(=)
-           default.endorsers_per_block c.endorsers_per_block
-       and hard_gas_limit_per_operation =
-         opt Compare.Z.(=)
-           default.hard_gas_limit_per_operation c.hard_gas_limit_per_operation
-       and hard_gas_limit_per_block =
-         opt Compare.Z.(=)
-           default.hard_gas_limit_per_block c.hard_gas_limit_per_block
-       and proof_of_work_threshold =
-         opt Compare.Int64.(=)
-           default.proof_of_work_threshold c.proof_of_work_threshold
-       and tokens_per_roll =
-         opt Tez_repr.(=)
-           default.tokens_per_roll c.tokens_per_roll
-       and michelson_maximum_type_size =
-         opt Compare.Int.(=)
-           default.michelson_maximum_type_size c.michelson_maximum_type_size
-       and seed_nonce_revelation_tip =
-         opt Tez_repr.(=)
-           default.seed_nonce_revelation_tip c.seed_nonce_revelation_tip
-       and origination_size =
-         opt Compare.Int.(=)
-           default.origination_size c.origination_size
-       and block_security_deposit =
-         opt Tez_repr.(=)
-           default.block_security_deposit c.block_security_deposit
-       and endorsement_security_deposit =
-         opt Tez_repr.(=)
-           default.endorsement_security_deposit c.endorsement_security_deposit
-       and block_reward =
-         opt Tez_repr.(=)
-           default.block_reward c.block_reward
-       and endorsement_reward =
-         opt Tez_repr.(=)
-           default.endorsement_reward c.endorsement_reward
-       and cost_per_byte =
-         opt Tez_repr.(=)
-           default.cost_per_byte c.cost_per_byte
-       and hard_storage_limit_per_operation =
-         opt Compare.Z.(=)
-           default.hard_storage_limit_per_operation c.hard_storage_limit_per_operation
-       and test_chain_duration =
-         opt Compare.Int64.(=)
-           default.test_chain_duration c.test_chain_duration
-       in
-       (( preserved_cycles,
-          blocks_per_cycle,
-          blocks_per_commitment,
-          blocks_per_roll_snapshot,
-          blocks_per_voting_period,
-          time_between_blocks,
-          endorsers_per_block,
-          hard_gas_limit_per_operation,
-          hard_gas_limit_per_block),
-        ((proof_of_work_threshold,
-          tokens_per_roll,
-          michelson_maximum_type_size,
-          seed_nonce_revelation_tip,
-          origination_size,
-          block_security_deposit,
-          endorsement_security_deposit,
-          block_reward),
-         (endorsement_reward,
-          cost_per_byte,
-          hard_storage_limit_per_operation,
-          test_chain_duration))))
-    (fun (( preserved_cycles,
-            blocks_per_cycle,
-            blocks_per_commitment,
-            blocks_per_roll_snapshot,
-            blocks_per_voting_period,
-            time_between_blocks,
-            endorsers_per_block,
-            hard_gas_limit_per_operation,
-            hard_gas_limit_per_block),
-          ((proof_of_work_threshold,
-            tokens_per_roll,
-            michelson_maximum_type_size,
-            seed_nonce_revelation_tip,
-            origination_size,
-            block_security_deposit,
-            endorsement_security_deposit,
-            block_reward),
-           (endorsement_reward,
-            cost_per_byte,
-            hard_storage_limit_per_operation,
-            test_chain_duration))) ->
-      let unopt def = function None -> def | Some v -> v in
-      let default = Constants_repr.default in
-      { Constants_repr.preserved_cycles =
-          unopt default.preserved_cycles preserved_cycles ;
-        blocks_per_cycle =
-          unopt default.blocks_per_cycle blocks_per_cycle ;
-        blocks_per_commitment =
-          unopt default.blocks_per_commitment blocks_per_commitment ;
-        blocks_per_roll_snapshot =
-          unopt default.blocks_per_roll_snapshot blocks_per_roll_snapshot ;
-        blocks_per_voting_period =
-          unopt default.blocks_per_voting_period blocks_per_voting_period ;
-        time_between_blocks =
-          unopt default.time_between_blocks @@
-          time_between_blocks ;
-        endorsers_per_block =
-          unopt default.endorsers_per_block endorsers_per_block ;
-        hard_gas_limit_per_operation =
-          unopt default.hard_gas_limit_per_operation hard_gas_limit_per_operation ;
-        hard_gas_limit_per_block =
-          unopt default.hard_gas_limit_per_block hard_gas_limit_per_block ;
-        proof_of_work_threshold =
-          unopt default.proof_of_work_threshold proof_of_work_threshold ;
-        tokens_per_roll =
-          unopt default.tokens_per_roll tokens_per_roll ;
-        michelson_maximum_type_size =
-          unopt default.michelson_maximum_type_size michelson_maximum_type_size ;
-        seed_nonce_revelation_tip =
-          unopt default.seed_nonce_revelation_tip seed_nonce_revelation_tip ;
-        origination_size =
-          unopt default.origination_size origination_size ;
-        block_security_deposit =
-          unopt default.block_security_deposit block_security_deposit ;
-        endorsement_security_deposit =
-          unopt default.endorsement_security_deposit endorsement_security_deposit ;
-        block_reward =
-          unopt default.block_reward block_reward ;
-        endorsement_reward =
-          unopt default.endorsement_reward endorsement_reward ;
-        cost_per_byte =
-          unopt default.cost_per_byte cost_per_byte ;
-        hard_storage_limit_per_operation =
-          unopt default.hard_storage_limit_per_operation hard_storage_limit_per_operation ;
-        test_chain_duration =
-          unopt default.test_chain_duration test_chain_duration ;
-      } )
-    (merge_objs
-       (obj9
-          (opt "preserved_cycles" uint8)
-          (opt "blocks_per_cycle" int32)
-          (opt "blocks_per_commitment" int32)
-          (opt "blocks_per_roll_snapshot" int32)
-          (opt "blocks_per_voting_period" int32)
-          (opt "time_between_blocks" (list Period_repr.encoding))
-          (opt "endorsers_per_block" uint16)
-          (opt "hard_gas_limit_per_operation" z)
-          (opt "hard_gas_limit_per_block" z))
-       (merge_objs
-          (obj8
-             (opt "proof_of_work_threshold" int64)
-             (opt "tokens_per_roll" Tez_repr.encoding)
-             (opt "michelson_maximum_type_size" uint16)
-             (opt "seed_nonce_revelation_tip" Tez_repr.encoding)
-             (opt "origination_size" int31)
-             (opt "block_security_deposit" Tez_repr.encoding)
-             (opt "endorsement_security_deposit" Tez_repr.encoding)
-             (opt "block_reward" Tez_repr.encoding))
-          (obj4
-             (opt "endorsement_reward" Tez_repr.encoding)
-             (opt "cost_per_byte" Tez_repr.encoding)
-             (opt "hard_storage_limit_per_operation" z)
-             (opt "test_chain_duration" int64))))
-
 let encoding =
   let open Data_encoding in
   conv
@@ -295,4 +105,254 @@ let encoding =
           (dft "commitments" (list Commitment_repr.encoding) [])
           (opt "security_deposit_ramp_up_cycles" int31)
           (opt "no_reward_cycles" int31))
-       constants_encoding)
+       Constants_repr.parametric_encoding)
+
+
+(* Only for migration from 004 to 005 *)
+
+module Proto_004 = struct
+
+  type parametric = {
+    preserved_cycles: int ;
+    blocks_per_cycle: int32 ;
+    blocks_per_commitment: int32 ;
+    blocks_per_roll_snapshot: int32 ;
+    blocks_per_voting_period: int32 ;
+    time_between_blocks: Period_repr.t list ;
+    endorsers_per_block: int ;
+    hard_gas_limit_per_operation: Z.t ;
+    hard_gas_limit_per_block: Z.t ;
+    proof_of_work_threshold: int64 ;
+    tokens_per_roll: Tez_repr.t ;
+    michelson_maximum_type_size: int;
+    seed_nonce_revelation_tip: Tez_repr.t ;
+    origination_size: int ;
+    block_security_deposit: Tez_repr.t ;
+    endorsement_security_deposit: Tez_repr.t ;
+    block_reward: Tez_repr.t ;
+    endorsement_reward: Tez_repr.t ;
+    cost_per_byte: Tez_repr.t ;
+    hard_storage_limit_per_operation: Z.t ;
+    test_chain_duration: int64 ;  (* in seconds *)
+  }
+
+  let default = {
+    preserved_cycles = 5 ;
+    blocks_per_cycle = 4096l ;
+    blocks_per_commitment = 32l ;
+    blocks_per_roll_snapshot = 256l ;
+    blocks_per_voting_period = 32768l ;
+    time_between_blocks =
+      List.map Period_repr.of_seconds_exn [ 60L ; 75L ] ;
+    endorsers_per_block = 32 ;
+    hard_gas_limit_per_operation = Z.of_int 800_000 ;
+    hard_gas_limit_per_block = Z.of_int 8_000_000 ;
+    proof_of_work_threshold =
+      Int64.(sub (shift_left 1L 46) 1L) ;
+    tokens_per_roll =
+      Tez_repr.(mul_exn one 8_000) ;
+    michelson_maximum_type_size = 1000 ;
+    seed_nonce_revelation_tip = begin
+      match Tez_repr.(one /? 8L) with
+      | Ok c -> c
+      | Error _ -> assert false
+    end ;
+    origination_size = 257 ;
+    block_security_deposit = Tez_repr.(mul_exn one 512) ;
+    endorsement_security_deposit = Tez_repr.(mul_exn one 64) ;
+    block_reward = Tez_repr.(mul_exn one 16) ;
+    endorsement_reward = Tez_repr.(mul_exn one 2) ;
+    hard_storage_limit_per_operation = Z.of_int 60_000 ;
+    cost_per_byte = Tez_repr.of_mutez_exn 1_000L ;
+    test_chain_duration = Int64.mul 32768L 60L;
+  }
+
+  (* This encoding is used to read configuration files (e.g. sandbox.json)
+     where some fields can be missing, in that case they are replaced by
+     the default. *)
+  let constants_encoding =
+    let open Data_encoding in
+    conv
+      (fun (c : parametric) ->
+         let module Compare_time_between_blocks = Compare.List (Period_repr) in
+         let module Compare_keys = Compare.List (Ed25519.Public_key) in
+         let opt (=) def v = if def = v then None else Some v in
+         let preserved_cycles =
+           opt Compare.Int.(=)
+             default.preserved_cycles c.preserved_cycles
+         and blocks_per_cycle =
+           opt Compare.Int32.(=)
+             default.blocks_per_cycle c.blocks_per_cycle
+         and blocks_per_commitment =
+           opt Compare.Int32.(=)
+             default.blocks_per_commitment c.blocks_per_commitment
+         and blocks_per_roll_snapshot =
+           opt Compare.Int32.(=)
+             default.blocks_per_roll_snapshot c.blocks_per_roll_snapshot
+         and blocks_per_voting_period =
+           opt Compare.Int32.(=)
+             default.blocks_per_voting_period c.blocks_per_voting_period
+         and time_between_blocks =
+           opt Compare_time_between_blocks.(=)
+             default.time_between_blocks c.time_between_blocks
+         and endorsers_per_block =
+           opt Compare.Int.(=)
+             default.endorsers_per_block c.endorsers_per_block
+         and hard_gas_limit_per_operation =
+           opt Compare.Z.(=)
+             default.hard_gas_limit_per_operation c.hard_gas_limit_per_operation
+         and hard_gas_limit_per_block =
+           opt Compare.Z.(=)
+             default.hard_gas_limit_per_block c.hard_gas_limit_per_block
+         and proof_of_work_threshold =
+           opt Compare.Int64.(=)
+             default.proof_of_work_threshold c.proof_of_work_threshold
+         and tokens_per_roll =
+           opt Tez_repr.(=)
+             default.tokens_per_roll c.tokens_per_roll
+         and michelson_maximum_type_size =
+           opt Compare.Int.(=)
+             default.michelson_maximum_type_size c.michelson_maximum_type_size
+         and seed_nonce_revelation_tip =
+           opt Tez_repr.(=)
+             default.seed_nonce_revelation_tip c.seed_nonce_revelation_tip
+         and origination_size =
+           opt Compare.Int.(=)
+             default.origination_size c.origination_size
+         and block_security_deposit =
+           opt Tez_repr.(=)
+             default.block_security_deposit c.block_security_deposit
+         and endorsement_security_deposit =
+           opt Tez_repr.(=)
+             default.endorsement_security_deposit c.endorsement_security_deposit
+         and block_reward =
+           opt Tez_repr.(=)
+             default.block_reward c.block_reward
+         and endorsement_reward =
+           opt Tez_repr.(=)
+             default.endorsement_reward c.endorsement_reward
+         and cost_per_byte =
+           opt Tez_repr.(=)
+             default.cost_per_byte c.cost_per_byte
+         and hard_storage_limit_per_operation =
+           opt Compare.Z.(=)
+             default.hard_storage_limit_per_operation c.hard_storage_limit_per_operation
+         and test_chain_duration =
+           opt Compare.Int64.(=)
+             default.test_chain_duration c.test_chain_duration
+         in
+         (( preserved_cycles,
+            blocks_per_cycle,
+            blocks_per_commitment,
+            blocks_per_roll_snapshot,
+            blocks_per_voting_period,
+            time_between_blocks,
+            endorsers_per_block,
+            hard_gas_limit_per_operation,
+            hard_gas_limit_per_block),
+          ((proof_of_work_threshold,
+            tokens_per_roll,
+            michelson_maximum_type_size,
+            seed_nonce_revelation_tip,
+            origination_size,
+            block_security_deposit,
+            endorsement_security_deposit,
+            block_reward),
+           (endorsement_reward,
+            cost_per_byte,
+            hard_storage_limit_per_operation,
+            test_chain_duration))))
+      (fun (( preserved_cycles,
+              blocks_per_cycle,
+              blocks_per_commitment,
+              blocks_per_roll_snapshot,
+              blocks_per_voting_period,
+              time_between_blocks,
+              endorsers_per_block,
+              hard_gas_limit_per_operation,
+              hard_gas_limit_per_block),
+            ((proof_of_work_threshold,
+              tokens_per_roll,
+              michelson_maximum_type_size,
+              seed_nonce_revelation_tip,
+              origination_size,
+              block_security_deposit,
+              endorsement_security_deposit,
+              block_reward),
+             (endorsement_reward,
+              cost_per_byte,
+              hard_storage_limit_per_operation,
+              test_chain_duration))) ->
+        let unopt def = function None -> def | Some v -> v in
+        { preserved_cycles =
+            unopt default.preserved_cycles preserved_cycles ;
+          blocks_per_cycle =
+            unopt default.blocks_per_cycle blocks_per_cycle ;
+          blocks_per_commitment =
+            unopt default.blocks_per_commitment blocks_per_commitment ;
+          blocks_per_roll_snapshot =
+            unopt default.blocks_per_roll_snapshot blocks_per_roll_snapshot ;
+          blocks_per_voting_period =
+            unopt default.blocks_per_voting_period blocks_per_voting_period ;
+          time_between_blocks =
+            unopt default.time_between_blocks @@
+            time_between_blocks ;
+          endorsers_per_block =
+            unopt default.endorsers_per_block endorsers_per_block ;
+          hard_gas_limit_per_operation =
+            unopt default.hard_gas_limit_per_operation hard_gas_limit_per_operation ;
+          hard_gas_limit_per_block =
+            unopt default.hard_gas_limit_per_block hard_gas_limit_per_block ;
+          proof_of_work_threshold =
+            unopt default.proof_of_work_threshold proof_of_work_threshold ;
+          tokens_per_roll =
+            unopt default.tokens_per_roll tokens_per_roll ;
+          michelson_maximum_type_size =
+            unopt default.michelson_maximum_type_size michelson_maximum_type_size ;
+          seed_nonce_revelation_tip =
+            unopt default.seed_nonce_revelation_tip seed_nonce_revelation_tip ;
+          origination_size =
+            unopt default.origination_size origination_size ;
+          block_security_deposit =
+            unopt default.block_security_deposit block_security_deposit ;
+          endorsement_security_deposit =
+            unopt default.endorsement_security_deposit endorsement_security_deposit ;
+          block_reward =
+            unopt default.block_reward block_reward ;
+          endorsement_reward =
+            unopt default.endorsement_reward endorsement_reward ;
+          cost_per_byte =
+            unopt default.cost_per_byte cost_per_byte ;
+          hard_storage_limit_per_operation =
+            unopt default.hard_storage_limit_per_operation hard_storage_limit_per_operation ;
+          test_chain_duration =
+            unopt default.test_chain_duration test_chain_duration ;
+        } )
+      (merge_objs
+         (obj9
+            (opt "preserved_cycles" uint8)
+            (opt "blocks_per_cycle" int32)
+            (opt "blocks_per_commitment" int32)
+            (opt "blocks_per_roll_snapshot" int32)
+            (opt "blocks_per_voting_period" int32)
+            (opt "time_between_blocks" (list Period_repr.encoding))
+            (opt "endorsers_per_block" uint16)
+            (opt "hard_gas_limit_per_operation" z)
+            (opt "hard_gas_limit_per_block" z))
+         (merge_objs
+            (obj8
+               (opt "proof_of_work_threshold" int64)
+               (opt "tokens_per_roll" Tez_repr.encoding)
+               (opt "michelson_maximum_type_size" uint16)
+               (opt "seed_nonce_revelation_tip" Tez_repr.encoding)
+               (opt "origination_size" int31)
+               (opt "block_security_deposit" Tez_repr.encoding)
+               (opt "endorsement_security_deposit" Tez_repr.encoding)
+               (opt "block_reward" Tez_repr.encoding))
+            (obj4
+               (opt "endorsement_reward" Tez_repr.encoding)
+               (opt "cost_per_byte" Tez_repr.encoding)
+               (opt "hard_storage_limit_per_operation" z)
+               (opt "test_chain_duration" int64))))
+
+end

vendors/ligo-utils/tezos-protocol-alpha/parameters_repr.mli

@@ -45,4 +45,34 @@ type t = {
 }
 
 val encoding: t Data_encoding.t
-val constants_encoding: Constants_repr.parametric Data_encoding.t
+
+
+(* Only for migration from 004 to 005 *)
+
+module Proto_004 : sig
+  type parametric = {
+    preserved_cycles: int ;
+    blocks_per_cycle: int32 ;
+    blocks_per_commitment: int32 ;
+    blocks_per_roll_snapshot: int32 ;
+    blocks_per_voting_period: int32 ;
+    time_between_blocks: Period_repr.t list ;
+    endorsers_per_block: int ;
+    hard_gas_limit_per_operation: Z.t ;
+    hard_gas_limit_per_block: Z.t ;
+    proof_of_work_threshold: int64 ;
+    tokens_per_roll: Tez_repr.t ;
+    michelson_maximum_type_size: int;
+    seed_nonce_revelation_tip: Tez_repr.t ;
+    origination_size: int ;
+    block_security_deposit: Tez_repr.t ;
+    endorsement_security_deposit: Tez_repr.t ;
+    block_reward: Tez_repr.t ;
+    endorsement_reward: Tez_repr.t ;
+    cost_per_byte: Tez_repr.t ;
+    hard_storage_limit_per_operation: Z.t ;
+    test_chain_duration: int64 ;
+  }
+
+  val constants_encoding: parametric Data_encoding.t
+end

vendors/ligo-utils/tezos-protocol-alpha/period_repr.ml

@@ -28,6 +28,8 @@ type period = t
 include (Compare.Int64 : Compare.S with type t := t)
 let encoding = Data_encoding.int64
 
+let rpc_arg = RPC_arg.int64
+
 let pp ppf v = Format.fprintf ppf "%Ld" v
 
 type error += (* `Permanent *)
@@ -73,6 +75,7 @@ let mult i p =
   then error Invalid_arg
   else ok (Int64.mul (Int64.of_int32 i) p)
 
+let zero = of_seconds_exn 0L
 let one_second = of_seconds_exn 1L
 let one_minute = of_seconds_exn 60L
 let one_hour = of_seconds_exn 3600L

vendors/ligo-utils/tezos-protocol-alpha/period_repr.mli

@@ -27,6 +27,7 @@ type t
 type period = t
 include Compare.S with type t := t
 val encoding : period Data_encoding.t
+val rpc_arg : period RPC_arg.t
 val pp: Format.formatter -> period -> unit
 
 
@@ -41,6 +42,7 @@ val of_seconds_exn : int64 -> period
 
 val mult : int32 -> period -> period tzresult
 
+val zero : period
 val one_second : period
 val one_minute : period
 val one_hour : period

vendors/ligo-utils/tezos-protocol-alpha/raw_context.ml

@@ -30,18 +30,22 @@ type t = {
   constants: Constants_repr.parametric ;
   first_level: Raw_level_repr.t ;
   level: Level_repr.t ;
+  predecessor_timestamp: Time.t ;
   timestamp: Time.t ;
   fitness: Int64.t ;
   deposits: Tez_repr.t Signature.Public_key_hash.Map.t ;
+  included_endorsements: int ;
   allowed_endorsements:
     (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ;
   fees: Tez_repr.t ;
   rewards: Tez_repr.t ;
   block_gas: Z.t ;
   operation_gas: Gas_limit_repr.t ;
+  internal_gas: Gas_limit_repr.internal_gas ;
   storage_space_to_pay: Z.t option ;
   allocated_contracts: int option ;
   origination_nonce: Contract_repr.origination_nonce option ;
+  temporary_big_map: Z.t ;
   internal_nonce: int ;
   internal_nonces_used: Int_set.t ;
 }
@@ -50,6 +54,7 @@ type context = t
 type root_context = t
 
 let current_level ctxt = ctxt.level
+let predecessor_timestamp ctxt = ctxt.predecessor_timestamp
 let current_timestamp ctxt = ctxt.timestamp
 let current_fitness ctxt = ctxt.fitness
 let first_level ctxt = ctxt.first_level
@@ -62,6 +67,7 @@ let record_endorsement ctxt k =
   | Some (_, _, true) -> assert false (* right already used *)
   | Some (d, s, false) ->
       { ctxt with
+        included_endorsements = ctxt.included_endorsements + (List.length s);
         allowed_endorsements =
           Signature.Public_key_hash.Map.add k (d,s,true) ctxt.allowed_endorsements }
 
@@ -77,6 +83,8 @@ let init_endorsements ctxt allowed_endorsements =
 let allowed_endorsements ctxt =
   ctxt.allowed_endorsements
 
+let included_endorsements ctxt = ctxt.included_endorsements
+
 type error += Too_many_internal_operations (* `Permanent *)
 
 let () =
@@ -184,16 +192,22 @@ let check_gas_limit ctxt remaining =
   else
     ok ()
 let set_gas_limit ctxt remaining =
-  { ctxt with operation_gas = Limited { remaining } }
+  { ctxt with operation_gas = Limited { remaining } ;
+              internal_gas = Gas_limit_repr.internal_gas_zero }
 let set_gas_unlimited ctxt =
   { ctxt with operation_gas = Unaccounted }
 let consume_gas ctxt cost =
-  Gas_limit_repr.consume ctxt.block_gas ctxt.operation_gas cost >>? fun (block_gas, operation_gas) ->
+  Gas_limit_repr.consume
-  ok { ctxt with block_gas ; operation_gas }
+    ctxt.block_gas
+    ctxt.operation_gas
+    ctxt.internal_gas
+    cost >>? fun (block_gas, operation_gas, internal_gas) ->
+  ok { ctxt with block_gas ; operation_gas ; internal_gas }
 let check_enough_gas ctxt cost =
-  Gas_limit_repr.check_enough ctxt.block_gas ctxt.operation_gas cost
+  Gas_limit_repr.check_enough ctxt.block_gas ctxt.operation_gas ctxt.internal_gas cost
 let gas_level ctxt = ctxt.operation_gas
 let block_gas_level ctxt = ctxt.block_gas
+
 let gas_consumed ~since ~until =
   match gas_level since, gas_level until with
   | Limited { remaining = before }, Limited { remaining = after } -> Z.sub before after
@@ -318,7 +332,7 @@ let storage_error err = fail (Storage_error err)
 (* This key should always be populated for every version of the
    protocol.  It's absence meaning that the context is empty. *)
 let version_key = ["version"]
-let version_value = "alpha_current"
+let version_value = "babylon_005"
 
 let version = "v1"
 let first_level_key = [ version ; "first_level" ]
@@ -400,7 +414,7 @@ let get_proto_param ctxt =
 let set_constants ctxt constants =
   let bytes =
     Data_encoding.Binary.to_bytes_exn
-      Parameters_repr.constants_encoding constants in
+      Constants_repr.parametric_encoding constants in
   Context.set ctxt constants_key bytes
 
 let get_constants ctxt =
@@ -409,7 +423,20 @@ let get_constants ctxt =
       failwith "Internal error: cannot read constants in context."
   | Some bytes ->
       match
-        Data_encoding.Binary.of_bytes Parameters_repr.constants_encoding bytes
+        Data_encoding.Binary.of_bytes Constants_repr.parametric_encoding bytes
+      with
+      | None ->
+          failwith "Internal error: cannot parse constants in context."
+      | Some constants -> return constants
+
+(* only for migration from 004 to 005 *)
+let get_004_constants ctxt =
+  Context.get ctxt constants_key >>= function
+  | None ->
+      failwith "Internal error: cannot read constants in context."
+  | Some bytes ->
+      match
+        Data_encoding.Binary.of_bytes Parameters_repr.Proto_004.constants_encoding bytes
       with
       | None ->
           failwith "Internal error: cannot parse constants in context."
@@ -431,7 +458,7 @@ let check_inited ctxt =
       else
         storage_error (Incompatible_protocol_version s)
 
-let prepare ~level ~timestamp ~fitness ctxt =
+let prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt =
   Lwt.return (Raw_level_repr.of_int32 level) >>=? fun level ->
   Lwt.return (Fitness_repr.to_int64 fitness) >>=? fun fitness ->
   check_inited ctxt >>=? fun () ->
@@ -446,23 +473,27 @@ let prepare ~level ~timestamp ~fitness ctxt =
       level in
   return {
     context = ctxt ; constants ; level ;
+    predecessor_timestamp ;
     timestamp ; fitness ; first_level ;
     allowed_endorsements = Signature.Public_key_hash.Map.empty ;
+    included_endorsements = 0 ;
     fees = Tez_repr.zero ;
     rewards = Tez_repr.zero ;
     deposits = Signature.Public_key_hash.Map.empty ;
     operation_gas = Unaccounted ;
+    internal_gas = Gas_limit_repr.internal_gas_zero ;
     storage_space_to_pay = None ;
     allocated_contracts = None ;
     block_gas = constants.Constants_repr.hard_gas_limit_per_block ;
     origination_nonce = None ;
+    temporary_big_map = Z.sub Z.zero Z.one ;
     internal_nonce = 0 ;
     internal_nonces_used = Int_set.empty ;
   }
 
 type previous_protocol =
   | Genesis of Parameters_repr.t
-  | Alpha_previous
+  | Athens_004
 
 let check_and_update_protocol_version ctxt =
   begin
@@ -476,8 +507,8 @@ let check_and_update_protocol_version ctxt =
         else if Compare.String.(s = "genesis") then
           get_proto_param ctxt >>=? fun (param, ctxt) ->
           return (Genesis param, ctxt)
-        else if Compare.String.(s = "alpha_previous") then
+        else if Compare.String.(s = "athens_004") then
-          return (Alpha_previous, ctxt)
+          return (Athens_004, ctxt)
         else
           storage_error (Incompatible_protocol_version s)
   end >>=? fun (previous_proto, ctxt) ->
@@ -494,10 +525,41 @@ let prepare_first_block ~level ~timestamp ~fitness ctxt =
         set_first_level ctxt first_level >>=? fun ctxt ->
         set_constants ctxt param.constants >>= fun ctxt ->
         return ctxt
-    | Alpha_previous ->
+    | Athens_004 ->
+        get_004_constants ctxt >>=? fun c ->
+        let constants = Constants_repr.{
+            preserved_cycles = c.preserved_cycles ;
+            blocks_per_cycle = c.blocks_per_cycle ;
+            blocks_per_commitment = c.blocks_per_commitment ;
+            blocks_per_roll_snapshot = c.blocks_per_roll_snapshot ;
+            blocks_per_voting_period = c.blocks_per_voting_period ;
+            time_between_blocks =
+              List.map Period_repr.of_seconds_exn [ 60L ; 40L ] ;
+            endorsers_per_block = c.endorsers_per_block ;
+            hard_gas_limit_per_operation = c.hard_gas_limit_per_operation ;
+            hard_gas_limit_per_block = c.hard_gas_limit_per_block ;
+            proof_of_work_threshold = c.proof_of_work_threshold ;
+            tokens_per_roll = c.tokens_per_roll ;
+            michelson_maximum_type_size = c.michelson_maximum_type_size;
+            seed_nonce_revelation_tip = c.seed_nonce_revelation_tip ;
+            origination_size = c.origination_size ;
+            block_security_deposit = c.block_security_deposit ;
+            endorsement_security_deposit = c.endorsement_security_deposit ;
+            block_reward = c.block_reward ;
+            endorsement_reward = c.endorsement_reward ;
+            cost_per_byte = c.cost_per_byte ;
+            hard_storage_limit_per_operation = c.hard_storage_limit_per_operation ;
+            test_chain_duration = c.test_chain_duration ;
+            quorum_min = 20_00l ; (* quorum is in centile of a percentage *)
+            quorum_max = 70_00l ;
+            min_proposal_quorum = 5_00l ;
+            initial_endorsers = 24 ;
+            delay_per_missing_endorsement = Period_repr.of_seconds_exn 8L ;
+          } in
+        set_constants ctxt constants >>= fun ctxt ->
         return ctxt
   end >>=? fun ctxt ->
-  prepare ctxt ~level ~timestamp ~fitness >>=? fun ctxt ->
+  prepare ctxt ~level ~predecessor_timestamp:timestamp ~timestamp ~fitness >>=? fun ctxt ->
   return (previous_proto, ctxt)
 
 let activate ({ context = c ; _ } as s) h =
@@ -507,30 +569,6 @@ let fork_test_chain ({ context = c ; _ } as s) protocol expiration =
   Updater.fork_test_chain c ~protocol ~expiration >>= fun c ->
   Lwt.return { s with context = c }
 
-let register_resolvers enc resolve =
-  let resolve context str =
-    let faked_context = {
-      context ;
-      constants = Constants_repr.default ;
-      first_level = Raw_level_repr.root ;
-      level =  Level_repr.root Raw_level_repr.root ;
-      timestamp = Time.of_seconds 0L ;
-      fitness = 0L ;
-      allowed_endorsements = Signature.Public_key_hash.Map.empty ;
-      storage_space_to_pay = None ;
-      allocated_contracts = None ;
-      fees = Tez_repr.zero ;
-      rewards = Tez_repr.zero ;
-      deposits = Signature.Public_key_hash.Map.empty ;
-      block_gas = Constants_repr.default.hard_gas_limit_per_block ;
-      operation_gas = Unaccounted ;
-      origination_nonce = None ;
-      internal_nonce = 0 ;
-      internal_nonces_used = Int_set.empty ;
-    } in
-    resolve faked_context str in
-  Context.register_resolver enc  resolve
-
 (* Generic context ********************************************************)
 
 type key = string list
@@ -650,3 +688,19 @@ let project x = x
 let absolute_key _ k = k
 
 let description = Storage_description.create ()
+
+let fresh_temporary_big_map ctxt =
+  { ctxt with temporary_big_map = Z.sub ctxt.temporary_big_map Z.one },
+  ctxt.temporary_big_map
+
+let reset_temporary_big_map ctxt =
+  { ctxt with temporary_big_map = Z.sub Z.zero Z.one }
+
+let temporary_big_maps ctxt f acc =
+  let rec iter acc id =
+    if Z.equal id ctxt.temporary_big_map then
+      Lwt.return acc
+    else
+      f acc id >>= fun acc ->
+      iter acc (Z.sub id Z.one) in
+  iter acc (Z.sub Z.zero Z.one)

vendors/ligo-utils/tezos-protocol-alpha/raw_context.mli

@@ -23,7 +23,7 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-(** {1 Errors} ****************************************************************)
+(** {1 Errors} *)
 
 type error += Too_many_internal_operations (* `Permanent *)
 
@@ -40,7 +40,7 @@ type error += Failed_to_decode_parameter of Data_encoding.json * string
 
 val storage_error: storage_error -> 'a tzresult Lwt.t
 
-(** {1 Abstract Context} **************************************************)
+(** {1 Abstract Context} *)
 
 (** Abstract view of the context.
     Includes a handle to the functional key-value database
@@ -54,13 +54,14 @@ type root_context = t
     with this version of the protocol. *)
 val prepare:
   level: Int32.t ->
+  predecessor_timestamp: Time.t ->
   timestamp: Time.t ->
   fitness: Fitness.t ->
   Context.t -> context tzresult Lwt.t
 
 type previous_protocol =
   | Genesis of Parameters_repr.t
-  | Alpha_previous
+  | Athens_004
 
 val prepare_first_block:
   level:int32 ->
@@ -71,14 +72,12 @@ val prepare_first_block:
 val activate: context -> Protocol_hash.t -> t Lwt.t
 val fork_test_chain: context -> Protocol_hash.t -> Time.t -> t Lwt.t
 
-val register_resolvers:
-  'a Base58.encoding -> (context -> string -> 'a list Lwt.t) -> unit
-
 (** Returns the state of the database resulting of operations on its
     abstract view *)
 val recover: context -> Context.t
 
 val current_level: context -> Level_repr.t
+val predecessor_timestamp: context -> Time.t
 val current_timestamp: context -> Time.t
 
 val current_fitness: context -> Int64.t
@@ -129,7 +128,7 @@ val origination_nonce: t -> Contract_repr.origination_nonce tzresult
 val increment_origination_nonce: t -> (t * Contract_repr.origination_nonce) tzresult
 val unset_origination_nonce: t -> t
 
-(** {1 Generic accessors} *************************************************)
+(** {1 Generic accessors} *)
 
 type key = string list
 
@@ -241,6 +240,9 @@ val allowed_endorsements:
   context ->
   (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t
 
+(** Keep track of the number of endorsements that are included in a block *)
+val included_endorsements: context -> int
+
 (** Initializes the map of allowed endorsements, this function must only be
     called once. *)
 val init_endorsements:
@@ -251,3 +253,12 @@ val init_endorsements:
 (** Marks an endorsment in the map as used. *)
 val record_endorsement:
   context -> Signature.Public_key_hash.t -> context
+
+(** Provide a fresh identifier for a temporary big map (negative index). *)
+val fresh_temporary_big_map: context -> context * Z.t
+
+(** Reset the temporary big_map identifier generator to [-1]. *)
+val reset_temporary_big_map: context -> context
+
+(** Iterate over all created temporary big maps since the last {!reset_temporary_big_map}. *)
+val temporary_big_maps: context -> ('a -> Z.t -> 'a Lwt.t) -> 'a -> 'a Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/raw_level_repr.ml

@@ -72,7 +72,7 @@ let () =
 
 let of_int32 l =
   try Ok (of_int32_exn l)
-  with _ -> Error [Unexpected_level l]
+  with _ -> error (Unexpected_level l)
 
 module Index = struct
   type t = raw_level

vendors/ligo-utils/tezos-protocol-alpha/script_interpreter.mli

@@ -42,26 +42,38 @@ type execution_result =
     big_map_diff : Contract.big_map_diff option ;
     operations : packed_internal_operation list }
 
+type step_constants =
+  { source : Contract.t ;
+    payer : Contract.t ;
+    self : Contract.t ;
+    amount : Tez.t ;
+    chain_id : Chain_id.t }
+
 type 'tys stack =
   | Item : 'ty * 'rest stack -> ('ty * 'rest) stack
   | Empty : Script_typed_ir.end_of_stack stack
 
+val step:
+  ?log: execution_trace ref ->
+  context -> step_constants ->
+  ('bef, 'aft) Script_typed_ir.descr ->
+  'bef stack ->
+  ('aft stack * context) tzresult Lwt.t
+
 val execute:
   Alpha_context.t ->
   Script_ir_translator.unparsing_mode ->
-  source: Contract.t ->
+  step_constants ->
-  payer: Contract.t ->
+  script: Script.t ->
-  self: (Contract.t * Script.t) ->
+  entrypoint: string ->
   parameter: Script.expr ->
-  amount: Tez.t ->
   execution_result tzresult Lwt.t
 
 val trace:
   Alpha_context.t ->
   Script_ir_translator.unparsing_mode ->
-  source: Contract.t ->
+  step_constants ->
-  payer: Contract.t ->
+  script: Script.t ->
-  self: (Contract.t * Script.t) ->
+  entrypoint: string ->
   parameter: Script.expr ->
-  amount: Tez.t ->
   (execution_result * execution_trace) tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/script_ir_annot.ml

@@ -101,26 +101,26 @@ let gen_access_annot
         Some (`Var_annot (String.concat "." [v; f]))
 
 let merge_type_annot
-  : type_annot option -> type_annot option -> type_annot option tzresult
+  : legacy: bool -> type_annot option -> type_annot option -> type_annot option tzresult
-  = fun annot1 annot2 ->
+  = fun ~legacy annot1 annot2 ->
     match annot1, annot2 with
     | None, None
     | Some _, None
     | None, Some _ -> ok None
     | Some `Type_annot a1, Some `Type_annot a2 ->
-        if String.equal a1 a2
+        if legacy || String.equal a1 a2
         then ok annot1
         else error (Inconsistent_annotations (":" ^ a1, ":" ^ a2))
 
 let merge_field_annot
-  : field_annot option -> field_annot option -> field_annot option tzresult
+  : legacy: bool -> field_annot option -> field_annot option -> field_annot option tzresult
-  = fun annot1 annot2 ->
+  = fun ~legacy annot1 annot2 ->
     match annot1, annot2 with
     | None, None
     | Some _, None
     | None, Some _ -> ok None
     | Some `Field_annot a1, Some `Field_annot a2 ->
-        if String.equal a1 a2
+        if legacy || String.equal a1 a2
         then ok annot1
         else error (Inconsistent_annotations ("%" ^ a1, "%" ^ a2))
 
@@ -257,26 +257,6 @@ let parse_composed_type_annot
     get_two_annot loc fields >|? fun (f1, f2) ->
     (t, f1, f2)
 
-let check_const_type_annot
-  : int -> string list -> type_annot option -> field_annot option list -> unit tzresult Lwt.t
-  = fun loc annot expected_name expected_fields ->
-    Lwt.return
-      (parse_composed_type_annot loc annot >>? fun (ty_name, field1, field2) ->
-       merge_type_annot expected_name ty_name >>? fun _ ->
-       match expected_fields, field1, field2 with
-       | [], Some _, _ | [], _, Some _ | [_], Some _, Some _ ->
-           (* Too many annotations *)
-           error (Unexpected_annotation loc)
-       | _ :: _ :: _ :: _, _, _ | [_], None, Some _ ->
-           error (Unexpected_annotation loc)
-       | [], None, None -> ok ()
-       | [ f1; f2 ], _,  _ ->
-           merge_field_annot f1 field1 >>? fun _ ->
-           merge_field_annot f2 field2 >|? fun _ -> ()
-       | [ f1 ], _,  None ->
-           merge_field_annot f1 field1 >|? fun _ -> ()
-      )
-
 let parse_field_annot
   : int -> string list -> field_annot option tzresult
   = fun loc annot ->
@@ -290,12 +270,18 @@ let extract_field_annot
   : Script.node -> (Script.node * field_annot option) tzresult
   = function
     | Prim (loc, prim, args, annot) ->
-        let field_annots, annot = List.partition (fun s ->
+        let rec extract_first acc = function
-            Compare.Int.(String.length s > 0) &&
+          | [] -> None, annot
-            Compare.Char.(s.[0] = '%')
+          | s :: rest ->
-          ) annot in
+              if Compare.Int.(String.length s > 0) &&
-        parse_field_annot loc field_annots >|? fun field_annot ->
+                 Compare.Char.(s.[0] = '%') then
-        Prim (loc, prim, args, annot), field_annot
+                Some s, List.rev_append acc rest
+              else extract_first (s :: acc) rest in
+        let field_annot, annot = extract_first [] annot in
+        let field_annot = match field_annot with
+          | None -> None
+          | Some field_annot -> Some (`Field_annot (String.sub field_annot 1 (String.length field_annot - 1))) in
+        ok (Prim (loc, prim, args, annot), field_annot)
     | expr -> ok (expr, None)
 
 let check_correct_field
@@ -402,6 +388,19 @@ let parse_destr_annot
       | None -> value_annot in
     (v, f)
 
+let parse_entrypoint_annot
+  : int -> ?default:var_annot option -> string list -> (var_annot option * field_annot option) tzresult
+  = fun loc ?default annot ->
+    parse_annots loc annot >>?
+    classify_annot loc >>? fun (vars, types, fields) ->
+    error_unexpected_annot loc types >>? fun () ->
+    get_one_annot loc fields >>? fun f ->
+    get_one_annot loc vars >|? function
+    | Some _ as a -> (a, f)
+    | None -> match default with
+      | Some a -> (a, f)
+      | None -> (None, f)
+
 let parse_var_type_annot
   : int -> string list -> (var_annot option * type_annot option) tzresult
   = fun loc annot ->

vendors/ligo-utils/tezos-protocol-alpha/script_ir_annot.mli

@@ -72,28 +72,28 @@ val var_to_field_annot : var_annot option -> field_annot option
 (** Replace an annotation by its default value if it is [None] *)
 val default_annot : default:'a option -> 'a option -> 'a option
 
-(** Generate annotation for field accesses, of the form @var.field1.field2 *)
+(** Generate annotation for field accesses, of the form [var.field1.field2] *)
 val gen_access_annot :
   var_annot option ->
   ?default:field_annot option -> field_annot option -> var_annot option
 
 (** Merge type annotations.
-    @returns an error {!Inconsistent_type_annotations} if they are both present
+    @return an error {!Inconsistent_type_annotations} if they are both present
-    and different *)
+    and different, unless [legacy] *)
 val merge_type_annot :
-  type_annot option -> type_annot option -> type_annot option tzresult
+  legacy: bool -> type_annot option -> type_annot option -> type_annot option tzresult
 
 (** Merge field annotations.
-    @returns an error {!Inconsistent_type_annotations} if they are both present
+    @return an error {!Inconsistent_type_annotations} if they are both present
-    and different *)
+    and different, unless [legacy] *)
 val merge_field_annot :
-  field_annot option -> field_annot option -> field_annot option tzresult
+  legacy: bool -> field_annot option -> field_annot option -> field_annot option tzresult
 
 (** Merge variable annotations, does not fail ([None] if different). *)
 val merge_var_annot :
   var_annot option -> var_annot option -> var_annot option
 
-(** @returns an error {!Unexpected_annotation} in the monad the list is not empty. *)
+(** @return an error {!Unexpected_annotation} in the monad the list is not empty. *)
 val error_unexpected_annot : int -> 'a list -> unit tzresult
 
 (** Same as {!error_unexpected_annot} in Lwt. *)
@@ -117,11 +117,6 @@ val parse_composed_type_annot :
   int -> string list ->
   (type_annot option * field_annot option * field_annot option) tzresult
 
-(** Check that type annotations on constants are consistent *)
-val check_const_type_annot :
-  int -> string list -> type_annot option -> field_annot option list ->
-  unit tzresult Lwt.t
-
 (** Extract and remove a field annotation from a node *)
 val extract_field_annot :
   Script.node -> (Script.node * field_annot option) tzresult
@@ -157,5 +152,11 @@ val parse_destr_annot :
   value_annot:var_annot option ->
   (var_annot option * field_annot option) tzresult
 
+val parse_entrypoint_annot :
+  int ->
+  ?default:var_annot option ->
+  string list ->
+  (var_annot option * field_annot option) tzresult
+
 val parse_var_type_annot :
   int -> string list -> (var_annot option * type_annot option) tzresult

vendors/ligo-utils/tezos-protocol-alpha/script_ir_translator.mli

@@ -32,11 +32,17 @@ type ex_comparable_ty = Ex_comparable_ty : 'a Script_typed_ir.comparable_ty -> e
 type ex_ty = Ex_ty : 'a Script_typed_ir.ty -> ex_ty
 type ex_stack_ty = Ex_stack_ty : 'a Script_typed_ir.stack_ty -> ex_stack_ty
 type ex_script = Ex_script : ('a, 'b) Script_typed_ir.script -> ex_script
-
 type tc_context =
   | Lambda : tc_context
   | Dip : 'a Script_typed_ir.stack_ty * tc_context -> tc_context
-  | Toplevel : { storage_type : 'sto Script_typed_ir.ty ; param_type : 'param Script_typed_ir.ty } -> tc_context
+  | Toplevel : { storage_type : 'sto Script_typed_ir.ty ;
+                 param_type : 'param Script_typed_ir.ty ;
+                 root_name : string option ;
+                 legacy_create_contract_literal : bool } -> tc_context
+type 'bef judgement =
+  | Typed : ('bef, 'aft) Script_typed_ir.descr -> 'bef judgement
+  | Failed :
+      { descr : 'aft. 'aft Script_typed_ir.stack_ty -> ('bef, 'aft) Script_typed_ir.descr } -> 'bef judgement
 
 type unparsing_mode = Optimized | Readable
 
@@ -64,21 +70,20 @@ val map_get : 'key -> ('key, 'value) Script_typed_ir.map -> 'value option
 val map_key_ty : ('a, 'b) Script_typed_ir.map -> 'a Script_typed_ir.comparable_ty
 val map_size : ('a, 'b) Script_typed_ir.map -> Script_int.n Script_int.num
 
+val empty_big_map : 'a Script_typed_ir.comparable_ty -> 'b Script_typed_ir.ty -> ('a, 'b) Script_typed_ir.big_map
 val big_map_mem :
-  context -> Contract.t -> 'key ->
+  context -> 'key ->
   ('key, 'value) Script_typed_ir.big_map ->
   (bool * context) tzresult Lwt.t
 val big_map_get :
-  context ->
+  context -> 'key ->
-  Contract.t -> 'key ->
   ('key, 'value) Script_typed_ir.big_map ->
   ('value option * context) tzresult Lwt.t
 val big_map_update :
   'key -> 'value option -> ('key, 'value) Script_typed_ir.big_map ->
   ('key, 'value) Script_typed_ir.big_map
 
-val ty_of_comparable_ty :
+val has_big_map : 't Script_typed_ir.ty -> bool
-  'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.ty
 
 
 val ty_eq :
@@ -86,25 +91,41 @@ val ty_eq :
   'ta Script_typed_ir.ty -> 'tb Script_typed_ir.ty ->
   (('ta Script_typed_ir.ty, 'tb Script_typed_ir.ty) eq * context) tzresult
 
+val compare_comparable : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> int
+
+val ty_of_comparable_ty : ('a, 's) Script_typed_ir.comparable_struct -> 'a Script_typed_ir.ty
+
 val parse_data :
   ?type_logger: type_logger ->
-  context ->
+  context -> legacy: bool ->
   'a Script_typed_ir.ty -> Script.node -> ('a * context) tzresult Lwt.t
 val unparse_data :
   context -> unparsing_mode -> 'a Script_typed_ir.ty -> 'a ->
   (Script.node * context) tzresult Lwt.t
 
+val parse_instr :
+  ?type_logger: type_logger ->
+  tc_context -> context -> legacy: bool ->
+  Script.node -> 'bef Script_typed_ir.stack_ty -> ('bef judgement * context) tzresult Lwt.t
+
 val parse_ty :
-  context ->
+  context -> legacy: bool ->
   allow_big_map: bool ->
   allow_operation: bool ->
+  allow_contract: bool ->
   Script.node -> (ex_ty * context) tzresult
 
+val parse_packable_ty :
+  context -> legacy: bool -> Script.node -> (ex_ty * context) tzresult
+
 val unparse_ty :
   context -> 'a Script_typed_ir.ty -> (Script.node * context) tzresult Lwt.t
 
 val parse_toplevel :
-  Script.expr -> (Script.node * Script.node * Script.node) tzresult
+  legacy: bool -> Script.expr -> (Script.node * Script.node * Script.node * string option) tzresult
+
+val add_field_annot :
+  [ `Field_annot of string ] option -> [ `Var_annot of string ] option -> Script.node -> Script.node
 
 val typecheck_code :
   context -> Script.expr -> (type_map * context) tzresult Lwt.t
@@ -113,18 +134,9 @@ val typecheck_data :
   ?type_logger: type_logger ->
   context -> Script.expr * Script.expr -> context tzresult Lwt.t
 
-type 'bef judgement =
-  | Typed : ('bef, 'aft) Script_typed_ir.descr -> 'bef judgement
-  | Failed : { descr : 'aft. 'aft Script_typed_ir.stack_ty -> ('bef, 'aft) Script_typed_ir.descr } -> 'bef judgement
-
-val parse_instr :
-    ?type_logger: type_logger ->
-    tc_context -> context ->
-    Script.node -> 'bef Script_typed_ir.stack_ty -> ('bef judgement * context) tzresult Lwt.t
-
 val parse_script :
   ?type_logger: type_logger ->
-  context -> Script.t -> (ex_script * context) tzresult Lwt.t
+  context -> legacy: bool -> Script.t -> (ex_script * context) tzresult Lwt.t
 
 (* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)
 val unparse_script :
@@ -132,23 +144,44 @@ val unparse_script :
   ('a, 'b) Script_typed_ir.script -> (Script.t * context) tzresult Lwt.t
 
 val parse_contract :
-  context -> Script.location -> 'a Script_typed_ir.ty -> Contract.t ->
+  legacy: bool -> context -> Script.location -> 'a Script_typed_ir.ty -> Contract.t ->
+  entrypoint: string ->
   (context * 'a Script_typed_ir.typed_contract) tzresult Lwt.t
 
 val parse_contract_for_script :
-  context -> Script.location -> 'a Script_typed_ir.ty -> Contract.t ->
+  legacy: bool -> context -> Script.location -> 'a Script_typed_ir.ty -> Contract.t ->
+  entrypoint: string ->
   (context * 'a Script_typed_ir.typed_contract option) tzresult Lwt.t
 
+val find_entrypoint :
+  't Script_typed_ir.ty -> root_name: string option -> string -> ((Script.node -> Script.node) * ex_ty) tzresult
+
+module Entrypoints_map : S.MAP with type key = string
+
+val list_entrypoints :
+  't Script_typed_ir.ty ->
+  context ->
+  root_name: string option ->
+  (Michelson_v1_primitives.prim list list *
+   (Michelson_v1_primitives.prim list * Script.node) Entrypoints_map.t)
+    tzresult
+
 val pack_data : context -> 'a Script_typed_ir.ty -> 'a -> (MBytes.t * context) tzresult Lwt.t
 val hash_data : context -> 'a Script_typed_ir.ty -> 'a -> (Script_expr_hash.t * context) tzresult Lwt.t
 
-val extract_big_map :
+type big_map_ids
-  'a Script_typed_ir.ty -> 'a -> Script_typed_ir.ex_big_map option
 
-val diff_of_big_map :
+val no_big_map_id : big_map_ids
-  context -> unparsing_mode -> Script_typed_ir.ex_big_map ->
-  (Contract.big_map_diff * context) tzresult Lwt.t
 
-val big_map_initialization :
+val collect_big_maps :
-  context -> unparsing_mode -> ex_script ->
+  context -> 'a Script_typed_ir.ty -> 'a -> (big_map_ids * context) tzresult Lwt.t
-  (Contract.big_map_diff option * context) tzresult Lwt.t
+
+val list_of_big_map_ids : big_map_ids -> Z.t list
+
+val extract_big_map_diff :
+  context -> unparsing_mode ->
+  temporary: bool ->
+  to_duplicate: big_map_ids ->
+  to_update: big_map_ids ->
+  'a Script_typed_ir.ty -> 'a ->
+  ('a * Contract.big_map_diff option * context) tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/script_repr.ml

@@ -62,7 +62,7 @@ let lazy_expr expr =
 
 type t = {
   code : lazy_expr ;
-  storage : lazy_expr
+  storage : lazy_expr ;
 }
 
 let encoding =
@@ -195,3 +195,25 @@ let minimal_deserialize_cost lexpr =
     ~fun_bytes:(fun b -> serialized_cost b)
     ~fun_combine:(fun c_free _ -> c_free)
     lexpr
+
+let unit =
+  Micheline.strip_locations (Prim (0, Michelson_v1_primitives.D_Unit, [], []))
+
+let unit_parameter =
+  lazy_expr unit
+
+let is_unit_parameter =
+  let unit_bytes = Data_encoding.force_bytes unit_parameter in
+  Data_encoding.apply_lazy
+    ~fun_value:(fun v -> match Micheline.root v with Prim (_, Michelson_v1_primitives.D_Unit, [], []) -> true | _ -> false)
+    ~fun_bytes:(fun b -> MBytes.(=) b unit_bytes)
+    ~fun_combine:(fun res _ -> res)
+
+let rec strip_annotations node =
+  let open Micheline in
+  match node with
+  | Int (_, _) | String (_, _) | Bytes (_, _) as leaf -> leaf
+  | Prim (loc, name, args, _) ->
+      Prim (loc, name, List.map strip_annotations args, [])
+  | Seq (loc, args) ->
+      Seq (loc, List.map strip_annotations args)

vendors/ligo-utils/tezos-protocol-alpha/script_repr.mli

@@ -69,3 +69,9 @@ val force_decode : lazy_expr -> (expr * Gas_limit_repr.cost) tzresult
 val force_bytes : lazy_expr -> (MBytes.t * Gas_limit_repr.cost) tzresult
 
 val minimal_deserialize_cost : lazy_expr -> Gas_limit_repr.cost
+
+val unit_parameter : lazy_expr
+
+val is_unit_parameter : lazy_expr -> bool
+
+val strip_annotations : node -> node

vendors/ligo-utils/tezos-protocol-alpha/script_tc_errors.ml

@@ -44,6 +44,11 @@ type error += Missing_field of prim
 type error += Duplicate_field of Script.location * prim
 type error += Unexpected_big_map of Script.location
 type error += Unexpected_operation of Script.location
+type error += Unexpected_contract of Script.location
+type error += No_such_entrypoint of string
+type error += Duplicate_entrypoint of string
+type error += Unreachable_entrypoint of prim list
+type error += Entrypoint_name_too_long of string
 
 (* Instruction typing errors *)
 type error += Fail_not_in_tail_position of Script.location
@@ -67,7 +72,9 @@ type error += Type_too_large : Script.location * int * int -> error
 
 (* Value typing errors *)
 type error += Invalid_constant : Script.location * Script.expr * Script.expr -> error
+type error += Invalid_syntactic_constant : Script.location * Script.expr * string -> error
 type error += Invalid_contract of Script.location * Contract.t
+type error += Invalid_big_map of Script.location * Big_map.id
 type error += Comparable_type_expected : Script.location * Script.expr -> error
 type error += Inconsistent_types : Script.expr * Script.expr -> error
 type error += Unordered_map_keys of Script.location * Script.expr
@@ -82,3 +89,6 @@ type error += Ill_typed_contract : Script.expr * type_map -> error
 
 (* Gas related errors *)
 type error += Cannot_serialize_error
+
+(* Deprecation errors *)
+type error += Deprecated_instruction of prim

vendors/ligo-utils/tezos-protocol-alpha/script_tc_errors_registration.ml

@@ -170,8 +170,9 @@ let () =
     ~id:"michelson_v1.unexpected_bigmap"
     ~title: "Big map in unauthorized position (type error)"
     ~description:
-      "When parsing script, a big_map type was found somewhere else \
+      "When parsing script, a big_map type was found in a position \
-       than in the left component of the toplevel storage pair."
+       where it could end up stored inside a big_map, which is \
+       forbidden for now."
     (obj1
        (req "loc" location_encoding))
     (function Unexpected_big_map loc -> Some loc | _ -> None)
@@ -180,14 +181,70 @@ let () =
   register_error_kind
     `Permanent
     ~id:"michelson_v1.unexpected_operation"
-    ~title: "Big map in unauthorized position (type error)"
+    ~title: "Operation in unauthorized position (type error)"
     ~description:
-      "When parsing script, a operation type was found \
+      "When parsing script, an operation type was found \
        in the storage or parameter field."
     (obj1
        (req "loc" location_encoding))
     (function Unexpected_operation loc -> Some loc | _ -> None)
     (fun loc -> Unexpected_operation loc) ;
+  (* No such entrypoint *)
+  register_error_kind
+    `Permanent
+    ~id:"michelson_v1.no_such_entrypoint"
+    ~title: "No such entrypoint (type error)"
+    ~description:
+      "An entrypoint was not found when calling a contract."
+    (obj1
+       (req "entrypoint" string))
+    (function No_such_entrypoint entrypoint -> Some entrypoint | _ -> None)
+    (fun entrypoint -> No_such_entrypoint entrypoint) ;
+  (* Unreachable entrypoint *)
+  register_error_kind
+    `Permanent
+    ~id:"michelson_v1.unreachable_entrypoint"
+    ~title: "Unreachable entrypoint (type error)"
+    ~description:
+      "An entrypoint in the contract is not reachable."
+    (obj1
+       (req "path" (list prim_encoding)))
+    (function Unreachable_entrypoint path -> Some path | _ -> None)
+    (fun path -> Unreachable_entrypoint path) ;
+  (* Duplicate entrypoint *)
+  register_error_kind
+    `Permanent
+    ~id:"michelson_v1.duplicate_entrypoint"
+    ~title: "Duplicate entrypoint (type error)"
+    ~description:
+      "Two entrypoints have the same name."
+    (obj1
+       (req "path" string))
+    (function Duplicate_entrypoint entrypoint -> Some entrypoint | _ -> None)
+    (fun entrypoint -> Duplicate_entrypoint entrypoint) ;
+  (* Entrypoint name too long *)
+  register_error_kind
+    `Permanent
+    ~id:"michelson_v1.entrypoint_name_too_long"
+    ~title: "Entrypoint name too long (type error)"
+    ~description:
+      "An entrypoint name exceeds the maximum length of 31 characters."
+    (obj1
+       (req "name" string))
+    (function Entrypoint_name_too_long entrypoint -> Some entrypoint | _ -> None)
+    (fun entrypoint -> Entrypoint_name_too_long entrypoint) ;
+  (* Unexpected contract *)
+  register_error_kind
+    `Permanent
+    ~id:"michelson_v1.unexpected_contract"
+    ~title: "Contract in unauthorized position (type error)"
+    ~description:
+      "When parsing script, a contract type was found \
+       in the storage or parameter field."
+    (obj1
+       (req "loc" location_encoding))
+    (function Unexpected_contract loc -> Some loc | _ -> None)
+    (fun loc -> Unexpected_contract loc) ;
   (* -- Value typing errors ---------------------- *)
   (* Unordered map keys *)
   register_error_kind
@@ -454,6 +511,22 @@ let () =
       | _ -> None)
     (fun (loc, (ty, expr)) ->
        Invalid_constant (loc, expr, ty)) ;
+  (* Invalid syntactic constant *)
+  register_error_kind
+    `Permanent
+    ~id:"invalidSyntacticConstantError"
+    ~title: "Invalid constant (parse error)"
+    ~description:
+      "A compile-time constant was invalid for its expected form."
+    (located (obj2
+                (req "expectedForm" Script.expr_encoding)
+                (req "wrongExpression" Script.expr_encoding)))
+    (function
+      | Invalid_constant (loc, expr, ty) ->
+          Some (loc, (ty, expr))
+      | _ -> None)
+    (fun (loc, (ty, expr)) ->
+       Invalid_constant (loc, expr, ty)) ;
   (* Invalid contract *)
   register_error_kind
     `Permanent
@@ -469,6 +542,21 @@ let () =
       | _ -> None)
     (fun (loc, c) ->
        Invalid_contract (loc, c)) ;
+  (* Invalid big_map *)
+  register_error_kind
+    `Permanent
+    ~id:"michelson_v1.invalid_big_map"
+    ~title: "Invalid big_map"
+    ~description:
+      "A script or data expression references a big_map that does not \
+       exist or assumes a wrong type for an existing big_map."
+    (located (obj1 (req "big_map" z)))
+    (function
+      | Invalid_big_map (loc, c) ->
+          Some (loc, c)
+      | _ -> None)
+    (fun (loc, c) ->
+       Invalid_big_map (loc, c)) ;
   (* Comparable type expected *)
   register_error_kind
     `Permanent
@@ -619,4 +707,14 @@ let () =
                   the provided gas"
     Data_encoding.empty
     (function Cannot_serialize_error -> Some () | _ -> None)
-    (fun () -> Cannot_serialize_error)
+    (fun () -> Cannot_serialize_error) ;
+  (* Deprecated instruction *)
+  register_error_kind
+    `Permanent
+    ~id:"michelson_v1.deprecated_instruction"
+    ~title:"Script is using a deprecated instruction"
+    ~description:
+      "A deprecated instruction usage is disallowed in newly created contracts"
+    (obj1 (req "prim" prim_encoding))
+    (function Deprecated_instruction prim -> Some prim | _ -> None)
+    (fun prim -> Deprecated_instruction prim) ;

vendors/ligo-utils/tezos-protocol-alpha/script_typed_ir.ml

@@ -34,20 +34,35 @@ type field_annot = [ `Field_annot of string ]
 
 type annot = [ var_annot | type_annot | field_annot ]
 
-type 'ty comparable_ty =
+type address = Contract.t * string
-  | Int_key : type_annot option -> (z num) comparable_ty
-  | Nat_key : type_annot option -> (n num) comparable_ty
-  | String_key : type_annot option -> string comparable_ty
-  | Bytes_key : type_annot option -> MBytes.t comparable_ty
-  | Mutez_key : type_annot option -> Tez.t comparable_ty
-  | Bool_key : type_annot option -> bool comparable_ty
-  | Key_hash_key : type_annot option -> public_key_hash comparable_ty
-  | Timestamp_key : type_annot option -> Script_timestamp.t comparable_ty
-  | Address_key : type_annot option -> Contract.t comparable_ty
 
+type ('a, 'b) pair = 'a * 'b
+
+type ('a, 'b) union = L of 'a | R of 'b
+
+type comb = Comb
+type leaf = Leaf
+
+type (_, _) comparable_struct =
+  | Int_key : type_annot option -> (z num, _) comparable_struct
+  | Nat_key : type_annot option -> (n num, _) comparable_struct
+  | String_key : type_annot option -> (string, _) comparable_struct
+  | Bytes_key : type_annot option -> (MBytes.t, _) comparable_struct
+  | Mutez_key : type_annot option -> (Tez.t, _) comparable_struct
+  | Bool_key : type_annot option -> (bool, _) comparable_struct
+  | Key_hash_key : type_annot option -> (public_key_hash, _) comparable_struct
+  | Timestamp_key : type_annot option -> (Script_timestamp.t, _) comparable_struct
+  | Address_key : type_annot option -> (address, _) comparable_struct
+  | Pair_key :
+      (('a, leaf) comparable_struct * field_annot option) *
+      (('b, _) comparable_struct * field_annot option) *
+      type_annot option -> (('a, 'b) pair, comb) comparable_struct
+
+type 'a comparable_ty = ('a, comb) comparable_struct
 
 module type Boxed_set = sig
   type elt
+  val elt_ty : elt comparable_ty
   module OPS : S.SET with type elt = elt
   val boxed : OPS.t
   val size : int
@@ -65,23 +80,21 @@ end
 
 type ('key, 'value) map = (module Boxed_map with type key = 'key and type value = 'value)
 
+type operation = packed_internal_operation * Contract.big_map_diff option
+
 type ('arg, 'storage) script =
-  { code : (('arg, 'storage) pair, (packed_internal_operation list, 'storage) pair) lambda ;
+  { code : (('arg, 'storage) pair, (operation list, 'storage) pair) lambda ;
     arg_type : 'arg ty ;
     storage : 'storage ;
-    storage_type : 'storage ty }
+    storage_type : 'storage ty ;
-
+    root_name : string option }
-and ('a, 'b) pair = 'a * 'b
-
-and ('a, 'b) union = L of 'a | R of 'b
 
 and end_of_stack = unit
 
 and ('arg, 'ret) lambda =
-    Lam of ('arg * end_of_stack, 'ret * end_of_stack) descr * Script.expr
+    Lam : ('arg * end_of_stack, 'ret * end_of_stack) descr * Script.node -> ('arg, 'ret) lambda
 
-and 'arg typed_contract =
+and 'arg typed_contract = 'arg ty * address
-  'arg ty * Contract.t
 
 and 'ty ty =
   | Unit_t : type_annot option -> unit ty
@@ -94,39 +107,48 @@ and 'ty ty =
   | Key_hash_t : type_annot option -> public_key_hash ty
   | Key_t : type_annot option -> public_key ty
   | Timestamp_t : type_annot option -> Script_timestamp.t ty
-  | Address_t : type_annot option -> Contract.t ty
+  | Address_t : type_annot option -> address ty
   | Bool_t : type_annot option -> bool ty
   | Pair_t :
       ('a ty * field_annot option * var_annot option) *
       ('b ty * field_annot option * var_annot option) *
-      type_annot option -> ('a, 'b) pair ty
+      type_annot option *
-  | Union_t : ('a ty * field_annot option) * ('b ty * field_annot option) * type_annot option  -> ('a, 'b) union ty
+      bool -> ('a, 'b) pair ty
+  | Union_t :
+      ('a ty * field_annot option) *
+      ('b ty * field_annot option) *
+      type_annot option *
+      bool -> ('a, 'b) union ty
   | Lambda_t : 'arg ty * 'ret ty * type_annot option  -> ('arg, 'ret) lambda ty
-  | Option_t : ('v ty * field_annot option) * field_annot option * type_annot option  -> 'v option ty
+  | Option_t : 'v ty * type_annot option * bool  -> 'v option ty
-  | List_t : 'v ty * type_annot option -> 'v list ty
+  | List_t : 'v ty * type_annot option * bool -> 'v list ty
   | Set_t : 'v comparable_ty * type_annot option -> 'v set ty
-  | Map_t : 'k comparable_ty * 'v ty * type_annot option -> ('k, 'v) map ty
+  | Map_t : 'k comparable_ty * 'v ty * type_annot option * bool -> ('k, 'v) map ty
   | Big_map_t : 'k comparable_ty * 'v ty * type_annot option -> ('k, 'v) big_map ty
   | Contract_t : 'arg ty * type_annot option -> 'arg typed_contract ty
-  | Operation_t : type_annot option -> packed_internal_operation ty
+  | Operation_t : type_annot option -> operation ty
+  | Chain_id_t : type_annot option -> Chain_id.t ty
 
 and 'ty stack_ty =
   | Item_t : 'ty ty * 'rest stack_ty * var_annot option -> ('ty * 'rest) stack_ty
   | Empty_t : end_of_stack stack_ty
 
-and ('key, 'value) big_map = { diff : ('key, 'value option) map ;
+and ('key, 'value) big_map = { id : Z.t option ;
+                               diff : ('key, 'value option) map ;
                                key_type : 'key ty ;
                                value_type : 'value ty }
 
 (* ---- Instructions --------------------------------------------------------*)
 
 (* The low-level, typed instructions, as a GADT whose parameters
-   encode the typing rules. The left parameter is the typed shape of
+   encode the typing rules.
-   the stack before the instruction, the right one the shape
+
-   after. Any program whose construction is accepted by OCaml's
+   The left parameter is the typed shape of the stack before the
-   type-checker is guaranteed to be type-safe.  Overloadings of the
+   instruction, the right one the shape after. Any program whose
-   concrete syntax are already resolved in this representation, either
+   construction is accepted by OCaml's type-checker is guaranteed to
-   by using different constructors or type witness parameters. *)
+   be type-safe. Overloadings of the concrete syntax are already
+   resolved in this representation, either by using different
+   constructors or type witness parameters. *)
 and ('bef, 'aft) instr =
   (* stack ops *)
   | Drop :
@@ -195,6 +217,8 @@ and ('bef, 'aft) instr =
       ('a * ('v option * (('a, 'v) map * 'rest)), ('a, 'v) map * 'rest) instr
   | Map_size : (('a, 'b) map * 'rest, n num * 'rest) instr
   (* big maps *)
+  | Empty_big_map : 'a comparable_ty * 'v ty ->
+    ('rest, ('a, 'v) big_map * 'rest) instr
   | Big_map_mem :
       ('a * (('a, 'v) big_map * 'rest), bool * 'rest) instr
   | Big_map_get :
@@ -232,10 +256,7 @@ and ('bef, 'aft) instr =
   | Diff_timestamps :
       (Script_timestamp.t * (Script_timestamp.t * 'rest),
        z num * 'rest) instr
-  (* currency operations *)
+  (* tez operations *)
-  (* TODO: we can either just have conversions to/from integers and
-     do all operations on integers, or we need more operations on
-     Tez. Also Sub_tez should return Tez.t option (if negative) and *)
   | Add_tez :
       (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr
   | Sub_tez :
@@ -323,6 +344,8 @@ and ('bef, 'aft) instr =
     ('top * 'bef, 'top * 'aft) instr
   | Exec :
       ('arg * (('arg, 'ret) lambda * 'rest), 'ret * 'rest) instr
+  | Apply : 'arg ty ->
+      ('arg * (('arg * 'remaining, 'ret) lambda * 'rest), ('remaining, 'ret) lambda * 'rest) instr
   | Lambda : ('arg, 'ret) lambda ->
     ('rest, ('arg, 'ret) lambda * 'rest) instr
   | Failwith :
@@ -345,24 +368,25 @@ and ('bef, 'aft) instr =
       (z num * 'rest, bool * 'rest) instr
   | Ge :
       (z num * 'rest, bool * 'rest) instr
-
   (* protocol *)
   | Address :
-      (_ typed_contract * 'rest, Contract.t * 'rest) instr
+      (_ typed_contract * 'rest, address * 'rest) instr
-  | Contract : 'p ty ->
+  | Contract : 'p ty * string ->
-    (Contract.t * 'rest, 'p typed_contract option * 'rest) instr
+    (address * 'rest, 'p typed_contract option * 'rest) instr
   | Transfer_tokens :
-      ('arg * (Tez.t * ('arg typed_contract * 'rest)), packed_internal_operation * 'rest) instr
+      ('arg * (Tez.t * ('arg typed_contract * 'rest)), operation * 'rest) instr
   | Create_account :
       (public_key_hash * (public_key_hash option * (bool * (Tez.t * 'rest))),
-       packed_internal_operation * (Contract.t * 'rest)) instr
+       operation * (address * 'rest)) instr
   | Implicit_account :
       (public_key_hash * 'rest, unit typed_contract * 'rest) instr
-  | Create_contract : 'g ty * 'p ty * ('p * 'g, packed_internal_operation list * 'g) lambda  ->
+  | Create_contract : 'g ty * 'p ty * ('p * 'g, operation list * 'g) lambda * string option ->
     (public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))),
-     packed_internal_operation * (Contract.t * 'rest)) instr
+     operation * (address * 'rest)) instr
+  | Create_contract_2 : 'g ty * 'p ty * ('p * 'g, operation list * 'g) lambda * string option  ->
+    (public_key_hash option * (Tez.t * ('g * 'rest)), operation * (address * 'rest)) instr
   | Set_delegate :
-      (public_key_hash option * 'rest, packed_internal_operation * 'rest) instr
+      (public_key_hash option * 'rest, operation * 'rest) instr
   | Now :
       ('rest, Script_timestamp.t * 'rest) instr
   | Balance :
@@ -384,13 +408,35 @@ and ('bef, 'aft) instr =
   | Steps_to_quota : (* TODO: check that it always returns a nat *)
       ('rest, n num * 'rest) instr
   | Source :
-      ('rest, Contract.t * 'rest) instr
+      ('rest, address * 'rest) instr
   | Sender :
-      ('rest, Contract.t * 'rest) instr
+      ('rest, address * 'rest) instr
-  | Self : 'p ty ->
+  | Self : 'p ty * string ->
     ('rest, 'p typed_contract * 'rest) instr
   | Amount :
       ('rest, Tez.t * 'rest) instr
+  | Dig   : int * ('x * 'rest, 'rest, 'bef, 'aft) stack_prefix_preservation_witness ->
+    ('bef, 'x * 'aft) instr
+  | Dug   : int * ('rest, 'x * 'rest, 'bef, 'aft) stack_prefix_preservation_witness ->
+    ('x * 'bef, 'aft) instr
+  | Dipn  : int * ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness * ('fbef, 'faft) descr ->
+    ('bef, 'aft) instr
+  | Dropn : int * ('rest, 'rest, 'bef, _) stack_prefix_preservation_witness ->
+    ('bef, 'rest) instr
+  | ChainId :
+      ('rest, Chain_id.t * 'rest) instr
+
+(* Type witness for operations that work deep in the stack ignoring
+   (and preserving) a prefix.
+
+   The two right parameters are the shape of the stack with the (same)
+   prefix before and after the transformation. The two left
+   parameters are the shape of the stack without the prefix before and
+   after. The inductive definition makes it so by construction. *)
+and ('bef, 'aft, 'bef_suffix, 'aft_suffix) stack_prefix_preservation_witness =
+  | Prefix : ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness
+    -> ('fbef, 'faft, 'x * 'bef, 'x * 'aft) stack_prefix_preservation_witness
+  | Rest : ('bef, 'aft, 'bef, 'aft) stack_prefix_preservation_witness
 
 and ('bef, 'aft) descr =
   { loc : Script.location ;

vendors/ligo-utils/tezos-protocol-alpha/seed_repr.mli

@@ -33,7 +33,7 @@
     seed such that the generated sequence is a given one. *)
 
 
-(** {2 Random Generation} ****************************************************)
+(** {2 Random Generation} *)
 
 (** The state of the random number generator *)
 type t
@@ -56,7 +56,7 @@ val take : sequence -> MBytes.t * sequence
 (** Generates the next random value as a bounded [int32] *)
 val take_int32 : sequence -> int32 -> int32 * sequence
 
-(** {2 Predefined seeds} *****************************************************)
+(** {2 Predefined seeds} *)
 
 val empty : seed
 
@@ -68,7 +68,7 @@ val deterministic_seed : seed -> seed
     concatenated with a constant. *)
 val initial_seeds : int -> seed list
 
-(** {2 Entropy} **************************************************************)
+(** {2 Entropy} *)
 
 (** A nonce for adding entropy to the generator *)
 type nonce
@@ -88,12 +88,12 @@ val check_hash : nonce -> Nonce_hash.t -> bool
 (** For using nonce hashes as keys in the hierarchical database *)
 val nonce_hash_key_part : Nonce_hash.t -> string list -> string list
 
-(** {2 Predefined nonce} *****************************************************)
+(** {2 Predefined nonce} *)
 
 val initial_nonce_0 : nonce
 val initial_nonce_hash_0 : Nonce_hash.t
 
-(** {2 Serializers} **********************************************************)
+(** {2 Serializers} *)
 
 val nonce_encoding  : nonce Data_encoding.t
 val seed_encoding : seed Data_encoding.t

vendors/ligo-utils/tezos-protocol-alpha/services_registration.ml

@@ -35,7 +35,11 @@ let rpc_init ({ block_hash ; block_header ; context } : Updater.rpc_context) =
   let level = block_header.level in
   let timestamp = block_header.timestamp in
   let fitness = block_header.fitness in
-  Alpha_context.prepare ~level ~timestamp ~fitness context >>=? fun context ->
+  Alpha_context.prepare
+    ~level
+    ~predecessor_timestamp:timestamp
+    ~timestamp
+    ~fitness context >>=? fun context ->
   return { block_hash ; block_header ; context }
 
 let rpc_services = ref (RPC_directory.empty : Updater.rpc_context RPC_directory.t)

vendors/ligo-utils/tezos-protocol-alpha/storage.ml

@@ -36,7 +36,7 @@ module Int32 = struct
 end
 
 module Z = struct
-  type t = Z.t
+  include Z
   let encoding = Data_encoding.z
 end
 
@@ -66,8 +66,15 @@ module Make_index(H : Storage_description.INDEX)
     }
 end
 
+module Block_priority =
+  Make_single_data_storage(Registered)
+    (Raw_context)
+    (struct let name = ["block_priority"] end)
+    (Int)
+
+(* Only for migration from 004 *)
 module Last_block_priority =
-  Make_single_data_storage
+  Make_single_data_storage(Ghost)
     (Raw_context)
     (struct let name = ["last_block_priority"] end)
     (Int)
@@ -77,17 +84,17 @@ module Last_block_priority =
 module Contract = struct
 
   module Raw_context =
-    Make_subcontext(Raw_context)(struct let name = ["contracts"] end)
+    Make_subcontext(Registered)(Raw_context)(struct let name = ["contracts"] end)
 
   module Global_counter =
-    Make_single_data_storage
+    Make_single_data_storage(Registered)
       (Raw_context)
       (struct let name = ["global_counter"] end)
       (Z)
 
   module Indexed_context =
     Make_indexed_subcontext
-      (Make_subcontext(Raw_context)(struct let name = ["index"] end))
+      (Make_subcontext(Registered)(Raw_context)(struct let name = ["index"] end))
       (Make_index(Contract_repr.Index))
 
   let fold = Indexed_context.fold_keys
@@ -100,7 +107,7 @@ module Contract = struct
 
   module Frozen_balance_index =
     Make_indexed_subcontext
-      (Make_subcontext
+      (Make_subcontext(Registered)
          (Indexed_context.Raw_context)
          (struct let name = ["frozen_balance"] end))
       (Make_index(Cycle_repr.Index))
@@ -125,12 +132,12 @@ module Contract = struct
       (struct let name = ["manager"] end)
       (Manager_repr)
 
-  module Spendable =
+  module Spendable_004 =
-    Indexed_context.Make_set
+    Indexed_context.Make_set(Ghost)
       (struct let name = ["spendable"] end)
 
-  module Delegatable =
+  module Delegatable_004 =
-    Indexed_context.Make_set
+    Indexed_context.Make_set(Ghost)
       (struct let name = ["delegatable"] end)
 
   module Delegate =
@@ -139,7 +146,7 @@ module Contract = struct
       (Signature.Public_key_hash)
 
   module Inactive_delegate =
-    Indexed_context.Make_set
+    Indexed_context.Make_set(Registered)
       (struct let name = ["inactive_delegate"] end)
 
   module Delegate_desactivation =
@@ -149,9 +156,17 @@ module Contract = struct
 
   module Delegated =
     Make_data_set_storage
-      (Make_subcontext
+      (Make_subcontext(Registered)
          (Indexed_context.Raw_context)
          (struct let name = ["delegated"] end))
+      (Make_index(Contract_repr.Index))
+
+  (** Only for migration from proto_004  *)
+  module Delegated_004 =
+    Make_data_set_storage
+      (Make_subcontext(Ghost)
+         (Indexed_context.Raw_context)
+         (struct let name = ["delegated_004"] end))
       (Make_index(Contract_hash))
 
   module Counter =
@@ -219,6 +234,14 @@ module Contract = struct
     let init_set ctxt contract value =
       consume_serialize_gas ctxt value >>=? fun ctxt ->
       I.init_set ctxt contract value
+
+    (** Only for used for 005 migration to avoid gas cost. *)
+    let init_free ctxt contract value =
+      I.init_free ctxt contract value
+
+    (** Only for used for 005 migration to avoid gas cost. *)
+    let set_free ctxt contract value =
+      I.set_free ctxt contract value
   end
 
   module Code =
@@ -229,15 +252,146 @@ module Contract = struct
     Make_carbonated_map_expr
       (struct let name = ["storage"] end)
 
-  type bigmap_key = Raw_context.t * Contract_repr.t
+  module Paid_storage_space =
+    Indexed_context.Make_map
+      (struct let name = ["paid_bytes"] end)
+      (Z)
+
+  module Used_storage_space =
+    Indexed_context.Make_map
+      (struct let name = ["used_bytes"] end)
+      (Z)
+
+  module Roll_list =
+    Indexed_context.Make_map
+      (struct let name = ["roll_list"] end)
+      (Roll_repr)
+
+  module Change =
+    Indexed_context.Make_map
+      (struct let name = ["change"] end)
+      (Tez_repr)
+
+end
+
+(** Big maps handling *)
+
+module Big_map = struct
+  module Raw_context =
+    Make_subcontext(Registered)(Raw_context)(struct let name = ["big_maps"] end)
+
+  module Next = struct
+    include
+      Make_single_data_storage(Registered)
+        (Raw_context)
+        (struct let name = ["next"] end)
+        (Z)
+    let incr ctxt =
+      get ctxt >>=? fun i ->
+      set ctxt (Z.succ i) >>=? fun ctxt ->
+      return (ctxt, i)
+    let init ctxt = init ctxt Z.zero
+  end
+
+  module Index = struct
+    type t = Z.t
+
+    let rpc_arg =
+      let construct = Z.to_string in
+      let destruct hash =
+        match Z.of_string hash with
+        | exception _ -> Error "Cannot parse big map id"
+        | id -> Ok id in
+      RPC_arg.make
+        ~descr: "A big map identifier"
+        ~name: "big_map_id"
+        ~construct
+        ~destruct
+        ()
+
+    let encoding =
+      Data_encoding.def "big_map_id"
+        ~title:"Big map identifier"
+        ~description: "A big map identifier"
+        Z.encoding
+    let compare = Compare.Z.compare
+
+    let path_length = 7
+
+    let to_path c l =
+      let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in
+      let `Hex index_key = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
+      String.sub index_key 0 2 ::
+      String.sub index_key 2 2 ::
+      String.sub index_key 4 2 ::
+      String.sub index_key 6 2 ::
+      String.sub index_key 8 2 ::
+      String.sub index_key 10 2 ::
+      Z.to_string c ::
+      l
+
+    let of_path = function
+      | [] | [_] | [_;_] | [_;_;_] | [_;_;_;_] | [_;_;_;_;_] | [_;_;_;_;_;_]
+      | _::_::_::_::_::_::_::_::_ ->
+          None
+      | [ index1 ; index2 ; index3 ; index4 ; index5 ; index6 ; key ] ->
+          let c = Z.of_string key in
+          let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in
+          let `Hex index_key = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
+          assert Compare.String.(String.sub index_key 0 2 = index1) ;
+          assert Compare.String.(String.sub index_key 2 2 = index2) ;
+          assert Compare.String.(String.sub index_key 4 2 = index3) ;
+          assert Compare.String.(String.sub index_key 6 2 = index4) ;
+          assert Compare.String.(String.sub index_key 8 2 = index5) ;
+          assert Compare.String.(String.sub index_key 10 2 = index6) ;
+          Some c
+  end
+
+  module Indexed_context =
+    Make_indexed_subcontext
+      (Make_subcontext(Registered)(Raw_context)(struct let name = ["index"] end))
+      (Make_index(Index))
+
+  let rpc_arg = Index.rpc_arg
+
+  let fold = Indexed_context.fold_keys
+  let list = Indexed_context.keys
+
+  let remove_rec ctxt n =
+    Indexed_context.remove_rec ctxt n
+
+  let copy ctxt ~from ~to_ =
+    Indexed_context.copy ctxt ~from ~to_
+
+  type key = Raw_context.t * Z.t
+
+  module Total_bytes =
+    Indexed_context.Make_map
+      (struct let name = ["total_bytes"] end)
+      (Z)
+
+  module Key_type =
+    Indexed_context.Make_map
+      (struct let name = ["key_type"] end)
+        (struct
+          type t = Script_repr.expr
+          let encoding = Script_repr.expr_encoding
+        end)
+
+  module Value_type =
+    Indexed_context.Make_map
+      (struct let name = ["value_type"] end)
+        (struct
+          type t = Script_repr.expr
+          let encoding = Script_repr.expr_encoding
+        end)
+
+  module Contents = struct
 
-  (* Consume gas for serilization and deserialization of expr in this
-     module *)
-  module Big_map = struct
     module I = Storage_functors.Make_indexed_carbonated_data_storage
-        (Make_subcontext
+        (Make_subcontext(Registered)
            (Indexed_context.Raw_context)
-           (struct let name = ["big_map"] end))
+           (struct let name = ["contents"] end))
         (Make_index(Script_expr_hash))
         (struct
           type t = Script_repr.expr
@@ -274,41 +428,21 @@ module Contract = struct
           (ctxt, value_opt)
   end
 
-  module Paid_storage_space =
-    Indexed_context.Make_map
-      (struct let name = ["paid_bytes"] end)
-      (Z)
-
-  module Used_storage_space =
-    Indexed_context.Make_map
-      (struct let name = ["used_bytes"] end)
-      (Z)
-
-  module Roll_list =
-    Indexed_context.Make_map
-      (struct let name = ["roll_list"] end)
-      (Roll_repr)
-
-  module Change =
-    Indexed_context.Make_map
-      (struct let name = ["change"] end)
-      (Tez_repr)
-
 end
 
 module Delegates =
   Make_data_set_storage
-    (Make_subcontext(Raw_context)(struct let name = ["delegates"] end))
+    (Make_subcontext(Registered)(Raw_context)(struct let name = ["delegates"] end))
     (Make_index(Signature.Public_key_hash))
 
 module Active_delegates_with_rolls =
   Make_data_set_storage
-    (Make_subcontext(Raw_context)(struct let name = ["active_delegates_with_rolls"] end))
+    (Make_subcontext(Registered)(Raw_context)(struct let name = ["active_delegates_with_rolls"] end))
     (Make_index(Signature.Public_key_hash))
 
 module Delegates_with_frozen_balance_index =
   Make_indexed_subcontext
-    (Make_subcontext(Raw_context)
+    (Make_subcontext(Registered)(Raw_context)
        (struct let name = ["delegates_with_frozen_balance"] end))
     (Make_index(Cycle_repr.Index))
 
@@ -323,12 +457,12 @@ module Cycle = struct
 
   module Indexed_context =
     Make_indexed_subcontext
-      (Make_subcontext(Raw_context)(struct let name = ["cycle"] end))
+      (Make_subcontext(Registered)(Raw_context)(struct let name = ["cycle"] end))
       (Make_index(Cycle_repr.Index))
 
   module Last_roll =
     Make_indexed_data_storage
-      (Make_subcontext
+      (Make_subcontext(Registered)
          (Indexed_context.Raw_context)
          (struct let name = ["last_roll"] end))
       (Int_index)
@@ -377,7 +511,7 @@ module Cycle = struct
 
   module Nonce =
     Make_indexed_data_storage
-      (Make_subcontext
+      (Make_subcontext(Registered)
          (Indexed_context.Raw_context)
          (struct let name = ["nonces"] end))
       (Make_index(Raw_level_repr.Index))
@@ -399,21 +533,21 @@ end
 module Roll = struct
 
   module Raw_context =
-    Make_subcontext(Raw_context)(struct let name = ["rolls"] end)
+    Make_subcontext(Registered)(Raw_context)(struct let name = ["rolls"] end)
 
   module Indexed_context =
     Make_indexed_subcontext
-      (Make_subcontext(Raw_context)(struct let name = ["index"] end))
+      (Make_subcontext(Registered)(Raw_context)(struct let name = ["index"] end))
       (Make_index(Roll_repr.Index))
 
   module Next =
-    Make_single_data_storage
+    Make_single_data_storage(Registered)
       (Raw_context)
       (struct let name = ["next"] end)
       (Roll_repr)
 
   module Limbo =
-    Make_single_data_storage
+    Make_single_data_storage(Registered)
       (Raw_context)
       (struct let name = ["limbo"] end)
       (Roll_repr)
@@ -469,7 +603,7 @@ module Roll = struct
 
   module Owner =
     Make_indexed_data_snapshotable_storage
-      (Make_subcontext(Raw_context)(struct let name = ["owner"] end))
+      (Make_subcontext(Registered)(Raw_context)(struct let name = ["owner"] end))
       (Snapshoted_owner_index)
       (Make_index(Roll_repr.Index))
       (Signature.Public_key)
@@ -486,10 +620,10 @@ end
 module Vote = struct
 
   module Raw_context =
-    Make_subcontext(Raw_context)(struct let name = ["votes"] end)
+    Make_subcontext(Registered)(Raw_context)(struct let name = ["votes"] end)
 
   module Current_period_kind =
-    Make_single_data_storage
+    Make_single_data_storage(Registered)
       (Raw_context)
       (struct let name = ["current_period_kind"] end)
       (struct
@@ -497,45 +631,51 @@ module Vote = struct
         let encoding = Voting_period_repr.kind_encoding
       end)
 
-  module Current_quorum =
+  module Current_quorum_004 =
-    Make_single_data_storage
+    Make_single_data_storage(Ghost)
       (Raw_context)
       (struct let name = ["current_quorum"] end)
       (Int32)
 
+  module Participation_ema =
+    Make_single_data_storage(Registered)
+      (Raw_context)
+      (struct let name = ["participation_ema"] end)
+      (Int32)
+
   module Current_proposal =
-    Make_single_data_storage
+    Make_single_data_storage(Registered)
       (Raw_context)
       (struct let name = ["current_proposal"] end)
       (Protocol_hash)
 
   module Listings_size =
-    Make_single_data_storage
+    Make_single_data_storage(Registered)
       (Raw_context)
       (struct let name = ["listings_size"] end)
       (Int32)
 
   module Listings =
     Make_indexed_data_storage
-      (Make_subcontext(Raw_context)(struct let name = ["listings"] end))
+      (Make_subcontext(Registered)(Raw_context)(struct let name = ["listings"] end))
       (Make_index(Signature.Public_key_hash))
       (Int32)
 
   module Proposals =
     Make_data_set_storage
-      (Make_subcontext(Raw_context)(struct let name = ["proposals"] end))
+      (Make_subcontext(Registered)(Raw_context)(struct let name = ["proposals"] end))
       (Pair(Make_index(Protocol_hash))(Make_index(Signature.Public_key_hash)))
 
   module Proposals_count =
     Make_indexed_data_storage
-      (Make_subcontext(Raw_context)
+      (Make_subcontext(Registered)(Raw_context)
          (struct let name = ["proposals_count"] end))
       (Make_index(Signature.Public_key_hash))
       (Int)
 
   module Ballots =
     Make_indexed_data_storage
-      (Make_subcontext(Raw_context)(struct let name = ["ballots"] end))
+      (Make_subcontext(Registered)(Raw_context)(struct let name = ["ballots"] end))
       (Make_index(Signature.Public_key_hash))
       (struct
         type t = Vote_repr.ballot
@@ -580,7 +720,7 @@ end
 
 module Commitments =
   Make_indexed_data_storage
-    (Make_subcontext(Raw_context)(struct let name = ["commitments"] end))
+    (Make_subcontext(Registered)(Raw_context)(struct let name = ["commitments"] end))
     (Make_index(Blinded_public_key_hash.Index))
     (Tez_repr)
 
@@ -590,7 +730,7 @@ module Ramp_up = struct
 
   module Rewards =
     Make_indexed_data_storage
-      (Make_subcontext(Raw_context)(struct let name = ["ramp_up"; "rewards"] end))
+      (Make_subcontext(Registered)(Raw_context)(struct let name = ["ramp_up"; "rewards"] end))
       (Make_index(Cycle_repr.Index))
       (struct
         type t = Tez_repr.t * Tez_repr.t
@@ -599,7 +739,7 @@ module Ramp_up = struct
 
   module Security_deposits =
     Make_indexed_data_storage
-      (Make_subcontext(Raw_context)(struct let name = ["ramp_up"; "deposits"] end))
+      (Make_subcontext(Registered)(Raw_context)(struct let name = ["ramp_up"; "deposits"] end))
       (Make_index(Cycle_repr.Index))
       (struct
         type t = Tez_repr.t * Tez_repr.t

vendors/ligo-utils/tezos-protocol-alpha/storage.mli

@@ -36,12 +36,17 @@
 
 open Storage_sigs
 
-module Last_block_priority : sig
+module Block_priority : sig
   val get : Raw_context.t -> int tzresult Lwt.t
   val set : Raw_context.t -> int -> Raw_context.t tzresult Lwt.t
   val init : Raw_context.t -> int -> Raw_context.t tzresult Lwt.t
 end
 
+(* Only for migration from 004 *)
+module Last_block_priority : sig
+  val delete : Raw_context.t -> Raw_context.t tzresult Lwt.t
+end
+
 module Roll : sig
 
   (** Storage from this submodule must only be accessed through the
@@ -152,7 +157,13 @@ module Contract : sig
      and type value = Signature.Public_key_hash.t
      and type t := Raw_context.t
 
+  (** All contracts (implicit and originated) that are delegated, if any  *)
   module Delegated : Data_set_storage
+    with type elt = Contract_repr.t
+     and type t = Raw_context.t * Contract_repr.t
+
+  (** Only for migration from proto_004  *)
+  module Delegated_004 : Data_set_storage
     with type elt = Contract_hash.t
      and type t = Raw_context.t * Contract_repr.t
 
@@ -166,11 +177,11 @@ module Contract : sig
      and type value = Cycle_repr.t
      and type t := Raw_context.t
 
-  module Spendable : Data_set_storage
+  module Spendable_004 : Data_set_storage
     with type elt = Contract_repr.t
      and type t := Raw_context.t
 
-  module Delegatable : Data_set_storage
+  module Delegatable_004 : Data_set_storage
     with type elt = Contract_repr.t
      and type t := Raw_context.t
 
@@ -179,15 +190,39 @@ module Contract : sig
      and type value = Z.t
      and type t := Raw_context.t
 
-  module Code : Non_iterable_indexed_carbonated_data_storage
+  module Code : sig
-    with type key = Contract_repr.t
+    include Non_iterable_indexed_carbonated_data_storage
-     and type value = Script_repr.lazy_expr
+      with type key = Contract_repr.t
-     and type t := Raw_context.t
+       and type value = Script_repr.lazy_expr
+       and type t := Raw_context.t
 
-  module Storage : Non_iterable_indexed_carbonated_data_storage
+    (** Only used for 005 migration to avoid gas cost.
-    with type key = Contract_repr.t
+        Allocates a storage bucket at the given key and initializes it ;
-     and type value = Script_repr.lazy_expr
+        returns a {!Storage_error Existing_key} if the bucket exists. *)
-     and type t := Raw_context.t
+    val init_free: Raw_context.t -> Contract_repr.t -> Script_repr.lazy_expr -> (Raw_context.t * int) tzresult Lwt.t
+
+    (** Only used for 005 migration to avoid gas cost.
+        Updates the content of a bucket ; returns A {!Storage_Error
+        Missing_key} if the value does not exists. *)
+    val set_free: Raw_context.t -> Contract_repr.t -> Script_repr.lazy_expr -> (Raw_context.t * int) tzresult Lwt.t
+  end
+
+  module Storage : sig
+    include Non_iterable_indexed_carbonated_data_storage
+      with type key = Contract_repr.t
+       and type value = Script_repr.lazy_expr
+       and type t := Raw_context.t
+
+    (** Only used for 005 migration to avoid gas cost.
+        Allocates a storage bucket at the given key and initializes it ;
+        returns a {!Storage_error Existing_key} if the bucket exists. *)
+    val init_free: Raw_context.t -> Contract_repr.t -> Script_repr.lazy_expr -> (Raw_context.t * int) tzresult Lwt.t
+
+    (** Only used for 005 migration to avoid gas cost.
+        Updates the content of a bucket ; returns A {!Storage_Error
+        Missing_key} if the value does not exists. *)
+    val set_free: Raw_context.t -> Contract_repr.t -> Script_repr.lazy_expr -> (Raw_context.t * int) tzresult Lwt.t
+  end
 
   (** Current storage space in bytes.
       Includes code, global storage and big map elements. *)
@@ -202,12 +237,50 @@ module Contract : sig
      and type value = Z.t
      and type t := Raw_context.t
 
-  type bigmap_key = Raw_context.t * Contract_repr.t
+end
 
-  module Big_map : Non_iterable_indexed_carbonated_data_storage
+module Big_map : sig
+
+  module Next : sig
+    val incr : Raw_context.t -> (Raw_context.t * Z.t) tzresult Lwt.t
+    val init : Raw_context.t -> Raw_context.t tzresult Lwt.t
+  end
+
+  (** The domain of alive big maps *)
+  val fold :
+    Raw_context.t ->
+    init:'a -> f:(Z.t -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+  val list : Raw_context.t -> Z.t list Lwt.t
+
+  val remove_rec : Raw_context.t -> Z.t -> Raw_context.t Lwt.t
+
+  val copy : Raw_context.t -> from:Z.t -> to_:Z.t ->  Raw_context.t tzresult Lwt.t
+
+  type key = Raw_context.t * Z.t
+
+  val rpc_arg : Z.t RPC_arg.t
+
+  module Index : Storage_description.INDEX with type t = Z.t
+
+  module Contents : Non_iterable_indexed_carbonated_data_storage
     with type key = Script_expr_hash.t
      and type value = Script_repr.expr
-     and type t := bigmap_key
+     and type t := key
+
+  module Total_bytes : Indexed_data_storage
+    with type key = Z.t
+     and type value = Z.t
+     and type t := Raw_context.t
+
+  module Key_type : Indexed_data_storage
+    with type key = Z.t
+     and type value = Script_repr.expr
+     and type t := Raw_context.t
+
+  module Value_type : Indexed_data_storage
+    with type key = Z.t
+     and type value = Script_repr.expr
+     and type t := Raw_context.t
 
 end
 
@@ -234,8 +307,14 @@ module Vote : sig
     with type value = Voting_period_repr.kind
      and type t := Raw_context.t
 
-  (** Expected quorum, in centile of percentage *)
+  (** Only for migration from 004.
-  module Current_quorum : Single_data_storage
+      Expected quorum, in centile of percentage *)
+  module Current_quorum_004 : Single_data_storage
+    with type value = int32
+     and type t := Raw_context.t
+
+  (** Participation exponential moving average, in centile of percentage *)
+  module Participation_ema : Single_data_storage
     with type value = int32
      and type t := Raw_context.t
 

vendors/ligo-utils/tezos-protocol-alpha/storage_description.ml

@@ -285,7 +285,7 @@ let build_directory : type key. key t -> key RPC_directory.t =
               else if Compare.Int.(i = 0) then return_some []
               else
                 list k >>=? fun keys ->
-                map_p
+                map_s
                   (fun key ->
                      if Compare.Int.(i = 1) then
                        return (key, None)

vendors/ligo-utils/tezos-protocol-alpha/storage_functors.ml

@@ -25,10 +25,13 @@
 
 open Storage_sigs
 
+module Registered = struct let ghost = false end
+module Ghost = struct let ghost = true end
+
 module Make_encoder (V : VALUE) = struct
   let of_bytes ~key b =
     match Data_encoding.Binary.of_bytes V.encoding b with
-    | None -> Error [Raw_context.Storage_error (Corrupted_data key)]
+    | None -> error (Raw_context.Storage_error (Corrupted_data key))
     | Some v -> Ok v
   let to_bytes v =
     match Data_encoding.Binary.to_bytes V.encoding v with
@@ -54,7 +57,7 @@ let map_key f = function
   | `Key k -> `Key (f k)
   | `Dir k -> `Dir (f k)
 
-module Make_subcontext (C : Raw_context.T) (N : NAME)
+module Make_subcontext (R : REGISTER) (C : Raw_context.T) (N : NAME)
   : Raw_context.T with type t = C.t = struct
   type t = C.t
   type context = t
@@ -84,10 +87,12 @@ module Make_subcontext (C : Raw_context.T) (N : NAME)
   let consume_gas = C.consume_gas
   let check_enough_gas = C.check_enough_gas
   let description =
-    Storage_description.register_named_subcontext C.description N.name
+    let description = if R.ghost then Storage_description.create ()
+      else C.description in
+    Storage_description.register_named_subcontext description N.name
 end
 
-module Make_single_data_storage (C : Raw_context.T) (N : NAME) (V : VALUE)
+module Make_single_data_storage (R : REGISTER) (C : Raw_context.T) (N : NAME) (V : VALUE)
   : Single_data_storage with type t = C.t
                          and type value = V.t = struct
   type t = C.t
@@ -129,9 +134,11 @@ module Make_single_data_storage (C : Raw_context.T) (N : NAME) (V : VALUE)
 
   let () =
     let open Storage_description in
+    let description = if R.ghost then Storage_description.create ()
+      else C.description in
     register_value
       ~get:get_option
-      (register_named_subcontext C.description N.name)
+      (register_named_subcontext description N.name)
       V.encoding
 
 end
@@ -329,76 +336,76 @@ module Make_indexed_carbonated_data_storage
   type key = I.t
   type value = V.t
   include Make_encoder(V)
-  let name i =
+  let data_key i =
     I.to_path i [data_name]
-  let len_name i =
+  let len_key i =
     I.to_path i [len_name]
   let consume_mem_gas c =
     Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))
   let existing_size c i =
-    C.get_option c (len_name i) >>= function
+    C.get_option c (len_key i) >>= function
-    | None -> return 0
+    | None -> return (0, false)
-    | Some len -> decode_len_value (len_name i) len
+    | Some len -> decode_len_value (len_key i) len >>=? fun len -> return (len, true)
   let consume_read_gas get c i =
-    get c (len_name i) >>=? fun len ->
+    get c (len_key i) >>=? fun len ->
-    decode_len_value (len_name i) len >>=? fun len ->
+    decode_len_value (len_key i) len >>=? fun len ->
     Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost (Z.of_int len)))
   let consume_serialize_write_gas set c i v =
     let bytes = to_bytes v in
     let len = MBytes.length bytes in
     Lwt.return (C.consume_gas c (Gas_limit_repr.alloc_mbytes_cost len)) >>=? fun c ->
     Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int len))) >>=? fun c ->
-    set c (len_name i) (encode_len_value bytes) >>=? fun c ->
+    set c (len_key i) (encode_len_value bytes) >>=? fun c ->
     return (c, bytes)
   let consume_remove_gas del c i =
     Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost Z.zero)) >>=? fun c ->
-    del c (len_name i)
+    del c (len_key i)
   let mem s i =
     consume_mem_gas s >>=? fun s ->
-    C.mem s (name i) >>= fun exists ->
+    C.mem s (data_key i) >>= fun exists ->
     return (C.project s, exists)
   let get s i =
     consume_read_gas C.get s i >>=? fun s ->
-    C.get s (name i) >>=? fun b ->
+    C.get s (data_key i) >>=? fun b ->
-    let key = C.absolute_key s (name i) in
+    let key = C.absolute_key s (data_key i) in
     Lwt.return (of_bytes ~key b) >>=? fun v ->
     return (C.project s, v)
   let get_option s i =
     consume_mem_gas s >>=? fun s ->
-    C.mem s (name i) >>= fun exists ->
+    C.mem s (data_key i) >>= fun exists ->
     if exists then
       get s i >>=? fun (s, v) ->
       return (s, Some v)
     else
       return (C.project s, None)
   let set s i v =
-    existing_size s i >>=? fun prev_size ->
+    existing_size s i >>=? fun (prev_size, _) ->
     consume_serialize_write_gas C.set s i v >>=? fun (s, bytes) ->
-    C.set s (name i) bytes >>=? fun t ->
+    C.set s (data_key i) bytes >>=? fun t ->
     let size_diff = MBytes.length bytes - prev_size in
     return (C.project t, size_diff)
   let init s i v =
     consume_serialize_write_gas C.init s i v >>=? fun (s, bytes) ->
-    C.init s (name i) bytes >>=? fun t ->
+    C.init s (data_key i) bytes >>=? fun t ->
     let size = MBytes.length bytes in
     return (C.project t, size)
   let init_set s i v =
     let init_set s i v = C.init_set s i v >>= return in
-    existing_size s i >>=? fun prev_size ->
+    existing_size s i >>=? fun (prev_size, existed) ->
     consume_serialize_write_gas init_set s i v >>=? fun (s, bytes) ->
-    init_set s (name i) bytes >>=? fun t ->
+    init_set s (data_key i) bytes >>=? fun t ->
     let size_diff = MBytes.length bytes - prev_size in
-    return (C.project t, size_diff)
+    return (C.project t, size_diff, existed)
   let remove s i =
     let remove s i = C.remove s i >>= return in
-    existing_size s i >>=? fun prev_size ->
+    existing_size s i >>=? fun (prev_size, existed) ->
     consume_remove_gas remove s i >>=? fun s ->
-    remove s (name i) >>=? fun t ->
+    remove s (data_key i) >>=? fun t ->
-    return (C.project t, prev_size)
+    return (C.project t, prev_size, existed)
   let delete s i =
-    existing_size s i >>=? fun prev_size ->
+    existing_size s i >>=? fun (prev_size, _) ->
     consume_remove_gas C.delete s i >>=? fun s ->
-    C.delete s (name i) >>=? fun t ->
+    C.delete s (data_key i) >>=? fun t ->
     return (C.project t, prev_size)
   let set_option s i v =
     match v with
@@ -407,14 +414,21 @@ module Make_indexed_carbonated_data_storage
 
   let fold_keys_unaccounted s ~init ~f =
     let rec dig i path acc =
-      if Compare.Int.(i <= 1) then
+      if Compare.Int.(i <= 0) then
         C.fold s path ~init:acc ~f:begin fun k acc ->
           match k with
           | `Dir _ -> Lwt.return acc
           | `Key file ->
-              match I.of_path file with
+              match List.rev file with
-              | None -> assert false
+              | last :: _ when Compare.String.(last = len_name) ->
-              | Some path -> f path acc
+                  Lwt.return acc
+              | last :: rest when Compare.String.(last = data_name) ->
+                  let file = List.rev rest in
+                  begin match I.of_path file with
+                    | None -> assert false
+                    | Some path -> f path acc
+                  end
+              | _ -> assert false
         end
       else
         C.fold s path ~init:acc ~f:begin fun k acc ->
@@ -422,7 +436,7 @@ module Make_indexed_carbonated_data_storage
           | `Dir k -> dig (i-1) k acc
           | `Key _ -> Lwt.return acc
         end in
-    dig I.path_length [data_name] init
+    dig I.path_length [] init
 
   let keys_unaccounted s =
     fold_keys_unaccounted s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
@@ -455,8 +469,8 @@ module Make_indexed_data_snapshotable_storage (C : Raw_context.T)
   let data_name = ["current"]
   let snapshot_name = ["snapshot"]
 
-  module C_data = Make_subcontext(C)(struct let name = data_name end)
+  module C_data = Make_subcontext(Registered)(C)(struct let name = data_name end)
-  module C_snapshot = Make_subcontext(C)(struct let name = snapshot_name end)
+  module C_snapshot = Make_subcontext(Registered)(C)(struct let name = snapshot_name end)
 
   include Make_indexed_data_storage(C_data)(I) (V)
   module Snapshot = Make_indexed_data_storage(C_snapshot)(Pair(Snapshot_index)(I))(V)
@@ -510,6 +524,12 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
 
   let list t k = C.fold t k ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc))
 
+  let remove_rec t k =
+    C.remove_rec t (I.to_path k [])
+
+  let copy t ~from ~to_ =
+    C.copy t ~from:(I.to_path from []) ~to_:(I.to_path to_ [])
+
   let description =
     Storage_description.register_indexed_subcontext
       ~list:(fun c -> keys c >>= return)
@@ -587,13 +607,13 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
         end
       | [] ->
           list t prefix >>= fun prefixes ->
-          Lwt_list.map_p (function
+          Lwt_list.map_s (function
               | `Key prefix | `Dir prefix -> loop (i+1) prefix []) prefixes
           >|= List.flatten
       | [d] when Compare.Int.(i = I.path_length - 1) ->
           if Compare.Int.(i >= I.path_length) then invalid_arg "IO.resolve" ;
           list t prefix >>= fun prefixes ->
-          Lwt_list.map_p (function
+          Lwt_list.map_s (function
               | `Key prefix | `Dir prefix ->
                   match Misc.remove_prefix ~prefix:d (List.hd (List.rev prefix)) with
                   | None -> Lwt.return_nil
@@ -602,7 +622,7 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
           >|= List.flatten
       | "" :: ds ->
           list t prefix >>= fun prefixes ->
-          Lwt_list.map_p (function
+          Lwt_list.map_s (function
               | `Key prefix | `Dir prefix -> loop (i+1) prefix ds) prefixes
           >|= List.flatten
       | d :: ds ->
@@ -612,7 +632,7 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
           | false -> Lwt.return_nil in
     loop 0 [] prefix
 
-  module Make_set (N : NAME) = struct
+  module Make_set (R : REGISTER) (N : NAME) = struct
     type t = C.t
     type context = t
     type elt = I.t
@@ -650,13 +670,15 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
     let () =
       let open Storage_description in
       let unpack = unpack I.args in
+      let description = if R.ghost then Storage_description.create ()
+        else Raw_context.description in
       register_value
         ~get:(fun c ->
             let (c, k) = unpack c in
             mem c k >>= function
             | true -> return_some true
             | false -> return_none)
-        (register_named_subcontext Raw_context.description N.name)
+        (register_named_subcontext description N.name)
         Data_encoding.bool
 
   end
@@ -755,8 +777,8 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
       Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))
     let existing_size c =
       Raw_context.get_option c len_name >>= function
-      | None -> return 0
+      | None -> return (0, false)
-      | Some len -> decode_len_value len_name len
+      | Some len -> decode_len_value len_name len >>=? fun len -> return (len, true)
     let consume_read_gas get c =
       get c (len_name) >>=? fun len ->
       decode_len_value len_name len >>=? fun len ->
@@ -790,31 +812,46 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
       else
         return (C.project s, None)
     let set s i v =
-      existing_size (pack s i) >>=? fun prev_size ->
+      existing_size (pack s i) >>=? fun (prev_size, _) ->
       consume_write_gas Raw_context.set (pack s i) v >>=? fun (c, bytes) ->
       Raw_context.set c data_name bytes >>=? fun c ->
       let size_diff = MBytes.length bytes - prev_size in
       return (Raw_context.project c, size_diff)
+    let set_free s i v =
+      let c = pack s i in
+      let bytes = to_bytes v in
+      existing_size c >>=? fun (prev_size, _) ->
+      Raw_context.set c len_name (encode_len_value bytes) >>=? fun c ->
+      Raw_context.set c data_name bytes >>=? fun c ->
+      let size_diff = MBytes.length bytes - prev_size in
+      return (Raw_context.project c, size_diff)
     let init s i v =
       consume_write_gas Raw_context.init (pack s i) v >>=? fun (c, bytes) ->
       Raw_context.init c data_name bytes >>=? fun c ->
       let size = MBytes.length bytes in
       return (Raw_context.project c, size)
+    let init_free s i v =
+      let c = pack s i in
+      let bytes = to_bytes v in
+      let size = MBytes.length bytes in
+      Raw_context.init c len_name (encode_len_value bytes) >>=? fun c ->
+      Raw_context.init c data_name bytes >>=? fun c ->
+      return (Raw_context.project c, size)
     let init_set s i v =
       let init_set c k v = Raw_context.init_set c k v >>= return in
-      existing_size (pack s i) >>=? fun prev_size ->
+      existing_size (pack s i) >>=? fun (prev_size, existed) ->
       consume_write_gas init_set (pack s i) v >>=? fun (c, bytes) ->
       init_set c data_name bytes >>=? fun c ->
       let size_diff = MBytes.length bytes - prev_size in
-      return (Raw_context.project c, size_diff)
+      return (Raw_context.project c, size_diff, existed)
     let remove s i =
       let remove c k = Raw_context.remove c k >>= return in
-      existing_size (pack s i) >>=? fun prev_size ->
+      existing_size (pack s i) >>=? fun (prev_size, existed) ->
       consume_remove_gas remove (pack s i) >>=? fun c ->
       remove c data_name >>=? fun c ->
-      return (Raw_context.project c, prev_size)
+      return (Raw_context.project c, prev_size, existed)
     let delete s i =
-      existing_size (pack s i) >>=? fun prev_size ->
+      existing_size (pack s i) >>=? fun (prev_size, _) ->
       consume_remove_gas Raw_context.delete (pack s i) >>=? fun c ->
       Raw_context.delete c data_name >>=? fun c ->
       return (Raw_context.project c, prev_size)

vendors/ligo-utils/tezos-protocol-alpha/storage_functors.mli

@@ -27,11 +27,14 @@
 
 open Storage_sigs
 
-module Make_subcontext (C : Raw_context.T) (N : NAME)
+module Registered : REGISTER
+module Ghost : REGISTER
+
+module Make_subcontext (R : REGISTER) (C : Raw_context.T) (N : NAME)
   : Raw_context.T with type t = C.t
 
 module Make_single_data_storage
-    (C : Raw_context.T) (N : NAME) (V : VALUE)
+    (R : REGISTER) (C : Raw_context.T) (N : NAME) (V : VALUE)
   : Single_data_storage with type t = C.t
                          and type value = V.t
 

vendors/ligo-utils/tezos-protocol-alpha/storage_sigs.ml

@@ -23,7 +23,7 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-(** {1 Entity Accessor Signatures} ****************************************)
+(** {1 Entity Accessor Signatures} *)
 
 (** The generic signature of a single data accessor (a single value
     bound to a specific key in the hierarchical (key x value)
@@ -118,16 +118,18 @@ module type Single_carbonated_data_storage = sig
   (** Allocates the data and initializes it with a value ; just
       updates it if the bucket exists.
       Consumes [Gas_repr.write_bytes_cost <size of the new value>].
-      Returns the difference from the old (maybe 0) to the new size. *)
+      Returns the difference from the old (maybe 0) to the new size, and a boolean
-  val init_set: context -> value -> (Raw_context.t * int) tzresult Lwt.t
+      indicating if a value was already associated to this key. *)
+  val init_set: context -> value -> (Raw_context.t * int * bool) tzresult Lwt.t
 
   (** When the value is [Some v], allocates the data and initializes
       it with [v] ; just updates it if the bucket exists. When the
       valus is [None], delete the storage bucket when the value ; does
       nothing if the bucket does not exists.
       Consumes the same gas cost as either {!remove} or {!init_set}.
-      Returns the difference from the old (maybe 0) to the new size. *)
+      Returns the difference from the old (maybe 0) to the new size, and a boolean
-  val set_option: context -> value option -> (Raw_context.t * int) tzresult Lwt.t
+      indicating if a value was already associated to this key. *)
+  val set_option: context -> value option -> (Raw_context.t * int * bool) tzresult Lwt.t
 
   (** Delete the storage bucket ; returns a {!Storage_error
       Missing_key} if the bucket does not exists.
@@ -138,8 +140,9 @@ module type Single_carbonated_data_storage = sig
   (** Removes the storage bucket and its contents ; does nothing if
       the bucket does not exists.
       Consumes [Gas_repr.write_bytes_cost Z.zero].
-      Returns the freed size. *)
+      Returns the freed size, and a boolean
-  val remove: context -> (Raw_context.t * int) tzresult Lwt.t
+      indicating if a value was already associated to this key. *)
+  val remove: context -> (Raw_context.t * int * bool) tzresult Lwt.t
 
 end
 
@@ -245,8 +248,9 @@ module type Non_iterable_indexed_carbonated_data_storage = sig
       with a value ; just updates it if the bucket exists.
       Consumes serialization cost.
       Consumes [Gas_repr.write_bytes_cost <size of the new value>].
-      Returns the difference from the old (maybe 0) to the new size. *)
+      Returns the difference from the old (maybe 0) to the new size, and a boolean
-  val init_set: context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t
+      indicating if a value was already associated to this key. *)
+  val init_set: context -> key -> value -> (Raw_context.t * int * bool) tzresult Lwt.t
 
   (** When the value is [Some v], allocates the data and initializes
       it with [v] ; just updates it if the bucket exists. When the
@@ -254,8 +258,9 @@ module type Non_iterable_indexed_carbonated_data_storage = sig
       nothing if the bucket does not exists.
       Consumes serialization cost.
       Consumes the same gas cost as either {!remove} or {!init_set}.
-      Returns the difference from the old (maybe 0) to the new size. *)
+      Returns the difference from the old (maybe 0) to the new size, and a boolean
-  val set_option: context -> key -> value option -> (Raw_context.t * int) tzresult Lwt.t
+      indicating if a value was already associated to this key. *)
+  val set_option: context -> key -> value option -> (Raw_context.t * int * bool) tzresult Lwt.t
 
   (** Delete a storage bucket and its contents ; returns a
       {!Storage_error Missing_key} if the bucket does not exists.
@@ -266,8 +271,9 @@ module type Non_iterable_indexed_carbonated_data_storage = sig
   (** Removes a storage bucket and its contents ; does nothing if the
       bucket does not exists.
       Consumes [Gas_repr.write_bytes_cost Z.zero].
-      Returns the freed size. *)
+      Returns the freed size, and a boolean
-  val remove: context -> key -> (Raw_context.t * int) tzresult Lwt.t
+      indicating if a value was already associated to this key. *)
+  val remove: context -> key -> (Raw_context.t * int * bool) tzresult Lwt.t
 
 end
 
@@ -358,6 +364,22 @@ module type VALUE = sig
   val encoding: t Data_encoding.t
 end
 
+module type REGISTER = sig val ghost : bool end
+
+module type Non_iterable_indexed_carbonated_data_storage_with_free = sig
+  include Non_iterable_indexed_carbonated_data_storage
+
+  (** Only used for 005 migration to avoid gas cost.
+      Allocates a storage bucket at the given key and initializes it ;
+      returns a {!Storage_error Existing_key} if the bucket exists. *)
+  val init_free: context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** Only used for 005 migration to avoid gas cost.
+      Updates the content of a bucket ; returns A {!Storage_Error
+      Missing_key} if the value does not exists. *)
+  val set_free: context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t
+end
+
 module type Indexed_raw_context = sig
 
   type t
@@ -373,7 +395,12 @@ module type Indexed_raw_context = sig
 
   val resolve: context -> string list -> key list Lwt.t
 
-  module Make_set (N : NAME)
+  val remove_rec: context -> key -> context Lwt.t
+
+  val copy: context -> from:key -> to_:key -> context tzresult Lwt.t
+
+  module Make_set (R : REGISTER) (N : NAME)
+
     : Data_set_storage with type t = t
                         and type elt = key
 
@@ -383,7 +410,7 @@ module type Indexed_raw_context = sig
                             and type value = V.t
 
   module Make_carbonated_map (N : NAME) (V : VALUE)
-    : Non_iterable_indexed_carbonated_data_storage with type t = t
+    : Non_iterable_indexed_carbonated_data_storage_with_free with type t = t
                                                     and type key = key
                                                     and type value = V.t
 

vendors/ligo-utils/tezos-protocol-alpha/test/activation.ml

@@ -0,0 +1,371 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** The activation operation creates an implicit contract from a
+    registered commitment present in the context. It is parametrized by
+    a public key hash (pkh) and a secret.
+
+    The commitments are composed of :
+    - a blinded pkh that can be revealed by the secret ;
+    - an amount.
+
+    The commitments and the secrets are generated from
+    /scripts/create_genesis/create_genenis.py and should be coherent.
+*)
+
+open Protocol
+open Alpha_context
+open Test_utils
+open Test_tez
+
+(* Generated commitments and secrets  *)
+
+(* Commitments are hard-coded in {Tezos_proto_alpha_parameters.Default_parameters} *)
+
+(* let commitments =
+ *   List.map (fun (bpkh, a) ->
+ *       Commitment_repr.{
+ *         blinded_public_key_hash=Blinded_public_key_hash.of_b58check_exn bpkh ;
+ *         amount = Tez_repr.of_mutez_exn (Int64.of_string a)}
+ *     )
+ *     [ ( "btz1bRL4X5BWo2Fj4EsBdUwexXqgTf75uf1qa", "23932454669343" ) ;
+ *       ( "btz1SxjV1syBgftgKy721czKi3arVkVwYUFSv", "72954577464032" ) ;
+ *       ( "btz1LtoNCjiW23txBTenALaf5H6NKF1L3c1gw", "217487035428349" ) ;
+ *       ( "btz1SUd3mMhEBcWudrn8u361MVAec4WYCcFoy", "4092742372031" ) ;
+ *       ( "btz1MvBXf4orko1tsGmzkjLbpYSgnwUjEe81r", "17590039016550" ) ;
+ *       ( "btz1LoDZ3zsjgG3k3cqTpUMc9bsXbchu9qMXT", "26322312350555" ) ;
+ *       ( "btz1RMfq456hFV5AeDiZcQuZhoMv2dMpb9hpP", "244951387881443" ) ;
+ *       ( "btz1Y9roTh4A7PsMBkp8AgdVFrqUDNaBE59y1", "80065050465525" ) ;
+ *       ( "btz1Q1N2ePwhVw5ED3aaRVek6EBzYs1GDkSVD", "3569618927693" ) ;
+ *       ( "btz1VFFVsVMYHd5WfaDTAt92BeQYGK8Ri4eLy", "9034781424478" ) ;
+ *     ] *)
+
+type secret_account = {
+  account : public_key_hash ;
+  activation_code : Blinded_public_key_hash.activation_code ;
+  amount : Tez.t ;
+}
+
+let secrets () =
+  (* Exported from proto_alpha client - TODO : remove when relocated to lib_crypto *)
+  let read_key mnemonic email password =
+    match Bip39.of_words mnemonic with
+    | None -> assert false
+    | Some t ->
+        (* TODO: unicode normalization (NFKD)... *)
+        let passphrase = MBytes.(concat "" [
+            of_string email ;
+            of_string password ;
+          ]) in
+        let sk = Bip39.to_seed ~passphrase t in
+        let sk = MBytes.sub sk 0 32 in
+        let sk : Signature.Secret_key.t =
+          Ed25519 (Data_encoding.Binary.of_bytes_exn Ed25519.Secret_key.encoding sk) in
+        let pk = Signature.Secret_key.to_public_key sk in
+        let pkh = Signature.Public_key.hash pk in
+        (pkh, pk, sk)
+  in
+  List.map (fun (mnemonic, secret, amount, pkh, password, email) ->
+      let (pkh', pk, sk) = read_key mnemonic email password in
+      let pkh = Signature.Public_key_hash.of_b58check_exn pkh in
+      assert (Signature.Public_key_hash.equal pkh pkh');
+      let account = Account.{ pkh ; pk ; sk } in
+      Account.add_account account ;
+      { account = account.pkh ;
+        activation_code = Blinded_public_key_hash.activation_code_of_hex secret ;
+        amount = Option.unopt_exn (Invalid_argument "tez conversion")
+            (Tez.of_mutez (Int64.of_string amount))
+      })
+    [
+      (["envelope"; "hospital"; "mind"; "sunset"; "cancel"; "muscle"; "leisure";
+        "thumb"; "wine"; "market"; "exit"; "lucky"; "style"; "picnic"; "success"],
+       "0f39ed0b656509c2ecec4771712d9cddefe2afac",
+       "23932454669343",
+       "tz1MawerETND6bqJqx8GV3YHUrvMBCDasRBF",
+       "z0eZHQQGKt",
+       "cjgfoqmk.wpxnvnup@tezos.example.org"
+      );
+      (["flag"; "quote"; "will"; "valley"; "mouse"; "chat"; "hold"; "prosper";
+        "silk"; "tent"; "cruel"; "cause"; "demise"; "bottom"; "practice"],
+       "41f98b15efc63fa893d61d7d6eee4a2ce9427ac4",
+       "72954577464032",
+       "tz1X4maqF9tC1Yn4jULjHRAyzjAtc25Z68TX",
+       "MHErskWPE6",
+       "oklmcktr.ztljnpzc@tezos.example.org"
+      );
+      (["library"; "away"; "inside"; "paper"; "wise"; "focus"; "sweet"; "expose";
+        "require"; "change"; "stove"; "planet"; "zone"; "reflect"; "finger"],
+       "411dfef031eeecc506de71c9df9f8e44297cf5ba",
+       "217487035428348",
+       "tz1SWBY7rWMutEuWS54Pt33MkzAS6eWkUuTc",
+       "0AO6BzQNfN",
+       "ctgnkvqm.kvtiybky@tezos.example.org"
+      );
+      (["cruel"; "fluid"; "damage"; "demand"; "mimic"; "above"; "village"; "alpha";
+        "vendor"; "staff"; "absent"; "uniform"; "fire"; "asthma"; "milk"],
+       "08d7d355bc3391d12d140780b39717d9f46fcf87",
+       "4092742372031",
+       "tz1amUjiZaevaxQy5wKn4SSRvVoERCip3nZS",
+       "9kbZ7fR6im",
+       "bnyxxzqr.tdszcvqb@tezos.example.org"
+      ) ;
+      (["opera"; "divorce"; "easy"; "myself"; "idea"; "aim"; "dash"; "scout";
+        "case"; "resource"; "vote"; "humor"; "ticket"; "client"; "edge"],
+       "9b7cad042fba557618bdc4b62837c5f125b50e56",
+       "17590039016550",
+       "tz1Zaee3QBtD4ErY1SzqUvyYTrENrExu6yQM",
+       "suxT5H09yY",
+       "iilkhohu.otnyuvna@tezos.example.org"
+      ) ;
+      (["token"; "similar"; "ginger"; "tongue"; "gun"; "sort"; "piano"; "month";
+        "hotel"; "vote"; "undo"; "success"; "hobby"; "shell"; "cart"],
+       "124c0ca217f11ffc6c7b76a743d867c8932e5afd",
+       "26322312350555",
+       "tz1geDUUhfXK1EMj7VQdRjug1MoFe6gHWnCU",
+       "4odVdLykaa",
+       "kwhlglvr.slriitzy@tezos.example.org"
+      ) ;
+      (["shield"; "warrior"; "gorilla"; "birth"; "steak"; "neither"; "feel";
+        "only"; "liberty"; "float"; "oven"; "extend"; "pulse"; "suffer"; "vapor"],
+       "ac7a2125beea68caf5266a647f24dce9fea018a7",
+       "244951387881443",
+       "tz1h3nY7jcZciJgAwRhWcrEwqfVp7VQoffur",
+       "A6yeMqBFG8",
+       "lvrmlbyj.yczltcxn@tezos.example.org"
+      ) ;
+      (["waste"; "open"; "scan"; "tip"; "subway"; "dance"; "rent"; "copper";
+        "garlic"; "laundry"; "defense"; "clerk"; "another"; "staff"; "liar"],
+       "2b3e94be133a960fa0ef87f6c0922c19f9d87ca2",
+       "80065050465525",
+       "tz1VzL4Xrb3fL3ckvqCWy6bdGMzU2w9eoRqs",
+       "oVZqpq60sk",
+       "rfodmrha.zzdndvyk@tezos.example.org"
+      ) ;
+      (["fiber"; "next"; "property"; "cradle"; "silk"; "obey"; "gossip";
+        "push"; "key"; "second"; "across"; "minimum"; "nice"; "boil"; "age"],
+       "dac31640199f2babc157aadc0021cd71128ca9ea",
+       "3569618927693",
+       "tz1RUHg536oRKhPLFfttcB5gSWAhh4E9TWjX",
+       "FfytQTTVbu",
+       "owecikdy.gxnyttya@tezos.example.org"
+      ) ;
+      (["print"; "labor"; "budget"; "speak"; "poem"; "diet"; "chunk"; "eternal";
+        "book"; "saddle"; "pioneer"; "ankle"; "happy"; "only"; "exclude"],
+       "bb841227f250a066eb8429e56937ad504d7b34dd",
+       "9034781424478",
+       "tz1M1LFbgctcPWxstrao9aLr2ECW1fV4pH5u",
+       "zknAl3lrX2",
+       "ettilrvh.zsrqrbud@tezos.example.org"
+      ) ;
+    ]
+
+let activation_init () =
+  Context.init ~with_commitments:true 1 >>=? fun (b, cs) ->
+  secrets () |> fun ss ->
+  return (b, cs, ss)
+
+let simple_init_with_commitments () =
+  activation_init () >>=? fun (blk, _contracts, _secrets) ->
+  Block.bake blk >>=? fun _ ->
+  return_unit
+
+(** A single activation *)
+let single_activation () =
+  activation_init () >>=? fun (blk, _contracts, secrets) ->
+  let { account ; activation_code ; amount=expected_amount ; _ } as _first_one = List.hd secrets in
+
+  (* Contract does not exist *)
+  Assert.balance_is ~loc:__LOC__ (B blk) (Contract.implicit_contract account) Tez.zero >>=? fun () ->
+
+  Op.activation (B blk) account activation_code >>=? fun operation ->
+  Block.bake ~operation blk >>=? fun blk ->
+
+  (* Contract does exist *)
+  Assert.balance_is ~loc:__LOC__ (B blk) (Contract.implicit_contract account) expected_amount
+
+(** 10 activations, one per bake *)
+let multi_activation_1 () =
+  activation_init () >>=? fun (blk, _contracts, secrets) ->
+
+  Error_monad.fold_left_s (fun blk { account ; activation_code ; amount = expected_amount ; _ } ->
+      Op.activation (B blk) account activation_code >>=? fun operation ->
+      Block.bake ~operation blk >>=? fun blk ->
+
+      Assert.balance_is ~loc:__LOC__ (B blk) (Contract.implicit_contract account) expected_amount >>=? fun () ->
+
+      return blk
+    ) blk secrets >>=? fun _ ->
+  return_unit
+
+(** All in one bake *)
+let multi_activation_2 () =
+  activation_init () >>=? fun (blk, _contracts, secrets) ->
+
+  Error_monad.fold_left_s (fun ops { account ; activation_code ; _ } ->
+      Op.activation (B blk) account activation_code >>=? fun op ->
+      return (op::ops)
+    ) [] secrets >>=? fun ops ->
+
+  Block.bake ~operations:ops blk >>=? fun blk ->
+
+  Error_monad.iter_s (fun { account ; amount = expected_amount ; _ } ->
+      (* Contract does exist *)
+      Assert.balance_is ~loc:__LOC__ (B blk) (Contract.implicit_contract account) expected_amount
+    ) secrets
+
+(** Transfer with activated account *)
+let activation_and_transfer () =
+  activation_init () >>=? fun (blk, contracts, secrets) ->
+  let { account ; activation_code ; _ } as _first_one = List.hd secrets in
+  let bootstrap_contract = List.hd contracts in
+  let first_contract = Contract.implicit_contract account in
+
+  Op.activation (B blk) account activation_code >>=? fun operation ->
+  Block.bake ~operation blk >>=? fun blk ->
+
+  Context.Contract.balance (B blk) bootstrap_contract >>=? fun amount ->
+  Tez.(/?) amount 2L >>?= fun half_amount ->
+  Context.Contract.balance (B blk) first_contract >>=? fun activated_amount_before ->
+
+  Op.transaction (B blk) bootstrap_contract first_contract half_amount >>=? fun operation ->
+  Block.bake ~operation blk >>=? fun blk ->
+
+  Assert.balance_was_credited ~loc:__LOC__ (B blk) (Contract.implicit_contract account) activated_amount_before half_amount
+
+(** Transfer to an unactivated account and then activating it *)
+let transfer_to_unactivated_then_activate () =
+  activation_init () >>=? fun (blk, contracts, secrets) ->
+  let { account ; activation_code ; amount } as _first_one = List.hd secrets in
+  let bootstrap_contract = List.hd contracts in
+  let unactivated_commitment_contract = Contract.implicit_contract account in
+
+  Context.Contract.balance (B blk) bootstrap_contract >>=? fun b_amount ->
+  Tez.(/?) b_amount 2L >>?= fun b_half_amount ->
+
+  Incremental.begin_construction blk >>=? fun inc ->
+  Op.transaction (I inc) bootstrap_contract unactivated_commitment_contract b_half_amount >>=? fun op ->
+  Incremental.add_operation inc op >>=? fun inc ->
+  Op.activation (I inc) account activation_code >>=? fun op' ->
+  Incremental.add_operation inc op' >>=? fun inc ->
+  Incremental.finalize_block inc >>=? fun blk2 ->
+
+  Assert.balance_was_credited ~loc:__LOC__ (B blk2) (Contract.implicit_contract account) amount b_half_amount
+
+(****************************************************************)
+(*  The following test scenarios are supposed to raise errors.  *)
+(****************************************************************)
+
+(** Invalid pkh activation : expected to fail as the context does not
+    contain any commitment *)
+let invalid_activation_with_no_commitments () =
+  Context.init 1 >>=? fun (blk, _) ->
+  let secrets = secrets () in
+  let { account ; activation_code ; _ } as _first_one = List.hd secrets in
+
+  Op.activation (B blk) account activation_code >>=? fun operation ->
+  Block.bake ~operation blk >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Invalid_activation _ -> true
+    | _ -> false
+  end
+
+(** Wrong activation : wrong secret given in the operation *)
+let invalid_activation_wrong_secret () =
+  activation_init () >>=? fun (blk, _, secrets) ->
+  let { account ; _ } as _first_one = List.nth secrets 0 in
+  let { activation_code ; _ } as _second_one = List.nth secrets 1 in
+
+  Op.activation (B blk) account activation_code >>=? fun operation ->
+  Block.bake ~operation blk >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res  begin function
+    | Apply.Invalid_activation _ -> true
+    | _ -> false
+  end
+
+(** Invalid pkh activation : expected to fail as the context does not
+    contain an associated commitment *)
+let invalid_activation_inexistent_pkh () =
+  activation_init () >>=? fun (blk, _, secrets) ->
+  let { activation_code ; _ } as _first_one = List.hd secrets in
+  let inexistent_pkh = Signature.Public_key_hash.of_b58check_exn
+      "tz1PeQHGKPWSpNoozvxgqLN9TFsj6rDqNV3o" in
+
+  Op.activation (B blk) inexistent_pkh activation_code >>=? fun operation ->
+  Block.bake ~operation blk >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Invalid_activation _ -> true
+    | _ -> false
+  end
+
+(** Invalid pkh activation : expected to fail as the commitment has
+    already been claimed *)
+let invalid_double_activation () =
+  activation_init () >>=? fun (blk, _, secrets) ->
+  let { account ; activation_code ; _ } as _first_one = List.hd secrets in
+  Incremental.begin_construction blk >>=? fun inc ->
+
+  Op.activation (I inc) account activation_code >>=? fun op ->
+  Incremental.add_operation inc op >>=? fun inc ->
+  Op.activation (I inc) account activation_code >>=? fun op' ->
+  Incremental.add_operation inc op' >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Invalid_activation _ -> true
+    | _ -> false
+  end
+
+(** Transfer from an unactivated commitment account *)
+let invalid_transfer_from_unactived_account () =
+  activation_init () >>=? fun (blk, contracts, secrets) ->
+  let { account ; _ } as _first_one = List.hd secrets in
+  let bootstrap_contract = List.hd contracts in
+  let unactivated_commitment_contract = Contract.implicit_contract account in
+
+  (* No activation *)
+
+  Op.transaction (B blk) unactivated_commitment_contract bootstrap_contract Tez.one >>=? fun operation ->
+  Block.bake ~operation blk >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Contract_storage.Empty_implicit_contract pkh -> if pkh = account then true else false
+    | _ -> false
+  end
+
+let tests = [
+  Test.tztest "init with commitments" `Quick simple_init_with_commitments ;
+  Test.tztest "single activation" `Quick single_activation ;
+  Test.tztest "multi-activation one-by-one" `Quick multi_activation_1 ;
+  Test.tztest "multi-activation all at a time" `Quick multi_activation_2 ;
+  Test.tztest "activation and transfer" `Quick activation_and_transfer ;
+  Test.tztest "transfer to unactivated account then activate" `Quick transfer_to_unactivated_then_activate ;
+  Test.tztest "invalid activation with no commitments" `Quick invalid_activation_with_no_commitments ;
+  Test.tztest "invalid activation with commitments" `Quick invalid_activation_inexistent_pkh ;
+  Test.tztest "invalid double activation" `Quick invalid_double_activation ;
+  Test.tztest "wrong activation code" `Quick invalid_activation_wrong_secret ;
+  Test.tztest "invalid transfer from unactivated account" `Quick invalid_transfer_from_unactived_account
+]

vendors/ligo-utils/tezos-protocol-alpha/test/baking.ml

@@ -0,0 +1,98 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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 Protocol
+open Alpha_context
+open Test_utils
+
+(** Tests for [bake_n] and [bake_until_end_cycle]. *)
+let test_cycle () =
+  Context.init 5 >>=? fun (b,_) ->
+  Context.get_constants (B b) >>=? fun csts ->
+  let blocks_per_cycle = csts.parametric.blocks_per_cycle in
+
+  let pp = fun fmt x -> Format.fprintf fmt "%ld" x in
+
+  (* Tests that [bake_until_cycle_end] returns a block at
+     level [blocks_per_cycle]. *)
+  Block.bake b >>=? fun b ->
+  Block.bake_until_cycle_end b >>=? fun b ->
+  Context.get_level (B b) >>=? fun curr_level ->
+  Assert.equal ~loc:__LOC__ Int32.equal "not the right level" pp
+    (Alpha_context.Raw_level.to_int32 curr_level)
+    blocks_per_cycle >>=? fun () ->
+
+  (* Tests that [bake_n n] bakes [n] blocks. *)
+  Context.get_level (B b) >>=? fun l ->
+  Block.bake_n 10 b >>=? fun b ->
+  Context.get_level (B b) >>=? fun curr_level ->
+  Assert.equal ~loc:__LOC__ Int32.equal "not the right level" pp
+    (Alpha_context.Raw_level.to_int32 curr_level)
+    (Int32.add (Alpha_context.Raw_level.to_int32 l) 10l)
+
+
+(** Tests the formula introduced in Emmy+ for block reward:
+    (16/(p+1)) * (0.8 + 0.2 * e / 32)
+    where p is the block priority and
+    e is the number of included endorsements *)
+let test_block_reward priority () =
+  begin match priority with
+    | 0 -> Test_tez.Tez.((of_int 128) /? Int64.of_int 10) >>?= fun min ->
+        return (Test_tez.Tez.of_int 16, min)
+    | 1 -> Test_tez.Tez.((of_int 64) /? Int64.of_int 10) >>?= fun min ->
+        return (Test_tez.Tez.of_int 8, min)
+    | 3 -> Test_tez.Tez.((of_int 32) /? Int64.of_int 10) >>?= fun min ->
+        return (Test_tez.Tez.of_int 4, min)
+    | _ -> fail (invalid_arg "prio should be 0, 1, or 3")
+  end >>=? fun (expected_reward_max_endo, expected_reward_min_endo) ->
+  let endorsers_per_block = 32 in
+  Context.init ~endorsers_per_block 32 >>=? fun (b, _) ->
+
+  Context.get_endorsers (B b) >>=? fun endorsers ->
+  fold_left_s (fun ops (endorser : Alpha_services.Delegate.Endorsing_rights.t) ->
+      let delegate = endorser.delegate in
+      Op.endorsement ~delegate (B b) () >>=? fun op ->
+      return (Operation.pack op :: ops)
+    ) [] endorsers >>=? fun ops ->
+  Block.bake
+    ~policy:(By_priority 0)
+    ~operations:ops
+    b >>=? fun b ->
+  (* bake a block at priority 0 and 32 endorsements;
+     the reward is 16 tez *)
+  Context.get_baking_reward (B b) ~priority ~endorsing_power:32 >>=? fun baking_reward ->
+  Assert.equal_tez ~loc:__LOC__ baking_reward expected_reward_max_endo >>=? fun () ->
+  (* bake a block at priority 0 and 0 endorsements;
+     the reward is 12.8 tez *)
+  Context.get_baking_reward (B b) ~priority ~endorsing_power:0 >>=? fun baking_reward ->
+  Assert.equal_tez ~loc:__LOC__ baking_reward expected_reward_min_endo
+
+
+let tests = [
+  Test.tztest "cycle" `Quick (test_cycle) ;
+  Test.tztest "block_reward for priority 0" `Quick (test_block_reward 0) ;
+  Test.tztest "block_reward for priority 1" `Quick (test_block_reward 1) ;
+  Test.tztest "block_reward for priority 3" `Quick (test_block_reward 3) ;
+]

vendors/ligo-utils/tezos-protocol-alpha/test/combined_operations.ml

@@ -0,0 +1,229 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Multiple operations can be grouped in one ensuring their
+    derministic application.
+
+    If an invalid operation is present in this group of operation, the
+    previous applied operations are backtracked leaving the context
+    unchanged and the following operations are skipped. Fees attributed
+    to the operations are collected by the baker nonetheless.
+
+    Only manager operations are allowed in multiple transactions.
+    They must all belong to the same manager as there is only one signature. *)
+
+open Protocol
+open Test_tez
+open Test_utils
+
+let ten_tez = Tez.of_int 10
+
+(** Groups ten transactions between the same parties. *)
+let multiple_transfers () =
+  Context.init 3 >>=? fun (blk, contracts) ->
+  let c1 = List.nth contracts 0 in
+  let c2 = List.nth contracts 1 in
+  let c3 = List.nth contracts 2 in
+
+  map_s (fun _ ->
+      Op.transaction (B blk) c1 c2 Tez.one
+    ) (1--10) >>=? fun ops ->
+
+  Op.combine_operations ~source:c1 (B blk) ops >>=? fun operation ->
+
+  Context.Contract.balance (B blk) c1 >>=? fun c1_old_balance ->
+  Context.Contract.balance (B blk) c2 >>=? fun c2_old_balance ->
+  Context.Contract.pkh c3 >>=? fun baker_pkh ->
+  Block.bake ~policy:(By_account baker_pkh) ~operation blk >>=? fun blk ->
+
+  Assert.balance_was_debited ~loc:__LOC__
+    (B blk) c1 c1_old_balance (Tez.of_int 10) >>=? fun () ->
+  Assert.balance_was_credited ~loc:__LOC__
+    (B blk) c2 c2_old_balance (Tez.of_int 10) >>=? fun () ->
+  return_unit
+
+
+(** Groups ten delegated originations. *)
+let multiple_origination_and_delegation () =
+  Context.init 2 >>=? fun (blk, contracts) ->
+  let c1 = List.nth contracts 0 in
+  let c2 = List.nth contracts 1 in
+  let n = 10 in
+  Context.get_constants (B blk) >>=? fun { parametric = { origination_size ; cost_per_byte ; _ } ; _ } ->
+  Context.Contract.pkh c2 >>=? fun delegate_pkh ->
+
+  (* Deploy n smart contracts with dummy scripts from c1 *)
+  map_s (fun i ->
+      Op.origination ~delegate:delegate_pkh ~counter:(Z.of_int i) ~fee:Tez.zero ~script:Op.dummy_script
+        ~credit:(Tez.of_int 10) (B blk) c1
+    ) (1--n) >>=? fun originations ->
+
+  (* These computed originated contracts are not the ones really created *)
+  (* We will extract them from the tickets *)
+  let (originations_operations, _) = List.split originations in
+
+  Op.combine_operations ~source:c1 (B blk) originations_operations >>=? fun operation ->
+
+  Context.Contract.balance (B blk) c1 >>=? fun c1_old_balance ->
+  Incremental.begin_construction blk >>=? fun inc ->
+  Incremental.add_operation inc operation >>=? fun inc ->
+
+  (* To retrieve the originated contracts, it is easier to extract them
+     from the tickets. Else, we could (could we ?) hash each combined
+     operation individually. *)
+  let tickets = Incremental.rev_tickets inc in
+  let open Apply_results in
+  let tickets =
+    List.fold_left (fun acc -> function
+        | No_operation_metadata -> assert false
+        | Operation_metadata { contents } ->
+            to_list (Contents_result_list contents) @ acc
+      ) [] tickets |> List.rev in
+  let new_contracts =
+    List.map (function
+        | Contents_result
+            (Manager_operation_result
+               { operation_result =
+                   Applied (Origination_result { originated_contracts = [ h ] ; _ })
+               ; _ }) ->
+            h
+        | _ -> assert false
+      ) tickets in
+
+  (* Previous balance - (Credit (n * 10tz) + Origination cost (n tz)) *)
+  Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
+  Tez.(origination_burn *? (Int64.of_int n)) >>?= fun origination_total_cost ->
+  Lwt.return (
+    Tez.( *? ) Op.dummy_script_cost 10L >>?
+    Tez.( +? ) (Tez.of_int (10 * n)) >>?
+    Tez.( +? ) origination_total_cost ) >>=? fun total_cost ->
+  Assert.balance_was_debited ~loc:__LOC__
+    (I inc) c1 c1_old_balance total_cost >>=? fun () ->
+
+  iter_s (fun c ->
+      Assert.balance_is ~loc:__LOC__ (I inc) c (Tez.of_int 10)
+    ) new_contracts >>=? fun () ->
+
+  return_unit
+
+let expect_balance_too_low = function
+  | Environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ ->
+      return_unit
+  | _ ->
+      failwith "Contract should not have a sufficient balance : operation expected to fail."
+
+(** Groups three operations, the midlle one failing.
+    Checks that the receipt is consistent.
+    Variant without fees. *)
+let failing_operation_in_the_middle () =
+  Context.init 2 >>=? fun (blk, contracts) ->
+  let c1 = List.nth contracts 0 in
+  let c2 = List.nth contracts 1 in
+
+  Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.one >>=? fun op1 ->
+  Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.max_tez >>=? fun op2 ->
+  Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.one >>=? fun op3 ->
+  let operations = [ op1 ; op2 ; op3 ] in
+
+  Op.combine_operations ~source:c1 (B blk) operations >>=? fun operation ->
+
+  Context.Contract.balance (B blk) c1 >>=? fun c1_old_balance ->
+  Context.Contract.balance (B blk) c2 >>=? fun c2_old_balance ->
+
+  Incremental.begin_construction blk >>=? fun inc ->
+  Incremental.add_operation
+    ~expect_failure:expect_balance_too_low inc operation >>=? fun inc ->
+
+  let tickets = Incremental.rev_tickets inc in
+  let open Apply_results in
+  let tickets =
+    List.fold_left (fun acc -> function
+        | No_operation_metadata -> assert false
+        | Operation_metadata { contents } ->
+            to_list (Contents_result_list contents) @ acc
+      ) [] tickets in
+  begin match tickets with
+    | Contents_result (Manager_operation_result { operation_result = (Backtracked _) ; _ }) ::
+      Contents_result (Manager_operation_result { operation_result = Failed (_, [ Contract_storage.Balance_too_low _ ]) ; _ }) ::
+      Contents_result (Manager_operation_result { operation_result = Skipped _ ; _ }) ::
+      _ -> ()
+    | _ -> assert false
+  end ;
+
+  Assert.balance_is ~loc:__LOC__ (I inc) c1 c1_old_balance >>=? fun () ->
+  Assert.balance_is ~loc:__LOC__ (I inc) c2 c2_old_balance >>=? fun () ->
+
+  return_unit
+
+(** Groups three operations, the midlle one failing.
+    Checks that the receipt is consistent.
+    Variant with fees, that should be spent even in case of failure. *)
+let failing_operation_in_the_middle_with_fees () =
+  Context.init 2 >>=? fun (blk, contracts) ->
+  let c1 = List.nth contracts 0 in
+  let c2 = List.nth contracts 1 in
+
+  Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one >>=? fun op1 ->
+  Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.max_tez >>=? fun op2 ->
+  Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one >>=? fun op3 ->
+  let operations = [ op1 ; op2 ; op3 ] in
+
+  Op.combine_operations ~source:c1 (B blk) operations >>=? fun operation ->
+
+  Context.Contract.balance (B blk) c1 >>=? fun c1_old_balance ->
+  Context.Contract.balance (B blk) c2 >>=? fun c2_old_balance ->
+
+  Incremental.begin_construction blk >>=? fun inc ->
+  Incremental.add_operation
+    ~expect_failure:expect_balance_too_low inc operation >>=? fun inc ->
+
+  let tickets = Incremental.rev_tickets inc in
+  let open Apply_results in
+  let tickets =
+    List.fold_left (fun acc -> function
+        | No_operation_metadata -> assert false
+        | Operation_metadata { contents } ->
+            to_list (Contents_result_list contents) @ acc
+      ) [] tickets in
+  begin match tickets with
+    | Contents_result (Manager_operation_result { operation_result = (Backtracked _) ; _ }) ::
+      Contents_result (Manager_operation_result { operation_result = Failed (_, [ Contract_storage.Balance_too_low _ ]) ; _ }) ::
+      Contents_result (Manager_operation_result { operation_result = Skipped _ ; _ }) ::
+      _ -> ()
+    | _ -> assert false
+  end ;
+
+  (* In the presence of a failure, all the fees are collected. Even for skipped operations. *)
+  Assert.balance_was_debited ~loc:__LOC__ (I inc) c1 c1_old_balance (Tez.of_int 3) >>=? fun () ->
+  Assert.balance_is ~loc:__LOC__ (I inc) c2 c2_old_balance >>=? fun () ->
+
+  return_unit
+
+let tests = [
+  Test.tztest "multiple transfers" `Quick multiple_transfers ;
+  Test.tztest "multiple originations and delegations" `Quick multiple_origination_and_delegation ;
+  Test.tztest "Failing operation in the middle" `Quick failing_operation_in_the_middle ;
+  Test.tztest "Failing operation in the middle (with fees)" `Quick failing_operation_in_the_middle_with_fees ;
+]

vendors/ligo-utils/tezos-protocol-alpha/test/contracts/cps_fact.tz

@@ -0,0 +1,16 @@
+storage nat ;
+parameter nat ;
+code { UNPAIR ;
+       DIP { SELF ; ADDRESS ; SOURCE;
+             IFCMPEQ {} { DROP ; PUSH @storage nat 1 } };
+       DUP ;
+       PUSH nat 1 ;
+       IFCMPGE
+         { DROP ; NIL operation ; PAIR }
+         { PUSH nat 1 ; SWAP ; SUB @parameter ; ISNAT ;
+           IF_NONE
+             { NIL operation ; PAIR }
+             { DUP ; DIP { PUSH nat 1 ; ADD ; MUL @storage } ; SWAP;
+               DIP { DIP { SELF; PUSH mutez 0 } ;
+                     TRANSFER_TOKENS ; NIL operation ; SWAP ; CONS } ;
+               SWAP ; PAIR } } }

vendors/ligo-utils/tezos-protocol-alpha/test/contracts/cps_fact_2.tz

@@ -0,0 +1,14 @@
+storage unit ;
+parameter (pair nat nat) ;
+code { CAR ; UNPAIR ;
+       DUP ;
+       PUSH nat 1 ;
+       IFCMPGE
+         { DROP ; DROP ; UNIT ; NIL operation ; PAIR }
+         { PUSH nat 1 ; SWAP ; SUB @parameter ; ISNAT ;
+           IF_NONE
+             { DROP ; UNIT ; NIL operation ; PAIR }
+             { DUP ; DIP { PUSH nat 1 ; ADD ; MUL @storage } ; PAIR ;
+               DIP { SELF; PUSH tez "0" } ;
+               TRANSFER_TOKENS ; NIL operation ; SWAP ; CONS ;
+               UNIT ; SWAP ; PAIR } } }

vendors/ligo-utils/tezos-protocol-alpha/test/double_baking.ml

@@ -0,0 +1,189 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Double baking evidence operation may happen when a baker
+    baked two different blocks on the same level. *)
+
+open Protocol
+open Alpha_context
+
+(****************************************************************)
+(*                  Utility functions                           *)
+(****************************************************************)
+
+let get_first_different_baker baker bakers =
+  return @@ List.find (fun baker' ->
+      Signature.Public_key_hash.(<>) baker baker')
+    bakers
+
+let get_first_different_bakers ctxt =
+  Context.get_bakers ctxt >>=? fun bakers ->
+  let baker_1 = List.hd bakers in
+  get_first_different_baker baker_1 (List.tl bakers) >>=? fun baker_2 ->
+  return (baker_1, baker_2)
+
+let get_first_different_endorsers ctxt =
+  Context.get_endorsers ctxt >>=? fun endorsers ->
+  let endorser_1 = (List.hd endorsers).delegate in
+  let endorser_2 = (List.hd (List.tl endorsers)).delegate in
+  return (endorser_1, endorser_2)
+
+(** Bake two block at the same level using the same policy (i.e. same
+    baker) *)
+let block_fork ?policy contracts b =
+  let (contract_a, contract_b) =
+    List.hd contracts, List.hd (List.tl contracts) in
+  Op.transaction (B b) contract_a contract_b  Alpha_context.Tez.one_cent >>=? fun operation ->
+  Block.bake ?policy ~operation b >>=? fun blk_a ->
+  Block.bake ?policy b >>=? fun blk_b ->
+  return (blk_a, blk_b)
+
+(****************************************************************)
+(*                        Tests                                 *)
+(****************************************************************)
+
+(** Simple scenario where two blocks are baked by a same baker and
+    exposed by a double baking evidence operation *)
+let valid_double_baking_evidence () =
+  Context.init 2 >>=? fun (b, contracts) ->
+
+  Context.get_bakers (B b) >>=? fun bakers ->
+  let priority_0_baker = List.hd bakers in
+
+  block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) ->
+
+  Op.double_baking (B blk_a) blk_a.header blk_b.header >>=? fun operation ->
+  Block.bake ~policy:(Excluding [ priority_0_baker ]) ~operation blk_a >>=? fun blk ->
+
+  (* Check that the frozen deposit, the fees and rewards are removed *)
+  iter_s (fun kind ->
+      let contract = Alpha_context.Contract.implicit_contract priority_0_baker in
+      Assert.balance_is ~loc:__LOC__ (B blk) contract ~kind Tez.zero)
+    [ Deposit ; Fees ; Rewards ]
+
+(****************************************************************)
+(*  The following test scenarios are supposed to raise errors.  *)
+(****************************************************************)
+
+(** Check that a double baking operation fails if it exposes the same two blocks *)
+let same_blocks () =
+  Context.init 2 >>=? fun (b, _contracts) ->
+  Block.bake b >>=? fun ba ->
+  Op.double_baking (B ba) ba.header ba.header >>=? fun operation ->
+  Block.bake ~operation ba >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Invalid_double_baking_evidence _ -> true
+    | _ -> false end >>=? fun () ->
+  return_unit
+
+(** Check that a double baking operation exposing two blocks with
+    different levels fails *)
+let different_levels () =
+  Context.init 2 >>=? fun (b, contracts) ->
+
+  block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) ->
+
+  Block.bake blk_b >>=? fun blk_b_2 ->
+
+  Op.double_baking (B blk_a) blk_a.header blk_b_2.header >>=? fun operation ->
+  Block.bake ~operation blk_a >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Invalid_double_baking_evidence _ -> true
+    | _ -> false end
+
+(** Check that a double baking operation exposing two yet to be baked
+    blocks fails *)
+let too_early_double_baking_evidence () =
+  Context.init 2 >>=? fun (b, contracts) ->
+  block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) ->
+
+  Op.double_baking (B b) blk_a.header blk_b.header >>=? fun operation ->
+  Block.bake ~operation b >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Too_early_double_baking_evidence _ -> true
+    | _ -> false end
+
+(** Check that after [preserved_cycles + 1], it is not possible to
+    create a double baking operation anymore *)
+let too_late_double_baking_evidence () =
+  Context.init 2 >>=? fun (b, contracts) ->
+  Context.get_constants (B b)
+  >>=? fun Constants.{ parametric = { preserved_cycles ; _ } ; _ } ->
+
+  block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) ->
+
+  fold_left_s (fun blk _ -> Block.bake_until_cycle_end blk)
+    blk_a (1 -- (preserved_cycles + 1)) >>=? fun blk ->
+
+  Op.double_baking (B blk) blk_a.header blk_b.header >>=? fun operation ->
+  Block.bake ~operation blk >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Outdated_double_baking_evidence _ -> true
+    | _ -> false end
+
+(** Check that an invalid double baking evidence that exposes two block
+    baking with same level made by different bakers fails *)
+let different_delegates () =
+  Context.init 2 >>=? fun (b, _) ->
+
+  get_first_different_bakers (B b) >>=? fun (baker_1, baker_2) ->
+  Block.bake ~policy:(By_account baker_1) b >>=? fun blk_a ->
+  Block.bake ~policy:(By_account baker_2) b >>=? fun blk_b ->
+
+  Op.double_baking (B blk_a) blk_a.header blk_b.header >>=? fun operation ->
+  Block.bake ~operation blk_a >>= fun e ->
+  Assert.proto_error ~loc:__LOC__ e begin function
+    | Apply.Inconsistent_double_baking_evidence _ -> true
+    | _ -> false end
+
+let wrong_signer () =
+  (* Baker_2 bakes a block but baker signs it. *)
+  let header_custom_signer baker baker_2 b =
+    Block.Forge.forge_header ~policy:(By_account baker_2) b >>=? fun header ->
+    Block.Forge.set_baker baker header |>
+    Block.Forge.sign_header
+  in
+
+  Context.init 2 >>=? fun (b, _) ->
+  get_first_different_bakers (B b) >>=? fun (baker_1, baker_2) ->
+  Block.bake ~policy:(By_account baker_1) b >>=? fun blk_a ->
+  header_custom_signer baker_1 baker_2 b >>=? fun header_b ->
+  Op.double_baking (B blk_a) blk_a.header header_b >>=? fun operation ->
+  Block.bake ~operation blk_a >>= fun e ->
+  Assert.proto_error ~loc:__LOC__ e begin function
+    | Baking.Invalid_block_signature _ -> true
+    | _ -> false end
+
+let tests = [
+  Test.tztest "valid double baking evidence" `Quick valid_double_baking_evidence ;
+
+  (* Should fail*)
+  Test.tztest "same blocks" `Quick same_blocks ;
+  Test.tztest "different levels" `Quick different_levels ;
+  Test.tztest "too early double baking evidence" `Quick too_early_double_baking_evidence ;
+  Test.tztest "too late double baking evidence" `Quick too_late_double_baking_evidence ;
+  Test.tztest "different delegates" `Quick different_delegates ;
+  Test.tztest "wrong delegate" `Quick wrong_signer ;
+]

vendors/ligo-utils/tezos-protocol-alpha/test/double_endorsement.ml

@@ -0,0 +1,204 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Double endorsement evidence operation may happen when an endorser
+    endorsed two different blocks on the same level. *)
+
+open Protocol
+open Alpha_context
+
+(****************************************************************)
+(*                  Utility functions                           *)
+(****************************************************************)
+
+let get_first_different_baker baker bakers =
+  return @@ List.find (fun baker' ->
+      Signature.Public_key_hash.(<>) baker baker')
+    bakers
+
+let get_first_different_bakers ctxt =
+  Context.get_bakers ctxt >>=? fun bakers ->
+  let baker_1 = List.hd bakers in
+  get_first_different_baker baker_1 (List.tl bakers) >>=? fun baker_2 ->
+  return (baker_1, baker_2)
+
+let get_first_different_endorsers ctxt =
+  Context.get_endorsers ctxt >>=? fun endorsers ->
+  let endorser_1 = (List.hd endorsers) in
+  let endorser_2 = (List.hd (List.tl endorsers)) in
+  return (endorser_1, endorser_2)
+
+let block_fork b =
+  get_first_different_bakers (B b) >>=? fun (baker_1, baker_2) ->
+  Block.bake ~policy:(By_account baker_1) b >>=? fun blk_a ->
+  Block.bake ~policy:(By_account baker_2) b >>=? fun blk_b ->
+  return (blk_a, blk_b)
+
+(****************************************************************)
+(*                        Tests                                 *)
+(****************************************************************)
+
+(** Simple scenario where two endorsements are made from the same
+    delegate and exposed by a double_endorsement operation. Also verify
+    that punishment is operated. *)
+let valid_double_endorsement_evidence () =
+  Context.init 2 >>=? fun (b, _) ->
+
+  block_fork b >>=? fun (blk_a, blk_b) ->
+
+  Context.get_endorser (B blk_a) >>=? fun (delegate, _slots) ->
+  Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a ->
+  Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b ->
+  Block.bake ~operations:[Operation.pack endorsement_a] blk_a >>=? fun blk_a ->
+  (* Block.bake ~operations:[endorsement_b] blk_b >>=? fun _ -> *)
+
+  Op.double_endorsement (B blk_a) endorsement_a endorsement_b >>=? fun operation ->
+
+  (* Bake with someone different than the bad endorser *)
+  Context.get_bakers (B blk_a) >>=? fun bakers ->
+  get_first_different_baker delegate bakers >>=? fun baker ->
+
+  Block.bake ~policy:(By_account baker) ~operation blk_a >>=? fun blk ->
+
+  (* Check that the frozen deposit, the fees and rewards are removed *)
+  iter_s (fun kind ->
+      let contract = Alpha_context.Contract.implicit_contract delegate in
+      Assert.balance_is ~loc:__LOC__ (B blk) contract ~kind Tez.zero)
+    [ Deposit ; Fees ; Rewards ]
+
+(****************************************************************)
+(*  The following test scenarios are supposed to raise errors.  *)
+(****************************************************************)
+
+(** Check that an invalid double endorsement operation that exposes a valid
+    endorsement fails. *)
+let invalid_double_endorsement () =
+  Context.init 10 >>=? fun (b, _) ->
+  Block.bake b >>=? fun b ->
+
+  Op.endorsement (B b) () >>=? fun endorsement ->
+  Block.bake ~operation:(Operation.pack endorsement) b >>=? fun b ->
+
+  Op.double_endorsement (B b) endorsement endorsement >>=? fun operation ->
+  Block.bake ~operation b >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Invalid_double_endorsement_evidence -> true
+    | _ -> false end
+
+(** Check that a double endorsement added at the same time as a double
+    endorsement operation fails. *)
+let too_early_double_endorsement_evidence () =
+  Context.init 2 >>=? fun (b, _) ->
+  block_fork b >>=? fun (blk_a, blk_b) ->
+
+  Context.get_endorser (B blk_a) >>=? fun (delegate, _slots) ->
+  Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a ->
+  Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b ->
+
+  Op.double_endorsement (B b) endorsement_a endorsement_b >>=? fun operation ->
+  Block.bake ~operation b >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Too_early_double_endorsement_evidence _ -> true
+    | _ -> false end
+
+(** Check that after [preserved_cycles + 1], it is not possible
+    to create a double_endorsement anymore. *)
+let too_late_double_endorsement_evidence () =
+  Context.init 2 >>=? fun (b, _) ->
+  Context.get_constants (B b)
+  >>=? fun Constants.{ parametric = { preserved_cycles ; _ } ; _ } ->
+
+  block_fork b >>=? fun (blk_a, blk_b) ->
+
+  Context.get_endorser (B blk_a) >>=? fun (delegate, _slots) ->
+  Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a ->
+  Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b ->
+
+  fold_left_s (fun blk _ -> Block.bake_until_cycle_end blk)
+    blk_a (1 -- (preserved_cycles + 1)) >>=? fun blk ->
+
+  Op.double_endorsement (B blk) endorsement_a endorsement_b >>=? fun operation ->
+  Block.bake ~operation blk >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Outdated_double_endorsement_evidence _ -> true
+    | _ -> false end
+
+(** Check that an invalid double endorsement evidence that expose two
+    endorsements made by two different endorsers fails. *)
+let different_delegates () =
+  Context.init 2 >>=? fun (b, _) ->
+
+  Block.bake b >>=? fun b ->
+  block_fork b >>=? fun (blk_a, blk_b) ->
+  Context.get_endorser (B blk_a) >>=? fun (endorser_a, _a_slots) ->
+  get_first_different_endorsers (B blk_b) >>=? fun (endorser_b1c, endorser_b2c) ->
+  let endorser_b =
+    if Signature.Public_key_hash.(=) endorser_a endorser_b1c.delegate
+    then endorser_b2c.delegate
+    else endorser_b1c.delegate
+  in
+
+  Op.endorsement ~delegate:endorser_a (B blk_a) () >>=? fun e_a ->
+  Op.endorsement ~delegate:endorser_b (B blk_b) () >>=? fun e_b ->
+  Block.bake ~operation:(Operation.pack e_b) blk_b >>=? fun _ ->
+  Op.double_endorsement (B blk_b) e_a e_b >>=? fun operation ->
+  Block.bake ~operation blk_b >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Inconsistent_double_endorsement_evidence _ -> true
+    | _ -> false end
+
+(** Check that a double endorsement evidence that exposes a ill-formed
+    endorsement fails. *)
+let wrong_delegate () =
+  Context.init ~endorsers_per_block:1 2 >>=? fun (b, contracts) ->
+  Error_monad.map_s (Context.Contract.manager (B b)) contracts >>=? fun accounts ->
+  let pkh1 = (List.nth accounts 0).Account.pkh in
+  let pkh2 = (List.nth accounts 1).Account.pkh in
+
+  block_fork b >>=? fun (blk_a, blk_b) ->
+  Context.get_endorser (B blk_a) >>=? fun (endorser_a, _a_slots) ->
+  Op.endorsement ~delegate:endorser_a (B blk_a) () >>=? fun endorsement_a ->
+  Context.get_endorser (B blk_b) >>=? fun (endorser_b, _b_slots) ->
+  let delegate =
+    if Signature.Public_key_hash.equal pkh1 endorser_b
+    then pkh2
+    else pkh1
+  in
+  Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b ->
+
+  Op.double_endorsement (B blk_b) endorsement_a endorsement_b >>=? fun operation ->
+  Block.bake ~operation blk_b >>= fun e ->
+  Assert.proto_error ~loc:__LOC__ e begin function
+    | Baking.Unexpected_endorsement -> true
+    | _ -> false end
+
+let tests = [
+  Test.tztest "valid double endorsement evidence" `Quick valid_double_endorsement_evidence ;
+  Test.tztest "invalid double endorsement evidence" `Quick invalid_double_endorsement ;
+  Test.tztest "too early double endorsement evidence" `Quick too_early_double_endorsement_evidence ;
+  Test.tztest "too late double endorsement evidence" `Quick too_late_double_endorsement_evidence ;
+  Test.tztest "different delegates" `Quick different_delegates ;
+  Test.tztest "wrong delegate" `Quick wrong_delegate ;
+]

vendors/ligo-utils/tezos-protocol-alpha/test/dune

@@ -0,0 +1,46 @@
+(executable
+ (name main)
+ (libraries tezos-base
+            tezos-micheline
+            tezos-protocol-environment
+            alcotest-lwt
+            tezos-005-PsBabyM1-test-helpers
+            tezos-stdlib-unix
+            bip39
+            tezos-protocol-005-PsBabyM1-parameters)
+ (flags (:standard -open Tezos_base__TzPervasives
+                   -open Tezos_micheline
+                   -open Tezos_protocol_005_PsBabyM1
+                   -open Tezos_005_PsBabyM1_test_helpers
+                   )))
+
+(alias
+ (name buildtest)
+ (package tezos-protocol-005-PsBabyM1-tests)
+ (deps main.exe))
+
+(rule
+ (copy %{lib:tezos-protocol-005-PsBabyM1-parameters:test-parameters.json}
+       protocol_parameters.json))
+
+; runs only the `Quick tests
+(alias
+ (name runtest_proto_005_PsBabyM1)
+ (package tezos-protocol-005-PsBabyM1-tests)
+ (action (run %{exe:main.exe} -v -q)))
+
+; runs both `Quick and `Slow tests
+(alias
+ (name runtest_slow)
+ (package tezos-protocol-005-PsBabyM1-tests)
+ (action (run %{exe:main.exe} -v)))
+
+(alias
+ (name runtest)
+ (package tezos-protocol-005-PsBabyM1-tests)
+ (deps (alias runtest_proto_005_PsBabyM1)))
+
+(alias
+ (name runtest_lint)
+ (deps (glob_files *.ml{,i}))
+ (action (run %{lib:tezos-tooling:lint.sh} %{deps})))

vendors/ligo-utils/tezos-protocol-alpha/test/endorsement.ml

@@ -0,0 +1,441 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Endorsing a block adds an extra layer of confidence to the Tezos's
+    PoS algorithm. The block endorsing operation must be included in
+    the following block. Each endorser possess a number of slots
+    corresponding to their priority. After [preserved_cycles], a reward
+    is given to the endorser. This reward depends on the priority of
+    the block that contains the endorsements. *)
+
+open Protocol
+open Alpha_context
+open Test_utils
+open Test_tez
+
+(****************************************************************)
+(*                    Utility functions                         *)
+(****************************************************************)
+
+let get_expected_reward ctxt ~priority ~baker ~endorsing_power =
+  begin if baker then
+      Context.get_baking_reward ctxt ~priority ~endorsing_power
+    else
+      return (Test_tez.Tez.of_int 0)
+  end >>=? fun baking_reward ->
+  Context.get_endorsing_reward ctxt ~priority ~endorsing_power >>=? fun endorsing_reward ->
+  Test_tez.Tez.(endorsing_reward +? baking_reward) >>?= fun reward -> return reward
+
+let get_expected_deposit ctxt ~baker ~endorsing_power =
+  Context.get_constants ctxt >>=? fun Constants.
+    { parametric = { endorsement_security_deposit ;
+                     block_security_deposit ; _ } ; _  } ->
+  let open Environment in
+  let open Tez in
+  let baking_deposit = if baker then block_security_deposit else of_int 0 in
+  endorsement_security_deposit *? (Int64.of_int endorsing_power) >>?= fun endorsement_deposit ->
+  endorsement_deposit +? baking_deposit >>?= fun deposit -> return deposit
+
+(* [baker] is true if the [pkh] has also baked the current block, in
+   which case correspoding deposit and reward should be ajusted *)
+let assert_endorser_balance_consistency ~loc ?(priority=0) ?(baker=false) ~endorsing_power
+    ctxt pkh initial_balance =
+  let contract = Contract.implicit_contract pkh in
+  get_expected_reward ctxt ~priority ~baker ~endorsing_power >>=? fun reward ->
+  get_expected_deposit ctxt ~baker ~endorsing_power >>=? fun deposit ->
+
+  Assert.balance_was_debited ~loc ctxt contract initial_balance deposit >>=? fun () ->
+  Context.Contract.balance ~kind:Rewards ctxt contract >>=? fun reward_balance ->
+  Assert.equal_tez ~loc reward_balance reward >>=? fun () ->
+  Context.Contract.balance ~kind:Deposit ctxt contract >>=? fun deposit_balance ->
+  Assert.equal_tez ~loc deposit_balance deposit
+
+let delegates_with_slots endorsers =
+  List.map (fun (endorser: Delegate_services.Endorsing_rights.t) ->
+      endorser.delegate)
+    endorsers
+
+let endorsing_power endorsers =
+  List.fold_left
+    (fun sum (endorser: Delegate_services.Endorsing_rights.t) ->
+       sum + List.length endorser.slots)
+    0 endorsers
+
+(****************************************************************)
+(*                      Tests                                   *)
+(****************************************************************)
+
+(** Apply a single endorsement from the slot 0 endorser *)
+let simple_endorsement () =
+  Context.init 5 >>=? fun (b, _) ->
+  Context.get_endorser (B b) >>=? fun (delegate, slots) ->
+  Op.endorsement ~delegate (B b) () >>=? fun op ->
+  Context.Contract.balance (B b) (Contract.implicit_contract delegate) >>=? fun initial_balance ->
+  let policy = Block.Excluding [ delegate ] in
+  Block.get_next_baker ~policy b >>=? fun (_, priority, _) ->
+  Block.bake
+    ~policy
+    ~operations:[Operation.pack op]
+    b >>=? fun b2 ->
+  assert_endorser_balance_consistency ~loc:__LOC__
+    (B b2) ~priority ~endorsing_power:(List.length slots)
+    delegate initial_balance
+
+(** Apply a maximum number of endorsements. An endorser can be
+    selected twice. *)
+let max_endorsement () =
+  let endorsers_per_block = 16 in
+  Context.init ~endorsers_per_block 32 >>=? fun (b, _) ->
+
+  Context.get_endorsers (B b) >>=? fun endorsers ->
+  Assert.equal_int ~loc:__LOC__
+    (List.length
+       (List.concat
+          (List.map
+             (fun { Alpha_services.Delegate.Endorsing_rights.slots ; _ } -> slots)
+             endorsers)))
+    endorsers_per_block >>=? fun () ->
+
+  fold_left_s (fun (delegates, ops, balances)
+                (endorser : Alpha_services.Delegate.Endorsing_rights.t) ->
+                let delegate = endorser.delegate in
+                Context.Contract.balance (B b) (Contract.implicit_contract delegate) >>=? fun balance ->
+                Op.endorsement ~delegate (B b) () >>=? fun op ->
+                return (delegate :: delegates,
+                        Operation.pack op :: ops,
+                        (List.length endorser.slots, balance) :: balances)
+              )
+    ([], [], [])
+    endorsers >>=? fun (delegates, ops, previous_balances) ->
+
+  Block.bake ~policy:(Excluding delegates) ~operations:(List.rev ops) b >>=? fun b ->
+
+  (* One account can endorse more than one time per level, we must
+     check that the bonds are summed up *)
+  iter_s (fun (endorser_account, (endorsing_power, previous_balance)) ->
+      assert_endorser_balance_consistency ~loc:__LOC__
+        (B b) ~endorsing_power endorser_account previous_balance
+    ) (List.combine delegates previous_balances)
+
+(** Check every that endorsers' balances are consistent with different priorities *)
+let consistent_priorities () =
+  let priorities = 0 -- 64 in
+  Context.init 64 >>=? fun (b, _) ->
+
+  fold_left_s (fun (b, used_pkhes) priority ->
+      (* Choose an endorser that has not baked nor endorsed before *)
+      Context.get_endorsers (B b) >>=? fun endorsers ->
+      let endorser =
+        List.find_opt
+          (fun (e: Delegate_services.Endorsing_rights.t) ->
+             not (Signature.Public_key_hash.Set.mem e.delegate used_pkhes)
+          )
+          endorsers in
+      match endorser with
+      | None -> return (b, used_pkhes) (* not enough fresh endorsers; we "stop" *)
+      | Some endorser ->
+
+          Context.Contract.balance (B b)
+            (Contract.implicit_contract endorser.delegate) >>=? fun balance ->
+
+          Op.endorsement ~delegate:endorser.delegate (B b) () >>=? fun operation ->
+          let operation = Operation.pack operation in
+
+          Block.get_next_baker ~policy:(By_priority priority) b >>=? fun (baker, _, _) ->
+          let used_pkhes = Signature.Public_key_hash.Set.add baker used_pkhes in
+          let used_pkhes = Signature.Public_key_hash.Set.add endorser.delegate used_pkhes in
+
+          (* Bake with a specific priority *)
+          Block.bake ~policy:(By_priority priority) ~operation b >>=? fun b ->
+
+          let is_baker = Signature.Public_key_hash.(baker = endorser.delegate) in
+
+          assert_endorser_balance_consistency ~loc:__LOC__ ~priority ~baker:is_baker (B b)
+            ~endorsing_power:(List.length endorser.slots)
+            endorser.delegate balance >>=? fun () ->
+
+          return (b, used_pkhes)
+    ) (b, Signature.Public_key_hash.Set.empty) priorities >>=? fun _b -> return_unit
+
+(** Check that after [preserved_cycles] cycles the endorser gets his reward *)
+let reward_retrieval () =
+  Context.init 5 >>=? fun (b, _) ->
+  Context.get_constants (B b) >>=? fun Constants.
+    { parametric = { preserved_cycles ; _ } ; _ } ->
+  Context.get_endorser (B b) >>=? fun (endorser, slots) ->
+  Context.Contract.balance (B b) (Contract.implicit_contract endorser) >>=? fun balance ->
+  Op.endorsement ~delegate:endorser (B b) () >>=? fun operation ->
+  let operation = Operation.pack operation in
+  let policy = Block.Excluding [ endorser ] in
+  Block.get_next_baker ~policy b >>=? fun (_, priority, _) ->
+  Block.bake ~policy ~operation b >>=? fun b ->
+  (* Bake (preserved_cycles + 1) cycles *)
+  fold_left_s (fun b _ ->
+      Block.bake_until_cycle_end ~policy:(Excluding [ endorser ]) b
+    ) b (0 -- preserved_cycles) >>=? fun b ->
+  get_expected_reward (B b) ~priority ~baker:false ~endorsing_power:(List.length slots) >>=? fun reward ->
+  Assert.balance_was_credited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser) balance reward
+
+(** Check that after [preserved_cycles] cycles endorsers get their
+    reward. Two endorsers are used and they endorse in different
+    cycles. *)
+let reward_retrieval_two_endorsers () =
+  Context.init 5 >>=? fun (b, _) ->
+  Context.get_constants (B b) >>=? fun Constants.
+    { parametric = { preserved_cycles ; endorsement_reward ; endorsement_security_deposit ; _ } ; _ } ->
+  Context.get_endorsers (B b) >>=? fun endorsers ->
+  let endorser1 = List.hd endorsers in
+  let endorser2 = List.hd (List.tl endorsers) in
+
+  Context.Contract.balance (B b) (Contract.implicit_contract endorser1.delegate) >>=? fun balance1 ->
+  Context.Contract.balance (B b) (Contract.implicit_contract endorser2.delegate) >>=? fun balance2 ->
+  Lwt.return Tez.(endorsement_security_deposit *? Int64.of_int (List.length endorser1.slots)) >>=? fun security_deposit1 ->
+
+  (* endorser1 endorses the genesis block in cycle 0 *)
+  Op.endorsement ~delegate:endorser1.delegate (B b) () >>=? fun operation1 ->
+
+  let policy = Block.Excluding [ endorser1.delegate ; endorser2.delegate ] in
+  Block.get_next_baker ~policy b >>=? fun (_, priority, _) ->
+  Tez.(endorsement_reward /? Int64.(succ (of_int priority))) >>?= fun reward_per_slot ->
+  Lwt.return Tez.(reward_per_slot *? Int64.of_int (List.length endorser1.slots)) >>=? fun reward1 ->
+
+  (* bake next block, include endorsement of endorser1 *)
+  Block.bake ~policy ~operation:(Operation.pack operation1) b >>=? fun b ->
+  Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 security_deposit1 >>=? fun () ->
+  Assert.balance_is ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2  >>=? fun () ->
+
+  (* complete cycle 0 *)
+  Block.bake_until_cycle_end ~policy b >>=? fun b ->
+  Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 security_deposit1 >>=? fun () ->
+  Assert.balance_is ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2  >>=? fun () ->
+
+  (* get the slots of endorser2 for the current block *)
+  Context.get_endorsers (B b) >>=? fun endorsers ->
+  let same_endorser2 endorser =
+    Signature.Public_key_hash.(endorser.Delegate_services.Endorsing_rights.delegate = endorser2.delegate) in
+  let endorser2 = List.find same_endorser2 endorsers in (* No exception raised: in sandboxed mode endorsers do not change between blocks *)
+  Lwt.return Tez.(endorsement_security_deposit *? Int64.of_int (List.length endorser2.slots)) >>=? fun security_deposit2 ->
+
+  (* endorser2 endorses the last block in cycle 0 *)
+  Op.endorsement ~delegate:endorser2.delegate (B b) () >>=? fun operation2 ->
+
+  (* bake first block in cycle 1, include endorsement of endorser2 *)
+  Block.bake ~policy ~operation:(Operation.pack operation2) b >>=? fun b ->
+
+  let priority = b.header.protocol_data.contents.priority in
+  Tez.(endorsement_reward /? Int64.(succ (of_int priority))) >>?= fun reward_per_slot ->
+  Lwt.return Tez.(reward_per_slot *? Int64.of_int (List.length endorser2.slots)) >>=? fun reward2 ->
+
+  Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 security_deposit1 >>=? fun () ->
+  Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2 security_deposit2 >>=? fun () ->
+
+  (* bake [preserved_cycles] cycles *)
+  fold_left_s (fun b _ ->
+      Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 security_deposit1 >>=? fun () ->
+      Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2 security_deposit2 >>=? fun () ->
+      Block.bake_until_cycle_end ~policy b
+    ) b (1 -- preserved_cycles) >>=? fun b ->
+
+  Assert.balance_was_credited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 reward1 >>=? fun () ->
+  Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2 security_deposit2 >>=? fun () ->
+
+  (* bake cycle [preserved_cycle + 1] *)
+  Block.bake_until_cycle_end ~policy b >>=? fun b ->
+  Assert.balance_was_credited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 reward1 >>=? fun () ->
+  Assert.balance_was_credited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2 reward2
+
+
+
+(****************************************************************)
+(*  The following test scenarios are supposed to raise errors.  *)
+(****************************************************************)
+
+(** Wrong endorsement predecessor : apply an endorsement with an
+    incorrect block predecessor *)
+let wrong_endorsement_predecessor () =
+  Context.init 5 >>=? fun (b, _) ->
+
+  Context.get_endorser (B b) >>=? fun (genesis_endorser, _slots) ->
+  Block.bake b >>=? fun b' ->
+  Op.endorsement ~delegate:genesis_endorser ~signing_context:(B b) (B b') () >>=? fun operation ->
+  let operation = Operation.pack operation in
+  Block.bake ~operation b' >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Wrong_endorsement_predecessor _ -> true
+    | _ -> false
+  end
+
+(** Invalid_endorsement_level : apply an endorsement with an incorrect
+    level (i.e. the predecessor level) *)
+let invalid_endorsement_level () =
+  Context.init 5 >>=? fun (b, _) ->
+  Context.get_level (B b) >>=? fun genesis_level ->
+  Block.bake b >>=? fun b ->
+  Op.endorsement ~level:genesis_level (B b) () >>=? fun operation ->
+  let operation = Operation.pack operation in
+  Block.bake ~operation b >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Invalid_endorsement_level -> true
+    | _ -> false
+  end
+
+(** Duplicate endorsement : apply an endorsement that has already been done *)
+let duplicate_endorsement () =
+  Context.init 5 >>=? fun (b, _) ->
+  Incremental.begin_construction b >>=? fun inc ->
+  Op.endorsement (B b) () >>=? fun operation ->
+  let operation = Operation.pack operation in
+  Incremental.add_operation inc operation >>=? fun inc ->
+  Op.endorsement (B b) () >>=? fun operation ->
+  let operation = Operation.pack operation in
+  Incremental.add_operation inc operation >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Duplicate_endorsement _ -> true
+    | _ -> false
+  end
+
+(** Apply a single endorsement from the slot 0 endorser *)
+let not_enough_for_deposit () =
+  Context.init 5 ~endorsers_per_block:1 >>=? fun (b_init, contracts) ->
+  Error_monad.map_s (fun c ->
+      Context.Contract.manager (B b_init) c >>=? fun m -> return (m, c)) contracts >>=?
+  fun managers ->
+  Block.bake b_init >>=? fun b ->
+  (* retrieve the level 2's endorser *)
+  Context.get_endorser (B b) >>=? fun (endorser, _slots) ->
+  let _, contract_other_than_endorser =
+    List.find (fun (c, _) -> not (Signature.Public_key_hash.equal c.Account.pkh endorser))
+      managers
+  in
+  let _, contract_of_endorser =
+    List.find (fun (c, _) -> (Signature.Public_key_hash.equal c.Account.pkh endorser))
+      managers
+  in
+  Context.Contract.balance (B b)
+    (Contract.implicit_contract endorser) >>=? fun initial_balance ->
+  (* Empty the future endorser account *)
+  Op.transaction (B b_init) contract_of_endorser contract_other_than_endorser initial_balance >>=? fun op_trans ->
+  Block.bake ~operation:op_trans b_init >>=? fun b ->
+  (* Endorse with a zero balance *)
+  Op.endorsement ~delegate:endorser (B b) () >>=? fun op_endo ->
+  Block.bake
+    ~policy:(Excluding [endorser])
+    ~operation:(Operation.pack op_endo)
+    b >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Delegate_storage.Balance_too_low_for_deposit _ -> true
+    | _ -> false
+  end
+
+(* check that a block with not enough endorsement cannot be baked *)
+let endorsement_threshold () =
+  let initial_endorsers = 28 in
+  let num_accounts = 100 in
+  Context.init ~initial_endorsers num_accounts >>=? fun (b, _) ->
+  Context.get_endorsers (B b) >>=? fun endorsers ->
+  let num_endorsers = List.length endorsers in
+
+  (* we try to bake with more and more endorsers, but at each
+     iteration with a timestamp smaller than required *)
+  iter_s (fun i ->
+      (* the priority is chosen rather arbitrarily *)
+      let priority = num_endorsers - i in
+      let crt_endorsers = List.take_n i endorsers in
+      let endorsing_power = endorsing_power crt_endorsers in
+      let delegates = delegates_with_slots crt_endorsers in
+      map_s (fun x ->  Op.endorsement ~delegate:x (B b) ()) delegates >>=? fun ops ->
+      Context.get_minimal_valid_time (B b) ~priority ~endorsing_power >>=? fun timestamp ->
+      (* decrease the timestamp by one second *)
+      let seconds = Int64.(sub (of_string (Timestamp.to_seconds_string timestamp)) 1L) in
+      match Timestamp.of_seconds (Int64.to_string seconds) with
+      | None -> failwith "timestamp to/from string manipulation failed"
+      | Some timestamp ->
+          Block.bake ~timestamp ~policy:(By_priority priority)
+            ~operations:(List.map Operation.pack ops) b >>= fun b2 ->
+          Assert.proto_error ~loc:__LOC__ b2 begin function
+            | Baking.Timestamp_too_early _
+            | Apply.Not_enough_endorsements_for_priority _ -> true
+            | _ -> false
+          end)
+    (0 -- (num_endorsers-1)) >>=? fun () ->
+
+  (* we bake with all endorsers endorsing, at the right time *)
+  let priority = 0 in
+  let endorsing_power = endorsing_power endorsers in
+  let delegates = delegates_with_slots endorsers in
+  map_s (fun delegate ->  Op.endorsement ~delegate (B b) ()) delegates >>=? fun ops ->
+  Context.get_minimal_valid_time (B b) ~priority ~endorsing_power >>=? fun timestamp ->
+  Block.bake
+    ~policy:(By_priority priority)
+    ~timestamp
+    ~operations:(List.map Operation.pack ops)
+    b >>= fun _ -> return_unit
+
+let test_fitness_gap () =
+  let num_accounts = 5 in
+  Context.init num_accounts >>=? fun (b, _) ->
+  begin
+    match Fitness_repr.to_int64 b.header.shell.fitness with
+    | Ok fitness ->
+        return (Int64.to_int fitness)
+    | Error _ -> assert false
+  end >>=? fun fitness ->
+  Context.get_endorser (B b) >>=? fun (delegate, _slots) ->
+  Op.endorsement ~delegate (B b) () >>=? fun op ->
+  (* bake at priority 0 succeed thanks to enough endorsements *)
+  Block.bake
+    ~policy:(By_priority 0)
+    ~operations:[Operation.pack op]
+    b >>=? fun b ->
+  begin
+    match Fitness_repr.to_int64 b.header.shell.fitness with
+    | Ok new_fitness ->
+        return ((Int64.to_int new_fitness) - fitness)
+    | Error _ -> assert false
+  end >>=? fun res ->
+  (* in Emmy+, the fitness increases by 1, so the difference between
+     the fitness at level 1 and at level 0 is 1, independently if the
+     number fo endorements (here 1) *)
+  Assert.equal_int ~loc:__LOC__ res 1 >>=? fun () ->
+  return_unit
+
+let tests = [
+  Test.tztest "Simple endorsement" `Quick simple_endorsement ;
+  Test.tztest "Maximum endorsement" `Quick max_endorsement ;
+  Test.tztest "Consistent priorities" `Quick consistent_priorities ;
+  Test.tztest "Reward retrieval" `Quick reward_retrieval ;
+  Test.tztest "Reward retrieval two endorsers" `Quick reward_retrieval_two_endorsers ;
+  Test.tztest "Endorsement threshold" `Quick endorsement_threshold ;
+  Test.tztest "Fitness gap" `Quick test_fitness_gap ;
+
+  (* Fail scenarios *)
+  Test.tztest "Wrong endorsement predecessor" `Quick wrong_endorsement_predecessor ;
+  Test.tztest "Invalid endorsement level" `Quick invalid_endorsement_level ;
+  Test.tztest "Duplicate endorsement" `Quick duplicate_endorsement ;
+  Test.tztest "Not enough for deposit" `Quick not_enough_for_deposit ;
+]

vendors/ligo-utils/tezos-protocol-alpha/test/helpers/account.ml

@@ -0,0 +1,92 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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 Protocol
+
+type t = {
+  pkh : Signature.Public_key_hash.t ;
+  pk :  Signature.Public_key.t ;
+  sk :  Signature.Secret_key.t ;
+}
+type account = t
+
+let known_accounts = Signature.Public_key_hash.Table.create 17
+
+let new_account ?seed () =
+  let (pkh, pk, sk) = Signature.generate_key ?seed () in
+  let account = { pkh ; pk ; sk } in
+  Signature.Public_key_hash.Table.add known_accounts pkh account ;
+  account
+
+let add_account ({ pkh ; _ } as account) =
+  Signature.Public_key_hash.Table.add known_accounts pkh account
+
+let activator_account = new_account ()
+
+let find pkh =
+  try return (Signature.Public_key_hash.Table.find known_accounts pkh)
+  with Not_found ->
+    failwith "Missing account: %a" Signature.Public_key_hash.pp pkh
+
+let find_alternate pkh =
+  let exception Found of t in
+  try
+    Signature.Public_key_hash.Table.iter
+      (fun pkh' account ->
+         if not (Signature.Public_key_hash.equal pkh pkh') then
+           raise (Found account))
+      known_accounts ;
+    raise Not_found
+  with Found account -> account
+
+let dummy_account = new_account ()
+
+let generate_accounts ?(initial_balances = []) n : (t * Tez_repr.t) list =
+  Signature.Public_key_hash.Table.clear known_accounts ;
+  let default_amount = Tez_repr.of_mutez_exn 4_000_000_000_000L in
+  let amount i = match List.nth_opt initial_balances i with
+    | None -> default_amount
+    | Some a -> Tez_repr.of_mutez_exn a
+  in
+  List.map (fun i ->
+      let (pkh, pk, sk) = Signature.generate_key () in
+      let account = { pkh ; pk ; sk } in
+      Signature.Public_key_hash.Table.add known_accounts pkh account ;
+      account, amount i)
+    (0--(n-1))
+
+let commitment_secret =
+  Blinded_public_key_hash.activation_code_of_hex
+    "aaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbb"
+
+let new_commitment ?seed () =
+  let (pkh, pk, sk) = Signature.generate_key ?seed ~algo:Ed25519 () in
+  let unactivated_account = { pkh; pk; sk } in
+  let open Commitment_repr in
+  let pkh = match pkh with Ed25519 pkh -> pkh | _ -> assert false in
+  let bpkh = Blinded_public_key_hash.of_ed25519_pkh commitment_secret pkh in
+  Lwt.return @@ Environment.wrap_error @@
+  Tez_repr.(one *? 4_000L) >>=? fun amount ->
+  return @@ (unactivated_account, { blinded_public_key_hash = bpkh ; amount })