1/*
    2  BSD 2-Clause License
    3
    4  Copyright (c) 2018, Can Bican
    5  All rights reserved.
    6
    7  Redistribution and use in source and binary forms, with or without
    8  modification, are permitted provided that the following conditions are met:
    9
   10  * Redistributions of source code must retain the above copyright notice, this
   11    list of conditions and the following disclaimer.
   12
   13  * Redistributions in binary form must reproduce the above copyright notice,
   14    this list of conditions and the following disclaimer in the documentation
   15    and/or other materials provided with the distribution.
   16
   17  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   18  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   19  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
   20  DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
   21  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
   22  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
   23  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   24  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
   25  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
   26  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
   27*/
   28:- module(consul, [
   29     read_consul_key/2,
   30     read_consul_key/3,
   31     update_consul_key/2,
   32     delete_consul_key/1,
   33     consul_services/1,
   34     consul_service/2,
   35     register_consul_service/4,
   36     deregister_consul_service/1
   37   ]).

Consul client

An interface to consul:

The module requires a local consul agent running on the default port.

author
- Can Bican
See also
- https://www.consul.io/
license
- BSD 2-clause

*/

   56:- use_module(library(http/http_client)).   57:- use_module(library(http/http_json)).   58:- use_module(library(http/json)).   59
   60connection('http://localhost:8500/v1').
   61kv_url(Key, URL) :- connection(Connection), format(atom(URL), '~w/kv/~w', [ Connection, Key ]).
   62svs_url(URL) :- connection(Connection), format(atom(URL), '~w/catalog/services', [ Connection ]).
   63sv_url(Service, URL) :- connection(Connection), format(atom(URL), '~w/catalog/service/~w', [ Connection, Service ]).
   64reg_url(URL) :- connection(Connection), format(atom(URL), '~w/agent/service/register', [ Connection ]).
   65dereg_url(Service, URL) :- connection(Connection), format(atom(URL), '~w/agent/service/deregister/~w', [ Connection, Service ]).
 consul_services(-Services:list) is semidet
Lists services registered on consul. This only lists the service names, further querying should be performed by consul_service/2.
Arguments:
Services- List of strings, all registered services on the consul agent.
   73consul_services(Services) :-
   74  svs_url(URL),
   75  http_get(URL, Result, [content_type('application/json'), json_object(dict)]),
   76  findall(X, _ = Result.get(X), Services).
 consul_service(+Service:atom, -Properties:dict) is semidet
Lists properties of a service registered on consul. Result is a dict of properties:
Arguments:
Service- the name of the service, as received from consul_services/1.
Properties- the properties of the queried service, as a dict of:
  • host: IP address of the service.
  • port: Port of the service.
  • tags: Tags associated with the service, as a list.
   89consul_service(Service, Properties) :-
   90  sv_url(Service, URL),
   91  http_get(URL, Result, [content_type('application/json'), json_object(dict)]),
   92  convlist([X,Y]>>(
   93    get_dict('ServiceAddress', X, Address),
   94    get_dict('ServicePort', X, Port),
   95    get_dict('ServiceTags', X, Tags),
   96    Y = service{host: Address, port: Port, tags: Tags}
   97  ), Result, PropertiesFound),
   98  (
   99    PropertiesFound == [], !, fail ; Properties = PropertiesFound
  100  ).
 read_consul_key(+Key:atom, -Value:atom) is semidet
Same as read_consul_key(Key, Value, [as(atom)]).
See also
- read_consul_key/3
  108read_consul_key(Key, Value) :-
  109  read_consul_key(Key, Value, []).
 read_consul_key(+Key:atom, -Value:atom, +Options:options) is semidet
Reads a key from consul kv database
Arguments:
Key- Name of the key to query for.
Value- Value of the queried key.
Options- Provided options are:
  • as(+Type) Type of the value. Type can be list, string, number or atom.
  121read_consul_key(Key, Value, Options) :-
  122  catch(
  123    (
  124      kv_url(Key, URL),
  125      http_get(URL, [Data|_], [content_type('application/json'), json_object(dict)]),
  126      base64(V, Data.'Value'),
  127      option(as(Type), Options, atom),
  128      convert_result(V, Type, Value)
  129    ),
  130    error(existence_error(url,_),context(_,status(404,_))),
  131    fail
  132  ).
  133
  134convert_result(In, atom, In) :- !.
  135convert_result(In, number, Out) :- atom_number(In, Out), !.
  136convert_result(In, string, Out) :- atom_string(In, Out), !.
  137convert_result(In, list, Out) :-
  138  atom_string(In, Ins),
  139  format(string(S), "lst(~w).", Ins),
  140  open_string(S, Stream),
  141  read_term(Stream, lst(Out), []),
  142  !.
 delete_consul_key(+Key:atom) is det
Deletes a key from consul kv database
Arguments:
Key- name of the key to delete
  150delete_consul_key(Key) :-
  151  kv_url(Key, URL),
  152  http_delete(URL, _, [content_type('application/json'), json_object(dict)]).
 update_consul_key(+Key:atom, +Value:atom) is det
Creates or updates a key in consul kv database
Arguments:
Key- name of the key to update
Value- new value of the key
  161update_consul_key(Key, Value) :-
  162  is_list(Value),
  163  kv_url(Key, URL),
  164  format(string(ValueToSend), "~w", [Value]),
  165  http_put(URL, atom(ValueToSend), _, [content_type('application/json')]),
  166  !.
  167update_consul_key(Key, Value) :-
  168  kv_url(Key, URL),
  169  http_put(URL, atom(Value), _, [content_type('application/json')]).
 register_consul_service(+Service:atom, +Host:atom, +Port:integer, +Tags:list) is det
Registers a service in consul or updates the existing service
Arguments:
Service- service name to register
Host- IP address of the service
Port- port of the service
Tags- tags associated with the service
  179register_consul_service(Service, Host, Port, Tags) :-
  180  Payload = _{ 'Name': Service, 'Tags': Tags, 'Address': Host, 'Port': Port},
  181  with_output_to(string(PayloadJson), json_write(current_output, Payload, [])),
  182  reg_url(URL),
  183  http_put(URL, codes(PayloadJson), _, []).
 deregister_consul_service(+Service:atom) is det
Deregisters a service in consul
Arguments:
Service- service name to deregister
  190deregister_consul_service(Service) :-
  191  dereg_url(Service, URL),
  192  http_put(URL, _, _, [])