Tests: add isolate tests

test/proto_alpha/jbuild

@@ -11,6 +11,7 @@
               tezos-client-base
               tezos-client-genesis
               tezos-client-alpha
+              tezos-shell
               test_lib))
   (flags (:standard -w -9-32 -safe-string
                     -open Tezos_base__TzPervasives

test/proto_alpha_isolate/jbuild

@@ -0,0 +1,38 @@
+(jbuild_version 1)
+
+(rule
+ ((targets (michelson_v1_parser.ml))
+  (action (copy# ../../src/proto_alpha/lib_client/michelson_v1_parser.ml michelson_v1_parser.ml))))
+
+(rule
+ ((targets (michelson_macros.ml))
+  (action (copy# ../../src/proto_alpha/lib_client/michelson_macros.ml michelson_macros.ml))))
+
+(executables
+ ((names (test_isolate_main))
+  (libraries (tezos-base
+              tezos-rpc-http
+              tezos-shell
+              test_lib
+              tezos_proto_alpha_isolate_helpers))
+  (flags (:standard -w -9-32 -safe-string
+                    -open Tezos_base__TzPervasives
+                    -open Tezos_rpc_http))))
+
+(alias
+ ((name buildtest)
+  (deps (test_isolate_main.exe))))
+
+(alias
+ ((name runtest_isolate_main)
+  (deps (../proto_alpha/sandbox.json (glob_files ../contracts/*.tz)))
+  (action (chdir ${ROOT} (run ${exe:test_isolate_main.exe})))))
+
+(alias
+ ((name runtest)
+  (deps ((alias runtest_isolate_main)))))
+
+(alias
+ ((name runtest_indent)
+  (deps ((glob_files *.ml) (glob_files *.mli)))
+  (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^}))))

test/proto_alpha_isolate/test_isolate_dsl.ml

@@ -0,0 +1,163 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Helpers_logger.Logger
+
+exception No_error
+
+open Isolate_helpers
+
+let run (starting_block : Block.result): unit Proto_alpha.tzresult Lwt.t =
+
+  let open Proto_alpha.Error_monad in
+
+  let init_tc = starting_block.tezos_context in
+
+  Account.make_2_accounts ~tc: init_tc >>=? fun ((account_a, account_b), init_tc) ->
+  Account.make_account ~tc: init_tc >>=? fun (_baker, init_tc) ->
+  let account_unknown_foo = Account.new_account () in
+  debug "Accounts set" ;
+
+  let default_fee = 10 in
+
+  let transfer ?(tc=init_tc) ?fee a b c =
+    Apply.transaction_pred
+      ~tc
+      ~pred: starting_block
+      (a,b,c, fee)
+  in
+  let originate ?(tc=init_tc) ?fee ?(spendable=true) ?(delegatable=true) a b =
+    let fee = Option.unopt ~default:default_fee fee in
+    Apply.origination_pred
+      ~tc
+      ~pred: starting_block
+      (a, b, spendable, delegatable, fee)
+  in
+
+  (* Send from a sender with no balance (never seen). *)
+  (* TODO: Is it OK to get Storage_error and not something more specific? *)
+  transfer
+    account_unknown_foo
+    account_b
+    10000 >|= Assert.unknown_contract ~msg: __LOC__ >>= fun _ ->
+  debug "Transfer from no balance V2" ;
+
+  (* Send 1000 tz to unknown account. *)
+  transfer
+    account_a
+    account_unknown_foo
+    10000 >>= Assert.ok_contract >>=? fun (_, tc) ->
+  Assert.equal_cents_balance ~msg: __LOC__ ~tc (account_unknown_foo.contract, 10000) >>=? fun () ->
+  debug "Reception" ;
+
+  (* Check that a basic transfer originates no contracts. *)
+  transfer
+    ~tc
+    account_a
+    account_b
+    1000
+  >>=? fun ((contracts, _), _) ->
+  Assert.equal_int ~msg: __LOC__ 0 (List.length contracts) ;
+  debug "No contracts originated" ;
+
+  (* Check sender/receiver balance post transaction *)
+  transfer
+    account_a
+    account_b
+    1000
+  >>= Assert.ok_contract ~msg: __LOC__ >>=? fun (_,tc) ->
+  Assert.equal_cents_balance ~msg: __LOC__ ~tc (account_a.contract, 998990) >>=? fun () ->
+  Assert.equal_cents_balance ~msg: __LOC__ ~tc (account_b.contract, 1001000) >>=? fun () ->
+  debug "Transfer balances" ;
+
+  (* Check balance too low. *)
+  transfer
+    account_a
+    account_b
+    10000000
+  >|= Assert.balance_too_low ~msg: __LOC__ >>= fun _ ->
+  debug "Too low" ;
+
+  (* Check non-spendability of a non-spendable contract *)
+  (* TODO: Unspecified economic error: should be more specific. *)
+  originate
+    ~spendable: false
+    account_a
+    1000
+  >>= Assert.ok_contract ~msg: __LOC__ >>=? fun ((contracts,_), tc) ->
+  Assert.equal_int (List.length contracts) 1 ;
+  let non_spendable = List.hd contracts in
+  let account = {account_a with contract = non_spendable} in
+  debug "Contract created" ;
+  transfer account account_b 50 ~tc >>= Assert.wrap >>= fun result ->
+  Assert.non_spendable ~msg: __LOC__ result ;
+  debug "Non Spendable" ;
+
+  (* Check spendability of a spendable contract *)
+  originate
+    ~spendable: true
+    ~fee: 100
+    account_a
+    1000
+  >>= Assert.ok_contract ~msg: __LOC__ >>=? fun ((contracts, _), spendable_tc) ->
+  Assert.equal_int (List.length contracts) 1 ;
+  let contract_spendable = List.hd contracts in
+  let account_spendable = {account_a with contract = contract_spendable} in
+  debug "Contract created" ;
+  transfer account_spendable account_b 50 ~tc: spendable_tc >>= Assert.ok ~msg: __LOC__ >>=? fun _ ->
+  debug "Spendable" ;
+
+
+  (* Try spending a default account with unmatching pk/sk pairs. *)
+  let account = { account_a with ppk = account_b.ppk } in
+  transfer
+    account
+    account_b
+    50
+  >>= Assert.wrap >>= fun result ->
+  Assert.generic_economic_error ~msg: __LOC__ result ;
+  debug "Unmatching keys" ;
+
+  (* Try spending a default account with keys not matching the
+     contract pkh. *)
+  let account = {account_a with contract = account_b.contract } in
+  transfer
+    account
+    account_unknown_foo
+    50
+  >>= Assert.wrap >>= fun result ->
+  Assert.inconsistent_pkh ~msg: __LOC__ result ;
+  debug "Unmatching contract" ;
+
+  (* Try spending an originated contract without the manager's key. *)
+  let account = {account_b with contract = contract_spendable } in
+  transfer
+    ~tc: spendable_tc
+    account
+    account_unknown_foo
+    50
+  >>= Assert.wrap >>= fun result ->
+  Assert.inconsistent_pkh ~msg: __LOC__ result ;
+  debug "No manager key" ;
+
+  return ()
+
+
+let main () =
+  Init.main () >>=? fun starting_block ->
+  run starting_block >>= Assert.wrap
+
+
+let tests = [
+  "main", (fun _ -> main ()) ;
+]
+
+let main () =
+  Test.run "dsl." tests

test/proto_alpha_isolate/test_isolate_endorsement.ml

@@ -0,0 +1,153 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+let name = "Isolate Endorsement"
+module Logger = Logging.Make(struct let name = name end)
+let section = Lwt_log.Section.make name
+let () =
+  Lwt_log.Section.set_level section Lwt_log(*.Debug*).Warning
+
+
+exception No_error
+
+open Isolate_helpers
+open Shorthands
+open Proto_alpha.Environment.Error_monad
+let (>>?=) = Assert.(>>?=)
+
+let test_wrong_slot endorse_a starting_block =
+  let wrong_slot = function
+    | Proto_alpha.Baking.Invalid_endorsement_slot _ -> true
+    | _ -> false
+  in
+  starting_block >>=? endorse_a (-1) >>?= fun result ->
+  Assert.economic_error ~msg: __LOC__ wrong_slot result ;
+  starting_block >>=? endorse_a 16 >>?= fun result ->
+  Assert.economic_error ~msg: __LOC__ wrong_slot result ;
+  return ()
+
+
+let test_wrong_delegate endorse_a starting_block =
+  let wrong_delegate = function
+    | Proto_alpha.Baking.Wrong_delegate _ -> true
+    | _ -> false
+  in
+  starting_block >>=?
+  endorse_a 0 >>=? endorse_a 1 >>=? endorse_a 2 >>= Assert.wrap >>= fun result ->
+  Assert.economic_error ~msg: __LOC__ wrong_delegate result ;
+  return ()
+
+
+let test_endorsement_payment starting_block =
+  let bootstrap_accounts = Account.bootstrap_accounts in
+  let open Proto_alpha.Tezos_context in
+  starting_block >>=? fun root ->
+  get_tc_full root >>=? fun tc ->
+  let level = Level.succ tc @@ Level.current tc in
+  Proto_alpha.Services_registration.endorsement_rights tc level None >>=? fun (_, endorsers) ->
+
+  let aux (endorser_slot, block_priority) =
+    let contract_p =
+      Misc.find_account bootstrap_accounts
+      @@ List.nth endorsers endorser_slot in
+    Contract.get_balance tc (Contract.default_contract contract_p.hpub) >>=? fun init_balance ->
+
+    (* After one block, endorsement bond cost should be paid *)
+    Block.endorsement
+      root.tezos_header.shell root.hash
+      root.level block_priority contract_p
+      root.validation.context endorser_slot
+    >>=? fun result ->
+    get_balance_res contract_p result >>=? fun bond_balance ->
+    let proto_header = Block.get_proto_header block_priority in
+    Proto_alpha.Baking.check_baking_rights
+      result.tezos_context proto_header root.tezos_header.shell.timestamp
+    >>=? fun baker_hpub ->
+    let endorsement_bond_cost =
+      Constants.endorsement_bond_cost in
+    let baking = baker_hpub = contract_p.hpub && block_priority < 4 in
+    let baking_bond_cost =
+      if baking
+      then Constants.baking_bond_cost
+      else Tez.zero in
+    let cost = Cast.tez_add endorsement_bond_cost baking_bond_cost in
+    let expected_balance = Cast.tez_sub init_balance cost in
+    Assert.equal_tez ~msg: __LOC__ expected_balance bond_balance ;
+    (* After one cycle, (4 blocks in test/proto_alpha/sandbox),
+       endorsement reward sould be received *)
+    chain_empty_block result >>=? chain_empty_block >>=?
+    chain_empty_block >>=? chain_empty_block >>=? fun result ->
+    get_balance_res contract_p result >>=? fun reward_balance ->
+    Proto_alpha.Baking.endorsement_reward ~block_priority >>=? fun reward ->
+    let expected_balance = Cast.tez_add expected_balance reward in
+    let expected_balance = Cast.tez_add expected_balance endorsement_bond_cost in
+    Assert.equal_tez ~msg: __LOC__ expected_balance reward_balance ;
+    return ()
+  in
+  let slots = [0 ;1 ;2 ;3 ;4 ;5 ;6 ;7 ;8 ;9 ;10 ;11 ;12 ;13 ;14] in
+  let prios = [0 ;1 ;2 ;3 ;4 ;5 ;6] in
+  iter_s aux @@ List.product slots prios
+
+
+let test_multiple_endorsement (pred: Block.result) =
+  let open Proto_alpha.Tezos_context in
+  let tc = pred.tezos_context in
+  let level = Level.succ tc @@ Level.current tc in
+  Proto_alpha.Services_registration.endorsement_rights tc level None >>=? fun (_, endorsers) ->
+  let endorser =
+    Misc.find_account Account.bootstrap_accounts
+    @@ List.nth endorsers 0 in
+  let op = Isolate_helpers.Operation.endorsement_full endorser pred.hash, endorser in
+  Block.of_res ~res: pred ~ops: [op ;op] () >>= Assert.wrap >>= fun x ->
+  Assert.double_endorsement ~msg: __LOC__ x ;
+  return ()
+
+
+let test_wrong_endorsement starting_block =
+  let account = Account.new_account () in
+  let endorse slot (res: Block.result) =
+    Block.endorsement
+      res.tezos_header.shell res.hash res.level
+      15 account res.validation.context slot
+  in
+  test_wrong_delegate endorse starting_block >>=? fun () ->
+  test_wrong_slot endorse starting_block
+
+
+let test_fitness (res: Block.result) =
+  Block.of_res ~priority: 0 ~res () >>=? fun block_0 ->
+  let fitness_0 = block_0.validation.fitness in
+  Block.of_res ~priority: 1 ~res () >>=? fun block_1 ->
+  let fitness_1 = block_1.validation.fitness in
+  let diff = Fitness.compare fitness_0 fitness_1 in
+  Assert.equal_int ~msg: "Fitness test" diff 0 ;
+  return ()
+
+
+let (>>=??) = Assert.(>>=??)
+
+let main (): unit Error_monad.tzresult Lwt.t =
+  let open Error_monad in
+
+  Init.main () >>=? fun sb ->
+  let starting_block = Proto_alpha.Error_monad.return sb in
+
+  test_endorsement_payment starting_block >>=?? fun () ->
+  test_wrong_endorsement starting_block >>=?? fun () ->
+  test_multiple_endorsement sb >>=?? fun () ->
+  test_fitness sb >>=?? fun () ->
+  return ()
+
+let tests = [
+  "main", (fun _ -> main ()) ;
+]
+
+let main () =
+  Test.run "endorsement." tests

test/proto_alpha_isolate/test_isolate_main.ml

@@ -0,0 +1,16 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+let () =
+  Test_isolate_dsl.main ();
+  Test_isolate_transaction.main ();
+  Test_isolate_endorsement.main ();
+  Test_isolate_origination.main ();
+  Test_isolate_michelson.main ()
+

test/proto_alpha_isolate/test_isolate_michelson.ml

@@ -0,0 +1,501 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+let name = "Isolate Michelson"
+module Logger = Logging.Make(struct let name = name end)
+let section = Lwt_log.Section.make name
+let () =
+  Lwt_log.Section.set_level section Lwt_log.Debug(*.Warning*)
+
+open Logger
+
+open Isolate_helpers
+open Shorthands
+
+let (>>??) = Assert.(>>??)
+let (>>=??) = Assert.(>>=??)
+
+open Tezos_micheline
+
+let parse_param s : Proto_alpha.Tezos_context.Script.expr =
+  let (parsed, _) = Michelson_v1_parser.parse_expression s in
+  parsed.expanded
+
+
+let parse_script code_str storage_str : Proto_alpha.Tezos_context.Script.t =
+  let code = parse_param code_str in
+  let storage = parse_param storage_str in
+  let return: Proto_alpha.Tezos_context.Script.t = {code ; storage} in
+  return
+
+
+let program param ret st code =
+  let storage s = "  storage " ^ s ^ " ; \n" in
+  let parameter s = "  parameter " ^ s ^ " ; \n" in
+  let return s = "  return " ^ s ^ " ; \n" in
+  "{\n" ^ (storage st) ^ (parameter param) ^ (return ret) ^ "  " ^ code ^ "}"
+
+let quote s = "\"" ^ s ^ "\""
+
+let test parse_execute =
+  let dir_path = "test/contracts/" in
+  let test ?tc (file_name: string) (storage: string) (input: string) =
+    let full_path = dir_path ^ file_name ^ ".tz" in
+    let file = Helpers_misc.read_file full_path in
+    let spaced_file = Str.global_replace (Str.regexp_string "\n") "\n " file in
+    let program = "{" ^ spaced_file ^ "}" in
+    parse_execute ?tc program input storage
+  in
+  test
+
+
+let test_fails ?location parse_execute f s i =
+  test parse_execute f s i >>= fun x ->
+  let msg = Option.unopt ~default:"Not failing" location in
+  Assert.generic_economic_error ~msg x ;
+  return ()
+
+
+let string_of_canon output_prim =
+  let output_can = Proto_alpha.Michelson_v1_primitives.strings_of_prims output_prim in
+  let location_maker _ =
+    let ret : Micheline_printer.location = {comment=None} in
+    ret in
+  let output_node = Micheline.inject_locations location_maker output_can in
+  Format.fprintf
+    Format.str_formatter "%a" Micheline_printer.print_expr output_node ;
+  let output = Format.flush_str_formatter () in
+  output
+
+
+let test_print parse_execute fn s i =
+  test parse_execute fn s i >>=? fun (sp, op, _) ->
+  let ss = string_of_canon sp in
+  let os = string_of_canon op in
+  debug "Storage : %s" ss ;
+  debug "Output : %s" os ;
+  return ()
+
+
+let test_output parse_execute ?location (file_name: string) (storage: string) (input: string) (expected_output: string) =
+  test parse_execute file_name storage input >>=? fun (_storage_prim, output_prim, _tc, _contracts) ->
+  let output = string_of_canon output_prim in
+  let msg = Option.unopt ~default:"strings aren't equal" location in
+  Assert.equal_string ~msg expected_output output ;
+  return ()
+
+
+let test_tc ?tc parse_execute (file_name: string) (storage: string) (input: string) =
+  test parse_execute ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, _contracts) ->
+  return (tc)
+
+
+let test_contract ?tc parse_execute (file_name: string) (storage: string) (input: string) =
+  test parse_execute ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, contracts) ->
+  return (contracts, tc)
+
+
+
+let test_storage parse_execute ?location (file_name: string) (storage: string) (input: string) (expected_storage: string) =
+  test parse_execute file_name storage input >>=? fun (storage_prim, _output_prim, _tc, _contracts) ->
+  let storage = string_of_canon storage_prim in
+  let msg = Option.unopt ~default:"strings aren't equal" location in
+  Assert.equal_string ~msg expected_storage storage ;
+  return ()
+
+
+let test_example parse_execute sb =
+  let test_output ?location a b c d =
+    test_output ?location parse_execute a b c d >>= function
+    | Ok(x) -> return x
+    | Error(errs) -> (
+        match location with
+        | None -> ()
+        | Some(loc) -> debug "loc : %s" loc
+      ) ; Lwt.return (Error(errs))
+  in
+  let test_fails ?location = test_fails ?location parse_execute in
+  let test_tc ?tc = test_tc ?tc parse_execute in
+  let test_contract ?tc = test_contract ?tc parse_execute in
+  (*  let test_print ?location = test_print ?location parse_execute in*)
+  let test_storage ?location = test_storage ?location parse_execute in
+
+  (*  FORMAT: assert_output contract_file storage input expected_result *)
+  test_output ~location: __LOC__ "ret_int" "Unit" "Unit" "300" >>=? fun _ ->
+
+  (*  Identity on strings *)
+  test_output ~location: __LOC__ "str_id" "Unit" "\"Hello\"" "\"Hello\"" >>=? fun _ ->
+  test_output ~location: __LOC__ "str_id" "Unit" "\"abcd\"" "\"abcd\"" >>=? fun _ ->
+
+  (*  Identity on pairs *)
+  test_output ~location: __LOC__ "pair_id" "Unit" "(Pair True False)" "(Pair True False)" >>=? fun _ ->
+  test_output ~location: __LOC__ "pair_id" "Unit" "(Pair False True)" "(Pair False True)" >>=? fun _ ->
+  test_output ~location: __LOC__ "pair_id" "Unit" "(Pair True True)" "(Pair True True)" >>=? fun _ ->
+  test_output ~location: __LOC__ "pair_id" "Unit" "(Pair False False)" "(Pair False False)" >>=? fun _ ->
+
+  (*  Logical not *)
+  test_output ~location: __LOC__ "not" "Unit" "True" "False" >>=? fun _ ->
+  test_output ~location: __LOC__ "not" "Unit" "False" "True" >>=? fun _ ->
+
+  (*  Logical and *)
+  test_output ~location: __LOC__ "and" "Unit" "(Pair False False)" "False" >>=? fun _ ->
+  test_output ~location: __LOC__ "and" "Unit" "(Pair False True)" "False" >>=? fun _ ->
+  test_output ~location: __LOC__ "and" "Unit" "(Pair True False)" "False" >>=? fun _ ->
+  test_output ~location: __LOC__ "and" "Unit" "(Pair True True)" "True" >>=? fun _ ->
+
+  (*  Logical or *)
+  test_output ~location: __LOC__ "or" "Unit" "(Pair False False)" "False" >>=? fun _ ->
+  test_output ~location: __LOC__ "or" "Unit" "(Pair False True)" "True" >>=? fun _ ->
+  test_output ~location: __LOC__ "or" "Unit" "(Pair True False)" "True" >>=? fun _ ->
+  test_output ~location: __LOC__ "or" "Unit" "(Pair True True)" "True" >>=? fun _ ->
+
+  (*  XOR *)
+  test_output ~location: __LOC__ "xor" "Unit" "(Pair False False)" "False" >>=? fun _ ->
+  test_output ~location: __LOC__ "xor" "Unit" "(Pair False True)" "True" >>=? fun _ ->
+  test_output ~location: __LOC__ "xor" "Unit" "(Pair True False)" "True" >>=? fun _ ->
+  test_output ~location: __LOC__ "xor" "Unit" "(Pair True True)" "False" >>=? fun _ ->
+
+
+  (*  Build list *)
+  test_output ~location: __LOC__ "build_list" "Unit" "0" "{ 0 }" >>=? fun _ ->
+  test_output ~location: __LOC__ "build_list" "Unit" "3" "{ 0 ; 1 ; 2 ; 3 }" >>=? fun _ ->
+  test_output ~location: __LOC__ "build_list" "Unit" "10" "{ 0 ; 1 ; 2 ; 3 ; 4 ; 5 ; 6 ; 7 ; 8 ; 9 ; 10 }" >>=? fun _ ->
+
+  (*  Concatenate all strings of a list into one string *)
+  test_output ~location: __LOC__ "concat_list" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "\"abc\"" >>=? fun _ ->
+  test_output ~location: __LOC__ "concat_list" "Unit" "{}" "\"\"" >>=? fun _ ->
+  test_output ~location: __LOC__ "concat_list" "Unit" "{ \"Hello\" ; \" \" ; \"World\" ; \"!\" }" "\"Hello World!\"" >>=? fun _ ->
+
+  (*  Find maximum int in list -- returns None if not found *)
+  test_output ~location: __LOC__ "max_in_list" "Unit" "{}" "None" >>=? fun _ ->
+  test_output ~location: __LOC__ "max_in_list" "Unit" "{ 1 }" "(Some 1)" >>=? fun _ ->
+  test_output ~location: __LOC__ "max_in_list" "Unit" "{ -1 }" "(Some -1)" >>=? fun _ ->
+  test_output ~location: __LOC__ "max_in_list" "Unit" "{ 10 ; -1 ; -20 ; 100 ; 0 }" "(Some 100)" >>=? fun _ ->
+  test_output ~location: __LOC__ "max_in_list" "Unit" "{ 10 ; -1 ; -20 ; 100 ; 0 }" "(Some 100)" >>=? fun _ ->
+  test_output ~location: __LOC__ "max_in_list" "Unit" "{ -10 ; -1 ; -20 ; -100 }" "(Some -1)" >>=? fun _ ->
+
+  (*  Identity on lists *)
+  test_output ~location: __LOC__ "list_id" "Unit" "{ \"1\" ; \"2\" ; \"3\" }" "{ \"1\" ; \"2\" ; \"3\" }" >>=? fun _ ->
+  test_output ~location: __LOC__ "list_id" "Unit" "{}" "{}" >>=? fun _ ->
+  test_output ~location: __LOC__ "list_id" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "list_id_map" "Unit" "{ \"1\" ; \"2\" ; \"3\" }" "{ \"1\" ; \"2\" ; \"3\" }" >>=? fun _ ->
+  test_output ~location: __LOC__ "list_id_map" "Unit" "{}" "{}" >>=? fun _ ->
+  test_output ~location: __LOC__ "list_id_map" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ ->
+
+
+  (*  Identity on maps *)
+  test_output ~location: __LOC__ "map_id" "Unit" "{ Elt 0 1 }" "{ Elt 0 1 }" >>=? fun _ ->
+  test_output ~location: __LOC__ "map_id" "Unit" "{ Elt 0 0 }" "{ Elt 0 0 }" >>=? fun _ ->
+  test_output ~location: __LOC__ "map_id" "Unit" "{ Elt 0 0 ; Elt 3 4 }" "{ Elt 0 0 ; Elt 3 4 }" >>=? fun _ ->
+
+  (*  Map block on lists *)
+  test_output ~location: __LOC__ "list_map_block" "Unit" "{}" "{}" >>=? fun _ ->
+  test_output ~location: __LOC__ "list_map_block" "Unit" "{ 1 ; 1 ; 1 ; 1 }" "{ 1 ; 2 ; 3 ; 4 }" >>=? fun _ ->
+  test_output ~location: __LOC__ "list_map_block" "Unit" "{ 1 ; 2 ; 3 ; 0 }" "{ 1 ; 3 ; 5 ; 3 }" >>=? fun _ ->
+
+  (*  List iter *)
+  test_output ~location: __LOC__ "list_iter" "Unit" "{ 10 ; 2 ; 1 }" "20" >>=? fun _ ->
+  test_output ~location: __LOC__ "list_iter" "Unit" "{ 3 ; 6 ; 9 }" "162" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "list_iter2" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "\"cba\"" >>=? fun _ ->
+  test_output ~location: __LOC__ "list_iter2" "Unit" "{}" "\"\"" >>=? fun _ ->
+
+
+  (*  Identity on sets *)
+  test_output ~location: __LOC__ "set_id" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ ->
+  test_output ~location: __LOC__ "set_id" "Unit" "{}" "{}" >>=? fun _ ->
+  test_output ~location: __LOC__ "set_id" "Unit" "{ \"asdf\" ; \"bcde\" }" "{ \"asdf\" ; \"bcde\" }" >>=? fun _ ->
+
+  (*  Set member -- set is in storage *)
+  test_output ~location: __LOC__ "set_member" "{}" "\"Hi\"" "False" >>=? fun _ ->
+  test_output ~location: __LOC__ "set_member" "{ \"Hi\" }" "\"Hi\"" "True" >>=? fun _ ->
+  test_output ~location: __LOC__ "set_member" "{ \"Hello\" ; \"World\" }" "\"\"" "False" >>=? fun _ ->
+
+  (*  Set size *)
+  test_output ~location: __LOC__ "set_size" "Unit" "{}" "0" >>=? fun _ ->
+  test_output ~location: __LOC__ "set_size" "Unit" "{ 1 }" "1" >>=? fun _ ->
+  test_output ~location: __LOC__ "set_size" "Unit" "{ 1 ; 2 ; 3 }" "3" >>=? fun _ ->
+  test_output ~location: __LOC__ "set_size" "Unit" "{ 1 ; 2 ; 3 ; 4 ; 5 ; 6 }" "6" >>=? fun _ ->
+
+  (*  Set iter *)
+  test_output ~location: __LOC__ "set_iter" "Unit" "{}" "0" >>=? fun _ ->
+  test_output ~location: __LOC__ "set_iter" "Unit" "{ 1 }" "1" >>=? fun _ ->
+  test_output ~location: __LOC__ "set_iter" "Unit" "{ -100 ; 1 ; 2 ; 3 }" "-94" >>=? fun _ ->
+
+  (*  Map size *)
+  test_output ~location: __LOC__ "map_size" "Unit" "{}" "0" >>=? fun _ ->
+  test_output ~location: __LOC__ "map_size" "Unit" "{ Elt \"a\" 1 }" "1" >>=? fun _ ->
+  test_output ~location: __LOC__ "map_size" "Unit" "{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 }" "3" >>=? fun _ ->
+  test_output ~location: __LOC__ "map_size" "Unit" "{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 ; Elt \"d\" 4 ; Elt \"e\" 5 ; Elt \"f\" 6 }" "6" >>=? fun _ ->
+
+  (*  Contains all elements -- does the second list contain all of the same elements *)
+  (*  as the first one? I'm ignoring element multiplicity *)
+  test_output ~location: __LOC__ "contains_all" "Unit" "(Pair {} {})" "True" >>=? fun _ ->
+  test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"a\" } { \"B\" })" "False" >>=? fun _ ->
+  test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"A\" } { \"B\" })" "False" >>=? fun _ ->
+  test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"B\" } { \"B\" })" "True" >>=? fun _ ->
+  test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"B\" ; \"C\" ; \"asdf\" } { \"B\" ; \"B\" ; \"asdf\" ; \"C\" })" "True" >>=? fun _ ->
+  test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"B\" ; \"B\" ; \"asdf\" ; \"C\" } { \"B\" ; \"C\" ; \"asdf\" })" "True" >>=? fun _ ->
+
+  (*  Concatenate the string in storage with all strings in the given list *)
+  test_output ~location: __LOC__ "concat_hello" "Unit" "{ \"World!\" }" "{ \"Hello World!\" }" >>=? fun _ ->
+  test_output ~location: __LOC__ "concat_hello" "Unit" "{}" "{}" >>=? fun _ ->
+  test_output ~location: __LOC__ "concat_hello" "Unit" "{ \"test1\" ; \"test2\" }" "{ \"Hello test1\" ; \"Hello test2\" }" >>=? fun _ ->
+
+  (*  Create an empty map and add a string to it *)
+  test_output ~location: __LOC__ "empty_map" "Unit" "Unit" "{ Elt \"hello\" \"world\" }" >>=? fun _ ->
+
+  (*  Get the value stored at the given key in the map *)
+  test_output ~location: __LOC__ "get_map_value" "{ Elt \"hello\" \"hi\" }" "\"hello\"" "(Some \"hi\")" >>=? fun _ ->
+  test_output ~location: __LOC__ "get_map_value" "{ Elt \"hello\" \"hi\" }" "\"\"" "None" >>=? fun _ ->
+  test_output ~location: __LOC__ "get_map_value" "{ Elt \"1\" \"one\" ; Elt \"2\" \"two\" }" "\"1\"" "(Some \"one\")" >>=? fun _ ->
+
+  (*  Map iter *)
+  test_output ~location: __LOC__ "map_iter" "Unit" "{ Elt 0 100 ; Elt 2 100 }" "(Pair 2 200)" >>=? fun _ ->
+  test_output ~location: __LOC__ "map_iter" "Unit" "{ Elt 1 1 ; Elt 2 100 }" "(Pair 3 101)" >>=? fun _ ->
+
+  (*  Return True if True branch of if was taken and False otherwise *)
+  test_output ~location: __LOC__ "if" "Unit" "True" "True" >>=? fun _ ->
+  test_output ~location: __LOC__ "if" "Unit" "False" "False" >>=? fun _ ->
+
+  (*  Generate a pair of or types *)
+  test_output ~location: __LOC__ "swap_left_right" "Unit" "(Left True)" "(Right True)" >>=? fun _ ->
+  test_output ~location: __LOC__ "swap_left_right" "Unit" "(Right \"a\")" "(Left \"a\")" >>=? fun _ ->
+
+  (*  Reverse a list *)
+  test_output ~location: __LOC__ "reverse" "Unit" "{}" "{}" >>=? fun _ ->
+  test_output ~location: __LOC__ "reverse" "Unit" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ ->
+  test_output ~location: __LOC__ "reverse_loop" "Unit" "{}" "{}" >>=? fun _ ->
+  test_output ~location: __LOC__ "reverse_loop" "Unit" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ ->
+
+  (*  Reverse using LOOP_LEFT *)
+  test_output ~location: __LOC__ "loop_left" "Unit" "{}" "{}" >>=? fun _ ->
+  test_output ~location: __LOC__ "loop_left" "Unit" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ ->
+
+  (*  Exec concat contract *)
+  test_output ~location: __LOC__ "exec_concat" "Unit" "\"\"" "\"_abc\"" >>=? fun _ ->
+  test_output ~location: __LOC__ "exec_concat" "Unit" "\"test\"" "\"test_abc\"" >>=? fun _ ->
+
+  (*  Get current steps to quota *)
+  test_output ~location: __LOC__ "steps_to_quota" "Unit" "Unit" "39991" >>=? fun _ ->
+
+  let bootstrap_0 = List.nth Account.bootstrap_accounts 0 in
+  get_balance_res bootstrap_0 sb >>=?? fun _balance ->
+  let amount = Proto_alpha.Tezos_context.Tez.to_string @@ Cast.cents_of_int Script.init_amount in
+  (*  Get the current balance of the contract *)
+  test_output ~location: __LOC__ "balance" "Unit" "Unit" ("\"" ^ amount ^ "\"") >>=? fun _ ->
+
+  (*  Test comparisons on tez { EQ ; GT ; LT ; GE ; LE } *)
+  test_output ~location: __LOC__ "compare" "Unit" "(Pair \"1.00\" \"2.00\")" "{ False ; False ; True ; False ; True }" >>=? fun _ ->
+  test_output ~location: __LOC__ "compare" "Unit" "(Pair \"2.00\" \"1.00\")" "{ False ; True ; False ; True ; False }" >>=? fun _ ->
+  test_output ~location: __LOC__ "compare" "Unit" "(Pair \"2.37\" \"2.37\")" "{ True ; False ; False ; True ; True }" >>=? fun _ ->
+
+  (*  Test addition and subtraction on tez *)
+  test_output ~location: __LOC__ "tez_add_sub" "Unit" "(Pair \"2\" \"1\")" "(Pair \"3\" \"1\")" >>=? fun _ ->
+  test_output ~location: __LOC__ "tez_add_sub" "Unit" "(Pair \"2.31\" \"1.01\")" "(Pair \"3.32\" \"1.3\")" >>=? fun _ ->
+
+  (*  Test get first element of list *)
+  test_output ~location: __LOC__ "first" "Unit" "{ 1 ; 2 ; 3 ; 4 }" "1" >>=? fun _ ->
+  test_output ~location: __LOC__ "first" "Unit" "{ 4 }" "4" >>=? fun _ ->
+
+  (*  Hash input string *)
+  (*  Test assumed to be correct -- hash is based on encoding of AST *)
+  test_output ~location: __LOC__ "hash_string" "Unit" "\"abcdefg\"" "\"exprv3MnhXvjthGzZ7jDtXRRFremZyey9rsGtL7JRkeaQX1fThN7WF\"" >>=? fun _ ->
+  test_output ~location: __LOC__ "hash_string" "Unit" "\"12345\"" "\"expru81QVHsW2qaWLNHnMHSxDNhqtat17ajadri6mKUvXyc2EWHZC3\"" >>=? fun _ ->
+
+  (*  Test ASSERT *)
+  test_output ~location: __LOC__ "assert" "Unit" "True" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert" "Unit" "False" >>=? fun _ ->
+
+  (*  COMPARE ; ASSERT_ *)
+  test_output ~location: __LOC__ "assert_eq" "Unit" "(Pair -1 -1)" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_eq" "Unit" "(Pair 0 -1)" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "assert_eq" "Unit" "(Pair -1 -1)" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_eq" "Unit" "(Pair 0 -1)" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "assert_neq" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_neq" "Unit" "(Pair -1 -1)" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "assert_lt" "Unit" "(Pair -1 0)" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_lt" "Unit" "(Pair 0 -1)" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_lt" "Unit" "(Pair 0 0)" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "assert_le" "Unit" "(Pair 0 0)" "Unit" >>=? fun _ ->
+  test_output ~location: __LOC__ "assert_le" "Unit" "(Pair -1 0)" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_le" "Unit" "(Pair 0 -1)" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "assert_gt" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_gt" "Unit" "(Pair -1 0)" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_gt" "Unit" "(Pair 0 0)" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "assert_ge" "Unit" "(Pair 0 0)" "Unit" >>=? fun _ ->
+  test_output ~location: __LOC__ "assert_ge" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_ge" "Unit" "(Pair -1 0)" >>=? fun _ ->
+
+  (*  ASSERT_CMP *)
+  test_output ~location: __LOC__ "assert_cmpeq" "Unit" "(Pair -1 -1)" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_cmpeq" "Unit" "(Pair 0 -1)" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "assert_cmpeq" "Unit" "(Pair -1 -1)" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_cmpeq" "Unit" "(Pair 0 -1)" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "assert_cmpneq" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_cmpneq" "Unit" "(Pair -1 -1)" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "assert_cmplt" "Unit" "(Pair -1 0)" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_cmplt" "Unit" "(Pair 0 -1)" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_cmplt" "Unit" "(Pair 0 0)" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "assert_cmple" "Unit" "(Pair 0 0)" "Unit" >>=? fun _ ->
+  test_output ~location: __LOC__ "assert_cmple" "Unit" "(Pair -1 0)" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_cmple" "Unit" "(Pair 0 -1)" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "assert_cmpgt" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_cmpgt" "Unit" "(Pair -1 0)" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_cmpgt" "Unit" "(Pair 0 0)" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "assert_cmpge" "Unit" "(Pair 0 0)" "Unit" >>=? fun _ ->
+  test_output ~location: __LOC__ "assert_cmpge" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ ->
+  test_fails ~location: __LOC__ "assert_cmpge" "Unit" "(Pair -1 0)" >>=? fun _ ->
+
+  (*  IF_SOME *)
+  test_output ~location: __LOC__ "if_some" "Unit" "(Some \"hello\")" "\"hello\"" >>=? fun _ ->
+  test_output ~location: __LOC__ "if_some" "Unit" "None" "\"\"" >>=? fun _ ->
+
+  (*  Tests the SET_CAR and SET_CDR instructions *)
+  test_output ~location: __LOC__ "set_car" "(Pair \"hello\" 0)" "\"world\"" "(Pair \"world\" 0)" >>=? fun _ ->
+  test_output ~location: __LOC__ "set_car" "(Pair \"hello\" 0)" "\"abc\"" "(Pair \"abc\" 0)" >>=? fun _ ->
+  test_output ~location: __LOC__ "set_car" "(Pair \"hello\" 0)" "\"\"" "(Pair \"\" 0)" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "set_cdr" "(Pair \"hello\" 0)" "1" "(Pair \"hello\" 1)" >>=? fun _ ->
+  test_output ~location: __LOC__ "set_cdr" "(Pair \"hello\" 500)" "3" "(Pair \"hello\" 3)" >>=? fun _ ->
+  test_output ~location: __LOC__ "set_cdr" "(Pair \"hello\" 7)" "100" "(Pair \"hello\" 100)" >>=? fun _ ->
+
+  test_storage ~location: __LOC__ "set_caddaadr" "(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 \"0\") 4) 5))) 6)" "\"3\"" "(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 \"3\") 4) 5))) 6)" >>=? fun _ ->
+
+  test_storage ~location: __LOC__ "map_caddaadr" "(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 \"0\") 4) 5))) 6)" "Unit" "(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 \"1\") 4) 5))) 6)" >>=? fun _ ->
+
+  (*  Did the given key sign the string? (key is bootstrap1) *)
+  test_output ~location: __LOC__ "check_signature" "(Pair \"26981d372a7b3866621bf79713d249197fe6d518ef702fa65738e1715bde9da54df04fefbcc84287ecaa9f74ad9296462731aa24bbcece63c6bf73a8f5752309\" \"hello\")" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" "True" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "check_signature" "(Pair \"26981d372a7b3866621bf79713d249197fe6d518ef702fa65738e1715bde9da54df04fefbcc84287ecaa9f74ad9296462731aa24bbcece63c6bf73a8f5752309\" \"abcd\")" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" "False" >>=? fun _ ->
+
+  (*  Convert a public key to a public key hash *)
+  test_output ~location: __LOC__ "hash_key" "Unit" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" "\"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx\"" >>=? fun _ ->
+  test_output ~location: __LOC__ "hash_key" "Unit" "\"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES\"" "\"tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k\"" >>=? fun _ ->
+
+  (*  Test timestamp operations *)
+  test_output ~location: __LOC__ "add_timestamp_delta" "Unit" "(Pair 100 100)" "\"1970-01-01T00:03:20Z\"" >>=? fun _ ->
+  test_output ~location: __LOC__ "add_timestamp_delta" "Unit" "(Pair 100 -100)" "\"1970-01-01T00:00:00Z\"" >>=? fun _ ->
+  test_output ~location: __LOC__ "add_timestamp_delta" "Unit" "(Pair \"1970-01-01T00:00:00Z\" 0)" "\"1970-01-01T00:00:00Z\"" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "add_delta_timestamp" "Unit" "(Pair 100 100)" "\"1970-01-01T00:03:20Z\"" >>=? fun _ ->
+  test_output ~location: __LOC__ "add_delta_timestamp" "Unit" "(Pair -100 100)" "\"1970-01-01T00:00:00Z\"" >>=? fun _ ->
+  test_output ~location: __LOC__ "add_delta_timestamp" "Unit" "(Pair 0 \"1970-01-01T00:00:00Z\")" "\"1970-01-01T00:00:00Z\"" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "sub_timestamp_delta" "Unit" "(Pair 100 100)" "\"1970-01-01T00:00:00Z\"" >>=? fun _ ->
+  test_output ~location: __LOC__ "sub_timestamp_delta" "Unit" "(Pair 100 -100)" "\"1970-01-01T00:03:20Z\"" >>=? fun _ ->
+  test_output ~location: __LOC__ "sub_timestamp_delta" "Unit" "(Pair 100 2000000000000000000)" "-1999999999999999900" >>=? fun _ ->
+
+  test_output ~location: __LOC__ "diff_timestamps" "Unit" "(Pair 0 0)" "0" >>=? fun _ ->
+  test_output ~location: __LOC__ "diff_timestamps" "Unit" "(Pair 0 1)" "-1" >>=? fun _ ->
+  test_output ~location: __LOC__ "diff_timestamps" "Unit" "(Pair 1 0)" "1" >>=? fun _ ->
+  test_output ~location: __LOC__ "diff_timestamps" "Unit" "(Pair \"1970-01-01T00:03:20Z\" \"1970-01-01T00:00:00Z\")" "200" >>=? fun _ ->
+
+  (* Test NOW *)
+  let now = sb.tezos_header.shell.timestamp in
+  let now_str = quote @@ Tezos_base.Time.to_notation now in
+  test_storage ~location: __LOC__ "store_now" "\"1970-01-01T00:03:20Z\"" "Unit" now_str >>=? fun _ ->
+
+  (* Test TRANSFER_TO *)
+  Account.make_account ~tc: sb.tezos_context >>=?? fun (account, tc) ->
+  let account_str = quote @@ Ed25519.Public_key_hash.to_b58check account.hpub in
+  test_tc ~tc "transfer_to" "Unit" account_str >>=? fun tc ->
+  let amount = Account.init_amount + 100 in
+  Assert.equal_cents_balance ~tc (account.contract, amount * 100) >>=?? fun _ ->
+
+  (* Test CREATE_ACCOUNT *)
+  Account.make_account ~tc: sb.tezos_context >>=?? fun (account, tc) ->
+  let account_str = quote @@ Ed25519.Public_key_hash.to_b58check account.hpub in
+  test_contract ~tc "create_account" account_str account_str >>=? fun (cs, tc) ->
+  Assert.equal_int 1 @@ List.length cs ;
+
+  (* Test CREATE_CONTRACT *)
+  test_contract ~tc "create_contract" account_str account_str >>=? fun (cs, tc) ->
+  Assert.equal_int 1 @@ List.length cs ;
+  let contract = List.hd cs in
+  Proto_alpha.Tezos_context.Contract.get_script tc contract >>=?? fun res ->
+  let script = Option.unopt_exn (Failure "get_script") res in
+  Script.execute_code_pred ~tc sb script (parse_param "\"abc\"") >>=?? fun (_, ret, _, _, _) ->
+  Assert.equal_string ~msg: __LOC__ "\"abc\"" @@ string_of_canon ret ;
+
+  (* Test DEFAULT_ACCOUNT *)
+  let account = Account.new_account () in
+  let b_str = quote @@ Ed25519.Public_key_hash.to_b58check account.hpub in
+  test_contract ~tc "default_account" "Unit" b_str >>=? fun (_cs, tc) ->
+  Assert.equal_cents_balance ~tc (account.contract, 100 * 100) >>=?? fun _ ->
+  return ()
+
+
+let test_program parse_execute =
+  let open Error_monad in
+  let id_code = "code
+     { DUP ;
+       PAIR ;
+       CAR }" in
+  let id_int_program =
+    program "int" "int" "int" id_code in
+  let id_ill_param_program =
+    program "string" "int" "string" id_code in
+  let id_ill_return_program =
+    program "int" "string" "int" id_code in
+  let id_pbool_program =
+    program "(pair bool bool)" "(pair bool bool)" "unit" id_code in
+  let push_300_code = "code
+     { CAR ;
+       PUSH nat 300 ;
+       PAIR }" in
+  let push_300 =
+    program "unit" "nat" "unit" push_300_code in
+  parse_execute id_int_program "2" "3" >>=? fun _ ->
+  parse_execute id_ill_param_program "2" "3" >>= fun x ->
+  Assert.ill_typed_data_error ~msg: "Good data type" x ;
+  parse_execute id_ill_return_program "2" "3" >>= fun x ->
+  Assert.ill_typed_return_error ~msg: "Good return type" x ;
+  parse_execute push_300 "Unit" "Unit" >>=? fun _ ->
+  parse_execute id_pbool_program "(Pair True True)" "Unit" >>=? fun _ ->
+  return ()
+
+
+let main (): unit Error_monad.tzresult Lwt.t =
+  Init.main () >>=? fun sb ->
+  let execute_code ?tc = Script.execute_code_pred ?tc sb in
+  let parse_execute ?tc code_str param_str storage_str =
+    let param = parse_param param_str in
+    let script = parse_script code_str storage_str in
+    execute_code ?tc script param >>=?? fun (ret, st, _, tc, nonce) ->
+    let contracts = Proto_alpha.Tezos_context.Contract.originated_contracts nonce in
+    return (ret, st, tc, contracts)
+  in
+  test_program parse_execute >>=? fun _x ->
+  test_example parse_execute sb >>=? fun _x ->
+  return ()
+
+
+
+
+let tests = [
+  "main", (fun _ -> main ()) ;
+]
+
+let main () =
+  Test.run "michelson." tests

test/proto_alpha_isolate/test_isolate_origination.ml

@@ -0,0 +1,106 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+let name = "Isolate Origination"
+module Logger = Logging.Make(struct let name = name end)
+let section = Lwt_log.Section.make name
+let () =
+  Lwt_log.Section.set_level section Lwt_log.Debug
+
+
+exception No_error
+
+open Isolate_helpers
+let (>>?=) = Assert.(>>?=)
+let (>>=??) = Assert.(>>=??)
+
+let test_simple_origination originate =
+  let open Proto_alpha.Error_monad in
+  let src = List.hd Account.bootstrap_accounts in
+
+  (* 0 balance should fail *)
+  originate src 0 >>= Assert.wrap >>= fun result ->
+  Assert.initial_amount_too_low ~msg: __LOC__ result ;
+
+  (* .5 Balance should fail *)
+  originate src 50 >>= Assert.wrap >>= fun result ->
+  Assert.initial_amount_too_low ~msg: __LOC__ result ;
+
+  (* 2. Balance should work *)
+  originate src 200 >>= Assert.ok >>= fun _ ->
+  return ()
+
+
+let test_delegation
+    (originate: ?tc: Proto_alpha.Tezos_context.t -> ?delegatable: bool -> 'a)
+    (delegate: ?tc: Proto_alpha.Tezos_context.t -> 'b)
+  =
+
+  let open Proto_alpha.Error_monad in
+  let account_a = List.nth Account.bootstrap_accounts 0 in
+  let account_b = List.nth Account.bootstrap_accounts 1 in
+
+  (* Delegatable should change delegate *)
+  originate
+    ~delegatable: true account_a 200
+  >>=? fun ((contracts, _errs), tc) ->
+  let contract = List.hd contracts in
+  let account_ac = {account_a with contract} in
+  delegate ~tc account_ac account_b.hpub >>= Assert.ok ~msg: __LOC__ >>= fun _ ->
+
+  (* Not-Delegatable should not change delegate *)
+  originate
+    ~delegatable: false account_a 200
+  >>=? fun ((contracts, _errs), tc) ->
+  let contract = List.hd contracts in
+  let account_a = {account_a with contract} in
+  delegate ~tc account_a account_b.hpub >>= Assert.wrap >>= fun res ->
+  Assert.non_delegatable ~msg: __LOC__ res ;
+
+  return ()
+
+
+let main (): unit Error_monad.tzresult Lwt.t =
+
+  Init.main () >>=? fun root ->
+
+  let originate ?(tc=root.tezos_context) ?baker ?spendable ?fee ?delegatable src amount =
+    let delegatable = Option.unopt ~default:true delegatable in
+    let spendable = Option.unopt ~default:true spendable in
+    let fee = Option.unopt ~default:10 fee in
+    Apply.origination_pred
+      ?baker
+      ~tc
+      ~pred: root
+      (src, amount, spendable, delegatable, fee)
+  in
+  let delegate ?(tc=root.tezos_context) ?baker ?fee src delegate =
+    let fee = Option.unopt ~default:10 fee in
+    Apply.delegation_pred
+      ?baker
+      ~tc
+      ~pred: root
+      (src, delegate, fee)
+  in
+
+  test_simple_origination originate >>=?? fun () ->
+  test_delegation
+    (originate ?fee: None ?baker: None ~spendable: true)
+    (delegate ?fee: None ?baker: None) >>=?? fun () ->
+
+  Error_monad.return ()
+
+
+let tests = [
+  "main", (fun _ -> main ()) ;
+]
+
+let main () =
+  Test.run "origination." tests

test/proto_alpha_isolate/test_isolate_transaction.ml

@@ -0,0 +1,164 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+let name = "Isolate Transactions"
+module Logger = Logging.Make(struct let name = name end)
+let section = Lwt_log.Section.make name
+let () =
+  Lwt_log.Section.set_level section Lwt_log.Warning(*.Debug*)
+open Logger
+
+module Helpers = Isolate_helpers
+open Helpers
+open Proto_alpha.Error_monad
+
+let test_cycle_transfer (pred: Helpers.Block.result) =
+  let transfer = Helpers.Apply.transaction_pred ~pred in
+  let tc = pred.tezos_context in
+  let cycle n =
+    Helpers.Account.make_accounts ~tc n >>=? fun (accounts, tc) ->
+    let pairs = List.combine accounts @@ List.shift accounts in
+    let aux tc (src, dst) =
+      transfer ~tc (src, dst, 10000, Some(10)) >>=? fun (_, tc) -> return tc
+    in
+    fold_left_s aux tc pairs >>=? fun tc ->
+    let aux (account: Helpers.Account.t) =
+      Helpers.Assert.equal_cents_balance ~tc ~msg: __LOC__ (account.contract, Helpers.Account.init_amount * 100 - 10)
+    in
+    iter_s aux accounts
+  in
+  cycle 2 >>=? fun _ ->
+  cycle 13 >>=? fun _ ->
+  cycle 50 >>=? fun _ ->
+  return ()
+
+
+
+let run (starting_block: Helpers.Block.result): unit tzresult Lwt.t =
+  let init_tc = starting_block.tezos_context in
+
+  Helpers.Account.make_2_accounts ~tc: init_tc >>=? fun ((account_a, account_b), init_tc) ->
+  Helpers.Account.make_account ~tc: init_tc >>=? fun (_baker, init_tc) ->
+  let account_unknown_foo = Helpers.Account.new_account () in
+  debug "Accounts set" ;
+
+  let transfer ?(tc=init_tc) ?fee (src, dst, amount) =
+    Helpers.Apply.transaction_pred
+      ~tc
+      ~pred: starting_block
+      (src, dst, amount, fee)
+  in
+  let originate ?(tc=init_tc) =
+    Helpers.Apply.origination_pred
+      ~tc
+      ~pred: starting_block
+  in
+
+  let init_amount = Helpers.Account.init_amount in
+
+  (* Send from a sender with no balance (never seen). *)
+  (* TODO: Is it OK to get Storage_error and not something more specific? *)
+  transfer (account_unknown_foo, account_b, 10000) >|=
+  Assert.unknown_contract ~msg: __LOC__ >>= fun _ ->
+  debug "Transfer from no balance V2" ;
+
+  (* Send 10 tz to unknown account. *)
+  transfer (account_a, account_unknown_foo, 10000) >>=
+  Assert.ok_contract >>=? fun (_, tc) ->
+  Assert.equal_cents_balance ~msg: __LOC__ ~tc (account_unknown_foo.contract, 10000) >>=? fun () ->
+  debug "Reception" ;
+
+  (* Unknown account transfers back tz. *)
+  transfer ~tc (account_unknown_foo, account_a, 9990) >>=
+  Assert.ok_contract >>=? fun _ ->
+  debug "Transfer back" ;
+
+  (* Check that a basic transfer originates no contracts. *)
+  transfer (account_a, account_b, 1000) >>=? fun ((contracts, _), _) ->
+  Assert.equal_int ~msg: __LOC__ 0 (List.length contracts) ;
+  debug "No contracts originated" ;
+
+  (* Check sender/receiver balance post transaction *)
+  transfer (account_a, account_b, 1000) >>=
+  Assert.ok_contract ~msg: __LOC__ >>=? fun (_,tc) ->
+  Proto_alpha.Tezos_context.Contract.get_balance tc account_a.contract >>=? fun _balance ->
+  Assert.equal_cents_balance ~msg: __LOC__ ~tc (account_a.contract, init_amount * 100 - 1000 - 10) >>=? fun () ->
+  Assert.equal_cents_balance ~msg: __LOC__ ~tc (account_b.contract, 1001000) >>=? fun () ->
+  debug "Transfer balances" ;
+
+  (* Check balance too low. *)
+  transfer (account_a, account_b, 10000000) >|=
+  Assert.balance_too_low ~msg: __LOC__ >>= fun _ ->
+  debug "Too low" ;
+
+  (* Check non-spendability of a non-spendable contract *)
+  (* TODO: Unspecified economic error: should be more specific. *)
+  originate (account_a, 1000, false, true, 0)
+  >>= Assert.ok_contract ~msg: __LOC__ >>=? fun ((contracts,_), tc) ->
+  Assert.equal_int (List.length contracts) 1 ;
+  let non_spendable = List.hd contracts in
+  let account = {account_a with contract = non_spendable} in
+  debug "Contract created" ;
+
+  transfer (account, account_b, 50) ~tc >>= Assert.wrap >>= fun result ->
+  Assert.non_spendable ~msg: __LOC__ result ;
+  debug "Non Spendable" ;
+
+  (* Check spendability of a spendable contract *)
+  originate (account_a, 1000, true, true, 100)
+  >>= Assert.ok_contract ~msg: __LOC__ >>=? fun ((contracts, _), spendable_tc) ->
+  Assert.equal_int (List.length contracts) 1 ;
+  let contract_spendable = List.hd contracts in
+  let account_spendable = {account_a with contract = contract_spendable} in
+  debug "Contract created" ;
+  transfer (account_spendable, account_b, 50) ~tc: spendable_tc >>= Assert.ok ~msg: __LOC__ >>=? fun _ ->
+  debug "Spendable" ;
+
+
+  (* Try spending a default account with unmatching pk/sk pairs. *)
+  let account = { account_a with ppk = account_b.ppk } in
+  transfer (account, account_b, 50)
+  >>= Assert.wrap >>= fun result ->
+  Assert.generic_economic_error ~msg: __LOC__ result ;
+  debug "Unmatching keys" ;
+
+  (* Try spending a default account with keys not matching the
+     contract pkh. *)
+  let account = {account_a with contract = account_b.contract } in
+  transfer (account, account_unknown_foo, 50)
+  >>= Assert.wrap >>= fun result ->
+  Assert.inconsistent_pkh ~msg: __LOC__ result ;
+  debug "Unmatching contract" ;
+
+  (* Try spending an originated contract without the manager's key. *)
+  let account = {account_b with contract = contract_spendable } in
+  transfer
+    ~tc: spendable_tc
+    (account, account_unknown_foo, 50)
+  >>= Assert.wrap >>= fun result ->
+  Assert.inconsistent_pkh ~msg: __LOC__ result ;
+  debug "No manager key" ;
+
+  test_cycle_transfer starting_block >>=? fun _ ->
+
+  return ()
+
+
+let main () =
+  let open Error_monad in
+  Helpers.Init.main () >>=? fun starting_block ->
+  run starting_block >>= Assert.wrap
+
+
+let tests = [
+  "main", (fun _ -> main ()) ;
+]
+
+let main () =
+  Test.run "transactions." tests

test/proto_alpha_isolate_helpers/helpers_account.ml

@@ -0,0 +1,106 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Proto_alpha.Error_monad
+open Proto_alpha.Tezos_context
+
+type account = {
+  hpub : Ed25519.Public_key_hash.t ;
+  pub :  Ed25519.Public_key.t ;
+  ppk :  Ed25519.Secret_key.t ;
+  contract : Contract.contract
+}
+type t = account
+
+let bootstrap_accounts =
+  let pubs = [
+    "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav";
+    "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9";
+    "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV";
+    "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU";
+    "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n";
+  ] in
+  let ppks = [
+    "edskRuR1azSfboG86YPTyxrQgosh5zChf5bVDmptqLTb5EuXAm9\
+     rsnDYfTKhq7rDQujdn5WWzwUMeV3agaZ6J2vPQT58jJAJPi";
+    "edskRkJz4Rw2rM5NtabEWMbbg2bF4b1nfFajaqEuEk4SgU7eeDby\
+     m9gVQtBTbYo32WUg2zb5sNBkD1whRN7zX43V9bftBbtaKc";
+    "edskS3qsqsNgdjUqeMsVcEwBn8dkZ5iDRz6aF21KhcCtRiAkWByp\
+     USbicccR4Vgqm9UdW2Vabuos6seezqgbXTrmcbLUG4rdAC";
+    "edskRg9qcPqaVQa6jXWNMU5p71tseSuR7NzozgqZ9URsVDi81wTyP\
+     JdFSBdeakobyHUi4Xgu61jgKRQvkhXrPmEdEUfiqfiJFL";
+    "edskS7rLN2Df3nbS1EYvwJbWo4umD7yPM1SUeX7gp1WhCVpMFXjcC\
+     yM58xs6xsnTsVqHQmJQ2RxoAjJGedWfvFmjQy6etA3dgZ";
+  ] in
+  let pubs = List.map Ed25519.Public_key.of_b58check_exn pubs in
+  let ppks = List.map Ed25519.Secret_key.of_b58check_exn ppks in
+  let keys = List.combine pubs ppks in
+  let aux (pub, ppk) : account =
+    let hpub = Ed25519.Public_key.hash pub in {
+      pub ;
+      ppk ;
+      hpub ;
+      contract = Contract.default_contract hpub
+    }
+  in List.map aux keys
+
+let new_account () : account =
+  let (hpub, pub, ppk) = Ed25519.generate_key () in
+  let contract = Contract.default_contract hpub in
+  {hpub ; pub ; ppk ; contract}
+
+let init_amount = 10000
+
+let init_account ~(tc : context) account =
+  Contract.credit
+    tc
+    account.contract
+  @@ Helpers_cast.tez_of_int init_amount
+  >>=? fun context -> return (account, context)
+
+let make_account ~(tc : context) =
+  let account = new_account () in
+  init_account ~tc account
+
+let make_accounts ~(tc : context) n =
+  let rec aux tc n acc =
+    if (n = 0) then
+      return (acc, tc)
+    else
+      make_account ~tc >>=? fun (account, tc) ->
+      aux tc (n - 1) @@ account :: acc
+  in
+  aux tc n []
+
+let make_2_accounts ~(tc : context) =
+  make_account ~tc >>=? fun (src, tc) ->
+  make_account ~tc >>=? fun (dst, tc) ->
+  return ((src, dst), tc)
+
+let make_4_accounts ~(tc : context) =
+  make_account ~tc >>=? fun (a, tc) ->
+  make_account ~tc >>=? fun (b, tc) ->
+  make_account ~tc >>=? fun (c, tc) ->
+  make_account ~tc >>=? fun (d, tc) ->
+  return ((a, b, c, d), tc)
+
+let display_account ~tc account =
+  Contract.get_balance tc account.contract >>= function
+  | Ok balance -> (
+      Helpers_logger.lwt_debug
+        "Account %a : (%a tz)"
+        Ed25519.Public_key_hash.pp account.hpub
+        Tez.pp balance
+    )| Error _ -> Helpers_logger.lwt_debug "Error in balance"
+
+let display_accounts ~tc accounts =
+  Helpers_logger.lwt_debug "Got accounts" >>= fun () ->
+  Lwt_list.iter_s (display_account ~tc) accounts
+

test/proto_alpha_isolate_helpers/helpers_account.mli

@@ -0,0 +1,63 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Proto_alpha.Tezos_context
+
+(** Facilities to deal with accounts , bootstrap accounts and make new
+    accounts *)
+
+(** Explicit account type *)
+type account = {
+  hpub : Ed25519.Public_key_hash.t;
+  pub : Ed25519.Public_key.t;
+  ppk : Ed25519.Secret_key.t;
+  contract :
+    Contract.contract;
+}
+type t = account
+
+(** Bootstrap accounts of the sandbox *)
+val bootstrap_accounts : account list
+
+(** Generates a new (pub , ppk) pair and the associated default_contract *)
+val new_account : unit -> account
+
+(** Amount of cents in a new account *)
+val init_amount : int
+
+(** Credits a new account *)
+val init_account :
+  tc:context -> account ->
+  (account * context) Proto_alpha.tzresult Lwt.t
+
+(** Generates a new account and credits it *)
+val make_account :
+  tc:context ->
+  (account * context) Proto_alpha.tzresult Lwt.t
+
+(** Generates a list of new accounts and credits them *)
+val make_accounts :
+  tc:context -> int ->
+  (account list * context) Proto_alpha.tzresult Lwt.t
+
+(** Better typed "make_accounts tc 2" *)
+val make_2_accounts :
+  tc:context ->
+  ((account * account) * context) Proto_alpha.tzresult Lwt.t
+
+(** Better typed "make_accounts tc 4" *)
+val make_4_accounts :
+  tc:context ->
+  ((t * t * t * t) * context) Proto_alpha.tzresult Lwt.t
+
+(** Debug : Displays an account and its balance *)
+val display_account : tc:context -> account -> unit Lwt.t
+
+(** Debug : Displays several accounts and their balances *)
+val display_accounts : tc:context -> account list -> unit Lwt.t

test/proto_alpha_isolate_helpers/helpers_apply.ml

@@ -0,0 +1,88 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Proto_alpha.Error_monad
+
+let operation
+    ~tc ?(baker: Helpers_account.t option) ?(src: Helpers_account.t option)
+    pred_block_hash op_sh proto_op =
+  return @@ Helpers_operation.apply_of_proto src op_sh proto_op >>=? fun operation ->
+  Proto_alpha.Apply.apply_operation
+    tc
+    (Option.map ~f:(fun x -> x.Helpers_account.contract) baker)
+    pred_block_hash
+    0
+    operation >>=? fun (tc, contracts, err) -> return ((contracts, err), tc)
+
+
+let transaction ~tc ?(fee = 0) ?baker
+    pbh opsh src (dst: Helpers_account.t)
+    amount =
+  Helpers_operation.transaction_full
+    src dst.contract
+    (Helpers_cast.cents_of_int amount)
+    ~fee: (Helpers_cast.cents_of_int fee)
+  @@ Helpers_cast.ctxt_of_tc tc
+  >>=? fun protop ->
+  operation ~tc ?baker ~src pbh opsh protop
+
+
+let transaction_pred ?tc ~(pred: Helpers_block.result) ?baker (src, dst, amount, fee) =
+  let tc = Option.unopt ~default:pred.tezos_context tc in
+  let fee = Option.unopt ~default:10 fee in
+  transaction ~tc ~fee ?baker pred.hash (Helpers_block.get_op_header_res pred) src dst amount
+
+
+let script_origination
+    ~tc pbh opsh script src amount =
+  Helpers_operation.script_origination_full
+    script src (Helpers_cast.cents_of_int amount) @@ Helpers_cast.ctxt_of_tc tc
+  >>=? fun protop -> operation ~tc ?baker: None ~src pbh opsh protop
+
+
+let origination
+    ~tc ?baker ?(spendable = true) ?(fee = 0) ?(delegatable = true)
+    pbh opsh src amount =
+  Helpers_operation.origination_full
+    src ~spendable ~delegatable
+    (Helpers_cast.cents_of_int amount) ~fee:(Helpers_cast.tez_of_int fee)
+  @@ Helpers_cast.ctxt_of_tc tc
+  >>=? fun protop ->
+  operation ~tc ?baker ~src pbh opsh protop
+
+
+let script_origination_pred
+    ?tc ~(pred: Helpers_block.result) (script, src, amount) =
+  let tc = Option.unopt ~default:pred.tezos_context tc in
+  script_origination ~tc pred.hash (Helpers_block.get_op_header_res pred) (Some script) src amount
+
+
+let origination_pred
+    ?tc ?baker ~(pred: Helpers_block.result) (src, amount, spendable, delegatable, fee) =
+  let tc = Option.unopt ~default:pred.tezos_context tc in
+  origination ~tc ?baker ~spendable ~fee ~delegatable
+    pred.hash
+    (Helpers_block.get_op_header_res pred)
+    src amount
+
+
+let delegation ~tc ?baker ?(fee = 0) pbh opsh src delegate =
+  Helpers_operation.delegation_full
+    src delegate ~fee:(Helpers_cast.cents_of_int fee)
+  @@ Helpers_cast.ctxt_of_tc tc
+  >>=? fun protop ->
+  operation ~tc ?baker ~src pbh opsh protop
+
+
+let delegation_pred
+    ?tc ?baker ~(pred: Helpers_block.result) (src, delegate, fee) =
+  let tc = Option.unopt ~default:pred.tezos_context tc in
+  delegation ~tc ?baker ~fee pred.hash (Helpers_block.get_op_header_res pred) src delegate
+
+

test/proto_alpha_isolate_helpers/helpers_apply.mli

@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Functions to build and apply operations *)
+
+open Proto_alpha.Tezos_context
+
+val operation :
+  tc:context -> ?baker:Helpers_account.t -> ?src:Helpers_account.t ->
+  Block_hash.t -> Tezos_base.Operation.shell_header -> proto_operation ->
+  ((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
+
+val transaction :
+  tc:context -> ?fee:int -> ?baker:Helpers_account.t -> Block_hash.t ->
+  Tezos_base.Operation.shell_header -> Helpers_account.t -> Helpers_account.t -> int ->
+  ((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
+
+val transaction_pred :
+  ?tc:t -> pred:Helpers_block.result -> ?baker:Helpers_account.t ->
+  Helpers_account.t * Helpers_account.t * int * int option ->
+  ((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
+
+val script_origination :
+  tc:context -> Block_hash.t -> Tezos_base.Operation.shell_header ->
+  Script.t option -> Helpers_account.t -> int ->
+  ((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
+
+val origination :
+  tc:context -> ?baker:Helpers_account.t -> ?spendable:bool -> ?fee:int ->
+  ?delegatable:bool -> Block_hash.t -> Tezos_base.Operation.shell_header ->
+  Helpers_account.t -> int ->
+  ((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
+
+val script_origination_pred :
+  ?tc:t -> pred:Helpers_block.result -> Script.t * Helpers_account.t * int ->
+  ((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
+
+val origination_pred :
+  ?tc:t -> ?baker:Helpers_account.t -> pred:Helpers_block.result ->
+  Helpers_account.t * int * bool * bool * int ->
+  ((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
+
+val delegation :
+  tc:context -> ?baker:Helpers_account.t -> ?fee:int -> Block_hash.t ->
+  Tezos_base.Operation.shell_header -> Helpers_account.t -> public_key_hash ->
+  ((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
+
+val delegation_pred :
+  ?tc:t -> ?baker:Helpers_account.t -> pred:Helpers_block.result ->
+  Helpers_account.t * public_key_hash * int ->
+  ((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t

test/proto_alpha_isolate_helpers/helpers_assert.ml

@@ -0,0 +1,199 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include Assert
+
+open Proto_alpha.Tezos_context
+
+let wrap_result = Proto_alpha.Environment.wrap_error
+
+let wrap = fun x -> Lwt.return @@ wrap_result x
+
+let (>>=??) x y = x >>= wrap >>=? y
+
+let (>>??) x y = wrap_result x >>? y
+
+let (>>?=) x y = x >>= wrap >>= y
+
+open Proto_alpha.Error_monad
+
+let tmp_map f lst =
+  let rec aux acc = function
+    | [] -> ok acc
+    | hd :: tl ->
+        f hd >>? fun fhd -> (aux (fhd :: acc) tl)
+  in
+  aux [] lst
+
+
+let ok ?msg = function
+  | Ok x -> return x
+  | Error errs ->
+      Helpers_logger.log_error "Error : %a" pp @@ List.hd errs ;
+      Assert.is_true ~msg:(Option.unopt ~default:"not ok" msg) false ;
+      fail @@ List.hd errs
+
+
+let ok_contract ?msg x =
+  ok x >>=? fun (((_, errs), _) as x) ->
+  Assert.is_none ?msg errs ;
+  return x
+
+
+exception No_error
+
+let no_error ?msg = function
+  | Ok x -> x
+  | Error _ ->
+      Assert.is_true
+        ~msg: (Option.unopt ~default:"yes error" msg)
+        false ;
+      raise No_error
+
+
+let equal_pkh ?msg pkh1 pkh2 =
+  let msg = Assert.format_msg msg in
+  let eq pkh1 pkh2 =
+    match pkh1, pkh2 with
+    | None, None -> true
+    | Some pkh1, Some pkh2 ->
+        Ed25519.Public_key_hash.equal pkh1 pkh2
+    | _ -> false in
+  let prn = function
+    | None -> "none"
+    | Some pkh -> Ed25519.Public_key_hash.to_hex pkh in
+  Assert.equal ?msg ~prn ~eq pkh1 pkh2
+
+let equal_int64 ?msg =
+  Assert.equal
+    ~eq: Int64.equal
+    ~prn: Int64.to_string
+    ~msg: (Option.unopt ~default:"int64_equal" msg)
+
+
+let equal_int ?msg =
+  Assert.equal
+    ~eq: (=)
+    ~prn: string_of_int
+    ~msg: (Option.unopt ~default:"int_equal" msg)
+
+
+
+let equal_tez ?msg =
+  Assert.equal
+    ~eq: Tez .(=)
+    ~prn: Tez.to_string
+    ~msg: (Option.unopt ~default:"tez_equal" msg)
+
+
+let equal_balance ~tc ?msg (contract, expected_balance) =
+  Contract.get_balance tc contract >>=? fun balance ->
+  return @@
+  equal_tez
+    expected_balance balance
+    ~msg: (Option.unopt ~default:"balance_equal" msg)
+
+
+let equal_cents_balance ~tc ?msg (contract, cents_balance) =
+  equal_balance
+    ~tc
+    ~msg: (Option.unopt ~default:"equal_cents_balance" msg)
+    (contract, Helpers_cast.cents_of_int cents_balance)
+
+
+let ecoproto_error f = function
+  | Proto_alpha.Environment.Ecoproto_error errors ->
+      List.exists f errors
+  | _ -> false
+
+
+let generic_economic_error ~msg =
+  Assert.contain_error ~msg ~f: (ecoproto_error (fun _ -> true))
+
+let economic_error ~msg f =
+  Assert.contain_error ~msg ~f: (ecoproto_error f)
+
+let ill_typed_data_error ~msg =
+  let aux = function
+    | Proto_alpha.Script_ir_translator.Ill_typed_data _ -> true
+    | _ -> false in
+  economic_error ~msg aux
+
+let ill_typed_return_error ~msg =
+  let aux = function
+    | Proto_alpha.Script_ir_translator.Bad_return _ -> true
+    | _ -> false in
+  economic_error ~msg aux
+
+let double_endorsement ~msg =
+  let aux = function
+    | Proto_alpha.Apply.Duplicate_endorsement(_) -> true
+    | _ -> false
+  in
+  economic_error ~msg aux
+
+let contain_error_alpha ?msg ~f = function
+  | Ok _ -> ()
+  | Error errs ->
+      if (not @@ List.exists f errs)
+      then Assert.is_true
+          ~msg:(Option.unopt ~default:"yes error" msg) false
+
+
+let unknown_contract ~msg =
+  let f = function
+    | Proto_alpha.Raw_context.Storage_error _ -> true
+    | _ -> false
+  in
+  contain_error_alpha ~msg ~f
+
+
+let non_existing_contract ~msg =
+  contain_error_alpha ~msg ~f: (function
+      | Proto_alpha.Contract_storage.Non_existing_contract _ -> true
+      | _ -> false)
+
+
+let balance_too_low ~msg =
+  contain_error_alpha ~msg ~f: (function
+      | Contract.Balance_too_low _ -> true
+      | _ -> false)
+
+
+let non_spendable ~msg =
+  Assert.contain_error ~msg ~f: begin ecoproto_error (function
+      | Proto_alpha.Contract_storage.Unspendable_contract _ -> true
+      | error ->
+          Helpers_logger.debug "Actual error: %a" pp error ;
+          false)
+  end
+
+let inconsistent_pkh ~msg =
+  Assert.contain_error ~msg ~f: begin ecoproto_error (function
+      | Proto_alpha.Contract_storage.Inconsistent_hash _ -> true
+      | _ -> false)
+  end
+
+let initial_amount_too_low ~msg =
+  Assert.contain_error ~msg ~f: begin ecoproto_error (function
+      | Contract.Initial_amount_too_low _ -> true
+      | _ -> false)
+  end
+
+let non_delegatable ~msg =
+  Assert.contain_error ~msg ~f: begin ecoproto_error (function
+      | Proto_alpha.Contract_storage.Non_delegatable_contract _ -> true
+      | _ -> false)
+  end
+
+let wrong_delegate ~msg =
+  Assert.contain_error ~msg ~f: begin ecoproto_error (function
+      | Proto_alpha.Baking.Wrong_delegate _ -> true
+      | _ -> false)
+  end

test/proto_alpha_isolate_helpers/helpers_assert.mli

@@ -0,0 +1,81 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Proto_alpha.Tezos_context
+
+include module type of Assert
+
+(** Functions capturing common assertion scenarios and error monads helpers *)
+
+(** Converts a tzresult from the Environment's error monad to a tzresult of the
+    top level error monad *)
+val wrap_result : 'a Proto_alpha.tzresult -> 'a tzresult
+
+(** Converts a tzresult Lwt.t from the Environment's error monad to a tzresult Lwt.t
+    of the top level error monad *)
+val wrap : 'a Proto_alpha.tzresult -> 'a tzresult Lwt.t
+
+(** Binds a top level error monad function with an Environment's error monad
+    tzresult Lwt.t *)
+val ( >>=?? ) :
+  'a Proto_alpha.tzresult Lwt.t -> ('a -> 'b tzresult Lwt.t) -> 'b tzresult Lwt.t
+
+(** Binds a top level error monad function with an Environment's error monad
+    tzresult *)
+val ( >>?? ) : 'a Proto_alpha.tzresult -> ('a -> 'b tzresult) -> 'b tzresult
+
+(** Partially binds a top level error monad function with an Environment's
+    error monad tzresult *)
+val ( >>?= ) : 'a Proto_alpha.tzresult Lwt.t -> ('a tzresult -> 'b Lwt.t) -> 'b Lwt.t
+
+val tmp_map : ('a -> 'b Proto_alpha.tzresult) -> 'a list -> 'b list Proto_alpha.tzresult
+
+val ok : ?msg:string -> 'a Proto_alpha.tzresult -> 'a Proto_alpha.tzresult Lwt.t
+
+val ok_contract : ?msg:string ->
+  (('a * 'b option) * 'c) Proto_alpha.tzresult ->
+  (('a * 'b option) * 'c) Proto_alpha.tzresult Lwt.t
+
+exception No_error
+
+val no_error : ?msg:string -> ('a, 'b) result -> 'a
+val equal_pkh :
+  ?msg:string -> Ed25519.Public_key_hash.t option ->
+  Ed25519.Public_key_hash.t option -> unit
+val equal_int64 : ?msg:string -> Int64.t -> Int64.t -> unit
+val equal_int : ?msg:string -> int -> int -> unit
+val equal_tez : ?msg:string -> Tez.t -> Tez.t -> unit
+val equal_balance :
+  tc:context -> ?msg:string ->
+  Contract.contract * Tez.t ->
+  unit Proto_alpha.tzresult Lwt.t
+val equal_cents_balance :
+  tc:context -> ?msg:string ->
+  Contract.contract * int ->
+  unit Proto_alpha.tzresult Lwt.t
+val ecoproto_error :
+  (Proto_alpha.error -> bool) -> Error_monad.error -> bool
+
+val generic_economic_error : msg:string -> 'a tzresult -> unit
+val economic_error :
+  msg:string -> (Proto_alpha.error -> bool) -> 'a tzresult -> unit
+val ill_typed_data_error : msg:string -> 'a tzresult -> unit
+val ill_typed_return_error : msg:string -> 'a tzresult -> unit
+val double_endorsement : msg:string -> 'a tzresult -> unit
+val contain_error_alpha :
+  ?msg:string -> f:('a -> bool) -> ('b, 'a list) result -> unit
+val unknown_contract : msg:string -> 'a Proto_alpha.tzresult -> unit
+val non_existing_contract : msg:string -> 'a Proto_alpha.tzresult -> unit
+val balance_too_low : msg:string -> 'a Proto_alpha.tzresult -> unit
+val non_spendable : msg:string -> 'a tzresult -> unit
+val inconsistent_pkh : msg:string -> 'a tzresult -> unit
+val initial_amount_too_low : msg:string -> 'a tzresult -> unit
+val non_delegatable : msg:string -> 'a tzresult -> unit
+val wrong_delegate : msg:string -> 'a tzresult -> unit
+

test/proto_alpha_isolate_helpers/helpers_block.ml

@@ -0,0 +1,188 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Proto_alpha.Error_monad
+
+type shell_header = Block_header.shell_header
+type tezos_header = Block_header.t
+type protocol_header = Proto_alpha.Tezos_context.Block_header.proto_header
+type operation_header = Operation.shell_header
+
+type init_block = {
+  pred_block_hash : Block_hash.t ;
+  pred_shell_header : shell_header ;
+  proto_header : protocol_header ;
+  op_header : operation_header ;
+  sourced_operations : (Proto_alpha.Main.operation * Helpers_account.t) list ;
+  operation_hashs : Operation_hash.t list ;
+  proto_header_bytes : MBytes.t ;
+  timestamp : Time.t ;
+  level : Int32.t ;
+  context : Tezos_storage.Context.t
+}
+
+type result = {
+  tezos_header : tezos_header ;
+  hash : Block_hash.t ;
+  level : Int32.t ;
+  validation : Tezos_protocol_updater.Updater.validation_result ;
+  tezos_context : Proto_alpha.Tezos_context.t
+}
+
+let get_op_header_res (res : result) : operation_header = {
+  branch = res.hash
+}
+
+let get_proto_header priority : protocol_header = {
+  priority ;
+  proof_of_work_nonce = Helpers_sodium.generate_proof_of_work_nonce ();
+  seed_nonce_hash = Proto_alpha.Tezos_context.Nonce.hash @@ Helpers_sodium.generate_seed_nonce ()
+}
+
+let get_op_header pbh : operation_header = {
+  branch = pbh
+}
+
+
+let make_sourced_operation op_header (proto_operation, source) =
+  Helpers_operation.main_of_proto source op_header proto_operation >>? fun (a, b) ->
+  ok ((a, source), b)
+
+
+let init (pred_shell_header : shell_header) pred_block_hash
+    level priority src_protops context =
+  let op_header : operation_header =
+    get_op_header pred_block_hash in
+  Helpers_assert.tmp_map (make_sourced_operation op_header) src_protops >>? fun src_ops_hashs ->
+  let (sourced_operations, operation_hashs) = List.split src_ops_hashs in
+  let proto_header = get_proto_header priority in
+  let proto_header_bytes =
+    Proto_alpha.Tezos_context.Block_header.forge_unsigned_proto_header
+      proto_header
+  in
+  let timestamp =
+    Time.add
+      pred_shell_header.timestamp
+    @@ Int64.mul 60L @@ Int64.of_int (priority + 1)
+  in
+  ok {
+    pred_block_hash ;
+    pred_shell_header ;
+    proto_header ;
+    op_header ;
+    proto_header_bytes ;
+    sourced_operations ;
+    operation_hashs ;
+    timestamp ;
+    level ;
+    context
+  }
+
+
+let init_of_result ?(priority = 15) ~(res : result) ~ops =
+  init
+    res.tezos_header.shell
+    res.hash
+    res.level
+    priority
+    ops
+    res.validation.context
+
+
+let get_level opt_msg =
+  let msg = Option.unopt ~default: "level 1" opt_msg in
+  let parts = String.split_on_char ',' msg in
+  let level_part = List.hd parts in
+  let parts = String.split_on_char ' ' level_part in
+  let level_str = List.nth parts 1 in
+  Int32.of_int @@ int_of_string level_str
+
+
+let get_header_hash
+    (init_block : init_block)
+    (validation_result : Tezos_protocol_updater.Updater.validation_result)
+  : result tzresult Lwt.t
+  =
+  let op_hashs = init_block.operation_hashs in
+  let hash = Operation_list_list_hash.compute
+      [Operation_list_hash.compute op_hashs] in
+  let level = Int32.succ init_block.pred_shell_header.level in
+  let timestamp = init_block.timestamp in
+  let shell_header = {
+    init_block.pred_shell_header with
+    level ;
+    predecessor = init_block.pred_block_hash ;
+    operations_hash = hash ;
+    timestamp ;
+    fitness = validation_result.fitness
+  } in
+  let tezos_header : tezos_header = {
+    shell = shell_header ;
+    proto = init_block.proto_header_bytes
+  } in
+  Proto_alpha.Tezos_context.init
+    validation_result.context
+    ~level
+    ~timestamp
+    ~fitness: validation_result.fitness
+  >>=? fun tezos_context ->
+  let hash = Block_header.hash tezos_header in
+  return {
+    tezos_header ;
+    hash ;
+    validation = validation_result ;
+    level ;
+    tezos_context
+  }
+
+
+let begin_construction_pre (init_block: init_block) =
+  Proto_alpha.Main.begin_construction
+    ~predecessor_context: init_block.context
+    ~predecessor_timestamp: init_block.pred_shell_header.timestamp
+    ~predecessor_level: init_block.level
+    ~predecessor_fitness: init_block.pred_shell_header.fitness
+    ~predecessor: init_block.pred_block_hash
+    ~timestamp: init_block.timestamp
+    ~proto_header: init_block.proto_header_bytes
+    ()
+
+
+let make init_block =
+  let (operations,_) = List.split init_block.sourced_operations in
+  begin_construction_pre init_block >>=? fun vs ->
+  Proto_alpha.Error_monad.fold_left_s
+    Main.apply_operation
+    vs
+    operations
+  >>=? Main.finalize_block >>=? get_header_hash init_block
+
+
+let make_init psh pbh lvl prio ops ctxt =
+  Lwt.return @@ init psh pbh lvl prio ops ctxt >>=? make
+
+
+let of_res ?priority ?(ops =[]) ~(res: result) () =
+  Lwt.return @@ init_of_result ?priority ~res ~ops >>=? make
+
+
+let endorsement
+    psh pbh level priority src ctxt slot =
+  make_init
+    psh pbh level priority
+    [Helpers_operation.endorsement_full src pbh ~slot, src]
+    ctxt
+
+
+let endorsement_of_res (pred: result) (src: Helpers_account.t) slot =
+  of_res ~ops: [Helpers_operation.endorsement_full src pred.hash ~slot, src]
+
+
+let empty psh pbh level prio ctxt =
+  make_init psh pbh level prio [] ctxt

test/proto_alpha_isolate_helpers/helpers_block.mli

@@ -0,0 +1,81 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Representation of blocks independent from the State module *)
+
+type shell_header = Block_header.shell_header
+type tezos_header = Block_header.t
+type protocol_header = Tezos_context.Block_header.proto_header
+type operation_header = Operation.shell_header
+
+(** Block before application *)
+type init_block = {
+  pred_block_hash : Block_hash.t;
+  pred_shell_header : shell_header;
+  proto_header : protocol_header;
+  op_header : operation_header;
+  sourced_operations :
+    (Main.operation * Helpers_account.t) list;
+  operation_hashs : Operation_hash.t list;
+  proto_header_bytes : MBytes.t;
+  timestamp : Time.t;
+  level : Int32.t;
+  context : Tezos_storage.Context.t;
+}
+
+(** Result of the application of a block *)
+type result = {
+  tezos_header : tezos_header;
+  hash : Block_hash.t;
+  level : Int32.t;
+  validation : Tezos_protocol_updater.Updater.validation_result;
+  tezos_context : Tezos_context.t;
+}
+val get_op_header_res : result -> operation_header
+val get_proto_header : int -> protocol_header
+val get_op_header : Block_hash.t -> operation_header
+val make_sourced_operation :
+  Operation.shell_header ->
+  Tezos_context.proto_operation *
+  Helpers_account.t ->
+  ((Proto_alpha.Main.operation * Helpers_account.t) * Operation_hash.t) Proto_alpha.Error_monad.tzresult
+val init :
+  shell_header -> Block_hash.t -> Int32.t -> int ->
+  (Tezos_context.proto_operation * Helpers_account.t) list ->
+  Tezos_storage.Context.t -> init_block Proto_alpha.Error_monad.tzresult
+val init_of_result :
+  ?priority:int -> res:result ->
+  ops:(Tezos_context.proto_operation * Helpers_account.t) list ->
+  init_block Proto_alpha.Error_monad.tzresult
+val get_level : string option -> int32
+val get_header_hash :
+  init_block -> Tezos_protocol_updater.Updater.validation_result ->
+  result Proto_alpha.Error_monad.tzresult Lwt.t
+val begin_construction_pre :
+  init_block -> Main.validation_state Proto_alpha.Error_monad.tzresult Lwt.t
+val make : init_block -> result Proto_alpha.Error_monad.tzresult Lwt.t
+val make_init :
+  shell_header -> Block_hash.t -> Int32.t -> int ->
+  (Tezos_context.proto_operation * Helpers_account.t) list ->
+  Tezos_storage.Context.t -> result Proto_alpha.Error_monad.tzresult Lwt.t
+val of_res :
+  ?priority:int ->
+  ?ops:(Tezos_context.proto_operation * Helpers_account.t) list ->
+  res:result ->
+  unit -> result Proto_alpha.Error_monad.tzresult Lwt.t
+val endorsement :
+  shell_header -> Block_hash.t -> Int32.t -> int ->
+  Helpers_account.t -> Tezos_storage.Context.t -> int ->
+  result Proto_alpha.Error_monad.tzresult Lwt.t
+val endorsement_of_res :
+  result -> Helpers_account.t -> int -> ?priority:int -> res:result ->
+  unit -> result Proto_alpha.Error_monad.tzresult Lwt.t
+val empty :
+  shell_header -> Block_hash.t -> Int32.t -> int ->
+  Tezos_storage.Context.t -> result Proto_alpha.Error_monad.tzresult Lwt.t

test/proto_alpha_isolate_helpers/helpers_cast.ml

@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Proto_alpha.Tezos_context
+
+exception Tez_error
+
+let tez_of_int x = Option.unopt_exn Tez_error @@ (
+    match (Tez.( *?) Tez.one (Int64.of_int x)) with
+    | Error _ -> None
+    | Ok x -> Some x
+  )
+
+let cents_of_int x = Option.unopt_exn Tez_error @@ (
+    match (Tez.( *?) Tez.one_cent (Int64.of_int x)) with
+    | Error _ -> None
+    | Ok x -> Some x
+  )
+
+let tez_add x y = match Tez.(+?) x y with
+  | Ok x -> x
+  | Error _ -> raise Tez_error
+
+
+let tez_add_int x y = tez_add x @@ tez_of_int y
+
+let tez_sub x y = match Tez.(-?) x y with
+  | Ok x -> x
+  | Error _ -> raise Tez_error
+
+
+let tez_sub_int x y = tez_add x @@ tez_of_int y
+
+let ctxt_of_tc tc = (finalize tc).context

test/proto_alpha_isolate_helpers/helpers_cast.mli

@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Proto_alpha.Tezos_context
+
+exception Tez_error
+
+(** Common casts between Tezos_context types *)
+
+val tez_of_int : int -> Tez.tez
+val cents_of_int : int -> Tez.tez
+
+(** Tez.(+?) with a top - level error instead *)
+val tez_add : Tez.tez -> Tez.tez -> Tez.tez
+val tez_add_int : Tez.tez -> int -> Tez.tez
+
+(** Tez.(-?) with a top - level error instead *)
+val tez_sub : Tez.tez -> Tez.tez -> Tez.tez
+val tez_sub_int : Tez.tez -> int -> Tez.tez
+val ctxt_of_tc : context -> Tezos_storage.Context.t
+

test/proto_alpha_isolate_helpers/helpers_constants.ml

@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Tezos_shell
+
+let genesis : State.Net.genesis = {
+  time =
+    Time.of_notation_exn "2017-09-22T00:00:00Z" ;
+  block =
+    Block_hash.of_b58check_exn
+      "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" ;
+  protocol =
+    Protocol_hash.of_b58check_exn
+      "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im" ;
+}
+
+let alpha_hash : Tezos_base.TzPervasives.Protocol_hash.t =
+  Protocol_hash.of_b58check_exn
+    "ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK"
+
+let test_folder =
+  let home = Sys.getenv "HOME" in
+  Filename.concat home ".tezos-test"
+
+let store_root = Filename.concat test_folder "store"
+let context_root = Filename.concat test_folder "context"

test/proto_alpha_isolate_helpers/helpers_constants.mli

@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Constants used for testing *)
+
+val genesis : Tezos_shell.State.Net.genesis
+val alpha_hash : Protocol_hash.t
+
+(** Folder in which the temporary files for testing are put *)
+val test_folder : string
+
+val store_root : string
+val context_root : string

test/proto_alpha_isolate_helpers/helpers_init.ml

@@ -0,0 +1,123 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Tezos_shell
+open Helpers_logger
+
+let previous_gs = ref None
+
+let cleanup () =
+  ignore @@ Sys.command @@ "rm -rf " ^ Helpers_constants.test_folder
+
+let get_global_state () =
+  match !previous_gs with
+  | Some gs ->
+      State.Net.all gs >>= fun ls ->
+      Lwt_list.iter_p (State.Net.destroy gs) ls >>= fun () ->
+      return gs
+  | None ->
+      Lwt.catch (
+        fun () ->
+          State.read
+            ~store_root: Helpers_constants.store_root
+            ~context_root: Helpers_constants.context_root
+            () >>= function
+          | Ok init_state -> (
+              previous_gs := Some init_state ;
+              Lwt.return @@ Ok init_state
+            )| Error errors -> (
+              lwt_warn "Errors !" >>= fun () ->
+              lwt_warn "Error when building global state ...%a" pp_print_error errors >>= fun () ->
+              Lwt.return @@ Error errors
+            )
+      ) (function
+          | e -> Logger.lwt_warn "Error !" >>= fun () ->
+              Lwt.fail e
+        )
+
+let get_activation_block baker context_hash head =
+  let open Tezos_embedded_raw_protocol_genesis in
+  State.Block.context head >>= fun context ->
+  Data.Pubkey.set_pubkey context baker.Helpers_account.pub >>= fun context ->
+  let shell_header =
+    Helpers_misc.get_block_header
+      head
+      Helpers_misc.no_ops_hash
+      (State.Block.fitness head)
+      context_hash
+      (Time.now ())
+  in
+  let fitness =
+    Tezos_embedded_raw_protocol_alpha.Fitness_repr.from_int64 100L in
+  let command: Data.Command.t =
+    Data.Command.Activate({protocol = Helpers_constants.alpha_hash ; validation_passes = 0 ; fitness}) in
+  let content_bytes = Data.Command.forge shell_header command in
+  let signature = Ed25519.sign baker.ppk content_bytes in
+  let proto = (command , signature) in
+  let proto_bytes =
+    Data_encoding.Binary.to_bytes
+      Data.Command.signed_encoding
+      proto in
+  let raw_block: Block_header.t = {
+    shell = shell_header ;
+    proto = proto_bytes
+  } in
+  return (context , raw_block)
+
+let get_alpha () =
+  get_global_state () >>=? fun global_state ->
+  State.Net.create global_state Helpers_constants.genesis >>= fun state ->
+  Tezos_shell.Chain.head state >>= fun head ->
+  let baker = Helpers_account.new_account () in
+  let rec attempt context_hash =
+    begin
+      get_activation_block baker context_hash head >>=? fun (context , raw_block) ->
+      Tezos_storage.Context.get_protocol context >>= fun protocol_hash ->
+      let (module Protocol) = Helpers_misc.get_protocol protocol_hash in
+      Protocol.begin_application
+        ~predecessor_context: context
+        ~predecessor_timestamp: (State.Block.timestamp head)
+        ~predecessor_fitness: (State.Block.fitness head)
+        raw_block
+      >>=? fun app ->
+      Protocol.finalize_block app >>=? fun result ->
+      State.Block.store state raw_block [[]] result >>=? fun opt_block ->
+      return (opt_block , result)
+    end >>= function
+    | Ok v -> return v
+    | Error [ State.Block.Inconsistent_hash (got , _) ] ->
+        attempt got
+    | Error err ->
+        Error_monad.pp_print_error Format.err_formatter err ;
+        Lwt.return (Error err) in
+  attempt Context_hash.zero >>=? fun (opt_block , result) ->
+  Error_monad.protect (fun () -> return (Option.unopt_exn (Failure "get_alpha") opt_block)) >>=? fun block ->
+  Tezos_shell.Chain.set_head state block >>= fun _ ->
+  return (global_state , state , result)
+
+let get_sandbox () =
+  Data_encoding_ezjsonm.read_file "test/proto_alpha/sandbox.json" >>= fun x ->
+  Lwt.return @@ Helpers_assert.no_error ~msg:__LOC__ x
+
+open Helpers_assert
+
+let main () =
+  cleanup () ;
+  ignore @@ Unix.mkdir Helpers_constants.test_folder 0o777 ;
+  ignore @@ Unix.mkdir Helpers_constants.store_root 0o777 ;
+  get_alpha () >>=? fun (_gs, s, r) ->
+  let context = r.context in
+  Tezos_shell.Chain.head s >>= fun head ->
+  let hash = State.Block.hash head in
+  let block_shell_header = State.Block.shell_header head in
+  get_sandbox () >>= fun json ->
+  Main.configure_sandbox context @@ Some json >>=?? fun context ->
+  Helpers_block.empty block_shell_header hash Int32.zero 0 context >>= Helpers_assert.wrap
+
+let () = at_exit cleanup

test/proto_alpha_isolate_helpers/helpers_init.mli

@@ -0,0 +1,12 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Functions used to build the first tezos_context and first block *)
+
+val main : unit -> Helpers_block.result tzresult Lwt.t

test/proto_alpha_isolate_helpers/helpers_logger.ml

@@ -0,0 +1,16 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions , Inc.< contact@tezos.com >                *)
+(*                                                                        *)
+(*    All rights reserved.No warranty , explicit or implicit , provided.  *)
+(*                                                                        *)
+(**************************************************************************)
+
+let name = "Isolate Helpers"
+module Logger = Logging.Make(struct let name = name end)
+let section = Lwt_log.Section.make name
+let () =
+  Lwt_log.Section.set_level section Lwt_log.Debug
+
+include Logger

test/proto_alpha_isolate_helpers/helpers_logger.mli

@@ -0,0 +1,12 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions , Inc.< contact@tezos.com >                *)
+(*                                                                        *)
+(*    All rights reserved.No warranty , explicit or implicit , provided.  *)
+(*                                                                        *)
+(**************************************************************************)
+
+val name : string
+module Logger : Logging.LOG
+include Logging.LOG

test/proto_alpha_isolate_helpers/helpers_misc.ml

@@ -0,0 +1,78 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Tezos_shell
+
+exception Unknown_protocol
+
+let no_ops_hash =
+  Operation_list_list_hash.compute
+    [Operation_list_hash.empty]
+
+
+let get_protocol hash : (module State.Registred_protocol.T) =
+  let (module Protocol): (module State.Registred_protocol.T) =
+    Option.unopt_exn
+      Unknown_protocol
+    @@ State.Registred_protocol.get hash
+  in
+  (module Protocol)
+
+
+let get_shell_header head =
+  let shell_header : Operation.shell_header = {
+    branch = State.Block.hash head
+  } in
+  shell_header
+
+
+let get_block_header pred operations_hash fitness context timestamp =
+  let pred_header = State.Block.header pred in
+  let pred_hash = State.Block.hash pred in
+  let shell_header : Block_header.shell_header = {
+    level = Int32.succ pred_header.shell.level ;
+    proto_level = 0 ;
+    predecessor = pred_hash ;
+    timestamp ;
+    validation_passes = 1 ;
+    operations_hash ;
+    context ;
+    fitness
+  } in
+  shell_header
+
+
+let find_account accounts hpub =
+  let hpub_pred (x : Helpers_account.t) =
+    Ed25519.Public_key_hash.equal x.hpub hpub in
+  List.find hpub_pred accounts
+
+
+let get_dummy_tezos_context context =
+  Proto_alpha.Tezos_context.init
+    context
+    ~level: Int32.one
+    ~timestamp:(Time.now ())
+    ~fitness:([])
+
+
+let read_file path =
+  let (//) = Filename.concat in
+  let executable_path = Sys.getcwd () in
+  let path =
+    if Filename.is_relative path
+    then executable_path // path
+    else path
+  in
+  let ic = open_in path in
+  let n = in_channel_length ic in
+  let s = Bytes.create n in
+  really_input ic s 0 n ;
+  close_in ic ;
+  (Bytes.to_string s)

test/proto_alpha_isolate_helpers/helpers_misc.mli

@@ -0,0 +1,29 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Tezos_shell
+open Proto_alpha.Tezos_context
+
+exception Unknown_protocol
+
+(** Miscellaneous self-descriptive functions *)
+
+val no_ops_hash : Operation_list_list_hash.t
+val get_protocol : Protocol_hash.t -> (module State.Registred_protocol.T)
+val get_shell_header :
+  State.Block.t -> Tezos_base.Operation.shell_header
+val get_block_header :
+  State.Block.t -> Operation_list_list_hash.t ->
+  Tezos_stdlib.MBytes.t list -> Context_hash.t ->
+  Tezos_base.Time.t -> Block_header.shell_header
+val find_account : Helpers_account.t list -> Ed25519.Public_key_hash.t -> Helpers_account.t
+val get_dummy_tezos_context :
+  Proto_alpha.Environment.Context.t -> Proto_alpha.Tezos_context.context Proto_alpha.Environment.Error_monad.tzresult Lwt.t
+val read_file : string -> string
+

test/proto_alpha_isolate_helpers/helpers_operation.ml

@@ -0,0 +1,137 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Proto_alpha.Tezos_context
+open Proto_alpha.Environment.Error_monad
+
+let sourced ops = Sourced_operations ops
+
+let manager (src : Helpers_account.t) ?(fee = Tez.zero) operations context =
+  Helpers_misc.get_dummy_tezos_context context >>=? fun context ->
+  Contract.get_counter context src.contract >>=? fun counter ->
+  let counter = Int32.succ counter in
+  return @@
+  Manager_operations {
+    source = src.contract ;
+    public_key = Some src.pub ;
+    fee ;
+    counter ;
+    operations
+  }
+
+
+let manager_full src ?(fee = Tez.zero) ops context =
+  manager src ~fee ops context >>=? fun ops -> return @@ sourced ops
+
+
+let transaction ?(parameters = None) amount destination =
+  Transaction {
+    amount ;
+    parameters ;
+    destination
+  }
+
+
+let origination
+    ?(delegatable = true) ?(script = None)
+    ?(spendable = true) ?(delegate = None)
+    (manager: Helpers_account.t) credit
+  =
+  Origination {
+    manager = manager.hpub ;
+    delegate ;
+    spendable ;
+    delegatable ;
+    script ;
+    credit
+  }
+
+
+let delegation delegate =
+  Delegation (Some delegate)
+
+
+let delegation_full ?(fee = Tez.zero) src delegate context =
+  manager_full src ~fee [delegation delegate] context
+
+
+let script_origination_full script src credit context =
+  manager_full src ~fee: Tez.zero [origination ~script src credit] context
+
+
+let origination_full ?(spendable = true) ?(delegatable = true) ?(fee = Tez.zero) src credit context =
+  manager_full src ~fee [origination ~spendable ~delegatable src credit] context
+
+
+let transaction_full ?(fee = Tez.zero) src dst amount context =
+  manager src ~fee [transaction amount dst] context
+  >>=? fun manager_op ->
+  return @@ sourced manager_op
+
+
+let delegate (src: Helpers_account.t) operations =
+  Delegate_operations {
+    source = src.pub ;
+    operations
+  }
+
+
+let endorsement ?(slot = 0) block =
+  Endorsement {
+    block ;
+    slot
+  }
+
+
+let endorsement_full ?(slot = 0) src block =
+  sourced
+  @@ delegate
+    src
+    [endorsement block ~slot]
+
+
+let sign src oph protop =
+  let signature_content = Operation.forge oph protop in
+  let signature = match src with
+    | None -> None
+    | Some(src: Helpers_account.t) -> Some (Ed25519.sign src.ppk signature_content) in
+  let open Data_encoding in
+  let signed_proto_operation_encoding =
+    Data_encoding.merge_objs
+      Operation.proto_operation_encoding
+      (obj1 @@ varopt "signature" Ed25519.Signature.encoding) in
+  let proto_bytes =
+    Data_encoding.Binary.to_bytes
+      signed_proto_operation_encoding
+      (protop, signature) in
+  (proto_bytes, signature)
+
+
+let main_of_proto (src: Helpers_account.t) operation_header protocol_operation =
+  let (proto,_) = sign (Some src) operation_header protocol_operation in
+  let data_operation: Tezos_base.Operation.t =
+    {shell = operation_header ; proto} in
+  let hash = Tezos_base.Operation.hash data_operation in
+  Proto_alpha.Main.parse_operation hash data_operation >>? fun op ->
+  ok (op, hash)
+
+
+let apply_of_proto
+    (source: Helpers_account.t option) operation_header protocol_operation =
+  let (proto, signature) = sign source operation_header protocol_operation in
+  let data_operation: Tezos_base.Operation.t =
+    {shell = operation_header ; proto} in
+  let hash = Tezos_base.Operation.hash data_operation in
+  {
+    hash ;
+    shell = operation_header ;
+    contents = protocol_operation ;
+    signature
+  }
+

test/proto_alpha_isolate_helpers/helpers_operation.mli

@@ -0,0 +1,71 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Proto_alpha.Tezos_context
+
+(** Functions building operations *)
+
+val sourced : sourced_operations -> proto_operation
+
+val manager :
+  Helpers_account.t -> ?fee:Tez.tez -> manager_operation list ->
+  Proto_alpha.Environment.Context.t -> sourced_operations Proto_alpha.tzresult Lwt.t
+
+val manager_full :
+  Helpers_account.t -> ?fee:Tez.tez -> manager_operation list ->
+  Proto_alpha.Environment.Context.t -> proto_operation Proto_alpha.tzresult Lwt.t
+
+val transaction :
+  ?parameters:Script.expr option -> Tez.t -> Contract.contract ->
+  manager_operation
+
+val origination :
+  ?delegatable:bool -> ?script:Script.t option -> ?spendable:bool ->
+  ?delegate:public_key_hash option -> Helpers_account.t -> Tez.t -> manager_operation
+
+val delegation : public_key_hash -> manager_operation
+
+val delegation_full :
+  ?fee:Tez.tez -> Helpers_account.t -> public_key_hash -> Proto_alpha.Environment.Context.t ->
+  proto_operation Proto_alpha.tzresult Lwt.t
+
+val script_origination_full :
+  Script.t option -> Helpers_account.t -> Tez.t -> Proto_alpha.Environment.Context.t ->
+  proto_operation Proto_alpha.tzresult  Lwt.t
+
+val origination_full :
+  ?spendable:bool -> ?delegatable:bool -> ?fee:Tez.tez ->
+  Helpers_account.t -> Tez.t -> Proto_alpha.Environment.Context.t ->
+  proto_operation Proto_alpha.tzresult Lwt.t
+
+val transaction_full :
+  ?fee:Tez.tez -> Helpers_account.t -> Contract.contract -> Tez.t ->
+  Proto_alpha.Environment.Context.t -> proto_operation Proto_alpha.tzresult Lwt.t
+
+val delegate :
+  Helpers_account.t -> delegate_operation list -> sourced_operations
+
+val endorsement :
+  ?slot:int -> Block_hash.t -> delegate_operation
+
+val endorsement_full :
+  ?slot:int -> Helpers_account.t -> Block_hash.t -> proto_operation
+
+val sign :
+  Helpers_account.t option -> Tezos_base.Operation.shell_header ->
+  proto_operation -> MBytes.t * Ed25519.Signature.t option
+
+val main_of_proto :
+  Helpers_account.t -> Tezos_base.Operation.shell_header ->
+  proto_operation -> (Main.operation * Tezos_base.Operation_hash.t) Proto_alpha.tzresult
+
+val apply_of_proto :
+  Helpers_account.t option -> Tezos_base.Operation.shell_header ->
+  proto_operation -> operation
+

test/proto_alpha_isolate_helpers/helpers_script.ml

@@ -0,0 +1,36 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Proto_alpha.Error_monad
+open Proto_alpha.Tezos_context
+
+let init_amount = 20000
+
+let execute_code_pred
+    ?tc (pred : Helpers_block.result) (script : Script.t) (argument : Script.expr) =
+  let op = List.nth Helpers_account.bootstrap_accounts 0 in
+  let tc = Option.unopt ~default:pred.tezos_context tc in
+  Helpers_apply.script_origination_pred ~tc ~pred (script, op, init_amount)
+  >>=? fun ((dst, _), tc) ->
+  let dst = List.hd dst in
+  let ctxt = Helpers_cast.ctxt_of_tc tc in
+  Helpers_operation.transaction_full op dst Tez.zero ctxt
+  >>=? fun dummy_protop ->
+  let op_header = Helpers_block.get_op_header_res pred in
+  let apply_op = Helpers_operation.apply_of_proto
+      (Some op) op_header dummy_protop in
+  let dummy_nonce = Contract.initial_origination_nonce apply_op.hash in
+  let amount = Tez.zero in
+  let gaz = Gas.of_int (Tezos_context.Constants.max_gas tc) in
+  let return = Script_interpreter.execute
+      dummy_nonce op.contract dst
+      tc script amount argument gaz in
+  return
+
+

test/proto_alpha_isolate_helpers/helpers_script.mli

@@ -0,0 +1,17 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Proto_alpha.Tezos_context
+
+val init_amount : int
+val execute_code_pred :
+  ?tc:Tezos_context.t -> Helpers_block.result -> Script.t -> Script.expr ->
+  (Script.expr * Script.expr * Gas.t * context * Contract.origination_nonce)
+    Proto_alpha.tzresult Lwt.t
+

test/proto_alpha_isolate_helpers/helpers_services.ml

@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Proto_alpha.Tezos_context
+open Helpers_assert
+
+let endorsement_rights ~tc () =
+  let level = Level.current tc in
+  Proto_alpha.Services_registration.endorsement_rights tc level None >>=?? fun (_, endorsers) ->
+  return @@ List.mapi (fun x i -> x, i) endorsers
+
+
+let baking_rights ~tc () =
+  let level = Level.succ tc @@ Level.current tc in
+  Proto_alpha.Services_registration.baking_rights tc level None >>=?? fun (_, bakers) ->
+  return @@ List.mapi (fun x i -> x, i) bakers
+

test/proto_alpha_isolate_helpers/helpers_services.mli

@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Wrappers around Services_registration calls *)
+
+val endorsement_rights :
+  tc:Proto_alpha.Tezos_context.context -> unit ->
+  (int * Tezos_context.public_key_hash) list tzresult Lwt.t
+
+val baking_rights :
+  tc:Proto_alpha.Tezos_context.context -> unit ->
+  (int * Tezos_context.public_key_hash) list tzresult Lwt.t

test/proto_alpha_isolate_helpers/helpers_sodium.ml

@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc.< contact@tezos.com >                 *)
+(*                                                                        *)
+(*    All rights reserved.No warranty, explicit or implicit, provided.    *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Proto_alpha.Tezos_context
+
+let generate_proof_of_work_nonce () =
+  Sodium.Random.Bigbytes.generate Constants.proof_of_work_nonce_size
+
+let generate_seed_nonce () =
+  match Nonce.of_bytes @@
+    Sodium.Random.Bigbytes.generate Constants.nonce_length with
+  | Error _ -> assert false
+  | Ok nonce -> nonce

test/proto_alpha_isolate_helpers/helpers_sodium.mli

@@ -0,0 +1,13 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc.< contact@tezos.com >                 *)
+(*                                                                        *)
+(*    All rights reserved.No warranty, explicit or implicit, provided.    *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Extension of the Sodium module with helpers functions *)
+
+val generate_proof_of_work_nonce : unit -> MBytes.t
+val generate_seed_nonce : unit -> Proto_alpha.Tezos_context.Nonce.nonce

test/proto_alpha_isolate_helpers/isolate_helpers.ml

@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Sodium = Helpers_sodium
+module Cast = Helpers_cast
+module Assert = Helpers_assert
+module Services = Helpers_services
+module Constants = Helpers_constants
+module Account = Helpers_account
+module Misc = Helpers_misc
+module Operation = Helpers_operation
+module Block = Helpers_block
+module Init = Helpers_init
+module Apply = Helpers_apply
+module Script = Helpers_script
+
+module Shorthands = struct
+
+  let to_tc ctxt = Misc.get_dummy_tezos_context ctxt
+
+  let to_tc_full ctxt level fitness =
+    Tezos_context.init
+      ctxt
+      ~level
+      ~fitness
+      ~timestamp:(Time.now())
+
+  let get_tc (res:Block.result) =
+    to_tc res.validation.context
+
+  let get_tc_full (res:Block.result) =
+    Tezos_context.init
+      res.validation.context
+      ~level:res.level
+      ~timestamp:res.tezos_header.shell.timestamp
+      ~fitness:res.validation.fitness
+
+  let get_balance_res (account:Account.t) (result:Block.result) =
+    let open Proto_alpha.Error_monad in
+    get_tc_full result >>=? fun tc ->
+    Proto_alpha.Tezos_context.Contract.get_balance tc account.contract
+
+  let chain_empty_block (result:Block.result) =
+    Block.empty
+      result.tezos_header.shell
+      result.hash
+      result.level
+      15
+      result.validation.context
+
+end

test/proto_alpha_isolate_helpers/jbuild

@@ -0,0 +1,19 @@
+(jbuild_version 1)
+
+(library
+ ((name tezos_proto_alpha_isolate_helpers)
+  (libraries (kaputt
+              test_lib
+              tezos-base
+              tezos-shell
+              tezos-embedded-protocol-genesis
+              tezos-embedded-protocol-alpha))
+  (wrapped false)
+  (flags (:standard -w -9-32 -safe-string
+          -open Tezos_base__TzPervasives
+          -open Tezos_embedded_raw_protocol_alpha))))
+
+(alias
+ ((name runtest_indent)
+  (deps ((glob_files *.ml) (glob_files *.mli)))
+  (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^}))))

test/proto_alpha_isolate_helpers/proto_alpha.ml

@@ -0,0 +1,5 @@
+include Tezos_embedded_raw_protocol_alpha
+module Environment = Tezos_embedded_protocol_environment_alpha.Environment
+module Error_monad = Environment.Error_monad
+type error = Error_monad.error
+type 'a tzresult = 'a Error_monad.tzresult