From 6f548918efe7d4d3f8f9d9b04c58eac37d4e462d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?TG=20=C3=97=20=CE=98?= <*@tg-x.net>
Date: Sun, 27 Oct 2019 22:49:12 +0100
Subject: [PATCH] cycylon, vicinity, ringcast, poldercast
---
.gitignore | 5 +
LICENSE.md | 660 ++++++++++++++++++
Makefile | 15 +
README.md | 56 ++
dune-project | 2 +
lib/p2p-cyclon-lwt/dune | 5 +
lib/p2p-cyclon-lwt/p2p_cyclon_lwt.ml | 141 ++++
lib/p2p-cyclon-lwt/s.ml | 86 +++
lib/p2p-cyclon/dune | 4 +
lib/p2p-cyclon/p2p_cyclon.ml | 75 ++
lib/p2p-cyclon/p2p_cyclon.mli | 54 ++
lib/p2p-poldercast-lwt/dune | 14 +
lib/p2p-poldercast-lwt/p2p_poldercast_lwt.ml | 164 +++++
lib/p2p-poldercast-lwt/s.ml | 74 ++
lib/p2p-poldercast/dune | 4 +
lib/p2p-poldercast/node.ml | 72 ++
lib/p2p-poldercast/p2p-poldercast | 16 +
lib/p2p-poldercast/p2p_poldercast.ml | 154 ++++
lib/p2p-poldercast/s.ml | 74 ++
lib/p2p-ringcast-lwt/dune | 5 +
lib/p2p-ringcast-lwt/p2p_ringcast_lwt.ml | 166 +++++
lib/p2p-ringcast-lwt/s.ml | 102 +++
lib/p2p-ringcast/dune | 4 +
lib/p2p-ringcast/p2p_ringcast.ml | 213 ++++++
lib/p2p-ringcast/s.ml | 53 ++
lib/p2p-vicinity-lwt/dune | 5 +
lib/p2p-vicinity-lwt/p2p_vicinity_lwt.ml | 143 ++++
lib/p2p-vicinity-lwt/s.ml | 89 +++
lib/p2p-vicinity/dune | 4 +
lib/p2p-vicinity/p2p_vicinity.ml | 100 +++
lib/p2p-vicinity/s.ml | 24 +
lib/p2p/dune | 4 +
lib/p2p/group.ml | 37 +
lib/p2p/group_id.ml | 17 +
lib/p2p/msg_id.ml | 17 +
lib/p2p/node.ml | 68 ++
lib/p2p/node_id.ml | 57 ++
lib/p2p/s.ml | 399 +++++++++++
lib/p2p/view.ml | 157 +++++
p2p-cyclon-lwt.opam | 27 +
p2p-cyclon.opam | 23 +
p2p-poldercast-lwt.opam | 26 +
p2p-poldercast.opam | 24 +
p2p-ringcast-lwt.opam | 26 +
p2p-ringcast.opam | 25 +
p2p-vicinity-lwt.opam | 26 +
p2p-vicinity.opam | 23 +
p2p.opam | 27 +
test/p2p-cyclon-lwt/dune | 15 +
test/p2p-cyclon-lwt/test_cyclon_lwt.ml | 146 ++++
test/p2p-cyclon/dune | 9 +
test/p2p-cyclon/test_cyclon.ml | 80 +++
test/p2p-poldercast-lwt/dune | 16 +
.../p2p-poldercast-lwt/test_poldercast_lwt.ml | 202 ++++++
test/p2p-poldercast/dune | 11 +
test/p2p-poldercast/test_poldercast.ml | 80 +++
test/p2p-ringcast-lwt/dune | 14 +
test/p2p-ringcast-lwt/test_ringcast_lwt.ml | 182 +++++
test/p2p-ringcast/dune | 9 +
test/p2p-ringcast/test_ringcast.ml | 96 +++
test/p2p-vicinity-lwt/dune | 14 +
test/p2p-vicinity-lwt/test_vicinity_lwt.ml | 146 ++++
test/p2p-vicinity/dune | 9 +
test/p2p-vicinity/test_vicinity.ml | 107 +++
test/p2p/dune | 4 +
test/p2p/test_gossip.ml | 137 ++++
test/p2p/test_view.ml | 82 +++
67 files changed, 4925 insertions(+)
create mode 100644 .gitignore
create mode 100644 LICENSE.md
create mode 100644 Makefile
create mode 100644 README.md
create mode 100644 dune-project
create mode 100644 lib/p2p-cyclon-lwt/dune
create mode 100644 lib/p2p-cyclon-lwt/p2p_cyclon_lwt.ml
create mode 100644 lib/p2p-cyclon-lwt/s.ml
create mode 100644 lib/p2p-cyclon/dune
create mode 100644 lib/p2p-cyclon/p2p_cyclon.ml
create mode 100644 lib/p2p-cyclon/p2p_cyclon.mli
create mode 100644 lib/p2p-poldercast-lwt/dune
create mode 100644 lib/p2p-poldercast-lwt/p2p_poldercast_lwt.ml
create mode 100644 lib/p2p-poldercast-lwt/s.ml
create mode 100644 lib/p2p-poldercast/dune
create mode 100644 lib/p2p-poldercast/node.ml
create mode 100644 lib/p2p-poldercast/p2p-poldercast
create mode 100644 lib/p2p-poldercast/p2p_poldercast.ml
create mode 100644 lib/p2p-poldercast/s.ml
create mode 100644 lib/p2p-ringcast-lwt/dune
create mode 100644 lib/p2p-ringcast-lwt/p2p_ringcast_lwt.ml
create mode 100644 lib/p2p-ringcast-lwt/s.ml
create mode 100644 lib/p2p-ringcast/dune
create mode 100644 lib/p2p-ringcast/p2p_ringcast.ml
create mode 100644 lib/p2p-ringcast/s.ml
create mode 100644 lib/p2p-vicinity-lwt/dune
create mode 100644 lib/p2p-vicinity-lwt/p2p_vicinity_lwt.ml
create mode 100644 lib/p2p-vicinity-lwt/s.ml
create mode 100644 lib/p2p-vicinity/dune
create mode 100644 lib/p2p-vicinity/p2p_vicinity.ml
create mode 100644 lib/p2p-vicinity/s.ml
create mode 100644 lib/p2p/dune
create mode 100644 lib/p2p/group.ml
create mode 100644 lib/p2p/group_id.ml
create mode 100644 lib/p2p/msg_id.ml
create mode 100644 lib/p2p/node.ml
create mode 100644 lib/p2p/node_id.ml
create mode 100644 lib/p2p/s.ml
create mode 100644 lib/p2p/view.ml
create mode 100644 p2p-cyclon-lwt.opam
create mode 100644 p2p-cyclon.opam
create mode 100644 p2p-poldercast-lwt.opam
create mode 100644 p2p-poldercast.opam
create mode 100644 p2p-ringcast-lwt.opam
create mode 100644 p2p-ringcast.opam
create mode 100644 p2p-vicinity-lwt.opam
create mode 100644 p2p-vicinity.opam
create mode 100644 p2p.opam
create mode 100644 test/p2p-cyclon-lwt/dune
create mode 100644 test/p2p-cyclon-lwt/test_cyclon_lwt.ml
create mode 100644 test/p2p-cyclon/dune
create mode 100644 test/p2p-cyclon/test_cyclon.ml
create mode 100644 test/p2p-poldercast-lwt/dune
create mode 100644 test/p2p-poldercast-lwt/test_poldercast_lwt.ml
create mode 100644 test/p2p-poldercast/dune
create mode 100644 test/p2p-poldercast/test_poldercast.ml
create mode 100644 test/p2p-ringcast-lwt/dune
create mode 100644 test/p2p-ringcast-lwt/test_ringcast_lwt.ml
create mode 100644 test/p2p-ringcast/dune
create mode 100644 test/p2p-ringcast/test_ringcast.ml
create mode 100644 test/p2p-vicinity-lwt/dune
create mode 100644 test/p2p-vicinity-lwt/test_vicinity_lwt.ml
create mode 100644 test/p2p-vicinity/dune
create mode 100644 test/p2p-vicinity/test_vicinity.ml
create mode 100644 test/p2p/dune
create mode 100644 test/p2p/test_gossip.ml
create mode 100644 test/p2p/test_view.ml
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..06de165
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,5 @@
+*~
+.*
+\#*
+_build
+*.install
diff --git a/LICENSE.md b/LICENSE.md
new file mode 100644
index 0000000..cba6f6a
--- /dev/null
+++ b/LICENSE.md
@@ -0,0 +1,660 @@
+### GNU AFFERO GENERAL PUBLIC LICENSE
+
+Version 3, 19 November 2007
+
+Copyright (C) 2007 Free Software Foundation, Inc.
+
+
+Everyone is permitted to copy and distribute verbatim copies of this
+license document, but changing it is not allowed.
+
+### Preamble
+
+The GNU Affero General Public License is a free, copyleft license for
+software and other kinds of works, specifically designed to ensure
+cooperation with the community in the case of network server software.
+
+The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+our General Public Licenses are intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains
+free software for all its users.
+
+When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+Developers that use our General Public Licenses protect your rights
+with two steps: (1) assert copyright on the software, and (2) offer
+you this License which gives you legal permission to copy, distribute
+and/or modify the software.
+
+A secondary benefit of defending all users' freedom is that
+improvements made in alternate versions of the program, if they
+receive widespread use, become available for other developers to
+incorporate. Many developers of free software are heartened and
+encouraged by the resulting cooperation. However, in the case of
+software used on network servers, this result may fail to come about.
+The GNU General Public License permits making a modified version and
+letting the public access it on a server without ever releasing its
+source code to the public.
+
+The GNU Affero General Public License is designed specifically to
+ensure that, in such cases, the modified source code becomes available
+to the community. It requires the operator of a network server to
+provide the source code of the modified version running there to the
+users of that server. Therefore, public use of a modified version, on
+a publicly accessible server, gives the public access to the source
+code of the modified version.
+
+An older license, called the Affero General Public License and
+published by Affero, was designed to accomplish similar goals. This is
+a different license, not a version of the Affero GPL, but Affero has
+released a new version of the Affero GPL which permits relicensing
+under this license.
+
+The precise terms and conditions for copying, distribution and
+modification follow.
+
+### TERMS AND CONDITIONS
+
+#### 0. Definitions.
+
+"This License" refers to version 3 of the GNU Affero General Public
+License.
+
+"Copyright" also means copyright-like laws that apply to other kinds
+of works, such as semiconductor masks.
+
+"The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of
+an exact copy. The resulting work is called a "modified version" of
+the earlier work or a work "based on" the earlier work.
+
+A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user
+through a computer network, with no transfer of a copy, is not
+conveying.
+
+An interactive user interface displays "Appropriate Legal Notices" to
+the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+#### 1. Source Code.
+
+The "source code" for a work means the preferred form of the work for
+making modifications to it. "Object code" means any non-source form of
+a work.
+
+A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+The Corresponding Source need not include anything that users can
+regenerate automatically from other parts of the Corresponding Source.
+
+The Corresponding Source for a work in source code form is that same
+work.
+
+#### 2. Basic Permissions.
+
+All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+You may make, run and propagate covered works that you do not convey,
+without conditions so long as your license otherwise remains in force.
+You may convey covered works to others for the sole purpose of having
+them make modifications exclusively for you, or provide you with
+facilities for running those works, provided that you comply with the
+terms of this License in conveying all material for which you do not
+control copyright. Those thus making or running the covered works for
+you must do so exclusively on your behalf, under your direction and
+control, on terms that prohibit them from making any copies of your
+copyrighted material outside their relationship with you.
+
+Conveying under any other circumstances is permitted solely under the
+conditions stated below. Sublicensing is not allowed; section 10 makes
+it unnecessary.
+
+#### 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such
+circumvention is effected by exercising rights under this License with
+respect to the covered work, and you disclaim any intention to limit
+operation or modification of the work as a means of enforcing, against
+the work's users, your or third parties' legal rights to forbid
+circumvention of technological measures.
+
+#### 4. Conveying Verbatim Copies.
+
+You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+#### 5. Conveying Modified Source Versions.
+
+You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these
+conditions:
+
+- a) The work must carry prominent notices stating that you modified
+ it, and giving a relevant date.
+- b) The work must carry prominent notices stating that it is
+ released under this License and any conditions added under
+ section 7. This requirement modifies the requirement in section 4
+ to "keep intact all notices".
+- c) You must license the entire work, as a whole, under this
+ License to anyone who comes into possession of a copy. This
+ License will therefore apply, along with any applicable section 7
+ additional terms, to the whole of the work, and all its parts,
+ regardless of how they are packaged. This License gives no
+ permission to license the work in any other way, but it does not
+ invalidate such permission if you have separately received it.
+- d) If the work has interactive user interfaces, each must display
+ Appropriate Legal Notices; however, if the Program has interactive
+ interfaces that do not display Appropriate Legal Notices, your
+ work need not make them do so.
+
+A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+#### 6. Conveying Non-Source Forms.
+
+You may convey a covered work in object code form under the terms of
+sections 4 and 5, provided that you also convey the machine-readable
+Corresponding Source under the terms of this License, in one of these
+ways:
+
+- a) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by the
+ Corresponding Source fixed on a durable physical medium
+ customarily used for software interchange.
+- b) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by a
+ written offer, valid for at least three years and valid for as
+ long as you offer spare parts or customer support for that product
+ model, to give anyone who possesses the object code either (1) a
+ copy of the Corresponding Source for all the software in the
+ product that is covered by this License, on a durable physical
+ medium customarily used for software interchange, for a price no
+ more than your reasonable cost of physically performing this
+ conveying of source, or (2) access to copy the Corresponding
+ Source from a network server at no charge.
+- c) Convey individual copies of the object code with a copy of the
+ written offer to provide the Corresponding Source. This
+ alternative is allowed only occasionally and noncommercially, and
+ only if you received the object code with such an offer, in accord
+ with subsection 6b.
+- d) Convey the object code by offering access from a designated
+ place (gratis or for a charge), and offer equivalent access to the
+ Corresponding Source in the same way through the same place at no
+ further charge. You need not require recipients to copy the
+ Corresponding Source along with the object code. If the place to
+ copy the object code is a network server, the Corresponding Source
+ may be on a different server (operated by you or a third party)
+ that supports equivalent copying facilities, provided you maintain
+ clear directions next to the object code saying where to find the
+ Corresponding Source. Regardless of what server hosts the
+ Corresponding Source, you remain obligated to ensure that it is
+ available for as long as needed to satisfy these requirements.
+- e) Convey the object code using peer-to-peer transmission,
+ provided you inform other peers where the object code and
+ Corresponding Source of the work are being offered to the general
+ public at no charge under subsection 6d.
+
+A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal,
+family, or household purposes, or (2) anything designed or sold for
+incorporation into a dwelling. In determining whether a product is a
+consumer product, doubtful cases shall be resolved in favor of
+coverage. For a particular product received by a particular user,
+"normally used" refers to a typical or common use of that class of
+product, regardless of the status of the particular user or of the way
+in which the particular user actually uses, or expects or is expected
+to use, the product. A product is a consumer product regardless of
+whether the product has substantial commercial, industrial or
+non-consumer uses, unless such uses represent the only significant
+mode of use of the product.
+
+"Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to
+install and execute modified versions of a covered work in that User
+Product from a modified version of its Corresponding Source. The
+information must suffice to ensure that the continued functioning of
+the modified object code is in no case prevented or interfered with
+solely because modification has been made.
+
+If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or
+updates for a work that has been modified or installed by the
+recipient, or for the User Product in which it has been modified or
+installed. Access to a network may be denied when the modification
+itself materially and adversely affects the operation of the network
+or violates the rules and protocols for communication across the
+network.
+
+Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+#### 7. Additional Terms.
+
+"Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders
+of that material) supplement the terms of this License with terms:
+
+- a) Disclaiming warranty or limiting liability differently from the
+ terms of sections 15 and 16 of this License; or
+- b) Requiring preservation of specified reasonable legal notices or
+ author attributions in that material or in the Appropriate Legal
+ Notices displayed by works containing it; or
+- c) Prohibiting misrepresentation of the origin of that material,
+ or requiring that modified versions of such material be marked in
+ reasonable ways as different from the original version; or
+- d) Limiting the use for publicity purposes of names of licensors
+ or authors of the material; or
+- e) Declining to grant rights under trademark law for use of some
+ trade names, trademarks, or service marks; or
+- f) Requiring indemnification of licensors and authors of that
+ material by anyone who conveys the material (or modified versions
+ of it) with contractual assumptions of liability to the recipient,
+ for any liability that these contractual assumptions directly
+ impose on those licensors and authors.
+
+All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions; the
+above requirements apply either way.
+
+#### 8. Termination.
+
+You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+However, if you cease all violation of this License, then your license
+from a particular copyright holder is reinstated (a) provisionally,
+unless and until the copyright holder explicitly and finally
+terminates your license, and (b) permanently, if the copyright holder
+fails to notify you of the violation by some reasonable means prior to
+60 days after the cessation.
+
+Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+#### 9. Acceptance Not Required for Having Copies.
+
+You are not required to accept this License in order to receive or run
+a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+#### 10. Automatic Licensing of Downstream Recipients.
+
+Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+#### 11. Patents.
+
+A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+A contributor's "essential patent claims" are all patent claims owned
+or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+A patent license is "discriminatory" if it does not include within the
+scope of its coverage, prohibits the exercise of, or is conditioned on
+the non-exercise of one or more of the rights that are specifically
+granted under this License. You may not convey a covered work if you
+are a party to an arrangement with a third party that is in the
+business of distributing software, under which you make payment to the
+third party based on the extent of your activity of conveying the
+work, and under which the third party grants, to any of the parties
+who would receive the covered work from you, a discriminatory patent
+license (a) in connection with copies of the covered work conveyed by
+you (or copies made from those copies), or (b) primarily for and in
+connection with specific products or compilations that contain the
+covered work, unless you entered into that arrangement, or that patent
+license was granted, prior to 28 March 2007.
+
+Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+#### 12. No Surrender of Others' Freedom.
+
+If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under
+this License and any other pertinent obligations, then as a
+consequence you may not convey it at all. For example, if you agree to
+terms that obligate you to collect a royalty for further conveying
+from those to whom you convey the Program, the only way you could
+satisfy both those terms and this License would be to refrain entirely
+from conveying the Program.
+
+#### 13. Remote Network Interaction; Use with the GNU General Public License.
+
+Notwithstanding any other provision of this License, if you modify the
+Program, your modified version must prominently offer all users
+interacting with it remotely through a computer network (if your
+version supports such interaction) an opportunity to receive the
+Corresponding Source of your version by providing access to the
+Corresponding Source from a network server at no charge, through some
+standard or customary means of facilitating copying of software. This
+Corresponding Source shall include the Corresponding Source for any
+work covered by version 3 of the GNU General Public License that is
+incorporated pursuant to the following paragraph.
+
+Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the work with which it is combined will remain governed by version
+3 of the GNU General Public License.
+
+#### 14. Revised Versions of this License.
+
+The Free Software Foundation may publish revised and/or new versions
+of the GNU Affero General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies that a certain numbered version of the GNU Affero General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU Affero General Public License, you may choose any version ever
+published by the Free Software Foundation.
+
+If the Program specifies that a proxy can decide which future versions
+of the GNU Affero General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+#### 15. Disclaimer of Warranty.
+
+THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT
+WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND
+PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE
+DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
+CORRECTION.
+
+#### 16. Limitation of Liability.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR
+CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT
+NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR
+LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM
+TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER
+PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+
+#### 17. Interpretation of Sections 15 and 16.
+
+If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+END OF TERMS AND CONDITIONS
+
+### How to Apply These Terms to Your New Programs
+
+If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these
+terms.
+
+To do so, attach the following notices to the program. It is safest to
+attach them to the start of each source file to most effectively state
+the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+
+ Copyright (C)
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+
+Also add information on how to contact you by electronic and paper
+mail.
+
+If your software can interact with users remotely through a computer
+network, you should also make sure that it provides a way for users to
+get its source. For example, if your program is a web application, its
+interface could display a "Source" link that leads users to an archive
+of the code. There are many ways you could offer source, and different
+solutions will be better for different programs; see section 13 for
+the specific requirements.
+
+You should also get your employer (if you work as a programmer) or
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. For more information on this, and how to apply and follow
+the GNU AGPL, see .
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..ec6fbb8
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,15 @@
+.PHONY: all build doc test clean
+
+all: build doc test
+
+build:
+ dune build
+
+doc:
+ dune build @doc
+
+test:
+ dune runtest -f --no-buffer -j 1
+
+clean:
+ dune clean
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..e66046a
--- /dev/null
+++ b/README.md
@@ -0,0 +1,56 @@
+[![Build Status](https://travis-ci.org/p2pcollab/ocaml-p2p.svg?branch=master)](https://travis-ci.org/p2pcollab/ocaml-p2p)
+
+# Gossip-based protocols for P2P collaboration
+
+P2Pcollab is a collacection of composable libraries
+implementing gossip-based protocols for P2P collaboration.
+
+These libraries are distributed under the AGPL-3.0-only license.
+
+## Modules
+
+- PolderCast: P2P topic-based pub/sub
+- RingCast: P2P hybrid dissemination
+- VICINITY: P2P clustering & topology management
+- CYCLON: Random Peer Sampling
+
+## Installation
+
+The libraries can be installed via `opam`:
+
+ opam install p2p
+ opam install p2p-cyclon
+ opam install p2p-cyclon-lwt
+ opam install p2p-vicinity
+ opam install p2p-vicinity-lwt
+ opam install p2p-ringcast
+ opam install p2p-ringcast-lwt
+ opam install p2p-poldercast
+ opam install p2p-poldercast-lwt
+
+## Building
+
+To build from source, generate documentation, and run tests, use `dune`:
+
+ dune build
+ dune build @doc
+ dune runtest -f -j1 --no-buffer
+
+In addition, the following `Makefile` targets are available
+ as a shorthand for the above:
+
+ make
+ make build
+ make doc
+ make test
+
+## Documentation
+
+The documentation and API reference is generated from the source interfaces.
+It can be consulted [online][doc] or via `odig`, e.g.:
+
+ odig doc p2p
+ odig doc p2p-cyclon
+ ...
+
+[doc]: https://p2pcollab.net/doc/ocaml/
diff --git a/dune-project b/dune-project
new file mode 100644
index 0000000..7176f00
--- /dev/null
+++ b/dune-project
@@ -0,0 +1,2 @@
+(lang dune 1.3)
+(name gossip)
diff --git a/lib/p2p-cyclon-lwt/dune b/lib/p2p-cyclon-lwt/dune
new file mode 100644
index 0000000..e5c0c9c
--- /dev/null
+++ b/lib/p2p-cyclon-lwt/dune
@@ -0,0 +1,5 @@
+(library
+ (name p2p_cyclon_lwt)
+ (public_name p2p-cyclon-lwt)
+ (libraries p2p p2p-cyclon lwt lwt.unix)
+ (preprocess (pps lwt_ppx)))
diff --git a/lib/p2p-cyclon-lwt/p2p_cyclon_lwt.ml b/lib/p2p-cyclon-lwt/p2p_cyclon_lwt.ml
new file mode 100644
index 0000000..1a7c0dc
--- /dev/null
+++ b/lib/p2p-cyclon-lwt/p2p_cyclon_lwt.ml
@@ -0,0 +1,141 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+(**
+{1 CYCLON with Lwt}
+
+High-level library implementing the CYCLON protocol using Lwt.
+*)
+
+(** Functor building an implementation of Cyclon with Lwt
+ given a [Node_id], [Node], gossip [View], [Cyclon] implementation,
+ and an [Io] event handler module. *)
+module Make
+ (Node_id: P2p.S.NODE_ID)
+ (Node : P2p.S.NODE with type nid := Node_id.t)
+ (View : P2p.S.VIEW with type nid := Node_id.t
+ and type node := Node.t)
+ (Cyclon : P2p.S.GOSSIP with type node := Node.t
+ and type view := View.t)
+ (Io : S.CYCLON_IO with type nid := Node_id.t
+ and type node := Node.t
+ and type view := View.t)
+ : S.CYCLON with type nid := Node_id.t
+ and type node := Node.t
+ and type view := View.t
+ and type io := Io.t = struct
+
+ module Gossip = Cyclon
+
+ type t = {
+ me : Node.t; (** this node *)
+ mutable view : View.t; (** partial view of gossip protocol *)
+ view_len : int; (** max view length *)
+ xchg_len : int; (** max exchange length *)
+ period : float; (** gossip period in seconds *)
+ io : Io.t;
+ mutable stop : unit Lwt.t option;
+ mutable stopper : unit Lwt.u option;
+ }
+
+ let init ~me ~view ~view_len ~xchg_len ~period ~io =
+ { me; view; view_len; xchg_len; period; io;
+ stop = None; stopper = None }
+
+ let view t = t.view
+
+ (** wait for [delay] seconds,
+ then return the result of thread [t],
+ or cancel it if not finished yet **)
+ let timeout delay stop t =
+ let%lwt _ = Lwt.choose [ Lwt_unix.sleep delay; stop ] in
+ match Lwt.state t with
+ | Lwt.Sleep -> Lwt.cancel t; Lwt.return None
+ | Lwt.Return v -> Lwt.return (Some v)
+ | Lwt.Fail ex -> Lwt.fail ex
+
+ (** initiate exchange with a node from [t.view],
+ wait for response, and return merged view *)
+ let initiate t dst sent view =
+ match dst with
+ | (Some dst) ->
+ let%lwt recvd = Io.initiate_gossip t.io dst sent in
+ let%lwt recvd = Io.gossip_recvd t.io t.me recvd t.view in
+ t.view <- Gossip.merge ~view ~view_len:t.view_len ~me:t.me
+ ~sent ~recvd ~xchg_len:t.xchg_len;
+ let%lwt _ = Io.view_updated t.io t.me t.view in
+ Lwt.return t.view
+ | _ ->
+ Lwt.return t.view
+
+ (** run initiator:
+ pick a random node from [t.view] to gossip with every [t.period] seconds *)
+ let run ?stop t =
+ match t.stop with
+ | Some stop -> stop
+ | None ->
+ let stop =
+ match stop with
+ | None ->
+ let (stop, stopper) = Lwt.wait () in
+ t.stopper <- Some stopper;
+ t.stop <- Some stop;
+ stop
+ | Some stop ->
+ t.stop <- Some stop;
+ stop in
+
+ let rec loop () =
+ let (dst, sent, view_before) =
+ Gossip.initiate ~me:t.me ~view:t.view ~xview:View.empty
+ ~xchg_len:t.xchg_len in
+ let%lwt view_after = timeout t.period stop
+ (initiate t dst sent view_before) in
+ let _ = t.view <- match view_after with
+ | Some v -> v
+ | _ -> view_before in
+ match Lwt.state stop with
+ | Lwt.Sleep -> loop ()
+ | _ -> Lwt.return_unit
+ in loop ()
+
+ let shutdown t =
+ match t.stopper with
+ | Some stopper ->
+ Lwt.wakeup_later stopper ();
+ t.stop <- None;
+ t.stopper <- None
+ | None ->
+ match t.stop with
+ | Some stop ->
+ Lwt.cancel stop;
+ t.stop <- None
+ | None -> ()
+
+ (** merge received entries from a node and send response *)
+ let respond t src recvd =
+ let sent = Gossip.respond ~view:t.view ~xview:View.empty
+ ~recvd ~src ~me:t.me ~xchg_len:t.xchg_len in
+ let%lwt _ = Io.respond_gossip t.io src sent in
+ let%lwt recvd = Io.gossip_recvd t.io src recvd t.view in
+ t.view <- Gossip.merge ~view:t.view ~view_len:t.view_len
+ ~sent ~recvd ~xchg_len:t.xchg_len ~me:t.me;
+ Lwt.return t.view
+
+end
+
+(** Signatures *)
+module S = S
diff --git a/lib/p2p-cyclon-lwt/s.ml b/lib/p2p-cyclon-lwt/s.ml
new file mode 100644
index 0000000..299239b
--- /dev/null
+++ b/lib/p2p-cyclon-lwt/s.ml
@@ -0,0 +1,86 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+module type CYCLON = sig
+ type t
+ type nid
+ type node
+ type view
+ type io
+
+ val init : me:node -> view:view -> view_len:int -> xchg_len:int
+ -> period:float -> io:io -> t
+ (** [init node view view_len xchg_len period io]
+ initializes a CYCLON instance with the following configuration:
+ - [me] - this node
+ - [view] - initial view
+ - [view_len] - max view length
+ - [xchg_len] - number of entries to exchange at each period
+ - [period] - gossip period, in seconds
+ - [io]
+ *)
+
+ val run : ?stop:unit Lwt.t -> t -> unit Lwt.t
+ (** [run t] runs initiator thread:
+ picks a random node from [view] to gossip with
+ every [period] seconds.
+
+ If [?stop] is provided, this initiator thread returns
+ as soon as the [stop] thread is fulfilled. *)
+
+ val shutdown : t -> unit
+ (** [shutdown t] stops initiator thread.
+
+ In case [run] was called with a [stop] argument,
+ the [stop] thread is cancelled, otherwise it is fulfilled. *)
+
+ val respond : t -> node -> view -> view Lwt.t
+ (** [respond t src recvd]
+ merges received entries from a node and sends response *)
+
+ val view : t -> view
+ (** [view t] returns current view *)
+end
+
+
+module type CYCLON_IO = sig
+ type t
+ type nid
+ type node
+ type view
+
+ val initiate_gossip : t -> node -> view -> view Lwt.t
+ (** [initiate_gossip dst xchg]
+ sends [xchg] entries to [node]
+ and returns response *)
+
+ val respond_gossip : t -> node -> view -> unit Lwt.t
+ (** [respond_gossip t src xchg]
+ sends [xchg] entries in response to [node] *)
+
+ val gossip_recvd : t -> node -> view -> view -> view Lwt.t
+ (** [gossip_recvd t src recvd view]
+ is called after entries are received during an exchange;
+ allows rewriting [recvd] entries with the returned value,
+ thus allows using a stream sampler such as URPS
+ to provide uniformly random nodes
+ instead of the possibly biased exchanged nodes *)
+
+ val view_updated : t -> node -> view -> unit Lwt.t
+ (** [view_updated node view]
+ is called when [view] has been updated
+ after a gossip exchange with [node] *)
+end
diff --git a/lib/p2p-cyclon/dune b/lib/p2p-cyclon/dune
new file mode 100644
index 0000000..e4a9d02
--- /dev/null
+++ b/lib/p2p-cyclon/dune
@@ -0,0 +1,4 @@
+(library
+ (name p2p_cyclon)
+ (public_name p2p-cyclon)
+ (libraries p2p))
diff --git a/lib/p2p-cyclon/p2p_cyclon.ml b/lib/p2p-cyclon/p2p_cyclon.ml
new file mode 100644
index 0000000..be821c4
--- /dev/null
+++ b/lib/p2p-cyclon/p2p_cyclon.ml
@@ -0,0 +1,75 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+(** Functor building an implementation of Cyclon
+ given a [Node_id], [Node], and gossip [View]. *)
+module Make
+ (Node_id : P2p.S.NODE_ID)
+ (Node : P2p.S.NODE with type nid := Node_id.t)
+ (View : P2p.S.VIEW with type nid := Node_id.t
+ and type node := Node.t)
+ : P2p.S.GOSSIP with type node := Node.t
+ and type view := View.t = struct
+
+ let initiate ~view ~xview ~me ~xchg_len =
+ let dst = View.oldest view in
+ match dst with
+ | Some dst ->
+ let view = View.remove (Node.id dst) view in
+ let view = View.incr_age view in
+ let uview = View.union view xview in
+ let xchg = View.random_subset (xchg_len - 1) uview in
+ let xchg = View.add me xchg in
+ (Some dst, xchg, view)
+ | None -> (* view empty *)
+ (None, View.empty, view)
+
+ let respond ~view ~xview ~recvd ~src ~me ~xchg_len =
+ let _recvd = recvd and _src = src and _me = me in
+ let uview = View.union view xview in
+ View.random_subset xchg_len uview
+
+ let merge ~view ~view_len ~sent ~recvd ~xchg_len ~me =
+ let sent = View.remove (Node.id me) sent in
+ let recvd = View.remove (Node.id me) recvd in
+ let recvd = View.random_subset xchg_len recvd in
+ let recvd = View.zero_age recvd in
+ let rec merge view sent recvd =
+ if 0 < View.length recvd then
+ match View.random recvd with
+ | (Some rnode) ->
+ if View.length view < view_len then
+ (* fill an empty slot in view *)
+ let view = View.add rnode view in
+ let recvd = View.remove (Node.id rnode) recvd in
+ merge view sent recvd
+ else (* replace a sent entry in view with a received one *)
+ (match View.random sent with
+ | Some snode ->
+ let view = View.add rnode view in
+ let view =
+ if view_len < View.length view
+ then View.remove (Node.id snode) view
+ else view in
+ let sent = View.remove (Node.id snode) sent in
+ let recvd = View.remove (Node.id rnode) recvd in
+ merge view sent recvd
+ | _ -> view)
+ | _ -> view
+ else view in
+ merge view sent recvd
+
+end
diff --git a/lib/p2p-cyclon/p2p_cyclon.mli b/lib/p2p-cyclon/p2p_cyclon.mli
new file mode 100644
index 0000000..6bec4bf
--- /dev/null
+++ b/lib/p2p-cyclon/p2p_cyclon.mli
@@ -0,0 +1,54 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+(**
+
+{1 CYCLON: Inexpensive Membership Management for Unstructured P2P Overlays}
+
+This is an OCaml implementation of the CYCLON protocol as specified in the paper
+{{:https://www.distributed-systems.net/my-data/papers/2005.jnsm.pdf}
+CYCLON: Inexpensive Membership Managementfor Unstructured P2P Overlays}.
+
+{2 Protocol}
+
++ Increase by one the age of all neighbors.
++ Select neighbor {e Q} with the highest age among all neighbors, and {e l - 1} other random neighbors.
++ Replace {e Q}'s entry with a new entry of age 0 and with {e P}'s address.
++ Send the updated subset to peer {e Q}.
++ Receive from {e Q} a subset of no more that {e i} of its own entries.
++ Discard entries pointing at {e P} and entries already contained in {e P}'s cache.
++ Update {e P}'s cache to include {e all} remaining entries, by {e firstly} using empty cache slots (if any),
+ and {e secondly} replacing entries among the ones sent to {e Q}.
+
+{e Quoted from the paper above.}
+
+{2 Security}
+
+CYCLON is not secure against malicious nodes deviating from the protocol.
+See {{:https://github.com/p2pcollab/ocaml-urps} URPS} for a stream sampler
+implementation that achieves uniformity in presence of malicious nodes
+and which can be used together with CYCLON.
+*)
+
+open P2p
+
+module Make
+ (Node_id : S.NODE_ID)
+ (Node : S.NODE with type nid := Node_id.t)
+ (View : S.VIEW with type nid := Node_id.t
+ and type node := Node.t)
+ : S.GOSSIP with type node := Node.t
+ and type view := View.t
diff --git a/lib/p2p-poldercast-lwt/dune b/lib/p2p-poldercast-lwt/dune
new file mode 100644
index 0000000..6c0a3f1
--- /dev/null
+++ b/lib/p2p-poldercast-lwt/dune
@@ -0,0 +1,14 @@
+(library
+ (name p2p_poldercast_lwt)
+ (public_name p2p-poldercast-lwt)
+ (libraries p2p
+ p2p-poldercast
+ p2p-ringcast
+ p2p-ringcast-lwt
+ p2p-vicinity
+ p2p-vicinity-lwt
+ p2p-cyclon
+ p2p-cyclon-lwt
+ lwt
+ lwt.unix)
+ (preprocess (pps lwt_ppx)))
diff --git a/lib/p2p-poldercast-lwt/p2p_poldercast_lwt.ml b/lib/p2p-poldercast-lwt/p2p_poldercast_lwt.ml
new file mode 100644
index 0000000..0a3dbe4
--- /dev/null
+++ b/lib/p2p-poldercast-lwt/p2p_poldercast_lwt.ml
@@ -0,0 +1,164 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+(**
+{1 PolderCast with Lwt}
+
+High-level library implementing the PolderCast protocol using Lwt.
+*)
+
+(** Functor building an implementation of Poldercast with Lwt
+ given a FIXME [Node_id], [Node], gossip [View], PolderCast [Gossip] protocol,
+ and an [Io] event handler module. *)
+module Make
+ (Node_id : P2p.S.NODE_ID)
+ (Group_id: P2p.S.GROUP_ID)
+ (Node : P2p.S.NODE with type nid := Node_id.t)
+ (Group: P2p.S.GROUP with type gid := Group_id.t)
+ (View : P2p.S.VIEW with type nid := Node_id.t
+ and type node := Node.t)
+ (Msg_id : P2p.S.MSG_ID)
+ (Ringcast : P2p.S.GOSSIP_DISSEM with type nid := Node_id.t
+ and type node := Node.t
+ and type view := View.t
+ and type mid := Msg_id.t)
+ (Ringcast_io : P2p_ringcast_lwt.S.RINGCAST_IO with type nid := Node_id.t
+ and type node := Node.t
+ and type view := View.t
+ and type mid := Msg_id.t)
+ (Ringcast_lwt : P2p_ringcast_lwt.S.RINGCAST with type nid := Node_id.t
+ and type node := Node.t
+ and type view := View.t
+ and type mid := Msg_id.t
+ and type io := Ringcast_io.t)
+ (Poldercast : P2p_poldercast.S.PUBSUB with type nid := Node_id.t
+ and type gid := Group_id.t
+ and type node := Node.t
+ and type group := Group.t
+ and type view := View.t
+ and type mid := Msg_id.t)
+ : S.POLDERCAST with type nid := Node_id.t
+ and type gid := Group_id.t
+ and type node := Node.t
+ and type group := Group.t
+ and type view := View.t
+ and type mid := Msg_id.t
+ and type ring := P2p_ringcast_lwt.Make
+ (Node_id) (Node) (View) (Msg_id)
+ (Ringcast) (Ringcast_io) .t
+ and type ring_io := Ringcast_io.t = struct
+
+ module Pub = Poldercast.Pub
+ module Sub = Poldercast.Sub
+ module RCL = P2p_ringcast_lwt.Make (Node_id) (Node) (View) (Msg_id)
+ (Ringcast) (Ringcast_io)
+
+ (** data associated with a subscription *)
+ type sub = {
+ me : Node.t;
+ group : Group.t;
+ ring : RCL.t;
+ ring_t : unit Lwt.t;
+ stop : unit Lwt.t;
+ io : Ringcast_io.t;
+ }
+
+ type t = {
+ me : Node.t;
+ view_len : int;
+ xchg_len : int;
+ period : float;
+ fanout : int;
+ seen_len : int;
+ subs : sub Poldercast.Sub.t; (** Group_id.t -> sub *)
+ io : (Group.t -> Ringcast_io.t);
+ stop : unit Lwt.t;
+ stopper : unit Lwt.u option;
+ }
+
+ let sub ?(view=View.empty) t group =
+ let io = t.io group in
+ let ring = RCL.init
+ ~me:t.me ~view ~view_len:t.view_len
+ ~xchg_len:t.xchg_len ~period:t.period ~fanout:t.fanout
+ ~seen_len:t.seen_len ~io in
+ let stop = Lwt.choose [ fst (Lwt.task ()); t.stop ] in
+ let ring_t = RCL.run ring ~stop in
+ let sub = { me = t.me; group; ring; ring_t; stop; io } in
+ let subs = Sub.add group sub t.subs in
+ { t with subs }
+
+ let unsub t gid =
+ match Sub.find gid t.subs with
+ | Some (_group, sub) ->
+ let () = Lwt.cancel sub.stop in
+ let subs = Sub.remove gid t.subs in
+ Ok { t with subs }
+ | None -> Error "Group not found"
+
+ let init ~me ?max_subs ~view_len ~xchg_len ~period ~fanout ~seen_len
+ ?(sub_list = []) ?stop ~io =
+ let subs = match max_subs with
+ | Some max_subs -> Sub.init max_subs
+ | None -> Sub.empty in
+ let (stop, stopper) =
+ match stop with
+ | None ->
+ let (stop, stopper) = Lwt.wait () in
+ (stop, Some stopper)
+ | Some stop ->
+ (stop, None) in
+ let t = { me; subs; view_len; xchg_len; period; fanout; seen_len; io;
+ stop; stopper } in
+ List.fold_left
+ (fun t (group, view) ->
+ sub t group ~view)
+ t sub_list
+
+ let run t =
+ t.stop
+
+ let shutdown t =
+ match t.stopper with
+ | Some stopper ->
+ Lwt.wakeup_later stopper ();
+ | None ->
+ Lwt.cancel t.stop
+
+ let find t gid =
+ match Sub.find gid t.subs with
+ | Some (_group, sub) ->
+ Some sub.ring
+ | None -> None
+
+ let view t =
+ Sub.fold
+ (fun _gid (_group, sub) view ->
+ View.union view (RCL.view sub.ring))
+ t.subs View.empty
+
+ let to_list t =
+ Sub.fold
+ (fun _gid data lst ->
+ let (group, sub) = data in
+ let view = (RCL.view sub.ring) in
+ (group, view) :: lst)
+ t.subs []
+
+end
+
+(** Signatures *)
+module S = S
diff --git a/lib/p2p-poldercast-lwt/s.ml b/lib/p2p-poldercast-lwt/s.ml
new file mode 100644
index 0000000..d556cca
--- /dev/null
+++ b/lib/p2p-poldercast-lwt/s.ml
@@ -0,0 +1,74 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+module type POLDERCAST = sig
+ type t
+ type nid
+ type gid
+ type node
+ type group
+ type view
+ type mid
+ type ring
+ type ring_io
+
+ val init : me:node -> ?max_subs:int -> view_len:int -> xchg_len:int
+ -> period:float -> fanout:int -> seen_len:int
+ -> ?sub_list:(group * view) list -> ?stop:unit Lwt.t
+ -> io:(group -> ring_io) -> t
+ (** [init node view view_len xchg_len period fanout seen_cap]
+ initializes a PolderCast instance with the following configuration.
+
+ @param me this node
+ @param view initial view
+ @param view_len max view length
+ @param xchg_len number of entries to exchange at each period
+ @param period gossip period, in seconds
+ @param fanout dissemination fanout
+ @param seen_len length of queue of last seen message IDs
+ @param stop thread that shuts down all groups when cancelled
+ *)
+
+ val run : t -> unit Lwt.t
+ (** [run t] returns a promise that is fulfilled upon [shutdown] *)
+
+ val shutdown : t -> unit
+ (** [shutdown t] shuts down all subscribed groups.
+
+ After calling this function, [sub] cannot be called again with [t]. *)
+
+ val sub : ?view:view -> t -> group -> t
+ (** [sub ?view t group] subscribes to [group] with initial [view] *)
+
+ val unsub : t -> gid -> (t, string) result
+ (** [unsub t gid] unsubscribes from group with ID [gid] *)
+
+ val find : t -> gid -> ring option
+
+ val view : t -> view
+ (** [view t] returns the combined view of all subscribed groups *)
+
+ val to_list : t -> (group * view) list
+ (** [to_list t] returns a list of [(group, view)] pairs
+ of all subscribed groups paired with their current membership view *)
+end
+
+module type RINGCAST_IO = sig
+ include P2p_ringcast_lwt.S.RINGCAST_IO
+ type group
+
+ val init : 'a -> group -> t
+end
diff --git a/lib/p2p-poldercast/dune b/lib/p2p-poldercast/dune
new file mode 100644
index 0000000..5e6c676
--- /dev/null
+++ b/lib/p2p-poldercast/dune
@@ -0,0 +1,4 @@
+(library
+ (name p2p_poldercast)
+ (public_name p2p-poldercast)
+ (libraries p2p p2p-ringcast bloomf blip))
diff --git a/lib/p2p-poldercast/node.ml b/lib/p2p-poldercast/node.ml
new file mode 100644
index 0000000..0e4e6e0
--- /dev/null
+++ b/lib/p2p-poldercast/node.ml
@@ -0,0 +1,72 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+module Make
+ (Node_id: P2p.S.NODE_ID)
+ : S.NODE with type nid := Node_id.t = struct
+
+ module Node = P2p.Node.Make (Node_id)
+
+ type node = Node.t
+ type t = {
+ node : node;
+ subs : Bitv.t;
+ }
+
+ (** Base *)
+
+ let id t = Node.id t.node
+ let age t = Node.age t.node
+ let ver t = Node.ver t.node
+ let zero_age t = { t with node = Node.zero_age t.node }
+ let incr_age t = { t with node = Node.incr_age t.node }
+ let set_age t age = { t with node = Node.set_age t.node age }
+ let set_ver t ver = { t with node = Node.set_ver t.node ver }
+ let incr_ver t = { t with node = Node.incr_ver t.node }
+
+ let compare a b = Node.compare a.node b.node
+
+ let distance a b = Node.distance a.node b.node
+
+ let distance_ring a b = Node.distance_ring a.node b.node
+
+ (** Extensions *)
+
+ let init ?age ?ver id =
+ let node = Node.init ?age ?ver id in
+ let subs = Bitv.create 0 false in
+ { node; subs }
+
+ let subs t =
+ t.subs
+
+ let set_subs t subs =
+ { t with subs }
+
+ let sim a b =
+ Blip.sim a.subs b.subs
+
+ let to_string t =
+ let buf = Buffer.create (Bitv.length t.subs) in
+ Bitv.iter
+ (fun b -> Buffer.add_char buf (char_of_int (if b then 1 else 0))) t.subs;
+ Printf.sprintf "%s\n%s\n" (Node.to_string t.node) (Buffer.contents buf)
+
+ let pp ppf t =
+ Node.pp ppf t.node;
+ Bitv.iter (fun b -> Fmt.pf ppf "%d" (if b then 1 else 0)) t.subs
+
+end
diff --git a/lib/p2p-poldercast/p2p-poldercast b/lib/p2p-poldercast/p2p-poldercast
new file mode 100644
index 0000000..7f12329
--- /dev/null
+++ b/lib/p2p-poldercast/p2p-poldercast
@@ -0,0 +1,16 @@
+ /home/dev/src/p2pcollab/ocaml-p2p/lib/p2p-poldercast:
+ total used in directory 48K available 33652480
+ drwxr-xr-x 1 dev dev 258 Sep 26 16:46 .
+ drwxr-xr-x 1 dev dev 266 Jun 5 19:30 ..
+ -rw-r--r-- 1 dev dev 109 Sep 26 01:26 dune
+ -rw-r--r-- 1 dev dev 2,2K Sep 26 01:26 .merlin
+ -rw-r--r-- 1 dev dev 980 Sep 26 16:46 .node.ml
+ -rw-r--r-- 1 dev dev 324 Sep 26 13:43 node.ml~
+ -rw-r--r-- 1 dev dev 332 Sep 26 13:22 node_profile.ml
+ -rw-r--r-- 1 dev dev 187 Sep 25 14:29 node_profile.ml~
+ -rw-r--r-- 1 dev dev 259 Sep 26 03:23 .p2p_poldercast.ml
+ -rw-r--r-- 1 dev dev 2,4K Sep 26 11:25 p2p_poldercast.ml
+ -rw-r--r-- 1 dev dev 1,8K May 24 17:38 p2p_poldercast.ml~
+ -rw-r--r-- 1 dev dev 184 Mar 15 2019 seenq.ml~
+ -rw-r--r-- 1 dev dev 588 Sep 26 16:20 .s.ml
+ -rw-r--r-- 1 dev dev 222 Sep 25 15:07 s.ml~
diff --git a/lib/p2p-poldercast/p2p_poldercast.ml b/lib/p2p-poldercast/p2p_poldercast.ml
new file mode 100644
index 0000000..b82f4af
--- /dev/null
+++ b/lib/p2p-poldercast/p2p_poldercast.ml
@@ -0,0 +1,154 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+(**
+{1 PolderCast: P2P Topic-based Pub/Sub}
+
+This is an OCaml implementation of PolderCast,
+a P2P topic-based pub/sub protocol described in the paper
+{{:https://hal.inria.fr/hal-01555561} PolderCast: Fast, Robust, and Scalable Architecture for P2P Topic-Based Pub/Sub}
+
+It relies on three different gossip protocols:
+- Random Peer Sampling, to find random nodes in the network. See the {!P2p_cyclon}module.
+- Clustering, to find nodes with overlapping subscriptions. See the {!P2p_vicinity} module.
+- Dissemination, for the dissemination of messages within a topic. See the {!P2p_ringcast} module.
+
+{2 Privacy}
+
+PolderCast, as specified in the paper, employs VICINITY for clustering,
+and transmits full node subscription profiles in the clear.
+See {{:https://github.com/p2pcollab/ocaml-blip} BLIP} for a privacy mechanism
+that transmits subscriptions as randomized Bloom filters instead,
+and {{:https://github.com/p2pcollab/ocaml-psi} BFPSI},
+a Bloom filter-based Private Set Intersection protocol
+to determine common subscriptions of two nodes.
+*)
+
+(** PolderCast*)
+module Make
+ (Node_id: P2p.S.NODE_ID)
+ (Group_id: P2p.S.GROUP_ID)
+ (Node: S.NODE with type nid := Node_id.t)
+ (Group: P2p.S.GROUP with type gid := Group_id.t)
+ (View: P2p.S.VIEW with type nid := Node_id.t
+ and type node := Node.t)
+ (Msg_id: P2p.S.MSG_ID)
+ (Pub : P2p.S.GOSSIP_DISSEM with type nid := Node_id.t
+ and type node := Node.t
+ and type view := View.t
+ and type mid := Msg_id.t)
+ : S.PUBSUB with type nid := Node_id.t
+ and type node := Node.t
+ and type view := View.t
+ and type mid := Msg_id.t
+ and type gid := Group_id.t
+ and type group := Group.t = struct
+
+ (** Publishing *)
+ module Pub = Pub
+
+ (** Subscriptions of this node *)
+ module Sub = struct
+ module Subs = Map.Make (Group_id)
+
+ type group = Group.t
+
+ type 'a t = {
+ subs : (group * 'a) Subs.t; (** subscriptions: gid -> group *)
+ bf : Group_id.t Bloomf.t;
+ mutable bf_dirty : bool;
+ b : Bitv.t;
+ }
+
+ let init max_subs =
+ let subs = Subs.empty in
+ let bf = Bloomf.create max_subs in
+ let b = Bloomf.bits bf in
+ { subs; bf; b; bf_dirty = false }
+
+ let empty =
+ init 1000
+
+ let rebuild_bf t =
+ Bloomf.clear t.bf;
+ Subs.iter (fun gid _group -> Bloomf.add t.bf gid) t.subs;
+ t.bf_dirty <- false
+
+ (** subscribe to [group] with ID [gid] *)
+ let add group data t =
+ let gid = Group.id group in
+ let subs = Subs.add gid (group, data) t.subs in
+ Bloomf.add t.bf gid;
+ { t with subs }
+
+ let remove gid t =
+ let subs = Subs.remove gid t.subs in
+ { t with subs; bf_dirty = true }
+
+ let bloom t =
+ if t.bf_dirty then rebuild_bf t;
+ Bloomf.bits t.bf
+
+ let blip t e =
+ let _m, k = Bloomf.params t.bf in
+ Blip.flip (bloom t) (Blip.p e k)
+
+ let length t =
+ Subs.cardinal t.subs
+
+ let is_empty t =
+ Subs.is_empty t.subs
+
+ let mem gid t =
+ Subs.mem gid t.subs
+
+ let find gid t =
+ Subs.find_opt gid t.subs
+
+ let filter f t =
+ let subs = Subs.filter f t.subs in
+ { t with subs }
+
+ let fold f t a =
+ Subs.fold f t.subs a
+
+ let iter f t =
+ Subs.iter f t.subs
+
+ let map f t =
+ let subs = Subs.mapi f t.subs in
+ { t with subs }
+
+ let to_list t =
+ List.map
+ (fun (_gid, group) -> group)
+ (Subs.bindings t.subs)
+
+ let of_list max_subs l =
+ List.fold_left
+ (fun t (group, data) ->
+ add group data t)
+ (init max_subs) l
+
+ end
+
+end
+
+(** Signatures *)
+module S = S
+
+(** Node *)
+module Node = Node
diff --git a/lib/p2p-poldercast/s.ml b/lib/p2p-poldercast/s.ml
new file mode 100644
index 0000000..0177230
--- /dev/null
+++ b/lib/p2p-poldercast/s.ml
@@ -0,0 +1,74 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+(** Node *)
+module type NODE = sig
+
+ include P2p.S.NODE
+
+ (** Subscriptions of node *)
+ val subs : t -> Bitv.t
+
+ val set_subs : t -> Bitv.t -> t
+
+ val sim : t -> t -> float
+end
+
+(** Subscriptions of this node to groups *)
+module type SUBSCRIPTION = sig
+
+ include P2p.S.SUBSCRIPTION
+
+ val init : int -> 'a t
+ (** [int max_subs] initializes an empty subscription set
+ with [max_subs] maximum number of subscriptions expected. *)
+
+ val of_list : int -> (group * 'a) list -> 'a t
+ (** [of_list max_subs sub_list] initializes a subscription set
+ from a list of (group, metadata) pairs *)
+
+ val bloom : 'a t -> Bitv.t
+ (** [bloom t] returns a bloom filter with the subscribed group IDs inserted. *)
+
+ val blip : 'a t -> float -> Bitv.t
+ (** [blip t e] is [bloom] with independent random bit flips.
+
+ @param e Differential privacy parameter ε.
+ Determines the privacy-utility trade-off.
+ See {! Blip.p} in the documentation of the [Blip] module. *)
+end
+
+(** Publish-subscribe message dissemination *)
+module type PUBSUB = sig
+ type nid
+ type node
+ type view
+ type mid
+ type gid
+ type group
+
+ module Pub : sig
+ include P2p.S.GOSSIP_DISSEM
+ with type nid := nid
+ and type node := node
+ and type view := view
+ and type mid := mid
+ end
+
+ module Sub : SUBSCRIPTION
+ with type gid := gid
+ and type group := group
+end
diff --git a/lib/p2p-ringcast-lwt/dune b/lib/p2p-ringcast-lwt/dune
new file mode 100644
index 0000000..cfc193d
--- /dev/null
+++ b/lib/p2p-ringcast-lwt/dune
@@ -0,0 +1,5 @@
+(library
+ (name p2p_ringcast_lwt)
+ (public_name p2p-ringcast-lwt)
+ (libraries p2p p2p-ringcast lwt lwt.unix lru)
+ (preprocess (pps lwt_ppx)))
diff --git a/lib/p2p-ringcast-lwt/p2p_ringcast_lwt.ml b/lib/p2p-ringcast-lwt/p2p_ringcast_lwt.ml
new file mode 100644
index 0000000..ed28f83
--- /dev/null
+++ b/lib/p2p-ringcast-lwt/p2p_ringcast_lwt.ml
@@ -0,0 +1,166 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+(**
+{1 RingCast with Lwt}
+
+High-level library implementing the RingCast protocol using Lwt.
+*)
+
+(** Functor building an implementation of Ringcast with Lwt
+ given a [Node_id], [Node], gossip [View], RingCast [Gossip] protocol,
+ and an [Io] event handler module. *)
+module Make
+ (Node_id : P2p.S.NODE_ID)
+ (Node : P2p.S.NODE with type nid := Node_id.t)
+ (View : P2p.S.VIEW with type nid := Node_id.t
+ and type node := Node.t)
+ (Msg_id : P2p.S.MSG_ID)
+ (Ringcast : P2p.S.GOSSIP_DISSEM with type nid := Node_id.t
+ and type node := Node.t
+ and type view := View.t
+ and type mid := Msg_id.t)
+ (Io : S.RINGCAST_IO with type nid := Node_id.t
+ and type node := Node.t
+ and type view := View.t
+ and type mid := Msg_id.t)
+ : S.RINGCAST with type nid := Node_id.t
+ and type node := Node.t
+ and type view := View.t
+ and type mid := Msg_id.t
+ and type io := Io.t = struct
+
+ module Gossip = Ringcast
+
+ type t = {
+ me : Node.t; (** this node *)
+ mutable view : View.t; (** partial view of gossip protocol *)
+ view_len : int; (** max view length *)
+ xchg_len : int; (** max exchange length *)
+ period : float; (** gossip period in seconds *)
+ fanout : int;
+ io : Io.t;
+ mutable seen : Gossip.seen;
+ mutable stop : unit Lwt.t option;
+ mutable stopper : unit Lwt.u option;
+ }
+
+ let init ~me ~view ~view_len ~xchg_len ~period ~fanout ~seen_len ~io =
+ let seen = Gossip.init_seen seen_len in
+ { me; view; view_len; xchg_len; period; fanout; seen; io;
+ stop = None; stopper = None; }
+
+ let view t = t.view
+
+ (** Wait for [delay] seconds,
+ then return the result of thread [t],
+ or cancel it if not finished yet **)
+ let timeout delay stop t =
+ let%lwt _ = Lwt.choose [ Lwt_unix.sleep delay; stop ] in
+ match Lwt.state t with
+ | Lwt.Sleep -> Lwt.cancel t; Lwt.return None
+ | Lwt.Return v -> Lwt.return (Some v)
+ | Lwt.Fail ex -> Lwt.fail ex
+
+ (** Initiate exchange with a node from [t.view],
+ wait for response, and return merged view. *)
+ let initiate t dst sent view =
+ match dst with
+ | (Some dst) ->
+ let%lwt recvd = Io.initiate_gossip t.io dst sent in
+ let%lwt recvd = Io.gossip_recvd t.io dst recvd t.view in
+ t.view <- Gossip.merge ~view ~view_len:t.view_len ~me:t.me
+ ~sent ~recvd ~xchg_len:t.xchg_len;
+ let%lwt _ = Io.view_updated t.io t.me t.view in
+ Lwt.return t.view
+ | _ ->
+ Lwt.return t.view
+
+ (** Run active thread.
+ Pick a random node from [t.view] to gossip with
+ every [t.period] seconds. *)
+ let run ?stop t =
+ match t.stop with
+ | Some stop -> stop
+ | None ->
+ let stop =
+ match stop with
+ | None ->
+ let (stop, stopper) = Lwt.wait () in
+ t.stopper <- Some stopper;
+ t.stop <- Some stop;
+ stop
+ | Some stop ->
+ t.stop <- Some stop;
+ stop in
+
+ let rec loop () =
+ let xview = Io.get_xview t.io in
+ let (dst, sent, view_before) =
+ Gossip.initiate ~me:t.me ~view:t.view ~xview
+ ~xchg_len:t.xchg_len in
+ let%lwt view_after = timeout t.period stop (initiate t dst sent view_before) in
+ let _ = t.view <- match view_after with
+ | Some v -> v
+ | _ -> view_before in
+ match Lwt.state stop with
+ | Lwt.Sleep -> loop ()
+ | _ -> Lwt.return_unit
+ in loop ()
+
+ let shutdown t =
+ match t.stopper with
+ | Some stopper ->
+ Lwt.wakeup_later stopper ();
+ t.stop <- None;
+ t.stopper <- None
+ | None ->
+ match t.stop with
+ | Some stop ->
+ Lwt.cancel stop;
+ t.stop <- None
+ | None -> ()
+
+ (** Merge received entries from a node and send response *)
+ let respond t src recvd =
+ let xview = Io.get_xview t.io in
+ let sent = Gossip.respond ~view:t.view ~xview
+ ~recvd ~src ~me:t.me ~xchg_len:t.xchg_len in
+ let%lwt _ = Io.respond_gossip t.io src sent in
+ let%lwt recvd = Io.gossip_recvd t.io src recvd t.view in
+ t.view <- Gossip.merge ~view:t.view ~view_len:t.view_len
+ ~sent ~recvd ~xchg_len:t.xchg_len ~me:t.me;
+ Lwt.return t.view
+
+ (** Forward [msg] with ID [mid] from [src] to [t.fanout] nodes in [t.view] *)
+ let forward t src mid msg =
+ let (targets, seen) =
+ Gossip.forward ~view:t.view ~seen:t.seen ~mid
+ ~src ~me:t.me ~fanout:t.fanout
+ in
+ View.iter
+ (fun _nid node ->
+ let _ =
+ let%lwt _ = Io.send_msg t.io node mid msg
+ in Lwt.return_unit
+ in ()) targets;
+ t.seen <- seen;
+ Lwt.return_unit
+
+end
+
+(** Signatures *)
+module S = S
diff --git a/lib/p2p-ringcast-lwt/s.ml b/lib/p2p-ringcast-lwt/s.ml
new file mode 100644
index 0000000..3a7e2ec
--- /dev/null
+++ b/lib/p2p-ringcast-lwt/s.ml
@@ -0,0 +1,102 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+module type RINGCAST = sig
+ type t
+ type nid
+ type node
+ type view
+ type mid
+ type io
+
+ val init : me:node -> view:view -> view_len:int -> xchg_len:int -> period:float
+ -> fanout:int -> seen_len:int -> io:io -> t
+ (** [init node view view_len xchg_len period fanout seen_cap]
+ initializes a RingCast instance with the following configuration.
+
+ @param me this node
+ @param view initial view
+ @param view_len max view length
+ @param xchg_len number of entries to exchange at each period
+ @param period gossip period, in seconds
+ @param fanout dissemination fanout
+ @param seen_len length of queue of last seen message IDs
+ *)
+
+ val run : ?stop:unit Lwt.t -> t -> unit Lwt.t
+ (** [run ?stop t] runs initiator thread:
+ picks a random node from [view] to gossip with
+ every [period] seconds.
+
+ If [?stop] is provided, this initiator thread returns
+ as soon as the [stop] thread is fulfilled. *)
+
+ val shutdown : t -> unit
+ (** [shutdown t] stops initiator thread.
+
+ In case [run] was called with a [stop] argument,
+ the [stop] thread is cancelled, otherwise it is fulfilled. *)
+
+ val respond : t -> node -> view -> view Lwt.t
+ (** [respond t node recvd]
+ merges received entries from a node and sends response *)
+
+ val forward : t -> node -> mid -> Cstruct.t -> unit Lwt.t
+ (** [forward t src mid msg]
+ receives a message ([msgid, msg]) from a [src] node and
+ selects nodes from the local view it should be forwarded to
+ (predecessor or successor on the ring and some random nodes,
+ limited by [fanout]);
+ calls [Io.send_msg] for each selected node *)
+
+ val view : t -> view
+ (** [view t] returns current view *)
+end
+
+module type RINGCAST_IO = sig
+ type t
+ type nid
+ type mid
+ type node
+ type view
+
+ val initiate_gossip : t -> node -> view -> view Lwt.t
+ (** [initiate_gossip t node xchg]
+ sends [xchg] entries to [node]
+ and returns response *)
+
+ val respond_gossip : t -> node -> view -> unit Lwt.t
+ (** [respond_gossip t node xchg]
+ sends [xchg] entries in response to [node] *)
+
+ val gossip_recvd : t -> node -> view -> view -> view Lwt.t
+ (** [gossip_recvd t src recvd view]
+ is called after entries are received during an exchange;
+ allows rewriting [recvd] entries with the returned value. *)
+
+ val view_updated : t -> node -> view -> unit Lwt.t
+ (** [view_updated t node view]
+ is called when [view] has been updated
+ after a gossip exchange with [node] *)
+
+ val get_xview : t -> view
+ (** [get_xview t]
+ is called before selecting entries for a gossip exchange
+ and should return the view of other gossip protocol(s), if any. *)
+
+ val send_msg : t -> node -> mid -> Cstruct.t -> unit Lwt.t
+ (** [send_msg t dst msgid msg] *)
+end
diff --git a/lib/p2p-ringcast/dune b/lib/p2p-ringcast/dune
new file mode 100644
index 0000000..e801945
--- /dev/null
+++ b/lib/p2p-ringcast/dune
@@ -0,0 +1,4 @@
+(library
+ (name p2p_ringcast)
+ (public_name p2p-ringcast)
+ (libraries p2p lru))
diff --git a/lib/p2p-ringcast/p2p_ringcast.ml b/lib/p2p-ringcast/p2p_ringcast.ml
new file mode 100644
index 0000000..a4b002c
--- /dev/null
+++ b/lib/p2p-ringcast/p2p_ringcast.ml
@@ -0,0 +1,213 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+(**
+{1 RingCast: P2P hybrid dissemination protocol}
+
+This is an OCaml implementation of RingCast,
+a P2P hybrid (probabilistic/deterministic) dissemination protocol
+described in the paper
+{{:https://hal.inria.fr/hal-01555561} PolderCast}
+(and earlier in
+{{:https://www.distributed-systems.net/my-data/papers/2007.mw.pdf}
+Hybrid Dissemination}.
+
+It organizes nodes in a bidirectional ring structure
+and forwards messages to neighbours as well as random nodes.
+It achieves complete dissemination of messages with a low message overhead.
+*)
+
+(** Functor building an implementation of Ringcast
+ given a Node_id, Node, gossip View, and Msg_id. *)
+module Make
+ (Node_id: P2p.S.NODE_ID)
+ (Node: P2p.S.NODE with type nid := Node_id.t)
+ (View: P2p.S.VIEW with type nid := Node_id.t
+ and type node := Node.t)
+ (Msg_id: P2p.S.MSG_ID)
+ : S.GOSSIP_DISSEM with type nid := Node_id.t
+ and type node := Node.t
+ and type view := View.t
+ and type mid := Msg_id.t = struct
+
+ module W = struct
+ type t = int
+ let weight _ = 1
+ end
+
+ module Rng = Nocrypto.Rng
+ module SeenQ = Lru.F.Make(Msg_id)(W)
+
+ type seen = SeenQ.t
+
+ type dist =
+ {
+ node: Node.t;
+ dir: int;
+ dist: Node_id.t;
+ }
+
+ (** selects [len] closest neighbours to [dst] from [view]
+ (len/2 with lower and len/2 with higher ID) *)
+ let closest ~view ~dst ~len =
+ let dlist =
+ List.stable_sort
+ (fun n1 n2 ->
+ Node_id.compare n1.dist n2.dist)
+ (List.sort
+ (fun _n1 _n2 -> if Rng.Int.gen 2 = 0 then 1 else -1)
+ (View.fold
+ (fun _nid node lst ->
+ let (dir, dist) = Node.distance_ring dst node in
+ { node; dir; dist } :: lst)
+ view [])) in
+ let (dview_lo, dview_hi) =
+ List.fold_left
+ (fun (dview_lo, dview_hi) dnode ->
+ let dview_lo =
+ if dnode.dir < 0 then
+ if View.length dview_lo < len / 2 then
+ View.add dnode.node dview_lo
+ else dview_lo
+ else dview_lo in
+ let dview_hi =
+ if 0 < dnode.dir then
+ if View.length dview_hi < len / 2 then
+ View.add dnode.node dview_hi
+ else dview_hi
+ else dview_hi in
+ (dview_lo, dview_hi))
+ (View.empty, View.empty)
+ dlist
+ in
+ View.union dview_lo dview_hi
+
+ (** find the closest neighbour with lower ID to [dst] from [view] *)
+ let predecessor ~view ~dst =
+ let dlist =
+ List.stable_sort
+ (fun n1 n2 ->
+ compare n1.dist n2.dist)
+ (List.sort
+ (fun _n1 _n2 -> if Rng.Int.gen 2 = 0 then 1 else -1)
+ (View.fold
+ (fun _nid node lst ->
+ let (dir, dist) = Node.distance_ring dst node in
+ { node; dir; dist } :: lst)
+ view [])) in
+ match
+ List.nth_opt
+ (List.filter
+ (fun dnode -> dnode.dir < 0)
+ dlist)
+ 0 with
+ | Some dnode -> Some dnode.node
+ | None -> None
+
+ (** find the closest neighbour with lower ID to [dst] from [view] *)
+ let successor ~view ~dst =
+ let dlist =
+ List.stable_sort
+ (fun n1 n2 ->
+ compare n1.dist n2.dist)
+ (List.sort
+ (fun _n1 _n2 -> if Rng.Int.gen 2 = 0 then 1 else -1)
+ (View.fold
+ (fun _nid node lst ->
+ let (dir, dist) = Node.distance_ring dst node in
+ { node; dir; dist } :: lst)
+ view [])) in
+ match
+ List.nth_opt
+ (List.filter
+ (fun dnode -> 0 < dnode.dir)
+ dlist)
+ 0 with
+ | Some dnode -> Some dnode.node
+ | None -> None
+
+ let initiate ~view ~xview ~me ~xchg_len =
+ let dst = View.oldest view in
+ match dst with
+ | Some dst ->
+ let view = View.remove (Node.id dst) view in
+ let view = View.incr_age view in
+ let uview = View.union view xview in
+ let xchg = closest ~dst:me ~len:xchg_len ~view:uview in
+ let xchg = View.random_subset (xchg_len-1) xchg in
+ let xchg = View.add me xchg in
+ (Some dst, xchg, view)
+ | None ->
+ (None, View.empty, view)
+
+ let respond ~view ~xview ~recvd ~src ~me ~xchg_len =
+ let uview = View.add me view in
+ let uview = View.union uview xview in
+ let uview = View.filter (* remove recvd nodes *)
+ (fun nid _node -> not (View.mem nid recvd))
+ uview in
+ closest ~dst:src ~len:xchg_len ~view:uview
+
+ let merge ~view ~view_len ~sent ~recvd ~xchg_len ~me =
+ let _sent = sent in
+ let recvd = View.remove (Node.id me) recvd in
+ let recvd = View.random_subset xchg_len recvd in
+ let recvd = View.zero_age recvd in
+ let uview = View.union view recvd in
+ closest ~dst:me ~len:view_len ~view:uview
+
+ let init_seen seen_len =
+ SeenQ.empty seen_len
+
+ let forward ~view ~seen ~mid ~src ~me ~fanout =
+ if SeenQ.mem mid seen then (* already seen *)
+ (View.empty, seen)
+ else
+ let dsts =
+ let d = Node.compare me src in
+ let fanout_rnd =
+ if d = 0 then fanout - 2 (* msg from self *)
+ else fanout - 1 in
+ let dsts = View.random_subset fanout_rnd view in
+ if 0 < d then (* msg from successor, fwd to predecessor *)
+ let dst = predecessor ~view ~dst:me in
+ match dst with
+ | Some node -> View.add node dsts
+ | _ -> dsts
+ else if d < 0 then (* msg from predecessor fwd to successor *)
+ let dst = successor ~view ~dst:me in
+ match dst with
+ | Some node -> View.add node dsts
+ | _ -> dsts
+ else (* msg from self, fwd to both successor & predecessor *)
+ let pnode = predecessor ~view ~dst:me in
+ let snode = successor ~view ~dst:me in
+ let dsts =
+ match pnode with
+ | Some node -> View.add node dsts
+ | _ -> dsts in
+ match snode with
+ | Some node -> View.add node dsts
+ | _ -> dsts in
+ let seen =
+ SeenQ.trim @@
+ SeenQ.add mid 1 seen in
+ (dsts, seen)
+
+end
+
+(** Signatures *)
+module S = S
diff --git a/lib/p2p-ringcast/s.ml b/lib/p2p-ringcast/s.ml
new file mode 100644
index 0000000..93a2570
--- /dev/null
+++ b/lib/p2p-ringcast/s.ml
@@ -0,0 +1,53 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+module type DISSEMINATION = sig
+ type nid
+ type node
+ type view
+ type mid
+ type seen
+
+ val init_seen : int -> seen
+
+ val forward :
+ view : view
+ -> seen : seen
+ -> mid : mid
+ -> src : node
+ -> me : node
+ -> fanout : int
+ -> (view * seen)
+end
+
+module type GOSSIP_DISSEM = sig
+ type nid
+ type node
+ type view
+ type mid
+ type seen
+
+ include P2p.S.GOSSIP
+ with type node := node
+ and type view := view
+
+ include DISSEMINATION
+ with type nid := nid
+ and type node := node
+ and type view := view
+ and type mid := mid
+ and type seen := seen
+end
diff --git a/lib/p2p-vicinity-lwt/dune b/lib/p2p-vicinity-lwt/dune
new file mode 100644
index 0000000..6665b23
--- /dev/null
+++ b/lib/p2p-vicinity-lwt/dune
@@ -0,0 +1,5 @@
+(library
+ (name p2p_vicinity_lwt)
+ (public_name p2p-vicinity-lwt)
+ (libraries p2p p2p-vicinity lwt lwt.unix)
+ (preprocess (pps lwt_ppx)))
diff --git a/lib/p2p-vicinity-lwt/p2p_vicinity_lwt.ml b/lib/p2p-vicinity-lwt/p2p_vicinity_lwt.ml
new file mode 100644
index 0000000..aa808b9
--- /dev/null
+++ b/lib/p2p-vicinity-lwt/p2p_vicinity_lwt.ml
@@ -0,0 +1,143 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+(**
+{1 VICINITY with Lwt}
+
+High-level library implementing the VICINITY protocol using Lwt.
+*)
+
+(** Functor building an implementation of Vicinity with Lwt
+ given a [Node_id], [Node], gossip [View], [Vicinity] implementation,
+ and an [Io] event handler module. *)
+module Make
+ (Node_id : P2p.S.NODE_ID)
+ (Node : P2p.S.NODE with type nid := Node_id.t)
+ (View : P2p.S.VIEW with type nid := Node_id.t
+ and type node := Node.t)
+ (Vicinity : P2p.S.GOSSIP with type node := Node.t
+ and type view := View.t)
+ (Io : S.VICINITY_IO with type nid := Node_id.t
+ and type node := Node.t
+ and type view := View.t)
+ : S.VICINITY with type nid := Node_id.t
+ and type node := Node.t
+ and type view := View.t
+ and type io := Io.t = struct
+
+ module Gossip = Vicinity
+
+ type t = {
+ me : Node.t; (** this node *)
+ mutable view : View.t; (** partial view of gossip protocol *)
+ view_len : int; (** max view length *)
+ xchg_len : int; (** max exchange length *)
+ period : float; (** gossip period in seconds *)
+ io : Io.t;
+ mutable stop : unit Lwt.t option;
+ mutable stopper : unit Lwt.u option;
+ }
+
+ let init ~me ~view ~view_len ~xchg_len ~period ~io =
+ { me; view; view_len; xchg_len; period; io;
+ stop = None; stopper = None }
+
+ let view t = t.view
+
+ (** wait for [delay] seconds,
+ then return the result of thread [t],
+ or cancel it if not finished yet **)
+ let timeout delay stop t =
+ let%lwt _ = Lwt.choose [ Lwt_unix.sleep delay; stop ] in
+ match Lwt.state t with
+ | Lwt.Sleep -> Lwt.cancel t; Lwt.return None
+ | Lwt.Return v -> Lwt.return (Some v)
+ | Lwt.Fail ex -> Lwt.fail ex
+
+ (** initiate exchange with a node from [t.view],
+ wait for response, and return merged view *)
+ let initiate t dst sent view =
+ match dst with
+ | (Some dst) ->
+ let%lwt recvd = Io.initiate_gossip t.io dst sent in
+ let%lwt recvd = Io.gossip_recvd t.io dst recvd t.view in
+ t.view <- Gossip.merge ~view ~view_len:t.view_len ~me:t.me
+ ~sent ~recvd ~xchg_len:t.xchg_len;
+ let%lwt _ = Io.view_updated t.io t.me t.view in
+ Lwt.return t.view
+ | _ ->
+ Lwt.return t.view
+
+ (** run initiator: pick a random node from [t.view] to gossip with
+ every [t.period] seconds *)
+ let run ?stop t =
+ match t.stop with
+ | Some stop -> stop
+ | None ->
+ let stop =
+ match stop with
+ | None ->
+ let (stop, stopper) = Lwt.wait () in
+ t.stopper <- Some stopper;
+ t.stop <- Some stop;
+ stop
+ | Some stop ->
+ t.stop <- Some stop;
+ stop in
+
+ let rec loop () =
+ let xview = Io.get_xview t.io in
+ let (dst, sent, view_before) =
+ Gossip.initiate ~me:t.me ~view:t.view ~xview
+ ~xchg_len:t.xchg_len in
+ let%lwt view_after = timeout t.period stop
+ (initiate t dst sent view_before) in
+ let _ = t.view <- match view_after with
+ | Some v -> v
+ | _ -> view_before in
+ match Lwt.state stop with
+ | Lwt.Sleep -> loop ()
+ | _ -> Lwt.return_unit
+ in loop ()
+
+ let shutdown t =
+ match t.stopper with
+ | Some stopper ->
+ Lwt.wakeup_later stopper ();
+ t.stop <- None;
+ t.stopper <- None
+ | None ->
+ match t.stop with
+ | Some stop ->
+ Lwt.cancel stop;
+ t.stop <- None
+ | None -> ()
+
+ (** merge received entries from a node and send response *)
+ let respond t src recvd =
+ let xview = Io.get_xview t.io in
+ let sent = Gossip.respond ~view:t.view ~xview
+ ~recvd ~src ~me:t.me ~xchg_len:t.xchg_len in
+ let%lwt _ = Io.respond_gossip t.io src sent in
+ let%lwt recvd = Io.gossip_recvd t.io src recvd t.view in
+ t.view <- Gossip.merge ~view:t.view ~view_len:t.view_len
+ ~sent ~recvd ~xchg_len:t.xchg_len ~me:t.me;
+ Lwt.return t.view
+
+end
+
+(** Signatures *)
+module S = S
diff --git a/lib/p2p-vicinity-lwt/s.ml b/lib/p2p-vicinity-lwt/s.ml
new file mode 100644
index 0000000..e9ec3c5
--- /dev/null
+++ b/lib/p2p-vicinity-lwt/s.ml
@@ -0,0 +1,89 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+(** Type of a module implementing Vicinity using Lwt *)
+module type VICINITY = sig
+ type t
+ type nid
+ type node
+ type view
+ type io
+
+ val init : me:node -> view:view -> view_len:int -> xchg_len:int
+ -> period:float -> io:io -> t
+ (** [init node view view_len xchg_len period]
+ initializes a VICINITY instance with the following configuration:
+ - [my_node] - this node
+ - [view] - initial view
+ - [view_len] - max view length
+ - [xchg_len] - number of entries to exchange at each period
+ - [period] - gossip period, in seconds
+ *)
+
+ val run : ?stop:unit Lwt.t -> t -> unit Lwt.t
+ (** [run t] runs initiator thread:
+ picks a random node from [view] to gossip with
+ every [period] seconds.
+
+ If [?stop] is provided, this initiator thread returns
+ as soon as the [stop] thread is fulfilled. *)
+
+ val shutdown : t -> unit
+ (** [shutdown t] stops initiator thread.
+
+ In case [run] was called with a [stop] argument,
+ the [stop] thread is cancelled, otherwise it is fulfilled. *)
+
+ val respond : t -> node -> view -> view Lwt.t
+ (** [respond t src recvd]
+ merges received entries from a node and sends response *)
+
+ val view : t -> view
+ (** [view t] returns current view *)
+end
+
+(** Type of a module implementing network I/O
+ and event handlers for {! VICINITY} *)
+module type VICINITY_IO = sig
+ type t
+ type nid
+ type node
+ type view
+
+ val initiate_gossip : t -> node -> view -> view Lwt.t
+ (** [initiate_gossip t dst xchg]
+ sends [xchg] entries to [node]
+ and returns response *)
+
+ val respond_gossip : t -> node -> view -> unit Lwt.t
+ (** [respond_gossip t src xchg]
+ sends [xchg] entries in response to [node] *)
+
+ val gossip_recvd : t -> node -> view -> view -> view Lwt.t
+ (** [gossip_recvd t src recvd view]
+ is called after entries are received during an exchange;
+ allows rewriting [recvd] entries with the returned value. *)
+
+ val view_updated : t -> node -> view -> unit Lwt.t
+ (** [view_updated node view]
+ is called when [view] has been updated
+ after a gossip exchange with [node] *)
+
+ val get_xview : t -> view
+ (** [get_xview t]
+ is called before selecting entries for a gossip exchange
+ and should return the view of other gossip protocol(s), if any. *)
+end
diff --git a/lib/p2p-vicinity/dune b/lib/p2p-vicinity/dune
new file mode 100644
index 0000000..4c9fdb5
--- /dev/null
+++ b/lib/p2p-vicinity/dune
@@ -0,0 +1,4 @@
+(library
+ (name p2p_vicinity)
+ (public_name p2p-vicinity)
+ (libraries p2p))
diff --git a/lib/p2p-vicinity/p2p_vicinity.ml b/lib/p2p-vicinity/p2p_vicinity.ml
new file mode 100644
index 0000000..76285a5
--- /dev/null
+++ b/lib/p2p-vicinity/p2p_vicinity.ml
@@ -0,0 +1,100 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+(**
+{1 VICINITY: P2P topology management protocol}
+
+This is an implementation of VICINITY, a P2P topology management protocol
+described in the paper {{:https://hal.inria.fr/hal-01480790/document}
+VICINITY: A Pinch of Randomness Brings out the Structure}.
+The protocol takes care of overlay construction & maintenance,
+and can be used for e.g. clustering nodes in groups
+or organizing them in a coordinate system.
+*)
+
+(** Functor building an implementation of Vicinity
+ given a [Node_id], [Node], and gossip [View]. *)
+module Make
+ (Node_id : P2p.S.NODE_ID)
+ (Node : S.NODE with type nid := Node_id.t)
+ (View : P2p.S.VIEW with type nid := Node_id.t
+ and type node := Node.t)
+ : P2p.S.GOSSIP with type node := Node.t
+ and type view := View.t = struct
+
+ module Rng = Nocrypto.Rng
+
+ type s =
+ {
+ sim: float; (** similarity measure *)
+ node: Node.t;
+ }
+
+ (** select [xchg_len] nodes closest to [dst] from [view] *)
+ let closest ~view ~dst ~xchg_len =
+ let dlist =
+ List.stable_sort
+ (fun a b ->
+ if a.sim = b.sim then 0
+ else if a.sim < b.sim then -1
+ else 1)
+ (List.sort
+ (fun _a _b -> if Rng.Int.gen 2 = 0 then 1 else -1)
+ (View.fold
+ (fun _nid node lst ->
+ { node; sim = Node.sim dst node } :: lst)
+ view [])) in
+ List.fold_left
+ (fun dview dnode ->
+ if View.length dview < xchg_len
+ then View.add dnode.node dview
+ else dview)
+ View.empty
+ dlist
+
+ let initiate ~view ~xview ~me ~xchg_len =
+ let dst = View.oldest view in
+ match dst with
+ | Some dst ->
+ let view = View.remove (Node.id dst) view in
+ let view = View.incr_age view in
+ let uview = View.union view xview in
+ let xchg_len = xchg_len - 1 in
+ let xchg = closest ~dst:me ~xchg_len ~view:uview in
+ let xchg = View.add me xchg in
+ (Some dst, xchg, view)
+ | None ->
+ (None, View.empty, view)
+
+ let respond ~view ~xview ~recvd ~src ~me ~xchg_len =
+ let uview = View.add me view in
+ let uview = View.union uview xview in
+ let uview = View.filter (* remove recvd nodes *)
+ (fun nid _node -> not (View.mem nid recvd))
+ uview in
+ closest ~dst:src ~xchg_len ~view:uview
+
+ let merge ~view ~view_len ~sent ~recvd ~xchg_len ~me =
+ let _sent = sent in
+ let recvd = View.remove (Node.id me) recvd in
+ let recvd = View.random_subset xchg_len recvd in
+ let recvd = View.zero_age recvd in
+ let uview = View.union view recvd in
+ closest ~dst:me ~xchg_len:view_len ~view:uview
+end
+
+(** Signatures *)
+module S = S
diff --git a/lib/p2p-vicinity/s.ml b/lib/p2p-vicinity/s.ml
new file mode 100644
index 0000000..7ed4bc7
--- /dev/null
+++ b/lib/p2p-vicinity/s.ml
@@ -0,0 +1,24 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+(** Node *)
+module type NODE = sig
+
+ include P2p.S.NODE
+
+ (** Similarity measure *)
+ val sim : t -> t -> float
+end
diff --git a/lib/p2p/dune b/lib/p2p/dune
new file mode 100644
index 0000000..f9c5fd7
--- /dev/null
+++ b/lib/p2p/dune
@@ -0,0 +1,4 @@
+(library
+ (name p2p)
+ (public_name p2p)
+ (libraries fmt nocrypto stdint))
diff --git a/lib/p2p/group.ml b/lib/p2p/group.ml
new file mode 100644
index 0000000..df4272c
--- /dev/null
+++ b/lib/p2p/group.ml
@@ -0,0 +1,37 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+module Make
+ (Group_id : S.GROUP_ID)
+ : S.GROUP with type gid := Group_id.t = struct
+
+ type gid = Group_id.t
+
+ type t = {
+ id : gid;
+ }
+
+ let init id = { id }
+
+ let id t = t.id
+
+ let compare a b =
+ Group_id.compare a.id b.id
+
+ let pp ppf t =
+ Fmt.pf ppf "%a" Group_id.pp t.id
+
+end
diff --git a/lib/p2p/group_id.ml b/lib/p2p/group_id.ml
new file mode 100644
index 0000000..005ffb5
--- /dev/null
+++ b/lib/p2p/group_id.ml
@@ -0,0 +1,17 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+include Node_id
diff --git a/lib/p2p/msg_id.ml b/lib/p2p/msg_id.ml
new file mode 100644
index 0000000..005ffb5
--- /dev/null
+++ b/lib/p2p/msg_id.ml
@@ -0,0 +1,17 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+include Node_id
diff --git a/lib/p2p/node.ml b/lib/p2p/node.ml
new file mode 100644
index 0000000..8b28b60
--- /dev/null
+++ b/lib/p2p/node.ml
@@ -0,0 +1,68 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+module Make
+ (Node_id : S.NODE_ID)
+ : S.NODE with type nid := Node_id.t = struct
+
+ type nid = Node_id.t
+
+ type t = {
+ id : nid;
+ age : int;
+ ver : int;
+ }
+
+ let id t = t.id
+ let age t = t.age
+ let ver t = t.ver
+
+ let init ?(age=0) ?(ver=0) id =
+ { id; age; ver }
+
+ let compare a b =
+ Node_id.compare a.id b.id
+
+ let distance a b =
+ Node_id.distance a.id b.id
+
+ let distance_ring a b =
+ Node_id.distance_ring a.id b.id
+
+ let zero_age t =
+ { t with age = 0 }
+
+ let incr_age t =
+ { t with age = t.age + 1 }
+
+ let set_age t age =
+ { t with age }
+
+ let incr_ver t =
+ { t with ver = t.ver + 1 }
+
+ let set_ver t ver =
+ { t with ver }
+
+ let to_string t =
+ Printf.sprintf "%s (ver: %d; age: %d)"
+ (Node_id.to_string t.id) t.ver t.age
+
+ let pp ppf t =
+ Fmt.pf ppf "%s (ver: %d; age: %d)\n"
+ (Node_id.to_string t.id) t.ver t.age
+
+end
diff --git a/lib/p2p/node_id.ml b/lib/p2p/node_id.ml
new file mode 100644
index 0000000..c17ba62
--- /dev/null
+++ b/lib/p2p/node_id.ml
@@ -0,0 +1,57 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+open Stdint
+open Uint64
+
+type t = Uint64.t
+
+let zero = Uint64.zero
+let one = Uint64.one
+
+let random () =
+ let open Int64 in
+ let r1 = Nocrypto.Rng.Int64.gen max_int in
+ let r2 = Nocrypto.Rng.Int64.gen max_int in
+ let open Uint64 in
+ of_int64 r1 + of_int64 r2
+
+let compare a b =
+ if a = b then 0
+ else if a < b then -1
+ else 1
+
+let distance a b =
+ abs @@ a - b
+
+let distance_ring a b =
+ let d = abs (a - b) in
+ if d = zero
+ then (0, d)
+ else
+ let d = if d <= (max_int - min_int) / (of_int 2)
+ then d
+ else max_int + one - d in
+ if (a - b = d)
+ then (-1, d)
+ else (1, d)
+
+let to_uint64 t = t
+
+let to_string = Uint64.to_string
+
+let pp ppf t =
+ Fmt.pf ppf "%s" @@ Uint64.to_string t
diff --git a/lib/p2p/s.ml b/lib/p2p/s.ml
new file mode 100644
index 0000000..91fe6c0
--- /dev/null
+++ b/lib/p2p/s.ml
@@ -0,0 +1,399 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+(** Node ID *)
+module type NODE_ID = sig
+ type t
+
+ val zero : t
+ (** [zero] returns node ID 0 *)
+
+ val one : t
+ (** [one] returns node ID 1 *)
+
+ val random : unit -> t
+ (** [random] returns a random node ID. *)
+
+ val compare : t -> t -> int
+ (** [compare a b] compares node IDs [a] & [b].
+ @return
+ - [0] if a = b
+ - [-1] if [a] < [b]
+ - [1] if [b] < [a] *)
+
+ val distance : t -> t -> t
+ (** [distance a b] calculates distance between node IDs [a] & [b]. *)
+
+ val distance_ring : t -> t -> (int * t)
+ (** [distance_ring a b] calculates distance between node IDs [a] & [b]. *)
+
+ val to_uint64 : t -> Stdint.Uint64.t
+ (** [to_uint64 t] returns a uint64 representation of node ID [t] *)
+
+ val to_string : t -> string
+ (** [to_string t] returns a string representation of node ID [t] *)
+
+ val pp : Format.formatter -> t -> unit
+ (** [pp fmt t] pretty-prints node ID [t] *)
+end
+
+(** Group ID *)
+module type GROUP_ID = sig
+ type t
+
+ val compare : t -> t -> int
+ (** [compare a b] compares group IDs [a] & [b].
+ @return
+ - [0] if a = b
+ - [-1] if [a] < [b]
+ - [1] if [b] < [a] *)
+
+ val to_string : t -> string
+ (** [to_string t] returns a string representation of group ID [t] *)
+
+ val pp : Format.formatter -> t -> unit
+ (** [pp fmt t] pretty-prints group ID [t] *)
+end
+
+(** Message ID *)
+module type MSG_ID = sig
+ type t
+
+ val compare : t -> t -> int
+ (** [compare a b] compares message IDs [a] & [b].
+ @return
+ - [0] if a = b
+ - [-1] if [a] < [b]
+ - [1] if [b] < [a] *)
+
+ val to_string : t -> string
+ (** [to_string t] returns a string representation of message ID [t] *)
+
+ val pp : Format.formatter -> t -> unit
+ (** [pp fmt t] pretty-prints message ID [t] *)
+end
+
+(** Node *)
+module type NODE = sig
+ type t
+ type nid
+
+ val init : ?age:int -> ?ver:int -> nid -> t
+ (** [init ?age ?ver nid] *)
+
+ val id : t -> nid
+ (** [id t] returns ID of node [t] *)
+
+ val age : t -> int
+ (** [age t] returns ID of node profile [t] *)
+
+ val ver : t -> int
+ (** [ver t] returns version of node profile [t] *)
+
+ val compare : t -> t -> int
+ (** [compare a b] compares IDs of nodes [a] & [b].
+ See {! Node_id.compare} *)
+
+ val distance : t -> t -> nid
+ (** [distance a b] calculates distance between IDs of nodes [a] & [b].
+ See {! Node_id.distance} *)
+
+ val distance_ring : t -> t -> (int * nid)
+ (** [distance_ring a b] calculates distance on a ring
+ between IDs of nodes [a] & [b].
+ See {! Node_id.distance_ring} *)
+
+ val zero_age : t -> t
+ (** [zero_age t] sets the age of node profile to zero. *)
+
+ val set_age : t -> int -> t
+ (** [set_age t] sets the age of node profile to [age]. *)
+
+ val incr_age : t -> t
+ (** [incr_age t] increments the age of node profile. *)
+
+ val set_ver : t -> int -> t
+ (** [set_ver t] sets the version of node profile to [ver]. *)
+
+ val incr_ver : t -> t
+ (** [incr_ver t] increments the version of node profile. *)
+
+ val to_string : t -> string
+ (** [to_string t] returns a string representation of node [t] *)
+
+ val pp : Format.formatter -> t -> unit
+ (** [pp fmt t] pretty-prints node [t] *)
+end
+
+(** Group *)
+module type GROUP = sig
+ type t
+ type gid
+ (* type node *)
+
+ val init : gid -> t
+ (** [init gid] initializes a group with ID [gid]. *)
+
+ val id : t -> gid
+ (** [id t] returns the ID of group [t]. *)
+
+ val compare : t -> t -> int
+ (** [compare a b] compares IDs of groups [a] & [b].
+ See {! Group_id.compare} *)
+
+ val pp : Format.formatter -> t -> unit
+ (** [pp fmt t] pretty-prints group [t] *)
+end
+
+(** Gossip view *)
+module type VIEW = sig
+ type t
+ type nid
+ type node
+
+ val empty : t
+ (** [empty] is the empty view. *)
+
+ val add : node -> t -> t
+ (** [add node t] adds [node] to view [t] *)
+
+ val remove : nid -> t -> t
+ (** [remove node t] removes [node] from view [t] *)
+
+ val length : t -> int
+ (** [lengh t] returns the number of nodes in view [t] *)
+
+ val is_empty : t -> bool
+ (** [is_empty t] returns true if there are no nodes in view [t] *)
+
+ val mem : nid -> t -> bool
+ (** [mem nid t] returns true if [nid] is in view [t]. *)
+
+ val find : nid -> t -> node option
+ (** [find nid t] returns [Some node] if [nid] is in view [t],
+ otherwise [None]. *)
+
+ val oldest : t -> node option
+ (** [oldest t] returns the oldest node in view.
+ In case there are multiple oldest nodes, picks a random one of those. *)
+
+ val random : t -> node option
+ (** [random t] selects a random from view [t]. Returns [None] if [t] is empty. *)
+
+ val random_subset : int -> t -> t
+ (** [random_subset n t] selects a random subset of view [t] with [n] elements. *)
+
+ val union : t -> t -> t
+ (** [union a b] returns the union of views [a] & [b]. *)
+
+ val zero_age : t -> t
+ (** [zero_age t] sets the age of all nodes in view to 0. *)
+
+ val incr_age : t -> t
+ (** [incr_age t] increments the age of all nodes in view. *)
+
+ val filter : (nid -> node -> bool) -> t -> t
+ val fold : (nid -> node -> 'a -> 'a) -> t -> 'a -> 'a
+ val iter : (nid -> node -> unit) -> t -> unit
+ val map : (nid -> node -> node) -> t -> t
+
+ val to_list : t -> node list
+ val of_list : node list -> t
+
+ val pp : Format.formatter -> t -> unit
+ (** [pp ppf t] pretty-prints view [t] *)
+end
+
+(** Gossip protocol *)
+module type GOSSIP = sig
+ type node
+ type view
+
+ val initiate :
+ view : view
+ -> xview : view
+ -> me : node
+ -> xchg_len : int
+ -> (node option * view * view)
+ (** [initiate ~view ~xview ~me ~xchg_len ?distance]
+ initiates gossip exchange.
+
+ @param ~view current view
+ @param ~xview external view from another gossip protocol
+ @param ~me this node
+ @param ~xchg_len number of items in gossip exchange
+
+ @return [(Some dst, xchg, view)]:
+ @param dst destination node
+ @param xchg items to send to [dst]
+ @param view updated view of this node*)
+
+ val respond :
+ view : view
+ -> xview : view
+ -> recvd : view
+ -> src : node
+ -> me : node
+ -> xchg_len : int
+ -> view
+ (** [respond ~view ~xview ~recvd ~src ~me ~xchg_len]
+ responds to a gossip exchange.
+
+ @param ~view current view
+ @param ~xview external view from another gossip protocol
+ @param ~recvd received items
+ @param ~src source node
+ @param ~me this node
+ @param ~xchg_len number of items in gossip exchange
+
+ @return updated view *)
+
+ val merge :
+ view : view
+ -> view_len : int
+ -> sent : view
+ -> recvd : view
+ -> xchg_len : int
+ -> me : node
+ -> view
+ (** [merge ~view ~view_len ~sent ~recvd ~xchg_len ~me]
+ merges received entries during a gossip exchange.
+
+ @param ~view current view
+ @param ~view_len number of items in [view]
+ @param ~sent sent items
+ @param ~recvd received items
+ @param ~xchg_len number of items in gossip exchange
+ @param ~me this node
+
+ @return updated view *)
+end
+
+(** Dissemination of messages within a group *)
+module type DISSEMINATION = sig
+ type nid
+ type node
+ type view
+ type mid
+ type seen
+
+ val init_seen : int -> seen
+ (** [init_seen len] initializes the queue of last seen messages
+ with maximum queue length [len]. *)
+
+ val forward :
+ view : view
+ -> seen : seen
+ -> mid : mid
+ -> src : node
+ -> me : node
+ -> fanout : int
+ -> (view * seen)
+ (** Select recipients to forward an incoming or outgoing message.
+ If [mid] was already [seen] before, the message is not fowarded.
+
+ @param ~view Current view.
+ @param ~seen Queue of last seen message IDs.
+ @param ~mid Message ID.
+ @param ~src Source node.
+ @param ~fanout Number of nodes to select for forwarding.
+
+ @return [(dsts, seen)]
+ @param dsts The list of destinations to forward to.
+ @param seen Updated seen queue with [mid] added.
+ *)
+end
+
+(** Gossip + Dissemination combined *)
+module type GOSSIP_DISSEM = sig
+ type nid
+ type node
+ type view
+ type mid
+ type seen
+
+ include GOSSIP
+ with type node := node
+ and type view := view
+
+ include DISSEMINATION
+ with type nid := nid
+ and type node := node
+ and type view := view
+ and type mid := mid
+ and type seen := seen
+end
+
+(** Subscriptions of this node to groups *)
+module type SUBSCRIPTION = sig
+ type 'a t
+ type gid
+ type group
+
+ val empty : 'a t
+ (** [empty] returns the empty subscription set. *)
+
+ val add : group -> 'a -> 'a t -> 'a t
+ (** [add group 'a t] adds group to the subscription set [t] *)
+
+ val remove : gid -> 'a t -> 'a t
+ (** [remove group t] removes group from the subscription set [t] *)
+
+ val length : 'a t -> int
+ (** [length t] returns the number of groups in the subscription set. *)
+
+ val is_empty : 'a t -> bool
+ (** [is_empty t] returns true if the subscription set is empty. *)
+
+ val mem : gid -> 'a t -> bool
+ (** [mem gid t] returns true if [gid] is in the subscription set. *)
+
+ val find : gid -> 'a t -> (group * 'a) option
+ (** [find gid t] returns [Some group] if [gid] is in the subscription set,
+ otherwise [None]. *)
+
+ val filter : (gid -> (group * 'a) -> bool) -> 'a t -> 'a t
+ val fold : (gid -> (group * 'a) -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ val iter : (gid -> (group * 'a) -> unit) -> 'a t -> unit
+ val map : (gid -> (group * 'a) -> (group * 'a)) -> 'a t -> 'a t
+
+ val to_list : 'a t -> (group * 'a) list
+ (** [to_list t] returns the subscription set as list ordered by group ID. *)
+end
+
+(** Publish-subscribe message dissemination *)
+module type PUBSUB = sig
+ type nid
+ type node
+ type view
+ type mid
+ type gid
+ type group
+
+ module Pub : sig
+ include GOSSIP_DISSEM
+ with type nid := nid
+ and type node := node
+ and type view := view
+ and type mid := mid
+ end
+
+ module Sub : sig
+ include SUBSCRIPTION
+ with type gid := gid
+ and type group := group
+ end
+end
diff --git a/lib/p2p/view.ml b/lib/p2p/view.ml
new file mode 100644
index 0000000..6b297fb
--- /dev/null
+++ b/lib/p2p/view.ml
@@ -0,0 +1,157 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+(** View *)
+
+module Rng = Nocrypto.Rng
+
+module Make
+ (Node_id: S.NODE_ID)
+ (Node : S.NODE with type nid := Node_id.t)
+ : S.VIEW with type nid := Node_id.t
+ and type node := Node.t = struct
+
+ module I = struct
+ type t = int
+ let compare (a: int) b = compare a b
+ end
+
+ module IntSet = Set.Make(I)
+
+ module View = Map.Make(Node_id)
+
+ type t = Node.t View.t
+
+ let empty = View.empty
+
+ let add node t =
+ let nid = Node.id node in
+ View.add nid node t
+
+ let remove = View.remove
+
+ let length = View.cardinal
+ let is_empty = View.is_empty
+
+ let zero_age t =
+ View.map
+ (fun node -> Node.zero_age node)
+ t
+
+ let incr_age t =
+ View.map
+ (fun node -> Node.incr_age node)
+ t
+
+ (** get oldest node from [view],
+ in case there are multiple oldest nodes pick a random one
+
+ returns [Some (nid, node)] or [None] if [view] is empty *)
+ let oldest t =
+ match
+ View.fold
+ (fun nid node oldest ->
+ match oldest with
+ | None ->
+ Some (nid, node, 1)
+ | Some (_onid, onode, _n) when (Node.age onode) < (Node.age node) ->
+ Some (nid, node, 1)
+ | Some (onid, onode, n) when (Node.age onode) = (Node.age node) ->
+ let n = n + 1 in
+ let max = 1000 in
+ if float_of_int (Rng.Int.gen max) /. float_of_int max
+ < 1. /. float_of_int n
+ then Some (nid, node, n)
+ else Some (onid, onode, n)
+ | _ -> oldest)
+ t None
+ with
+ | Some (_nid, node, _n) -> Some node
+ | None -> None
+
+ let mem = View.mem
+ let find = View.find_opt
+
+ (** get a random node from [view] *)
+ let random t =
+ let len = length t in
+ if 0 < len then
+ let r = Rng.Int.gen len in
+ let (rnode, _) =
+ View.fold
+ (fun _nid node a ->
+ let (rnode, n) = a in
+ if (n = r)
+ then (Some node, n + 1)
+ else (rnode, n + 1))
+ t
+ (None, 0)
+ in
+ rnode
+ else
+ None
+
+ (** return [len] random nodes from [view] *)
+ let random_subset len t =
+ if len < length t then
+ begin
+ let rset =
+ let rec add_rnd rset =
+ if IntSet.cardinal rset < len
+ then add_rnd @@ IntSet.add (Rng.Int.gen len) rset
+ else rset
+ in
+ add_rnd IntSet.empty in
+ let (rview, _) =
+ View.fold
+ (fun _nid node a ->
+ let (rview, n) = a in
+ if IntSet.mem n rset
+ then (add node rview, n + 1)
+ else (rview, n + 1))
+ t
+ (empty, 0) in
+ rview
+ end
+ else t
+
+ let union t1 t2 =
+ View.union
+ (fun _nid node1 node2 ->
+ if (Node.ver node1) < (Node.ver node2)
+ then Some node2
+ else Some node1)
+ t1 t2
+
+ let filter = View.filter
+ let fold = View.fold
+ let iter = View.iter
+ let map = View.mapi
+
+ let to_list t =
+ List.map
+ (fun (_nid, node) -> node)
+ (View.bindings t)
+
+ let of_list l =
+ List.fold_left
+ (fun t node ->
+ add node t)
+ empty l
+
+ let pp ppf t =
+ View.iter (fun _nid node -> Fmt.pf ppf " - %a\n" Node.pp node) t
+end
diff --git a/p2p-cyclon-lwt.opam b/p2p-cyclon-lwt.opam
new file mode 100644
index 0000000..0792354
--- /dev/null
+++ b/p2p-cyclon-lwt.opam
@@ -0,0 +1,27 @@
+opam-version: "2.0"
+name: "p2p-cyclon-lwt"
+synopsis: "CYCLON: Lwt threads running the protocol"
+maintainer: "TG x Thoth <*@tg-x.net>"
+authors: ["TG x Thoth <*@tg-x.net>"]
+tags: [ "p2p" "protocol" "membership" "gossip" ]
+license: "AGPL-3.0-only"
+homepage: "https://p2pcollab.net"
+doc: "https://p2pcollab.net/doc/ocaml/cyclon-lwt"
+dev-repo: "git+https://github.com/p2pcollab/ocaml-p2p.git"
+bug-reports: "https://github.com/p2pcollab/ocaml-p2p/issues"
+depends:
+[
+ "dune" {build & >= "1.0.0"}
+ "lwt"
+ "lwt_ppx"
+ "p2p-cyclon"
+ "urps" {with-test}
+ "ounit" {with-test}
+]
+build: [
+ ["dune" "subst"] {pinned}
+ ["dune" "build" "-p" name "-j" jobs]
+]
+run-test: [
+ ["dune" "runtest" "-p" name "-j" jobs]
+]
diff --git a/p2p-cyclon.opam b/p2p-cyclon.opam
new file mode 100644
index 0000000..d3395bc
--- /dev/null
+++ b/p2p-cyclon.opam
@@ -0,0 +1,23 @@
+opam-version: "2.0"
+name: "p2p-cyclon"
+synopsis: "CYCLON: Inexpensive Membership Management for Unstructured P2P Overlays"
+maintainer: "TG x Thoth <*@tg-x.net>"
+authors: ["TG x Thoth <*@tg-x.net>"]
+tags: [ "p2p" "protocol" "membership" "gossip" "cyclon" ]
+license: "AGPL-3.0-only"
+homepage: "https://p2pcollab.net"
+doc: "https://p2pcollab.net/doc/ocaml/cyclon"
+dev-repo: "git+https://github.com/p2pcollab/ocaml-p2p.git"
+bug-reports: "https://github.com/p2pcollab/ocaml-p2p/issues"
+depends:
+[
+ "dune" {build & >= "1.0.0"}
+ "ounit" {with-test}
+]
+build: [
+ ["dune" "subst"] {pinned}
+ ["dune" "build" "-p" name "-j" jobs]
+]
+run-test: [
+ ["dune" "runtest" "-p" name "-j" jobs]
+]
diff --git a/p2p-poldercast-lwt.opam b/p2p-poldercast-lwt.opam
new file mode 100644
index 0000000..5ab5e20
--- /dev/null
+++ b/p2p-poldercast-lwt.opam
@@ -0,0 +1,26 @@
+opam-version: "2.0"
+name: "poldercast-lwt"
+synopsis: "RingCast: Lwt threads running the protocol"
+maintainer: "TG x Thoth <*@tg-x.net>"
+authors: ["TG x Thoth <*@tg-x.net>"]
+tags: [ "p2p" "multicast" "protocol" "ring" ]
+license: "AGPL-3.0-only"
+homepage: "https://p2pcollab.net"
+doc: "https://p2pcollab.net/doc/ocaml/poldercast-lwt"
+dev-repo: "git+https://github.com/p2pcollab/ocaml-poldercast.git"
+bug-reports: "https://github.com/p2pcollab/ocaml-poldercast/issues"
+depends:
+[
+ "dune" {build & >= "1.0.0"}
+ "poldercast"
+ "lwt"
+ "lwt_ppx"
+ "ounit" {with-test}
+]
+build: [
+ ["dune" "subst"] {pinned}
+ ["dune" "build" "-p" name "-j" jobs]
+]
+run-test: [
+ ["dune" "runtest" "-p" name "-j" jobs]
+]
diff --git a/p2p-poldercast.opam b/p2p-poldercast.opam
new file mode 100644
index 0000000..d58de23
--- /dev/null
+++ b/p2p-poldercast.opam
@@ -0,0 +1,24 @@
+opam-version: "2.0"
+name: "p2p-poldercast"
+synopsis: "PolderCast: P2P hybrid (probabilistic/deterministic) dissemination"
+maintainer: "TG x Thoth <*@tg-x.net>"
+authors: ["TG x Thoth <*@tg-x.net>"]
+tags: [ "p2p" "multicast" "protocol" "ring" ]
+license: "AGPL-3.0-only"
+homepage: "https://p2pcollab.net"
+doc: "https://p2pcollab.net/doc/ocaml/poldercast"
+dev-repo: "git+https://github.com/p2pcollab/ocaml-p2p.git"
+bug-reports: "https://github.com/p2pcollab/ocaml-p2p/issues"
+depends:
+[
+ "dune" {build & >= "1.0.0"}
+ "ounit" {with-test}
+ "psq"
+]
+build: [
+ ["dune" "subst"] {pinned}
+ ["dune" "build" "-p" name "-j" jobs]
+]
+run-test: [
+ ["dune" "runtest" "-p" name "-j" jobs]
+]
diff --git a/p2p-ringcast-lwt.opam b/p2p-ringcast-lwt.opam
new file mode 100644
index 0000000..1672bc9
--- /dev/null
+++ b/p2p-ringcast-lwt.opam
@@ -0,0 +1,26 @@
+opam-version: "2.0"
+name: "ringcast-lwt"
+synopsis: "RingCast: Lwt threads running the protocol"
+maintainer: "TG x Thoth <*@tg-x.net>"
+authors: ["TG x Thoth <*@tg-x.net>"]
+tags: [ "p2p" "multicast" "protocol" "ring" ]
+license: "AGPL-3.0-only"
+homepage: "https://p2pcollab.net"
+doc: "https://p2pcollab.net/doc/ocaml/ringcast-lwt"
+dev-repo: "git+https://github.com/p2pcollab/ocaml-p2p.git"
+bug-reports: "https://github.com/p2pcollab/ocaml-p2p/issues"
+depends:
+[
+ "dune" {build & >= "1.0.0"}
+ "ringcast"
+ "lwt"
+ "lwt_ppx"
+ "ounit" {with-test}
+]
+build: [
+ ["dune" "subst"] {pinned}
+ ["dune" "build" "-p" name "-j" jobs]
+]
+run-test: [
+ ["dune" "runtest" "-p" name "-j" jobs]
+]
diff --git a/p2p-ringcast.opam b/p2p-ringcast.opam
new file mode 100644
index 0000000..7954ac4
--- /dev/null
+++ b/p2p-ringcast.opam
@@ -0,0 +1,25 @@
+opam-version: "2.0"
+name: "p2p-ringcast"
+synopsis: "RingCast: P2P hybrid (probabilistic/deterministic) dissemination"
+maintainer: "TG x Thoth <*@tg-x.net>"
+authors: ["TG x Thoth <*@tg-x.net>"]
+tags: [ "p2p" "multicast" "protocol" "ring" ]
+license: "AGPL-3.0-only"
+homepage: "https://p2pcollab.net"
+doc: "https://p2pcollab.net/doc/ocaml/ringcast"
+dev-repo: "git+https://github.com/p2pcollab/ocaml-p2p.git"
+bug-reports: "https://github.com/p2pcollab/ocaml-p2p/issues"
+depends:
+[
+ "dune" {build & >= "1.0.0"}
+ "ounit" {with-test}
+ "p2p"
+ "lru"
+]
+build: [
+ ["dune" "subst"] {pinned}
+ ["dune" "build" "-p" name "-j" jobs]
+]
+run-test: [
+ ["dune" "runtest" "-p" name "-j" jobs]
+]
diff --git a/p2p-vicinity-lwt.opam b/p2p-vicinity-lwt.opam
new file mode 100644
index 0000000..abe2bc6
--- /dev/null
+++ b/p2p-vicinity-lwt.opam
@@ -0,0 +1,26 @@
+opam-version: "2.0"
+name: "p2p-vicinity-lwt"
+synopsis: "VICINITY: Lwt threads running the protocol"
+maintainer: "TG x Thoth <*@tg-x.net>"
+authors: ["TG x Thoth <*@tg-x.net>"]
+tags: [ "p2p" "overlay" "topology" "management" "clustering" "protocol" ]
+license: "AGPL-3.0-only"
+homepage: "https://p2pcollab.net"
+doc: "https://p2pcollab.net/doc/ocaml/vicinity-lwt"
+dev-repo: "git+https://github.com/p2pcollab/ocaml-p2p.git"
+bug-reports: "https://github.com/p2pcollab/ocaml-p2p/issues"
+depends:
+[
+ "dune" {build & >= "1.0.0"}
+ "p2p-vicinity"
+ "lwt"
+ "lwt_ppx"
+ "ounit" {with-test}
+]
+build: [
+ ["dune" "subst"] {pinned}
+ ["dune" "build" "-p" name "-j" jobs]
+]
+run-test: [
+ ["dune" "runtest" "-p" name "-j" jobs]
+]
diff --git a/p2p-vicinity.opam b/p2p-vicinity.opam
new file mode 100644
index 0000000..3c53273
--- /dev/null
+++ b/p2p-vicinity.opam
@@ -0,0 +1,23 @@
+opam-version: "2.0"
+name: "p2p-vicinity"
+synopsis: "VICINITY: P2P topology management & clustering protocol"
+maintainer: "TG x Thoth <*@tg-x.net>"
+authors: ["TG x Thoth <*@tg-x.net>"]
+tags: [ "p2p" "overlay" "topology" "management" "clustering" "protocol" ]
+license: "AGPL-3.0-only"
+homepage: "https://p2pcollab.net"
+doc: "https://p2pcollab.net/doc/ocaml/vicinity"
+dev-repo: "git+https://github.com/p2pcollab/ocaml-p2p.git"
+bug-reports: "https://github.com/p2pcollab/ocaml-p2p/issues"
+depends:
+[
+ "dune" {build & >= "1.0.0"}
+ "ounit" {with-test}
+]
+build: [
+ ["dune" "subst"] {pinned}
+ ["dune" "build" "-p" name "-j" jobs]
+]
+run-test: [
+ ["dune" "runtest" "-p" name "-j" jobs]
+]
diff --git a/p2p.opam b/p2p.opam
new file mode 100644
index 0000000..6df5ed1
--- /dev/null
+++ b/p2p.opam
@@ -0,0 +1,27 @@
+opam-version: "2.0"
+name: "p2p"
+synopsis: "Composable P2P network construction libraries"
+maintainer: "TG x Thoth <*@tg-x.net>"
+authors: ["TG x Thoth <*@tg-x.net>"]
+tags: [ "p2p" "protocol" ]
+license: "AGPL-3.0-only"
+homepage: "https://p2pcollab.net"
+doc: "https://p2pcollab.net/doc/ocaml/p2p"
+dev-repo: "git+https://github.com/p2pcollab/ocaml-p2p.git"
+bug-reports: "https://github.com/p2pcollab/ocaml-p2p/issues"
+depends:
+[
+ "dune" {build & >= "1.0.0"}
+ "ounit" {with-test}
+ "fmt"
+ "fsq"
+ "nocrypto"
+ "stdint"
+]
+build: [
+ ["dune" "subst"] {pinned}
+ ["dune" "build" "-p" name "-j" jobs]
+]
+run-test: [
+ ["dune" "runtest" "-p" name "-j" jobs]
+]
diff --git a/test/p2p-cyclon-lwt/dune b/test/p2p-cyclon-lwt/dune
new file mode 100644
index 0000000..5b37c29
--- /dev/null
+++ b/test/p2p-cyclon-lwt/dune
@@ -0,0 +1,15 @@
+(tests
+ (names test_cyclon_lwt)
+ (package p2p-cyclon-lwt)
+ (libraries
+ p2p-cyclon
+ p2p-cyclon-lwt
+ urps
+ lwt
+ oUnit
+ nocrypto.lwt
+ )
+ (preprocess
+ (pps lwt_ppx)
+ )
+)
diff --git a/test/p2p-cyclon-lwt/test_cyclon_lwt.ml b/test/p2p-cyclon-lwt/test_cyclon_lwt.ml
new file mode 100644
index 0000000..3c47e51
--- /dev/null
+++ b/test/p2p-cyclon-lwt/test_cyclon_lwt.ml
@@ -0,0 +1,146 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+open Stdint
+
+let u64 = Uint64.of_int64
+let pf = Fmt.pf
+let out = Fmt.stdout
+
+module Node_id = P2p.Node_id
+module Node = P2p.Node.Make (Node_id)
+module View = P2p.View.Make (Node_id) (Node)
+module Cyclon = P2p_cyclon.Make (Node_id) (Node) (View)
+module Sampler = Urps.Sampler.Make (Node_id)
+
+module Io = struct
+
+ type t = {
+ node_id: Node_id.t;
+ sampler : Node.t Sampler.t;
+ in_chan : Lwt_io.input_channel;
+ out_chan : Lwt_io.output_channel;
+ }
+
+ let init node_id in_chan out_chan =
+ let c = 700 in
+ let s = 10 in
+ let k = 50 in
+ let sampler = Sampler.init c s k in
+ { node_id; sampler; in_chan; out_chan }
+
+ (** [initiate_gossip t node xchg]
+ sends [xchg] entries to node [dst]
+ and returns response *)
+ let initiate_gossip t dst xchg =
+ pf out "%a # INITIATE_GOSSIP to node %a\n" Node_id.pp t.node_id Node.pp dst;
+ pf out "xchg to send:\n%a\n" View.pp xchg; flush stdout;
+ flush stdout;
+ let%lwt _ = Lwt_io.write_value t.out_chan xchg in
+ Lwt_io.read_value t.in_chan
+
+ (** [respond_gossip t node xchg]
+ sends [xchg] entries in response to node [dst] *)
+ let respond_gossip t dst xchg =
+ pf out "%a # RESPOND_GOSSIP to node %a\n" Node_id.pp t.node_id Node.pp dst;
+ pf out "xchg to send:\n%a\n" View.pp xchg;
+ flush stdout;
+ let%lwt _ = Lwt_io.write_value t.out_chan xchg in
+ Lwt.return_unit
+
+ (** [gossip_recvd t view src recvd]
+ is called after entries are received from node [src] during a gossip exchange;
+ allows rewriting [recvd] entries with the returned value,
+ thus allows using a stream sampler such as URPS
+ to provide uniformly random nodes instead of the possibly biased exchanged nodes *)
+ let gossip_recvd t src recvd _view =
+ let sampled =
+ View.fold (fun nid node sampled ->
+ let (_id, n) = Sampler.add t.sampler nid node in
+ View.add n sampled)
+ recvd
+ View.empty in
+ pf out "%a # GOSSIP_RECVD from node %a\n" Node_id.pp t.node_id Node.pp src;
+ pf out "recvd:\n%a\n" View.pp recvd;
+ pf out "sampled:\n%a\n" View.pp sampled;
+ flush stdout;
+ Lwt.return sampled
+
+ (** [view_updated node view]
+ is called when [view] has been updated after a gossip exchange *)
+ let view_updated t node view =
+ pf out "%a # VIEW_UPDATED of node %a\n%a\n" Node_id.pp t.node_id Node.pp node View.pp view;
+ flush stdout;
+ Lwt.return_unit
+end
+
+module Cyclon_lwt = P2p_cyclon_lwt.Make (Node_id) (Node) (View) (Cyclon) (Io)
+
+let rec read_chan ch cy node rnode =
+ let%lwt recvd = Lwt_io.read_value ch in
+ pf out "%a # READ_CHAN\n" Node_id.pp (Node.id node);
+ pf out "recvd:\n%a\n" View.pp recvd;
+ flush stdout;
+ let%lwt view = Cyclon_lwt.respond cy rnode recvd in
+ pf out "recvd:\n%a\n" View.pp recvd;
+ pf out "view:\n%a\n" View.pp view;
+ flush stdout;
+ read_chan ch cy node rnode
+
+let _ = Nocrypto_entropy_lwt.initialize ()
+
+let () =
+ let view_len = 8 in
+ let xchg_len = 4 in
+ let period = 1.0 in
+
+ let (in_ch1, out_ch2) = Lwt_io.pipe () in
+ let (in_ch2, out_ch1) = Lwt_io.pipe () in
+
+ let node1 = Node.init (u64 100L) in
+ let io1 = Io.init (Node.id node1) in_ch1 out_ch1 in
+ let view1 =
+ View.add (Node.init (u64 110L))
+ (View.add (Node.init (u64 120L))
+ (View.add (Node.init (u64 130L))
+ (View.add (Node.init (u64 140L))
+ (View.add (Node.init (u64 150L))
+ (View.add (Node.init (u64 160L))
+ (View.add (Node.init (u64 170L))
+ View.empty)))))) in
+ let cyclon1 = Cyclon_lwt.init ~me:node1 ~view:view1 ~view_len ~xchg_len ~period ~io:io1 in
+
+ let node2 = Node.init (u64 200L) in
+ let io2 = Io.init (Node.id node2) in_ch2 out_ch2 in
+ let view2 =
+ View.add (Node.init (u64 210L))
+ (View.add (Node.init (u64 220L))
+ (View.add (Node.init (u64 230L))
+ (View.add (Node.init (u64 240L))
+ (View.add (Node.init (u64 250L))
+ (View.add (Node.init (u64 260L))
+ (View.add (Node.init (u64 270L))
+ View.empty)))))) in
+ let cyclon2 = Cyclon_lwt.init ~me:node2 ~view:view2 ~view_len ~xchg_len ~period ~io:io2 in
+
+ let timeout = Lwt_unix.sleep 5.5 in
+ Lwt_main.run @@
+ Lwt.choose [ Cyclon_lwt.run cyclon1;
+ Cyclon_lwt.run cyclon2;
+ read_chan in_ch1 cyclon1 node1 node2;
+ read_chan in_ch2 cyclon2 node2 node1;
+ Lwt.map (fun () -> Cyclon_lwt.shutdown cyclon1;
+ Cyclon_lwt.shutdown cyclon2) timeout ]
diff --git a/test/p2p-cyclon/dune b/test/p2p-cyclon/dune
new file mode 100644
index 0000000..0ca1a84
--- /dev/null
+++ b/test/p2p-cyclon/dune
@@ -0,0 +1,9 @@
+(test
+ (name test_cyclon)
+ (package p2p-cyclon)
+ (libraries
+ p2p-cyclon
+ oUnit
+ nocrypto.unix
+ )
+)
diff --git a/test/p2p-cyclon/test_cyclon.ml b/test/p2p-cyclon/test_cyclon.ml
new file mode 100644
index 0000000..bb8cc5d
--- /dev/null
+++ b/test/p2p-cyclon/test_cyclon.ml
@@ -0,0 +1,80 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+open OUnit2
+open Printf
+open Stdint
+
+module Node_id = P2p.Node_id
+module Node = P2p.Node.Make (Node_id)
+module View = P2p.View.Make (Node_id) (Node)
+module Cyclon = P2p_cyclon.Make (Node_id) (Node) (View)
+
+let u64 = Uint64.of_int64
+let pf = Fmt.pf
+let out = Fmt.stdout
+
+let view_len = 7
+let xchg_len = 3
+let me = Node.init (u64 99L)
+
+let my_view =
+ View.add (Node.init (u64 1L))
+ (View.add (Node.init (u64 2L))
+ (View.add (Node.init (u64 3L))
+ (View.add (Node.init (u64 4L))
+ (View.add (Node.init (u64 5L))
+ (View.add (Node.init (u64 6L))
+ (View.add (Node.init (u64 7L))
+ View.empty))))))
+
+let my_recvd =
+ View.add (Node.init (u64 10L))
+ (View.add (Node.init (u64 20L))
+ (View.add (Node.init (u64 3L))
+ View.empty))
+
+let test_gossip _ctx =
+ printf "\nCYCLON GOSSIP\n";
+ let view = my_view in
+ let (dst, sent, view) = Cyclon.initiate ~me ~view ~xview:View.empty ~xchg_len in
+ let recvd = my_recvd in
+ let dst =
+ match dst with
+ | Some dst -> dst
+ | None -> assert_failure "No gossip target" in
+ pf out "Gossip target: %a\n" Node.pp dst;
+ pf out "Gossip sent (%d):\n%a\n" (View.length sent) View.pp sent;
+ pf out "Gossip received (%d):\n%a\n" (View.length recvd) View.pp recvd;
+ assert_equal (View.length sent) xchg_len;
+ pf out "View before gossip (%d):\n%a\n" (View.length view) View.pp view;
+ let view = Cyclon.merge ~me ~view ~view_len ~sent ~recvd ~xchg_len in
+ pf out "View after gossip (%d):\n%a\n" (View.length view) View.pp view;
+ assert_equal (View.length view) view_len;
+ assert_equal (View.mem (Node.id me) view) false;
+ let resp = Cyclon.respond ~view ~xview:View.empty ~recvd ~xchg_len ~src:me ~me in
+ pf out "Gossip response:\n%a\n" View.pp resp;
+ assert_equal (View.length resp) xchg_len
+
+let suite =
+ "suite">:::
+ [
+ "gossip">:: test_gossip;
+ ]
+
+let () =
+ Nocrypto_entropy_unix.initialize ();
+ run_test_tt_main suite
diff --git a/test/p2p-poldercast-lwt/dune b/test/p2p-poldercast-lwt/dune
new file mode 100644
index 0000000..ffbe706
--- /dev/null
+++ b/test/p2p-poldercast-lwt/dune
@@ -0,0 +1,16 @@
+(tests
+ (names test_poldercast_lwt)
+ (package p2p-poldercast-lwt)
+ (libraries
+ p2p-ringcast
+ p2p-ringcast-lwt
+ p2p-poldercast
+ p2p-poldercast-lwt
+ lwt
+ oUnit
+ nocrypto.lwt
+ )
+ (preprocess
+ (pps lwt_ppx)
+ )
+)
diff --git a/test/p2p-poldercast-lwt/test_poldercast_lwt.ml b/test/p2p-poldercast-lwt/test_poldercast_lwt.ml
new file mode 100644
index 0000000..9b490b3
--- /dev/null
+++ b/test/p2p-poldercast-lwt/test_poldercast_lwt.ml
@@ -0,0 +1,202 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+open OUnit2
+open Stdint
+
+module Node_id = P2p.Node_id
+module Group_id = P2p.Group_id
+module Node = P2p_poldercast.Node.Make (Node_id)
+module Group = P2p.Group.Make (Group_id)
+module View = P2p.View.Make (Node_id) (Node)
+module Msg_id = P2p.Msg_id
+module Ringcast = P2p_ringcast.Make (Node_id) (Node) (View) (Msg_id)
+module Poldercast = P2p_poldercast.Make (Node_id) (Group_id) (Node) (Group)
+ (View) (Msg_id) (Ringcast)
+
+let u64 = Uint64.of_int64
+let pf = Fmt.pf
+let out = Fmt.stdout
+let sent_msgs = Hashtbl.create 3
+
+(** union of views *)
+module UView = struct
+
+ type t = {
+ rings : (Group_id.t, View.t) Hashtbl.t;
+ }
+
+ let create =
+ { rings = Hashtbl.create 10 }
+
+ let set_ring t gid view =
+ Hashtbl.replace t.rings gid view
+
+ let view t =
+ Hashtbl.fold
+ (fun _gid view uview ->
+ View.union uview view)
+ t.rings View.empty
+
+end
+
+module Io = struct
+
+ module IoMap = Map.Make (Node)
+
+ type t = {
+ group : Group.t;
+ me : Node.t;
+ uview : UView.t;
+ io : (Lwt_io.input_channel * Lwt_io.output_channel) IoMap.t;
+ }
+
+ let init me uview =
+ (fun group ->
+ { group; me; uview; io = IoMap.empty })
+
+ let get_chan t dst =
+ match IoMap.find_opt dst t.io with
+ | None ->
+ let (in_chan, out_chan) = Lwt_io.pipe () in
+ (in_chan, out_chan)
+ | Some (in_chan, out_chan) ->
+ (in_chan, out_chan)
+
+ let recv_gossip t group src xchg =
+ let (_in_chan, out_chan) = get_chan t src in
+ Lwt_io.write_value out_chan (group, xchg)
+
+ let recv_msg t group src msg =
+ let (_in_chan, out_chan) = get_chan t src in
+ Lwt_io.write_value out_chan (group, msg)
+
+ (** [initiate_gossip t node xchg]
+ sends [xchg] entries to node [dst]
+ and returns response *)
+ let initiate_gossip t dst xchg =
+ pf out "%a/%a # INITIATE_GOSSIP to node %a\n"
+ Group.pp t.group
+ Node.pp t.me
+ Node.pp dst;
+ pf out "xchg to send:\n%a\n" View.pp xchg;
+ flush stdout;
+ let (in_chan, out_chan) = get_chan t dst in
+ let%lwt _ = Lwt_io.write_value out_chan (t.group, xchg) in
+ let%lwt (rgroup, rxchg) = Lwt_io.read_value in_chan in
+ assert_equal t.group rgroup;
+ Lwt.return rxchg
+
+ (** [respond_gossip t node xchg]
+ sends [xchg] entries in response to node [dst] *)
+ let respond_gossip t dst xchg =
+ pf out "%a/%a # RESPOND_GOSSIP to node %a\n"
+ Group.pp t.group
+ Node.pp t.me
+ Node.pp dst;
+ pf out "xchg to send:\n%a\n" View.pp xchg;
+ flush stdout;
+ let (_in_chan, out_chan) = get_chan t dst in
+ let%lwt _ = Lwt_io.write_value out_chan (t.group, xchg) in
+ Lwt.return_unit
+
+ (** [gossip_recvd t node view recvd]
+ is called after entries are received during a gossip exchange;
+ allows rewriting [recvd] entries with the returned value. *)
+ let gossip_recvd _t _src recvd _view =
+ Lwt.return recvd
+
+ (** [view_updated node view]
+ is called when [view] has been updated after a gossip exchange *)
+ let view_updated t node view =
+ pf out "%a/%a # VIEW_UPDATED of node %a\n%a\n"
+ Group.pp t.group
+ Node.pp t.me
+ Node.pp node
+ View.pp view;
+ flush stdout;
+ UView.set_ring t.uview (Group.id t.group) view;
+ Lwt.return_unit
+
+ let send_msg t dst mid msg =
+ pf out "%a/%a # SEND_MSG %a to node %a%s\n"
+ Group.pp t.group
+ Node.pp t.me
+ Msg_id.pp mid
+ Node.pp dst
+ (Cstruct.to_string msg);
+ flush stdout;
+ let n =
+ match Hashtbl.find_opt sent_msgs mid with
+ | Some n -> n
+ | None -> 0 in
+ Hashtbl.add sent_msgs mid (n + 1);
+ Lwt.return_unit
+
+ let get_xview t =
+ UView.view t.uview
+end
+
+module Ringcast_lwt =
+ P2p_ringcast_lwt.Make (Node_id) (Node) (View) (Msg_id) (Ringcast) (Io)
+
+module Poldercast_lwt =
+ P2p_poldercast_lwt.Make (Node_id) (Group_id) (Node) (Group) (View) (Msg_id)
+ (Ringcast) (Io) (Ringcast_lwt) (Poldercast)
+
+let _ = Nocrypto_entropy_lwt.initialize ()
+
+let () =
+ let view_len = 8 in
+ let xchg_len = 4 in
+ let period = 1.0 in
+ let fanout = 5 in
+ let seen_len = 10 in
+
+ let me = Node.init (u64 100L) in
+
+ let group1 = Group.init (u64 1000L) in
+ let view1 =
+ View.add (Node.init (u64 110L))
+ (View.add (Node.init (u64 120L))
+ (View.add (Node.init (u64 130L))
+ (View.add (Node.init (u64 140L))
+ (View.add (Node.init (u64 150L))
+ (View.add (Node.init (u64 160L))
+ (View.add (Node.init (u64 170L))
+ View.empty)))))) in
+
+ let group2 = Group.init (u64 2000L) in
+ let view2 =
+ View.add (Node.init (u64 210L))
+ (View.add (Node.init (u64 220L))
+ (View.add (Node.init (u64 230L))
+ (View.add (Node.init (u64 240L))
+ (View.add (Node.init (u64 250L))
+ (View.add (Node.init (u64 260L))
+ (View.add (Node.init (u64 270L))
+ View.empty)))))) in
+
+ let io = Io.init me UView.create in
+ let sub_list = [ (group1, view1); (group2, view2) ] in
+ let pc = Poldercast_lwt.init ~me ~view_len ~xchg_len
+ ~period ~fanout ~seen_len ~sub_list ~io
+ ?max_subs:None ?stop:None in
+
+ let timeout = Lwt_unix.sleep 5.5 in
+ Lwt_main.run @@
+ Lwt.choose [ Poldercast_lwt.run pc;
+ Lwt.map (fun () -> Poldercast_lwt.shutdown pc) timeout ];
diff --git a/test/p2p-poldercast/dune b/test/p2p-poldercast/dune
new file mode 100644
index 0000000..26531ea
--- /dev/null
+++ b/test/p2p-poldercast/dune
@@ -0,0 +1,11 @@
+(test
+ (name test_poldercast)
+ (package p2p-poldercast)
+ (libraries
+ p2p-ringcast
+ p2p-poldercast
+ oUnit
+ nocrypto.unix
+ bitv
+ )
+)
diff --git a/test/p2p-poldercast/test_poldercast.ml b/test/p2p-poldercast/test_poldercast.ml
new file mode 100644
index 0000000..7356252
--- /dev/null
+++ b/test/p2p-poldercast/test_poldercast.ml
@@ -0,0 +1,80 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+open OUnit2
+open Printf
+open Stdint
+
+module Node_id = P2p.Node_id
+module Group_id = P2p.Group_id
+module Msg_id = P2p.Msg_id
+
+module Node = P2p_poldercast.Node.Make (Node_id)
+module Group = P2p.Group.Make (Group_id)
+module View = P2p.View.Make (Node_id) (Node)
+
+module Ringcast = P2p_ringcast.Make (Node_id) (Node) (View) (Msg_id)
+
+module Poldercast = P2p_poldercast.Make (Node_id) (Group_id) (Node) (Group) (View) (Msg_id) (Ringcast)
+module Pub = Poldercast.Pub
+module Sub = Poldercast.Sub
+
+let u64 = Uint64.of_int64
+let pf = Fmt.pf
+let out = Fmt.stdout
+let e = 10.
+
+let test_sub _ctx =
+ printf "\nPOLDERCAST SUB\n";
+ let sub = Sub.add (Group.init (u64 11L)) ()
+ (Sub.add (Group.init (u64 23L)) ()
+ (Sub.add (Group.init (u64 37L)) ()
+ (Sub.add (Group.init (u64 41L)) ()
+ (Sub.empty)))) in
+ let n23 = Node.init (u64 23L) in
+ let _bits = Sub.bloom sub in
+ let blip = Sub.blip sub e in
+ let n23 = Node.set_subs n23 blip in
+ printf "n23:\n%s" (Node.to_string n23);
+
+ let n42 = Node.init (u64 42L) in
+ let _bits = Sub.bloom sub in
+ let blip = Sub.blip sub e in
+ let n42 = Node.set_subs n42 blip in
+ printf "n42:\n%s" (Node.to_string n42);
+
+ let sim = Node.sim n23 n23 in
+ assert_equal sim 1.;
+ let sim = Node.sim n23 n42 in
+ printf "sim n23 n42 = %.2f\n" sim;
+
+ let g41 = (u64 41L) in
+ assert_equal (Sub.mem g41 sub) true;
+ assert_equal (Sub.length sub) 4;
+
+ let sub = Sub.remove g41 sub in
+ assert_equal (Sub.mem g41 sub) false;
+ assert_equal (Sub.length sub) 3
+
+let suite =
+ "suite">:::
+ [
+ "sub">:: test_sub;
+ ]
+
+let () =
+ Nocrypto_entropy_unix.initialize ();
+ run_test_tt_main suite
diff --git a/test/p2p-ringcast-lwt/dune b/test/p2p-ringcast-lwt/dune
new file mode 100644
index 0000000..6e52111
--- /dev/null
+++ b/test/p2p-ringcast-lwt/dune
@@ -0,0 +1,14 @@
+(tests
+ (names test_ringcast_lwt)
+ (package p2p-ringcast-lwt)
+ (libraries
+ p2p-ringcast
+ p2p-ringcast-lwt
+ lwt
+ oUnit
+ nocrypto.lwt
+ )
+ (preprocess
+ (pps lwt_ppx)
+ )
+)
diff --git a/test/p2p-ringcast-lwt/test_ringcast_lwt.ml b/test/p2p-ringcast-lwt/test_ringcast_lwt.ml
new file mode 100644
index 0000000..99920ed
--- /dev/null
+++ b/test/p2p-ringcast-lwt/test_ringcast_lwt.ml
@@ -0,0 +1,182 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+open Stdint
+open OUnit2
+
+let u64 = Uint64.of_int64
+let pf = Fmt.pf
+let out = Fmt.stdout
+let sent_msgs = Hashtbl.create 3
+
+module Node_id = P2p.Node_id
+module Node = P2p.Node.Make (Node_id)
+module View = P2p.View.Make (Node_id) (Node)
+module Msg_id = P2p.Msg_id
+module Ringcast = P2p_ringcast.Make (Node_id) (Node) (View) (Msg_id)
+
+module Io = struct
+
+ type t = {
+ node_id: Node_id.t;
+ in_chan : Lwt_io.input_channel;
+ out_chan : Lwt_io.output_channel;
+ }
+
+ let init node_id in_chan out_chan =
+ { node_id; in_chan; out_chan }
+
+ (** [initiate_gossip t node xchg]
+ sends [xchg] entries to node [dst]
+ and returns response *)
+ let initiate_gossip t dst xchg =
+ pf out "%a # INITIATE_GOSSIP to node %a\n" Node_id.pp t.node_id Node.pp dst;
+ pf out "xchg to send:\n%a\n" View.pp xchg;
+ flush stdout;
+ let%lwt _ = Lwt_io.write_value t.out_chan xchg in
+ Lwt_io.read_value t.in_chan
+
+ (** [respond_gossip t node xchg]
+ sends [xchg] entries in response to node [dst] *)
+ let respond_gossip t dst xchg =
+ pf out "%a # RESPOND_GOSSIP to node %a\n" Node_id.pp t.node_id Node.pp dst;
+ pf out "xchg to send:\n%a\n" View.pp xchg;
+ flush stdout;
+ let%lwt _ = Lwt_io.write_value t.out_chan xchg in
+ Lwt.return_unit
+
+ (** [gossip_recvd t node view recvd]
+ is called after entries are received during a gossip exchange;
+ allows rewriting [recvd] entries with the returned value. *)
+ let gossip_recvd _t _src recvd _view =
+ Lwt.return recvd
+
+ (** [view_updated node view]
+ is called when [view] has been updated after a gossip exchange *)
+ let view_updated t node view =
+ pf out "%a # VIEW_UPDATED of node %a\n%a\n" Node_id.pp t.node_id Node.pp node View.pp view;
+ flush stdout;
+ Lwt.return_unit
+
+ let send_msg t dst mid msg =
+ pf out "%a # SEND_MSG %a to node %a%s\n"
+ Node_id.pp t.node_id
+ Msg_id.pp mid
+ Node.pp dst
+ (Cstruct.to_string msg);
+ flush stdout;
+ let n =
+ match Hashtbl.find_opt sent_msgs mid with
+ | Some n -> n
+ | None -> 0 in
+ Hashtbl.add sent_msgs mid (n + 1);
+ Lwt.return_unit
+
+ let get_xview _t =
+ View.empty
+end
+
+module Ringcast_lwt =
+ P2p_ringcast_lwt.Make (Node_id) (Node) (View) (Msg_id) (Ringcast) (Io)
+
+let rec read_chan ch rc node rnode =
+ let%lwt recvd = Lwt_io.read_value ch in
+ pf out "%a # READ_CHAN\n" Node_id.pp (Node.id node);
+ pf out "recvd:\n%a\n" View.pp recvd;
+ flush stdout;
+ let%lwt view = Ringcast_lwt.respond rc rnode recvd in
+ pf out "recvd:\n%a\n" View.pp recvd;
+ pf out "view:\n%a\n" View.pp view;
+ flush stdout;
+ read_chan ch rc node rnode
+
+let forward delay rc src msgid msg =
+ let%lwt _ = Lwt_unix.sleep delay in
+ Ringcast_lwt.forward rc src msgid (Cstruct.of_string msg)
+
+let check_sent_msgs delay =
+ let%lwt _ = Lwt_unix.sleep delay in
+ let s1, s2, s3 =
+ Hashtbl.find sent_msgs (Uint64.of_int 1),
+ Hashtbl.find sent_msgs (Uint64.of_int 2),
+ Hashtbl.find sent_msgs (Uint64.of_int 3) in
+ let%lwt _ = Lwt_io.printf "check_recvd_msgs: %d %d %d\n"
+ s1 s2 s3 in
+ assert_equal s1 3;
+ assert_equal s2 3;
+ assert_equal s3 4;
+ Lwt.return_unit
+
+let _ = Nocrypto_entropy_lwt.initialize ()
+
+let () =
+ let view_len = 8 in
+ let xchg_len = 4 in
+ let period = 1.0 in
+ let fanout = 5 in
+ let seen_len = 10 in
+
+ let (in_ch1, out_ch2) = Lwt_io.pipe () in
+ let (in_ch2, out_ch1) = Lwt_io.pipe () in
+
+ let node1 = Node.init (u64 100L) in
+ let io1 = Io.init (Node.id node1) in_ch1 out_ch1 in
+ let view1 =
+ View.add (Node.init (u64 110L))
+ (View.add (Node.init (u64 120L))
+ (View.add (Node.init (u64 130L))
+ (View.add (Node.init (u64 140L))
+ (View.add (Node.init (u64 150L))
+ (View.add (Node.init (u64 160L))
+ (View.add (Node.init (u64 170L))
+ View.empty)))))) in
+ let rc1 = Ringcast_lwt.init ~me:node1 ~view:view1 ~view_len ~xchg_len
+ ~period ~fanout ~seen_len ~io:io1 in
+
+ let node2 = Node.init (u64 200L) in
+ let io2 = Io.init (Node.id node2) in_ch2 out_ch2 in
+ let view2 =
+ View.add (Node.init (u64 210L))
+ (View.add (Node.init (u64 220L))
+ (View.add (Node.init (u64 230L))
+ (View.add (Node.init (u64 240L))
+ (View.add (Node.init (u64 250L))
+ (View.add (Node.init (u64 260L))
+ (View.add (Node.init (u64 270L))
+ View.empty)))))) in
+ let rc2 = Ringcast_lwt.init ~me:node2 ~view:view2 ~view_len ~xchg_len ~period ~fanout ~seen_len ~io:io2 in
+
+ let timeout = Lwt_unix.sleep 5.5 in
+ Lwt_main.run @@
+ Lwt.join [
+ Lwt.choose [ Ringcast_lwt.run rc1;
+ Ringcast_lwt.run rc2;
+ read_chan in_ch1 rc1 node1 node2;
+ read_chan in_ch2 rc2 node2 node1;
+ Lwt.map (fun () -> Ringcast_lwt.shutdown rc1;
+ Ringcast_lwt.shutdown rc2) timeout ];
+ forward 1.0 rc1 node1 (Uint64.of_int 1)
+ (Printf.sprintf "first message from %s" (Node.to_string node1));
+ forward 1.5 rc1 node2 (Uint64.of_int 1)
+ (Printf.sprintf "first message #2 from %s" (Node.to_string node2));
+ forward 2.0 rc1 node1 (Uint64.of_int 2)
+ (Printf.sprintf "second message from %s" (Node.to_string node1));
+ forward 3.0 rc1 node2 (Uint64.of_int 3)
+ (Printf.sprintf "third message from %s" (Node.to_string node2));
+ forward 4.0 rc1 node2 (Uint64.of_int 1)
+ (Printf.sprintf "first message #3 from %s" (Node.to_string node2));
+ check_sent_msgs 5.3
+ ]
diff --git a/test/p2p-ringcast/dune b/test/p2p-ringcast/dune
new file mode 100644
index 0000000..402a708
--- /dev/null
+++ b/test/p2p-ringcast/dune
@@ -0,0 +1,9 @@
+(test
+ (name test_ringcast)
+ (package p2p-ringcast)
+ (libraries
+ p2p-ringcast
+ oUnit
+ nocrypto.unix
+ )
+)
diff --git a/test/p2p-ringcast/test_ringcast.ml b/test/p2p-ringcast/test_ringcast.ml
new file mode 100644
index 0000000..e5bcf4a
--- /dev/null
+++ b/test/p2p-ringcast/test_ringcast.ml
@@ -0,0 +1,96 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+open OUnit2
+open Printf
+open Stdint
+
+module Node_id = P2p.Node_id
+module Node = P2p.Node.Make (Node_id)
+module View = P2p.View.Make (Node_id) (Node)
+module Msg_id = P2p.Msg_id
+module Ringcast =
+ P2p_ringcast.Make (Node_id) (Node) (View) (Msg_id)
+
+let u64 = Uint64.of_int64
+let pf = Fmt.pf
+let out = Fmt.stdout
+
+let view_len = 8
+let xchg_len = 4
+let me = Node.init (u64 16L)
+
+let my_view =
+ View.add (Node.init (u64 7L))
+ (View.add (Node.init (u64 11L))
+ (View.add (Node.init (u64 13L))
+ (View.add (Node.init (u64 17L))
+ (View.add (Node.init (u64 19L))
+ (View.add (Node.init (u64 23L))
+ (View.add (Node.init (u64 41L))
+ (View.add (Node.init (u64 49L))
+ View.empty)))))))
+
+let my_view_str =
+ View.add (Node.init (u64 5L))
+ (View.add (Node.init (u64 10L))
+ (View.add (Node.init (u64 20L))
+ (View.add (Node.init (u64 30L))
+ (View.add (Node.init (u64 40L))
+ (View.add (Node.init (u64 45L))
+ (View.add (Node.init (u64 50L))
+ (View.add (Node.init (u64 0L))
+ View.empty)))))))
+
+let my_recvd =
+ View.add (Node.init (u64 5L))
+ (View.add (Node.init (u64 10L))
+ (View.add (Node.init (u64 20L))
+ (View.add (Node.init (u64 30L))
+ View.empty)))
+
+let test_gossip _ctx =
+ printf "\nRINGCAST GOSSIP\n";
+ let view = my_view in
+ let xview = my_view_str in
+ let (dst, sent, view) = Ringcast.initiate ~me ~view ~xview ~xchg_len in
+ let recvd = my_recvd in
+ let dst =
+ match dst with
+ | Some dst -> dst
+ | None -> assert_failure "No gossip target" in
+ pf out "Gossip target: %a\n" Node.pp dst;
+ pf out "Gossip sent (%d):\n%a\n" (View.length sent) View.pp sent;
+ assert_equal (View.length sent) xchg_len;
+ pf out "Gossip received (%d):\n%a\n" (View.length recvd) View.pp recvd;
+ pf out "View before gossip (%d):\n%a\n" (View.length view) View.pp view;
+ let view = Ringcast.merge ~me ~view ~view_len ~sent ~recvd ~xchg_len in
+ pf out "View after gossip (%d):\n%a\n" (View.length view) View.pp view;
+ assert_equal (View.length view) view_len;
+ assert_equal (View.mem (Node.id me) view) false;
+ let resp = Ringcast.respond ~view ~xview ~recvd ~xchg_len ~src:me ~me in
+ pf out "Gossip response:\n%a\n" View.pp resp;
+ assert_equal (View.length resp) xchg_len
+
+let suite =
+ "suite">:::
+ [
+ "gossip">:: test_gossip;
+ ]
+
+let () =
+ Nocrypto_entropy_unix.initialize ();
+ run_test_tt_main suite
diff --git a/test/p2p-vicinity-lwt/dune b/test/p2p-vicinity-lwt/dune
new file mode 100644
index 0000000..99f667f
--- /dev/null
+++ b/test/p2p-vicinity-lwt/dune
@@ -0,0 +1,14 @@
+(tests
+ (names test_vicinity_lwt)
+ (package p2p-vicinity-lwt)
+ (libraries
+ p2p-vicinity
+ p2p-vicinity-lwt
+ lwt
+ oUnit
+ nocrypto.lwt
+ )
+ (preprocess
+ (pps lwt_ppx)
+ )
+)
diff --git a/test/p2p-vicinity-lwt/test_vicinity_lwt.ml b/test/p2p-vicinity-lwt/test_vicinity_lwt.ml
new file mode 100644
index 0000000..f4e0529
--- /dev/null
+++ b/test/p2p-vicinity-lwt/test_vicinity_lwt.ml
@@ -0,0 +1,146 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+open Stdint
+
+let u64 = Uint64.of_int64
+let pf = Fmt.pf
+let out = Fmt.stdout
+
+module Node_id = P2p.Node_id
+
+module Make_node (Node_id: P2p.S.NODE_ID)
+ : P2p_vicinity.S.NODE with type nid := Node_id.t = struct
+
+ module Node = P2p.Node.Make (Node_id)
+ include Node
+
+ (** 1 / (a - b) *)
+ let sim a b =
+ 1. /. Uint64.to_float
+ (Node_id.to_uint64
+ (Node_id.distance (Node.id a) (Node.id b)))
+end
+
+module Node = Make_node (Node_id)
+module View = P2p.View.Make (Node_id) (Node)
+module Vicinity = P2p_vicinity.Make (Node_id) (Node) (View)
+
+module Io = struct
+
+ type t = {
+ node_id: Node_id.t;
+ in_chan : Lwt_io.input_channel;
+ out_chan : Lwt_io.output_channel;
+ }
+
+ let init node_id in_chan out_chan =
+ { node_id; in_chan; out_chan }
+
+ (** [initiate_gossip t node xchg]
+ sends [xchg] entries to node [dst]
+ and returns response *)
+ let initiate_gossip t dst xchg =
+ pf out "%a # INITIATE_GOSSIP to node %a\n" Node_id.pp t.node_id Node.pp dst;
+ pf out "xchg to send:\n%a\n" View.pp xchg;
+ flush stdout;
+ let%lwt _ = Lwt_io.write_value t.out_chan xchg in
+ Lwt_io.read_value t.in_chan
+
+ (** [respond_gossip t node xchg]
+ sends [xchg] entries in response to node [dst] *)
+ let respond_gossip t dst xchg =
+ pf out "%a # RESPOND_GOSSIP to node %a\n" Node_id.pp t.node_id Node.pp dst;
+ pf out "xchg to send:\n%a\n" View.pp xchg;
+ flush stdout;
+ let%lwt _ = Lwt_io.write_value t.out_chan xchg in
+ Lwt.return_unit
+
+ (** [gossip_recvd t node view recvd]
+ is called after entries are received during a gossip exchange;
+ allows rewriting [recvd] entries with the returned value. *)
+ let gossip_recvd _t _src recvd _view =
+ Lwt.return recvd
+
+ (** [view_updated node view]
+ is called when [view] has been updated after a gossip exchange *)
+ let view_updated t node view =
+ pf out "%a # VIEW_UPDATED of node %a\n%a\n" Node_id.pp t.node_id Node.pp node View.pp view;
+ flush stdout;
+ Lwt.return_unit
+
+ let get_xview _t =
+ View.empty
+end
+
+module Vicinity_lwt =
+ P2p_vicinity_lwt.Make (Node_id) (Node) (View) (Vicinity) (Io)
+
+let rec read_chan ch vc node rnode =
+ let%lwt recvd = Lwt_io.read_value ch in
+ pf out "%a # READ_CHAN\n" Node_id.pp (Node.id node);
+ pf out "recvd:\n%a\n" View.pp recvd;
+ flush stdout;
+ let%lwt view = Vicinity_lwt.respond vc rnode recvd in
+ pf out "recvd:\n%a\n" View.pp recvd;
+ pf out "view:\n%a\n" View.pp view;
+ flush stdout;
+ read_chan ch vc node rnode
+
+let _ = Nocrypto_entropy_lwt.initialize ()
+
+let () =
+ let view_len = 8 in
+ let xchg_len = 4 in
+ let period = 1.0 in
+
+ let (in_ch1, out_ch2) = Lwt_io.pipe () in
+ let (in_ch2, out_ch1) = Lwt_io.pipe () in
+
+ let node1 = Node.init (u64 100L) in
+ let io1 = Io.init (Node.id node1) in_ch1 out_ch1 in
+ let view1 =
+ View.add (Node.init (u64 110L))
+ (View.add (Node.init (u64 120L))
+ (View.add (Node.init (u64 130L))
+ (View.add (Node.init (u64 140L))
+ (View.add (Node.init (u64 150L))
+ (View.add (Node.init (u64 160L))
+ (View.add (Node.init (u64 170L))
+ View.empty)))))) in
+ let vc1 = Vicinity_lwt.init ~me:node1 ~view:view1 ~view_len ~xchg_len ~period ~io:io1 in
+
+ let node2 = Node.init (u64 200L) in
+ let io2 = Io.init (Node.id node2) in_ch2 out_ch2 in
+ let view2 =
+ View.add (Node.init (u64 210L))
+ (View.add (Node.init (u64 220L))
+ (View.add (Node.init (u64 230L))
+ (View.add (Node.init (u64 240L))
+ (View.add (Node.init (u64 250L))
+ (View.add (Node.init (u64 260L))
+ (View.add (Node.init (u64 270L))
+ View.empty)))))) in
+ let vc2 = Vicinity_lwt.init ~me:node2 ~view:view2 ~view_len ~xchg_len ~period ~io:io2 in
+
+ let timeout = Lwt_unix.sleep 5.5 in
+ Lwt_main.run @@
+ Lwt.choose [ Vicinity_lwt.run vc1;
+ Vicinity_lwt.run vc2;
+ read_chan in_ch1 vc1 node1 node2;
+ read_chan in_ch2 vc2 node2 node1;
+ Lwt.map (fun () -> Vicinity_lwt.shutdown vc1;
+ Vicinity_lwt.shutdown vc2) timeout ]
diff --git a/test/p2p-vicinity/dune b/test/p2p-vicinity/dune
new file mode 100644
index 0000000..096e4b0
--- /dev/null
+++ b/test/p2p-vicinity/dune
@@ -0,0 +1,9 @@
+(test
+ (name test_vicinity)
+ (package p2p-vicinity)
+ (libraries
+ p2p-vicinity
+ oUnit
+ nocrypto.unix
+ )
+)
diff --git a/test/p2p-vicinity/test_vicinity.ml b/test/p2p-vicinity/test_vicinity.ml
new file mode 100644
index 0000000..c42b78a
--- /dev/null
+++ b/test/p2p-vicinity/test_vicinity.ml
@@ -0,0 +1,107 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+open OUnit2
+open Printf
+open Stdint
+
+module Node_id = P2p.Node_id
+
+module Make_node (Node_id: P2p.S.NODE_ID)
+ : P2p_vicinity.S.NODE with type nid := Node_id.t = struct
+
+ module Node = P2p.Node.Make (Node_id)
+ include Node
+
+ (** 1 / (a - b) *)
+ let sim a b =
+ 1. /. Uint64.to_float
+ (Node_id.to_uint64
+ (Node_id.distance (Node.id a) (Node.id b)))
+end
+
+module Node = Make_node (Node_id)
+module View = P2p.View.Make (Node_id) (Node)
+module Vicinity = P2p_vicinity.Make (Node_id) (Node) (View)
+
+let u64 = Uint64.of_int64
+let pf = Fmt.pf
+let out = Fmt.stdout
+
+let view_len = 7
+let xchg_len = 5
+let me = Node.init (u64 23L)
+
+let my_view =
+ View.add (Node.init (u64 7L))
+ (View.add (Node.init (u64 11L))
+ (View.add (Node.init (u64 13L))
+ (View.add (Node.init (u64 17L))
+ (View.add (Node.init (u64 19L))
+ (View.add (Node.init (u64 29L))
+ (View.add (Node.init (u64 37L))
+ View.empty))))))
+
+let my_view_rnd =
+ View.add (Node.init (u64 10L))
+ (View.add (Node.init (u64 20L))
+ (View.add (Node.init (u64 30L))
+ (View.add (Node.init (u64 40L))
+ (View.add (Node.init (u64 50L))
+ (View.add (Node.init (u64 60L))
+ (View.add (Node.init (u64 70L))
+ View.empty))))))
+
+let my_recvd =
+ View.add (Node.init (u64 10L))
+ (View.add (Node.init (u64 20L))
+ (View.add (Node.init (u64 30L))
+ (View.add (Node.init (u64 40L))
+ (View.add (Node.init (u64 50L))
+ View.empty))))
+
+let test_gossip _ctx =
+ printf "\nVICINITY GOSSIP\n";
+ let view = my_view in
+ let xview = my_view_rnd in
+ let (dst, sent, view) = Vicinity.initiate ~me ~view ~xview ~xchg_len in
+ let recvd = my_recvd in
+ let dst =
+ match dst with
+ | Some dst -> dst
+ | None -> assert_failure "No gossip target" in
+ pf out "Gossip target: %a\n" Node.pp dst;
+ pf out "Gossip sent (%d):\n%a\n" (View.length sent) View.pp sent;
+ assert_equal (View.length sent) xchg_len;
+ pf out "Gossip received (%d):\n%a\n" (View.length recvd) View.pp recvd;
+ pf out "View before gossip (%d):\n%a\n" (View.length view) View.pp view;
+ let view = Vicinity.merge ~me ~view ~view_len ~sent ~recvd ~xchg_len in
+ pf out "View after gossip (%d):\n%a\n" (View.length view) View.pp view;
+ assert_equal (View.length view) view_len;
+ assert_equal (View.mem (Node.id me) view) false;
+ let resp = Vicinity.respond ~view ~xview ~recvd ~xchg_len ~src:me ~me in
+ pf out "Gossip response:\n%a\n" View.pp resp;
+ assert_equal (View.length resp) xchg_len
+
+let suite =
+ "suite">:::
+ [
+ "gossip">:: test_gossip;
+ ]
+
+let () =
+ Nocrypto_entropy_unix.initialize ();
+ run_test_tt_main suite
diff --git a/test/p2p/dune b/test/p2p/dune
new file mode 100644
index 0000000..d7274c3
--- /dev/null
+++ b/test/p2p/dune
@@ -0,0 +1,4 @@
+(test
+ (name test_view)
+ (package p2p)
+ (libraries oUnit p2p nocrypto.unix stdint))
diff --git a/test/p2p/test_gossip.ml b/test/p2p/test_gossip.ml
new file mode 100644
index 0000000..fc5b23d
--- /dev/null
+++ b/test/p2p/test_gossip.ml
@@ -0,0 +1,137 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+open Ringcast
+open OUnit2
+open Printf
+
+let view_len = 8
+let xchg_len = 4
+let my_nid = "ME"
+let my_data = 43
+
+let print_view msg view =
+ printf "\n%s\n" msg;
+ View.iter (fun id n -> Printf.printf "%s: %d (%d)\n" id n.data n.age) view;;
+
+let print_xchg msg xchg =
+ Printf.printf "\n%s\n" msg;
+ View.iter (fun id n -> Printf.printf "%s: %d\n" id n.data) xchg;;
+
+let opt2str v =
+ match v with
+ | Some v -> v
+ | None -> "-"
+
+let opt2int v =
+ match v with
+ | Some v -> v
+ | None -> -1
+
+let my_view =
+ add "a" 7
+ (add "b" 11
+ (add "c" 13
+ (add "d" 17
+ (add "e" 19
+ (add "f" 23
+ (add "g" 41
+ (add "h" 49
+ View.empty)))))))
+
+let my_recvd =
+ (add "W" 10
+ (add "X" 20
+ (add "Y" 30
+ (add "Z" 40
+ View.empty))))
+
+let my_view_str =
+ add "A" 5
+ (add "B" 10
+ (add "C" 20
+ (add "D" 30
+ (add "E" 40
+ (add "F" 45
+ (add "G" 50
+ (add "H" 0
+ View.empty)))))))
+
+let distance _nid1 data1 _nid2 data2 =
+ let min_nid = 0 in
+ let max_nid = 50 in
+ let nid1 = data1 in
+ let nid2 = data2 in
+ let d = abs (nid2 - nid1) in
+ let d = if d <= (max_nid - min_nid) / 2
+ then d
+ else max_nid + 1 - d in
+ let d = if (nid1 - nid2 = d) || (nid1 < nid2 && nid2 - nid1 != d)
+ then -1 * d
+ else d in
+ (* Printf.printf "distance %d %d = %d\n" nid1 nid2 d; *)
+ d
+
+let test_add _ctx =
+ let view = my_view in
+ print_view "add" view;
+ assert_equal (View.cardinal view) view_len
+
+let test_xchg _ctx =
+ let view = my_view in
+ let (nid, data, sent, _view) =
+ make_exchange view my_view_str xchg_len my_nid my_data distance in
+ printf "\nSEND TO %s (%d)\n" (opt2str nid) (opt2int data);
+ print_xchg "SEND:" sent;
+ print_newline ();
+ assert_equal (View.cardinal sent) xchg_len
+
+let test_recv _ctx =
+ let view = my_view in
+ let (nid, data, sent, view) =
+ make_exchange view my_view_str xchg_len my_nid my_data distance in
+ let recvd = my_recvd in
+ printf "\n\nSEND TO %s (%d)\n" (opt2str nid) (opt2int data);
+ print_view "VIEW BEFORE:" view;
+ print_xchg "SENT:" sent;
+ print_xchg "RECVD:" recvd;
+ assert_equal (View.cardinal view) (view_len - 1);
+ assert_equal (View.cardinal sent) xchg_len;
+ let view2 = merge_recvd view view_len recvd xchg_len my_nid my_data distance in
+ print_view "VIEW AFTER:" view2;
+ assert_equal (View.cardinal view2) view_len;
+ assert_equal (View.mem "ME" view2) false;
+ let (rnid, rdata) = ("x", 5) in
+ let resp =
+ make_response view2 my_view_str xchg_len rnid rdata recvd
+ my_nid my_data distance in
+ printf "\nRESPOND TO %s (%d)\n" rnid rdata;
+ print_xchg "RESP:" resp;
+ assert_equal (View.cardinal resp) xchg_len;
+ let (rnid, _rdata) = View.choose recvd in
+ assert_equal (View.mem rnid resp) false
+
+let suite =
+ "suite">:::
+ [
+ "add">:: test_add;
+ "exchange">:: test_xchg;
+ "receive">:: test_recv;
+ ]
+
+let () =
+ Random.self_init ();
+ run_test_tt_main suite
diff --git a/test/p2p/test_view.ml b/test/p2p/test_view.ml
new file mode 100644
index 0000000..a3c92ab
--- /dev/null
+++ b/test/p2p/test_view.ml
@@ -0,0 +1,82 @@
+(*
+ Copyright (C) 2019 TG x Thoth
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+*)
+
+open OUnit2
+open Stdint
+
+let u64 = Uint64.of_int64
+
+module Node_id = P2p.Node_id
+module Node = P2p.Node.Make (Node_id)
+module View = P2p.View.Make (Node_id) (Node)
+
+let my_view =
+ (View.add (Node.init (u64 7L))
+ (View.add (Node.init (u64 11L) ~age:3 ~ver:2)
+ (View.add (Node.init (u64 13L))
+ (View.add (Node.init (u64 17L))
+ (View.add (Node.init (u64 23L))
+ (View.add (Node.init (u64 19L))
+ (View.add (Node.init (u64 49L))
+ (View.add (Node.init (u64 47L))
+ View.empty))))))))
+
+let test_view _ctx =
+ let v = View.incr_age my_view in
+ assert_equal (View.length v) 8;
+ let v = View.remove (Uint64.of_int64 17L) v in
+ assert_equal (View.length v) 7;
+ let n =
+ match View.find (u64 11L) v with
+ | Some n -> n
+ | None -> assert_failure "11 not found" in
+ assert_equal (Node.id n) (u64 11L);
+ let n = Node.incr_age n in
+ assert_equal (Node.age n) 5;
+ assert_equal (Node.ver n) 2;
+ let n = Node.zero_age n in
+ assert_equal (Node.age n) 0;
+ let n2 =
+ match View.find (u64 13L) v with
+ | Some n -> n
+ | None -> assert_failure "13 not found" in
+ assert_equal (Node.age n2) 1;
+ assert_equal (Node.ver n2) 0;
+ assert_equal (Node.compare n n2) (-1);
+ assert_equal (Node.compare n n) 0;
+ assert_equal (Node.compare n2 n) 1;
+ let l = View.to_list v in
+ assert_equal l [
+ Node.init (u64 7L) ~age:1;
+ Node.init (u64 11L) ~age:4 ~ver:2;
+ Node.init (u64 13L) ~age:1;
+ Node.init (u64 19L) ~age:1;
+ Node.init (u64 23L) ~age:1;
+ Node.init (u64 47L) ~age:1;
+ Node.init (u64 49L) ~age:1;
+ ];
+ let v2 = View.of_list ((Node.init (u64 11L)) :: l) in
+ assert_equal (View.to_list v2) l
+
+let suite =
+ "suite">:::
+ [
+ "view">:: test_view;
+ ]
+
+let () =
+ Nocrypto_entropy_unix.initialize ();
+ run_test_tt_main suite