ligo/src/proto_alpha/lib_client/client_proto_context.ml
2018-06-06 10:54:33 +02:00

323 lines
11 KiB
OCaml

(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Proto_alpha
open Alpha_context
open Tezos_micheline
open Client_proto_contracts
open Client_keys
let get_balance (rpc : #Proto_alpha.rpc_context) ~chain ~block contract =
Alpha_services.Contract.balance rpc (chain, block) contract
let get_storage (rpc : #Proto_alpha.rpc_context) ~chain ~block contract =
Alpha_services.Contract.storage_opt rpc (chain, block) contract
let parse_expression arg =
Lwt.return
(Micheline_parser.no_parsing_error
(Michelson_v1_parser.parse_expression arg))
let transfer (cctxt : #Proto_alpha.full)
~chain ~block ?confirmations
?branch ~source ~src_pk ~src_sk ~destination ?arg
~amount ~fee ?gas_limit ?storage_limit () =
begin match arg with
| Some arg ->
parse_expression arg >>=? fun { expanded = arg } ->
return (Some arg)
| None -> return None
end >>=? fun parameters ->
let parameters = Option.map ~f:Script.lazy_expr parameters in
let contents = Transaction { amount ; parameters ; destination } in
Injection.inject_manager_operation
cctxt ~chain ~block ?confirmations
?branch ~source ~fee ?gas_limit ?storage_limit
~src_pk ~src_sk contents >>=? fun (_oph, _op, result as res) ->
Lwt.return
(Injection.originated_contracts (Single_result result)) >>=? fun contracts ->
return (res, contracts)
let reveal cctxt
~chain ~block ?confirmations
?branch ~source ~src_pk ~src_sk ~fee () =
Alpha_services.Contract.counter
cctxt (chain, block) source >>=? fun pcounter ->
let counter = Int32.succ pcounter in
Alpha_services.Contract.manager_key
cctxt (chain, block) source >>=? fun (_, key) ->
match key with
| Some _ ->
failwith "The manager key was previously revealed."
| None -> begin
let contents =
Single
(Manager_operation { source ; fee ; counter ;
gas_limit = Z.zero ; storage_limit = 0L ;
operation = Reveal src_pk }) in
Injection.inject_operation cctxt ~chain ~block ?confirmations
?branch ~src_sk contents >>=? fun (oph, op, result) ->
match Apply_operation_result.pack_contents_list op result with
| Apply_operation_result.Single_and_result
(Manager_operation _ as op, result) ->
return (oph, op, result)
| _ -> .
end
let originate
cctxt ~chain ~block ?confirmations
?branch ~source ~src_pk ~src_sk ~fee
?gas_limit ?storage_limit contents =
Injection.inject_manager_operation
cctxt ~chain ~block ?confirmations
?branch ~source ~fee ?gas_limit ?storage_limit
~src_pk ~src_sk contents >>=? fun (_oph, _op, result as res) ->
Lwt.return
(Injection.originated_contracts (Single_result result)) >>=? function
| [ contract ] -> return (res, contract)
| contracts ->
failwith
"The origination introduced %d contracts instead of one."
(List.length contracts)
let originate_account
cctxt ~chain ~block ?confirmations
?branch ~source ~src_pk ~src_sk ~manager_pkh
?(delegatable = false) ?delegate ~balance ~fee () =
let origination =
Origination { manager = manager_pkh ;
delegate ;
script = None ;
spendable = true ;
delegatable ;
credit = balance ;
preorigination = None } in
originate
cctxt ~chain ~block ?confirmations
?branch ~source ~gas_limit:Z.zero ~src_pk ~src_sk ~fee origination
let delegate_contract cctxt
~chain ~block ?branch ?confirmations
~source ~src_pk ~src_sk
~fee delegate_opt =
let operation = Delegation delegate_opt in
Injection.inject_manager_operation
cctxt ~chain ~block ?confirmations
?branch ~source ~fee ~gas_limit:Z.zero ~storage_limit:0L
~src_pk ~src_sk operation >>=? fun res ->
return res
let list_contract_labels
(cctxt : #Proto_alpha.full)
~chain ~block =
Alpha_services.Contract.list cctxt (chain, block) >>=? fun contracts ->
map_s (fun h ->
begin match Contract.is_implicit h with
| Some m -> begin
Public_key_hash.rev_find cctxt m >>=? function
| None -> return ""
| Some nm ->
RawContractAlias.find_opt cctxt nm >>=? function
| None -> return (" (known as " ^ nm ^ ")")
| Some _ -> return (" (known as key:" ^ nm ^ ")")
end
| None -> begin
RawContractAlias.rev_find cctxt h >>=? function
| None -> return ""
| Some nm -> return (" (known as " ^ nm ^ ")")
end
end >>=? fun nm ->
let kind = match Contract.is_implicit h with
| Some _ -> " (implicit)"
| None -> "" in
let h_b58 = Contract.to_b58check h in
return (nm, h_b58, kind))
contracts
let message_added_contract (cctxt : #Proto_alpha.full) name =
cctxt#message "Contract memorized as %s." name
let get_manager
(cctxt : #Proto_alpha.full)
~chain ~block source =
Client_proto_contracts.get_manager
cctxt ~chain ~block source >>=? fun src_pkh ->
Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) ->
return (src_name, src_pkh, src_pk, src_sk)
let set_delegate
cctxt ~chain ~block ?confirmations
~fee contract ~src_pk ~manager_sk opt_delegate =
delegate_contract
cctxt ~chain ~block ?confirmations
~source:contract ~src_pk ~src_sk:manager_sk ~fee opt_delegate
let register_as_delegate
cctxt ~chain ~block ?confirmations
~fee ~manager_sk src_pk =
let source = Signature.Public_key.hash src_pk in
delegate_contract
cctxt ~chain ~block ?confirmations
~source:(Contract.implicit_contract source) ~src_pk ~src_sk:manager_sk ~fee
(Some source)
let source_to_keys (wallet : #Proto_alpha.full) ~chain ~block source =
get_manager
wallet ~chain ~block
source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
return (src_pk, src_sk)
let save_contract ~force cctxt alias_name contract =
RawContractAlias.add ~force cctxt alias_name contract >>=? fun () ->
message_added_contract cctxt alias_name >>= fun () ->
return ()
let originate_contract
(cctxt : #Proto_alpha.full)
~chain ~block ?confirmations ?branch
~fee
?gas_limit
?storage_limit
~delegate
?(delegatable=true)
?(spendable=false)
~initial_storage
~manager
~balance
~source
~src_pk
~src_sk
~code
() =
Lwt.return (Michelson_v1_parser.parse_expression initial_storage) >>= fun result ->
Lwt.return (Micheline_parser.no_parsing_error result) >>=?
fun { Michelson_v1_parser.expanded = storage } ->
let code = Script.lazy_expr code and storage = Script.lazy_expr storage in
let origination =
Origination { manager ;
delegate ;
script = Some { code ; storage } ;
spendable ;
delegatable ;
credit = balance ;
preorigination = None } in
originate cctxt ~chain ~block ?confirmations
?branch ~source ~src_pk ~src_sk ~fee ?gas_limit ?storage_limit origination
type activation_key =
{ pkh : Ed25519.Public_key_hash.t ;
amount : Tez.t ;
activation_code : Blinded_public_key_hash.activation_code ;
mnemonic : string list ;
password : string ;
email : string ;
}
let raw_activation_key_encoding =
let open Data_encoding in
obj6
(req "pkh" Ed25519.Public_key_hash.encoding)
(req "amount" Tez.encoding)
(req "activation_code" Blinded_public_key_hash.activation_code_encoding)
(req "mnemonic" (list string))
(req "password" string)
(req "email" string)
let activation_key_encoding =
(* Hack: allow compatibility with older encoding *)
let open Data_encoding in
conv
(fun { pkh ; amount ; activation_code ; mnemonic ; password ; email } ->
( pkh, amount, activation_code, mnemonic, password, email ))
(fun ( pkh, amount, activation_code, mnemonic, password, email ) ->
{ pkh ; amount ; activation_code ; mnemonic ; password ; email }) @@
splitted
~binary:raw_activation_key_encoding
~json:
(union [
case
~title:"Activation"
Json_only
raw_activation_key_encoding
(fun x -> Some x)
(fun x -> x) ;
case
~title:"Deprecated_activation"
Json_only
(obj6
(req "pkh" Ed25519.Public_key_hash.encoding)
(req "amount" Tez.encoding)
(req "secret" Blinded_public_key_hash.activation_code_encoding)
(req "mnemonic" (list string))
(req "password" string)
(req "email" string))
(fun _ -> None)
(fun x -> x) ;
])
let read_key key =
match Bip39.of_words key.mnemonic with
| None ->
failwith ""
| Some t ->
(* TODO: unicode normalization (NFKD)... *)
let sk = Bip39.to_seed ~passphrase:(key.email ^ key.password) t in
let sk = Cstruct.(to_bigarray (sub sk 0 32)) in
let sk : Signature.Secret_key.t =
Ed25519 (Data_encoding.Binary.of_bytes_exn Ed25519.Secret_key.encoding sk) in
let pk = Signature.Secret_key.to_public_key sk in
let pkh = Signature.Public_key.hash pk in
return (pkh, pk, sk)
let activate_account
(cctxt : #Proto_alpha.full)
~chain ~block ?confirmations
?(encrypted = false) ?force key name =
read_key key >>=? fun (pkh, pk, sk) ->
fail_unless (Signature.Public_key_hash.equal pkh (Ed25519 key.pkh))
(failure "@[<v 2>Inconsistent activation key:@ \
Computed pkh: %a@ \
Embedded pkh: %a @]"
Signature.Public_key_hash.pp pkh
Ed25519.Public_key_hash.pp key.pkh) >>=? fun () ->
let contents =
Single ( Activate_account { id = key.pkh ; activation_code = key.activation_code } ) in
Injection.inject_operation
cctxt ?confirmations ~chain ~block
contents >>=? fun (oph, op, result) ->
let pk_uri = Tezos_signer_backends.Unencrypted.make_pk pk in
begin
if encrypted then
Tezos_signer_backends.Encrypted.encrypt cctxt sk
else
return (Tezos_signer_backends.Unencrypted.make_sk sk)
end >>=? fun sk_uri ->
Client_keys.register_key cctxt ?force (pkh, pk_uri, sk_uri) name >>=? fun () ->
begin
match confirmations with
| None ->
return ()
| Some _confirmations ->
Alpha_services.Contract.balance
cctxt (`Main, `Head 0)
(Contract.implicit_contract pkh) >>=? fun balance ->
cctxt#message "Account %s (%a) created with %s%a."
name
Signature.Public_key_hash.pp pkh
Client_proto_args.tez_sym
Tez.pp balance >>= fun () ->
return ()
end >>=? fun () ->
match Apply_operation_result.pack_contents_list op result with
| Apply_operation_result.Single_and_result
(Activate_account _ as op, result) ->
return (oph, op, result)
| _ -> .