balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Client: add tags to aliases (enabled for contracts).

Browse Source
This commit is contained in:
Guillem Rieu 2017-03-15 01:27:34 +01:00 committed by Benjamin Canou
parent 9c2564391c
commit 4e82e94ef4
6 changed files with 192 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Makefile
View File

@ -491,6 +491,7 @@ CLIENT_LIB_INTFS := \
client/client_generic_rpcs.mli \
client/client_helpers.mli \
client/client_aliases.mli \
client/client_tags.mli \
client/client_keys.mli \
client/client_protocols.mli \
client/client_blocks.mli \
@ -503,6 +504,7 @@ CLIENT_LIB_IMPLS := \
client/client_generic_rpcs.ml \
client/client_helpers.ml \
client/client_aliases.ml \
client/client_tags.ml \
client/client_keys.ml \
client/client_protocols.ml \
client/client_blocks.ml \

14
src/client/client_aliases.ml
View File

@ -50,9 +50,15 @@ module type Alias = sig
val del :
Client_commands.context ->
string -> unit Lwt.t
val update :
Client_commands.context ->
string -> t -> unit Lwt.t
val save :
Client_commands.context ->
(string * t) list -> unit Lwt.t
val of_source :
Client_commands.context ->
string -> t Lwt.t
val to_source :
Client_commands.context ->
t -> string Lwt.t
@ -175,6 +181,14 @@ module Alias = functor (Entity : Entity) -> struct
let list = List.filter (fun (n, _) -> n <> name) list in
save cctxt list
let update cctxt name value =
load cctxt >>= fun list ->
let list =
List.map
(fun (n, v) -> (n, if n = name then value else v))
list in
save cctxt list
let save cctxt list =
save cctxt list >>= fun () ->
cctxt.Client_commands.message

6
src/client/client_aliases.mli
View File

@ -46,9 +46,15 @@ module type Alias = sig
val del :
Client_commands.context ->
string -> unit Lwt.t
val update :
Client_commands.context ->
string -> t -> unit Lwt.t
val save :
Client_commands.context ->
(string * t) list -> unit Lwt.t
val of_source :
Client_commands.context ->
string -> t Lwt.t
val to_source :
Client_commands.context ->
t -> string Lwt.t

81
src/client/client_tags.ml Normal file
View File

@ -0,0 +1,81 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module Tag = struct
type t = string list
let add tags t =
t :: tags
let remove tags t =
let rec aux acc = function
| [] -> raise Not_found
| x :: ts when x = t -> (List.rev acc) @ ts
| x :: ts -> aux (x :: acc) ts
in
aux [] tags
let encoding =
Data_encoding.(list string)
end
module type Entity = sig
val name : string
end
module Tags (Entity : Entity) = struct
include Client_aliases.Alias (struct
type t = Tag.t
let encoding = Tag.encoding
(* Split a string of tags separated by commas, and possibly spaces *)
let of_source _ tags_str =
let rec aux tags s =
try
let idx = String.index s ',' in
let tag = String.(trim (sub s 0 idx)) in
let tail = String.(sub s (idx + 1) (length s - (idx + 1))) in
aux (tag :: tags) tail
with
| Not_found ->
String.(trim s) :: tags
in
Lwt.return (aux [] tags_str)
let to_source _ tags =
Lwt.return (String.concat ", " tags)
let name = Entity.name ^ " tag"
end)
let tag_param ?(name = "tag") ?(desc = "list of tags") next =
let desc =
desc ^ "\n"
^ "can be one or multiple tags separated by commas" in
Cli_entries.param ~name ~desc of_source next
let rev_find_by_tag cctxt tag =
load cctxt >>= fun tags ->
try return (Some (List.find (fun (_, v) -> List.mem tag v) tags |> fst))
with Not_found -> return None
let filter cctxt pred =
load cctxt >>= fun tags ->
return (List.filter pred tags)
let filter_by_tag cctxt tag =
filter cctxt (fun (_, v) -> List.mem tag v)
end

49
src/client/client_tags.mli Normal file
View File

@ -0,0 +1,49 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module Tag : sig
type t = string list
val add: t -> string -> t
val remove: t -> string -> t
val encoding: t Data_encoding.t
end
module type Entity = sig
val name : string
end
module Tags (Entity : Entity) : sig
include Client_aliases.Alias with type t = Tag.t
val tag_param:
?name:string ->
?desc:string ->
('a, Client_commands.context, unit) Cli_entries.params ->
(Tag.t -> 'a, Client_commands.context, unit) Cli_entries.params
val rev_find_by_tag:
Client_commands.context ->
string ->
string option tzresult Lwt.t
val filter:
Client_commands.context ->
(string * t -> bool) ->
(string * t) list tzresult Lwt.t
val filter_by_tag:
Client_commands.context ->
string ->
(string * t) list tzresult Lwt.t
end

46
src/client/embedded/alpha/client_proto_contracts.ml
View File

@ -87,6 +87,10 @@ module ContractAlias = struct
end
module Contract_tags = Client_tags.Tags (struct
let name = "contract"
end)
let list_contracts cctxt =
(* List contracts *)
RawContractAlias.load cctxt >>= fun raw_contracts ->
@ -163,16 +167,16 @@ let commands () =
command ~group ~desc: "lists all known contracts"
(fixed [ "list" ; "known" ; "contracts" ])
(fun cctxt ->
list_contracts cctxt >>= fun contracts ->
Lwt_list.iter_s (fun (prefix, alias, contract) ->
cctxt.message "%s%s: %s" prefix alias
(Contract.to_b58check contract))
contracts) ;
list_contracts cctxt >>= fun contracts ->
Lwt_list.iter_s (fun (prefix, alias, contract) ->
cctxt.message "%s%s: %s" prefix alias
(Contract.to_b58check contract))
contracts) ;
command ~group ~desc: "forget all known contracts"
(fixed [ "forget" ; "all" ; "contracts" ])
(fun cctxt ->
if not cctxt.config.force then
cctxt.Client_commands.error "this can only used with option -force true"
cctxt.Client_commands.error "this can only used with option -force true"
else
RawContractAlias.save cctxt []) ;
command ~group ~desc: "display a contract from the wallet"
@ -181,4 +185,34 @@ let commands () =
@@ stop)
(fun (_, contract) cctxt ->
cctxt.message "%a\n%!" Contract.pp contract) ;
command ~group ~desc: "tag a contract in the wallet"
(prefixes [ "tag" ; "contract" ]
@@ RawContractAlias.alias_param
@@ prefixes [ "with" ]
@@ Contract_tags.tag_param
@@ stop)
(fun (alias, _contract) new_tags cctxt ->
Contract_tags.find_opt cctxt alias >>= fun tags ->
let new_tags = match tags with
| None -> new_tags
| Some tags -> Utils.merge_list2 tags new_tags in
Contract_tags.update cctxt alias new_tags) ;
command ~group ~desc: "remove tag(s) from a contract in the wallet"
(prefixes [ "untag" ; "contract" ]
@@ RawContractAlias.alias_param
@@ prefixes [ "with" ]
@@ Contract_tags.tag_param
@@ stop)
(fun (alias, _contract) new_tags cctxt ->
Contract_tags.find_opt cctxt alias >>= fun tags ->
let new_tags = match tags with
| None -> []
| Some tags ->
Utils.merge_filter_list2
~f:(fun x1 x2 -> match x1, x2 with
| None, None -> assert false
| None, Some _ -> None
| Some t1, Some t2 when t1 = t2 -> None
| Some t1, _ -> Some t1) tags new_tags in
Contract_tags.update cctxt alias new_tags) ;
]