diff --git a/.dockerignore b/.dockerignore index ce2f76e9d..2e1e006a0 100644 --- a/.dockerignore +++ b/.dockerignore @@ -51,6 +51,7 @@ test/p2p/test-p2p-connection-pool test/shell/test-store test/shell/test-state test/shell/test-context +test/proto_alpha/test-transaction **/*~ **/\#*\# diff --git a/.gitignore b/.gitignore index df3951328..4735c91e8 100644 --- a/.gitignore +++ b/.gitignore @@ -39,6 +39,7 @@ /test/utils/.depend /test/p2p/.depend /test/shell/.depend +/test/proto_alpha/.depend /test/reports /test/utils/test-data-encoding @@ -50,6 +51,7 @@ /test/shell/test-store /test/shell/test-state /test/shell/test-context +/test/proto_alpha/test-transaction *~ \#*\# diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 1b5581d98..3e9ad066a 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -105,6 +105,15 @@ test:p2p:connection-pool: dependencies: - build +test:proto_alpha:transactions: + stage: test + tags: + - tezos_builder + script: + - make -C test/proto_alpha run-test-transaction + dependencies: + - build + test:basic.sh: stage: test tags: diff --git a/test/Makefile b/test/Makefile index 38aa1ea52..a3f973035 100644 --- a/test/Makefile +++ b/test/Makefile @@ -2,7 +2,8 @@ DIR := \ utils \ shell \ - p2p + p2p \ + proto_alpha all: build run diff --git a/test/proto_alpha/.merlin b/test/proto_alpha/.merlin new file mode 100644 index 000000000..6eeec19e3 --- /dev/null +++ b/test/proto_alpha/.merlin @@ -0,0 +1,30 @@ +REC +S . +B . +S ../../src/minutils +B ../../src/minutils +S ../../src/utils +B ../../src/utils +S ../../src/node/net +B ../../src/node/net +S ../../src/node/db +B ../../src/node/db +S ../../src/node/updater +B ../../src/node/updater +S ../../src/node/shell +B ../../src/node/shell +S ../../src/proto +B ../../src/proto +S ../../src/client +B ../../src/client +S ../../src/client/embedded/alpha +S ../../src/client/embedded/alpha/baker +B ../../src/client/embedded +S ../lib +B ../lib +FLG -open Error_monad -open Hash -open Utils -open Environment +FLG -w -40 +PKG lwt +PKG sodium +PKG kaputt +PKG ipaddr diff --git a/test/proto_alpha/Makefile b/test/proto_alpha/Makefile new file mode 100644 index 000000000..4a15fb556 --- /dev/null +++ b/test/proto_alpha/Makefile @@ -0,0 +1,50 @@ + +SRCDIR=../../src + +TESTS := \ + transaction \ + origination \ + endorsement \ + +include ../Makefile.shared + +SOURCE_DIRECTORIES := \ + ${CLIENT_SOURCE_DIRECTORIES} \ + ${SRCDIR}/proto \ + ${SRCDIR}/client/embedded \ + ${SRCDIR}/client/embedded/alpha \ + ${SRCDIR}/client/embedded/alpha/baker \ + ../lib + +LIB := \ + ${MINUTILSLIB} ${UTILSLIB} ${COMPILERLIB} \ + ${NODELIB} ${CLIENTLIB} ${EMBEDDED_CLIENT_PROTOCOLS} ${TESTLIB} + +PACKAGES := \ + ${CLIENT_PACKAGES} \ + kaputt \ + +OPENED_MODULES := \ + ${CLIENT_OPENED_MODULES} \ + Environment Client_embedded_proto_alpha Tezos_context + +############################################################################ +## Transactions + +.PHONY:run-test-transaction +run-test-transaction: + @echo + ./test-transaction + +TEST_CONNECTION_IMPLS := \ + proto_alpha_helpers.mli \ + proto_alpha_helpers.ml \ + test_transaction.ml + +test-transaction: ${LIB} ${TEST_CONNECTION_IMPLS:.ml=.cmx} + @echo COMPILE $(notdir $@) + @${OCAMLOPT} -linkall -linkpkg ${OCAMLFLAGS} -o $@ $^ + +clean:: + rm -f test-transaction + diff --git a/test/proto_alpha/proto_alpha_helpers.ml b/test/proto_alpha/proto_alpha_helpers.ml new file mode 100644 index 000000000..d3edbc882 --- /dev/null +++ b/test/proto_alpha/proto_alpha_helpers.ml @@ -0,0 +1,555 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Client_embedded_proto_alpha +open Tezos_context +open Client_alpha + +let (//) = Filename.concat + +let rpc_config : Client_rpcs.config = { + host = "localhost" ; + port = 18732 ; + tls = false ; + logger = Client_rpcs.null_logger ; +} + +let dictator_sk = + Environment.Ed25519.Secret_key.of_b58check_exn + "edskRhxswacLW6jF6ULavDdzwqnKJVS4UcDTNiCyiH6H8ZNnn2pmNviL7\ + pRNz9kRxxaWQFzEQEcZExGHKbwmuaAcoMegj5T99z" + +let activate_alpha () = + let fitness = Fitness_repr.from_int64 0L in + Client_genesis.Client_proto_main.mine + rpc_config (`Head 0) + (Activate Client_proto_main.protocol) + fitness dictator_sk + +let init () = + Random.self_init () ; + Unix.chdir (Filename.dirname (Filename.dirname Sys.executable_name)) ; + let pid = + Node_helpers.fork_node + ~port:rpc_config.port + ~sandbox:(Filename.dirname Sys.executable_name // "sandbox.json") + () in + activate_alpha () >>=? fun hash -> + return (pid, hash) + +module Account = struct + + type t = { + alias : string ; + sk : secret_key ; + pk : public_key ; + pkh : public_key_hash ; + contract : Contract.t ; + } + + let encoding = + let open Environment.Ed25519 in + let open Data_encoding in + conv + (fun { alias ; sk ; pk ; pkh ; contract } -> + (alias, sk, pk, pkh, contract) + ) + (fun (alias, sk, pk, pkh, contract) -> + { alias ; sk ; pk ; pkh ; contract }) + (obj5 + (req "alias" string) + (req "sk" Secret_key.encoding) + (req "pk" Public_key.encoding) + (req "pkh" Public_key_hash.encoding) + (req "contract" Contract.encoding)) + + let pp_account ppf account = + let json = Data_encoding.Json.construct encoding account in + Format.fprintf ppf "%s" (Data_encoding_ezjsonm.to_string json) + + let create ?keys alias = + let sk, pk = match keys with + | Some keys -> keys + | None -> Sodium.Sign.random_keypair () in + let pkh = Environment.Ed25519.Public_key.hash pk in + let contract = Contract.default_contract pkh in + { alias ; contract ; pkh ; pk ; sk } + + type destination = { + alias : string ; + contract : Contract.t ; + pk : public_key ; + pkh : public_key_hash ; + } + + let destination_encoding = + let open Environment.Ed25519 in + let open Data_encoding in + conv + (fun { alias ; pk ; pkh ; contract } -> + (alias, pk, pkh, contract)) + (fun (alias, pk, pkh, contract) -> + { alias ; pk ; pkh ; contract }) + (obj4 + (req "alias" string) + (req "pk" Public_key.encoding) + (req "pkh" Public_key_hash.encoding) + (req "contract" Contract.encoding)) + + let pp_destination ppf destination = + let json = Data_encoding.Json.construct destination_encoding destination in + Format.fprintf ppf "%s" (Data_encoding_ezjsonm.to_string json) + + let create_destination ~alias ~contract ~pk = + let pkh = Environment.Ed25519.Public_key.hash pk in + { alias ; contract ; pk ; pkh } + + type bootstrap_accounts = { b1 : t ; b2 : t ; b3 : t ; b4 : t ; b5 : t ; } + + let bootstrap_accounts = + let open Environment.Ed25519 in + let bootstrap1_pk = + Public_key.of_b58check_exn + "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" in + let bootstrap2_pk = + Public_key.of_b58check_exn + "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9" in + let bootstrap3_pk = + Public_key.of_b58check_exn + "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV" in + let bootstrap4_pk = + Public_key.of_b58check_exn + "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU" in + let bootstrap5_pk = + Public_key.of_b58check_exn + "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n" in + let bootstrap1_sk = + Secret_key.of_b58check_exn + "edskRuR1azSfboG86YPTyxrQgosh5zChf5bVDmptqLTb5EuXAm9\ + rsnDYfTKhq7rDQujdn5WWzwUMeV3agaZ6J2vPQT58jJAJPi" in + let bootstrap2_sk = + Secret_key.of_b58check_exn + "edskRkJz4Rw2rM5NtabEWMbbg2bF4b1nfFajaqEuEk4SgU7eeDby\ + m9gVQtBTbYo32WUg2zb5sNBkD1whRN7zX43V9bftBbtaKc" in + let bootstrap3_sk = + Secret_key.of_b58check_exn + "edskS3qsqsNgdjUqeMsVcEwBn8dkZ5iDRz6aF21KhcCtRiAkWByp\ + USbicccR4Vgqm9UdW2Vabuos6seezqgbXTrmcbLUG4rdAC" in + let bootstrap4_sk = + Secret_key.of_b58check_exn + "edskRg9qcPqaVQa6jXWNMU5p71tseSuR7NzozgqZ9URsVDi81wTyP\ + JdFSBdeakobyHUi4Xgu61jgKRQvkhXrPmEdEUfiqfiJFL" in + let bootstrap5_sk = + Secret_key.of_b58check_exn + "edskS7rLN2Df3nbS1EYvwJbWo4umD7yPM1SUeX7gp1WhCVpMFXjcC\ + yM58xs6xsnTsVqHQmJQ2RxoAjJGedWfvFmjQy6etA3dgZ" in + let cpt = ref 0 in + match List.map begin fun (pk, sk) -> + incr cpt ; + let alias = Printf.sprintf "bootstrap%d" !cpt in + let pkh = Environment.Ed25519.Public_key.hash pk in + { alias ; contract = Contract.default_contract pkh; pkh ; pk ; sk } + end [ + bootstrap1_pk, bootstrap1_sk; + bootstrap2_pk, bootstrap2_sk; + bootstrap3_pk, bootstrap3_sk; + bootstrap4_pk, bootstrap4_sk; + bootstrap5_pk, bootstrap5_sk; ] + with + | [ b1 ; b2 ; b3 ; b4 ; b5 ] -> { b1 ; b2 ; b3 ; b4 ; b5 } + | _ -> assert false + + let transfer + ?(block = `Prevalidation) + ?(fee = 5L) + ~(account:t) + ~destination + ~amount () = + let amount = match Tez.of_cents amount with None -> Tez.zero | Some a -> a in + let fee = match Tez.of_cents fee with None -> Tez.zero | Some a -> a in + Client_proto_context.transfer rpc_config + block + ~source:account.contract + ~src_pk:account.pk + ~src_sk:account.sk + ~destination + ~amount + ~fee () + + let originate + ?(block = `Prevalidation) + ?delegate + ?(fee=5L) + ~(src:t) + ~manager_pkh + ~spendable + ~balance + () = + let fee = match Tez.of_cents fee with + | None -> Tez.zero + | Some amount -> amount in + let balance = match Tez.of_cents balance with + | None -> Tez.zero + | Some amount -> amount in + let delegatable, delegate = match delegate with + | None -> false, None + | Some delegate -> true, Some delegate in + Client_proto_context.originate_account rpc_config block + ~source:src.contract + ~src_pk:src.pk + ~src_sk:src.sk + ~manager_pkh + ~spendable + ~balance + ~delegatable + ?delegate + ~fee () + + let set_delegate + ?(block = `Prevalidation) + ?(fee = 5L) + ~contract + ~manager_sk + delegate_opt = + let fee = match Tez.of_cents fee with + | None -> Tez.zero + | Some amount -> amount in + Client_proto_context.delegate_contract rpc_config block + ~source:contract + ~manager_sk + ~fee + delegate_opt + + let balance ?(block = `Prevalidation) (account : t) = + Client_proto_rpcs.Context.Contract.balance rpc_config + block account.contract + + (* TODO: gather contract related functions in a Contract module? *) + let delegate ?(block = `Prevalidation) (contract : Contract.t) = + Client_proto_rpcs.Context.Contract.delegate rpc_config + block contract + +end + +module Assert = struct + + include Assert + + 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 -> + Environment.Ed25519.Public_key_hash.equal pkh1 pkh2 + | _ -> false in + let prn = function + | None -> "none" + | Some pkh -> Environment.Ed25519.Public_key_hash.to_hex pkh in + Assert.equal ?msg ~prn ~eq pkh1 pkh2 + + let equal_tez ?msg tz1 tz2 = + let msg = Assert.format_msg msg in + let eq tz1 tz2 = Int64.equal (Tez.to_cents tz1) (Tez.to_cents tz2) in + let prn = Tez.to_string in + Assert.equal ?msg ~prn ~eq tz1 tz2 + + let balance_equal ~msg account expected_balance = + Account.balance account >>=? fun actual_balance -> + match Tez.of_cents expected_balance with + | None -> + failwith "invalid tez constant" + | Some expected_balance -> + return (equal_tez ~msg actual_balance expected_balance) + + let delegate_equal ~msg contract expected_delegate = + Account.delegate contract >>|? fun actual_delegate -> + equal_pkh ~msg actual_delegate expected_delegate + + let ecoproto_error f = function + | Register_client_embedded_proto_alpha.Ecoproto_error errors -> + List.exists f errors + | _ -> false + + let generic_economic_error ~msg = + Assert.contain_error ~msg ~f:(ecoproto_error (fun _ -> true)) + + let unknown_contract ~msg = + let open Client_embedded_proto_alpha.Storage_functors in + Assert.contain_error ~msg ~f:begin ecoproto_error (function + | Storage_error _ -> true + | _ -> false) + end + + let non_existing_contract ~msg = + Assert.contain_error ~msg ~f:begin ecoproto_error (function + | Contract_storage.Non_existing_contract _ -> true + | _ -> false) + end + + let balance_too_low ~msg = + Assert.contain_error ~msg ~f:begin ecoproto_error (function + | Contract.Balance_too_low _ -> true + | _ -> false) + end + + let non_spendable ~msg = + Assert.contain_error ~msg ~f:begin ecoproto_error (function + | Contract_storage.Unspendable_contract _ -> true + | _ -> false) + end + + let inconsistent_pkh ~msg = + Assert.contain_error ~msg ~f:begin ecoproto_error (function + | Public_key_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 + | Contract_storage.Non_delegatable_contract _ -> true + | _ -> false) + end + + let wrong_delegate ~msg = + Assert.contain_error ~msg ~f:begin ecoproto_error (function + | Mining.Wrong_delegate _ -> true + | _ -> false) + end + + let invalid_endorsement_slot ~msg = + Assert.contain_error ~msg ~f:begin ecoproto_error (function + | Mining.Invalid_endorsement_slot _ -> true + | _ -> false) + end + +end + +module Mining = struct + + let get_first_priority + ?(max_priority=1024) + level + (contract : Account.t) + block = + Client_proto_rpcs.Helpers.Rights.mining_rights_for_delegate + rpc_config + ~max_priority + ~first_level:level + ~last_level:level + block contract.Account.pkh () >>=? fun possibilities -> + try + let _, prio, _ = + List.find (fun (l,_,_) -> l = level) possibilities in + return prio + with Not_found -> + failwith "No slot found at level %a" Raw_level.pp level + + let rec mine_stamp + block + delegate_sk + shell + mining_slot + seed_nonce_hash = + Client_proto_rpcs.Constants.stamp_threshold + rpc_config block >>=? fun stamp_threshold -> + let rec loop () = + let proof_of_work_nonce = + Sodium.Random.Bigbytes.generate Constants.proof_of_work_nonce_size in + let unsigned_header = + Block.forge_header + shell { mining_slot ; seed_nonce_hash ; proof_of_work_nonce } in + let signed_header = + Environment.Ed25519.Signature.append delegate_sk unsigned_header in + let block_hash = Block_hash.hash_bytes [signed_header] in + if Mining.check_hash block_hash stamp_threshold then + proof_of_work_nonce + else + loop () in + return (loop ()) + + let inject_block + block + ?force + ~priority + ~timestamp + ~fitness + ~seed_nonce + ~src_sk + operation_list = + let block = match block with `Prevalidation -> `Head 0 | block -> block in + Client_node_rpcs.Blocks.info rpc_config block >>=? fun bi -> + let seed_nonce_hash = Nonce.hash seed_nonce in + Client_proto_rpcs.Context.next_level rpc_config block >>=? fun level -> + let operations = + Operation_list_list_hash.compute + [Operation_list_hash.compute operation_list] in + let shell = + { Store.Block_header.net_id = bi.net ; predecessor = bi.hash ; + timestamp ; fitness ; operations } in + let slot = { Block.level = level.level ; priority = Int32.of_int priority } in + mine_stamp + block src_sk shell slot seed_nonce_hash >>=? fun proof_of_work_nonce -> + Client_proto_rpcs.Helpers.Forge.block rpc_config + block + ~net:bi.net + ~predecessor:bi.hash + ~timestamp + ~fitness + ~operations + ~level:level.level + ~priority:priority + ~seed_nonce_hash + ~proof_of_work_nonce + () >>=? fun unsigned_header -> + let signed_header = Environment.Ed25519.Signature.append src_sk unsigned_header in + Client_node_rpcs.inject_block rpc_config + ?force signed_header [operation_list] >>=? fun block_hash -> + return block_hash + + let mine + ?(force = false) + ?(operations = []) + contract + block = + Client_mining_blocks.info rpc_config block >>=? fun bi -> + let seed_nonce = + match Nonce.of_bytes @@ + Sodium.Random.Bigbytes.generate Constants.nonce_length with + | Error _ -> assert false + | Ok nonce -> nonce in + let timestamp = Time.add (Time.now ()) 1L in + Client_proto_rpcs.Context.level rpc_config block >>=? fun level -> + let level = Raw_level.succ level.level in + get_first_priority level contract block >>=? fun priority -> + (Fitness_repr.to_int64 bi.fitness >|= + Register_client_embedded_proto_alpha.wrap_error) >>=? fun fitness -> + let fitness = + Fitness_repr.from_int64 @@ + Int64.add fitness (Int64.of_int @@ List.length operations + 1) in + Level.pp_full Format.str_formatter bi.level ; + inject_block + ~force + ~priority + ~timestamp + ~fitness + ~seed_nonce + ~src_sk:contract.sk + block + operations + + let endorsement_reward contract block = + Client_mining_blocks.info rpc_config block >>=? fun bi -> + get_first_priority bi.level.level contract block >>=? fun prio -> + Mining.endorsement_reward ~block_priority:(Int32.of_int prio) >|= + Register_client_embedded_proto_alpha.wrap_error >>|? + Tez.to_cents + +end + +module Endorse = struct + + let inject_endorsement + block + _level + ?async + ?force + src_sk + source + slot = + Client_blocks.get_block_hash rpc_config block >>=? fun block_hash -> + Client_node_rpcs.Blocks.net rpc_config block >>=? fun net -> + Client_proto_rpcs.Helpers.Forge.Delegate.endorsement rpc_config + block + ~net + ~source + ~block:block_hash + ~slot:slot + () >>=? fun bytes -> + let signed_bytes = Environment.Ed25519.Signature.append src_sk bytes in + Client_node_rpcs.inject_operation + rpc_config ?force ?async signed_bytes >>=? fun oph -> + return oph + + let signing_slots + ?(max_priority = 1024) + block + delegate + level = + Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate + rpc_config ~max_priority ~first_level:level ~last_level:level + block delegate () >>=? fun possibilities -> + let slots = + List.map (fun (_,slot) -> slot) + @@ List.filter (fun (l, _) -> l = level) possibilities in + return slots + + let endorse + ?(force = false) + ?slot + (contract : Account.t) + block = + Client_proto_rpcs.Context.level rpc_config block >>=? fun level -> + let level = Raw_level.succ @@ level.level in + begin + match slot with + | Some slot -> return slot + | None -> begin + signing_slots + block contract.Account.pkh + level >>=? function + | slot::_ -> return slot + | [] -> + failwith "No slot found at level %a" Raw_level.pp level + end + end >>=? fun slot -> + inject_endorsement + block level contract.sk contract.pk slot ~force >>=? fun oph -> + return oph + + (* FIXME @vb: I don't understand this function, copied from @cago. *) + let endorsers_list block { Account.b1 ; b2 ; b3 ; b4 ; b5 } = + let get_endorser_list result (account : Account.t) level block = + Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate + rpc_config block account.pkh + ~max_priority:16 + ~first_level:level + ~last_level:level () >>|? fun slots -> + List.iter (fun (_,slot) -> result.(slot) <- account) slots + in + let result = Array.make 16 b1 in + Client_proto_rpcs.Context.level rpc_config block >>=? fun level -> + let level = Raw_level.succ @@ level.level in + get_endorser_list result b1 level block >>=? fun () -> + get_endorser_list result b2 level block >>=? fun () -> + get_endorser_list result b3 level block >>=? fun () -> + get_endorser_list result b4 level block >>=? fun () -> + get_endorser_list result b5 level block >>=? fun () -> + return result + + let endorsement_rights + ?(max_priority = 1024) + (contract : Account.t) block = + Client_proto_rpcs.Context.level rpc_config block >>=? fun level -> + let delegate = contract.pkh in + let level = level.level in + Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate + rpc_config + ~max_priority + ~first_level:level + ~last_level:level + block delegate () + +end diff --git a/test/proto_alpha/proto_alpha_helpers.mli b/test/proto_alpha/proto_alpha_helpers.mli new file mode 100644 index 000000000..689f5f77d --- /dev/null +++ b/test/proto_alpha/proto_alpha_helpers.mli @@ -0,0 +1,193 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Client_embedded_proto_alpha +open Tezos_context +open Client_alpha + +val init : unit -> (int * Block_hash.t) tzresult Lwt.t +(** [init ()] sets up the test environment, and return the PID of + forked Tezos node and the block info of the block from where the + tests will begin. *) + +module Account : sig + + type t = { + alias : string ; + sk : Ed25519.Secret_key.t ; + pk : Ed25519.Public_key.t ; + pkh : Ed25519.Public_key_hash.t ; + contract : Contract.t ; + } + + val encoding : t Data_encoding.t + val pp_account : Format.formatter -> t -> unit + val create : ?keys:(secret_key * public_key) -> string -> t + (** [create ?keys alias] is an account with alias [alias]. If + [?keys] is [None], a pair of keys will be minted. *) + + type destination = { + alias : string ; + contract : Contract.t ; + pk : public_key ; + pkh : public_key_hash ; + } + + val destination_encoding : destination Data_encoding.t + val pp_destination : Format.formatter -> destination -> unit + val create_destination : + alias:string -> + contract:Contract.t -> + pk:public_key -> destination + (** [create_destination ~alias ~contract ~pk] is a destination + contract [contract] with manager's publick key [pk]. *) + + type bootstrap_accounts = { b1 : t ; b2 : t ; b3 : t ; b4 : t ; b5 : t } + + val bootstrap_accounts : bootstrap_accounts + (** The hardcoded bootstrap accounts. *) + + val transfer : + ?block:Client_proto_rpcs.block -> + ?fee:int64 -> + account:t -> + destination:Contract.t -> + amount:int64 -> + unit -> + (Operation_hash.t * Contract.t list) tzresult Lwt.t + + val originate : + ?block:Client_proto_rpcs.block -> + ?delegate:public_key_hash -> + ?fee:int64 -> + src:t -> + manager_pkh:public_key_hash -> + spendable:bool -> + balance:int64 -> + unit -> (Operation_hash.t * Contract.t) tzresult Lwt.t + + val set_delegate : + ?block:Client_proto_rpcs.block -> + ?fee:int64 -> + contract:Contract.t -> + manager_sk:secret_key -> + public_key_hash option -> + Operation_hash.t tzresult Lwt.t + + val balance : ?block:Client_proto_rpcs.block -> t -> Tez.t tzresult Lwt.t + + val delegate : + ?block:Client_proto_rpcs.block -> + Contract.t -> + public_key_hash option tzresult Lwt.t + +end + +module Mining : sig + + val get_first_priority : + ?max_priority:int -> + Raw_level.t -> + Account.t -> + Client_proto_rpcs.block -> + int tzresult Lwt.t + (** [get_first_priority ?max_prio level account block] is the + best (first) mining priority on [block] for [account] at + [level]. *) + + val mine_stamp : + Client_proto_rpcs.block -> + secret_key -> + Updater.shell_block -> + Block.mining_slot -> + Nonce_hash.t -> + MBytes.t tzresult Lwt.t + + val inject_block : + Client_node_rpcs.Blocks.block -> + ?force:bool -> + priority:int -> + timestamp:Time.t -> + fitness:Fitness.t -> + seed_nonce:Nonce.nonce -> + src_sk:secret_key -> + Operation_hash.t list -> Block_hash.t tzresult Lwt.t + + val mine : + ?force:bool -> + ?operations:Operation_hash.t list -> + Account.t -> + Client_node_rpcs.Blocks.block -> + Block_hash.t tzresult Lwt.t + + val endorsement_reward : + Account.t -> + Client_node_rpcs.Blocks.block -> + int64 tzresult Lwt.t +end + +module Endorse : sig + + val endorse : + ?force:bool -> + ?slot:int -> + Account.t -> + Client_alpha.Client_proto_rpcs.block -> + Operation_hash.t tzresult Lwt.t + + val endorsers_list : + Client_alpha.Client_proto_rpcs.block -> + Account.bootstrap_accounts -> + Account.t array tzresult Lwt.t + + val endorsement_rights : + ?max_priority:int -> + Account.t -> + Client_proto_rpcs.block -> + Client_proto_rpcs.Helpers.Rights.endorsement_slot list tzresult Lwt.t + +end + +module Assert : sig + + include module type of Assert + + val balance_equal: + msg:string -> Account.t -> int64 -> unit tzresult Lwt.t + val delegate_equal: + msg:string -> Contract.t -> public_key_hash option -> unit tzresult Lwt.t + + val ecoproto_error: + (Register_client_embedded_proto_alpha.Packed_protocol.error -> bool) -> + Error_monad.error -> bool + + val generic_economic_error : msg:string -> 'a tzresult -> unit + + (** Transaction assertions *) + + val unknown_contract : msg:string -> 'a tzresult -> unit + (** [unknown_contract ~msg result] raises if result is not a + [Storage_error]. *) + val non_existing_contract : msg:string -> 'a tzresult -> unit + val balance_too_low : msg:string -> 'a tzresult -> unit + val non_spendable : msg:string -> 'a tzresult -> unit + val inconsistent_pkh : msg:string -> 'a tzresult -> unit + + (** Origination assertions *) + + val initial_amount_too_low : msg:string -> 'a tzresult -> unit + val non_delegatable : msg:string -> 'a tzresult -> unit + + (** Endorsement / mining assertions *) + + val wrong_delegate : msg:string -> 'a tzresult -> unit + + val invalid_endorsement_slot : msg:string -> 'a tzresult -> unit + +end diff --git a/test/proto_alpha/sandbox.json b/test/proto_alpha/sandbox.json new file mode 100644 index 000000000..54a3bfec8 --- /dev/null +++ b/test/proto_alpha/sandbox.json @@ -0,0 +1,15 @@ +{ + "genesis_pubkey": + "edpkuSLWfVU1Vq7Jg9FucPyKmma6otcMHac9zG4oU1KMHSTBpJuGQ2", + "bootstrap_keys": [ + "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav", + "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9", + "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV", + "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU", + "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n" + ], + "slot_durations" : [ 1, 0 ], + "cycle_length" : 4, + "time_before_reward" : 1, + "first_free_mining_slot" : 4 +} diff --git a/test/proto_alpha/test_transaction.ml b/test/proto_alpha/test_transaction.ml new file mode 100644 index 000000000..af3802f06 --- /dev/null +++ b/test/proto_alpha/test_transaction.ml @@ -0,0 +1,120 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Client_embedded_proto_alpha +open Tezos_context + +module Helpers = Proto_alpha_helpers +module Assert = Helpers.Assert + +let run blkid ({ b1 ; b2 ; b3 ; _ } : Helpers.Account.bootstrap_accounts) = + + Helpers.Mining.mine b1 blkid >>=? fun blkh -> + let foo = Helpers.Account.create "foo" in + let bar = Helpers.Account.create "bar" in + + (* Send from a sender with no balance (never seen). *) + (* TODO: Is it OK to get Storage_error and not something more specific? *) + Helpers.Account.transfer + ~account:foo + ~destination:b1.contract + ~amount:1000_00L () >>= fun result -> + Assert.unknown_contract ~msg:__LOC__ result ; + + (* Send 1000 tz to "foo". *) + Helpers.Account.transfer + ~account:b1 + ~destination:foo.contract + ~amount:1000_00L () >>=? fun (_oph, contracts) -> + Assert.balance_equal ~msg:__LOC__ foo 1000_00L >>=? fun () -> + + (* Check that a basic transfer originates no contracts. *) + Assert.equal_int ~msg:__LOC__ 0 (List.length contracts) ; + + (* Check sender/receiver balance post transaction *) + Helpers.Account.transfer + ~account:foo + ~destination:bar.contract + ~amount:50_00L () >>=? fun _contracts -> + Assert.balance_equal ~msg:__LOC__ foo 949_95L >>=? fun () -> + Assert.balance_equal ~msg:__LOC__ bar 50_00L >>=? fun () -> + + (* Check balance too low. *) + Helpers.Account.transfer + ~account:bar + ~destination:foo.contract + ~amount:1000_00L () >>= fun result -> + Assert.balance_too_low ~msg:__LOC__ result ; + + (* Check non-spendability of a non-spendable contract *) + (* TODO: Unspecified economic error: should be more specific. *) + Helpers.Account.originate + ~src:foo + ~manager_pkh:foo.pkh + ~spendable:false + ~balance:50_00L () >>=? fun (_oph, non_spendable) -> + Format.printf "Created non-spendable contract %a@." Contract.pp non_spendable ; + let account = { foo with contract = non_spendable } in + Helpers.Account.transfer + ~account + ~destination:bar.contract + ~amount:10_00L () >>= fun result -> + Assert.non_spendable ~msg:__LOC__ result ; + + (* Check spendability of a spendable contract *) + Helpers.Account.originate + ~src:foo + ~manager_pkh:foo.pkh + ~spendable:true + ~balance:50_00L () >>=? fun (_oph, spendable) -> + Format.printf "Created contract %a@." Contract.pp spendable ; + let account = { foo with contract = spendable } in + Helpers.Account.transfer + ~account + ~destination:foo.contract + ~amount:10_00L () >>=? fun _contracts -> + + (* Try spending a default account with unmatching pk/sk pairs. *) + let account = { b1 with sk = b2.sk } in + Helpers.Account.transfer + ~account + ~destination:b2.contract + ~amount:10_00L () >>= fun result -> + Assert.generic_economic_error ~msg:__LOC__ result ; + + (* Try spending a default account with keys not matching the + contract pkh. *) + let account = { b1 with contract = b2.contract } in + Helpers.Account.transfer + ~account + ~destination:b3.contract + ~amount:10_00L () >>= fun result -> + Assert.inconsistent_pkh ~msg:__LOC__ result ; + + (* Try spending an originated contract without the manager's key. *) + let account = { b1 with contract = spendable } in + Helpers.Account.transfer + ~account + ~destination:b2.contract + ~amount:10_00L () >>= fun result -> + Assert.inconsistent_pkh ~msg:__LOC__ result ; + + return blkh + +let main () = + Helpers.init () >>=? fun (_node_pid, hash) -> + run (`Hash hash) Helpers.Account.bootstrap_accounts >>=? fun _blkh -> + return () + +let tests = [ + "main", (fun _ -> main ()) ; +] + +let () = + Test.run "transactions." tests diff --git a/test/proto_alpha/test_transaction.mli b/test/proto_alpha/test_transaction.mli new file mode 100644 index 000000000..76a0bb6b7 --- /dev/null +++ b/test/proto_alpha/test_transaction.mli @@ -0,0 +1,8 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************)