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

src/Makefile

@@ -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 \

src/client/client_aliases.ml

@@ -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

src/client/client_aliases.mli

@@ -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

src/client/client_tags.ml

@@ -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

src/client/client_tags.mli

@@ -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

src/client/embedded/alpha/client_proto_contracts.ml

@@ -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 ->
@@ -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) ;
   ]