Tests: add isolate tests
This commit is contained in:
parent
aeb910b9f9
commit
e5ea08d675
@ -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
|
||||
|
38
test/proto_alpha_isolate/jbuild
Normal file
38
test/proto_alpha_isolate/jbuild
Normal file
@ -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} ${^}))))
|
163
test/proto_alpha_isolate/test_isolate_dsl.ml
Normal file
163
test/proto_alpha_isolate/test_isolate_dsl.ml
Normal file
@ -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
|
153
test/proto_alpha_isolate/test_isolate_endorsement.ml
Normal file
153
test/proto_alpha_isolate/test_isolate_endorsement.ml
Normal file
@ -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
|
16
test/proto_alpha_isolate/test_isolate_main.ml
Normal file
16
test/proto_alpha_isolate/test_isolate_main.ml
Normal file
@ -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 ()
|
||||
|
501
test/proto_alpha_isolate/test_isolate_michelson.ml
Normal file
501
test/proto_alpha_isolate/test_isolate_michelson.ml
Normal file
@ -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
|
106
test/proto_alpha_isolate/test_isolate_origination.ml
Normal file
106
test/proto_alpha_isolate/test_isolate_origination.ml
Normal file
@ -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
|
164
test/proto_alpha_isolate/test_isolate_transaction.ml
Normal file
164
test/proto_alpha_isolate/test_isolate_transaction.ml
Normal file
@ -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
|
106
test/proto_alpha_isolate_helpers/helpers_account.ml
Normal file
106
test/proto_alpha_isolate_helpers/helpers_account.ml
Normal file
@ -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
|
||||
|
63
test/proto_alpha_isolate_helpers/helpers_account.mli
Normal file
63
test/proto_alpha_isolate_helpers/helpers_account.mli
Normal file
@ -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
|
88
test/proto_alpha_isolate_helpers/helpers_apply.ml
Normal file
88
test/proto_alpha_isolate_helpers/helpers_apply.ml
Normal file
@ -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
|
||||
|
||||
|
57
test/proto_alpha_isolate_helpers/helpers_apply.mli
Normal file
57
test/proto_alpha_isolate_helpers/helpers_apply.mli
Normal file
@ -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
|
199
test/proto_alpha_isolate_helpers/helpers_assert.ml
Normal file
199
test/proto_alpha_isolate_helpers/helpers_assert.ml
Normal file
@ -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
|
81
test/proto_alpha_isolate_helpers/helpers_assert.mli
Normal file
81
test/proto_alpha_isolate_helpers/helpers_assert.mli
Normal file
@ -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
|
||||
|
188
test/proto_alpha_isolate_helpers/helpers_block.ml
Normal file
188
test/proto_alpha_isolate_helpers/helpers_block.ml
Normal file
@ -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
|
81
test/proto_alpha_isolate_helpers/helpers_block.mli
Normal file
81
test/proto_alpha_isolate_helpers/helpers_block.mli
Normal file
@ -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
|
40
test/proto_alpha_isolate_helpers/helpers_cast.ml
Normal file
40
test/proto_alpha_isolate_helpers/helpers_cast.ml
Normal file
@ -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
|
27
test/proto_alpha_isolate_helpers/helpers_cast.mli
Normal file
27
test/proto_alpha_isolate_helpers/helpers_cast.mli
Normal file
@ -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
|
||||
|
32
test/proto_alpha_isolate_helpers/helpers_constants.ml
Normal file
32
test/proto_alpha_isolate_helpers/helpers_constants.ml
Normal file
@ -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"
|
19
test/proto_alpha_isolate_helpers/helpers_constants.mli
Normal file
19
test/proto_alpha_isolate_helpers/helpers_constants.mli
Normal file
@ -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
|
123
test/proto_alpha_isolate_helpers/helpers_init.ml
Normal file
123
test/proto_alpha_isolate_helpers/helpers_init.ml
Normal file
@ -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
|
12
test/proto_alpha_isolate_helpers/helpers_init.mli
Normal file
12
test/proto_alpha_isolate_helpers/helpers_init.mli
Normal file
@ -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
|
16
test/proto_alpha_isolate_helpers/helpers_logger.ml
Normal file
16
test/proto_alpha_isolate_helpers/helpers_logger.ml
Normal file
@ -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
|
12
test/proto_alpha_isolate_helpers/helpers_logger.mli
Normal file
12
test/proto_alpha_isolate_helpers/helpers_logger.mli
Normal file
@ -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
|
78
test/proto_alpha_isolate_helpers/helpers_misc.ml
Normal file
78
test/proto_alpha_isolate_helpers/helpers_misc.ml
Normal file
@ -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)
|
29
test/proto_alpha_isolate_helpers/helpers_misc.mli
Normal file
29
test/proto_alpha_isolate_helpers/helpers_misc.mli
Normal file
@ -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
|
||||
|
137
test/proto_alpha_isolate_helpers/helpers_operation.ml
Normal file
137
test/proto_alpha_isolate_helpers/helpers_operation.ml
Normal file
@ -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
|
||||
}
|
||||
|
71
test/proto_alpha_isolate_helpers/helpers_operation.mli
Normal file
71
test/proto_alpha_isolate_helpers/helpers_operation.mli
Normal file
@ -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
|
||||
|
36
test/proto_alpha_isolate_helpers/helpers_script.ml
Normal file
36
test/proto_alpha_isolate_helpers/helpers_script.ml
Normal file
@ -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
|
||||
|
||||
|
17
test/proto_alpha_isolate_helpers/helpers_script.mli
Normal file
17
test/proto_alpha_isolate_helpers/helpers_script.mli
Normal file
@ -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
|
||||
|
23
test/proto_alpha_isolate_helpers/helpers_services.ml
Normal file
23
test/proto_alpha_isolate_helpers/helpers_services.ml
Normal file
@ -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
|
||||
|
18
test/proto_alpha_isolate_helpers/helpers_services.mli
Normal file
18
test/proto_alpha_isolate_helpers/helpers_services.mli
Normal file
@ -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
|
19
test/proto_alpha_isolate_helpers/helpers_sodium.ml
Normal file
19
test/proto_alpha_isolate_helpers/helpers_sodium.ml
Normal file
@ -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
|
13
test/proto_alpha_isolate_helpers/helpers_sodium.mli
Normal file
13
test/proto_alpha_isolate_helpers/helpers_sodium.mli
Normal file
@ -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
|
57
test/proto_alpha_isolate_helpers/isolate_helpers.ml
Normal file
57
test/proto_alpha_isolate_helpers/isolate_helpers.ml
Normal file
@ -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
|
19
test/proto_alpha_isolate_helpers/jbuild
Normal file
19
test/proto_alpha_isolate_helpers/jbuild
Normal file
@ -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} ${^}))))
|
5
test/proto_alpha_isolate_helpers/proto_alpha.ml
Normal file
5
test/proto_alpha_isolate_helpers/proto_alpha.ml
Normal file
@ -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
|
Loading…
Reference in New Issue
Block a user