Proto/Alpha: some unit tests for 'transactions'

.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
 
 **/*~
 **/\#*\#

.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
 
 *~
 \#*\#

.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:

test/Makefile

@@ -2,7 +2,8 @@
 DIR := \
   utils \
   shell \
-  p2p
+  p2p \
+  proto_alpha
 
 all: build run
 

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

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
+

test/proto_alpha/proto_alpha_helpers.ml

@@ -0,0 +1,555 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    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

test/proto_alpha/proto_alpha_helpers.mli

@@ -0,0 +1,193 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    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

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
+}

test/proto_alpha/test_transaction.ml

@@ -0,0 +1,120 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    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

test/proto_alpha/test_transaction.mli

@@ -0,0 +1,8 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)