Proto/Client: add Sapling support

This commit add commands to handle a Sapling wallet and to forge
Sapling operations: shield, unshield and transfer. These operations
can be submitted to a Sapling enabled smart contract.
Co-authored-by: Marc Beunardeau's avatarMarc beunardeau <[email protected]>
Co-authored-by: Mehdi Bouaziz's avatarMehdi Bouaziz <[email protected]>
parent cad4906a
......@@ -802,6 +802,11 @@ opam:tezos-client-genesis-carthagenet:
variables:
package: tezos-client-genesis-carthagenet
opam:tezos-client-sapling:
<<: *opam_definition
variables:
package: tezos-client-sapling
opam:tezos-codec:
<<: *opam_definition
variables:
......
......@@ -88,6 +88,15 @@ let make_sk_uri (x : Uri.t) : sk_uri =
| Some _ ->
x
type sapling_uri = Uri.t
let make_sapling_uri (x : Uri.t) : sapling_uri =
match Uri.scheme x with
| None ->
Stdlib.failwith "SAPLING_URI needs a scheme"
| Some _ ->
x
let pk_uri_parameter () =
Clic.parameter (fun _ s ->
try return (make_pk_uri @@ Uri.of_string s)
......@@ -162,6 +171,44 @@ module Public_key = Client_aliases.Alias (struct
(fun (uri, key) -> (uri, Some key)) ]
end)
type sapling_key = {
sk : sapling_uri;
(* zip32 derivation path *)
path : int32 list;
(* index of the next address to generate *)
address_index : Sapling.Core.Client.Viewing_key.index;
}
module Sapling_key = Client_aliases.Alias (struct
module S = Sapling.Core.Client
let name = "sapling_key"
type t = sapling_key
let encoding =
let open Data_encoding in
conv
(fun k -> (k.sk, k.path, k.address_index))
(fun (sk, path, address_index) -> {sk; path; address_index})
(obj3
(req "sk" uri_encoding)
(req "path" (list int32))
(req "address_index" S.Viewing_key.index_encoding))
let of_source s =
let open Data_encoding in
match Json.from_string s with
| Error _ ->
failwith "corrupted wallet"
| Ok s ->
return (Json.destruct encoding s)
let to_source k =
let open Data_encoding in
return @@ Json.to_string (Json.construct encoding k)
end)
module type SIGNER = sig
val scheme : string
......
......@@ -29,6 +29,8 @@ type pk_uri = private Uri.t
type sk_uri = private Uri.t
type sapling_uri = private Uri.t
val pk_uri_parameter : unit -> (pk_uri, 'a) Clic.parameter
val pk_uri_param :
......@@ -57,6 +59,16 @@ module Public_key :
module Secret_key : Client_aliases.Alias with type t = sk_uri
type sapling_key = {
sk : sapling_uri;
(* zip32 derivation path *)
path : int32 list;
(* index of the last issued address *)
address_index : Sapling.Core.Client.Viewing_key.index;
}
module Sapling_key : Client_aliases.Alias with type t = sapling_key
module Logging : sig
val tag : string Tag.def
end
......@@ -213,3 +225,5 @@ val force_switch : unit -> (bool, 'ctx) Clic.arg
val make_pk_uri : Uri.t -> pk_uri
val make_sk_uri : Uri.t -> sk_uri
val make_sapling_uri : Uri.t -> sapling_uri
......@@ -3,6 +3,7 @@
(public_name tezos-client-base)
(libraries tezos-base
tezos-shell-services
sapling
tezos-rpc)
(library_flags (:standard -linkall))
(flags (:standard -open Tezos_base__TzPervasives
......
......@@ -345,6 +345,14 @@ struct
end
module Prefix = struct
(* These encoded prefixes are computed using scripts/base58_prefix.py
$ ./scripts/base58_prefix.py tz1 20
36 434591 [6L, 161L, 159L]
$ dune utop src/lib_crypto
utop # Tezos_crypto.Base58.make_encoded_prefix "\006\161\159" 20 ;;
- : string * int = ("tz1", 36)
*)
(* 32 *)
let block_hash = "\001\052" (* B(51) *)
......@@ -405,7 +413,11 @@ module Prefix = struct
let generic_signature = "\004\130\043" (* sig(96) *)
(* 4 *)
let chain_id = "\087\082\000"
let chain_id = "\087\082\000" (* Net(15) *)
(* 169 *)
let sapling_spending_key = "\011\237\020\092" (* sask(241) *)
(* Net(15) *)
(* 43 *)
let sapling_address = "\018\071\040\223" (* zet1(69) *)
end
......@@ -79,6 +79,10 @@ module Prefix : sig
val secp256k1_element : string
val secp256k1_scalar : string
val sapling_spending_key : string
val sapling_address : string
end
(** An extensible sum-type for decoded data: one case per known
......
......@@ -265,6 +265,83 @@ let encrypt cctxt sk =
Hashtbl.replace decrypted sk_uri sk ;
return sk_uri
module Sapling_raw = struct
let salt_len = 8
(* 193 *)
let encrypted_size = Crypto_box.boxzerobytes + salt_len + 169
let nonce = Crypto_box.zero_nonce
let pbkdf ~salt ~password =
Pbkdf.SHA512.pbkdf2 ~count:32768 ~dk_len:32l ~salt ~password
let encrypt ~password msg =
let msg = Sapling.Core.Wallet.Spending_key.to_bytes msg in
let salt = Hacl.Rand.gen salt_len in
let key = Crypto_box.Secretbox.unsafe_of_bytes (pbkdf ~salt ~password) in
Bigstring.to_string
(Bigstring.concat "" [salt; Crypto_box.Secretbox.box key msg nonce])
let decrypt ~password payload =
let ebytes = Bigstring.of_string payload in
let salt = Bigstring.sub ebytes 0 salt_len in
let encrypted_sk =
Bigstring.sub ebytes salt_len (encrypted_size - salt_len)
in
let key = Crypto_box.Secretbox.unsafe_of_bytes (pbkdf ~salt ~password) in
Option.(
Crypto_box.Secretbox.box_open key encrypted_sk nonce
>>= Sapling.Core.Wallet.Spending_key.of_bytes)
type Base58.data += Data of Sapling.Core.Wallet.Spending_key.t
let encrypted_b58_encoding password =
Base58.register_encoding
~prefix:Base58.Prefix.sapling_spending_key
~length:encrypted_size
~to_raw:(encrypt ~password)
~of_raw:(decrypt ~password)
~wrap:(fun x -> Data x)
end
let encrypt_sapling_key cctxt sk =
read_password cctxt
>>=? fun password ->
let path =
Base58.simple_encode (Sapling_raw.encrypted_b58_encoding password) sk
in
return (Client_keys.make_sapling_uri (Uri.make ~scheme ~path ()))
let decrypt_sapling_key (cctxt : #Client_context.io) (sk_uri : sapling_uri) =
let uri = (sk_uri :> Uri.t) in
let payload = Uri.path uri in
if Uri.scheme uri = Some scheme then
cctxt#prompt_password "Enter password to decrypt your key: "
>>=? fun password ->
match
Base58.simple_decode
(Sapling_raw.encrypted_b58_encoding password)
payload
with
| None ->
failwith
"Password incorrect or corrupted wallet, could not decipher \
encrypted Sapling spending key."
| Some sapling_key ->
return sapling_key
else
match
Base58.simple_decode
Sapling.Core.Wallet.Spending_key.b58check_encoding
payload
with
| None ->
failwith
"Corrupted wallet, could not read unencrypted Sapling spending key."
| Some sapling_key ->
return sapling_key
module Make (C : sig
val cctxt : Client_context.prompter
end) =
......
......@@ -42,3 +42,13 @@ val encrypt :
#Client_context.io ->
Signature.secret_key ->
Client_keys.sk_uri tzresult Lwt.t
val encrypt_sapling_key :
#Client_context.io ->
Sapling.Core.Wallet.Spending_key.t ->
Client_keys.sapling_uri tzresult Lwt.t
val decrypt_sapling_key :
#Client_context.io ->
Client_keys.sapling_uri ->
Sapling.Core.Wallet.Spending_key.t tzresult Lwt.t
......@@ -46,6 +46,12 @@ let make_sk sk =
Client_keys.make_sk_uri
(Uri.make ~scheme ~path:(Signature.Secret_key.to_b58check sk) ())
let make_sapling_key sk =
let path =
Base58.simple_encode Sapling.Core.Wallet.Spending_key.b58check_encoding sk
in
Client_keys.make_sapling_uri (Uri.make ~scheme ~path ())
let public_key pk_uri =
Lwt.return
(Signature.Public_key.of_b58check (Uri.path (pk_uri : pk_uri :> Uri.t)))
......
......@@ -28,3 +28,6 @@ include Client_keys.SIGNER
val make_pk : Signature.public_key -> Client_keys.pk_uri
val make_sk : Signature.secret_key -> Client_keys.sk_uri
val make_sapling_key :
Sapling.Core.Wallet.Spending_key.t -> Client_keys.sapling_uri
......@@ -32,3 +32,4 @@ let () =
@ Client_proto_contracts_commands.commands ()
@ Client_proto_context_commands.commands network ()
@ Client_proto_multisig_commands.commands ()
@ Tezos_client_sapling.Client_sapling_commands.commands ()
......@@ -33,6 +33,7 @@
tezos-client-alpha
tezos-client-commands
tezos-client-alpha-commands
tezos-client-sapling
tezos-rpc)
(library_flags (:standard -linkall))
(modules alpha_commands_registration)
......
wrap-fun-args=false
let-binding-spacing=compact
field-space=loose
break-separators=after-and-docked
sequence-style=separator
doc-comments=before
margin=80
module-item-spacing=sparse
parens-tuple=always
parens-tuple-patterns=always
break-string-literals=newlines-and-wrap
This diff is collapsed.
val commands : unit -> Protocol_client_context.full Clic.command list
This diff is collapsed.
(**
This module allows the creation Sapling transactions: shield, unshield and
transfer.
Because Sapling uses an UTXO model, it is necessary for the client to
maintain locally the set of unspent outputs for each viewing key, for each
smart contract. This operation is called scanning.
This local cache is updated downloading from the node only the difference
from the last scanned state.
*)
open Sapling.Core.Client
module Tez : module type of Tezos_protocol_alpha.Protocol.Alpha_context.Tez
(** This module is used to represent any shielded token to avoid confusing it
with Tez. *)
module Shielded_tez : sig
type t
val encoding : t Data_encoding.t
val pp : Format.formatter -> t -> unit
val zero : t
val of_mutez : int64 -> t option
val to_mutez : t -> int64
val of_tez : Tez.t -> t
val ( +? ) : t -> t -> t tzresult
end
(** Actual input to a smart contract handling Sapling transactions *)
module Contract_input : sig
type t
val encoding : t Data_encoding.t
val pp : Format.formatter -> t -> unit
val as_arg : t -> string
end
(** Account corresponding to a contract and a viewing key *)
module Account : sig
type t
val balance : t -> Shielded_tez.t
val pp_unspent : Format.formatter -> t -> unit
end
(** State of a contract, potentially involving several viewing keys *)
module Contract_state : sig
type t
val find_account : Viewing_key.t -> t -> Account.t option
end
module Client_state : sig
type t
val find :
Protocol_client_context.full ->
Protocol.Alpha_context.Contract.t ->
t ->
Contract_state.t tzresult Lwt.t
val register :
force:bool ->
Protocol_client_context.full ->
Protocol.Alpha_context.Contract.t ->
Viewing_key.t ->
unit tzresult Lwt.t
(** Synchronise our local state with the blockchain's.
The state must be recent enough to craft correct transactions.
The limit enforced by the protocol if 120 blocks.
Also scans, ie. checks for incoming payments and add
them to our balance.
**)
val sync_and_scan :
Protocol_client_context.full ->
Protocol.Alpha_context.Contract.t ->
Contract_state.t tzresult Lwt.t
end
(** [shield ?message ~dst tez cstate anti-replay] returns a transaction
shielding [tez] tez to a sapling address [dst] using a sapling
storage [cstate] and the anti-replay string. *)
val shield :
?message:bytes ->
dst:Viewing_key.address ->
Tez.t ->
Contract_state.t ->
string ->
Contract_input.t tzresult Lwt.t
(** [unshield ~src_name ~src ~dst ~backdst stez cstate storage] returns
a transaction unshielding [stez] shielded tokens from a sapling wallet
[src] to a transparent tezos address [dst], sending the change back to
[backdst] and using a Sapling storage [cstate] and a anti-replay string.
The transaction is refused if there is an unsufficient amount of shielded
tez in the wallet [src], the error is raised with [src_name].
*)
val unshield :
src:Spending_key.t ->
dst:Signature.public_key_hash ->
backdst:Viewing_key.address ->
Shielded_tez.t ->
Contract_state.t ->
string ->
Contract_input.t tzresult Lwt.t
(** [transfer ?message ~src ~dst ~backdst amount cstate anti-replay] creates a
Sapling transaction of [amount] shielded tez from Sapling wallet [src] to
Sapling address [dst], sending the change to [backdst], using a Sapling
storage [cstate] and a anti-replay string.
[?message] is an optional message that will be uploaded encypted on chain. *)
val transfer :
?message:bytes ->
src:Spending_key.t ->
dst:Viewing_key.address ->
backdst:Viewing_key.address ->
Shielded_tez.t ->
Contract_state.t ->
string ->
Contract_input.t tzresult Lwt.t
(library
(name tezos_client_sapling)
(public_name tezos-client-sapling)
(libraries tezos-base
tezos-crypto
tezos-client-base
tezos-signer-backends
tezos-client-alpha
tezos-client-alpha-commands
tezos-protocol-alpha
bip39)
(library_flags (:standard -linkall))
(flags (:standard -open Tezos_base__TzPervasives
-open Tezos_client_base
-open Tezos_client_alpha
-open Tezos_client_alpha_commands
-open Tezos_protocol_alpha
-open Tezos_stdlib_unix
)))
(alias
(name runtest_lint)
(deps (glob_files *.ml{,i}))
(action (run %{lib:tezos-tooling:lint.sh} %{deps})))
(lang dune 1.11)
(name tezos-client-sapling)
opam-version: "2.0"
maintainer: "[email protected]"
authors: [ "Tezos devteam" ]
homepage: "https://www.tezos.com/"
bug-reports: "https://gitlab.com/tezos/tezos/issues"
dev-repo: "git+https://gitlab.com/tezos/tezos.git"
license: "MIT"
depends: [
"tezos-tooling" { with-test }
"ocamlfind" { build }
"dune" { >= "1.7" }
"tezos-base"
"tezos-clic"
]
build: [
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]
synopsis: "Tezos: sapling support for `tezos-client`"
open Client_keys
open Sapling.Core.Client
module Mnemonic = struct
let new_random = Bip39.of_entropy (Hacl.Rand.gen 32)
let to_sapling_key mnemonic =
(* Z-cash needs 32 bytes and BIP-39 gives 64 bytes of entropy.
We xor the two halfs in case the entropy is not well distributed. *)
let seed_64_to_seed_32 (seed_64 : bytes) : bytes =
assert (Bytes.length seed_64 = 64) ;
let first_32 = Bytes.sub seed_64 0 32 in
let second_32 = Bytes.sub seed_64 32 32 in
let seed_32 = Bytes.create 32 in
for i = 0 to 31 do
Bytes.set
seed_32
i
(Char.chr
( Char.code (Bytes.get first_32 i)
lxor Char.code (Bytes.get second_32 i) ))
done ;
seed_32
in
Spending_key.of_seed
(seed_64_to_seed_32 (Bigstring.to_bytes (Bip39.to_seed mnemonic)))
let words_pp = Format.(pp_print_list ~pp_sep:pp_print_space pp_print_string)
end
(* Transform a spending key to an uri, encrypted or not. *)
let to_uri unencrypted cctxt sapling_key =
if unencrypted then
return (Tezos_signer_backends.Unencrypted.make_sapling_key sapling_key)
else Tezos_signer_backends.Encrypted.encrypt_sapling_key cctxt sapling_key
(** Transform an uri into a spending key, asking for a password if the uri was
encrypted. *)
let from_uri (cctxt : #Client_context.full) uri =
Tezos_signer_backends.Encrypted.decrypt_sapling_key cctxt uri
let register (cctxt : #Client_context.full) ?(force = false)
?(unencrypted = false) mnemonic name =
let sk = Mnemonic.to_sapling_key mnemonic in
to_uri unencrypted cctxt sk
>>=? fun sk_uri ->
let key =
{
sk = sk_uri;
path = [Spending_key.child_index sk];
address_index = Viewing_key.default_index;
}
in
Sapling_key.add ~force cctxt name key
>>=? fun () -> return @@ Viewing_key.of_sk sk
let derive (cctxt : #Client_context.full) ?(force = false)
?(unencrypted = false) src_name dst_name child_index =
Sapling_key.find cctxt src_name
>>=? fun k ->
from_uri cctxt k.sk
>>=? fun src_sk ->
let child_index = Int32.of_int child_index in
let dst_sk = Spending_key.derive_key src_sk child_index in
to_uri unencrypted cctxt dst_sk
>>=? fun dst_sk_uri ->
let dst_key =
{
sk = dst_sk_uri;
path = child_index :: k.path;
address_index = Viewing_key.default_index;
}
in
(* TODO check this force *)
let _ = force in
Sapling_key.add ~force:true cctxt dst_name dst_key
>>=? fun () ->
let path =
String.concat "/" (List.map Int32.to_string (List.rev dst_key.path))
in
return (path, Viewing_key.of_sk dst_sk)
let find_vk cctxt name =
Sapling_key.find cctxt name
>>=? fun k ->
from_uri cctxt k.sk >>=? fun sk -> return (Viewing_key.of_sk sk)
let new_address (cctxt : #Client_context.full) name index_opt =
Sapling_key.find cctxt name
>>=? fun k ->
let index =
match index_opt with
| None ->
k.address_index
| Some i ->
Viewing_key.index_of_int64 (Int64.of_int i)
in
from_uri cctxt k.sk
>>=? fun sk ->
return (Viewing_key.of_sk sk)
>>=? fun vk ->
(* Viewing_key.new_address finds the smallest index greater or equal to
[index] that generates a correct address. *)
let (corrected_index, address) = Viewing_key.new_address vk index in
Sapling_key.update
cctxt
name
{k with address_index = Viewing_key.index_succ corrected_index}
>>=? fun () -> return (sk, corrected_index, address)
let export_vk cctxt name =
find_vk cctxt name
>>=? fun vk -> return (Data_encoding.Json.construct Viewing_key.encoding vk)
open Sapling.Core.Client
(** Mnemonic of 24 common english words from which a key can be derived.
The mnemonic follows the BIP-39 spec. *)
module Mnemonic : sig
val new_random : Bip39.t
(** Pretty printer for printing a list of words of a mnemonic. *)
val words_pp : Format.formatter -> string list -> unit
end
(** Add to the wallet a new spending key derived from a mnemonic and identified
by an alias. The wallet is updated and the corresponding viewing key is
returned.
If [force] it will overwrite an existing alias. *)
val register :
#Client_context.full ->
?force:bool ->
?unencrypted:bool ->
Bip39.t ->
string ->
Viewing_key.t tzresult Lwt.t
(** [derive parent child index] derives a key with alias [child] from an
existing key with alias [parent] at [index] using ZIP32.
If a new index is required the state of the wallet is updated.
The path and viewing key corresping to the generated key are returned. *)
val derive :
#Client_context.full ->
?force:bool ->
?unencrypted:bool ->
string ->
string ->
int ->
(string * Viewing_key.t) tzresult Lwt.t
val find_vk : #Client_context.full -> string -> Viewing_key.t tzresult Lwt.t
(** Generate a new address.
If an optional index is provided, try to derive the address at this index,
otherwise use the first viable one.
Not all indexes correspond to a valid address so succesive ones are tried.
Once a valid index is found it is recorded in the wallet.
Return also the corresponding sk and vk to avoid asking the user multiple
times for the description password. *)
val new_address :
#Client_context.full ->
string ->
int option ->
(Spending_key.t * Viewing_key.index * Viewing_key.address) tzresult Lwt.t
val export_vk :
#Client_context.full -> string -> Data_encoding.Json.json tzresult Lwt.t