├── .gitignore ├── .travis.yml ├── LICENSE ├── README.rst ├── Setup.hs ├── bin ├── Control │ └── Concurrent │ │ └── UnreliableChan.hs ├── synod.hs └── tests.hs ├── paxos.cabal └── src ├── Data └── Serialize │ └── QuickCheck.hs └── Network └── Paxos ├── Synod.hs └── Synod ├── Acceptor.hs ├── Action.hs ├── Learner.hs ├── Messages.hs ├── Proposer.hs └── Types.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | cabal-dev/ 3 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: haskell 2 | script: 3 | - cabal configure --enable-tests 4 | - cabal build 5 | - cabal test --show-details=always 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 2.1, February 1999 3 | 4 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | [This is the first released version of the Lesser GPL. It also counts 10 | as the successor of the GNU Library Public License, version 2, hence 11 | the version number 2.1.] 12 | 13 | Preamble 14 | 15 | The licenses for most software are designed to take away your 16 | freedom to share and change it. By contrast, the GNU General Public 17 | Licenses are intended to guarantee your freedom to share and change 18 | free software--to make sure the software is free for all its users. 19 | 20 | This license, the Lesser General Public License, applies to some 21 | specially designated software packages--typically libraries--of the 22 | Free Software Foundation and other authors who decide to use it. You 23 | can use it too, but we suggest you first think carefully about whether 24 | this license or the ordinary General Public License is the better 25 | strategy to use in any particular case, based on the explanations below. 26 | 27 | When we speak of free software, we are referring to freedom of use, 28 | not price. Our General Public Licenses are designed to make sure that 29 | you have the freedom to distribute copies of free software (and charge 30 | for this service if you wish); that you receive source code or can get 31 | it if you want it; that you can change the software and use pieces of 32 | it in new free programs; and that you are informed that you can do 33 | these things. 34 | 35 | To protect your rights, we need to make restrictions that forbid 36 | distributors to deny you these rights or to ask you to surrender these 37 | rights. These restrictions translate to certain responsibilities for 38 | you if you distribute copies of the library or if you modify it. 39 | 40 | For example, if you distribute copies of the library, whether gratis 41 | or for a fee, you must give the recipients all the rights that we gave 42 | you. You must make sure that they, too, receive or can get the source 43 | code. If you link other code with the library, you must provide 44 | complete object files to the recipients, so that they can relink them 45 | with the library after making changes to the library and recompiling 46 | it. And you must show them these terms so they know their rights. 47 | 48 | We protect your rights with a two-step method: (1) we copyright the 49 | library, and (2) we offer you this license, which gives you legal 50 | permission to copy, distribute and/or modify the library. 51 | 52 | To protect each distributor, we want to make it very clear that 53 | there is no warranty for the free library. Also, if the library is 54 | modified by someone else and passed on, the recipients should know 55 | that what they have is not the original version, so that the original 56 | author's reputation will not be affected by problems that might be 57 | introduced by others. 58 | 59 | Finally, software patents pose a constant threat to the existence of 60 | any free program. We wish to make sure that a company cannot 61 | effectively restrict the users of a free program by obtaining a 62 | restrictive license from a patent holder. Therefore, we insist that 63 | any patent license obtained for a version of the library must be 64 | consistent with the full freedom of use specified in this license. 65 | 66 | Most GNU software, including some libraries, is covered by the 67 | ordinary GNU General Public License. This license, the GNU Lesser 68 | General Public License, applies to certain designated libraries, and 69 | is quite different from the ordinary General Public License. We use 70 | this license for certain libraries in order to permit linking those 71 | libraries into non-free programs. 72 | 73 | When a program is linked with a library, whether statically or using 74 | a shared library, the combination of the two is legally speaking a 75 | combined work, a derivative of the original library. The ordinary 76 | General Public License therefore permits such linking only if the 77 | entire combination fits its criteria of freedom. The Lesser General 78 | Public License permits more lax criteria for linking other code with 79 | the library. 80 | 81 | We call this license the "Lesser" General Public License because it 82 | does Less to protect the user's freedom than the ordinary General 83 | Public License. It also provides other free software developers Less 84 | of an advantage over competing non-free programs. These disadvantages 85 | are the reason we use the ordinary General Public License for many 86 | libraries. However, the Lesser license provides advantages in certain 87 | special circumstances. 88 | 89 | For example, on rare occasions, there may be a special need to 90 | encourage the widest possible use of a certain library, so that it becomes 91 | a de-facto standard. To achieve this, non-free programs must be 92 | allowed to use the library. A more frequent case is that a free 93 | library does the same job as widely used non-free libraries. In this 94 | case, there is little to gain by limiting the free library to free 95 | software only, so we use the Lesser General Public License. 96 | 97 | In other cases, permission to use a particular library in non-free 98 | programs enables a greater number of people to use a large body of 99 | free software. For example, permission to use the GNU C Library in 100 | non-free programs enables many more people to use the whole GNU 101 | operating system, as well as its variant, the GNU/Linux operating 102 | system. 103 | 104 | Although the Lesser General Public License is Less protective of the 105 | users' freedom, it does ensure that the user of a program that is 106 | linked with the Library has the freedom and the wherewithal to run 107 | that program using a modified version of the Library. 108 | 109 | The precise terms and conditions for copying, distribution and 110 | modification follow. Pay close attention to the difference between a 111 | "work based on the library" and a "work that uses the library". The 112 | former contains code derived from the library, whereas the latter must 113 | be combined with the library in order to run. 114 | 115 | GNU LESSER GENERAL PUBLIC LICENSE 116 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 117 | 118 | 0. This License Agreement applies to any software library or other 119 | program which contains a notice placed by the copyright holder or 120 | other authorized party saying it may be distributed under the terms of 121 | this Lesser General Public License (also called "this License"). 122 | Each licensee is addressed as "you". 123 | 124 | A "library" means a collection of software functions and/or data 125 | prepared so as to be conveniently linked with application programs 126 | (which use some of those functions and data) to form executables. 127 | 128 | The "Library", below, refers to any such software library or work 129 | which has been distributed under these terms. A "work based on the 130 | Library" means either the Library or any derivative work under 131 | copyright law: that is to say, a work containing the Library or a 132 | portion of it, either verbatim or with modifications and/or translated 133 | straightforwardly into another language. (Hereinafter, translation is 134 | included without limitation in the term "modification".) 135 | 136 | "Source code" for a work means the preferred form of the work for 137 | making modifications to it. For a library, complete source code means 138 | all the source code for all modules it contains, plus any associated 139 | interface definition files, plus the scripts used to control compilation 140 | and installation of the library. 141 | 142 | Activities other than copying, distribution and modification are not 143 | covered by this License; they are outside its scope. The act of 144 | running a program using the Library is not restricted, and output from 145 | such a program is covered only if its contents constitute a work based 146 | on the Library (independent of the use of the Library in a tool for 147 | writing it). Whether that is true depends on what the Library does 148 | and what the program that uses the Library does. 149 | 150 | 1. You may copy and distribute verbatim copies of the Library's 151 | complete source code as you receive it, in any medium, provided that 152 | you conspicuously and appropriately publish on each copy an 153 | appropriate copyright notice and disclaimer of warranty; keep intact 154 | all the notices that refer to this License and to the absence of any 155 | warranty; and distribute a copy of this License along with the 156 | Library. 157 | 158 | You may charge a fee for the physical act of transferring a copy, 159 | and you may at your option offer warranty protection in exchange for a 160 | fee. 161 | 162 | 2. You may modify your copy or copies of the Library or any portion 163 | of it, thus forming a work based on the Library, and copy and 164 | distribute such modifications or work under the terms of Section 1 165 | above, provided that you also meet all of these conditions: 166 | 167 | a) The modified work must itself be a software library. 168 | 169 | b) You must cause the files modified to carry prominent notices 170 | stating that you changed the files and the date of any change. 171 | 172 | c) You must cause the whole of the work to be licensed at no 173 | charge to all third parties under the terms of this License. 174 | 175 | d) If a facility in the modified Library refers to a function or a 176 | table of data to be supplied by an application program that uses 177 | the facility, other than as an argument passed when the facility 178 | is invoked, then you must make a good faith effort to ensure that, 179 | in the event an application does not supply such function or 180 | table, the facility still operates, and performs whatever part of 181 | its purpose remains meaningful. 182 | 183 | (For example, a function in a library to compute square roots has 184 | a purpose that is entirely well-defined independent of the 185 | application. Therefore, Subsection 2d requires that any 186 | application-supplied function or table used by this function must 187 | be optional: if the application does not supply it, the square 188 | root function must still compute square roots.) 189 | 190 | These requirements apply to the modified work as a whole. If 191 | identifiable sections of that work are not derived from the Library, 192 | and can be reasonably considered independent and separate works in 193 | themselves, then this License, and its terms, do not apply to those 194 | sections when you distribute them as separate works. But when you 195 | distribute the same sections as part of a whole which is a work based 196 | on the Library, the distribution of the whole must be on the terms of 197 | this License, whose permissions for other licensees extend to the 198 | entire whole, and thus to each and every part regardless of who wrote 199 | it. 200 | 201 | Thus, it is not the intent of this section to claim rights or contest 202 | your rights to work written entirely by you; rather, the intent is to 203 | exercise the right to control the distribution of derivative or 204 | collective works based on the Library. 205 | 206 | In addition, mere aggregation of another work not based on the Library 207 | with the Library (or with a work based on the Library) on a volume of 208 | a storage or distribution medium does not bring the other work under 209 | the scope of this License. 210 | 211 | 3. You may opt to apply the terms of the ordinary GNU General Public 212 | License instead of this License to a given copy of the Library. To do 213 | this, you must alter all the notices that refer to this License, so 214 | that they refer to the ordinary GNU General Public License, version 2, 215 | instead of to this License. (If a newer version than version 2 of the 216 | ordinary GNU General Public License has appeared, then you can specify 217 | that version instead if you wish.) Do not make any other change in 218 | these notices. 219 | 220 | Once this change is made in a given copy, it is irreversible for 221 | that copy, so the ordinary GNU General Public License applies to all 222 | subsequent copies and derivative works made from that copy. 223 | 224 | This option is useful when you wish to copy part of the code of 225 | the Library into a program that is not a library. 226 | 227 | 4. You may copy and distribute the Library (or a portion or 228 | derivative of it, under Section 2) in object code or executable form 229 | under the terms of Sections 1 and 2 above provided that you accompany 230 | it with the complete corresponding machine-readable source code, which 231 | must be distributed under the terms of Sections 1 and 2 above on a 232 | medium customarily used for software interchange. 233 | 234 | If distribution of object code is made by offering access to copy 235 | from a designated place, then offering equivalent access to copy the 236 | source code from the same place satisfies the requirement to 237 | distribute the source code, even though third parties are not 238 | compelled to copy the source along with the object code. 239 | 240 | 5. A program that contains no derivative of any portion of the 241 | Library, but is designed to work with the Library by being compiled or 242 | linked with it, is called a "work that uses the Library". Such a 243 | work, in isolation, is not a derivative work of the Library, and 244 | therefore falls outside the scope of this License. 245 | 246 | However, linking a "work that uses the Library" with the Library 247 | creates an executable that is a derivative of the Library (because it 248 | contains portions of the Library), rather than a "work that uses the 249 | library". The executable is therefore covered by this License. 250 | Section 6 states terms for distribution of such executables. 251 | 252 | When a "work that uses the Library" uses material from a header file 253 | that is part of the Library, the object code for the work may be a 254 | derivative work of the Library even though the source code is not. 255 | Whether this is true is especially significant if the work can be 256 | linked without the Library, or if the work is itself a library. The 257 | threshold for this to be true is not precisely defined by law. 258 | 259 | If such an object file uses only numerical parameters, data 260 | structure layouts and accessors, and small macros and small inline 261 | functions (ten lines or less in length), then the use of the object 262 | file is unrestricted, regardless of whether it is legally a derivative 263 | work. (Executables containing this object code plus portions of the 264 | Library will still fall under Section 6.) 265 | 266 | Otherwise, if the work is a derivative of the Library, you may 267 | distribute the object code for the work under the terms of Section 6. 268 | Any executables containing that work also fall under Section 6, 269 | whether or not they are linked directly with the Library itself. 270 | 271 | 6. As an exception to the Sections above, you may also combine or 272 | link a "work that uses the Library" with the Library to produce a 273 | work containing portions of the Library, and distribute that work 274 | under terms of your choice, provided that the terms permit 275 | modification of the work for the customer's own use and reverse 276 | engineering for debugging such modifications. 277 | 278 | You must give prominent notice with each copy of the work that the 279 | Library is used in it and that the Library and its use are covered by 280 | this License. You must supply a copy of this License. If the work 281 | during execution displays copyright notices, you must include the 282 | copyright notice for the Library among them, as well as a reference 283 | directing the user to the copy of this License. Also, you must do one 284 | of these things: 285 | 286 | a) Accompany the work with the complete corresponding 287 | machine-readable source code for the Library including whatever 288 | changes were used in the work (which must be distributed under 289 | Sections 1 and 2 above); and, if the work is an executable linked 290 | with the Library, with the complete machine-readable "work that 291 | uses the Library", as object code and/or source code, so that the 292 | user can modify the Library and then relink to produce a modified 293 | executable containing the modified Library. (It is understood 294 | that the user who changes the contents of definitions files in the 295 | Library will not necessarily be able to recompile the application 296 | to use the modified definitions.) 297 | 298 | b) Use a suitable shared library mechanism for linking with the 299 | Library. A suitable mechanism is one that (1) uses at run time a 300 | copy of the library already present on the user's computer system, 301 | rather than copying library functions into the executable, and (2) 302 | will operate properly with a modified version of the library, if 303 | the user installs one, as long as the modified version is 304 | interface-compatible with the version that the work was made with. 305 | 306 | c) Accompany the work with a written offer, valid for at 307 | least three years, to give the same user the materials 308 | specified in Subsection 6a, above, for a charge no more 309 | than the cost of performing this distribution. 310 | 311 | d) If distribution of the work is made by offering access to copy 312 | from a designated place, offer equivalent access to copy the above 313 | specified materials from the same place. 314 | 315 | e) Verify that the user has already received a copy of these 316 | materials or that you have already sent this user a copy. 317 | 318 | For an executable, the required form of the "work that uses the 319 | Library" must include any data and utility programs needed for 320 | reproducing the executable from it. However, as a special exception, 321 | the materials to be distributed need not include anything that is 322 | normally distributed (in either source or binary form) with the major 323 | components (compiler, kernel, and so on) of the operating system on 324 | which the executable runs, unless that component itself accompanies 325 | the executable. 326 | 327 | It may happen that this requirement contradicts the license 328 | restrictions of other proprietary libraries that do not normally 329 | accompany the operating system. Such a contradiction means you cannot 330 | use both them and the Library together in an executable that you 331 | distribute. 332 | 333 | 7. You may place library facilities that are a work based on the 334 | Library side-by-side in a single library together with other library 335 | facilities not covered by this License, and distribute such a combined 336 | library, provided that the separate distribution of the work based on 337 | the Library and of the other library facilities is otherwise 338 | permitted, and provided that you do these two things: 339 | 340 | a) Accompany the combined library with a copy of the same work 341 | based on the Library, uncombined with any other library 342 | facilities. This must be distributed under the terms of the 343 | Sections above. 344 | 345 | b) Give prominent notice with the combined library of the fact 346 | that part of it is a work based on the Library, and explaining 347 | where to find the accompanying uncombined form of the same work. 348 | 349 | 8. You may not copy, modify, sublicense, link with, or distribute 350 | the Library except as expressly provided under this License. Any 351 | attempt otherwise to copy, modify, sublicense, link with, or 352 | distribute the Library is void, and will automatically terminate your 353 | rights under this License. However, parties who have received copies, 354 | or rights, from you under this License will not have their licenses 355 | terminated so long as such parties remain in full compliance. 356 | 357 | 9. You are not required to accept this License, since you have not 358 | signed it. However, nothing else grants you permission to modify or 359 | distribute the Library or its derivative works. These actions are 360 | prohibited by law if you do not accept this License. Therefore, by 361 | modifying or distributing the Library (or any work based on the 362 | Library), you indicate your acceptance of this License to do so, and 363 | all its terms and conditions for copying, distributing or modifying 364 | the Library or works based on it. 365 | 366 | 10. Each time you redistribute the Library (or any work based on the 367 | Library), the recipient automatically receives a license from the 368 | original licensor to copy, distribute, link with or modify the Library 369 | subject to these terms and conditions. You may not impose any further 370 | restrictions on the recipients' exercise of the rights granted herein. 371 | You are not responsible for enforcing compliance by third parties with 372 | this License. 373 | 374 | 11. If, as a consequence of a court judgment or allegation of patent 375 | infringement or for any other reason (not limited to patent issues), 376 | conditions are imposed on you (whether by court order, agreement or 377 | otherwise) that contradict the conditions of this License, they do not 378 | excuse you from the conditions of this License. If you cannot 379 | distribute so as to satisfy simultaneously your obligations under this 380 | License and any other pertinent obligations, then as a consequence you 381 | may not distribute the Library at all. For example, if a patent 382 | license would not permit royalty-free redistribution of the Library by 383 | all those who receive copies directly or indirectly through you, then 384 | the only way you could satisfy both it and this License would be to 385 | refrain entirely from distribution of the Library. 386 | 387 | If any portion of this section is held invalid or unenforceable under any 388 | particular circumstance, the balance of the section is intended to apply, 389 | and the section as a whole is intended to apply in other circumstances. 390 | 391 | It is not the purpose of this section to induce you to infringe any 392 | patents or other property right claims or to contest validity of any 393 | such claims; this section has the sole purpose of protecting the 394 | integrity of the free software distribution system which is 395 | implemented by public license practices. Many people have made 396 | generous contributions to the wide range of software distributed 397 | through that system in reliance on consistent application of that 398 | system; it is up to the author/donor to decide if he or she is willing 399 | to distribute software through any other system and a licensee cannot 400 | impose that choice. 401 | 402 | This section is intended to make thoroughly clear what is believed to 403 | be a consequence of the rest of this License. 404 | 405 | 12. If the distribution and/or use of the Library is restricted in 406 | certain countries either by patents or by copyrighted interfaces, the 407 | original copyright holder who places the Library under this License may add 408 | an explicit geographical distribution limitation excluding those countries, 409 | so that distribution is permitted only in or among countries not thus 410 | excluded. In such case, this License incorporates the limitation as if 411 | written in the body of this License. 412 | 413 | 13. The Free Software Foundation may publish revised and/or new 414 | versions of the Lesser General Public License from time to time. 415 | Such new versions will be similar in spirit to the present version, 416 | but may differ in detail to address new problems or concerns. 417 | 418 | Each version is given a distinguishing version number. If the Library 419 | specifies a version number of this License which applies to it and 420 | "any later version", you have the option of following the terms and 421 | conditions either of that version or of any later version published by 422 | the Free Software Foundation. If the Library does not specify a 423 | license version number, you may choose any version ever published by 424 | the Free Software Foundation. 425 | 426 | 14. If you wish to incorporate parts of the Library into other free 427 | programs whose distribution conditions are incompatible with these, 428 | write to the author to ask for permission. For software which is 429 | copyrighted by the Free Software Foundation, write to the Free 430 | Software Foundation; we sometimes make exceptions for this. Our 431 | decision will be guided by the two goals of preserving the free status 432 | of all derivatives of our free software and of promoting the sharing 433 | and reuse of software generally. 434 | 435 | NO WARRANTY 436 | 437 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 438 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 439 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 440 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 441 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 442 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 443 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 444 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 445 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 446 | 447 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 448 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 449 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 450 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 451 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 452 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 453 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 454 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 455 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 456 | DAMAGES. 457 | 458 | END OF TERMS AND CONDITIONS 459 | 460 | How to Apply These Terms to Your New Libraries 461 | 462 | If you develop a new library, and you want it to be of the greatest 463 | possible use to the public, we recommend making it free software that 464 | everyone can redistribute and change. You can do so by permitting 465 | redistribution under these terms (or, alternatively, under the terms of the 466 | ordinary General Public License). 467 | 468 | To apply these terms, attach the following notices to the library. It is 469 | safest to attach them to the start of each source file to most effectively 470 | convey the exclusion of warranty; and each file should have at least the 471 | "copyright" line and a pointer to where the full notice is found. 472 | 473 | 474 | Copyright (C) 475 | 476 | This library is free software; you can redistribute it and/or 477 | modify it under the terms of the GNU Lesser General Public 478 | License as published by the Free Software Foundation; either 479 | version 2.1 of the License, or (at your option) any later version. 480 | 481 | This library is distributed in the hope that it will be useful, 482 | but WITHOUT ANY WARRANTY; without even the implied warranty of 483 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 484 | Lesser General Public License for more details. 485 | 486 | You should have received a copy of the GNU Lesser General Public 487 | License along with this library; if not, write to the Free Software 488 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 489 | 490 | Also add information on how to contact you by electronic and paper mail. 491 | 492 | You should also get your employer (if you work as a programmer) or your 493 | school, if any, to sign a "copyright disclaimer" for the library, if 494 | necessary. Here is a sample; alter the names: 495 | 496 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 497 | library `Frob' (a library for tweaking knobs) written by James Random Hacker. 498 | 499 | , 1 April 1990 500 | Ty Coon, President of Vice 501 | 502 | That's all there is to it! 503 | -------------------------------------------------------------------------------- /README.rst: -------------------------------------------------------------------------------- 1 | Paxos 2 | ===== 3 | This library aims to provide implementations of several Paxos-style 4 | distributed consensus algorithms, in Haskell_. 5 | 6 | See the *bin/* folder for some examples, or build the documentation 7 | using Haddock. 8 | 9 | .. _Haskell: http://www.haskell.org 10 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /bin/Control/Concurrent/UnreliableChan.hs: -------------------------------------------------------------------------------- 1 | {- Paxos - Implementations of Paxos-related consensus algorithms 2 | - 3 | - Copyright (C) 2012 Nicolas Trangez 4 | - 5 | - This library is free software; you can redistribute it and/or 6 | - modify it under the terms of the GNU Lesser General Public 7 | - License as published by the Free Software Foundation; either 8 | - version 2.1 of the License, or (at your option) any later version. 9 | - 10 | - This library is distributed in the hope that it will be useful, 11 | - but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | - Lesser General Public License for more details. 14 | - 15 | - You should have received a copy of the GNU Lesser General Public 16 | - License along with this library; if not, write to the Free Software 17 | - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 18 | - USA. 19 | -} 20 | 21 | module Control.Concurrent.UnreliableChan ( 22 | Chan 23 | , readChan 24 | , writeChan 25 | ) where 26 | 27 | import Control.Monad 28 | 29 | import Control.Concurrent hiding (Chan, readChan, writeChan) 30 | import Control.Concurrent.STM hiding (readTChan) 31 | import qualified Control.Concurrent.STM as TChan 32 | 33 | import System.Random 34 | 35 | type Chan a = TChan a 36 | 37 | -- | Write a value to a `Chan', rather unreliably 38 | writeChan :: Double -- ^ Message loss probability 39 | -> (Int, Int) -- ^ Message delivery delay bounds (in microseconds) 40 | -> Chan a -- ^ `Chan' to write to 41 | -> a -- ^ Value to deliver 42 | -> IO () 43 | writeChan lost delayBounds chan msg = do 44 | rndDrop <- randomIO 45 | rndDelay <- randomRIO delayBounds 46 | 47 | unless (rndDrop < lost) $ void $ forkIO $ do 48 | threadDelay rndDelay 49 | atomically $ TChan.writeTChan chan msg 50 | 51 | -- | Read a value from a `Chan', rather unreliable 52 | readChan :: Double -- ^ Message loss probability 53 | -> (Int, Int) -- ^ Message acceptance delay bounds (in microseconds) 54 | -> Chan a -- ^ `Chan' to read from 55 | -> IO a 56 | readChan lost delayBounds chan = do 57 | rndDrop <- randomIO 58 | rndDelay <- randomRIO delayBounds 59 | 60 | msg <- atomically $ TChan.readTChan chan 61 | 62 | if rndDrop < lost 63 | then readChan lost delayBounds chan 64 | else do 65 | threadDelay rndDelay 66 | return msg 67 | -------------------------------------------------------------------------------- /bin/synod.hs: -------------------------------------------------------------------------------- 1 | {- Paxos - Implementations of Paxos-related consensus algorithms 2 | - 3 | - Copyright (C) 2012 Nicolas Trangez 4 | - 5 | - This library is free software; you can redistribute it and/or 6 | - modify it under the terms of the GNU Lesser General Public 7 | - License as published by the Free Software Foundation; either 8 | - version 2.1 of the License, or (at your option) any later version. 9 | - 10 | - This library is distributed in the hope that it will be useful, 11 | - but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | - Lesser General Public License for more details. 14 | - 15 | - You should have received a copy of the GNU Lesser General Public 16 | - License along with this library; if not, write to the Free Software 17 | - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 18 | - USA. 19 | -} 20 | 21 | module Main (main) where 22 | 23 | import Control.Monad 24 | 25 | import Control.Concurrent hiding (readChan, writeChan) 26 | import Control.Concurrent.STM 27 | 28 | import qualified Control.Concurrent.UnreliableChan as U 29 | 30 | import System.Random 31 | 32 | import System.IO (stderr) 33 | 34 | import System.Log.Logger 35 | import System.Log.Handler (setFormatter) 36 | import System.Log.Handler.Simple (streamHandler) 37 | import System.Log.Formatter 38 | 39 | import Network.Paxos.Synod 40 | import qualified Network.Paxos.Synod.Proposer as P 41 | import qualified Network.Paxos.Synod.Acceptor as A 42 | import qualified Network.Paxos.Synod.Learner as L 43 | 44 | type NodeId = String 45 | type Value = String 46 | type Actions = [Action NodeId Value] 47 | type NetworkChannel = TChan (NodeId, Action NodeId Value) 48 | type MessageChannel = TChan (NodeId, Message NodeId Value) 49 | 50 | lost :: Double 51 | lost = 0.02 52 | minDelay :: Int 53 | minDelay = 1000 54 | maxDelay :: Int 55 | maxDelay = 300000 56 | readChan :: U.Chan a -> IO a 57 | readChan = U.readChan lost (minDelay, maxDelay) 58 | writeChan :: U.Chan a -> a -> IO () 59 | writeChan = U.writeChan lost (minDelay, maxDelay) 60 | 61 | handleActions :: NodeId -> NetworkChannel -> Actions -> IO () 62 | handleActions name network = mapM_ (\a -> writeChan network (name, a)) 63 | 64 | runProposer :: MVar Value -> String -> Quorum -> P.ProposalId NodeId -> Value -> MessageChannel -> NetworkChannel -> IO () 65 | runProposer lock name q p v chan network = do 66 | info $ "Running proposer for proposal " ++ show p 67 | myThreadId >>= void . forkIO . runWatcher 68 | 69 | handleActions name network actions0 70 | debug $ "Initial actions: " ++ show actions0 71 | 72 | loop state0 73 | where 74 | (state0, actions0) = P.startRound q p v 75 | loop state = do 76 | (sender, msg) <- readChan chan 77 | debug $ "Received message from '" ++ sender ++ "': " ++ show msg 78 | case msg of 79 | MsgPromise m -> do 80 | let (state', actions) = P.handlePromise state sender m 81 | debug $ "Actions: " ++ show actions 82 | handleActions name network actions 83 | loop state' 84 | _ -> loop state 85 | 86 | timeoutBounds = (0, 800000) 87 | runWatcher tid = do 88 | -- If no value is chosen in this timeframe, start a new round 89 | threadDelay 800000 90 | decission <- tryTakeMVar lock 91 | case decission of 92 | Nothing -> do 93 | -- Some random delay to give other proposers a chance 94 | randomRIO timeoutBounds >>= threadDelay 95 | killThread tid 96 | runProposer lock name q (P.succProposalId p) v chan network 97 | Just _ -> 98 | info "Learner learned a value, all done" 99 | 100 | debug = debugM name 101 | info = infoM name 102 | 103 | runAcceptor :: Int -> MessageChannel -> NetworkChannel -> IO () 104 | runAcceptor i chan network = loop state0 105 | where 106 | state0 = A.initialize 107 | loop state = do 108 | (sender, msg) <- readChan chan 109 | debug $ "Received message from '" ++ sender ++ "': " ++ show msg 110 | case msg of 111 | MsgPrepare m -> do 112 | let (state', actions) = A.handlePrepare state sender m 113 | debug $ "Actions: " ++ show actions 114 | handleActions name network actions 115 | loop state' 116 | MsgAccept m -> do 117 | let (state', actions) = A.handleAccept state m 118 | debug $ "Actions: " ++ show actions 119 | handleActions name network actions 120 | loop state' 121 | _ -> loop state 122 | 123 | name = "acceptor" ++ show i 124 | debug = debugM name 125 | 126 | runLearner :: Int -> Quorum -> MessageChannel -> NetworkChannel -> MVar Value -> IO () 127 | runLearner i q chan _network lock = loop state0 128 | where 129 | state0 = L.initialize q 130 | loop state = do 131 | (sender, msg) <- readChan chan 132 | debug $ "Received message from '" ++ sender ++ "': " ++ show msg 133 | case msg of 134 | MsgAccepted m -> do 135 | let state' = L.handleAccepted state sender m 136 | case L.getValue state' of 137 | Nothing -> loop state' 138 | Just v -> do 139 | info $ "Learned value: " ++ show v 140 | putMVar lock v 141 | _ -> loop state 142 | 143 | name = "learner" ++ show i 144 | debug = debugM name 145 | info = infoM name 146 | 147 | runNetwork :: NetworkChannel -> [(String, MessageChannel)] -> MessageChannel -> MessageChannel -> IO () 148 | runNetwork chan proposers acceptors learners = forever loop 149 | where 150 | loop = do 151 | (sender, action) <- atomically $ readTChan chan 152 | atomically $ case action of 153 | Send target message -> 154 | case lookup target proposers of 155 | Nothing -> error $ "Unknown target '" ++ target ++ "'" 156 | Just pchan -> writeTChan pchan (sender, message) 157 | Broadcast group message -> case group of 158 | Acceptors -> writeTChan acceptors (sender, message) 159 | Learners -> writeTChan learners (sender, message) 160 | 161 | 162 | main :: IO () 163 | main = do 164 | handler <- do 165 | h <- streamHandler stderr DEBUG 166 | return $ setFormatter h (simpleLogFormatter "[$loggername] $msg") 167 | updateGlobalLogger rootLoggerName $ 168 | setLevel DEBUG . setHandlers [handler] 169 | 170 | proposerChans <- replicateM numProposers newTChanIO 171 | acceptorsChan <- newBroadcastTChanIO 172 | learnersChan <- newBroadcastTChanIO 173 | 174 | network <- newTChanIO 175 | 176 | let proposers = [("proposer" ++ show i, chan) | (i, chan) <- zip [(0 :: Int) ..] proposerChans] 177 | 178 | lock <- newEmptyMVar 179 | 180 | networkHandler <- forkIO $ runNetwork network proposers acceptorsChan learnersChan 181 | 182 | learners <- forM [0 .. numLearners - 1] $ \i -> do 183 | chan <- atomically $ dupTChan learnersChan 184 | forkIO $ runLearner i q chan network lock 185 | 186 | acceptors <- forM [0 .. numAcceptors - 1] $ \i -> do 187 | chan <- atomically $ dupTChan acceptorsChan 188 | forkIO $ runAcceptor i chan network 189 | 190 | 191 | forM_ proposers $ \(name, chan) -> do 192 | timeout <- randomRIO (500, 10000) 193 | threadDelay timeout 194 | let msg = "Hello world, from " ++ name ++ "!" 195 | void $ forkIO $ runProposer lock name q (P.initialProposalId name) msg chan network 196 | 197 | result <- takeMVar lock 198 | 199 | mapM_ killThread acceptors 200 | mapM_ killThread learners 201 | killThread networkHandler 202 | 203 | putStrLn $ "Learned value: " ++ result 204 | 205 | where 206 | numLearners, numAcceptors, numProposers :: Int 207 | numLearners = 2 208 | numAcceptors = 5 209 | numProposers = 2 210 | q = quorum $ numAcceptors `div` 2 + 1 211 | -------------------------------------------------------------------------------- /bin/tests.hs: -------------------------------------------------------------------------------- 1 | {- Paxos - Implementations of Paxos-related consensus algorithms 2 | - 3 | - Copyright (C) 2012 Nicolas Trangez 4 | - 5 | - This library is free software; you can redistribute it and/or 6 | - modify it under the terms of the GNU Lesser General Public 7 | - License as published by the Free Software Foundation; either 8 | - version 2.1 of the License, or (at your option) any later version. 9 | - 10 | - This library is distributed in the hope that it will be useful, 11 | - but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | - Lesser General Public License for more details. 14 | - 15 | - You should have received a copy of the GNU Lesser General Public 16 | - License along with this library; if not, write to the Free Software 17 | - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 18 | - USA. 19 | -} 20 | 21 | module Main (main) where 22 | 23 | import Test.Framework (Test, defaultMain) 24 | 25 | import qualified Network.Paxos.Synod 26 | 27 | main :: IO () 28 | main = defaultMain tests 29 | 30 | tests :: [Test] 31 | tests = [ Network.Paxos.Synod.tests 32 | ] 33 | -------------------------------------------------------------------------------- /paxos.cabal: -------------------------------------------------------------------------------- 1 | Name: paxos 2 | Version: 0.1.0.0 3 | Synopsis: Implementations of Paxos-related consensus algorithms 4 | -- Description: 5 | Homepage: http://github.com/NicolasT/paxos 6 | License: LGPL-2.1 7 | License-File: LICENSE 8 | Author: Nicolas Trangez 9 | Maintainer: ikke@nicolast.be 10 | Copyright: Copyright (c) 2012, Nicolas Trangez 11 | Category: Network 12 | Build-Type: Simple 13 | Cabal-Version: >=1.8 14 | 15 | Extra-Source-Files: README.rst 16 | 17 | Source-Repository head 18 | Type: git 19 | Location: git://github.com/NicolasT/paxos.git 20 | 21 | Library 22 | Exposed-Modules: Network.Paxos.Synod, 23 | Network.Paxos.Synod.Proposer, 24 | Network.Paxos.Synod.Acceptor, 25 | Network.Paxos.Synod.Learner 26 | Other-Modules: Data.Serialize.QuickCheck, 27 | Network.Paxos.Synod.Action, 28 | Network.Paxos.Synod.Types, 29 | Network.Paxos.Synod.Messages 30 | Build-Depends: base >= 4 && < 5, 31 | containers, 32 | cereal, 33 | QuickCheck >= 2, 34 | test-framework, 35 | test-framework-quickcheck2 36 | Hs-Source-Dirs: src 37 | Ghc-Options: -Wall -fwarn-incomplete-patterns 38 | Ghc-Prof-Options: -caf-all -auto-all 39 | 40 | Executable synod 41 | Main-Is: synod.hs 42 | Other-Modules: Control.Concurrent.UnreliableChan 43 | Build-Depends: base >= 4 && < 5, 44 | stm >= 2.4, 45 | random, 46 | hslogger, 47 | paxos 48 | Hs-Source-Dirs: bin 49 | Ghc-Options: -Wall -fwarn-incomplete-patterns -rtsopts -threaded -with-rtsopts=-N 50 | Ghc-Prof-Options: -caf-all -auto-all 51 | 52 | Test-Suite tests 53 | Type: exitcode-stdio-1.0 54 | Main-Is: tests.hs 55 | Build-Depends: base >= 4 && < 5, 56 | test-framework, 57 | paxos 58 | Hs-Source-Dirs: bin 59 | Ghc-Options: -Wall -fwarn-incomplete-patterns -rtsopts -threaded 60 | -------------------------------------------------------------------------------- /src/Data/Serialize/QuickCheck.hs: -------------------------------------------------------------------------------- 1 | {- Paxos - Implementations of Paxos-related consensus algorithms 2 | - 3 | - Copyright (C) 2012 Nicolas Trangez 4 | - 5 | - This library is free software; you can redistribute it and/or 6 | - modify it under the terms of the GNU Lesser General Public 7 | - License as published by the Free Software Foundation; either 8 | - version 2.1 of the License, or (at your option) any later version. 9 | - 10 | - This library is distributed in the hope that it will be useful, 11 | - but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | - Lesser General Public License for more details. 14 | - 15 | - You should have received a copy of the GNU Lesser General Public 16 | - License along with this library; if not, write to the Free Software 17 | - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 18 | - USA. 19 | -} 20 | 21 | module Data.Serialize.QuickCheck ( 22 | prop_serialize 23 | ) where 24 | 25 | import Data.Serialize 26 | 27 | import Test.QuickCheck 28 | 29 | prop_serialize:: (Eq a, Serialize a, Arbitrary a) => a -> a -> Bool 30 | prop_serialize _ val = decode (encode val) == Right val 31 | -------------------------------------------------------------------------------- /src/Network/Paxos/Synod.hs: -------------------------------------------------------------------------------- 1 | {- Paxos - Implementations of Paxos-related consensus algorithms 2 | - 3 | - Copyright (C) 2012 Nicolas Trangez 4 | - 5 | - This library is free software; you can redistribute it and/or 6 | - modify it under the terms of the GNU Lesser General Public 7 | - License as published by the Free Software Foundation; either 8 | - version 2.1 of the License, or (at your option) any later version. 9 | - 10 | - This library is distributed in the hope that it will be useful, 11 | - but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | - Lesser General Public License for more details. 14 | - 15 | - You should have received a copy of the GNU Lesser General Public 16 | - License along with this library; if not, write to the Free Software 17 | - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 18 | - USA. 19 | -} 20 | 21 | module Network.Paxos.Synod ( 22 | -- * Re-exports 23 | BroadcastGroup(..) 24 | , Action(..) 25 | , Message(..) 26 | , Quorum 27 | , quorum 28 | -- * Testing 29 | , tests 30 | ) where 31 | 32 | import Test.Framework (Test, testGroup) 33 | 34 | import Network.Paxos.Synod.Action 35 | import Network.Paxos.Synod.Messages hiding (tests) 36 | import Network.Paxos.Synod.Types hiding (tests) 37 | 38 | import qualified Network.Paxos.Synod.Types 39 | import qualified Network.Paxos.Synod.Proposer 40 | import qualified Network.Paxos.Synod.Acceptor 41 | import qualified Network.Paxos.Synod.Learner 42 | import qualified Network.Paxos.Synod.Messages 43 | 44 | -- | Tests for modules in "Network.Paxos.Synod" 45 | tests :: Test 46 | tests = testGroup "Network.Paxos.Synod" [ 47 | Network.Paxos.Synod.Types.tests 48 | , Network.Paxos.Synod.Proposer.tests 49 | , Network.Paxos.Synod.Acceptor.tests 50 | , Network.Paxos.Synod.Learner.tests 51 | , Network.Paxos.Synod.Messages.tests 52 | ] 53 | -------------------------------------------------------------------------------- /src/Network/Paxos/Synod/Acceptor.hs: -------------------------------------------------------------------------------- 1 | {- Paxos - Implementations of Paxos-related consensus algorithms 2 | - 3 | - Copyright (C) 2012 Nicolas Trangez 4 | - 5 | - This library is free software; you can redistribute it and/or 6 | - modify it under the terms of the GNU Lesser General Public 7 | - License as published by the Free Software Foundation; either 8 | - version 2.1 of the License, or (at your option) any later version. 9 | - 10 | - This library is distributed in the hope that it will be useful, 11 | - but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | - Lesser General Public License for more details. 14 | - 15 | - You should have received a copy of the GNU Lesser General Public 16 | - License along with this library; if not, write to the Free Software 17 | - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 18 | - USA. 19 | -} 20 | 21 | module Network.Paxos.Synod.Acceptor ( 22 | -- * Acceptor functionality 23 | AcceptorState 24 | , Action(..) 25 | , initialize 26 | -- ** Incoming message handlers 27 | , handlePrepare 28 | , handleAccept 29 | -- * Testing 30 | , tests 31 | ) where 32 | 33 | import Control.Applicative 34 | 35 | import Data.Maybe (isNothing) 36 | 37 | import Data.Word (Word32) 38 | import Data.Serialize 39 | import Data.Serialize.QuickCheck 40 | 41 | import Test.Framework (Test, testGroup) 42 | import Test.Framework.Providers.QuickCheck2 (testProperty) 43 | 44 | import Test.QuickCheck (Arbitrary, arbitrary) 45 | 46 | import Network.Paxos.Synod.Action 47 | import Network.Paxos.Synod.Types hiding (tests) 48 | import Network.Paxos.Synod.Messages hiding (tests) 49 | 50 | -- | State of an Acceptor 51 | data AcceptorState nodeId value = AcceptorState { highestPromise :: Maybe (ProposalId nodeId) 52 | , highestAccepted :: Maybe (AcceptedValue nodeId value) 53 | } 54 | deriving (Show, Eq) 55 | 56 | serial :: Word32 57 | serial = 0x20121214 58 | 59 | instance (Serialize nodeId, Serialize value) => Serialize (AcceptorState nodeId value) where 60 | get = do 61 | serial' <- getWord32le 62 | if serial' /= serial 63 | then fail "AcceptorState: invalid serial" 64 | else AcceptorState <$> get <*> get 65 | 66 | put (AcceptorState a b) = putWord32le serial >> put a >> put b 67 | 68 | instance (Arbitrary nodeId, Arbitrary value) => Arbitrary (AcceptorState nodeId value) where 69 | arbitrary = do 70 | promised <- arbitrary 71 | accepted <- case promised of 72 | Nothing -> return Nothing 73 | Just _ -> arbitrary 74 | return $ AcceptorState promised accepted 75 | 76 | 77 | -- | Initial Acceptor state 78 | initialize :: AcceptorState nodeId value 79 | initialize = AcceptorState { highestPromise = Nothing 80 | , highestAccepted = Nothing 81 | } 82 | 83 | prop_initialize :: Bool 84 | prop_initialize = isNothing (highestPromise state0) && isNothing (highestAccepted state0) 85 | where 86 | state0 = initialize 87 | 88 | 89 | -- | Handle a single `Prepare' message received from a Proposer 90 | handlePrepare :: Ord nodeId 91 | => AcceptorState nodeId value -- ^ Current state 92 | -> nodeId -- ^ Identifier of the node from which the message was received 93 | -> Prepare nodeId -- ^ Received message 94 | -> (AcceptorState nodeId value, [Action nodeId value]) 95 | handlePrepare state proposer (Prepare proposal) = 96 | case highestPromise state of 97 | -- If we didn't send any promise yet, the given proposal is OK, and we promise to store it 98 | -- and never accept any lower proposals 99 | Nothing -> (state', sendPromise) 100 | -- Otherwise, only accept the proposal if it's higher than the highest one for which we 101 | -- returned a promise before 102 | Just promised -> case compare promised proposal of 103 | -- The highest proposal to which we send a `Promise' reply is lower 104 | -- than this one, accept it 105 | LT -> (state', sendPromise) 106 | -- They're equal, most likely some message duplication occurred 107 | EQ -> (state, []) 108 | -- We already promised not to accept any proposals lower than `promised', 109 | -- and the current proposal is lower, so we ignore this proposal 110 | GT -> (state, []) -- TODO Nack 111 | where 112 | -- We accept this proposal: store it 113 | state' = state { highestPromise = Just proposal } 114 | -- We accept this proposal: return a `Promise' to the Proposer 115 | sendPromise = [Send proposer $ MsgPromise $ Promise proposal (highestAccepted state')] 116 | 117 | prop_handlePrepare :: AcceptorState Int () -> Int -> Prepare Int -> Bool 118 | prop_handlePrepare state proposer msg@(Prepare proposalId) = 119 | case highestPromise state of 120 | Nothing -> (highestPromise state' == Just proposalId) && 121 | (actions == [Send proposer $ MsgPromise $ Promise proposalId Nothing]) 122 | Just promised -> (highestAccepted state' == highestAccepted state) && 123 | case compare promised proposalId of 124 | LT -> (highestPromise state' == Just proposalId) && 125 | (actions == [Send proposer $ MsgPromise $ Promise proposalId (highestAccepted state)]) 126 | EQ -> state' == state && null actions 127 | GT -> state' == state && null actions 128 | where 129 | (state', actions) = handlePrepare state proposer msg 130 | 131 | 132 | -- | Handle a single `Accept' message received from a Proposer 133 | handleAccept :: Ord nodeId 134 | => AcceptorState nodeId value -- ^ Current state 135 | -> Accept nodeId value -- ^ Received message 136 | -> (AcceptorState nodeId value, [Action nodeId value]) 137 | handleAccept state (Accept proposal value) = 138 | case highestPromise state of 139 | -- We didn't promise anything yet, so we can accept this (and update our `highestPromise' 140 | -- value accordingly!) 141 | Nothing -> (state', [sendAccepted]) 142 | -- We already sent a `Promise', check whether we can accept what's offered... 143 | Just promised -> case compare promised proposal of 144 | -- We promised not to accept any proposals below `promised', but 145 | -- this proposal exceeds this, so we can accept it (and update our 146 | -- `highestPromise' value accordingly) 147 | LT -> (state', [sendAccepted]) 148 | -- The given proposal is equal to the one we promised to use as 149 | -- lower-bound. This is just fine, but we only want to broadcast an 150 | -- `Accepted' message once 151 | EQ -> case highestAccepted state of 152 | -- We didn't accept anything before, so update the state 153 | -- and broadcast an `Accepted' message 154 | Nothing -> (state', [sendAccepted]) 155 | -- We accepted something before... 156 | Just (AcceptedValue p _) -> 157 | if p == proposal 158 | -- If we accepted the current proposal before, 159 | -- ignore this message, it's a duplicate 160 | then (state, []) 161 | -- Otherwise, we accepted an older proposal before. 162 | -- Update the state and broadcast `Accepted' 163 | else (state', [sendAccepted]) 164 | GT -> (state, []) -- TODO Nack 165 | where 166 | -- Assuming the conditions to accept this message are met, update the state... 167 | state' = state { highestPromise = Just proposal 168 | , highestAccepted = Just $ AcceptedValue proposal value 169 | } 170 | -- ... and broadcast an `Accepted' message to all Learners 171 | sendAccepted = Broadcast Learners $ MsgAccepted $ Accepted proposal value 172 | 173 | prop_handleAccept :: AcceptorState Int () -> Accept Int () -> Bool 174 | prop_handleAccept state msg@(Accept proposal value) = 175 | case highestPromise state of 176 | Nothing -> (state' == acceptedState) && (actions == [broadcastAccepted]) 177 | Just promised -> case compare promised proposal of 178 | LT -> (state' == acceptedState) && (actions == [broadcastAccepted]) 179 | EQ -> case highestAccepted state of 180 | Nothing -> (state' == acceptedState) && (actions == [broadcastAccepted]) 181 | Just (AcceptedValue p _) -> 182 | if p == proposal 183 | then (state' == state) && null actions 184 | else (state' == acceptedState) && (actions == [broadcastAccepted]) 185 | GT -> (state' == state) && null actions 186 | where 187 | (state', actions) = handleAccept state msg 188 | acceptedState = state { highestPromise = Just proposal 189 | , highestAccepted = Just $ AcceptedValue proposal value 190 | } 191 | broadcastAccepted = Broadcast Learners $ MsgAccepted $ Accepted proposal value 192 | 193 | 194 | -- | Tests 195 | tests :: Test 196 | tests = testGroup "Network.Paxos.Synod.Acceptor" [ 197 | testProperty "initialize" prop_initialize 198 | , testProperty "handlePrepare" prop_handlePrepare 199 | , testProperty "handleAccept" prop_handleAccept 200 | , testProperty "AcceptorState Serialize" $ prop_serialize (undefined :: AcceptorState String Int) 201 | ] 202 | -------------------------------------------------------------------------------- /src/Network/Paxos/Synod/Action.hs: -------------------------------------------------------------------------------- 1 | {- Paxos - Implementations of Paxos-related consensus algorithms 2 | - 3 | - Copyright (C) 2012 Nicolas Trangez 4 | - 5 | - This library is free software; you can redistribute it and/or 6 | - modify it under the terms of the GNU Lesser General Public 7 | - License as published by the Free Software Foundation; either 8 | - version 2.1 of the License, or (at your option) any later version. 9 | - 10 | - This library is distributed in the hope that it will be useful, 11 | - but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | - Lesser General Public License for more details. 14 | - 15 | - You should have received a copy of the GNU Lesser General Public 16 | - License along with this library; if not, write to the Free Software 17 | - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 18 | - USA. 19 | -} 20 | 21 | module Network.Paxos.Synod.Action ( 22 | BroadcastGroup(..) 23 | , Action(..) 24 | ) where 25 | 26 | import Network.Paxos.Synod.Messages 27 | 28 | -- | Broadcast group identifier 29 | data BroadcastGroup = Acceptors 30 | | Learners 31 | deriving (Show, Eq) 32 | 33 | 34 | -- | Actions which might need to be executed as the result of a state 35 | -- transition 36 | data Action nodeId value = Send nodeId (Message nodeId value) 37 | -- ^ Send the given message to the given node 38 | | Broadcast BroadcastGroup (Message nodeId value) 39 | -- ^ Broadcast the given message to the given group 40 | deriving (Show, Eq) 41 | 42 | -------------------------------------------------------------------------------- /src/Network/Paxos/Synod/Learner.hs: -------------------------------------------------------------------------------- 1 | {- Paxos - Implementations of Paxos-related consensus algorithms 2 | - 3 | - Copyright (C) 2012 Nicolas Trangez 4 | - 5 | - This library is free software; you can redistribute it and/or 6 | - modify it under the terms of the GNU Lesser General Public 7 | - License as published by the Free Software Foundation; either 8 | - version 2.1 of the License, or (at your option) any later version. 9 | - 10 | - This library is distributed in the hope that it will be useful, 11 | - but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | - Lesser General Public License for more details. 14 | - 15 | - You should have received a copy of the GNU Lesser General Public 16 | - License along with this library; if not, write to the Free Software 17 | - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 18 | - USA. 19 | -} 20 | 21 | module Network.Paxos.Synod.Learner ( 22 | -- * Learner functionality 23 | LearnerState 24 | , initialize 25 | -- ** Incoming message handlers 26 | , handleAccepted 27 | -- ** Result extraction 28 | , getValue 29 | -- * Testing 30 | , tests 31 | ) where 32 | 33 | import Control.Applicative 34 | 35 | import Data.Maybe (fromJust, isNothing) 36 | 37 | import Data.Map (Map) 38 | import qualified Data.Map as Map 39 | 40 | import Data.Word (Word32) 41 | import Data.Serialize 42 | import Data.Serialize.QuickCheck 43 | 44 | import Test.Framework (Test, testGroup) 45 | import Test.Framework.Providers.QuickCheck2 (testProperty) 46 | 47 | import Test.QuickCheck (Arbitrary, arbitrary, oneof) 48 | 49 | import Network.Paxos.Synod.Types hiding (quorum, tests) 50 | import Network.Paxos.Synod.Messages hiding (tests) 51 | 52 | -- | State of a Learner 53 | data LearnerState nodeId value = Learning { quorum :: Quorum 54 | , highestAccepted :: Map nodeId (ProposalId nodeId) 55 | , accepted :: Map (ProposalId nodeId) [nodeId] 56 | } 57 | | Decided value 58 | deriving (Show, Eq) 59 | 60 | serial :: Word32 61 | serial = 0x20121214 62 | 63 | instance (Ord nodeId, Serialize nodeId, Serialize value) => Serialize (LearnerState nodeId value) where 64 | get = do 65 | serial' <- getWord32le 66 | if serial' /= serial 67 | then fail "LearnerState: invalid serial" 68 | else do 69 | tag <- getWord8 70 | case tag of 71 | 1 -> Learning <$> get <*> get <*> get 72 | 2 -> Decided <$> get 73 | _ -> fail "LearnerState: invalid tag" 74 | 75 | put state = do 76 | putWord32le serial 77 | case state of 78 | Learning a b c -> putWord8 1 >> put a >> put b >> put c 79 | Decided a -> putWord8 2 >> put a 80 | 81 | instance (Ord nodeId, Arbitrary nodeId, Arbitrary value) => Arbitrary (LearnerState nodeId value) where 82 | arbitrary = oneof [learning, decided] 83 | where 84 | decided = Decided <$> arbitrary 85 | learning = do 86 | state0 <- initialize <$> arbitrary 87 | mods <- arbitrary 88 | let f (nodeId, msg) s = case handleAccepted s nodeId msg of 89 | Decided _ -> s 90 | s'@Learning{} -> s' 91 | state = foldr f state0 mods 92 | return state 93 | 94 | 95 | -- | Generate an initial Learner state 96 | initialize :: Quorum -- ^ Number of nodes which form a quorum 97 | -> LearnerState nodeId value 98 | initialize quorum' = Learning { quorum = quorum' 99 | , highestAccepted = Map.empty 100 | , accepted = Map.empty 101 | } 102 | 103 | prop_initialize :: Quorum -> Bool 104 | prop_initialize quorum' = and [ isNothing $ getValue state 105 | , quorum state == quorum' 106 | , Map.null $ highestAccepted state 107 | , Map.null $ accepted state 108 | ] 109 | where 110 | state = initialize quorum' 111 | 112 | 113 | -- | Handle a single Accepted message received from an Acceptor 114 | handleAccepted :: Ord nodeId 115 | => LearnerState nodeId value -- ^ Current state 116 | -> nodeId -- ^ Identifier of the node from which the message was received 117 | -> Accepted nodeId value -- ^ Received message 118 | -> LearnerState nodeId value 119 | handleAccepted state acceptor (Accepted proposalId value) = 120 | case state of 121 | Decided _ -> state 122 | Learning{} -> 123 | if acceptor `Map.member` highestAccepted state 124 | then if highestProposalId >= proposalId 125 | then state 126 | else handleMember state 127 | else handleNotMember state 128 | where 129 | Just highestProposalId = Map.lookup acceptor (highestAccepted state) 130 | 131 | listToMaybe l 132 | | null l = Nothing 133 | | otherwise = Just l 134 | 135 | handleMember s = handleNotMember $ s { accepted = Map.update (listToMaybe . filter (/= acceptor)) highestProposalId (accepted s) } 136 | 137 | -- TODO This is plain ugly 138 | handleNotMember s = check proposalId $ s { highestAccepted = Map.insert acceptor proposalId (highestAccepted s) 139 | , accepted = Map.adjust ((:) acceptor) proposalId (accepted s `Map.union` Map.singleton proposalId []) 140 | } 141 | 142 | check p s = 143 | if maybe 0 length (Map.lookup p (accepted s)) == fromIntegral (unQuorum (quorum s)) 144 | then Decided value 145 | else s 146 | 147 | prop_handleAccepted1 :: LearnerState Int () -> Int -> Accepted Int () -> Bool 148 | prop_handleAccepted1 state acceptor msg@(Accepted proposalId _) = 149 | isDecided || (fromJust (Map.lookup acceptor (highestAccepted state')) >= proposalId) 150 | where 151 | state' = handleAccepted state acceptor msg 152 | isDecided = case state' of 153 | Decided _ -> True 154 | Learning{} -> False 155 | 156 | prop_handleAccepted2 :: LearnerState Int () -> Int -> Accepted Int () -> Bool 157 | prop_handleAccepted2 state acceptor msg 158 | | isDecided = True 159 | | otherwise = acceptor `elem` list 160 | where 161 | state' = handleAccepted state acceptor msg 162 | isDecided = case state' of 163 | Decided _ -> True 164 | Learning{} -> False 165 | Just p = Map.lookup acceptor (highestAccepted state') 166 | Just list = Map.lookup p (accepted state') 167 | 168 | -- TODO Add property/test to check `Decided' is returned once quorum is 169 | -- reached 170 | 171 | 172 | -- | Extract the learned value from the Learner state, if any. 173 | -- 174 | -- Once a value has been learned, handling more `Prepare' messages becomes 175 | -- a no-op. 176 | getValue :: LearnerState nodeId value -> Maybe value 177 | getValue state = case state of 178 | Learning{} -> Nothing 179 | Decided value -> Just value 180 | 181 | prop_getValue :: LearnerState Int Int -> Bool 182 | prop_getValue state = case state of 183 | Decided value -> getValue state == Just value 184 | Learning{} -> isNothing $ getValue state 185 | 186 | 187 | -- | Tests 188 | tests :: Test 189 | tests = testGroup "Network.Paxos.Synod.Learner" [ 190 | testProperty "initialize" prop_initialize 191 | , testProperty "handleAccepted1" prop_handleAccepted1 192 | , testProperty "handleAccepted2" prop_handleAccepted2 193 | , testProperty "getValue" prop_getValue 194 | , testProperty "LearnerState Serialize" $ prop_serialize (undefined :: LearnerState String Int) 195 | ] 196 | -------------------------------------------------------------------------------- /src/Network/Paxos/Synod/Messages.hs: -------------------------------------------------------------------------------- 1 | {- Paxos - Implementations of Paxos-related consensus algorithms 2 | - 3 | - Copyright (C) 2012 Nicolas Trangez 4 | - 5 | - This library is free software; you can redistribute it and/or 6 | - modify it under the terms of the GNU Lesser General Public 7 | - License as published by the Free Software Foundation; either 8 | - version 2.1 of the License, or (at your option) any later version. 9 | - 10 | - This library is distributed in the hope that it will be useful, 11 | - but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | - Lesser General Public License for more details. 14 | - 15 | - You should have received a copy of the GNU Lesser General Public 16 | - License along with this library; if not, write to the Free Software 17 | - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 18 | - USA. 19 | -} 20 | 21 | {-# LANGUAGE DeriveDataTypeable #-} 22 | 23 | module Network.Paxos.Synod.Messages ( 24 | Prepare(Prepare) 25 | , Promise(Promise) 26 | , Accept(Accept) 27 | , Accepted(Accepted) 28 | , Message(..) 29 | , tests 30 | ) where 31 | 32 | import Control.Applicative 33 | 34 | import Data.Word (Word32) 35 | import Data.Serialize 36 | import Data.Serialize.QuickCheck 37 | 38 | import Data.Typeable (Typeable) 39 | 40 | import Test.Framework (Test, testGroup) 41 | import Test.Framework.Providers.QuickCheck2 (testProperty) 42 | 43 | import Test.QuickCheck (Arbitrary, arbitrary, oneof) 44 | 45 | import Network.Paxos.Synod.Types hiding (tests) 46 | 47 | data Prepare nodeId = Prepare (ProposalId nodeId) 48 | deriving (Show, Eq, Typeable) 49 | 50 | instance Serialize nodeId => Serialize (Prepare nodeId) where 51 | get = Prepare <$> get 52 | put (Prepare nodeId) = put nodeId 53 | 54 | instance Arbitrary nodeId => Arbitrary (Prepare nodeId) where 55 | arbitrary = Prepare <$> arbitrary 56 | 57 | 58 | data Promise nodeId value = Promise (ProposalId nodeId) (Maybe (AcceptedValue nodeId value)) 59 | deriving (Show, Eq, Typeable) 60 | 61 | instance (Serialize nodeId, Serialize value) => Serialize (Promise nodeId value) where 62 | get = Promise <$> get <*> get 63 | put (Promise p m) = put p >> put m 64 | 65 | instance (Arbitrary nodeId, Arbitrary value) => Arbitrary (Promise nodeId value) where 66 | arbitrary = Promise <$> arbitrary <*> arbitrary 67 | 68 | 69 | data Accept nodeId value = Accept (ProposalId nodeId) value 70 | deriving (Show, Eq, Typeable) 71 | 72 | instance (Serialize nodeId, Serialize value) => Serialize (Accept nodeId value) where 73 | get = Accept <$> get <*> get 74 | put (Accept p v) = put p >> put v 75 | 76 | instance (Arbitrary nodeId, Arbitrary value) => Arbitrary (Accept nodeId value) where 77 | arbitrary = Accept <$> arbitrary <*> arbitrary 78 | 79 | 80 | data Accepted nodeId value = Accepted (ProposalId nodeId) value 81 | deriving (Show, Eq, Typeable) 82 | 83 | instance (Serialize nodeId, Serialize value) => Serialize (Accepted nodeId value) where 84 | get = Accepted <$> get <*> get 85 | put (Accepted p v) = put p >> put v 86 | 87 | instance (Arbitrary nodeId, Arbitrary value) => Arbitrary (Accepted nodeId value) where 88 | arbitrary = Accepted <$> arbitrary <*> arbitrary 89 | 90 | 91 | -- | Union type for all types of message which might flow across nodes 92 | data Message nodeId value = MsgPrepare (Prepare nodeId) 93 | -- ^ A `Prepare' message, from Proposer to Acceptor 94 | | MsgPromise (Promise nodeId value) 95 | -- ^ A `Promise' message, from Acceptor to Proposer 96 | | MsgAccept (Accept nodeId value) 97 | -- ^ An `Accept' message, from Proposer to Acceptor 98 | | MsgAccepted (Accepted nodeId value) 99 | -- ^ An `Accepted' message, from Acceptor to Learner 100 | deriving (Show, Eq, Typeable) 101 | 102 | serial :: Word32 103 | serial = 0x20121214 104 | 105 | instance (Serialize nodeId, Serialize value) => Serialize (Message nodeId value) where 106 | get = do 107 | serial' <- getWord32le 108 | if serial' /= serial 109 | then fail "Message: invalid serial" 110 | else do 111 | tag <- getWord8 112 | case tag of 113 | 1 -> MsgPrepare <$> get 114 | 2 -> MsgPromise <$> get 115 | 3 -> MsgAccept <$> get 116 | 4 -> MsgAccepted <$> get 117 | _ -> fail "Message: invalid tag" 118 | 119 | put msg = do 120 | putWord32le serial 121 | case msg of 122 | MsgPrepare m -> putWord8 1 >> put m 123 | MsgPromise m -> putWord8 2 >> put m 124 | MsgAccept m -> putWord8 3 >> put m 125 | MsgAccepted m -> putWord8 4 >> put m 126 | 127 | instance (Arbitrary nodeId, Arbitrary value) => Arbitrary (Message nodeId value) where 128 | arbitrary = oneof [ MsgPrepare <$> arbitrary 129 | , MsgPromise <$> arbitrary 130 | , MsgAccept <$> arbitrary 131 | , MsgAccepted <$> arbitrary 132 | ] 133 | 134 | 135 | tests :: Test 136 | tests = testGroup "Network.Paxos.Synod.Messages" [ 137 | testProperty "Message Serialize" $ prop_serialize (undefined :: Message String Int) 138 | ] 139 | -------------------------------------------------------------------------------- /src/Network/Paxos/Synod/Proposer.hs: -------------------------------------------------------------------------------- 1 | {- Paxos - Implementations of Paxos-related consensus algorithms 2 | - 3 | - Copyright (C) 2012 Nicolas Trangez 4 | - 5 | - This library is free software; you can redistribute it and/or 6 | - modify it under the terms of the GNU Lesser General Public 7 | - License as published by the Free Software Foundation; either 8 | - version 2.1 of the License, or (at your option) any later version. 9 | - 10 | - This library is distributed in the hope that it will be useful, 11 | - but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | - Lesser General Public License for more details. 14 | - 15 | - You should have received a copy of the GNU Lesser General Public 16 | - License along with this library; if not, write to the Free Software 17 | - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 18 | - USA. 19 | -} 20 | 21 | module Network.Paxos.Synod.Proposer ( 22 | -- * Proposer functionality 23 | ProposerState 24 | , Action(..) 25 | , startRound 26 | , handlePromise 27 | 28 | -- * Re-exports of useful ProposalId functions 29 | , ProposalId 30 | , initialProposalId 31 | , succProposalId 32 | 33 | -- * Testing 34 | , tests 35 | ) where 36 | 37 | import Control.Applicative 38 | 39 | import Data.Maybe (isNothing) 40 | 41 | import Data.Word (Word32) 42 | import Data.Serialize 43 | import Data.Serialize.QuickCheck 44 | 45 | import Test.Framework (Test, testGroup) 46 | import Test.Framework.Providers.QuickCheck2 (testProperty) 47 | 48 | import Test.QuickCheck (Arbitrary, arbitrary) 49 | 50 | import Network.Paxos.Synod.Action 51 | import Network.Paxos.Synod.Types hiding (quorum, tests) 52 | import Network.Paxos.Synod.Messages hiding (tests) 53 | 54 | -- | State of a Proposer 55 | data ProposerState nodeId value = ProposerState { proposalId :: ProposalId nodeId 56 | , quorum :: Quorum 57 | , value :: value 58 | , acceptors :: [nodeId] 59 | , highestAccepted :: Maybe (AcceptedValue nodeId value) 60 | } 61 | deriving (Show, Eq) 62 | 63 | serial :: Word32 64 | serial = 0x20121213 65 | 66 | instance (Serialize nodeId, Serialize value) => Serialize (ProposerState nodeId value) where 67 | get = do 68 | serial' <- getWord32le 69 | if serial' /= serial 70 | then fail "ProposerState: invalid serial" 71 | else ProposerState <$> get <*> get <*> get <*> get <*> get 72 | put (ProposerState a b c d e) = putWord32le serial >> put a >> put b >> put c >> put d >> put e 73 | 74 | instance (Arbitrary nodeId, Arbitrary value) => Arbitrary (ProposerState nodeId value) where 75 | arbitrary = ProposerState <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary 76 | 77 | 78 | -- | Start a single round using given quorum, `ProposalId' and value to propose 79 | startRound :: Quorum -- ^ Quorum size 80 | -> ProposalId nodeId -- ^ `ProposalId' to use 81 | -> value -- ^ Value to propose 82 | -> (ProposerState nodeId value, [Action nodeId value]) 83 | startRound quorum' proposalId' value' = (state, [msg]) 84 | where 85 | state = ProposerState { proposalId = proposalId' 86 | , quorum = quorum' 87 | , value = value' 88 | , acceptors = [] 89 | , highestAccepted = Nothing 90 | } 91 | msg = Broadcast Acceptors $ MsgPrepare $ Prepare proposalId' 92 | 93 | prop_startRound1 :: Quorum -> ProposalId Int -> () -> Bool 94 | prop_startRound1 q p v = and [ proposalId s == p 95 | , quorum s == q 96 | , value s == v 97 | , null $ acceptors s 98 | , isNothing $ highestAccepted s 99 | ] 100 | where 101 | (s, _) = startRound q p v 102 | 103 | prop_startRound2 :: Quorum -> ProposalId Int -> () -> Bool 104 | prop_startRound2 q p v = actions == [Broadcast Acceptors $ MsgPrepare $ Prepare p] 105 | where 106 | (_, actions) = startRound q p v 107 | 108 | 109 | -- | Handle a single `Promise' message received from an Acceptor 110 | handlePromise :: Ord nodeId => ProposerState nodeId value -- ^ Current state 111 | -> nodeId -- ^ Identifier of the node from which the message was received 112 | -> Promise nodeId value -- ^ Received message 113 | -> (ProposerState nodeId value, [Action nodeId value]) 114 | handlePromise state acceptor (Promise proposalId' highestAccepted') 115 | -- Promises for older proposals than the one we're handling are ignored 116 | -- (most likely some message reordering occurred) 117 | | proposalId' < proposalId state = (state, []) 118 | -- Promises of proposals newer than the one we're handling are ignored, 119 | -- although we might want to send a hint to the manager he might want 120 | -- to restart a round with a higher proposal number 121 | | proposalId' > proposalId state = (state, []) -- TODO Give up and start new round? 122 | -- The given proposal number matches the one this proposer is handling 123 | | otherwise = 124 | -- Check whether we already handled a promise of this acceptor 125 | if acceptor `elem` acceptors state 126 | -- If so, ignore the message (some message duplication occurred) 127 | then (state, []) 128 | -- All well, update state and return some actions (if any) 129 | else (state', msgs) 130 | where 131 | -- Updated state assuming 132 | -- * The message is a promise matching the proposal number we're 133 | -- handling 134 | -- * A promise of this acceptor wasn't handled yet 135 | state' = state { acceptors = acceptor : acceptors state 136 | , highestAccepted = selectedAccepted 137 | } 138 | -- Select the `AcceptedValue' to remember: this is the maximum of the 139 | -- one we received before (if any) and the one contained in this 140 | -- message (again, if any) 141 | selectedAccepted = case highestAccepted state of 142 | Nothing -> highestAccepted' 143 | Just v -> case highestAccepted' of 144 | Nothing -> Just v 145 | Just v' -> Just $ max v v' 146 | -- Actions to execute as a result of this state change 147 | -- If we reached (but didn't exceed) the quorum (i.e. a quorum of 148 | -- acceptors sent a promise for the current proposal), send an `Accept' 149 | -- message to all Acceptors. The value contained in this command should 150 | -- be the one of the highest `AcceptedValue' we received in any 151 | -- `Promise', if any. Otherwise, we can use any value we want (or, more 152 | -- likely, the one our user wants to distribute). 153 | msgs = if length (acceptors state') /= fromIntegral (unQuorum $ quorum state') 154 | then [] 155 | else [Broadcast Acceptors $ MsgAccept $ Accept (proposalId state') value'] 156 | -- Retrieve the value to be distributed in an `Accept' message. This is 157 | -- the value of the highest `AcceptedValue' we received as part of 158 | -- `Promise' message, or the value passed by our user initially if 159 | -- none. 160 | value' = maybe (value state') (\(AcceptedValue _ v) -> v) (highestAccepted state') 161 | 162 | prop_handlePromise :: ProposerState Int () 163 | -> Int 164 | -> Promise Int () 165 | -> Bool 166 | prop_handlePromise state acceptor p@(Promise proposalId' highestAccepted') 167 | | proposalId' /= proposalId state = result == (state, []) 168 | | otherwise = 169 | if acceptor `elem` acceptors state 170 | then result == (state, []) 171 | else and [ acceptor `elem` acceptors state' 172 | , length (acceptors state') == length (acceptors state) + 1 173 | , highestAccepted state' == max (highestAccepted state) highestAccepted' 174 | , proposalId state' == proposalId state 175 | , (length (acceptors state') /= fromIntegral (unQuorum $ quorum state')) || 176 | (actions == [Broadcast Acceptors $ MsgAccept $ Accept (proposalId state') value']) 177 | ] 178 | where 179 | result@(state', actions) = handlePromise state acceptor p 180 | value' = maybe (value state') (\(AcceptedValue _ v) -> v) (highestAccepted state') 181 | 182 | 183 | -- | Tests 184 | tests :: Test 185 | tests = testGroup "Network.Paxos.Synod.Proposer" [ 186 | testProperty "startRound1" prop_startRound1 187 | , testProperty "startRound2" prop_startRound2 188 | , testProperty "handlePromise" prop_handlePromise 189 | , testProperty "ProposerState Seralize" $ prop_serialize (undefined :: ProposerState String Int) 190 | ] 191 | -------------------------------------------------------------------------------- /src/Network/Paxos/Synod/Types.hs: -------------------------------------------------------------------------------- 1 | {- Paxos - Implementations of Paxos-related consensus algorithms 2 | - 3 | - Copyright (C) 2012 Nicolas Trangez 4 | - 5 | - This library is free software; you can redistribute it and/or 6 | - modify it under the terms of the GNU Lesser General Public 7 | - License as published by the Free Software Foundation; either 8 | - version 2.1 of the License, or (at your option) any later version. 9 | - 10 | - This library is distributed in the hope that it will be useful, 11 | - but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | - Lesser General Public License for more details. 14 | - 15 | - You should have received a copy of the GNU Lesser General Public 16 | - License along with this library; if not, write to the Free Software 17 | - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 18 | - USA. 19 | -} 20 | 21 | {-# LANGUAGE DeriveDataTypeable #-} 22 | 23 | module Network.Paxos.Synod.Types ( 24 | -- * Proposal identifier handling 25 | ProposalId 26 | , initialProposalId 27 | , succProposalId 28 | , bumpProposalId 29 | 30 | -- * Utilities 31 | , Quorum(unQuorum) 32 | , quorum 33 | , AcceptedValue(..) 34 | 35 | -- * Testing 36 | , tests 37 | ) where 38 | 39 | import Control.Applicative ((<$>), (<*>)) 40 | 41 | import Data.Word (Word, Word64) 42 | 43 | import Data.Serialize 44 | import Data.Serialize.QuickCheck 45 | import Data.Typeable 46 | 47 | import Test.Framework (Test, testGroup) 48 | import Test.Framework.Providers.QuickCheck2 (testProperty) 49 | 50 | import Test.QuickCheck (Arbitrary, arbitrary) 51 | 52 | -- | Representation of a proposal identifier 53 | data ProposalId nodeId = ProposalId {-# UNPACK #-} !Word64 nodeId 54 | deriving (Show, Eq, Typeable) 55 | 56 | -- Note: even though the following instance should be exactly the one 57 | -- derived using `deriving(Ord)', I prefer to provide an explicit 58 | -- implementation 59 | instance Ord nodeId => Ord (ProposalId nodeId) where 60 | compare (ProposalId i1 n1) (ProposalId i2 n2) 61 | | i1 /= i2 = compare i1 i2 62 | | otherwise = compare n1 n2 63 | 64 | instance Serialize nodeId => Serialize (ProposalId nodeId) where 65 | get = ProposalId <$> get <*> get 66 | put (ProposalId i nodeId) = put i >> put nodeId 67 | 68 | instance Arbitrary a => Arbitrary (ProposalId a) where 69 | arbitrary = ProposalId <$> arbitrary <*> arbitrary 70 | 71 | prop_ProposalId_Ord :: ProposalId Int -> ProposalId Int -> Bool 72 | prop_ProposalId_Ord p1@(ProposalId i1 n1) p2@(ProposalId i2 n2) 73 | | i1 > i2 = p1 > p2 74 | | i1 < i2 = p1 < p2 75 | | otherwise = compare p1 p2 == compare n1 n2 76 | 77 | -- | Generate the initial (lowest) 'ProposalId' the given node will ever 78 | -- use 79 | initialProposalId :: nodeId -- ^ Identifier of the node which will send the proposal 80 | -> ProposalId nodeId 81 | initialProposalId = ProposalId 1 82 | 83 | -- | Calculate a new 'ProposalId' which will be greater than the given one, 84 | -- retaining the node identifier 85 | succProposalId :: Ord nodeId 86 | => ProposalId nodeId -- ^ Proposal to increment 87 | -> ProposalId nodeId 88 | succProposalId p = bumpProposalId p p 89 | 90 | prop_succProposalId1 :: ProposalId Int -> Bool 91 | prop_succProposalId1 p = succProposalId p > p 92 | 93 | prop_succProposalId2 :: ProposalId Int -> Bool 94 | prop_succProposalId2 p = succProposalId p < succProposalId (succProposalId p) 95 | 96 | -- | Bump a proposal so it becomes greater than another one, e.g. to 97 | -- restart a round with a higher 'ProposalId' based on `Nack' messages 98 | bumpProposalId :: Ord nodeId 99 | => ProposalId nodeId -- ^ Proposal to bump 100 | -> ProposalId nodeId -- ^ Proposal to exceed 101 | -> ProposalId nodeId 102 | bumpProposalId p1@(ProposalId _ nodeId) p2@(ProposalId i _) 103 | | p1 > p2 = p1 104 | | otherwise = ProposalId (i + 1) nodeId 105 | 106 | prop_bumpProposalId1 :: ProposalId Int -> ProposalId Int -> Bool 107 | prop_bumpProposalId1 p1 p2 = bumpProposalId p1 p2 > p2 108 | 109 | prop_bumpProposalId2 :: ProposalId Int -> ProposalId Int -> Bool 110 | prop_bumpProposalId2 p1 p2 = p2' > p1' 111 | where 112 | p1' = bumpProposalId p1 p2 113 | p2' = bumpProposalId p2 p1' 114 | 115 | -- | Quorum number 116 | newtype Quorum = Quorum { unQuorum :: Word } 117 | deriving (Show, Eq, Ord, Typeable) 118 | 119 | instance Serialize Quorum where 120 | get = Quorum <$> get 121 | put = put . unQuorum 122 | 123 | instance Arbitrary Quorum where 124 | arbitrary = Quorum <$> arbitrary 125 | 126 | -- | Smart constructor for `Quorum' values 127 | quorum :: (Integral a, Ord a) => a -> Quorum 128 | quorum q 129 | | q < 0 = error "quorum: Negative value" 130 | | toInteger q > toInteger (maxBound :: Word) = error "quorum: Overflow" 131 | | otherwise = Quorum $ fromIntegral q 132 | 133 | 134 | -- | Representation of something accepted by an acceptor 135 | data AcceptedValue nodeId value = AcceptedValue { acceptedProposalId :: ProposalId nodeId 136 | , acceptedValue :: value 137 | } 138 | deriving (Show, Typeable) 139 | 140 | -- Explicit Eq and Ord instances so there's no (unnecessary) Eq or Ord 141 | -- constraint on `value', since these should always be equal if the 142 | -- corresponding `ProposalId' is equal, and useless for comparison 143 | instance Eq nodeId => Eq (AcceptedValue nodeId value) where 144 | a == b = acceptedProposalId a == acceptedProposalId b 145 | 146 | instance Ord nodeId => Ord (AcceptedValue nodeId value) where 147 | compare a b = compare (acceptedProposalId a) (acceptedProposalId b) 148 | 149 | instance (Serialize nodeId, Serialize value) => Serialize (AcceptedValue nodeId value) where 150 | get = AcceptedValue <$> get <*> get 151 | put (AcceptedValue p v) = put p >> put v 152 | 153 | instance (Arbitrary nodeId, Arbitrary value) => Arbitrary (AcceptedValue nodeId value) where 154 | arbitrary = AcceptedValue <$> arbitrary <*> arbitrary 155 | 156 | 157 | prop_AcceptedValue_Eq :: AcceptedValue Int () -> AcceptedValue Int () -> Bool 158 | prop_AcceptedValue_Eq a1 a2 = 159 | (a1 == a2) == (acceptedProposalId a1 == acceptedProposalId a2) 160 | 161 | prop_AcceptedValue_Ord :: AcceptedValue Int () -> AcceptedValue Int () -> Bool 162 | prop_AcceptedValue_Ord a1 a2 = 163 | compare a1 a2 == compare (acceptedProposalId a1) (acceptedProposalId a2) 164 | 165 | 166 | -- | Tests 167 | tests :: Test 168 | tests = testGroup "Network.Paxos.Synod.Types" [ 169 | -- ProposalId 170 | testProperty "ProposalId Ord" prop_ProposalId_Ord 171 | , testProperty "ProposalId Serialize" $ prop_serialize (undefined :: ProposalId String) 172 | -- succProposalId 173 | , testProperty "succProposalId1" prop_succProposalId1 174 | , testProperty "succProposalId2" prop_succProposalId2 175 | -- bumpProposalId 176 | , testProperty "bumpProposalId1" prop_bumpProposalId1 177 | , testProperty "bumpProposalId2" prop_bumpProposalId2 178 | -- AcceptedValue 179 | , testProperty "AcceptedValue Eq" prop_AcceptedValue_Eq 180 | , testProperty "AcceptedValue Ord" prop_AcceptedValue_Ord 181 | , testProperty "AcceptedValue Serialize" $ prop_serialize (undefined :: AcceptedValue String Int) 182 | ] 183 | --------------------------------------------------------------------------------