Commit 1b91d092 authored by Benjamin Canou's avatar Benjamin Canou Committed by Grégoire Henry

Michelson: read some constants in base58 but store them in binary

parent ff4a5fad
......@@ -314,11 +314,11 @@ assert_storage $contract_dir/map_caddaadr.tz \
# Did the given key sign the string? (key is bootstrap1)
assert_success $client run program $contract_dir/check_signature.tz \
on storage '(Pair "1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01" "hello")' \
on storage '(Pair 0x011eb640b67c1859228a72730fae1a006bb94a999395dfb569e2776e9c1ae546376247f001343a1042f92082690f6aa2e6ed230df319b09767d9807ef3f8191f "hello")' \
and input '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"'
assert_fails $client run program $contract_dir/check_signature.tz \
on storage '(Pair "1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01" "abcd")' \
on storage '(Pair 0x011eb640b67c1859228a72730fae1a006bb94a999395dfb569e2776e9c1ae546376247f001343a1042f92082690f6aa2e6ed230df319b09767d9807ef3f8191f "abcd")' \
and input '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"'
......
......@@ -14,12 +14,12 @@
v1/format.mli
;; Part of external libraries
v1/mBytes.mli
v1/z.mli
v1/lwt.mli
v1/lwt_list.mli
;; Tezos extended stdlib
v1/mBytes.mli
v1/compare.mli
v1/data_encoding.mli
v1/error_monad.mli
......
......@@ -76,6 +76,9 @@ val to_int: t -> int
val of_int: int -> t
(** Converts from a base integer. *)
val to_bits: ?pad_to:int -> t -> MBytes.t
val of_bits: MBytes.t -> t
val equal: t -> t -> bool
val compare: t -> t -> int
......
......@@ -188,11 +188,25 @@ module Make (Context : CONTEXT) = struct
module Buffer = Buffer
module Format = Format
module Option = Option
module Z = Z
module MBytes = MBytes
module Z = struct
include Z
let to_bits ?(pad_to = 0) z =
let bits = to_bits z in
let len = Pervasives.((numbits z + 7) / 8) in
let full_len = Compare.Int.max pad_to len in
if full_len = 0 then
MBytes.empty
else
let res = MBytes.make full_len '\000' in
MBytes.blit_of_string bits 0 res 0 len ;
res
let of_bits bytes =
of_bits (MBytes.to_string bytes)
end
module Lwt_sequence = Lwt_sequence
module Lwt = Lwt
module Lwt_list = Lwt_list
module MBytes = MBytes
module Uri = Uri
module Data_encoding = Data_encoding
module Time = Time
......
......@@ -120,8 +120,7 @@ let trace
let hash_and_sign ?gas (data : Michelson_v1_parser.parsed) (typ : Michelson_v1_parser.parsed) sk block cctxt =
Alpha_services.Helpers.hash_data cctxt block (data.expanded, typ.expanded, gas) >>=? fun (hash, gas) ->
Client_keys.sign sk (MBytes.of_string hash) >>=? fun signature ->
let `Hex signature = Signature.to_hex signature in
return (hash, signature, gas)
return (hash, Signature.to_b58check signature, gas)
let typecheck_data
?gas
......
......@@ -398,7 +398,7 @@ let cleanup_balance_updates balance_updates =
not (Tez.equal update Tez.zero))
balance_updates
let apply_manager_operation_content ctxt ~payer ~source ~internal operation =
let apply_manager_operation_content ctxt mode ~payer ~source ~internal operation =
let before_operation = ctxt in
Contract.must_exist ctxt source >>=? fun () ->
let spend =
......@@ -449,7 +449,7 @@ let apply_manager_operation_content ctxt ~payer ~source ~internal operation =
| None, _ -> fail (Bad_contract_parameter (destination, Some arg_type, None))
end >>=? fun (ctxt, parameter) ->
Script_interpreter.execute
ctxt ~source ~payer ~self:(destination, script) ~amount ~parameter
ctxt mode ~source ~payer ~self:(destination, script) ~amount ~parameter
>>=? fun { ctxt ; storage ; big_map_diff ; operations } ->
Contract.used_storage_space ctxt destination >>=? fun old_size ->
Contract.update_script_storage
......@@ -477,7 +477,7 @@ let apply_manager_operation_content ctxt ~payer ~source ~internal operation =
| None -> return (None, ctxt)
| Some script ->
Script_ir_translator.parse_script ctxt script >>=? fun (_, ctxt) ->
Script_ir_translator.erase_big_map_initialization ctxt script >>=? fun (script, big_map_diff, ctxt) ->
Script_ir_translator.erase_big_map_initialization ctxt Optimized script >>=? fun (script, big_map_diff, ctxt) ->
return (Some (script, big_map_diff), ctxt)
end >>=? fun (script, ctxt) ->
spend ctxt source credit >>=? fun ctxt ->
......@@ -505,7 +505,7 @@ let apply_manager_operation_content ctxt ~payer ~source ~internal operation =
set_delegate ctxt source delegate >>=? fun ctxt ->
return (ctxt, Delegation_result)
let apply_internal_manager_operations ctxt ~payer ops =
let apply_internal_manager_operations ctxt mode ~payer ops =
let rec apply ctxt applied worklist =
match worklist with
| [] -> Lwt.return (Ok (ctxt, applied))
......@@ -514,7 +514,7 @@ let apply_internal_manager_operations ctxt ~payer ops =
fail (Internal_operation_replay op)
else
let ctxt = record_internal_nonce ctxt nonce in
apply_manager_operation_content ctxt ~source ~payer ~internal:true operation
apply_manager_operation_content ctxt mode ~source ~payer ~internal:true operation
end >>= function
| Error errors ->
let result = Internal op, Failed errors in
......@@ -526,12 +526,12 @@ let apply_internal_manager_operations ctxt ~payer ops =
apply ctxt ((Internal op, Applied result) :: applied) rest in
apply ctxt [] ops
let apply_manager_operations ctxt source ops =
let apply_manager_operations ctxt mode source ops =
let rec apply ctxt applied ops =
match ops with
| [] -> Lwt.return (Ok (ctxt, List.rev applied))
| operation :: rest ->
apply_manager_operation_content ctxt ~source ~payer:source ~internal:false operation
apply_manager_operation_content ctxt mode ~source ~payer:source ~internal:false operation
>>= function
| Error errors ->
let result = External, Failed errors in
......@@ -542,7 +542,7 @@ let apply_manager_operations ctxt source ops =
match result with
| Transaction_result { operations = emitted ; _ } -> emitted
| _ -> [] in
apply_internal_manager_operations ctxt ~payer:source emitted
apply_internal_manager_operations ctxt mode ~payer:source emitted
>>= function
| Error (results) ->
let result = (External, Applied result) in
......@@ -554,7 +554,7 @@ let apply_manager_operations ctxt source ops =
apply ctxt applied rest in
apply ctxt [] ops
let apply_sourced_operation ctxt pred_block operation ops =
let apply_sourced_operation ctxt mode pred_block operation ops =
match ops with
| Manager_operations { source ; fee ; counter ; operations ; gas_limit ; storage_limit } ->
let revealed_public_keys =
......@@ -580,7 +580,7 @@ let apply_sourced_operation ctxt pred_block operation ops =
let ctxt = reset_internal_nonce ctxt in
Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt ->
Lwt.return (Contract.set_storage_limit ctxt storage_limit) >>=? fun ctxt ->
apply_manager_operations ctxt source operations >>= begin function
apply_manager_operations ctxt mode source operations >>= begin function
| Ok (ctxt, operation_results) -> return (ctxt, operation_results)
| Error operation_results -> return (ctxt (* backtracked *), operation_results)
end >>=? fun (ctxt, operation_results) ->
......@@ -715,7 +715,7 @@ let apply_anonymous_operation ctxt kind =
Contract.(credit ctxt (implicit_contract (Signature.Ed25519 pkh)) amount) >>=? fun ctxt ->
return (ctxt, Activation_result [(* FIXME *)])
let apply_operation ctxt pred_block hash operation =
let apply_operation ctxt mode pred_block hash operation =
let ctxt = Contract.init_origination_nonce ctxt hash in
begin match operation.contents with
| Anonymous_operations ops ->
......@@ -727,7 +727,7 @@ let apply_operation ctxt pred_block hash operation =
>>=? fun (ctxt, results) ->
return (ctxt, Anonymous_operations_result (List.rev results))
| Sourced_operation ops ->
apply_sourced_operation ctxt pred_block operation ops
apply_sourced_operation ctxt mode pred_block operation ops
>>=? fun (ctxt, result) ->
return (ctxt, Sourced_operation_result result)
end >>=? fun (ctxt, result) ->
......
......@@ -19,17 +19,20 @@ type info = {
delegate: bool * public_key_hash option ;
counter: int32 ;
script: Script.t option ;
storage: Script.expr option ;
}
let info_encoding =
let open Data_encoding in
conv
(fun {manager ; balance ; spendable ; delegate ; script ; counter ; storage } ->
(manager, balance, spendable, delegate, script, storage, counter))
(fun (manager, balance, spendable, delegate, script, storage, counter) ->
{manager ; balance ; spendable ; delegate ; script ; storage ; counter}) @@
obj7
(fun {manager ; balance ; spendable ; delegate ;
script ; counter } ->
(manager, balance, spendable, delegate,
script, counter))
(fun (manager, balance, spendable, delegate,
script, counter) ->
{manager ; balance ; spendable ; delegate ;
script ; counter}) @@
obj6
(req "manager" Signature.Public_key_hash.encoding)
(req "balance" Tez.encoding)
(req "spendable" bool)
......@@ -37,7 +40,6 @@ let info_encoding =
(req "setable" bool)
(opt "value" Signature.Public_key_hash.encoding))
(opt "script" Script.encoding)
(opt "storage" Script.expr_encoding)
(req "counter" int32)
module S = struct
......@@ -172,8 +174,17 @@ let () =
register_field S.delegatable Contract.is_delegatable ;
register_opt_field S.script
(fun c v -> Contract.get_script c v >>=? fun (_, v) -> return v) ;
register_opt_field S.storage
(fun c v -> Contract.get_storage c v >>=? fun (_, v) -> return v) ;
register_opt_field S.storage (fun ctxt contract ->
Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
match script with
| None -> return None
| Some script ->
let ctxt = Gas.set_unlimited ctxt in
let open Script_ir_translator in
parse_script ctxt script >>=? fun (Ex_script script, ctxt) ->
unparse_script ctxt Readable script >>=? fun (script, _ctxt) ->
Lwt.return (Script.force_decode script.storage) >>=? fun storage ->
return (Some storage)) ;
register_field S.info (fun ctxt contract ->
Contract.get_balance ctxt contract >>=? fun balance ->
Contract.get_manager ctxt contract >>=? fun manager ->
......@@ -182,10 +193,18 @@ let () =
Contract.is_delegatable ctxt contract >>=? fun delegatable ->
Contract.is_spendable ctxt contract >>=? fun spendable ->
Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
Contract.get_storage ctxt contract >>=? fun (_ctxt, storage) ->
begin match script with
| None -> return (None, ctxt)
| Some script ->
let ctxt = Gas.set_unlimited ctxt in
let open Script_ir_translator in
parse_script ctxt script >>=? fun (Ex_script script, ctxt) ->
unparse_script ctxt Readable script >>=? fun (script, ctxt) ->
return (Some script, ctxt)
end >>=? fun (script, _ctxt) ->
return { manager ; balance ;
spendable ; delegate = (delegatable, delegate) ;
script ; counter ; storage})
script ; counter })
let list ctxt block =
RPC_context.make_call0 S.list ctxt block () ()
......
......@@ -19,7 +19,6 @@ type info = {
delegate: bool * public_key_hash option ;
counter: int32 ;
script: Script.t option ;
storage: Script.expr option ;
}
val info_encoding: info Data_encoding.t
......
......@@ -141,7 +141,7 @@ module I = struct
| None -> Error_monad.fail Operation.Cannot_parse_operation
| Some (shell, contents) ->
let operation = { shell ; contents ; signature } in
Apply.apply_operation ctxt pred_block hash operation
Apply.apply_operation ctxt Readable pred_block hash operation
>>=? fun (_, result) -> return result
end
......@@ -161,7 +161,7 @@ let () =
let storage = Script.lazy_expr storage in
let code = Script.lazy_expr code in
Script_interpreter.execute
ctxt
ctxt Readable
~source:contract (* transaction initiator *)
~payer:contract (* storage fees payer *)
~self:(contract, { storage ; code }) (* script owner *)
......@@ -176,7 +176,7 @@ let () =
let storage = Script.lazy_expr storage in
let code = Script.lazy_expr code in
Script_interpreter.trace
ctxt
ctxt Readable
~source:contract (* transaction initiator *)
~payer:contract (* storage fees payer *)
~self:(contract, { storage ; code }) (* script owner *)
......@@ -205,7 +205,7 @@ let () =
| Some gas -> Lwt.return (Gas.set_limit ctxt gas) end >>=? fun ctxt ->
Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:false (Micheline.root typ)) >>=? fun (Ex_ty typ, _) ->
parse_data ctxt typ (Micheline.root expr) >>=? fun (data, ctxt) ->
Lwt.return (Script_ir_translator.hash_data ctxt typ data) >>=? fun (hash, ctxt) ->
Script_ir_translator.hash_data ctxt typ data >>=? fun (hash, ctxt) ->
return (hash, Gas.level ctxt)
end ;
register1 S.level begin fun ctxt raw () offset ->
......
......@@ -110,7 +110,7 @@ let apply_operation ({ mode ; ctxt ; op_count ; _ } as data) operation =
{ block_header = { shell = { predecessor ; _ } ; _ } ; _ }
| Full_construction { predecessor ; _ } ->
predecessor in
Apply.apply_operation ctxt predecessor
Apply.apply_operation ctxt Optimized predecessor
(Alpha_context.Operation.hash operation) operation >>=? fun (ctxt, _) ->
let op_count = op_count + 1 in
return { data with ctxt ; op_count }
......
......@@ -64,13 +64,13 @@ let unparse_stack ctxt (stack, stack_ty) =
(* We drop the gas limit as this function is only used for debugging/errors. *)
let ctxt = Gas.set_unlimited ctxt in
let rec unparse_stack
: type a. a stack * a stack_ty -> Script.expr list
: type a. a stack * a stack_ty -> Script.expr list tzresult Lwt.t
= function
| Empty, Empty_t -> []
| Empty, Empty_t -> return []
| Item (v, rest), Item_t (ty, rest_ty, _) ->
match unparse_data ctxt ty v with
| Ok (data, _ctxt) -> Micheline.strip_locations data :: unparse_stack (rest, rest_ty)
| Error _ -> assert false in
unparse_data ctxt Readable ty v >>=? fun (data, _ctxt) ->
unparse_stack (rest, rest_ty) >>=? fun rest ->
return (Micheline.strip_locations data :: rest) in
unparse_stack (stack, stack_ty)
module Interp_costs = Michelson_v1_gas.Cost_of
......@@ -100,7 +100,8 @@ let rec interp
match log with
| None -> return (ret, ctxt)
| Some log ->
log := (descr.loc, Gas.level ctxt, unparse_stack ctxt (ret, descr.aft)) :: !log ;
unparse_stack ctxt (ret, descr.aft) >>=? fun stack ->
log := (descr.loc, Gas.level ctxt, stack) :: !log ;
return (ret, ctxt) in
let consume_gas_terop : type ret arg1 arg2 arg3 rest.
(_ * (_ * (_ * rest)), ret * rest) descr ->
......@@ -588,7 +589,7 @@ let rec interp
| Transfer_tokens,
Item (p, Item (amount, Item ((tp, destination), rest))) ->
Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt ->
Lwt.return @@ unparse_data ctxt tp p >>=? fun (p, ctxt) ->
unparse_data ctxt Optimized tp p >>=? fun (p, ctxt) ->
let operation =
Transaction
{ amount ; destination ;
......@@ -623,7 +624,7 @@ let rec interp
(Seq (0, [ Prim (0, K_parameter, [ unparse_ty None param_type ], None) ;
Prim (0, K_storage, [ unparse_ty None storage_type ], None) ;
Prim (0, K_code, [ Micheline.root code ], None) ], None)) in
Lwt.return @@ unparse_data ctxt storage_type init >>=? fun (storage, ctxt) ->
unparse_data ctxt Optimized storage_type init >>=? fun (storage, ctxt) ->
let storage = Micheline.strip_locations storage in
Contract.spend_from_script ctxt self credit >>=? fun ctxt ->
Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->
......@@ -661,7 +662,7 @@ let rec interp
logged_return (Item (Signature.Public_key.hash key, rest), ctxt)
| H ty, Item (v, rest) ->
Lwt.return (Gas.consume ctxt (Interp_costs.hash v)) >>=? fun ctxt ->
Lwt.return @@ hash_data ctxt ty v >>=? fun (hash, ctxt) ->
hash_data ctxt ty v >>=? fun (hash, ctxt) ->
logged_return (Item (hash, rest), ctxt)
| Steps_to_quota, rest ->
Lwt.return (Gas.consume ctxt Interp_costs.steps_to_quota) >>=? fun ctxt ->
......@@ -680,16 +681,18 @@ let rec interp
logged_return (Item (amount, rest), ctxt) in
let stack = (Item (arg, Empty)) in
begin match log with
| None -> ()
| None -> return ()
| Some log ->
log := (code.loc, Gas.level ctxt, unparse_stack ctxt (stack, code.bef)) :: !log
end ;
unparse_stack ctxt (stack, code.bef) >>=? fun stack ->
log := (code.loc, Gas.level ctxt, stack) :: !log ;
return ()
end >>=? fun () ->
step ctxt code stack >>=? fun (Item (ret, Empty), ctxt) ->
return (ret, ctxt)
(* ---- contract handling ---------------------------------------------------*)
and execute ?log ctxt ~source ~payer ~self script amount arg :
and execute ?log ctxt mode ~source ~payer ~self script amount arg :
(Script.expr * internal_operation list * context *
Script_typed_ir.ex_big_map option) tzresult Lwt.t =
parse_script ctxt script
......@@ -700,7 +703,7 @@ and execute ?log ctxt ~source ~payer ~self script amount arg :
(Runtime_contract_error (self, script_code))
(interp ?log ctxt ~source ~payer ~self amount code (arg, storage))
>>=? fun ((ops, sto), ctxt) ->
Lwt.return @@ unparse_data ctxt storage_type sto >>=? fun (storage, ctxt) ->
unparse_data ctxt mode storage_type sto >>=? fun (storage, ctxt) ->
return (Micheline.strip_locations storage, ops, ctxt,
Script_ir_translator.extract_big_map storage_type sto)
......@@ -710,26 +713,26 @@ type execution_result =
big_map_diff : Contract.big_map_diff option ;
operations : internal_operation list }
let trace ctxt ~source ~payer ~self:(self, script) ~parameter ~amount =
let trace ctxt mode ~source ~payer ~self:(self, script) ~parameter ~amount =
let log = ref [] in
execute ~log ctxt ~source ~payer ~self script amount (Micheline.root parameter)
>>=? fun (storage, operations, ctxt, big_map_diff) ->
begin match big_map_diff with
execute ~log ctxt mode ~source ~payer ~self script amount (Micheline.root parameter)
>>=? fun (storage, operations, ctxt, big_map) ->
begin match big_map with
| None -> return (None, ctxt)
| Some big_map_diff ->
Script_ir_translator.to_serializable_big_map ctxt big_map_diff >>=? fun (big_map_diff, ctxt) ->
| Some big_map ->
Script_ir_translator.diff_of_big_map ctxt mode big_map >>=? fun (big_map_diff, ctxt) ->
return (Some big_map_diff, ctxt)
end >>=? fun (big_map_diff, ctxt) ->
let trace = List.rev !log in
return ({ ctxt ; storage ; big_map_diff ; operations }, trace)
let execute ctxt ~source ~payer ~self:(self, script) ~parameter ~amount =
execute ctxt ~source ~payer ~self script amount (Micheline.root parameter)
>>=? fun (storage, operations, ctxt, big_map_diff) ->
begin match big_map_diff with
let execute ctxt mode ~source ~payer ~self:(self, script) ~parameter ~amount =
execute ctxt mode ~source ~payer ~self script amount (Micheline.root parameter)
>>=? fun (storage, operations, ctxt, big_map) ->
begin match big_map with
| None -> return (None, ctxt)
| Some big_map_diff ->
Script_ir_translator.to_serializable_big_map ctxt big_map_diff >>=? fun (big_map_diff, ctxt) ->
| Some big_map ->
Script_ir_translator.diff_of_big_map ctxt mode big_map >>=? fun (big_map_diff, ctxt) ->
return (Some big_map_diff, ctxt)
end >>=? fun (big_map_diff, ctxt) ->
return { ctxt ; storage ; big_map_diff ; operations }
......@@ -21,6 +21,7 @@ type execution_result =
val execute:
Alpha_context.t ->
Script_ir_translator.unparsing_mode ->
source: Contract.t ->
payer: Contract.t ->
self: (Contract.t * Script.t) ->
......@@ -33,6 +34,7 @@ type execution_trace =
val trace:
Alpha_context.t ->
Script_ir_translator.unparsing_mode ->
source: Contract.t ->
payer: Contract.t ->
self: (Contract.t * Script.t) ->
......
......@@ -17,6 +17,8 @@ type ex_ty = Ex_ty : 'a Script_typed_ir.ty -> ex_ty
type ex_stack_ty = Ex_stack_ty : 'a Script_typed_ir.stack_ty -> ex_stack_ty
type ex_script = Ex_script : ('a, 'b) Script_typed_ir.script -> ex_script
type unparsing_mode = Optimized | Readable
(* ---- Sets and Maps -------------------------------------------------------*)
val empty_set : 'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.set
......@@ -60,7 +62,8 @@ val parse_data :
context ->
'a Script_typed_ir.ty -> Script.node -> ('a * context) tzresult Lwt.t
val unparse_data :
context -> 'a Script_typed_ir.ty -> 'a -> (Script.node * context) tzresult
context -> unparsing_mode ->
'a Script_typed_ir.ty -> 'a -> (Script.node * context) tzresult Lwt.t
val parse_ty :
allow_big_map: bool ->
......@@ -83,23 +86,23 @@ val typecheck_data :
val parse_script :
?type_logger: (int -> Script.expr list -> Script.expr list -> unit) ->
context -> Script.t -> (ex_script * context) tzresult Lwt.t
val unparse_script :
context -> unparsing_mode ->
('a, 'b) Script_typed_ir.script -> (Script.t * context) tzresult Lwt.t
val parse_contract :
context -> Script.location -> 'a Script_typed_ir.ty -> Contract.t ->
(context * 'a Script_typed_ir.typed_contract) tzresult Lwt.t
val hash_data : context -> 'a Script_typed_ir.ty -> 'a -> (string * context) tzresult
val hash_data : context -> 'a Script_typed_ir.ty -> 'a -> (string * context) tzresult Lwt.t
val extract_big_map : 'a Script_typed_ir.ty -> 'a -> Script_typed_ir.ex_big_map option
val extract_big_map :
'a Script_typed_ir.ty -> 'a -> Script_typed_ir.ex_big_map option
val to_serializable_big_map :
context -> Script_typed_ir.ex_big_map ->
val diff_of_big_map :
context -> unparsing_mode -> Script_typed_ir.ex_big_map ->
(Contract.big_map_diff * context) tzresult Lwt.t
val to_printable_big_map :
context -> Script_typed_ir.ex_big_map ->
(Script.expr * Script.expr option) list
val erase_big_map_initialization :
context -> Script.t ->
context -> unparsing_mode -> Script.t ->
(Script.t * Contract.big_map_diff option * context) tzresult Lwt.t
......@@ -38,7 +38,7 @@ let operation
return @@ Helpers_operation.apply_of_proto src op_sh proto_op >>=? fun operation ->
let hash = Proto_alpha.Alpha_context.Operation.hash operation in
Proto_alpha.Apply.apply_operation
tc
tc Readable
pred_block_hash
hash
operation
......
......@@ -32,7 +32,7 @@ let execute_code_pred
Lwt.return (Proto_alpha.Alpha_context.Gas.set_limit tc gas) >>=? fun tc ->
let tc = Contract.init_origination_nonce tc hash in
Script_interpreter.execute
tc
tc Readable
~source: op.contract
~payer: op.contract
~self: (dst, script)
......
......@@ -47,7 +47,7 @@ let expect_big_map tc contract print_key key_type print_data data_type contents
let open Proto_alpha.Error_monad in
iter_p
(fun (n, exp) ->
Lwt.return @@ Proto_alpha.Script_ir_translator.hash_data tc key_type n >>=? fun (key, tc) ->
Proto_alpha.Script_ir_translator.hash_data tc key_type n >>=? fun (key, tc) ->
Proto_alpha.Alpha_context.Contract.Big_map.get_opt tc contract key >>=? fun (_tc, data) ->
match data, exp with
| None, None ->
......
......@@ -65,7 +65,7 @@ let parse_execute sb ?tc code_str param_str storage_str =
>>=?? fun (dst, { ctxt = tc ; operations = ops ; big_map_diff = bgm }) ->
let payer =
(List.hd Account.bootstrap_accounts).contract in
Proto_alpha.Apply.apply_internal_manager_operations tc ~payer ops >>= function
Proto_alpha.Apply.apply_internal_manager_operations tc Readable ~payer ops >>= function
| Error result ->
let _, err = extract_result result in
Lwt.return (Alpha_environment.wrap_error (Error_monad.error (List.hd err)))
......@@ -409,9 +409,9 @@ let test_example () =
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 1000000) 4) 5))) 6)" >>=? fun _ ->
(* Did the given key sign the string? (key is bootstrap1) *)
test_success ~location: __LOC__ "check_signature" "(Pair \"1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01\" \"hello\")" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" >>=? fun _ ->
test_success ~location: __LOC__ "check_signature" "(Pair \"edsigtbsm9RwhfQuJWSmZrvbDqDR9t1TJs34KrX4wkt9uUJ4PJG1aT6uLDiCqKz6vcGZAbNpoW7PvXUzdXo1E3c6ap6GoUU366J\" \"hello\")" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" >>=? fun _ ->
test_fails ~location: __LOC__ "check_signature" "(Pair \"1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01\" \"abcd\")" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" >>=? fun _ ->
test_fails ~location: __LOC__ "check_signature" "(Pair \"edsigtbsm9RwhfQuJWSmZrvbDqDR9t1TJs34KrX4wkt9uUJ4PJG1aT6uLDiCqKz6vcGZAbNpoW7PvXUzdXo1E3c6ap6GoUU366J\" \"abcd\")" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" >>=? fun _ ->
(* Convert a public key to a public key hash *)
test_output ~location: __LOC__ "hash_key" "None" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" "(Some \"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx\")" >>=? fun _ ->
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment