From 0d936f3d65767c210ff17bbc0232a551b315e697 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 14:52:34 -0500 Subject: [PATCH 01/30] Lock changes --- esy.lock/index.json | 171 +++++++++++++----- esy.lock/opam/{cppo.1.6.8 => cppo.1.6.9}/opam | 40 ++-- .../opam | 48 +++-- esy.lock/opam/num.1.4/opam | 12 +- esy.lock/opam/odoc.2.1.0/opam | 60 ++++++ esy.lock/opam/{re.1.10.3 => re.1.10.4}/opam | 14 +- .../{spawn.v0.15.0 => spawn.v0.15.1}/opam | 8 +- esy.lock/opam/tyxml.4.5.0/opam | 42 +++++ .../package.json | 3 + 9 files changed, 296 insertions(+), 102 deletions(-) rename esy.lock/opam/{cppo.1.6.8 => cppo.1.6.9}/opam (58%) rename esy.lock/opam/{easy-format.1.3.2 => easy-format.1.3.3}/opam (68%) create mode 100644 esy.lock/opam/odoc.2.1.0/opam rename esy.lock/opam/{re.1.10.3 => re.1.10.4}/opam (66%) rename esy.lock/opam/{spawn.v0.15.0 => spawn.v0.15.1}/opam (79%) create mode 100644 esy.lock/opam/tyxml.4.5.0/opam create mode 100644 esy.lock/overrides/opam__s__easy_format_opam__c__1.3.3_opam_override/package.json diff --git a/esy.lock/index.json b/esy.lock/index.json index a07cce0..3ccee46 100644 --- a/esy.lock/index.json +++ b/esy.lock/index.json @@ -1,5 +1,5 @@ { - "checksum": "ffe903d165082ab60be24550d1dae31b", + "checksum": "9d770610ebf28d090c00e576f71d8236", "root": "pollinate@link-dev:./package.json", "node": { "pollinate@link-dev:./package.json": { @@ -19,6 +19,7 @@ "@opam/ppx_deriving@opam:5.2.1@089e5dd3", "@opam/ppx_compare@opam:v0.14.0@fbd22977", "@opam/ppx_bin_prot@opam:v0.14.0@4a83bcd2", + "@opam/odoc@opam:2.1.0@d39daa6f", "@opam/lwt_ppx@opam:2.0.3@125707d0", "@opam/lwt@opam:5.5.0@30354e4c", "@opam/dune@opam:2.9.3@f57a6d69", "@opam/bin_prot@opam:v0.14.0@2d7601e9" @@ -64,13 +65,13 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.13.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@1ea9f987", - "@opam/dune@opam:2.9.3@f57a6d69", "@opam/cppo@opam:1.6.8@7e48217d", + "ocaml@4.13.1000@d41d8cd9", "@opam/easy-format@opam:1.3.3@5d74d95b", + "@opam/dune@opam:2.9.3@f57a6d69", "@opam/cppo@opam:1.6.9@db929a12", "@opam/biniou@opam:1.2.1@420bda02", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.13.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@1ea9f987", + "ocaml@4.13.1000@d41d8cd9", "@opam/easy-format@opam:1.3.3@5d74d95b", "@opam/dune@opam:2.9.3@f57a6d69", "@opam/biniou@opam:1.2.1@420bda02" ] }, @@ -183,6 +184,34 @@ ], "devDependencies": [ "ocaml@4.13.1000@d41d8cd9" ] }, + "@opam/tyxml@opam:4.5.0@0a609297": { + "id": "@opam/tyxml@opam:4.5.0@0a609297", + "name": "@opam/tyxml", + "version": "opam:4.5.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/c6/c69accef5df4dd89d38f6aa0baad01e8fda4e9e98bb7dad61bec1452c5716068#sha256:c69accef5df4dd89d38f6aa0baad01e8fda4e9e98bb7dad61bec1452c5716068", + "archive:https://github.com/ocsigen/tyxml/releases/download/4.5.0/tyxml-4.5.0.tbz#sha256:c69accef5df4dd89d38f6aa0baad01e8fda4e9e98bb7dad61bec1452c5716068" + ], + "opam": { + "name": "tyxml", + "version": "4.5.0", + "path": "esy.lock/opam/tyxml.4.5.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.13.1000@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", + "@opam/seq@opam:base@d8d7de1d", "@opam/re@opam:1.10.4@c4910ba6", + "@opam/dune@opam:2.9.3@f57a6d69", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.13.1000@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", + "@opam/seq@opam:base@d8d7de1d", "@opam/re@opam:1.10.4@c4910ba6", + "@opam/dune@opam:2.9.3@f57a6d69" + ] + }, "@opam/topkg@opam:1.0.5@0aa59f51": { "id": "@opam/topkg@opam:1.0.5@0aa59f51", "name": "@opam/topkg", @@ -301,20 +330,20 @@ "@opam/base@opam:v0.14.3@b3ddb868" ] }, - "@opam/spawn@opam:v0.15.0@4a27a4cb": { - "id": "@opam/spawn@opam:v0.15.0@4a27a4cb", + "@opam/spawn@opam:v0.15.1@85e9d6f1": { + "id": "@opam/spawn@opam:v0.15.1@85e9d6f1", "name": "@opam/spawn", - "version": "opam:v0.15.0", + "version": "opam:v0.15.1", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/31/310fb2a50ac7f64c738182cbabd9d27c1aeae1a08107fe14da8d35a87cbb57c7#sha256:310fb2a50ac7f64c738182cbabd9d27c1aeae1a08107fe14da8d35a87cbb57c7", - "archive:https://github.com/janestreet/spawn/archive/v0.15.0.tar.gz#sha256:310fb2a50ac7f64c738182cbabd9d27c1aeae1a08107fe14da8d35a87cbb57c7" + "archive:https://opam.ocaml.org/cache/sha256/9a/9afdee314fab6c3fcd689ab6eb5608d6b78078e6dede3953a47debde06c19d50#sha256:9afdee314fab6c3fcd689ab6eb5608d6b78078e6dede3953a47debde06c19d50", + "archive:https://github.com/janestreet/spawn/archive/v0.15.1.tar.gz#sha256:9afdee314fab6c3fcd689ab6eb5608d6b78078e6dede3953a47debde06c19d50" ], "opam": { "name": "spawn", - "version": "v0.15.0", - "path": "esy.lock/opam/spawn.v0.15.0" + "version": "v0.15.1", + "path": "esy.lock/opam/spawn.v0.15.1" } }, "overrides": [], @@ -370,12 +399,12 @@ "overrides": [], "dependencies": [ "ocaml@4.13.1000@d41d8cd9", "@opam/sexplib0@opam:v0.14.0@155c136c", - "@opam/parsexp@opam:v0.14.2@1d15b9d2", "@opam/num@opam:1.4@15ff926d", + "@opam/parsexp@opam:v0.14.2@1d15b9d2", "@opam/num@opam:1.4@54b259a0", "@opam/dune@opam:2.9.3@f57a6d69", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.13.1000@d41d8cd9", "@opam/sexplib0@opam:v0.14.0@155c136c", - "@opam/parsexp@opam:v0.14.2@1d15b9d2", "@opam/num@opam:1.4@15ff926d", + "@opam/parsexp@opam:v0.14.2@1d15b9d2", "@opam/num@opam:1.4@54b259a0", "@opam/dune@opam:2.9.3@f57a6d69" ] }, @@ -448,20 +477,20 @@ "ocaml@4.13.1000@d41d8cd9", "@opam/dune@opam:2.9.3@f57a6d69" ] }, - "@opam/re@opam:1.10.3@0585c65d": { - "id": "@opam/re@opam:1.10.3@0585c65d", + "@opam/re@opam:1.10.4@c4910ba6": { + "id": "@opam/re@opam:1.10.4@c4910ba6", "name": "@opam/re", - "version": "opam:1.10.3", + "version": "opam:1.10.4", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/84/846546967f3fe31765935dd40a6460a9424337ecce7b12727fcba49480790ebb#sha256:846546967f3fe31765935dd40a6460a9424337ecce7b12727fcba49480790ebb", - "archive:https://github.com/ocaml/ocaml-re/releases/download/1.10.3/re-1.10.3.tbz#sha256:846546967f3fe31765935dd40a6460a9424337ecce7b12727fcba49480790ebb" + "archive:https://opam.ocaml.org/cache/sha256/83/83eb3e4300aa9b1dc7820749010f4362ea83524742130524d78c20ce99ca747c#sha256:83eb3e4300aa9b1dc7820749010f4362ea83524742130524d78c20ce99ca747c", + "archive:https://github.com/ocaml/ocaml-re/releases/download/1.10.4/re-1.10.4.tbz#sha256:83eb3e4300aa9b1dc7820749010f4362ea83524742130524d78c20ce99ca747c" ], "opam": { "name": "re", - "version": "1.10.3", - "path": "esy.lock/opam/re.1.10.3" + "version": "1.10.4", + "path": "esy.lock/opam/re.1.10.4" } }, "overrides": [], @@ -943,7 +972,7 @@ "@opam/ppxlib@opam:0.25.0@8553d2e8", "@opam/ppx_derivers@opam:1.2.1@e2cbad12", "@opam/ocamlfind@opam:1.9.3@781b30f3", - "@opam/dune@opam:2.9.3@f57a6d69", "@opam/cppo@opam:1.6.8@7e48217d", + "@opam/dune@opam:2.9.3@f57a6d69", "@opam/cppo@opam:1.6.9@db929a12", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ @@ -1279,6 +1308,43 @@ "@opam/dune@opam:2.9.3@f57a6d69", "@opam/astring@opam:0.8.5@1300cee8" ] }, + "@opam/odoc@opam:2.1.0@d39daa6f": { + "id": "@opam/odoc@opam:2.1.0@d39daa6f", + "name": "@opam/odoc", + "version": "opam:2.1.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/65/65a2523a50ee368164f1f24f75866a6a36cdb0d00039c3006ec824351d4e4967#sha256:65a2523a50ee368164f1f24f75866a6a36cdb0d00039c3006ec824351d4e4967", + "archive:https://github.com/ocaml/odoc/releases/download/2.1.0/odoc-2.1.0.tbz#sha256:65a2523a50ee368164f1f24f75866a6a36cdb0d00039c3006ec824351d4e4967" + ], + "opam": { + "name": "odoc", + "version": "2.1.0", + "path": "esy.lock/opam/odoc.2.1.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.13.1000@d41d8cd9", "@opam/tyxml@opam:4.5.0@0a609297", + "@opam/result@opam:1.5@1c6a6533", + "@opam/odoc-parser@opam:1.0.0@b1029bdf", + "@opam/fpath@opam:0.7.3@674d8125", "@opam/fmt@opam:0.9.0@87213963", + "@opam/dune@opam:2.9.3@f57a6d69", "@opam/cppo@opam:1.6.9@db929a12", + "@opam/cmdliner@opam:1.1.1@03763729", + "@opam/astring@opam:0.8.5@1300cee8", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.13.1000@d41d8cd9", "@opam/tyxml@opam:4.5.0@0a609297", + "@opam/result@opam:1.5@1c6a6533", + "@opam/odoc-parser@opam:1.0.0@b1029bdf", + "@opam/fpath@opam:0.7.3@674d8125", "@opam/fmt@opam:0.9.0@87213963", + "@opam/dune@opam:2.9.3@f57a6d69", + "@opam/cmdliner@opam:1.1.1@03763729", + "@opam/astring@opam:0.8.5@1300cee8" + ] + }, "@opam/octavius@opam:1.2.2@2205cc65": { "id": "@opam/octavius@opam:1.2.2@2205cc65", "name": "@opam/octavius", @@ -1323,7 +1389,7 @@ "overrides": [], "dependencies": [ "ocaml@4.13.1000@d41d8cd9", "@opam/dune@opam:2.9.3@f57a6d69", - "@opam/cppo@opam:1.6.8@7e48217d", + "@opam/cppo@opam:1.6.9@db929a12", "@opam/base-bytes@opam:base@19d0c2ff", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], @@ -1410,7 +1476,7 @@ "dependencies": [ "ocaml@4.13.1000@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", "@opam/uuseg@opam:14.0.0@7d21466b", - "@opam/stdio@opam:v0.14.0@a5affb43", "@opam/re@opam:1.10.3@0585c65d", + "@opam/stdio@opam:v0.14.0@a5affb43", "@opam/re@opam:1.10.4@c4910ba6", "@opam/odoc-parser@opam:1.0.0@b1029bdf", "@opam/ocp-indent@opam:1.8.1@e32a3c50", "@opam/ocaml-version@opam:3.4.0@b6cd49e1", @@ -1429,7 +1495,7 @@ "devDependencies": [ "ocaml@4.13.1000@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", "@opam/uuseg@opam:14.0.0@7d21466b", - "@opam/stdio@opam:v0.14.0@a5affb43", "@opam/re@opam:1.10.3@0585c65d", + "@opam/stdio@opam:v0.14.0@a5affb43", "@opam/re@opam:1.10.4@c4910ba6", "@opam/odoc-parser@opam:1.0.0@b1029bdf", "@opam/ocp-indent@opam:1.8.1@e32a3c50", "@opam/ocaml-version@opam:3.4.0@b6cd49e1", @@ -1597,8 +1663,8 @@ "overrides": [], "dependencies": [ "ocaml@4.13.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@69d87312", - "@opam/spawn@opam:v0.15.0@4a27a4cb", - "@opam/result@opam:1.5@1c6a6533", "@opam/re@opam:1.10.3@0585c65d", + "@opam/spawn@opam:v0.15.1@85e9d6f1", + "@opam/result@opam:1.5@1c6a6533", "@opam/re@opam:1.10.4@c4910ba6", "@opam/ppx_yojson_conv_lib@opam:v0.15.0@773058a7", "@opam/pp@opam:1.1.2@89ad03b5", "@opam/ocamlformat-rpc-lib@opam:0.19.0@125cf11d", @@ -1608,8 +1674,8 @@ ], "devDependencies": [ "ocaml@4.13.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@69d87312", - "@opam/spawn@opam:v0.15.0@4a27a4cb", - "@opam/result@opam:1.5@1c6a6533", "@opam/re@opam:1.10.3@0585c65d", + "@opam/spawn@opam:v0.15.1@85e9d6f1", + "@opam/result@opam:1.5@1c6a6533", "@opam/re@opam:1.10.4@c4910ba6", "@opam/ppx_yojson_conv_lib@opam:v0.15.0@773058a7", "@opam/pp@opam:1.1.2@89ad03b5", "@opam/ocamlformat-rpc-lib@opam:0.19.0@125cf11d", @@ -1642,8 +1708,8 @@ "ocaml@4.13.1000@d41d8cd9", "@opam/dune@opam:2.9.3@f57a6d69" ] }, - "@opam/num@opam:1.4@15ff926d": { - "id": "@opam/num@opam:1.4@15ff926d", + "@opam/num@opam:1.4@54b259a0": { + "id": "@opam/num@opam:1.4@54b259a0", "name": "@opam/num", "version": "opam:1.4", "source": { @@ -1826,7 +1892,7 @@ "@opam/ocaml-syntax-shims@opam:1.0.0@9f361fbb", "@opam/mmap@opam:1.2.0@b0f60a84", "@opam/dune-configurator@opam:2.9.3@174e411b", - "@opam/dune@opam:2.9.3@f57a6d69", "@opam/cppo@opam:1.6.8@7e48217d", + "@opam/dune@opam:2.9.3@f57a6d69", "@opam/cppo@opam:1.6.9@db929a12", "@opam/base-unix@opam:base@87d0b2eb", "@opam/base-threads@opam:base@36803084", "@esy-ocaml/substs@0.0.1@d41d8cd9" @@ -2054,23 +2120,28 @@ ], "devDependencies": [ "@opam/dune@opam:2.9.3@f57a6d69" ] }, - "@opam/easy-format@opam:1.3.2@1ea9f987": { - "id": "@opam/easy-format@opam:1.3.2@1ea9f987", + "@opam/easy-format@opam:1.3.3@5d74d95b": { + "id": "@opam/easy-format@opam:1.3.3@5d74d95b", "name": "@opam/easy-format", - "version": "opam:1.3.2", + "version": "opam:1.3.3", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/34/3440c2b882d537ae5e9011eb06abb53f5667e651ea4bb3b460ea8230fa8c1926#sha256:3440c2b882d537ae5e9011eb06abb53f5667e651ea4bb3b460ea8230fa8c1926", - "archive:https://github.com/mjambon/easy-format/releases/download/1.3.2/easy-format-1.3.2.tbz#sha256:3440c2b882d537ae5e9011eb06abb53f5667e651ea4bb3b460ea8230fa8c1926" + "archive:https://opam.ocaml.org/cache/sha256/ea/eafccae911c26ca23e4ddacee3eaa54654d20f973b8680f84b708cef43adc416#sha256:eafccae911c26ca23e4ddacee3eaa54654d20f973b8680f84b708cef43adc416", + "archive:https://github.com/mjambon/easy-format/releases/download/1.3.3/easy-format-1.3.3.tbz#sha256:eafccae911c26ca23e4ddacee3eaa54654d20f973b8680f84b708cef43adc416" ], "opam": { "name": "easy-format", - "version": "1.3.2", - "path": "esy.lock/opam/easy-format.1.3.2" + "version": "1.3.3", + "path": "esy.lock/opam/easy-format.1.3.3" } }, - "overrides": [], + "overrides": [ + { + "opamoverride": + "esy.lock/overrides/opam__s__easy_format_opam__c__1.3.3_opam_override" + } + ], "dependencies": [ "ocaml@4.13.1000@d41d8cd9", "@opam/dune@opam:2.9.3@f57a6d69", "@esy-ocaml/substs@0.0.1@d41d8cd9" @@ -2180,20 +2251,20 @@ "ocaml@4.13.1000@d41d8cd9", "@opam/dune@opam:2.9.3@f57a6d69" ] }, - "@opam/cppo@opam:1.6.8@7e48217d": { - "id": "@opam/cppo@opam:1.6.8@7e48217d", + "@opam/cppo@opam:1.6.9@db929a12": { + "id": "@opam/cppo@opam:1.6.9@db929a12", "name": "@opam/cppo", - "version": "opam:1.6.8", + "version": "opam:1.6.9", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/fe/fed401197d86f9089e89f6cbdf1d660d#md5:fed401197d86f9089e89f6cbdf1d660d", - "archive:https://github.com/ocaml-community/cppo/archive/v1.6.8.tar.gz#md5:fed401197d86f9089e89f6cbdf1d660d" + "archive:https://opam.ocaml.org/cache/md5/d2/d23ffe85ac7dc8f0afd1ddf622770d09#md5:d23ffe85ac7dc8f0afd1ddf622770d09", + "archive:https://github.com/ocaml-community/cppo/archive/v1.6.9.tar.gz#md5:d23ffe85ac7dc8f0afd1ddf622770d09" ], "opam": { "name": "cppo", - "version": "1.6.8", - "path": "esy.lock/opam/cppo.1.6.8" + "version": "1.6.9", + "path": "esy.lock/opam/cppo.1.6.9" } }, "overrides": [], @@ -2283,11 +2354,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.13.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@1ea9f987", + "ocaml@4.13.1000@d41d8cd9", "@opam/easy-format@opam:1.3.3@5d74d95b", "@opam/dune@opam:2.9.3@f57a6d69", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.13.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@1ea9f987", + "ocaml@4.13.1000@d41d8cd9", "@opam/easy-format@opam:1.3.3@5d74d95b", "@opam/dune@opam:2.9.3@f57a6d69" ] }, @@ -2515,7 +2586,7 @@ "dependencies": [ "ocaml@4.13.1000@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", "@opam/stdlib-shims@opam:0.3.0@72c7bc98", - "@opam/re@opam:1.10.3@0585c65d", + "@opam/re@opam:1.10.4@c4910ba6", "@opam/ocaml-syntax-shims@opam:1.0.0@9f361fbb", "@opam/fmt@opam:0.9.0@87213963", "@opam/dune@opam:2.9.3@f57a6d69", "@opam/cmdliner@opam:1.1.1@03763729", @@ -2525,7 +2596,7 @@ "devDependencies": [ "ocaml@4.13.1000@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", "@opam/stdlib-shims@opam:0.3.0@72c7bc98", - "@opam/re@opam:1.10.3@0585c65d", + "@opam/re@opam:1.10.4@c4910ba6", "@opam/ocaml-syntax-shims@opam:1.0.0@9f361fbb", "@opam/fmt@opam:0.9.0@87213963", "@opam/dune@opam:2.9.3@f57a6d69", "@opam/cmdliner@opam:1.1.1@03763729", diff --git a/esy.lock/opam/cppo.1.6.8/opam b/esy.lock/opam/cppo.1.6.9/opam similarity index 58% rename from esy.lock/opam/cppo.1.6.8/opam rename to esy.lock/opam/cppo.1.6.9/opam index c9d7f68..9c51ec6 100644 --- a/esy.lock/opam/cppo.1.6.8/opam +++ b/esy.lock/opam/cppo.1.6.9/opam @@ -1,37 +1,39 @@ opam-version: "2.0" -maintainer: "martin@mjambon.com" +synopsis: "Code preprocessor like cpp for OCaml" +description: """\ +Cppo is an equivalent of the C preprocessor for OCaml programs. +It allows the definition of simple macros and file inclusion. + +Cppo is: + +* more OCaml-friendly than cpp +* easy to learn without consulting a manual +* reasonably fast +* simple to install and to maintain""" +maintainer: [ + "Martin Jambon " "Yishuai Li " +] authors: "Martin Jambon" license: "BSD-3-Clause" homepage: "https://github.com/ocaml-community/cppo" -doc: "https://ocaml-community.github.io/cppo/" +doc: "https://ocaml-community.github.io/cppo" bug-reports: "https://github.com/ocaml-community/cppo/issues" depends: [ "ocaml" {>= "4.02.3"} - "dune" {>= "1.0"} + "dune" {>= "1.10"} "base-unix" ] build: [ ["dune" "subst"] {dev} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} + ["dune" "build" "-p" name "@doc"] {with-doc} ] dev-repo: "git+https://github.com/ocaml-community/cppo.git" -synopsis: "Code preprocessor like cpp for OCaml" -description: """ -Cppo is an equivalent of the C preprocessor for OCaml programs. -It allows the definition of simple macros and file inclusion. - -Cppo is: - -* more OCaml-friendly than cpp -* easy to learn without consulting a manual -* reasonably fast -* simple to install and to maintain -""" url { - src: "https://github.com/ocaml-community/cppo/archive/v1.6.8.tar.gz" + src: "https://github.com/ocaml-community/cppo/archive/v1.6.9.tar.gz" checksum: [ - "md5=fed401197d86f9089e89f6cbdf1d660d" - "sha512=069bbe0ef09c03b0dc4b5795f909c3ef872fe99c6f1e6704a0fa97594b1570b3579226ec67fe11d696ccc349a4585055bbaf07c65eff423aa45af28abf38c858" + "md5=d23ffe85ac7dc8f0afd1ddf622770d09" + "sha512=26ff5a7b7f38c460661974b23ca190f0feae3a99f1974e0fd12ccf08745bd7d91b7bc168c70a5385b837bfff9530e0e4e41cf269f23dd8cf16ca658008244b44" ] -} +} \ No newline at end of file diff --git a/esy.lock/opam/easy-format.1.3.2/opam b/esy.lock/opam/easy-format.1.3.3/opam similarity index 68% rename from esy.lock/opam/easy-format.1.3.2/opam rename to esy.lock/opam/easy-format.1.3.3/opam index f55c2c8..5926060 100644 --- a/esy.lock/opam/easy-format.1.3.2/opam +++ b/esy.lock/opam/easy-format.1.3.3/opam @@ -1,17 +1,4 @@ opam-version: "2.0" -build: [ - ["dune" "subst"] {dev} - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} - ["dune" "build" "-p" name "@doc"] {with-doc} -] -maintainer: ["martin@mjambon.com" "rudi.grinberg@gmail.com"] -authors: ["Martin Jambon"] -bug-reports: "https://github.com/mjambon/easy-format/issues" -homepage: "https://github.com/mjambon/easy-format" -doc: "https://mjambon.github.io/easy-format/" -license: "BSD-3-Clause" -dev-repo: "git+https://github.com/mjambon/easy-format.git" synopsis: "High-level and functional interface to the Format module of the OCaml standard library" description: """ @@ -32,15 +19,40 @@ nodes: Atoms represent any text that is guaranteed to be printed as-is. Lists can model any sequence of items such as arrays of data or lists of definitions that are labelled with something like "int main", "let x =" or "x:".""" +maintainer: ["martin@mjambon.com" "rudi.grinberg@gmail.com"] +authors: ["Martin Jambon"] +license: "BSD-3-Clause" +homepage: "https://github.com/mjambon/easy-format" +doc: "https://mjambon.github.io/easy-format/" +bug-reports: "https://github.com/mjambon/easy-format/issues" depends: [ - "dune" {>= "1.10"} - "ocaml" {>= "4.02.3"} + "dune" {>= "2.9"} + "ocaml" {>= "4.08"} + "odoc" {with-doc} ] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "--promote-install-files=false" + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["dune" "install" "-p" name "--create-install-files" name] +] +dev-repo: "git+https://github.com/mjambon/easy-format.git" url { src: - "https://github.com/mjambon/easy-format/releases/download/1.3.2/easy-format-1.3.2.tbz" + "https://github.com/mjambon/easy-format/releases/download/1.3.3/easy-format-1.3.3.tbz" checksum: [ - "sha256=3440c2b882d537ae5e9011eb06abb53f5667e651ea4bb3b460ea8230fa8c1926" - "sha512=e39377a2ff020ceb9ac29e8515a89d9bdbc91dfcfa871c4e3baafa56753fac2896768e5d9822a050dc1e2ade43c8967afb69391a386c0a8ecd4e1f774e236135" + "sha256=eafccae911c26ca23e4ddacee3eaa54654d20f973b8680f84b708cef43adc416" + "sha512=611b3124f6a0ec6406b7bda8018a94c9c4a9da9d22495a5c34a6312bf7f0f0607a9529b276f7039ce3f3b15a955dac413d6d1229a55d5ac291302a3ddd5807e5" ] } +x-commit-hash: "56c57e69ef067d1cc4e31029d31e77e55b46be95" diff --git a/esy.lock/opam/num.1.4/opam b/esy.lock/opam/num.1.4/opam index 0e39879..253f84e 100644 --- a/esy.lock/opam/num.1.4/opam +++ b/esy.lock/opam/num.1.4/opam @@ -13,9 +13,13 @@ depends: [ conflicts: ["base-num"] build: make install: [ - make - "install" {!ocaml:preinstalled} - "findlib-install" {ocaml:preinstalled} + ["ocamlfind" "remove" "num"] + ["ocamlfind" "remove" "num-top"] + [ + make + "install" {!ocaml:preinstalled} + "findlib-install" {ocaml:preinstalled} + ] ] dev-repo: "git+https://github.com/ocaml/num.git" url { @@ -24,4 +28,4 @@ url { "md5=cda2b727e116a0b6a9c03902cc4b2415" "sha512=0cc9be8ad95704bb683b4bf6698bada1ee9a40dc05924b72adc7b969685c33eeb68ccf174cc09f6a228c48c18fe94af06f28bebc086a24973a066da620db8e6f" ] -} \ No newline at end of file +} diff --git a/esy.lock/opam/odoc.2.1.0/opam b/esy.lock/opam/odoc.2.1.0/opam new file mode 100644 index 0000000..6b1df40 --- /dev/null +++ b/esy.lock/opam/odoc.2.1.0/opam @@ -0,0 +1,60 @@ +opam-version: "2.0" +homepage: "http://github.com/ocaml/odoc" +doc: "https://ocaml.github.io/odoc/" +bug-reports: "https://github.com/ocaml/odoc/issues" +license: "ISC" + +authors: [ + "Thomas Refis " + "David Sheets " + "Leo White " + "Anton Bachin " + "Jon Ludlam " + "Jules Aguillon " + "Lubega Simon " +] +maintainer: "Jon Ludlam " +dev-repo: "git+https://github.com/ocaml/odoc.git" + +synopsis: "OCaml documentation generator" +description: """ +Odoc is a documentation generator for OCaml. It reads doc comments, +delimited with `(** ... *)`, and outputs HTML. +""" + +depends: [ + "odoc-parser" {>= "0.9.0"} + "astring" + "cmdliner" {>= "1.0.0"} + "cppo" {build & >= "1.1.0"} + "dune" {>= "2.9.1"} + "fpath" + "ocaml" {>= "4.02.0"} + "result" + "tyxml" {>= "4.3.0"} + "fmt" + + "ocamlfind" {with-test} + "yojson" {with-test} + ("ocaml" {< "4.04.1" & with-test} | "sexplib0" {with-test}) + "conf-jq" {with-test} + + "ppx_expect" {with-test} + "bos" {with-test} + + "bisect_ppx" {dev & > "2.5.0"} + ("ocaml" {< "4.03.0" & dev} | "mdx" {dev}) +] + +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] +] +url { + src: "https://github.com/ocaml/odoc/releases/download/2.1.0/odoc-2.1.0.tbz" + checksum: [ + "sha256=65a2523a50ee368164f1f24f75866a6a36cdb0d00039c3006ec824351d4e4967" + "sha512=cf4d7e884b94a9b9c4bcb62d4423d7289d7bbbf2642c5eacf9577b76eb835cf6ecc79d2384d36d174d2e9d8f758b5082c0c4bf8f66b5c6db4e9805dc3fc9ee1a" + ] +} +x-commit-hash: "d654ee2a4ff3e1465dcf92b882c26de71f7a9986" diff --git a/esy.lock/opam/re.1.10.3/opam b/esy.lock/opam/re.1.10.4/opam similarity index 66% rename from esy.lock/opam/re.1.10.3/opam rename to esy.lock/opam/re.1.10.4/opam index c65d450..9dad661 100644 --- a/esy.lock/opam/re.1.10.3/opam +++ b/esy.lock/opam/re.1.10.4/opam @@ -8,19 +8,19 @@ authors: [ "Rudi Grinberg" "Gabriel Radanne" ] -license: "LGPL-2.0 with OCaml linking exception" +license: "LGPL-2.0-or-later WITH OCaml-LGPL-linking-exception" homepage: "https://github.com/ocaml/ocaml-re" bug-reports: "https://github.com/ocaml/ocaml-re/issues" dev-repo: "git+https://github.com/ocaml/ocaml-re.git" build: [ - ["dune" "subst"] {pinned} + ["dune" "subst"] {dev} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] depends: [ - "ocaml" {>= "4.02"} + "ocaml" {>= "4.03"} "dune" {>= "2.0"} "ounit" {with-test} "seq" @@ -37,10 +37,10 @@ Pure OCaml regular expressions with: """ url { src: - "https://github.com/ocaml/ocaml-re/releases/download/1.10.3/re-1.10.3.tbz" + "https://github.com/ocaml/ocaml-re/releases/download/1.10.4/re-1.10.4.tbz" checksum: [ - "sha256=846546967f3fe31765935dd40a6460a9424337ecce7b12727fcba49480790ebb" - "sha512=d02103b7b8b8d8bc797341dcc933554745427f3c1b51b54b4ac9ff81badfd68c94726c57548b08e00ca99f3e09741b54b6500e97c19fc0e8fcefd6dfbe71da7f" + "sha256=83eb3e4300aa9b1dc7820749010f4362ea83524742130524d78c20ce99ca747c" + "sha512=92b05cf92c389fa8c753f2acca837b15dd05a4a2e8e2bec7a269d2e14c35b1a786d394258376648f80b4b99250ba1900cfe68230b8385aeac153149d9ce56099" ] } -x-commit-hash: "c5d5df80e128c3d7646b7d8b1322012c5fcc35f3" +x-commit-hash: "e9a4cecb8294c1839db18b1d0c30e755ec85ed5e" diff --git a/esy.lock/opam/spawn.v0.15.0/opam b/esy.lock/opam/spawn.v0.15.1/opam similarity index 79% rename from esy.lock/opam/spawn.v0.15.0/opam rename to esy.lock/opam/spawn.v0.15.1/opam index d8d1578..5be3a99 100644 --- a/esy.lock/opam/spawn.v0.15.0/opam +++ b/esy.lock/opam/spawn.v0.15.1/opam @@ -45,12 +45,12 @@ build: [ ] ] dev-repo: "git+https://github.com/janestreet/spawn.git" -x-commit-hash: "b5a25cab2f53a5ee9e10a7b8a96506cc61ce1198" +x-commit-hash: "13d279ebfa8c40d4bafe18cddfdff0de54b4eaff" url { src: - "https://github.com/janestreet/spawn/archive/v0.15.0.tar.gz" + "https://github.com/janestreet/spawn/archive/v0.15.1.tar.gz" checksum: [ - "sha256=310fb2a50ac7f64c738182cbabd9d27c1aeae1a08107fe14da8d35a87cbb57c7" - "sha512=3a775b57a73efee6adbc30b32fa779f27d11c7008a46f90fdb9da6288533e2d83fc49dbcd770c087f2e4560c5586ff72a9a2985d8929955773cc10d83f126013" + "sha256=9afdee314fab6c3fcd689ab6eb5608d6b78078e6dede3953a47debde06c19d50" + "sha512=efdb31d5ec5ea36d0bc80224d4ee04e46ce3428d1662870e6cebece92bc313d6eebee378802c0c059dd6e0cafea515308c31b7dfaf04a098eb4566583c1e9ed4" ] } diff --git a/esy.lock/opam/tyxml.4.5.0/opam b/esy.lock/opam/tyxml.4.5.0/opam new file mode 100644 index 0000000..22c7760 --- /dev/null +++ b/esy.lock/opam/tyxml.4.5.0/opam @@ -0,0 +1,42 @@ +opam-version: "2.0" +synopsis: "A library for building correct HTML and SVG documents" +description: + "TyXML provides a set of convenient combinators that uses the OCaml type system to ensure the validity of the generated documents. TyXML can be used with any representation of HTML and SVG: the textual one, provided directly by this package, or DOM trees (`js_of_ocaml-tyxml`) virtual DOM (`virtual-dom`) and reactive or replicated trees (`eliom`). You can also create your own representation and use it to instantiate a new set of combinators." +maintainer: ["dev@ocsigen.org"] +authors: ["The ocsigen team"] +license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" +homepage: "https://github.com/ocsigen/tyxml" +doc: "https://ocsigen.org/tyxml/latest/manual/intro" +bug-reports: "https://github.com/ocsigen/tyxml/issues" +depends: [ + "dune" {>= "2.0"} + "ocaml" {>= "4.02"} + "alcotest" {with-test} + "re" {>= "1.5.0"} + "seq" + "uutf" {>= "1.0.0"} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/ocsigen/tyxml.git" +x-commit-hash: "ef431a4bceaefb2d9248e79092e6c1a1a9420095" +url { + src: + "https://github.com/ocsigen/tyxml/releases/download/4.5.0/tyxml-4.5.0.tbz" + checksum: [ + "sha256=c69accef5df4dd89d38f6aa0baad01e8fda4e9e98bb7dad61bec1452c5716068" + "sha512=772535441b09c393d53c27152e65f404a0a541aa0cea1bda899a8d751ab64d1729237e583618c3ff33d75e3865d53503d1ea413c6bbc8c68c413347efd1709b3" + ] +} diff --git a/esy.lock/overrides/opam__s__easy_format_opam__c__1.3.3_opam_override/package.json b/esy.lock/overrides/opam__s__easy_format_opam__c__1.3.3_opam_override/package.json new file mode 100644 index 0000000..f9bd9e0 --- /dev/null +++ b/esy.lock/overrides/opam__s__easy_format_opam__c__1.3.3_opam_override/package.json @@ -0,0 +1,3 @@ +{ + "build": "dune build -p easy-format" +} From 9e0e84d107a02019a4395be634d9ff8523e74bad Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 14:59:24 -0500 Subject: [PATCH 02/30] Update messages for dissemination * Add post category * Derive show for debugging purposes * Add timestamp for checking if message is out of date * Make recipients an Address.t list so that messages can be constructed without recipients, then have recipients added later on * Add message hashing for easily checking if a message has been seen before --- lib/node/message.ml | 18 ++++++++++++++++-- lib/node/message.mli | 12 ++++++++---- 2 files changed, 24 insertions(+), 6 deletions(-) diff --git a/lib/node/message.ml b/lib/node/message.ml index 961d686..4be371d 100644 --- a/lib/node/message.ml +++ b/lib/node/message.ml @@ -5,16 +5,30 @@ type category = | Uncategorized | Request | Response + | Post | Failure_detection | Custom of string -[@@deriving bin_io] +[@@deriving bin_io, show] type t = { category : category; sub_category_opt : (string * string) option; id : int; + timestamp : float; sender : Address.t; - recipient : Address.t; + recipients : Address.t list; payload : bytes; } [@@deriving bin_io] + +let hash_of m = + [ + m.sender.address; + string_of_int m.sender.port; + string_of_float m.timestamp; + Bytes.to_string m.payload; + ] + |> String.concat "" + |> Digest.string + |> Digest.to_hex + |> fun s -> String.sub s 0 7 diff --git a/lib/node/message.mli b/lib/node/message.mli index 4068b67..dfca608 100644 --- a/lib/node/message.mli +++ b/lib/node/message.mli @@ -1,6 +1,6 @@ (** Messages received by the [node], whether they are requests, responses, or protocol-specific messages. For consumer use -only when implementing a routing function for the +only when implementing a preprocessing function for the node. *) open Common @@ -14,18 +14,22 @@ type category = | Uncategorized | Request | Response + | Post | Failure_detection | Custom of string -[@@deriving bin_io] +[@@deriving bin_io, show] (** Messages received from [peers] which are -stored in the node's inbox. *) +processed by the node's message handler. *) type t = { category : category; sub_category_opt : (string * string) option; id : int; + timestamp : float; sender : Address.t; - recipient : Address.t; + recipients : Address.t list; payload : bytes; } [@@deriving bin_io] + +val hash_of : t -> Digest.t From 175fe4fdbe7f0f69483de2ae8c41a8bf6acff3b1 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 15:04:35 -0500 Subject: [PATCH 03/30] Implemented Disseminator module This module is essentially a "dissemination manager". It keeps track of plenty of useful state info regarding what messages are being sent out, for how long they should continue to be sent out, and which messages shouldn't be interacted with anymore. --- lib/node/disseminator.ml | 63 +++++++++++++++++++++++++++++++++++++++ lib/node/disseminator.mli | 44 +++++++++++++++++++++++++++ 2 files changed, 107 insertions(+) create mode 100644 lib/node/disseminator.ml create mode 100644 lib/node/disseminator.mli diff --git a/lib/node/disseminator.ml b/lib/node/disseminator.ml new file mode 100644 index 0000000..ee29f90 --- /dev/null +++ b/lib/node/disseminator.ml @@ -0,0 +1,63 @@ +type pool_elt = { + message : Message.t; + remaining : int; +} + +(** Set of md5 message hashes in hex-string form + for storing "seen" messages *) +module DigestSet = Set.Make (Digest) + +type t = { + round : int; + pool : pool_elt list; + num_rounds : int; + epoch_length : float; + seen : DigestSet.t; +} + +let create ~num_rounds ~epoch_length = + { round = 0; pool = []; num_rounds; epoch_length; seen = DigestSet.empty } + +(* Increments disseminator.round and decrements pool_elt.remaining for + each disseminator pool element. Removes messages from the pool + that have been disseminated num_rounds times or which are + older than the epoch length.*) +let next_round disseminator = + let round = disseminator.round + 1 in + let pool = + disseminator.pool + |> List.map (fun ({ remaining; _ } as elt) -> + { elt with remaining = remaining - 1 }) + |> List.filter (fun elt -> elt.remaining > 0 + && elt.message.timestamp > Unix.time () -. disseminator.epoch_length) + in + + { disseminator with round; pool } + +let post disseminator message = + let open Message in + let time = Unix.time () in + if message.timestamp > time -. disseminator.epoch_length then + let pool = + { message; remaining = disseminator.num_rounds } :: disseminator.pool in + let digest_of_post = Message.hash_of message in + let seen = DigestSet.add digest_of_post disseminator.seen in + { disseminator with pool; seen } +else + disseminator + +let broadcast_queue disseminator = + List.map (fun e -> e.message) disseminator.pool + +let seen disseminator message = + let open Message in + let time = Unix.time () in + if message.timestamp > time -. disseminator.epoch_length then + let hash = Message.hash_of message in + DigestSet.mem hash disseminator.seen +else + false + +let all_seen disseminator = disseminator.seen |> DigestSet.to_seq |> List.of_seq + +let current_round { round; _ } = round diff --git a/lib/node/disseminator.mli b/lib/node/disseminator.mli new file mode 100644 index 0000000..4ff5e5a --- /dev/null +++ b/lib/node/disseminator.mli @@ -0,0 +1,44 @@ +(** Component responsible for gossip-style dissemination of + messages across the network *) + +(** A record containing information and state relevant to the + dissemination component. *) +type t + +(** Creates a dissemination component that can be attached to a node + when given the number of "rounds" for which each new message should + be disseminated and an "epoch length", in seconds, which determines + whether a message is too old to be disseminated again by checking + whether the message is newer than n seconds old, where n is the + given epoch length. *) +val create : num_rounds:int -> epoch_length:float -> t + +(** Starts the next round of dissemination, affecting the state + of the disseminator. In particular, this function causes the + current round to increase, reduces the number of rounds remaining + for each message being disseminated, and filters out messages with + no rounds remaining or a timestamp that's older than epoch_length + seconds. *) +val next_round : t -> t + +(** Adds a new message to the dissemination pool. The message will not be + posted if it is older than the epoch_length. Otherwise, the message + will begin to be disseminated automatically as long as the disseminator + is running along with Networking.disseminate.*) +val post : t -> Message.t -> t + +(** Returns the list of messages that need to be disseminated. For + exclusive use by Networking.disseminate. *) +val broadcast_queue : t -> Message.t list + +(** Determines whether the dissemination component has witnessed a + given message before, or whether the message is too old to be + retained in the set of seen messages. *) +val seen : t -> Message.t -> bool + +(** Returns the 7 digit hashes of all the messages + that the disseminator has seen. *) +val all_seen : t -> string list + +(** Returns the current disseminator round. *) +val current_round : t -> int From d5e04c75aa05ef8ff0741fc6c648f93d77819aca Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 15:06:12 -0500 Subject: [PATCH 04/30] Add node utils module, specifically add a convenient logging function --- lib/node/util.ml | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 lib/node/util.ml diff --git a/lib/node/util.ml b/lib/node/util.ml new file mode 100644 index 0000000..6eece0b --- /dev/null +++ b/lib/node/util.ml @@ -0,0 +1,10 @@ +open Types + +(** Prints a log message with information about the node it pertains to and the current time. *) +let log node msg = + let current_time = + Unix.time () |> Unix.localtime |> fun tm -> + Printf.sprintf "%02d:%02d:%02d" tm.Unix.tm_hour tm.Unix.tm_min + tm.Unix.tm_sec in + let addr = Printf.sprintf "%s:%d" !node.address.address !node.address.port in + Lwt_io.printf "[%s @ %s] %s" addr current_time msg From 440f1b0841a5cb4d02a8401cb3ace5184ea667b2 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 15:06:55 -0500 Subject: [PATCH 05/30] Update client to reflect changes in messages --- lib/node/client.ml | 56 +++++++++++++++------------------------------ lib/node/client.mli | 15 ++++++------ 2 files changed, 26 insertions(+), 45 deletions(-) diff --git a/lib/node/client.ml b/lib/node/client.ml index cecfa89..57aa85e 100644 --- a/lib/node/client.ml +++ b/lib/node/client.ml @@ -1,6 +1,4 @@ -open Lwt_unix open Common -open Common.Util open Types let address_of { address; _ } = address @@ -26,8 +24,9 @@ let create_request node recipient payload = category = Message.Request; sub_category_opt = None; id = !id; + timestamp = Unix.gettimeofday (); sender = !node.address; - recipient; + recipients = [recipient]; payload; }) @@ -37,50 +36,33 @@ let create_response node request payload = category = Message.Response; sub_category_opt = None; id = request.id; + timestamp = Unix.gettimeofday (); sender = !node.address; - recipient = request.sender; + recipients = [request.sender]; payload; } -let send_to node message = - let open Message in - let payload = Encoding.pack Message.bin_writer_t message in - let len = Bytes.length payload in - let addr = Address.to_sockaddr message.recipient in - Mutex.unsafe !node.socket (fun socket -> - let%lwt _ = sendto socket payload 0 len [] addr in - Lwt.return ()) - -let recv_next node = - let open Lwt_unix in - let open Util in - (* Peek the first 8 bytes of the incoming datagram - to read the Bin_prot size header. *) - let size_buffer = Bytes.create Encoding.size_header_length in - let%lwt node_socket = Mutex.lock !node.socket in - (* Flag MSG_PEEK means: peeks at an incoming message. - The data is treated as unread and the next recvfrom() - or similar function shall still return this data. - Here, we only need the mg_size. - *) - let%lwt _ = - recvfrom node_socket size_buffer 0 Encoding.size_header_length [MSG_PEEK] - in - let msg_size = - Encoding.read_size_header size_buffer + Encoding.size_header_length in - let msg_buffer = Bytes.create msg_size in - (* Now that we have read the header and the message size, we can read the message *) - let%lwt _ = recvfrom node_socket msg_buffer 0 msg_size [] in - let message = Encoding.unpack Message.bin_read_t msg_buffer in - Mutex.unlock !node.socket; - Lwt.return message +let create_post node payload = + Message. + { + category = Message.Post; + id = -1; + sub_category_opt = None; + timestamp = Unix.gettimeofday (); + sender = !node.address; + recipients = []; + payload; + } let request node request recipient = let%lwt message = create_request node recipient request in - let%lwt () = send_to node message in + let%lwt () = Networking.send_to node message in let condition_var = Lwt_condition.create () in Hashtbl.add !node.request_table message.id condition_var; Lwt_condition.wait condition_var +let post node message = + !node.disseminator <- Disseminator.post !node.disseminator message + let broadcast_request node req recipients = List.map (request node req) recipients diff --git a/lib/node/client.mli b/lib/node/client.mli index 1068e2d..efd4b74 100644 --- a/lib/node/client.mli +++ b/lib/node/client.mli @@ -11,9 +11,13 @@ val address_of : node -> Address.t (** Constructs a [Peer.t] from a [Types.node]. *) val peer_from : node -> Peer.t -(** Add a peer to the know peers. *) +(** Add a peer to the known peers. *) val add_peer : node -> Peer.t -> [`Duplicate | `Ok] +(** Begins disseminating an encoded message meant to be witnessed by as many + nodes in the network as possible. *) +val post : node ref -> Message.t -> unit + (** [create_request node recipient payload] creates a [Message.t] of the {i Request category} addressed to {i recipient} containing {i payload}. *) val create_request : node ref -> Address.t -> bytes -> Message.t Lwt.t @@ -22,13 +26,6 @@ val create_request : node ref -> Address.t -> bytes -> Message.t Lwt.t that responds to {i request} whose content is {i payload}. *) val create_response : node ref -> Message.t -> bytes -> Message.t -(** Sends a message via datagram from the given [Types.node] -to a specified peer within the [Message.t]. Construct a message with one of the -[create_*] functions to then feed to this function. *) -val send_to : node ref -> Message.t -> unit Lwt.t - -(** Waits for the next incoming message and returns it. *) -val recv_next : node ref -> Message.t Lwt.t (** Sends an encoded {i request} to the specified peer and returns a promise holding the response from the peer. This @@ -40,3 +37,5 @@ val request : node ref -> bytes -> Address.t -> Message.t Lwt.t of recipients and collects the responses in a list of [Message.t Lwt.t]. *) val broadcast_request : node ref -> bytes -> Address.t list -> Message.t Lwt.t list + +val create_post : node ref -> bytes -> Message.t From 5b02633d5cb2606639f419f4000da8f3df2420c6 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 15:07:22 -0500 Subject: [PATCH 06/30] Move networking functions to their own module and add gossip networking functionality --- lib/node/networking.ml | 88 +++++++++++++++++++++++++++++++++++++++++ lib/node/networking.mli | 11 ++++++ 2 files changed, 99 insertions(+) create mode 100644 lib/node/networking.ml create mode 100644 lib/node/networking.mli diff --git a/lib/node/networking.ml b/lib/node/networking.ml new file mode 100644 index 0000000..bfb43d9 --- /dev/null +++ b/lib/node/networking.ml @@ -0,0 +1,88 @@ +open Util +open Common +open Common.Util +open Types +open Lwt_unix + +let send_to node message = + let open Message in + let%lwt () = log node "Sending message\n" in + let payload = Encoding.pack Message.bin_writer_t message in + let len = Bytes.length payload in + let addrs = List.map Address.to_sockaddr message.recipients in + Mutex.unsafe !node.socket (fun socket -> + let%lwt _ = + Lwt_list.map_p (fun addr -> sendto socket payload 0 len [] addr) addrs + in + Lwt.return ()) + +let recv_next node = + let open Lwt_unix in + let open Util in + (* Peek the first 8 bytes of the incoming datagram + to read the Bin_prot size header. *) + let size_buffer = Bytes.create Encoding.size_header_length in + let%lwt node_socket = Mutex.lock !node.socket in + (* Flag MSG_PEEK means: peeks at an incoming message. + The data is treated as unread and the next recvfrom() + or similar function shall still return this data. + Here, we only need the mg_size. + *) + let%lwt _ = + recvfrom node_socket size_buffer 0 Encoding.size_header_length [MSG_PEEK] + in + let msg_size = + Encoding.read_size_header size_buffer + Encoding.size_header_length in + let msg_buffer = Bytes.create msg_size in + (* Now that we have read the header and the message size, we can read the message *) + let%lwt _ = recvfrom node_socket msg_buffer 0 msg_size [] in + let message = Encoding.unpack Message.bin_read_t msg_buffer in + Mutex.unlock !node.socket; + Lwt.return message + +(** Basic random shuffle, see https://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle*) +let knuth_shuffle known_peers = + let shuffled_array = Array.copy (Array.of_list known_peers) in + let initial_array_length = Array.length shuffled_array in + for i = initial_array_length - 1 downto 1 do + let k = Random.int (i + 1) in + let x = shuffled_array.(k) in + shuffled_array.(k) <- shuffled_array.(i); + shuffled_array.(i) <- x + done; + Array.to_list shuffled_array + +(** This function return the random peer, to which we will ask to ping the first peer *) +let pick_random_neighbors neighbors number_of_neighbors = + let rec take n l = + match l with + | [] -> [] + | h :: t when n > 0 -> h :: take (n - 1) t + | _ -> [] in + neighbors |> Base.Hashtbl.keys |> knuth_shuffle |> take number_of_neighbors + +(** Injects the list of recipients into the message and sends it to + each recipient with a log message. *) +let broadcast node message (recipients : Address.t list) = + let%lwt () = + recipients + |> List.map (fun Address.{ port; _ } -> string_of_int port) + |> String.concat " ; " + |> Printf.sprintf "Disseminating post %s from author %d to peers: [%s]\n" + (Message.hash_of message) message.sender.port + |> log node in + let message = Message.{ message with recipients } in + let%lwt () = send_to node message in + Lwt.return () + +(** Picks random peers to broadcast each message in the dissemination + queue to, then sends them. This function progresses the + disseminator to the next round, so no other function should + do this. *) +let disseminate node = + let dissemination_group = pick_random_neighbors !node.peers 2 in + let _ = + Disseminator.broadcast_queue !node.disseminator + |> List.map (fun message -> broadcast node message dissemination_group) + in + Lwt.return (!node.disseminator <- Disseminator.next_round !node.disseminator) diff --git a/lib/node/networking.mli b/lib/node/networking.mli new file mode 100644 index 0000000..867ca1a --- /dev/null +++ b/lib/node/networking.mli @@ -0,0 +1,11 @@ +open Types + +(** Sends a message via datagram from the given [Types.node] +to a specified peer within the [Message.t]. Construct a message with one of the +[create_*] functions to then feed to this function. *) +val send_to : node ref -> Message.t -> unit Lwt.t + +(** Waits for the next incoming message and returns it. *) +val recv_next : node ref -> Message.t Lwt.t + +val disseminate : node ref -> unit Lwt.t \ No newline at end of file From 2a4d9806784eba1a47e995439de7d905c42d3eb9 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 15:08:51 -0500 Subject: [PATCH 07/30] Update failure detector to reflect changes in messages and networking --- lib/node/failure_detector.ml | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/lib/node/failure_detector.ml b/lib/node/failure_detector.ml index 0db1061..ba356c0 100644 --- a/lib/node/failure_detector.ml +++ b/lib/node/failure_detector.ml @@ -82,27 +82,28 @@ let update_peer_status node peer status = (Printf.sprintf "Failed to find peer with address %s:%d in node peer list" peer.address.address peer.address.port) -let create_message node message (recipient : Peer.t) = +let create_message node message (recipients : Peer.t list) = Message. { category = Failure_detection; sub_category_opt = None; id = -1; + timestamp = Unix.gettimeofday (); sender = Client.address_of !node; - recipient = recipient.address; + recipients = List.map (fun p -> p.Peer.address) recipients; payload = Encoding.pack bin_writer_message message; } -let send_message message node (recipient : Peer.t) = - let message = create_message node message recipient in - Client.send_to node message +let send_message message node (recipients : Peer.t list) = + let message = create_message node message recipients in + Networking.send_to node message -let send_ping_to node peer = send_message Ping node peer +let send_ping_to node peer = send_message Ping node [peer] -let send_acknowledge_to node peer = send_message Acknowledge node peer +let send_acknowledge_to node peer = send_message Acknowledge node [peer] let send_ping_request_to node (recipient : Peer.t) = - send_message (PingRequest recipient.address) node recipient + send_message (PingRequest recipient.address) node [recipient] let handle_message node message = let open Message in From 5bef64081d6b3d5dc1ef03259338769cb932228b Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 15:09:30 -0500 Subject: [PATCH 08/30] Add a mutable disseminator to the node type --- lib/node/types.ml | 2 +- lib/node/types.mli | 29 +++++++++++++++++------------ 2 files changed, 18 insertions(+), 13 deletions(-) diff --git a/lib/node/types.ml b/lib/node/types.ml index 934844c..b69ef6b 100644 --- a/lib/node/types.ml +++ b/lib/node/types.ml @@ -20,7 +20,7 @@ type node = { current_request_id : int ref Mutex.t; request_table : (int, Message.t Lwt_condition.t) Hashtbl.t; socket : file_descr Mutex.t; - inbox : Inbox.t; failure_detector : failure_detector; peers : (Address.t, Peer.t) Base.Hashtbl.t; + mutable disseminator : Disseminator.t; } diff --git a/lib/node/types.mli b/lib/node/types.mli index 2316105..cd3c30a 100644 --- a/lib/node/types.mli +++ b/lib/node/types.mli @@ -39,21 +39,26 @@ type failure_detector = { (** Represents a node with some state in a peer-to-peer network *) type node = { address : Address.t; - (** An ID that is incremented whenever a request is - made from this node. The response matching this - request will carry the same ID, allowing the response - to be identified and thus stopping the request from - blocking. *) + (* An ID that is incremented whenever a request is + made from this node. The response matching this + request will carry the same ID, allowing the response + to be identified and thus stopping the request from + blocking. *) current_request_id : int ref Mutex.t; - (** A hashtable that pairs request IDs with condition variables. - When a response is received by the server, it checks this table - for a waiting request and signals the request's condition variable - with the incoming response. *) + (* A hashtable that pairs request IDs with condition variables. + When a response is received by the server, it checks this table + for a waiting request and signals the request's condition variable + with the incoming response. *) request_table : (int, Message.t Lwt_condition.t) Hashtbl.t; socket : file_descr Mutex.t; - (** A store of incoming messages for the node. Stores - messages separately by category. *) - inbox : Inbox.t; + (* Failure detection component ; runs automatically with the server and is responsible + for automatically removing dead nodes from the peers table. *) failure_detector : failure_detector; + (* Hashtable mapping addresses to Peers with statuses according + to the SWIM failure-detection protocol *) peers : (Address.t, Peer.t) Base.Hashtbl.t; + (* Dissemination component ; runs automatically with the server and is responsible + for automatically disseminating both new Post messages and received Post messages + with other nodes in the network *) + mutable disseminator : Disseminator.t; } From 62a7c558ab9a900498a41689e98b39f5a9048769 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 15:09:54 -0500 Subject: [PATCH 09/30] Update the server to be cleaner, log more, and include dissemination --- lib/node/server.ml | 155 ++++++++++++++++++++++++++++++++------------ lib/node/server.mli | 4 ++ 2 files changed, 119 insertions(+), 40 deletions(-) create mode 100644 lib/node/server.mli diff --git a/lib/node/server.ml b/lib/node/server.ml index e5dcaec..5ad4a47 100644 --- a/lib/node/server.ml +++ b/lib/node/server.ml @@ -1,51 +1,126 @@ -open Common.Util +open Util +open Common open Types -let route node router msg = - let open Message in - let msg = router msg in - Inbox.push !node.inbox msg.category msg - (** Signals a waiting request with its corresponding response if it exists. Otherwise returns None. *) -let handle_response request_table res = +let handle_response node res = let open Message in - let* res in - let* waiting_request = Hashtbl.find_opt request_table res.id in - Some (Lwt_condition.signal waiting_request res) + match Hashtbl.find_opt !node.request_table res.id with + | Some waiting_request -> Lwt_condition.signal waiting_request res + | None -> () -(* Sever procedure: - 1. Receive the next incoming message - 2. Route the message - 3. Grab the next response if it exists and send it to the request waiting for it - 4. Grab the next request if it exists and send it to the message handler along with the - node's state - 5. Send the encoded response from the message handler to the requester *) -let run node router msg_handler = - let rec server () = - let%lwt message = Client.recv_next node in - let%lwt () = route node router message in +(* Preprocess a message, log some information about it, then handle it + based on its category. The "rules" are as follows: - let%lwt () = - match%lwt Inbox.next !node.inbox Message.Failure_detection with - | Some message -> Failure_detector.handle_message node message - | None -> Lwt.return () in + Response: send the message to a "handle_response" function which wakes + up a sleeping request function with the response it was waiting for. + + Request: run the message handler on the incoming request and, if the message + handler returned a response, send it to the requester. - let%lwt () = Failure_detector.suspicion_detection node in - let%lwt () = Failure_detector.failure_detection node in + Failure_detection: send the message to the Failure_detector.handle_message function - let%lwt next_response = Inbox.next !node.inbox Message.Response in - let _ = handle_response !node.request_table next_response in + Post: check if the post has been seen (or if its outdated). If not, then handle the post with + the message handler, then disseminate it to this node's peers by reposting it. - let%lwt request = Inbox.next !node.inbox Message.Request in + Otherwise, we just apply the message handler and that's it. +*) +let process_message node preprocessor msg_handler = + let open Message in + let%lwt message = Networking.recv_next node in + let message = preprocessor message in + let%lwt () = + log node + (Printf.sprintf "Processing message %s from %d...\n" + (Message.hash_of message) message.sender.port) in + let%lwt () = + match message.category with + | Response -> Lwt.return (handle_response node message) + | Request -> ( + let%lwt () = + log node + (Printf.sprintf "%s:%d : Processing request from %s:%d\n" + !node.address.address !node.address.port message.sender.address + message.sender.port) in + match msg_handler message with + | Some response -> + response + |> Client.create_response node message + |> Networking.send_to node + | None -> + Lwt.return ()) + | Failure_detection -> Failure_detector.handle_message node message + | Post -> + if not (Disseminator.seen !node.disseminator message) then ( + let%lwt () = + log node + (Printf.sprintf "%s:%d : Processing post %s from %s:%d\n" + !node.address.address !node.address.port + (Message.hash_of message) message.sender.address + message.sender.port) in + let _ = msg_handler message in + let%lwt () = log node "Adding message to broadcast queue\n" in + Client.post node message; + Lwt.return ()) + else + log node + (Printf.sprintf "Got post %s from %s:%d but saw it already\n" + (Message.hash_of message) message.sender.address + message.sender.port) + | _ -> + let _ = msg_handler message in + Lwt.return () in + Lwt.return () + +(** Log some initial information at the beginning of a server iteration. + See comments for descriptions regarding what is actually being logged. *) +let print_logs node = + (* Check that the server is in fact running *) + let%lwt () = log node "Running server\n" in + (* Check which posts the node has seen so far *) + let%lwt () = + log node + (Printf.sprintf "Seen: %s\n" + (Disseminator.all_seen !node.disseminator |> String.concat " ; ")) + in + (* Check who the current peers of the node are *) + let%lwt () = + !node.peers + |> Base.Hashtbl.keys + |> List.map (fun Address.{ port; _ } -> string_of_int port) + |> String.concat " ; " + |> Printf.sprintf "Peers: %s\n" + |> log node in + (* Check which posts are currently being disseminated by the node *) + if List.length (Disseminator.broadcast_queue !node.disseminator) > 0 then let%lwt () = - match request with - | Some request -> - let response = - request |> msg_handler |> Client.create_response node request in - let%lwt () = Client.send_to node response in - Lwt.return () - | None -> Lwt.return () in - - server () in - Lwt.async server + !node.disseminator + |> Disseminator.broadcast_queue + |> List.map Message.hash_of + |> String.concat " " + |> Printf.sprintf "Broadcast Queue: %s\n" + |> log node in + Lwt.return () + else + Lwt.return () + +(* Sever procedure: + 0. Log pertinent information about the current node. + 1. Start a new thread for handling any incoming message. + 2. Run the failure detector. + 3. Run the disseminator, this includes actually sending messages to be + disseminated across the network. + 4. Wait 0.001 seconds before restarting the procedure. *) +let rec run node preprocessor msg_handler = + (* Step 0 *) + let%lwt () = print_logs node in + (* Step 1 *) + let _ = process_message node preprocessor msg_handler in + (* Step 2 *) + let%lwt () = Failure_detector.failure_detection node in + (* Step 3 *) + let%lwt () = Networking.disseminate node in + (* Step 4 *) + let%lwt () = Lwt_unix.sleep 0.001 in + run node preprocessor msg_handler diff --git a/lib/node/server.mli b/lib/node/server.mli new file mode 100644 index 0000000..38bf3d9 --- /dev/null +++ b/lib/node/server.mli @@ -0,0 +1,4 @@ +(** Runs the server given a reference to a node, a message preprocessor and a message handler. + The server is responsible for running failure detection and dissemination processes, as well + as issuing responses to nodes making individual requests via the message handler. *) +val run : Types.node ref -> (Message.t -> Message.t) -> (Message.t -> bytes option) -> 'b Lwt.t \ No newline at end of file From 97cf5b9ac965dbfced4ff36874b38f6b802c645b Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 15:10:27 -0500 Subject: [PATCH 10/30] Update node to use updated server and expose testing functions --- lib/node/node.ml | 19 ++++++++++++++----- lib/node/node.mli | 32 ++++++++++++++++++++------------ 2 files changed, 34 insertions(+), 17 deletions(-) diff --git a/lib/node/node.ml b/lib/node/node.ml index ad939c0..06a2480 100644 --- a/lib/node/node.ml +++ b/lib/node/node.ml @@ -4,10 +4,10 @@ open Types module Message = Message module Client = Client module Failure_detector = Failure_detector -module Inbox = Inbox -let init ?(preprocess = fun m -> m) ~msg_handler ?(init_peers = []) - (address, port) = +type t = Types.node + +let init ?(init_peers = []) Address.{ address; port } = let open Util in let%lwt socket = Net.create_socket port in let peers = @@ -23,7 +23,6 @@ let init ?(preprocess = fun m -> m) ~msg_handler ?(init_peers = []) current_request_id = Mutex.create (ref 0); request_table = Hashtbl.create 20; socket = Mutex.create socket; - inbox = Inbox.create (); failure_detector = Failure_detector.make { @@ -33,6 +32,16 @@ let init ?(preprocess = fun m -> m) ~msg_handler ?(init_peers = []) helpers_size = 3; }; peers; + disseminator = Disseminator.create ~num_rounds:10 ~epoch_length:50.; } in - Server.run node preprocess msg_handler; Lwt.return node + +let run_server ?(preprocessor = fun m -> m) ~msg_handler node = + Server.run node preprocessor msg_handler + +let seen node message = Disseminator.seen !node.disseminator message + +module Testing = struct + let broadcast_queue node = Disseminator.broadcast_queue !node.disseminator + let disseminator_round node = Disseminator.current_round !node.disseminator +end diff --git a/lib/node/node.mli b/lib/node/node.mli index 3f425b7..015bfce 100644 --- a/lib/node/node.mli +++ b/lib/node/node.mli @@ -3,18 +3,26 @@ open Common module Message = Message module Client = Client module Failure_detector = Failure_detector -module Inbox = Inbox + +type t = Types.node (** Initializes the node with an initial state, an optional -routing function that the consumer can use to inspect and modify +preprocessing function that the consumer can use to inspect and modify the incoming message as well as its metadata, and a message -handler that acts on the current state and the Message.t representing -the request. The message handler is used -to initialize a server that runs asynchronously. Returns -a reference to the node. *) -val init : - ?preprocess:(Message.t -> Message.t) -> - msg_handler:(Message.t -> bytes) -> - ?init_peers:Address.t list -> - string * int -> - Types.node ref Lwt.t +handler that acts on the current state and the incoming Message.t. +The message handler is used to initialize a server that runs asynchronously. +Returns reference to the newly created node. *) +val init : ?init_peers:Address.t list -> Address.t -> t ref Lwt.t + +val run_server : + ?preprocessor:(Message.t -> Message.t) -> + msg_handler:(Message.t -> bytes option) -> + t ref -> + 'b Lwt.t + +val seen : t ref -> Message.t -> bool + +module Testing : sig + val broadcast_queue : t ref -> Message.t list + val disseminator_round : t ref -> int +end From acbc8e572d18015f15ebe71d93c85f88ad7da0d2 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 15:10:44 -0500 Subject: [PATCH 11/30] Remove outdated Tqueue and Inbox modules --- lib/common/tqueue.ml | 68 ------------------------------------------- lib/common/tqueue.mli | 54 ---------------------------------- lib/node/inbox.ml | 31 -------------------- lib/node/inbox.mli | 25 ---------------- 4 files changed, 178 deletions(-) delete mode 100644 lib/common/tqueue.ml delete mode 100644 lib/common/tqueue.mli delete mode 100644 lib/node/inbox.ml delete mode 100644 lib/node/inbox.mli diff --git a/lib/common/tqueue.ml b/lib/common/tqueue.ml deleted file mode 100644 index f7462e9..0000000 --- a/lib/common/tqueue.ml +++ /dev/null @@ -1,68 +0,0 @@ -type 'a t = { - queue : 'a Queue.t; - lock : Lwt_mutex.t; - has_elt : unit Lwt_condition.t; -} - -let create () = - let queue = Queue.create () in - let lock = Lwt_mutex.create () in - let has_elt = Lwt_condition.create () in - { queue; lock; has_elt } - -let add x { queue; lock; has_elt } = - Lwt_mutex.with_lock lock (fun () -> - Queue.add x queue; - let%lwt () = - if Queue.length queue = 1 then ( - Lwt_condition.signal has_elt (); - Lwt.return ()) - else - Lwt.return () in - Lwt.return ()) - -let push = add - -let take { queue; lock; _ } = - Lwt_mutex.with_lock lock (fun () -> Lwt.return (Queue.take_opt queue)) - -let wait_to_take { queue; lock; has_elt } = - Lwt_mutex.with_lock lock (fun () -> - let%lwt () = - if Queue.is_empty queue then - Lwt_condition.wait ~mutex:lock has_elt - else - Lwt.return () in - Lwt.return (Queue.take queue)) - -let pop = take - -let peek { queue; lock; _ } = - Lwt_mutex.with_lock lock (fun () -> Lwt.return (Queue.peek_opt queue)) - -let wait_to_peek { queue; lock; has_elt } = - Lwt_mutex.with_lock lock (fun () -> - let%lwt () = - if Queue.is_empty queue then - Lwt_condition.wait ~mutex:lock has_elt - else - Lwt.return () in - Lwt.return (Queue.peek queue)) - -let top = peek - -let clear { queue; lock; _ } = - Lwt_mutex.with_lock lock (fun () -> Lwt.return (Queue.clear queue)) - -let copy { queue; lock; _ } = - Lwt_mutex.with_lock lock (fun () -> - let queue' = queue in - let lock' = Lwt_mutex.create () in - let has_elt' = Lwt_condition.create () in - Lwt.return { queue = queue'; lock = lock'; has_elt = has_elt' }) - -let is_empty { queue; lock; _ } = - Lwt_mutex.with_lock lock (fun () -> Lwt.return (Queue.is_empty queue)) - -let length { queue; lock; _ } = - Lwt_mutex.with_lock lock (fun () -> Lwt.return (Queue.length queue)) diff --git a/lib/common/tqueue.mli b/lib/common/tqueue.mli deleted file mode 100644 index c8b2e8f..0000000 --- a/lib/common/tqueue.mli +++ /dev/null @@ -1,54 +0,0 @@ -(** Thread-safe queues with the same exact interface -as OCaml's Queue module, except any function that -reads from or writes to a [Queue] returns a promise. -Furthermore, there is a special take function for blocking -the current thread until an element is available to take -from the queue. -Read the {{:https://ocaml.org/api/Queue.html}documentation for OCaml's Queue module} -for more information about the functions in this module *) - -(** {1 Type} *) - -(** The type of a thread-safe queue *) -type 'a t - -(** {1 API} *) - -(** Blocks the current thread of execution until -an element is in the queue, then returns a promise -containing the element. *) -val wait_to_take : 'a t -> 'a Lwt.t - -(** Similar to [wait_to_take] but doesn't block - the current thread. *) -val take : 'a t -> 'a option Lwt.t - -(** Similar to [wait_to_take], but doesn't remove -from the queue. *) -val wait_to_peek : 'a t -> 'a Lwt.t - -(** Similar to [wait_to_peek] but doesn't block - the current thread. *) -val peek : 'a t -> 'a option Lwt.t - -(**/**) - -val create : unit -> 'a t - -val add : 'a -> 'a t -> unit Lwt.t - -val push : 'a -> 'a t -> unit Lwt.t - -val pop : 'a t -> 'a option Lwt.t - -val top : 'a t -> 'a option Lwt.t - -val clear : 'a t -> unit Lwt.t - -val copy : 'a t -> 'a t Lwt.t - -val is_empty : 'a t -> bool Lwt.t - -val length : 'a t -> int Lwt.t - -(**/**) diff --git a/lib/node/inbox.ml b/lib/node/inbox.ml deleted file mode 100644 index e83e16a..0000000 --- a/lib/node/inbox.ml +++ /dev/null @@ -1,31 +0,0 @@ -open Common -type t = (Message.category, Message.t Tqueue.t) Base.Hashtbl.t - -let create () = - let inbox = Base.Hashtbl.Poly.create () in - let _ = Base.Hashtbl.add inbox ~key:Message.Request ~data:(Tqueue.create ()) in - let _ = - Base.Hashtbl.add inbox ~key:Message.Response ~data:(Tqueue.create ()) in - let _ = - Base.Hashtbl.add inbox ~key:Message.Uncategorized ~data:(Tqueue.create ()) - in - let _ = - Base.Hashtbl.add inbox ~key:Message.Failure_detection - ~data:(Tqueue.create ()) in - inbox - -let find_or_create_category inbox category = - Base.Hashtbl.find_or_add inbox category ~default:(fun () -> Tqueue.create ()) - -let next inbox ?(consume = true) category = - category - |> find_or_create_category inbox - |> if consume then Tqueue.take else Tqueue.peek - -let await_next inbox ?(consume = true) category = - category - |> find_or_create_category inbox - |> if consume then Tqueue.wait_to_take else Tqueue.wait_to_peek - -let push inbox category message = - category |> find_or_create_category inbox |> Tqueue.add message diff --git a/lib/node/inbox.mli b/lib/node/inbox.mli deleted file mode 100644 index a661d49..0000000 --- a/lib/node/inbox.mli +++ /dev/null @@ -1,25 +0,0 @@ -(** A Hashtbl mapping message categories to thread-safe queues -containing messages *) -type t - -(** Initializes an inbox with queues for each type of message. *) -val create : unit -> t - -(** Attempts to retrieve the next message of the given category -from the inbox, and returns None if no message is found. If consume -is true, then the if a message is found it will be removed from the -queue. Otherwise, it will be peeked at but not removed. Creates -a queue for the given category if one has not been created yet. *) -val next : t -> ?consume:bool -> Message.category -> Message.t option Lwt.t - -(** Blocks the current thread of execution until a message of the specified -category is available. If consume is true, the message will be -removed from the queue once it is available. Otherwise, it will be -peeked at. Creates a queue for the given category if one has not - been created yet. *) -val await_next : t -> ?consume:bool -> Message.category -> Message.t Lwt.t - -(** Pushes the given message of the given category -to the corresponding queue. Creates a queue for the given category -if one has not been created yet. *) -val push : t -> Message.category -> Message.t -> unit Lwt.t From dba4e72b7c8148baef972a69ca0f97f4c5a0644d Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 15:11:54 -0500 Subject: [PATCH 12/30] Update existing tests to reflect changes across the codebase --- test/commons.ml | 21 ++++++++------ test/failure_detector_prop.ml | 5 ++-- test/failure_detector_tests.ml | 8 ++--- test/node_tests.ml | 53 ++++++++++++---------------------- 4 files changed, 35 insertions(+), 52 deletions(-) diff --git a/test/commons.ml b/test/commons.ml index 887ebb3..3b083e5 100644 --- a/test/commons.ml +++ b/test/commons.ml @@ -4,7 +4,7 @@ module Commons = struct open Pollinate.Util open Messages - let preprocess msg = + let preprocessor msg = let open Messages in match msg.Message.category with | Request -> @@ -17,14 +17,17 @@ module Commons = struct { msg with payload = Encoding.pack bin_writer_response r } | _ -> msg - let msg_handler request = + let msg_handler message = let open Messages in let open Message in - let request = Encoding.unpack bin_read_request request.payload in - let response = - match request with - | Ping -> Pong - | Get -> Success "Ok" - | Insert _ -> Success "Successfully added value to state" in - Encoding.pack bin_writer_message (Response response) + match message.category with + | Request -> + let request = Encoding.unpack bin_read_request message.payload in + let response = + match request with + | Ping -> Pong + | Get -> Pong + | Insert _ -> Success "Successfully added value to state" in + Response response |> Encoding.pack bin_writer_message |> Option.some + | _ -> None end diff --git a/test/failure_detector_prop.ml b/test/failure_detector_prop.ml index fe0177b..89600ce 100644 --- a/test/failure_detector_prop.ml +++ b/test/failure_detector_prop.ml @@ -1,13 +1,12 @@ open QCheck2.Gen open Pollinate.Peer -open Commons +open Pollinate module SUT = Pollinate.Node.Failure_detector let node_a = Lwt_main.run - (Node.init ~preprocess:Commons.preprocess ~msg_handler:Commons.msg_handler - ("127.0.0.1", 3002)) + (Node.init Address.{ address = "127.0.0.1"; port = 3002 }) let knuth_shuffle_size = QCheck2.Test.make ~count:1000 diff --git a/test/failure_detector_tests.ml b/test/failure_detector_tests.ml index bc82743..1b348f3 100644 --- a/test/failure_detector_tests.ml +++ b/test/failure_detector_tests.ml @@ -1,4 +1,4 @@ -open Commons +open Pollinate open Pollinate.Node open Lwt.Infix @@ -6,12 +6,10 @@ module SUT = Pollinate.Node.Failure_detector let node_a = Lwt_main.run - (Node.init ~preprocess:Commons.preprocess ~msg_handler:Commons.msg_handler - ("127.0.0.1", 3003)) + (Node.init Address.{ address = "127.0.0.1"; port = 3003 }) let node_b = Lwt_main.run - (Node.init ~preprocess:Commons.preprocess ~msg_handler:Commons.msg_handler - ("127.0.0.1", 3004)) + (Node.init Address.{ address = "127.0.0.1"; port = 3004 }) let peer_b = Client.peer_from !node_b diff --git a/test/node_tests.ml b/test/node_tests.ml index c7e4574..83e7463 100644 --- a/test/node_tests.ml +++ b/test/node_tests.ml @@ -1,22 +1,23 @@ open Lwt.Infix +open Commons +open Pollinate open Pollinate.Node open Pollinate.Util -open Commons open Messages module Node_tests = struct (* Initializes two nodes and the related two peers *) let node_a = Lwt_main.run - (Node.init ~preprocess:Commons.preprocess ~msg_handler:Commons.msg_handler - ("127.0.0.1", 3000)) + (Node.init + Address.{ address = "127.0.0.1"; port = 3000 }) let peer_a = Client.peer_from !node_a let node_b = Lwt_main.run - (Node.init ~preprocess:Commons.preprocess ~msg_handler:Commons.msg_handler - ("127.0.0.1", 3001)) + (Node.init + Address.{ address = "127.0.0.1"; port = 3001 }) let peer_b = Client.peer_from !node_b @@ -24,6 +25,11 @@ module Node_tests = struct of the other, returning the first element in the response of each *) let trade_messages () = let open Messages in + let _ = + Lwt_list.map_p + (Node.run_server ~preprocessor:Commons.preprocessor + ~msg_handler:Commons.msg_handler) + [node_a; node_b] in let get = Encoding.pack bin_writer_message (Request Get) in let%lwt { payload = res_from_b; _ } = @@ -36,34 +42,18 @@ module Node_tests = struct let res_from_b, res_from_a = match (res_from_b, res_from_a) with - | Success ok1, Success ok2 -> (ok1, ok2) + | Pong, Pong -> ("Ok", "Ok") | _ -> failwith "Incorrect response" in Lwt.return (res_from_b, res_from_a) - let test_insert () = - let open Messages in - let insert_req = - Encoding.pack bin_writer_message (Request (Insert "something")) in - - let%lwt { payload = res_a; _ } = - Client.request node_a insert_req peer_b.address in - let res_a = Encoding.unpack bin_read_response res_a in - - let get = Encoding.pack bin_writer_message (Request Get) in - let%lwt { payload = b_state; _ } = - Client.request node_a get peer_b.address in - let b_state = Encoding.unpack bin_read_response b_state in - - let res_a, b_state = - match (res_a, b_state) with - | Success ok1, Success ok2 -> (ok1, ok2) - | _ -> failwith "Incorrect response" in - - Lwt.return (res_a, b_state) - let ping_pong () = let open Messages in + let _ = + Lwt_list.map_p + (Node.run_server ~preprocessor:Commons.preprocessor + ~msg_handler:Commons.msg_handler) + [node_a; node_b] in let ping = Encoding.pack bin_writer_message (Request Ping) in let%lwt { payload = pong; _ } = Client.request node_a ping peer_b.address in @@ -86,20 +76,13 @@ let test_trade_messages _ () = let test_ping_pong _ () = Node_tests.ping_pong () >|= Alcotest.(check string) "Ping pong" "Pong" -let test_insert_value _ () = - Node_tests.test_insert () - >|= Alcotest.(check (pair string string)) - "Test insert value" - ("Successfully added value to state", "Ok") - let () = Lwt_main.run @@ Alcotest_lwt.run "Client tests" [ - ( "communication", + ( "one-to-one communication", [ Alcotest_lwt.test_case "Trading Messages" `Quick test_trade_messages; Alcotest_lwt.test_case "Ping pong" `Quick test_ping_pong; - Alcotest_lwt.test_case "Insert value" `Quick test_insert_value; ] ); ] From 1565b10e15cbe12f942341e229819115a7eed075 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 15:12:17 -0500 Subject: [PATCH 13/30] Add disseminator and gossip tests --- test/disseminator_tests.ml | 105 ++++++++++++++++++++ test/dune | 4 + test/gossip_tests.ml | 191 +++++++++++++++++++++++++++++++++++++ 3 files changed, 300 insertions(+) create mode 100644 test/disseminator_tests.ml create mode 100644 test/gossip_tests.ml diff --git a/test/disseminator_tests.ml b/test/disseminator_tests.ml new file mode 100644 index 0000000..d22a79e --- /dev/null +++ b/test/disseminator_tests.ml @@ -0,0 +1,105 @@ +open Lwt.Infix +open Commons +open Pollinate +open Pollinate.Node + +module Disseminator_tests = struct + let node = + Lwt_main.run + (let%lwt node_a = + Node.init ~init_peers:[] + Address.{ address = "127.0.0.1"; port = 5000 } in + Lwt.return node_a) + + let queue_insertion_test () = + let _server = Node.run_server ~msg_handler:Commons.msg_handler node in + Client.address_of !node + |> (fun Address.{ port; _ } -> port) + |> string_of_int + |> String.to_bytes + |> Client.create_post node + |> Client.post node; + + Lwt.return (List.length (Node.Testing.broadcast_queue node)) + + let queue_removal_test () = + let _server = Node.run_server ~msg_handler:Commons.msg_handler node in + Client.address_of !node + |> (fun Address.{ port; _ } -> port) + |> string_of_int + |> String.to_bytes + |> Client.create_post node + |> Client.post node; + + let%lwt () = + while%lwt Node.Testing.disseminator_round node <= 10 do + Lwt_unix.sleep 0.1 + done in + Lwt.return (List.length (Node.Testing.broadcast_queue node)) + + let seen_message_test () = + let _server = Node.run_server ~msg_handler:Commons.msg_handler node in + let message = + Client.address_of !node + |> (fun Address.{ port; _ } -> port) + |> string_of_int + |> String.to_bytes + |> Client.create_post node in + message |> Client.post node; + + Lwt.return (Node.seen node message) +end + +(** Test for dissemination given a specific node. *) +let test_queue_removal _ () = + Disseminator_tests.queue_removal_test () + >|= Alcotest.(check int) + "Length of broadcast queue is 0 10 rounds after the client posts" 0 + +let test_queue_insertion _ () = + Disseminator_tests.queue_insertion_test () + >|= Alcotest.(check int) + "Length of broadcast queue is 1 after the client posts" 1 + +let test_seen_message _ () = + Disseminator_tests.seen_message_test () + >|= Alcotest.(check bool) + "A message that's just been posted is seen by the disseminator" true + +let () = + Lwt_main.run + @@ Alcotest_lwt.run "Disseminator tests" + [ + ( "disseminator functions", + [ + Alcotest_lwt.test_case + "Messages are removed from queue after 10 rounds" `Quick + test_queue_removal; + Alcotest_lwt.test_case + "Messages are added to the queue when posted" `Quick + test_queue_insertion; + Alcotest_lwt.test_case + "Messages that are posted are immediately seen" `Quick + test_seen_message + (* Alcotest_lwt.test_case "Dissemination from A" `Quick + (test_disseminate_from Gossip_tests.node_a); *) + (* Alcotest_lwt.test_case "Dissemination from B" `Quick + (test_disseminate_from Gossip_tests.node_b); + Alcotest_lwt.test_case "Dissemination from C" `Quick + (test_disseminate_from Gossip_tests.node_c); + Alcotest_lwt.test_case "Dissemination from D" `Quick + (test_disseminate_from Gossip_tests.node_d); *) + (* Alcotest_lwt.test_case "Dissemination from E" `Quick + (test_disseminate_from Gossip_tests.node_e); *) + (* Alcotest_lwt.test_case "Dissemination from F" `Quick + (test_disseminate_from Gossip_tests.node_f); *) + (* Alcotest_lwt.test_case "Dissemination from G" `Quick + (test_disseminate_from Gossip_tests.node_g); *) + (* Alcotest_lwt.test_case "Dissemination from H" `Quick + (test_disseminate_from Gossip_tests.node_h); *) + (* Alcotest_lwt.test_case "Dissemination from I" `Quick + (test_disseminate_from Gossip_tests.node_i); *) + (* Alcotest_lwt.test_case "Dissemination from J" `Quick + (test_disseminate_from Gossip_tests.node_j); ;*); + ] ); + ] diff --git a/test/dune b/test/dune index 97f6d6d..354a617 100644 --- a/test/dune +++ b/test/dune @@ -1,6 +1,8 @@ (tests (names node_tests + gossip_tests + disseminator_tests peer_prop address_prop util_prop @@ -8,6 +10,8 @@ failure_detector_tests) (modules node_tests + gossip_tests + disseminator_tests messages generators peer_prop diff --git a/test/gossip_tests.ml b/test/gossip_tests.ml new file mode 100644 index 0000000..800e875 --- /dev/null +++ b/test/gossip_tests.ml @@ -0,0 +1,191 @@ +open Lwt.Infix +open Commons +open Pollinate +open Pollinate.Node + +module Gossip_tests = struct + let local_address port = Address.{ address = "127.0.0.1"; port } + + (* Initializes a group of nodes connected as shown here: https://tinyurl.com/tcy8dxu8 *) + let ( node_a, + node_b, + node_c, + node_d, + node_e, + node_f, + node_g, + node_h, + node_i, + node_j ) = + Lwt_main.run + begin + let ( addr_a, + addr_b, + addr_c, + addr_d, + addr_e, + addr_f, + addr_g, + addr_h, + addr_i, + addr_j ) = + ( local_address 4000, + local_address 4001, + local_address 4002, + local_address 4003, + local_address 4004, + local_address 4005, + local_address 4006, + local_address 4007, + local_address 4008, + local_address 4009 ) in + + let%lwt node_a = + Node.init + ~init_peers:[addr_b; addr_c; addr_e; addr_h] + addr_a in + let%lwt node_b = + Node.init ~init_peers:[addr_a; addr_d; addr_e] addr_b in + let%lwt node_c = + Node.init ~init_peers:[addr_a; addr_f; addr_g] addr_c in + let%lwt node_d = Node.init ~init_peers:[addr_b] addr_d in + let%lwt node_e = + Node.init ~init_peers:[addr_a; addr_b] addr_e in + let%lwt node_f = Node.init ~init_peers:[addr_c] addr_f in + let%lwt node_g = Node.init ~init_peers:[addr_c] addr_g in + let%lwt node_h = + Node.init ~init_peers:[addr_a; addr_i; addr_j] addr_h in + let%lwt node_i = Node.init ~init_peers:[addr_h] addr_i in + let%lwt node_j = Node.init ~init_peers:[addr_h] addr_j in + Lwt.return + ( node_a, + node_b, + node_c, + node_d, + node_e, + node_f, + node_g, + node_h, + node_i, + node_j ) + end + + let nodes = + [ + node_a; + node_b; + node_c; + node_d; + node_e; + node_f; + node_g; + node_h; + node_i; + node_j; + ] + + (** Utility function for producing a list of ports from + the addresses of the given nodes. This provides an easy + way to identify nodes that are hosted on the same machine. *) + let node_ports nodes = + List.map + (fun n -> + let addr = Client.address_of !n in + addr.port) + nodes + + (** Starts the server for each node and constructs a Post message + whose author is the specified node, then disseminates it. Checks + every 2 seconds to see if all nodes have received the disseminated + message. The 2 second wait occurs n times before timing out and returning + the ports of the nodes who saw the message. *) + let disseminate_from _n node = + let _ = + List.map + (Node.run_server ~preprocessor:Commons.preprocessor + ~msg_handler:Commons.msg_handler) + nodes in + let message = + Client.address_of !node + |> (fun Address.{ port; _ } -> port) + |> string_of_int + |> String.to_bytes + |> Client.create_post node in + Client.post node message; + + let seen () = + nodes |> List.filter (fun n -> Node.seen n message) |> node_ports in + + (* let all_seen () = + seen () = node_ports nodes in *) + + (* Note: no matter what, we seem to wait n seconds here. + This shouldn't be happening. For some reason, I'm totally + unable to print log messages here as well. Really annoying. *) + (* let rec wait secs = + if secs < n && not (all_seen ()) then + let () = + seen () + |> List.map string_of_int + |> String.concat "; " + |> Printf.eprintf "SEEN: %s\n" in + let%lwt () = Lwt_unix.sleep 1. in + wait (secs +. 1.) + else + Lwt.return () in *) + + (* let%lwt () = wait 0. in *) + (* let secs = ref 1. in + let%lwt () = + while%lwt !secs < n && not (all_seen ()) do + secs := !secs +. 1.; + Lwt_unix.sleep 1. + done in *) + + (* let rounds = ref 0 in + + let%lwt () = + while%lwt !rounds < 7 && not (all_seen ()) do + rounds := !rounds + 1; + Lwt_unix.sleep 2. + done in *) + let%lwt () = Lwt_unix.sleep 0.2 in + + seen () |> Lwt.return +end + +(** Test for dissemination given a specific node. *) +let test_disseminate_from node _ () = + Gossip_tests.disseminate_from 15. node + >|= Alcotest.(check (list int)) + (Printf.sprintf "All nodes have seen the message %d" !node.address.port) + Gossip_tests.(node_ports nodes) + +let () = + Lwt_main.run + @@ Alcotest_lwt.run "Gossip tests" + [ + ( "gossip dissemination", + [ + Alcotest_lwt.test_case "Dissemination from A" `Quick + (test_disseminate_from Gossip_tests.node_a); + Alcotest_lwt.test_case "Dissemination from B" `Quick + (test_disseminate_from Gossip_tests.node_b); + Alcotest_lwt.test_case "Dissemination from C" `Quick + (test_disseminate_from Gossip_tests.node_c); + Alcotest_lwt.test_case "Dissemination from D" `Quick + (test_disseminate_from Gossip_tests.node_d); + Alcotest_lwt.test_case "Dissemination from E" `Quick + (test_disseminate_from Gossip_tests.node_e); + Alcotest_lwt.test_case "Dissemination from F" `Quick + (test_disseminate_from Gossip_tests.node_f); + Alcotest_lwt.test_case "Dissemination from G" `Quick + (test_disseminate_from Gossip_tests.node_g); + Alcotest_lwt.test_case "Dissemination from H" `Quick + (test_disseminate_from Gossip_tests.node_h); + Alcotest_lwt.test_case "Dissemination from I" `Quick + (test_disseminate_from Gossip_tests.node_i); + Alcotest_lwt.test_case "Dissemination from J" `Quick + (test_disseminate_from Gossip_tests.node_j); + ] ); + ] From af513eb7fc23055f62a371519b7235fb69136ed6 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 15:13:00 -0500 Subject: [PATCH 14/30] Add ppx show to node dune file --- lib/node/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/node/dune b/lib/node/dune index b91407a..b911382 100644 --- a/lib/node/dune +++ b/lib/node/dune @@ -3,4 +3,4 @@ (public_name pollinate.node) (libraries bin_prot lwt lwt.unix pollinate.common) (preprocess - (pps ppx_bin_prot lwt_ppx))) + (pps ppx_bin_prot ppx_deriving.show lwt_ppx))) From b015db0a29b3519c5933f750969a1bf400fbf007 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 15:13:40 -0500 Subject: [PATCH 15/30] Small doc fix --- lib/common/util.mli | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/common/util.mli b/lib/common/util.mli index 6767ca1..c75b9b3 100644 --- a/lib/common/util.mli +++ b/lib/common/util.mli @@ -10,7 +10,8 @@ val ( let* ) : 'a option -> ('a -> 'b option) -> 'b option module Encoding : sig (** Defines utilities for encoding or decoding messages. *) - (** The {i int} value of the buffer size. *) + (** The {i int} value of the necessary buffer size for storing the size + header at the beginning of each Bin_prot payload. *) val size_header_length : int (** Reads the value of the size header prepended From 9d8beacd71b1706d852e3c265b1cde688d7f4cdb Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 27 May 2022 15:13:40 -0500 Subject: [PATCH 16/30] Formatting fixes --- lib/node/client.mli | 1 - lib/node/disseminator.ml | 32 +++++++++++++++++--------------- lib/node/networking.mli | 2 +- lib/node/server.ml | 5 ++--- lib/node/server.mli | 6 +++++- test/disseminator_tests.ml | 4 ++-- test/failure_detector_prop.ml | 3 +-- test/failure_detector_tests.ml | 6 ++---- test/gossip_tests.ml | 16 +++++----------- test/node_tests.ml | 8 ++------ 10 files changed, 37 insertions(+), 46 deletions(-) diff --git a/lib/node/client.mli b/lib/node/client.mli index efd4b74..5d60eb4 100644 --- a/lib/node/client.mli +++ b/lib/node/client.mli @@ -26,7 +26,6 @@ val create_request : node ref -> Address.t -> bytes -> Message.t Lwt.t that responds to {i request} whose content is {i payload}. *) val create_response : node ref -> Message.t -> bytes -> Message.t - (** Sends an encoded {i request} to the specified peer and returns a promise holding the response from the peer. This function blocks the current thread of execution until a response diff --git a/lib/node/disseminator.ml b/lib/node/disseminator.ml index ee29f90..aa65a6c 100644 --- a/lib/node/disseminator.ml +++ b/lib/node/disseminator.ml @@ -28,8 +28,9 @@ let next_round disseminator = disseminator.pool |> List.map (fun ({ remaining; _ } as elt) -> { elt with remaining = remaining - 1 }) - |> List.filter (fun elt -> elt.remaining > 0 - && elt.message.timestamp > Unix.time () -. disseminator.epoch_length) + |> List.filter (fun elt -> + elt.remaining > 0 + && elt.message.timestamp > Unix.time () -. disseminator.epoch_length) in { disseminator with round; pool } @@ -37,14 +38,15 @@ let next_round disseminator = let post disseminator message = let open Message in let time = Unix.time () in - if message.timestamp > time -. disseminator.epoch_length then - let pool = - { message; remaining = disseminator.num_rounds } :: disseminator.pool in - let digest_of_post = Message.hash_of message in - let seen = DigestSet.add digest_of_post disseminator.seen in - { disseminator with pool; seen } -else - disseminator + if message.timestamp > time -. disseminator.epoch_length then + let pool = + { message; remaining = disseminator.num_rounds } :: disseminator.pool + in + let digest_of_post = Message.hash_of message in + let seen = DigestSet.add digest_of_post disseminator.seen in + { disseminator with pool; seen } + else + disseminator let broadcast_queue disseminator = List.map (fun e -> e.message) disseminator.pool @@ -52,11 +54,11 @@ let broadcast_queue disseminator = let seen disseminator message = let open Message in let time = Unix.time () in - if message.timestamp > time -. disseminator.epoch_length then - let hash = Message.hash_of message in - DigestSet.mem hash disseminator.seen -else - false + if message.timestamp > time -. disseminator.epoch_length then + let hash = Message.hash_of message in + DigestSet.mem hash disseminator.seen + else + false let all_seen disseminator = disseminator.seen |> DigestSet.to_seq |> List.of_seq diff --git a/lib/node/networking.mli b/lib/node/networking.mli index 867ca1a..48a621f 100644 --- a/lib/node/networking.mli +++ b/lib/node/networking.mli @@ -8,4 +8,4 @@ val send_to : node ref -> Message.t -> unit Lwt.t (** Waits for the next incoming message and returns it. *) val recv_next : node ref -> Message.t Lwt.t -val disseminate : node ref -> unit Lwt.t \ No newline at end of file +val disseminate : node ref -> unit Lwt.t diff --git a/lib/node/server.ml b/lib/node/server.ml index 5ad4a47..43a4b9d 100644 --- a/lib/node/server.ml +++ b/lib/node/server.ml @@ -48,8 +48,7 @@ let process_message node preprocessor msg_handler = response |> Client.create_response node message |> Networking.send_to node - | None -> - Lwt.return ()) + | None -> Lwt.return ()) | Failure_detection -> Failure_detector.handle_message node message | Post -> if not (Disseminator.seen !node.disseminator message) then ( @@ -71,7 +70,7 @@ let process_message node preprocessor msg_handler = | _ -> let _ = msg_handler message in Lwt.return () in - Lwt.return () + Lwt.return () (** Log some initial information at the beginning of a server iteration. See comments for descriptions regarding what is actually being logged. *) diff --git a/lib/node/server.mli b/lib/node/server.mli index 38bf3d9..2cfa48c 100644 --- a/lib/node/server.mli +++ b/lib/node/server.mli @@ -1,4 +1,8 @@ (** Runs the server given a reference to a node, a message preprocessor and a message handler. The server is responsible for running failure detection and dissemination processes, as well as issuing responses to nodes making individual requests via the message handler. *) -val run : Types.node ref -> (Message.t -> Message.t) -> (Message.t -> bytes option) -> 'b Lwt.t \ No newline at end of file +val run : + Types.node ref -> + (Message.t -> Message.t) -> + (Message.t -> bytes option) -> + 'b Lwt.t diff --git a/test/disseminator_tests.ml b/test/disseminator_tests.ml index d22a79e..b865de7 100644 --- a/test/disseminator_tests.ml +++ b/test/disseminator_tests.ml @@ -7,8 +7,8 @@ module Disseminator_tests = struct let node = Lwt_main.run (let%lwt node_a = - Node.init ~init_peers:[] - Address.{ address = "127.0.0.1"; port = 5000 } in + Node.init ~init_peers:[] Address.{ address = "127.0.0.1"; port = 5000 } + in Lwt.return node_a) let queue_insertion_test () = diff --git a/test/failure_detector_prop.ml b/test/failure_detector_prop.ml index 89600ce..05bcf3b 100644 --- a/test/failure_detector_prop.ml +++ b/test/failure_detector_prop.ml @@ -5,8 +5,7 @@ open Pollinate module SUT = Pollinate.Node.Failure_detector let node_a = - Lwt_main.run - (Node.init Address.{ address = "127.0.0.1"; port = 3002 }) + Lwt_main.run (Node.init Address.{ address = "127.0.0.1"; port = 3002 }) let knuth_shuffle_size = QCheck2.Test.make ~count:1000 diff --git a/test/failure_detector_tests.ml b/test/failure_detector_tests.ml index 1b348f3..11c0b16 100644 --- a/test/failure_detector_tests.ml +++ b/test/failure_detector_tests.ml @@ -5,11 +5,9 @@ open Lwt.Infix module SUT = Pollinate.Node.Failure_detector let node_a = - Lwt_main.run - (Node.init Address.{ address = "127.0.0.1"; port = 3003 }) + Lwt_main.run (Node.init Address.{ address = "127.0.0.1"; port = 3003 }) let node_b = - Lwt_main.run - (Node.init Address.{ address = "127.0.0.1"; port = 3004 }) + Lwt_main.run (Node.init Address.{ address = "127.0.0.1"; port = 3004 }) let peer_b = Client.peer_from !node_b diff --git a/test/gossip_tests.ml b/test/gossip_tests.ml index 800e875..41ca7a2 100644 --- a/test/gossip_tests.ml +++ b/test/gossip_tests.ml @@ -41,20 +41,14 @@ module Gossip_tests = struct local_address 4009 ) in let%lwt node_a = - Node.init - ~init_peers:[addr_b; addr_c; addr_e; addr_h] - addr_a in - let%lwt node_b = - Node.init ~init_peers:[addr_a; addr_d; addr_e] addr_b in - let%lwt node_c = - Node.init ~init_peers:[addr_a; addr_f; addr_g] addr_c in + Node.init ~init_peers:[addr_b; addr_c; addr_e; addr_h] addr_a in + let%lwt node_b = Node.init ~init_peers:[addr_a; addr_d; addr_e] addr_b in + let%lwt node_c = Node.init ~init_peers:[addr_a; addr_f; addr_g] addr_c in let%lwt node_d = Node.init ~init_peers:[addr_b] addr_d in - let%lwt node_e = - Node.init ~init_peers:[addr_a; addr_b] addr_e in + let%lwt node_e = Node.init ~init_peers:[addr_a; addr_b] addr_e in let%lwt node_f = Node.init ~init_peers:[addr_c] addr_f in let%lwt node_g = Node.init ~init_peers:[addr_c] addr_g in - let%lwt node_h = - Node.init ~init_peers:[addr_a; addr_i; addr_j] addr_h in + let%lwt node_h = Node.init ~init_peers:[addr_a; addr_i; addr_j] addr_h in let%lwt node_i = Node.init ~init_peers:[addr_h] addr_i in let%lwt node_j = Node.init ~init_peers:[addr_h] addr_j in Lwt.return diff --git a/test/node_tests.ml b/test/node_tests.ml index 83e7463..84a17c7 100644 --- a/test/node_tests.ml +++ b/test/node_tests.ml @@ -8,16 +8,12 @@ open Messages module Node_tests = struct (* Initializes two nodes and the related two peers *) let node_a = - Lwt_main.run - (Node.init - Address.{ address = "127.0.0.1"; port = 3000 }) + Lwt_main.run (Node.init Address.{ address = "127.0.0.1"; port = 3000 }) let peer_a = Client.peer_from !node_a let node_b = - Lwt_main.run - (Node.init - Address.{ address = "127.0.0.1"; port = 3001 }) + Lwt_main.run (Node.init Address.{ address = "127.0.0.1"; port = 3001 }) let peer_b = Client.peer_from !node_b From cb74dce7d00c597aa02ff69ea5446b6b1227dd14 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Wed, 1 Jun 2022 11:18:07 -0500 Subject: [PATCH 17/30] Change name of Disseminator.all_seen to Disseminator.get_seen_messages --- lib/node/disseminator.ml | 2 +- lib/node/disseminator.mli | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/node/disseminator.ml b/lib/node/disseminator.ml index aa65a6c..be635cc 100644 --- a/lib/node/disseminator.ml +++ b/lib/node/disseminator.ml @@ -60,6 +60,6 @@ let seen disseminator message = else false -let all_seen disseminator = disseminator.seen |> DigestSet.to_seq |> List.of_seq +let get_seen_messages disseminator = disseminator.seen |> DigestSet.to_seq |> List.of_seq let current_round { round; _ } = round diff --git a/lib/node/disseminator.mli b/lib/node/disseminator.mli index 4ff5e5a..bcea15e 100644 --- a/lib/node/disseminator.mli +++ b/lib/node/disseminator.mli @@ -38,7 +38,7 @@ val seen : t -> Message.t -> bool (** Returns the 7 digit hashes of all the messages that the disseminator has seen. *) -val all_seen : t -> string list +val get_seen_messages : t -> string list (** Returns the current disseminator round. *) val current_round : t -> int From 337f41426537e0614c7955aa47b8996738e85611 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Wed, 1 Jun 2022 11:20:15 -0500 Subject: [PATCH 18/30] Failure detector messaging functions operate on a single peer --- lib/node/failure_detector.ml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lib/node/failure_detector.ml b/lib/node/failure_detector.ml index ba356c0..5bc986a 100644 --- a/lib/node/failure_detector.ml +++ b/lib/node/failure_detector.ml @@ -82,7 +82,7 @@ let update_peer_status node peer status = (Printf.sprintf "Failed to find peer with address %s:%d in node peer list" peer.address.address peer.address.port) -let create_message node message (recipients : Peer.t list) = +let create_message node message recipient = Message. { category = Failure_detection; @@ -90,20 +90,20 @@ let create_message node message (recipients : Peer.t list) = id = -1; timestamp = Unix.gettimeofday (); sender = Client.address_of !node; - recipients = List.map (fun p -> p.Peer.address) recipients; + recipients = [ recipient.Peer.address ]; payload = Encoding.pack bin_writer_message message; } -let send_message message node (recipients : Peer.t list) = - let message = create_message node message recipients in +let send_message message node recipient = + let message = create_message node message recipient in Networking.send_to node message -let send_ping_to node peer = send_message Ping node [peer] +let send_ping_to node peer = send_message Ping node peer -let send_acknowledge_to node peer = send_message Acknowledge node [peer] +let send_acknowledge_to node peer = send_message Acknowledge node peer let send_ping_request_to node (recipient : Peer.t) = - send_message (PingRequest recipient.address) node [recipient] + send_message (PingRequest recipient.address) node recipient let handle_message node message = let open Message in From 5c1abe34651995b8b78d988583958a3aba848686 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Wed, 1 Jun 2022 11:27:22 -0500 Subject: [PATCH 19/30] Add doc comment for Networking.disseminate --- lib/node/networking.mli | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lib/node/networking.mli b/lib/node/networking.mli index 48a621f..0aa691d 100644 --- a/lib/node/networking.mli +++ b/lib/node/networking.mli @@ -8,4 +8,6 @@ val send_to : node ref -> Message.t -> unit Lwt.t (** Waits for the next incoming message and returns it. *) val recv_next : node ref -> Message.t Lwt.t -val disseminate : node ref -> unit Lwt.t +(** Advances a node's disseminator by disseminating the messages in the queue + and pruning outdated messages from the queue. *) +val disseminate : node ref -> unit Lwt.t \ No newline at end of file From b733e68b71f9fa69513ec66c0c5733ba04e54c3d Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Wed, 1 Jun 2022 11:35:21 -0500 Subject: [PATCH 20/30] Removed knuth shuffle and pick random peers from Failure detector --- lib/node/failure_detector.ml | 34 ++-------------------------------- lib/node/failure_detector.mli | 4 ---- lib/node/networking.mli | 7 ++++++- test/failure_detector_prop.ml | 13 ++++++++----- 4 files changed, 16 insertions(+), 42 deletions(-) diff --git a/lib/node/failure_detector.ml b/lib/node/failure_detector.ml index 5bc986a..72bc8f9 100644 --- a/lib/node/failure_detector.ml +++ b/lib/node/failure_detector.ml @@ -34,34 +34,6 @@ let wait_ack_timeout t sequence_number timeout = Lwt.return @@ Result.Ok "Successfully received acknowledge"); ] -(** Basic random shuffle, see https://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle*) -let knuth_shuffle known_peers = - let shuffled_array = Array.copy (Array.of_list known_peers) in - let initial_array_length = Array.length shuffled_array in - for i = initial_array_length - 1 downto 1 do - let k = Random.int (i + 1) in - let x = shuffled_array.(k) in - shuffled_array.(k) <- shuffled_array.(i); - shuffled_array.(i) <- x - done; - Array.to_list shuffled_array - -(* Regarding the SWIM protocol, if peer A cannot get ACK from peer B (timeout): - A sets B as `suspicious` - A randomly picks one (or several, should it also be randomly determined?) peer(s) from its list - and ask him/them to ping B.*) - -(** This function return the random peer, to which we will ask to ping the first peer *) -let rec pick_random_neighbors neighbors number_of_neighbors = - let addresses = neighbors |> Base.Hashtbl.keys |> knuth_shuffle in - match addresses with - | [] -> failwith "pick_random_peers" - | elem :: _ -> - if number_of_neighbors = 1 then - [elem] - else - elem :: pick_random_neighbors neighbors (number_of_neighbors - 1) - (** Updates a peer in the node's peer list with the given status. Returns a result that contains unit if the peer is found in the node's list, and @@ -150,7 +122,7 @@ let probe_peer t node peer_to_update = | Error _ -> ( let pingers = t.config.helpers_size - |> pick_random_neighbors !node.peers + |> Networking.pick_random_neighbors !node.peers |> List.map Peer.from in let _ = List.map (send_ping_request_to node) pingers in let wait_time = t.config.protocol_period - t.config.round_trip_time in @@ -172,9 +144,7 @@ let suspicion_detection node = match List.length available_peers with | 0 -> Lwt.return () | _ -> - let random_peer = - List.map (fun p -> p.address) available_peers |> knuth_shuffle |> List.hd - in + let random_peer = Networking.pick_random_neighbors !node.peers 1 |> List.hd in let _ = Lwt.join [ diff --git a/lib/node/failure_detector.mli b/lib/node/failure_detector.mli index 3ef3e48..5d1914a 100644 --- a/lib/node/failure_detector.mli +++ b/lib/node/failure_detector.mli @@ -40,10 +40,6 @@ val failure_detection : node ref -> unit Lwt.t (**/**) -val knuth_shuffle : Peer.t list -> Peer.t list - -val pick_random_neighbors : ('a, 'b) Base.Hashtbl.t -> int -> 'a list - val update_peer_status : Types.node ref -> Common.Peer.t -> Common.Peer.status -> (unit, string) result diff --git a/lib/node/networking.mli b/lib/node/networking.mli index 0aa691d..32766d7 100644 --- a/lib/node/networking.mli +++ b/lib/node/networking.mli @@ -1,4 +1,5 @@ open Types +open Common (** Sends a message via datagram from the given [Types.node] to a specified peer within the [Message.t]. Construct a message with one of the @@ -10,4 +11,8 @@ val recv_next : node ref -> Message.t Lwt.t (** Advances a node's disseminator by disseminating the messages in the queue and pruning outdated messages from the queue. *) -val disseminate : node ref -> unit Lwt.t \ No newline at end of file +val disseminate : node ref -> unit Lwt.t + +(** Given a Base.Hashtbl of Addresses to Peers and a number n of peers to be + randomly chosen, returns a list of addresses corresponding to n *) +val pick_random_neighbors : (Address.t, Peer.t) Base.Hashtbl.t -> int -> Address.t list \ No newline at end of file diff --git a/test/failure_detector_prop.ml b/test/failure_detector_prop.ml index 05bcf3b..a1632d1 100644 --- a/test/failure_detector_prop.ml +++ b/test/failure_detector_prop.ml @@ -7,11 +7,11 @@ module SUT = Pollinate.Node.Failure_detector let node_a = Lwt_main.run (Node.init Address.{ address = "127.0.0.1"; port = 3002 }) -let knuth_shuffle_size = +(* let knuth_shuffle_size = QCheck2.Test.make ~count:1000 ~name:"Knuth_shuffle does not change the size of the list" (QCheck2.Gen.list Generators.peer_gen) (fun peers -> - List.length (SUT.knuth_shuffle peers) == List.length peers) + List.length (SUT.knuth_shuffle peers) == List.length peers) *) let update_peer = QCheck2.Test.make ~count:1000 @@ -22,7 +22,7 @@ let update_peer = let _ = SUT.update_peer_status node_a neighbor neighbor_status in neighbor.status = neighbor_status) -let pick_random_neighbors = +(* let pick_random_neighbors = QCheck2.Test.make ~count:1000 ~name: "pick_random_neighbors on a peer with a single neighbor, returns this \ @@ -31,11 +31,14 @@ let pick_random_neighbors = let _ = add_neighbor peer neighbor in let random_neighbor = List.hd @@ SUT.pick_random_neighbors peer.neighbors 1 in - random_neighbor == neighbor.address) + random_neighbor == neighbor.address) *) let () = let failure_detector_prop = List.map QCheck_alcotest.to_alcotest - [knuth_shuffle_size; update_peer; pick_random_neighbors] in + [ update_peer + (* ; knuth_shuffle_size + ; pick_random_neighbors *) + ] in Alcotest.run "Failure detector" [("failure_detector.ml", failure_detector_prop)] From 4e183a51c09a10576a502541112d88754797e662 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Wed, 1 Jun 2022 11:35:47 -0500 Subject: [PATCH 21/30] Change server to use new name for Disseminator.all_seen --- lib/node/server.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/node/server.ml b/lib/node/server.ml index 43a4b9d..a85713f 100644 --- a/lib/node/server.ml +++ b/lib/node/server.ml @@ -81,7 +81,7 @@ let print_logs node = let%lwt () = log node (Printf.sprintf "Seen: %s\n" - (Disseminator.all_seen !node.disseminator |> String.concat " ; ")) + (Disseminator.get_seen_messages !node.disseminator |> String.concat " ; ")) in (* Check who the current peers of the node are *) let%lwt () = From 1c1c7bc242877f7bfa315b8a894c2a9c19e1ad06 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Wed, 1 Jun 2022 11:45:09 -0500 Subject: [PATCH 22/30] Move knuth shuffle and pick random peers tests to networking prop, move certain modules/functions to testing submodules --- lib/node/networking.ml | 4 ++++ lib/node/networking.mli | 6 +++++- lib/node/node.ml | 3 ++- lib/node/node.mli | 3 ++- test/dune | 2 ++ test/failure_detector_prop.ml | 2 +- test/failure_detector_tests.ml | 2 +- test/networking_prop.ml | 34 ++++++++++++++++++++++++++++++++++ 8 files changed, 51 insertions(+), 5 deletions(-) create mode 100644 test/networking_prop.ml diff --git a/lib/node/networking.ml b/lib/node/networking.ml index bfb43d9..340e41d 100644 --- a/lib/node/networking.ml +++ b/lib/node/networking.ml @@ -86,3 +86,7 @@ let disseminate node = |> List.map (fun message -> broadcast node message dissemination_group) in Lwt.return (!node.disseminator <- Disseminator.next_round !node.disseminator) + +module Testing = struct + let knuth_shuffle = knuth_shuffle +end \ No newline at end of file diff --git a/lib/node/networking.mli b/lib/node/networking.mli index 32766d7..3a98116 100644 --- a/lib/node/networking.mli +++ b/lib/node/networking.mli @@ -15,4 +15,8 @@ val disseminate : node ref -> unit Lwt.t (** Given a Base.Hashtbl of Addresses to Peers and a number n of peers to be randomly chosen, returns a list of addresses corresponding to n *) -val pick_random_neighbors : (Address.t, Peer.t) Base.Hashtbl.t -> int -> Address.t list \ No newline at end of file +val pick_random_neighbors : (Address.t, Peer.t) Base.Hashtbl.t -> int -> Address.t list + +module Testing : sig + val knuth_shuffle : 'a list -> 'a list +end \ No newline at end of file diff --git a/lib/node/node.ml b/lib/node/node.ml index 06a2480..5d37d14 100644 --- a/lib/node/node.ml +++ b/lib/node/node.ml @@ -3,7 +3,6 @@ open Types module Message = Message module Client = Client -module Failure_detector = Failure_detector type t = Types.node @@ -42,6 +41,8 @@ let run_server ?(preprocessor = fun m -> m) ~msg_handler node = let seen node message = Disseminator.seen !node.disseminator message module Testing = struct + module Failure_detector = Failure_detector + module Networking = Networking let broadcast_queue node = Disseminator.broadcast_queue !node.disseminator let disseminator_round node = Disseminator.current_round !node.disseminator end diff --git a/lib/node/node.mli b/lib/node/node.mli index 015bfce..2b07f37 100644 --- a/lib/node/node.mli +++ b/lib/node/node.mli @@ -2,7 +2,6 @@ open Common module Message = Message module Client = Client -module Failure_detector = Failure_detector type t = Types.node @@ -23,6 +22,8 @@ val run_server : val seen : t ref -> Message.t -> bool module Testing : sig + module Failure_detector = Failure_detector + module Networking = Networking val broadcast_queue : t ref -> Message.t list val disseminator_round : t ref -> int end diff --git a/test/dune b/test/dune index 354a617..ed3de82 100644 --- a/test/dune +++ b/test/dune @@ -6,6 +6,7 @@ peer_prop address_prop util_prop + networking_prop failure_detector_prop failure_detector_tests) (modules @@ -18,6 +19,7 @@ address_prop commons util_prop + networking_prop failure_detector_prop failure_detector_tests) (libraries pollinate bin_prot lwt alcotest-lwt qcheck-core qcheck-alcotest) diff --git a/test/failure_detector_prop.ml b/test/failure_detector_prop.ml index a1632d1..9b91f19 100644 --- a/test/failure_detector_prop.ml +++ b/test/failure_detector_prop.ml @@ -2,7 +2,7 @@ open QCheck2.Gen open Pollinate.Peer open Pollinate -module SUT = Pollinate.Node.Failure_detector +module SUT = Pollinate.Node.Testing.Failure_detector let node_a = Lwt_main.run (Node.init Address.{ address = "127.0.0.1"; port = 3002 }) diff --git a/test/failure_detector_tests.ml b/test/failure_detector_tests.ml index 11c0b16..9d047c7 100644 --- a/test/failure_detector_tests.ml +++ b/test/failure_detector_tests.ml @@ -2,7 +2,7 @@ open Pollinate open Pollinate.Node open Lwt.Infix -module SUT = Pollinate.Node.Failure_detector +module SUT = Pollinate.Node.Testing.Failure_detector let node_a = Lwt_main.run (Node.init Address.{ address = "127.0.0.1"; port = 3003 }) diff --git a/test/networking_prop.ml b/test/networking_prop.ml new file mode 100644 index 0000000..8d45812 --- /dev/null +++ b/test/networking_prop.ml @@ -0,0 +1,34 @@ +open QCheck2.Gen +open Pollinate.Peer +open Pollinate + +module SUT = Pollinate.Node.Testing.Networking + +let node_a = + Lwt_main.run (Node.init Address.{ address = "127.0.0.1"; port = 2002 }) + +let knuth_shuffle_size = + QCheck2.Test.make ~count:1000 + ~name:"Knuth_shuffle does not change the size of the list" + (QCheck2.Gen.list Generators.peer_gen) (fun peers -> + List.length (SUT.Testing.knuth_shuffle peers) == List.length peers) + +let pick_random_neighbors = + QCheck2.Test.make ~count:1000 + ~name: + "pick_random_neighbors on a peer with a single neighbor, returns this \ + neighbors" (pair Generators.peer_gen Generators.peer_gen) + (fun (peer, neighbor) -> + let _ = add_neighbor peer neighbor in + let random_neighbor = + List.hd @@ SUT.pick_random_neighbors peer.neighbors 1 in + random_neighbor == neighbor.address) + +let () = + let networking_prop = + List.map QCheck_alcotest.to_alcotest + [ knuth_shuffle_size + ; pick_random_neighbors + ] in + Alcotest.run "Networking" + [("networking.ml", networking_prop)] From af34e78601f37e49e931bd544f07e5c1ccedef2a Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Wed, 1 Jun 2022 12:09:24 -0500 Subject: [PATCH 23/30] Removed broadcast request function from client --- lib/node/client.ml | 5 +---- lib/node/client.mli | 7 +------ 2 files changed, 2 insertions(+), 10 deletions(-) diff --git a/lib/node/client.ml b/lib/node/client.ml index 57aa85e..9bc1516 100644 --- a/lib/node/client.ml +++ b/lib/node/client.ml @@ -62,7 +62,4 @@ let request node request recipient = Lwt_condition.wait condition_var let post node message = - !node.disseminator <- Disseminator.post !node.disseminator message - -let broadcast_request node req recipients = - List.map (request node req) recipients + !node.disseminator <- Disseminator.post !node.disseminator message \ No newline at end of file diff --git a/lib/node/client.mli b/lib/node/client.mli index 5d60eb4..7022f78 100644 --- a/lib/node/client.mli +++ b/lib/node/client.mli @@ -32,9 +32,4 @@ function blocks the current thread of execution until a response arrives. *) val request : node ref -> bytes -> Address.t -> Message.t Lwt.t -(** Broadcasts a request containing the given payload to a list -of recipients and collects the responses in a list of [Message.t Lwt.t]. *) -val broadcast_request : - node ref -> bytes -> Address.t list -> Message.t Lwt.t list - -val create_post : node ref -> bytes -> Message.t +val create_post : node ref -> bytes -> Message.t \ No newline at end of file From 4db790e3cc7adeaa6daf248b94eaffdb1c75b7b2 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Wed, 1 Jun 2022 16:59:57 -0500 Subject: [PATCH 24/30] Working state: gossip tests occasionally hang --- test/gossip_tests.ml | 55 +++++++++++++++----------------------------- 1 file changed, 19 insertions(+), 36 deletions(-) diff --git a/test/gossip_tests.ml b/test/gossip_tests.ml index 41ca7a2..f4bdbf8 100644 --- a/test/gossip_tests.ml +++ b/test/gossip_tests.ml @@ -110,42 +110,25 @@ module Gossip_tests = struct let seen () = nodes |> List.filter (fun n -> Node.seen n message) |> node_ports in - (* let all_seen () = - seen () = node_ports nodes in *) - - (* Note: no matter what, we seem to wait n seconds here. - This shouldn't be happening. For some reason, I'm totally - unable to print log messages here as well. Really annoying. *) - (* let rec wait secs = - if secs < n && not (all_seen ()) then - let () = - seen () - |> List.map string_of_int - |> String.concat "; " - |> Printf.eprintf "SEEN: %s\n" in - let%lwt () = Lwt_unix.sleep 1. in - wait (secs +. 1.) - else - Lwt.return () in *) - - (* let%lwt () = wait 0. in *) - (* let secs = ref 1. in - let%lwt () = - while%lwt !secs < n && not (all_seen ()) do - secs := !secs +. 1.; - Lwt_unix.sleep 1. - done in *) - - (* let rounds = ref 0 in - - let%lwt () = - while%lwt !rounds < 7 && not (all_seen ()) do - rounds := !rounds + 1; - Lwt_unix.sleep 2. - done in *) - let%lwt () = Lwt_unix.sleep 0.2 in - - seen () |> Lwt.return + let%lwt () = + let%lwt oc = Lwt_io.open_file ~flags:[Unix.O_WRONLY; Unix.O_APPEND; Unix.O_CREAT] ~mode:Lwt_io.Output "/tmp/log.txt" in + let%lwt () = Lwt_io.write oc (Printf.sprintf "%f\n" (Unix.gettimeofday ())) in + Lwt_io.close oc in + let reg_seen = + let%lwt () = Lwt_unix.sleep 0.2 in + Lwt.return (seen ()) in + let f_seen = + let%lwt () = Lwt_unix.sleep 3. in + Lwt.return [] in + let%lwt res = Lwt.pick [ reg_seen ; f_seen ] in + let%lwt () = + let%lwt oc = + Lwt_io.open_file + ~flags:[Unix.O_WRONLY; Unix.O_APPEND; Unix.O_CREAT] + ~mode:Lwt_io.Output "/tmp/log.txt" in + let%lwt () = Lwt_io.write oc (Printf.sprintf "%d\n" (List.length res)) in + Lwt_io.close oc in + Lwt.return res end (** Test for dissemination given a specific node. *) From f343c36383411b16375fec65c37157a0bf74ba43 Mon Sep 17 00:00:00 2001 From: Gauthier SEBILLE Date: Thu, 2 Jun 2022 10:40:03 +0200 Subject: [PATCH 25/30] fix formatting --- lib/node/client.ml | 2 +- lib/node/client.mli | 2 +- lib/node/disseminator.ml | 3 ++- lib/node/failure_detector.ml | 5 +++-- lib/node/networking.ml | 2 +- lib/node/networking.mli | 5 +++-- lib/node/server.ml | 4 ++-- test/failure_detector_prop.ml | 24 +----------------------- test/failure_detector_tests.ml | 2 +- test/gossip_tests.ml | 10 +++++++--- test/networking_prop.ml | 7 ++----- 11 files changed, 24 insertions(+), 42 deletions(-) diff --git a/lib/node/client.ml b/lib/node/client.ml index 9bc1516..7bc8b9f 100644 --- a/lib/node/client.ml +++ b/lib/node/client.ml @@ -62,4 +62,4 @@ let request node request recipient = Lwt_condition.wait condition_var let post node message = - !node.disseminator <- Disseminator.post !node.disseminator message \ No newline at end of file + !node.disseminator <- Disseminator.post !node.disseminator message diff --git a/lib/node/client.mli b/lib/node/client.mli index 7022f78..f75fe74 100644 --- a/lib/node/client.mli +++ b/lib/node/client.mli @@ -32,4 +32,4 @@ function blocks the current thread of execution until a response arrives. *) val request : node ref -> bytes -> Address.t -> Message.t Lwt.t -val create_post : node ref -> bytes -> Message.t \ No newline at end of file +val create_post : node ref -> bytes -> Message.t diff --git a/lib/node/disseminator.ml b/lib/node/disseminator.ml index be635cc..9eb9152 100644 --- a/lib/node/disseminator.ml +++ b/lib/node/disseminator.ml @@ -60,6 +60,7 @@ let seen disseminator message = else false -let get_seen_messages disseminator = disseminator.seen |> DigestSet.to_seq |> List.of_seq +let get_seen_messages disseminator = + disseminator.seen |> DigestSet.to_seq |> List.of_seq let current_round { round; _ } = round diff --git a/lib/node/failure_detector.ml b/lib/node/failure_detector.ml index 72bc8f9..7866ae9 100644 --- a/lib/node/failure_detector.ml +++ b/lib/node/failure_detector.ml @@ -62,7 +62,7 @@ let create_message node message recipient = id = -1; timestamp = Unix.gettimeofday (); sender = Client.address_of !node; - recipients = [ recipient.Peer.address ]; + recipients = [recipient.Peer.address]; payload = Encoding.pack bin_writer_message message; } @@ -144,7 +144,8 @@ let suspicion_detection node = match List.length available_peers with | 0 -> Lwt.return () | _ -> - let random_peer = Networking.pick_random_neighbors !node.peers 1 |> List.hd in + let random_peer = + Networking.pick_random_neighbors !node.peers 1 |> List.hd in let _ = Lwt.join [ diff --git a/lib/node/networking.ml b/lib/node/networking.ml index 340e41d..86fdaf6 100644 --- a/lib/node/networking.ml +++ b/lib/node/networking.ml @@ -89,4 +89,4 @@ let disseminate node = module Testing = struct let knuth_shuffle = knuth_shuffle -end \ No newline at end of file +end diff --git a/lib/node/networking.mli b/lib/node/networking.mli index 3a98116..e818c96 100644 --- a/lib/node/networking.mli +++ b/lib/node/networking.mli @@ -15,8 +15,9 @@ val disseminate : node ref -> unit Lwt.t (** Given a Base.Hashtbl of Addresses to Peers and a number n of peers to be randomly chosen, returns a list of addresses corresponding to n *) -val pick_random_neighbors : (Address.t, Peer.t) Base.Hashtbl.t -> int -> Address.t list +val pick_random_neighbors : + (Address.t, Peer.t) Base.Hashtbl.t -> int -> Address.t list module Testing : sig val knuth_shuffle : 'a list -> 'a list -end \ No newline at end of file +end diff --git a/lib/node/server.ml b/lib/node/server.ml index a85713f..e74eedb 100644 --- a/lib/node/server.ml +++ b/lib/node/server.ml @@ -81,8 +81,8 @@ let print_logs node = let%lwt () = log node (Printf.sprintf "Seen: %s\n" - (Disseminator.get_seen_messages !node.disseminator |> String.concat " ; ")) - in + (Disseminator.get_seen_messages !node.disseminator + |> String.concat " ; ")) in (* Check who the current peers of the node are *) let%lwt () = !node.peers diff --git a/test/failure_detector_prop.ml b/test/failure_detector_prop.ml index 9b91f19..38f3c42 100644 --- a/test/failure_detector_prop.ml +++ b/test/failure_detector_prop.ml @@ -1,18 +1,11 @@ open QCheck2.Gen open Pollinate.Peer open Pollinate - module SUT = Pollinate.Node.Testing.Failure_detector let node_a = Lwt_main.run (Node.init Address.{ address = "127.0.0.1"; port = 3002 }) -(* let knuth_shuffle_size = - QCheck2.Test.make ~count:1000 - ~name:"Knuth_shuffle does not change the size of the list" - (QCheck2.Gen.list Generators.peer_gen) (fun peers -> - List.length (SUT.knuth_shuffle peers) == List.length peers) *) - let update_peer = QCheck2.Test.make ~count:1000 ~name:"update_neighbor_status successfully update neighbor status" @@ -22,23 +15,8 @@ let update_peer = let _ = SUT.update_peer_status node_a neighbor neighbor_status in neighbor.status = neighbor_status) -(* let pick_random_neighbors = - QCheck2.Test.make ~count:1000 - ~name: - "pick_random_neighbors on a peer with a single neighbor, returns this \ - neighbors" (pair Generators.peer_gen Generators.peer_gen) - (fun (peer, neighbor) -> - let _ = add_neighbor peer neighbor in - let random_neighbor = - List.hd @@ SUT.pick_random_neighbors peer.neighbors 1 in - random_neighbor == neighbor.address) *) - let () = let failure_detector_prop = - List.map QCheck_alcotest.to_alcotest - [ update_peer - (* ; knuth_shuffle_size - ; pick_random_neighbors *) - ] in + List.map QCheck_alcotest.to_alcotest [update_peer] in Alcotest.run "Failure detector" [("failure_detector.ml", failure_detector_prop)] diff --git a/test/failure_detector_tests.ml b/test/failure_detector_tests.ml index 9d047c7..9747cf7 100644 --- a/test/failure_detector_tests.ml +++ b/test/failure_detector_tests.ml @@ -1,11 +1,11 @@ open Pollinate open Pollinate.Node open Lwt.Infix - module SUT = Pollinate.Node.Testing.Failure_detector let node_a = Lwt_main.run (Node.init Address.{ address = "127.0.0.1"; port = 3003 }) + let node_b = Lwt_main.run (Node.init Address.{ address = "127.0.0.1"; port = 3004 }) diff --git a/test/gossip_tests.ml b/test/gossip_tests.ml index f4bdbf8..166a2d9 100644 --- a/test/gossip_tests.ml +++ b/test/gossip_tests.ml @@ -111,8 +111,12 @@ module Gossip_tests = struct nodes |> List.filter (fun n -> Node.seen n message) |> node_ports in let%lwt () = - let%lwt oc = Lwt_io.open_file ~flags:[Unix.O_WRONLY; Unix.O_APPEND; Unix.O_CREAT] ~mode:Lwt_io.Output "/tmp/log.txt" in - let%lwt () = Lwt_io.write oc (Printf.sprintf "%f\n" (Unix.gettimeofday ())) in + let%lwt oc = + Lwt_io.open_file + ~flags:[Unix.O_WRONLY; Unix.O_APPEND; Unix.O_CREAT] + ~mode:Lwt_io.Output "/tmp/log.txt" in + let%lwt () = + Lwt_io.write oc (Printf.sprintf "%f\n" (Unix.gettimeofday ())) in Lwt_io.close oc in let reg_seen = let%lwt () = Lwt_unix.sleep 0.2 in @@ -120,7 +124,7 @@ module Gossip_tests = struct let f_seen = let%lwt () = Lwt_unix.sleep 3. in Lwt.return [] in - let%lwt res = Lwt.pick [ reg_seen ; f_seen ] in + let%lwt res = Lwt.pick [reg_seen; f_seen] in let%lwt () = let%lwt oc = Lwt_io.open_file diff --git a/test/networking_prop.ml b/test/networking_prop.ml index 8d45812..863a9ef 100644 --- a/test/networking_prop.ml +++ b/test/networking_prop.ml @@ -27,8 +27,5 @@ let pick_random_neighbors = let () = let networking_prop = List.map QCheck_alcotest.to_alcotest - [ knuth_shuffle_size - ; pick_random_neighbors - ] in - Alcotest.run "Networking" - [("networking.ml", networking_prop)] + [knuth_shuffle_size; pick_random_neighbors] in + Alcotest.run "Networking" [("networking.ml", networking_prop)] From 2d970ba94f9f44619435acc7281108d82314dbd0 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Thu, 2 Jun 2022 11:16:28 -0500 Subject: [PATCH 26/30] Make failure detector tests slow --- test/failure_detector_tests.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/failure_detector_tests.ml b/test/failure_detector_tests.ml index 9747cf7..0de5df7 100644 --- a/test/failure_detector_tests.ml +++ b/test/failure_detector_tests.ml @@ -41,9 +41,9 @@ let () = [ ( "failure_detector.ml", [ - Alcotest_lwt.test_case "Remove Suspicious peer" `Quick + Alcotest_lwt.test_case "Remove Suspicious peer" `Slow test_suspicion_detection; - Alcotest_lwt.test_case "Do nothing on Alive peer" `Quick + Alcotest_lwt.test_case "Do nothing on Alive peer" `Slow test_failure_detection_nothing_on_alive; ] ); ] From 01426c103e3f1fdcdc0eda8090bad9487972063c Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Thu, 2 Jun 2022 13:58:36 -0500 Subject: [PATCH 27/30] Remove logging and simplify gossip tests --- lib/node/networking.ml | 17 ++++++++-------- lib/node/server.ml | 45 +++++++++++++++++++++--------------------- test/gossip_tests.ml | 44 ++++++++++++++++++++--------------------- 3 files changed, 53 insertions(+), 53 deletions(-) diff --git a/lib/node/networking.ml b/lib/node/networking.ml index 86fdaf6..7937b2d 100644 --- a/lib/node/networking.ml +++ b/lib/node/networking.ml @@ -1,4 +1,3 @@ -open Util open Common open Common.Util open Types @@ -6,7 +5,7 @@ open Lwt_unix let send_to node message = let open Message in - let%lwt () = log node "Sending message\n" in + (* let%lwt () = log node "Sending message\n" in *) let payload = Encoding.pack Message.bin_writer_t message in let len = Bytes.length payload in let addrs = List.map Address.to_sockaddr message.recipients in @@ -64,13 +63,13 @@ let pick_random_neighbors neighbors number_of_neighbors = (** Injects the list of recipients into the message and sends it to each recipient with a log message. *) let broadcast node message (recipients : Address.t list) = - let%lwt () = - recipients - |> List.map (fun Address.{ port; _ } -> string_of_int port) - |> String.concat " ; " - |> Printf.sprintf "Disseminating post %s from author %d to peers: [%s]\n" - (Message.hash_of message) message.sender.port - |> log node in + (* let%lwt () = + recipients + |> List.map (fun Address.{ port; _ } -> string_of_int port) + |> String.concat " ; " + |> Printf.sprintf "Disseminating post %s from author %d to peers: [%s]\n" + (Message.hash_of message) message.sender.port + |> log node in *) let message = Message.{ message with recipients } in let%lwt () = send_to node message in Lwt.return () diff --git a/lib/node/server.ml b/lib/node/server.ml index e74eedb..b94b637 100644 --- a/lib/node/server.ml +++ b/lib/node/server.ml @@ -30,19 +30,19 @@ let process_message node preprocessor msg_handler = let open Message in let%lwt message = Networking.recv_next node in let message = preprocessor message in - let%lwt () = - log node - (Printf.sprintf "Processing message %s from %d...\n" - (Message.hash_of message) message.sender.port) in + (* let%lwt () = + log node + (Printf.sprintf "Processing message %s from %d...\n" + (Message.hash_of message) message.sender.port) in *) let%lwt () = match message.category with | Response -> Lwt.return (handle_response node message) | Request -> ( - let%lwt () = - log node - (Printf.sprintf "%s:%d : Processing request from %s:%d\n" - !node.address.address !node.address.port message.sender.address - message.sender.port) in + (* let%lwt () = + log node + (Printf.sprintf "%s:%d : Processing request from %s:%d\n" + !node.address.address !node.address.port message.sender.address + message.sender.port) in *) match msg_handler message with | Some response -> response @@ -52,21 +52,22 @@ let process_message node preprocessor msg_handler = | Failure_detection -> Failure_detector.handle_message node message | Post -> if not (Disseminator.seen !node.disseminator message) then ( - let%lwt () = - log node - (Printf.sprintf "%s:%d : Processing post %s from %s:%d\n" - !node.address.address !node.address.port - (Message.hash_of message) message.sender.address - message.sender.port) in + (* let%lwt () = + log node + (Printf.sprintf "%s:%d : Processing post %s from %s:%d\n" + !node.address.address !node.address.port + (Message.hash_of message) message.sender.address + message.sender.port) in *) let _ = msg_handler message in - let%lwt () = log node "Adding message to broadcast queue\n" in + (* let%lwt () = log node "Adding message to broadcast queue\n" in *) Client.post node message; Lwt.return ()) else - log node - (Printf.sprintf "Got post %s from %s:%d but saw it already\n" - (Message.hash_of message) message.sender.address - message.sender.port) + (* log node + (Printf.sprintf "Got post %s from %s:%d but saw it already\n" + (Message.hash_of message) message.sender.address + message.sender.port) *) + Lwt.return () | _ -> let _ = msg_handler message in Lwt.return () in @@ -74,7 +75,7 @@ let process_message node preprocessor msg_handler = (** Log some initial information at the beginning of a server iteration. See comments for descriptions regarding what is actually being logged. *) -let print_logs node = +let _print_logs node = (* Check that the server is in fact running *) let%lwt () = log node "Running server\n" in (* Check which posts the node has seen so far *) @@ -113,7 +114,7 @@ let print_logs node = 4. Wait 0.001 seconds before restarting the procedure. *) let rec run node preprocessor msg_handler = (* Step 0 *) - let%lwt () = print_logs node in + (* let%lwt () = print_logs node in *) (* Step 1 *) let _ = process_message node preprocessor msg_handler in (* Step 2 *) diff --git a/test/gossip_tests.ml b/test/gossip_tests.ml index 166a2d9..f3dc24f 100644 --- a/test/gossip_tests.ml +++ b/test/gossip_tests.ml @@ -89,55 +89,55 @@ module Gossip_tests = struct nodes (** Starts the server for each node and constructs a Post message - whose author is the specified node, then disseminates it. Checks - every 2 seconds to see if all nodes have received the disseminated - message. The 2 second wait occurs n times before timing out and returning - the ports of the nodes who saw the message. *) - let disseminate_from _n node = + whose author is the specified node, then disseminates it. Waits + 0.2 seconds for the message to disseminate fully across + the network. *) + let disseminate_from node = + (* Start the server for each node in a thread *) let _ = List.map (Node.run_server ~preprocessor:Commons.preprocessor ~msg_handler:Commons.msg_handler) nodes in + + (* Create the message to be posted by node *) let message = Client.address_of !node |> (fun Address.{ port; _ } -> port) |> string_of_int |> String.to_bytes |> Client.create_post node in + + (* Post the created message *) Client.post node message; + (* Function to generate a list of all the nodes who have witnessed + the post. *) let seen () = nodes |> List.filter (fun n -> Node.seen n message) |> node_ports in + (* Wait 0.2 seconds for the message to spread. *) + let%lwt () = Lwt_unix.sleep 0.2 in + + (* Compute the list of nodes who have seen the post. *) + let list_of_seen = seen () in + + (* Write the length of list_of_seen to a tmp log file *) let%lwt () = let%lwt oc = Lwt_io.open_file ~flags:[Unix.O_WRONLY; Unix.O_APPEND; Unix.O_CREAT] ~mode:Lwt_io.Output "/tmp/log.txt" in let%lwt () = - Lwt_io.write oc (Printf.sprintf "%f\n" (Unix.gettimeofday ())) in - Lwt_io.close oc in - let reg_seen = - let%lwt () = Lwt_unix.sleep 0.2 in - Lwt.return (seen ()) in - let f_seen = - let%lwt () = Lwt_unix.sleep 3. in - Lwt.return [] in - let%lwt res = Lwt.pick [reg_seen; f_seen] in - let%lwt () = - let%lwt oc = - Lwt_io.open_file - ~flags:[Unix.O_WRONLY; Unix.O_APPEND; Unix.O_CREAT] - ~mode:Lwt_io.Output "/tmp/log.txt" in - let%lwt () = Lwt_io.write oc (Printf.sprintf "%d\n" (List.length res)) in + Lwt_io.write oc (Printf.sprintf "%d\n" (List.length list_of_seen)) in Lwt_io.close oc in - Lwt.return res + (* End of logging code *) + Lwt.return list_of_seen end (** Test for dissemination given a specific node. *) let test_disseminate_from node _ () = - Gossip_tests.disseminate_from 15. node + Gossip_tests.disseminate_from node >|= Alcotest.(check (list int)) (Printf.sprintf "All nodes have seen the message %d" !node.address.port) Gossip_tests.(node_ports nodes) From 897163543d991a91d3782dea31fd7411bf45bd47 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 3 Jun 2022 13:31:49 -0500 Subject: [PATCH 28/30] Remove unnecessary commented out tests --- test/disseminator_tests.ml | 22 +--------------------- 1 file changed, 1 insertion(+), 21 deletions(-) diff --git a/test/disseminator_tests.ml b/test/disseminator_tests.ml index b865de7..8b23ee2 100644 --- a/test/disseminator_tests.ml +++ b/test/disseminator_tests.ml @@ -80,26 +80,6 @@ let () = test_queue_insertion; Alcotest_lwt.test_case "Messages that are posted are immediately seen" `Quick - test_seen_message - (* Alcotest_lwt.test_case "Dissemination from A" `Quick - (test_disseminate_from Gossip_tests.node_a); *) - (* Alcotest_lwt.test_case "Dissemination from B" `Quick - (test_disseminate_from Gossip_tests.node_b); - Alcotest_lwt.test_case "Dissemination from C" `Quick - (test_disseminate_from Gossip_tests.node_c); - Alcotest_lwt.test_case "Dissemination from D" `Quick - (test_disseminate_from Gossip_tests.node_d); *) - (* Alcotest_lwt.test_case "Dissemination from E" `Quick - (test_disseminate_from Gossip_tests.node_e); *) - (* Alcotest_lwt.test_case "Dissemination from F" `Quick - (test_disseminate_from Gossip_tests.node_f); *) - (* Alcotest_lwt.test_case "Dissemination from G" `Quick - (test_disseminate_from Gossip_tests.node_g); *) - (* Alcotest_lwt.test_case "Dissemination from H" `Quick - (test_disseminate_from Gossip_tests.node_h); *) - (* Alcotest_lwt.test_case "Dissemination from I" `Quick - (test_disseminate_from Gossip_tests.node_i); *) - (* Alcotest_lwt.test_case "Dissemination from J" `Quick - (test_disseminate_from Gossip_tests.node_j); ;*); + test_seen_message; ] ); ] From a9866a32ff4065975cb2cde2f7aa971d0d518ca2 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Mon, 6 Jun 2022 13:35:52 -0500 Subject: [PATCH 29/30] Add documentation for Client.create_post --- lib/node/client.mli | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/node/client.mli b/lib/node/client.mli index f75fe74..f08e853 100644 --- a/lib/node/client.mli +++ b/lib/node/client.mli @@ -14,8 +14,8 @@ val peer_from : node -> Peer.t (** Add a peer to the known peers. *) val add_peer : node -> Peer.t -> [`Duplicate | `Ok] -(** Begins disseminating an encoded message meant to be witnessed by as many - nodes in the network as possible. *) +(** Begins disseminating an encoded message meant to be witnessed by the + entire network. *) val post : node ref -> Message.t -> unit (** [create_request node recipient payload] creates a [Message.t] of the {i Request category} @@ -32,4 +32,7 @@ function blocks the current thread of execution until a response arrives. *) val request : node ref -> bytes -> Address.t -> Message.t Lwt.t +(** [create_post node payload] creates a [Message.t] of the {i Post category} + containing {i payload} for eventual gossip dissemination across the + entire network. *) val create_post : node ref -> bytes -> Message.t From 0906408e186f3e766b3fdc8f71f09e2aad3d3b55 Mon Sep 17 00:00:00 2001 From: Ambika Eshwar Date: Fri, 10 Jun 2022 16:32:59 -0500 Subject: [PATCH 30/30] Move background processes to an Lwt.async context --- lib/node/node.ml | 1 + lib/node/server.ml | 26 +++++++++----------------- lib/node/server.mli | 2 ++ 3 files changed, 12 insertions(+), 17 deletions(-) diff --git a/lib/node/node.ml b/lib/node/node.ml index 5d37d14..c2367ba 100644 --- a/lib/node/node.ml +++ b/lib/node/node.ml @@ -36,6 +36,7 @@ let init ?(init_peers = []) Address.{ address; port } = Lwt.return node let run_server ?(preprocessor = fun m -> m) ~msg_handler node = + Server.run_background_processes node ~period:0.001; Server.run node preprocessor msg_handler let seen node message = Disseminator.seen !node.disseminator message diff --git a/lib/node/server.ml b/lib/node/server.ml index b94b637..d7fa702 100644 --- a/lib/node/server.ml +++ b/lib/node/server.ml @@ -105,22 +105,14 @@ let _print_logs node = else Lwt.return () -(* Sever procedure: - 0. Log pertinent information about the current node. - 1. Start a new thread for handling any incoming message. - 2. Run the failure detector. - 3. Run the disseminator, this includes actually sending messages to be - disseminated across the network. - 4. Wait 0.001 seconds before restarting the procedure. *) +let run_background_processes node ~period = + let rec run_recursively () = + let%lwt () = Failure_detector.failure_detection node in + let%lwt () = Networking.disseminate node in + let%lwt () = Lwt_unix.sleep period in + run_recursively () in + Lwt.async run_recursively + let rec run node preprocessor msg_handler = - (* Step 0 *) - (* let%lwt () = print_logs node in *) - (* Step 1 *) - let _ = process_message node preprocessor msg_handler in - (* Step 2 *) - let%lwt () = Failure_detector.failure_detection node in - (* Step 3 *) - let%lwt () = Networking.disseminate node in - (* Step 4 *) - let%lwt () = Lwt_unix.sleep 0.001 in + let%lwt () = process_message node preprocessor msg_handler in run node preprocessor msg_handler diff --git a/lib/node/server.mli b/lib/node/server.mli index 2cfa48c..236aadf 100644 --- a/lib/node/server.mli +++ b/lib/node/server.mli @@ -6,3 +6,5 @@ val run : (Message.t -> Message.t) -> (Message.t -> bytes option) -> 'b Lwt.t + +val run_background_processes : Types.node ref -> period:float -> unit