hwormhole (empty) → 0.1.0.0
raw patch · 23 files changed
+3205/−0 lines, 23 filesdep +aesondep +asyncdep +basesetup-changed
Dependencies added: aeson, async, base, binary, binary-conduit, bytestring, conduit, conduit-extra, containers, cryptonite, directory, filepath, haskeline, hedgehog, hex, hspec, hwormhole, magic-wormhole, memory, mtl, network, network-info, optparse-applicative, pathwalk, protolude, random, saltine, spake2, temporary, text, transformers, unix-compat, zip
Files
- ChangeLog.md +10/−0
- LICENSE +674/−0
- Setup.hs +2/−0
- cmd/Main.hs +33/−0
- cmd/Options.hs +76/−0
- hwormhole.cabal +113/−0
- src/Transit.hs +40/−0
- src/Transit/Internal/App.hs +238/−0
- src/Transit/Internal/Conf.hs +32/−0
- src/Transit/Internal/Crypto.hs +105/−0
- src/Transit/Internal/Errors.hs +25/−0
- src/Transit/Internal/FileTransfer.hs +235/−0
- src/Transit/Internal/Messages.hs +167/−0
- src/Transit/Internal/Network.hs +243/−0
- src/Transit/Internal/Peer.hs +401/−0
- src/Transit/Internal/Pipeline.hs +139/−0
- tests/CryptoTests.hs +36/−0
- tests/Generator.hs +84/−0
- tests/Main.hs +17/−0
- tests/MessagesTests.hs +173/−0
- tests/PipelineTests.hs +74/−0
- tests/ProtocolTests.hs +32/−0
- wordlist.txt +256/−0
+ ChangeLog.md view
@@ -0,0 +1,10 @@+# Revision history for haskell-magic-wormhole-client++## 0.1.0.0 -- 2018-12-10++* First version of the haskell port of magic-wormhole client.+* The client can send and receive text messages, files and directories.+* Supports sending to local computers or remote ones via relay.+* Interoperable with the reference Brian Warner's Python client.+* Ability to select custom transit server or relay server.+* Completion help while typing the code at the receiver end.
+ LICENSE view
@@ -0,0 +1,674 @@+ GNU GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The GNU General Public License is a free, copyleft license for+software and other kinds of works.++ The licenses for most software and other practical works are designed+to take away your freedom to share and change the works. By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users. We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors. You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++ To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights. Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received. You must make sure that they, too, receive+or can get the source code. And you must show them these terms so they+know their rights.++ Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++ For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software. For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++ Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so. This is fundamentally incompatible with the aim of+protecting users' freedom to change the software. The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable. Therefore, we+have designed this version of the GPL to prohibit the practice for those+products. If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++ Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary. To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++ The precise terms and conditions for copying, distribution and+modification follow.++ TERMS AND CONDITIONS++ 0. Definitions.++ "This License" refers to version 3 of the GNU General Public License.++ "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++ "The Program" refers to any copyrightable work licensed under this+License. Each licensee is addressed as "you". "Licensees" and+"recipients" may be individuals or organizations.++ To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy. The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++ A "covered work" means either the unmodified Program or a work based+on the Program.++ To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy. Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++ To "convey" a work means any kind of propagation that enables other+parties to make or receive copies. Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++ An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License. If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++ 1. Source Code.++ The "source code" for a work means the preferred form of the work+for making modifications to it. "Object code" means any non-source+form of a work.++ A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++ The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form. A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++ The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities. However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work. For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++ The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++ The Corresponding Source for a work in source code form is that+same work.++ 2. Basic Permissions.++ All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met. This License explicitly affirms your unlimited+permission to run the unmodified Program. The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work. This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++ You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force. You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright. Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++ Conveying under any other circumstances is permitted solely under+the conditions stated below. Sublicensing is not allowed; section 10+makes it unnecessary.++ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.++ No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++ When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++ 4. Conveying Verbatim Copies.++ You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++ You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++ 5. Conveying Modified Source Versions.++ You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++ a) The work must carry prominent notices stating that you modified+ it, and giving a relevant date.++ b) The work must carry prominent notices stating that it is+ released under this License and any conditions added under section+ 7. This requirement modifies the requirement in section 4 to+ "keep intact all notices".++ c) You must license the entire work, as a whole, under this+ License to anyone who comes into possession of a copy. This+ License will therefore apply, along with any applicable section 7+ additional terms, to the whole of the work, and all its parts,+ regardless of how they are packaged. This License gives no+ permission to license the work in any other way, but it does not+ invalidate such permission if you have separately received it.++ d) If the work has interactive user interfaces, each must display+ Appropriate Legal Notices; however, if the Program has interactive+ interfaces that do not display Appropriate Legal Notices, your+ work need not make them do so.++ A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit. Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++ 6. Conveying Non-Source Forms.++ You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++ a) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by the+ Corresponding Source fixed on a durable physical medium+ customarily used for software interchange.++ b) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by a+ written offer, valid for at least three years and valid for as+ long as you offer spare parts or customer support for that product+ model, to give anyone who possesses the object code either (1) a+ copy of the Corresponding Source for all the software in the+ product that is covered by this License, on a durable physical+ medium customarily used for software interchange, for a price no+ more than your reasonable cost of physically performing this+ conveying of source, or (2) access to copy the+ Corresponding Source from a network server at no charge.++ c) Convey individual copies of the object code with a copy of the+ written offer to provide the Corresponding Source. This+ alternative is allowed only occasionally and noncommercially, and+ only if you received the object code with such an offer, in accord+ with subsection 6b.++ d) Convey the object code by offering access from a designated+ place (gratis or for a charge), and offer equivalent access to the+ Corresponding Source in the same way through the same place at no+ further charge. You need not require recipients to copy the+ Corresponding Source along with the object code. If the place to+ copy the object code is a network server, the Corresponding Source+ may be on a different server (operated by you or a third party)+ that supports equivalent copying facilities, provided you maintain+ clear directions next to the object code saying where to find the+ Corresponding Source. Regardless of what server hosts the+ Corresponding Source, you remain obligated to ensure that it is+ available for as long as needed to satisfy these requirements.++ e) Convey the object code using peer-to-peer transmission, provided+ you inform other peers where the object code and Corresponding+ Source of the work are being offered to the general public at no+ charge under subsection 6d.++ A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++ A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling. In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage. For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product. A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++ "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source. The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++ If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information. But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++ The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed. Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++ Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++ 7. Additional Terms.++ "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law. If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++ When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it. (Additional permissions may be written to require their own+removal in certain cases when you modify the work.) You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++ Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++ a) Disclaiming warranty or limiting liability differently from the+ terms of sections 15 and 16 of this License; or++ b) Requiring preservation of specified reasonable legal notices or+ author attributions in that material or in the Appropriate Legal+ Notices displayed by works containing it; or++ c) Prohibiting misrepresentation of the origin of that material, or+ requiring that modified versions of such material be marked in+ reasonable ways as different from the original version; or++ d) Limiting the use for publicity purposes of names of licensors or+ authors of the material; or++ e) Declining to grant rights under trademark law for use of some+ trade names, trademarks, or service marks; or++ f) Requiring indemnification of licensors and authors of that+ material by anyone who conveys the material (or modified versions of+ it) with contractual assumptions of liability to the recipient, for+ any liability that these contractual assumptions directly impose on+ those licensors and authors.++ All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10. If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term. If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++ If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++ Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++ 8. Termination.++ You may not propagate or modify a covered work except as expressly+provided under this License. Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++ However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++ Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++ Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License. If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++ 9. Acceptance Not Required for Having Copies.++ You are not required to accept this License in order to receive or+run a copy of the Program. Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance. However,+nothing other than this License grants you permission to propagate or+modify any covered work. These actions infringe copyright if you do+not accept this License. Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++ 10. Automatic Licensing of Downstream Recipients.++ Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License. You are not responsible+for enforcing compliance by third parties with this License.++ An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations. If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++ You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License. For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++ 11. Patents.++ A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based. The+work thus licensed is called the contributor's "contributor version".++ A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version. For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++ Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++ In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement). To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++ If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients. "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++ If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++ A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License. You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++ Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++ 12. No Surrender of Others' Freedom.++ If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all. For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++ 13. Use with the GNU Affero General Public License.++ Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work. The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++ 14. Revised Versions of this License.++ The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++ Each version is given a distinguishing version number. If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation. If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++ If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++ Later license versions may give you additional or different+permissions. However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++ 15. Disclaimer of Warranty.++ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++ 16. Limitation of Liability.++ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++ 17. Interpretation of Sections 15 and 16.++ If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software: you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation, either version 3 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program. If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++ If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++ <program> Copyright (C) <year> <name of author>+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++ You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++ The GNU General Public License does not permit incorporating your program+into proprietary programs. If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License. But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cmd/Main.hs view
@@ -0,0 +1,33 @@+-- This file is part of hwormhole.++-- hwormhole is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- (at your option) any later version.++-- hwormhole is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.++-- You should have received a copy of the GNU General Public License+-- along with hwormhole. If not, see <http://www.gnu.org/licenses/>.++{-# LANGUAGE OverloadedStrings #-}++module Main where++import Protolude++import qualified Data.Text.IO as TIO+import qualified Transit++import Options++main :: IO ()+main = do+ env <- Transit.prepareAppEnv appid "wordlist.txt" =<< commandlineParser+ result <- Transit.runApp Transit.app env+ either (TIO.putStrLn . show) return result+ where+ appid = "lothar.com/wormhole/text-or-file-xfer"
+ cmd/Options.hs view
@@ -0,0 +1,76 @@+-- This file is part of hwormhole.++-- hwormhole is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- (at your option) any later version.++-- hwormhole is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.++-- You should have received a copy of the GNU General Public License+-- along with hwormhole. If not, see <http://www.gnu.org/licenses/>.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Options+ ( commandlineParser+ )+where++import Protolude++import qualified Options.Applicative as Opt++import qualified Transit++optionsParser :: Opt.Parser Transit.Options+optionsParser+ = Transit.Options+ <$> commandParser+ <*> Opt.option+ (Opt.maybeReader Transit.parseWebSocketEndpoint)+ ( Opt.long "relayserver-url" <>+ Opt.help "Endpoint for the Relay server" <>+ Opt.value defaultEndpoint <>+ Opt.showDefault )+ <*> Opt.option+ (Opt.maybeReader Transit.parseTransitRelayUri)+ ( Opt.long "transit-helper" <>+ Opt.help "Transit relay to use" <>+ Opt.value defaultTransitUrl <>+ Opt.showDefault )+ where+ -- | Default URL for relay server.+ --+ -- This is a relay server run by Brian Warner.+ defaultEndpoint = fromMaybe (panic "Invalid default URL") (Transit.parseWebSocketEndpoint "ws://relay.magic-wormhole.io:4000/v1")+ -- | Default Transit Relay Url+ --+ -- This is a Transit relay run by Brian Warner.+ defaultTransitUrl = fromMaybe (panic "Invalid transit relay URL") (Transit.parseTransitRelayUri "tcp:transit.magic-wormhole.io:4001")++commandParser :: Opt.Parser Transit.Command+commandParser = Opt.hsubparser (sendCommand <> receiveCommand)+ where+ sendCommand = Opt.command "send" (Opt.info sendOptions (Opt.progDesc "send a text message, a file or a directory"))+ receiveCommand = Opt.command "receive" (Opt.info receiveOptions (Opt.progDesc "receive a text message"))+ receiveOptions :: Opt.Parser Transit.Command+ receiveOptions = Transit.Receive <$> optional (Opt.strArgument (Opt.metavar "CODE"))+ sendOptions :: Opt.Parser Transit.Command+ sendOptions = Transit.Send <$> parseMessageType+ parseMessageType :: Opt.Parser Transit.MessageType+ parseMessageType = msgParser <|> fileOrDirParser+ msgParser :: Opt.Parser Transit.MessageType+ msgParser = Transit.TMsg <$> Opt.strOption (Opt.long "text" <> Opt.help "Text message to send")+ fileOrDirParser :: Opt.Parser Transit.MessageType+ fileOrDirParser = Transit.TFile <$> Opt.strArgument (Opt.metavar "FILENAME" <> Opt.help "file path")++opts :: Opt.ParserInfo Transit.Options+opts = Opt.info (Opt.helper <*> optionsParser) (Opt.fullDesc <> Opt.header "wormhole")++commandlineParser :: IO Transit.Options+commandlineParser = Opt.execParser opts
+ hwormhole.cabal view
@@ -0,0 +1,113 @@+-- Initial haskell-magic-wormhole-client.cabal generated by cabal init.+-- For further documentation, see http://haskell.org/cabal/users-guide/++name: hwormhole+version: 0.1.0.0+synopsis: magic-wormhole client+description: A secure way to send files over the Internet using the magic-wormhole protocol+license: GPL-3+license-file: LICENSE+author: Ramakrishnan Muthukrishnan+maintainer: ram@leastauthority.com+copyright: (c) 2018 Least Authority TFA Gmbh+category: Network+build-type: Simple+extra-source-files: ChangeLog.md+cabal-version: 1.24+data-files: wordlist.txt++source-repository head+ type: git+ location: https://github.com/LeastAuthority/wormhole-client++library+ hs-source-dirs: src+ exposed-modules: Transit+ , Transit.Internal.App+ , Transit.Internal.Conf+ , Transit.Internal.Errors+ , Transit.Internal.FileTransfer+ , Transit.Internal.Network+ , Transit.Internal.Peer+ , Transit.Internal.Messages+ , Transit.Internal.Pipeline+ , Transit.Internal.Crypto+ build-depends: aeson >= 1.4 && < 2+ , async >= 2.1.0 && < 3.0+ , base >= 4.6 && < 5+ , binary >= 0.7 && < 1.0+ , bytestring >= 0.9 && < 1.0+ , conduit >= 1.2.13 && < 2.0+ , conduit-extra > 1.0.0 && < 2.0+ , containers >= 0.5.10 && < 1.0+ , cryptonite >= 0.24 && < 1.0+ , directory >= 1.3 && < 2.0+ , filepath >= 1.4.0 && < 2.0+ , haskeline >= 0.7.4 && < 1.0+ , hex >= 0.1.2 && < 1.0+ , magic-wormhole >= 0.2.1 && < 1.0+ , memory >= 0.14.15 && < 1.0+ , mtl >= 2.2.2 && < 3.0+ , network >= 2.7 && < 3+ , network-info >= 0.2.0 && < 1.0+ , pathwalk >= 0.3.1.2 && < 1.0+ , protolude >= 0.2.1 && < 1.0+ , random >= 1.1 && < 2.0+ , saltine == 0.1.0.1 && < 1.0+ , spake2 >= 0.4 && < 1.0+ , temporary >= 1.3 && < 2.0+ , text >= 1.2.1 && < 2.0+ , transformers >= 0.5.5 && < 1.0+ , unix-compat >= 0.5.0 && < 1.0+ , zip >= 1.2.0 && < 2.0+ other-modules: Paths_hwormhole+ default-language: Haskell2010+ default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications+ ghc-options: -Wall -Werror=incomplete-patterns++executable hwormhole-exe+ main-is: Main.hs+ other-modules: Options+ -- other-extensions:+ build-depends: base >=4.6 && <5+ , bytestring+ , aeson >=1.4 && <2+ , binary+ , hwormhole+ , optparse-applicative+ , protolude+ , text+ , transformers+ hs-source-dirs: cmd+ default-language: Haskell2010+ default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications+ ghc-options: -Wall -Werror=incomplete-patterns++test-suite hwormhole-tests+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: tests+ default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications+ ghc-options: -Wall -Werror=incomplete-patterns+ build-depends: base >=4.6 && <5+ , bytestring+ , aeson >=1.4 && <2+ , bytestring+ , conduit+ , containers+ , binary+ , binary-conduit+ , conduit-extra+ , text+ , protolude+ , hspec+ , saltine+ , hwormhole+ , magic-wormhole+ , hedgehog+ other-modules: ProtocolTests+ , MessagesTests+ , PipelineTests+ , CryptoTests+ , Generator+ default-language: Haskell2010
+ src/Transit.hs view
@@ -0,0 +1,40 @@+-- |+-- Description : A Magic Wormhole library that supports file and directory transfer.+--+-- Magic Wormhole is a technology for getting things from one computer to another, safely.+--+-- To use it, you must use the MagicWormhole library to first establish an encrypted connection:+--+-- 1. Start a 'Rendezvous.Session' with the Rendezvous server, to allow peers to find each other ('Rendezvous.runClient')+-- 2. Negotiate a shared 'Messages.Nameplate' so peers can find each other on the server ('Rendezvous.allocate', 'Rendezvous.list')+-- 3. Use the shared 'Messages.Nameplate' to 'Rendezvous.open' a shared 'Messages.Mailbox'+-- 4. Use a secret password shared between peers to establish an encrypted connection ('Peer.withEncryptedConnection')+--+-- Once you've done this, you can communicate with your peer via 'Transit.send' and 'Transit.receive'.+-- Once can send and receive either Text messages or Files.+--+-- The password is never sent over the wire.+-- Rather, it is used to negotiate a session key using SPAKE2,+-- and that key itself is used to derive many per-message keys,+-- so that each message is encrypted using NaCl SecretBox.+--+module Transit+ ( App.Env(..)+ , App.prepareAppEnv+ , App.app+ , App.runApp+ , Conf.Options(..)+ , Conf.Command(..)+ , Errors.Error(..)+ , FileTransfer.MessageType(..)+ , MagicWormhole.parseWebSocketEndpoint+ , Network.parseTransitRelayUri+ )+where++import qualified Transit.Internal.FileTransfer as FileTransfer+import qualified Transit.Internal.Network as Network+import qualified Transit.Internal.Errors as Errors+import qualified Transit.Internal.Conf as Conf+import qualified Transit.Internal.App as App+import qualified MagicWormhole
+ src/Transit/Internal/App.hs view
@@ -0,0 +1,238 @@+-- | Description: a file transfer monad transformer+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Transit.Internal.App+ ( Env(..)+ , prepareAppEnv+ , app+ , runApp+ )+where++import Protolude++import qualified Data.Text as Text+import qualified Data.Text.IO as TIO+import qualified MagicWormhole+import qualified System.Console.Haskeline as H+import qualified System.Console.Haskeline.Completion as HC+import qualified Crypto.Spake2 as Spake2++import System.IO.Error (IOError)+import System.Random (randomR, getStdGen)+import Data.String (String)+import Control.Monad.Trans.Except (ExceptT(..))+import Control.Monad.Except (liftEither)++import Transit.Internal.Conf (Options(..), Command(..))+import Transit.Internal.Errors (Error(..), CommunicationError(..))+import Transit.Internal.FileTransfer(MessageType(..), sendFile, receiveFile)+import Transit.Internal.Peer (sendOffer, receiveOffer, receiveMessageAck, sendMessageAck, decodeTransitMsg)+import Paths_hwormhole++type Password = ByteString++-- | Magic Wormhole transit app environment+data Env+ = Env { appID :: MagicWormhole.AppID+ -- ^ Application specific ID+ , side :: MagicWormhole.Side+ -- ^ random 5-byte bytestring+ , config :: Options+ -- ^ configuration like relay and transit url+ , wordList :: [(Text, Text)]+ -- ^ pass code word list (list of pair of words)+ }++-- | genWordlist would produce a list of the form+-- [ ("aardwark", "adroitness"),+-- ("absurd", "adviser"),+-- ....+-- ("zulu", "yucatan") ]+genWordList :: FilePath -> IO [(Text, Text)]+genWordList wordlistFile = do+ file <- TIO.readFile wordlistFile+ let contents = map toWordPair $ Text.lines file+ return contents+ where+ toWordPair :: Text -> (Text, Text)+ toWordPair line =+ let ws = map Text.toLower $ Text.words line+ Just firstWord = atMay ws 1+ Just sndWord = atMay ws 2+ in (firstWord, sndWord)+++-- | Create an 'Env', given the AppID, wordlist file and 'Options'+prepareAppEnv :: Text -> FilePath -> Options -> IO Env+prepareAppEnv appid wordlistPath options = do+ side' <- MagicWormhole.generateSide+ wordlist <- genWordList =<< getDataFileName wordlistPath+ let appID' = MagicWormhole.AppID appid+ return $ Env appID' side' options wordlist++allocatePassword :: [(Text, Text)] -> IO Text+allocatePassword wordlist = do+ g <- getStdGen+ let (r1, g') = randomR (0, 255) g+ (r2, _) = randomR (0, 255) g'+ Just evenW = fst <$> atMay wordlist r2+ Just oddW = snd <$> atMay wordlist r1+ return $ Text.concat [oddW, "-", evenW]++genPasscodes :: [Text] -> [(Text, Text)] -> [Text]+genPasscodes nameplates wordpairs =+ let evens = map fst wordpairs+ odds = map snd wordpairs+ wordCombos = [ o <> "-" <> e | o <- odds, e <- evens ]+ in+ [ n <> "-" <> hiphenWord | n <- nameplates, hiphenWord <- wordCombos ]++printSendHelpText :: Text -> IO ()+printSendHelpText passcode = do+ TIO.putStrLn $ "Wormhole code is: " <> passcode+ TIO.putStrLn "On the other computer, please run:"+ TIO.putStrLn ""+ TIO.putStrLn $ "wormhole receive " <> passcode++completeWord :: MonadIO m => [Text] -> HC.CompletionFunc m+completeWord wordlist = HC.completeWord Nothing "" completionFunc+ where+ completionFunc :: Monad m => String -> m [HC.Completion]+ completionFunc word = do+ let completions = filter (toS word `Text.isPrefixOf`) wordlist+ return $ map (HC.simpleCompletion . toS) completions++-- | Take an input code from the user with code completion.+-- In order for the code completion to work, we need to find+-- the possible open nameplates, the possible words and then+-- do the completion as the user types the code.+-- TODO: This function does too much. Perfect target for refactoring.+getCode :: MagicWormhole.Session -> [(Text, Text)] -> IO Text+getCode session wordlist = do+ nameplates <- MagicWormhole.list session+ let ns = [ n | MagicWormhole.Nameplate n <- nameplates ]+ putText "Enter the receive wormhole code: "+ H.runInputT (settings (genPasscodes ns wordlist)) getInput+ where+ settings :: MonadIO m => [Text] -> H.Settings m+ settings possibleWords = H.Settings+ { H.complete = completeWord possibleWords+ , H.historyFile = Nothing+ , H.autoAddHistory = False+ }+ getInput :: H.InputT IO Text+ getInput = do+ minput <- H.getInputLine ""+ case minput of+ Nothing -> return ""+ Just input -> return (toS input)++-- | App Monad Transformer that reads the configuration from 'Env', runs+-- a computation over the IO Monad and returns either the value 'a' or 'Error'+newtype App a = App {+ getApp :: ReaderT Env (ExceptT Error IO) a+ } deriving (Functor, Applicative, Monad, MonadIO, MonadReader Env, MonadError Error)++-- | run the App Monad Transformer+runApp :: App a -> Env -> IO (Either Error a)+runApp appM env = runExceptT (runReaderT (getApp appM) env)++-- | Given the magic-wormhole session, appid, password, a function to print a helpful message+-- on the command the receiver needs to type (simplest would be just a `putStrLn`) and the+-- path on the disk of the sender of the file that needs to be sent, `sendFile` sends it via+-- the wormhole securely. The receiver, on successfully receiving the file, would compute+-- a sha256 sum of the encrypted file and sends it across to the sender, along with an+-- acknowledgement, which the sender can verify.+send :: MagicWormhole.Session -> Password -> MessageType -> App ()+send session password tfd = do+ env <- ask+ -- first establish a wormhole session with the receiver and+ -- then talk the filetransfer protocol over it as follows.+ let options = config env+ let appid = appID env+ let transitserver = transitUrl options+ nameplate <- liftIO $ MagicWormhole.allocate session+ mailbox <- liftIO $ MagicWormhole.claim session nameplate+ peer <- liftIO $ MagicWormhole.open session mailbox -- XXX: We should run `close` in the case of exceptions?+ let (MagicWormhole.Nameplate n) = nameplate+ liftIO $ printSendHelpText $ toS n <> "-" <> toS password+ result <- liftIO $ MagicWormhole.withEncryptedConnection peer (Spake2.makePassword (toS n <> "-" <> password))+ (\conn ->+ case tfd of+ TMsg msg -> do+ let offer = MagicWormhole.Message msg+ sendOffer conn offer+ -- wait for "answer" message with "message_ack" key+ first NetworkError <$> receiveMessageAck conn+ TFile filepath ->+ sendFile conn transitserver appid filepath+ )+ liftEither result++-- | receive a text message or file from the wormhole peer.+receive :: MagicWormhole.Session -> Text -> App ()+receive session code = do+ env <- ask+ -- establish the connection+ let options = config env+ let appid = appID env+ let transitserver = transitUrl options+ let codeSplit = Text.split (=='-') code+ let (Just nameplate) = headMay codeSplit+ mailbox <- liftIO $ MagicWormhole.claim session (MagicWormhole.Nameplate nameplate)+ peer <- liftIO $ MagicWormhole.open session mailbox+ result <- liftIO $ MagicWormhole.withEncryptedConnection peer (Spake2.makePassword (toS (Text.strip code)))+ (\conn -> do+ -- unfortunately, the receiver has no idea which message to expect.+ -- If the sender is only sending a text message, it gets an offer first.+ -- if the sender is sending a file/directory, then transit comes first+ -- and then offer comes in. `Transit.receiveOffer' will attempt to interpret+ -- the bytestring as an offer message. If that fails, it passes the raw bytestring+ -- as a Left value so that we can try to decode it as a TransitMsg.+ someOffer <- receiveOffer conn+ case someOffer of+ Right (MagicWormhole.Message message) -> do+ TIO.putStrLn message+ result <- try (sendMessageAck conn "ok") :: IO (Either IOError ())+ return $ bimap (const (NetworkError (ConnectionError "sending the ack message failed"))) identity result+ Right (MagicWormhole.File _ _) -> do+ sendMessageAck conn "not_ok"+ return $ Left (NetworkError (ConnectionError "did not expect a file offer"))+ Right MagicWormhole.Directory {} ->+ return $ Left (NetworkError (UnknownPeerMessage "directory offer is not supported"))+ -- ok, we received the Transit Message, send back a transit message+ Left received ->+ case decodeTransitMsg (toS received) of+ Left e -> return $ Left (NetworkError e)+ Right transitMsg ->+ receiveFile conn transitserver appid transitMsg+ )+ liftEither result++-- | A file transfer application that takes an 'Env' and depending on the+-- config options, either sends or receives a file, directory or a text+-- message from the peer.+app :: App ()+app = do+ env <- ask+ let options = config env+ endpoint = relayEndpoint options+ case cmd options of+ Send tfd ->+ liftIO (MagicWormhole.runClient endpoint (appID env) (side env) $ \session ->+ runApp (sendSession tfd session) env) >>= liftEither+ Receive maybeCode ->+ liftIO (MagicWormhole.runClient endpoint (appID env) (side env) $ \session ->+ runApp (receiveSession maybeCode session) env) >>= liftEither+ where+ getWormholeCode :: MagicWormhole.Session -> [(Text, Text)] -> Maybe Text -> IO Text+ getWormholeCode session wordlist Nothing = getCode session wordlist+ getWormholeCode _ _ (Just code) = return code+ sendSession offerMsg session = do+ env <- ask+ password <- liftIO $ allocatePassword (wordList env)+ send session (toS password) offerMsg+ receiveSession code session = do+ env <- ask+ maybeCode <- liftIO $ getWormholeCode session (wordList env) code+ receive session maybeCode
+ src/Transit/Internal/Conf.hs view
@@ -0,0 +1,32 @@+-- | Description: Application Configuration+module Transit.Internal.Conf+ ( Options(..)+ , Command(..)+ )+where++import Protolude++import qualified MagicWormhole++import Transit.Internal.Network (RelayEndpoint)+import Transit.Internal.FileTransfer (MessageType)++-- | Application Configuration options+data Options+ = Options+ { cmd :: Command+ -- ^ send or receive+ , relayEndpoint :: MagicWormhole.WebSocketEndpoint+ -- ^ Rendezvous server websocket endpoint URL+ , transitUrl :: RelayEndpoint+ -- ^ Transit Relay URL+ } deriving (Eq, Show)++-- | Commands+data Command+ = Send MessageType+ -- ^ Send a file, directory or a text message+ | Receive (Maybe Text)+ -- ^ Receive a file, directory or a text message+ deriving (Eq, Show)
+ src/Transit/Internal/Crypto.hs view
@@ -0,0 +1,105 @@+-- | Description: functions and types that deal with Cryptography+module Transit.Internal.Crypto+ ( encrypt+ , decrypt+ , PlainText(..)+ , CipherText(..)+ , deriveKeyFromPurpose+ , Purpose(..)+ , CryptoError(..)+ )+where++import Protolude++import qualified Control.Exception as E+import qualified Data.ByteString as BS+import qualified Crypto.Saltine.Class as Saltine+import qualified Crypto.Saltine.Core.SecretBox as SecretBox+import Crypto.Saltine.Internal.ByteSizes (boxNonce)+import qualified Crypto.KDF.HKDF as HKDF+import Crypto.Hash (SHA256(..))+import qualified Crypto.Saltine.Internal.ByteSizes as ByteSizes++-- | Type for representing unencrypted plain text+newtype PlainText = PlainText ByteString+ deriving (Eq, Show)++-- | Type for representing encrypted cipher text.+newtype CipherText = CipherText ByteString+ deriving (Eq)++-- | Error Type for exceptions thrown by the Crypto module+data CryptoError = BadNonce Text+ -- ^ The nonce value in the received message is invalid.+ | CouldNotDecrypt Text+ -- ^ We could not decrypt the incoming encrypted record.+ | KeyGenError Text+ -- ^ Could not generate transit keys.+ deriving (Eq, Show)++instance E.Exception CryptoError++-- | decrypt the bytestring representing ciphertext block with+-- the given key. It is assumed that the ciphertext bytestring+-- is nonce followed by the actual encrypted data.+decrypt :: SecretBox.Key -> CipherText -> Either CryptoError (PlainText, SecretBox.Nonce)+decrypt key (CipherText ciphertext) =+ -- extract nonce from ciphertext.+ let (nonceBytes, record) = BS.splitAt boxNonce ciphertext+ maybeResult = Saltine.decode nonceBytes >>=+ \nonce -> SecretBox.secretboxOpen key nonce record >>=+ \plaintext -> return (plaintext, nonce)+ in+ case maybeResult of+ Just (plaintext, nonce) -> Right (PlainText plaintext, nonce)+ Nothing -> Left (CouldNotDecrypt "SecretBox failed to open")++-- | encrypt the given chunk with the given secretbox key and nonce.+-- Saltine's nonce seem represented as a big endian bytestring.+-- However, to interop with the wormhole python client, we need to+-- use and send nonce as a little endian bytestring.+encrypt :: SecretBox.Key -> SecretBox.Nonce -> PlainText -> Either CryptoError CipherText+encrypt key nonce (PlainText plaintext) =+ let nonceLE = BS.reverse $ toS $ Saltine.encode nonce+ maybeResult = Saltine.decode (toS nonceLE) >>=+ \newNonce -> Just (toS (SecretBox.secretbox key newNonce plaintext))+ in+ case maybeResult of+ Just ciphertext -> Right (CipherText (nonceLE <> ciphertext))+ Nothing -> Left (BadNonce "encrypt: could not decode nonce")++hkdf :: ByteString -> SecretBox.Key -> ByteString -> ByteString+hkdf salt key purpose =+ HKDF.expand (HKDF.extract salt (Saltine.encode key) :: HKDF.PRK SHA256) purpose keySize+ where+ keySize = ByteSizes.secretBoxKey++-- | Various purpose types for key derivation.+--+-- Normally used with 'deriveKeyFromPurpose'.+data Purpose+ = SenderHandshake+ -- ^ Purpose type to be used by transit sender.+ | ReceiverHandshake+ -- ^ Purpose type to be used by transit receiver.+ | SenderRecord+ -- ^ Purpose type to be used for encrypting records.+ | ReceiverRecord+ -- ^ Purpose type to be used for decrypting records.+ | RelayHandshake+ -- ^ Purpose type to be used for transit relay handshake.+ deriving (Eq, Show)++-- | derive a new purpose-specific key from a master key.+deriveKeyFromPurpose :: Purpose -> SecretBox.Key -> ByteString+deriveKeyFromPurpose purpose key =+ hkdf salt key (purposeStr purpose)+ where+ salt = "" :: ByteString+ purposeStr :: Purpose -> ByteString+ purposeStr SenderHandshake = "transit_sender"+ purposeStr ReceiverHandshake = "transit_receiver"+ purposeStr SenderRecord = "transit_record_sender_key"+ purposeStr ReceiverRecord = "transit_record_receiver_key"+ purposeStr RelayHandshake = "transit_relay_token"
+ src/Transit/Internal/Errors.hs view
@@ -0,0 +1,25 @@+-- | Description: Module for representing Error types+module Transit.Internal.Errors+ ( -- * Error+ Error(..)+ , N.CommunicationError(..)+ , P.InvalidHandshake+ , C.CryptoError+ )+where++import Protolude++import qualified Control.Exception as E++import qualified Transit.Internal.Network as N+import qualified Transit.Internal.Crypto as C+import qualified Transit.Internal.Peer as P++-- | An Error type for the Magic Wormhole Transit Module+data Error = CipherError C.CryptoError+ | NetworkError N.CommunicationError+ | HandshakeError P.InvalidHandshake+ deriving (Show)++instance E.Exception Error
+ src/Transit/Internal/FileTransfer.hs view
@@ -0,0 +1,235 @@+-- | Description: Functions for sending and receiving files/directories+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+module Transit.Internal.FileTransfer+ ( sendFile+ , receiveFile+ , MessageType(..)+ )+where++import Protolude++import qualified Data.Aeson as Aeson+import qualified Conduit as C+import qualified Data.Set as Set+import qualified Data.ByteString.Lazy as BL++import Network.Socket (socketPort, Socket)+import System.FilePath ((</>))+import System.Directory (removeFile, getTemporaryDirectory)+import System.IO.Temp (createTempDirectory)++import qualified MagicWormhole++import Transit.Internal.Errors (Error(..))+import Transit.Internal.Crypto (CipherText(..))+import Transit.Internal.Network+ ( tcpListener+ , buildHints+ , buildRelayHints+ , startServer+ , startClient+ , closeConnection+ , RelayEndpoint+ , CommunicationError(..)+ , TransitEndpoint(..))++import Transit.Internal.Peer+ ( makeRecordKeys+ , senderHandshakeExchange+ , senderTransitExchange+ , senderOfferExchange+ , receiveWormholeMessage+ , sendTransitMsg+ , sendWormholeMessage+ , receiverHandshakeExchange+ , makeAckMessage+ , generateTransitSide+ , sendRecord+ , receiveRecord+ , unzipInto)++import Transit.Internal.Messages+ ( TransitMsg( Transit, Answer )+ , Ability(..)+ , AbilityV1(..)+ , Ack( FileAck )+ , TransitAck (..))++import Transit.Internal.Pipeline+ ( sendPipeline+ , receivePipeline)++-- | Transfer type+data MessageType+ = TMsg Text+ -- ^ Text message transfer+ | TFile FilePath+ -- ^ File or Directory transfer+ deriving (Show, Eq)++transitPurpose :: MagicWormhole.AppID -> ByteString+transitPurpose (MagicWormhole.AppID appID) = toS appID <> "/transit-key"++sendAckMessage :: TransitEndpoint -> ByteString -> IO (Either Error ())+sendAckMessage (TransitEndpoint ep _ key) sha256Sum = do+ let ackMessage = makeAckMessage key sha256Sum+ case ackMessage of+ Right (CipherText encMsg) -> do+ res <- sendRecord ep encMsg+ return $ bimap NetworkError (const ()) res+ Left e -> return $ Left (CipherError e)++receiveAckMessage :: TransitEndpoint -> IO (Either Error Text)+receiveAckMessage (TransitEndpoint ep _ key) = do+ ackBytes <- (fmap . fmap) BL.fromStrict (receiveRecord ep key)+ case ackBytes of+ Left e -> return $ Left (CipherError e)+ Right ack' ->+ case Aeson.eitherDecode ack' of+ Right (TransitAck msg checksum) | msg == "ok" -> return (Right checksum)+ | otherwise -> return $ Left (NetworkError (TransitError "transit ack failure"))+ Left s -> return $ Left (NetworkError (TransitError (toS ("transit ack failure: " <> s))))++establishSenderTransit :: MagicWormhole.EncryptedConnection -> RelayEndpoint -> MagicWormhole.AppID -> IO (Either Error TransitEndpoint)+establishSenderTransit conn transitserver appid = do+ -- exchange abilities+ sock' <- tcpListener+ portnum <- socketPort sock'+ side <- generateTransitSide+ ourHints <- buildHints portnum transitserver+ let ourRelayHints = buildRelayHints transitserver+ transitResp <- senderTransitExchange conn (Set.toList ourHints)+ case transitResp of+ Left s -> return $ Left (NetworkError s)+ Right (Transit _peerAbilities peerHints) -> do+ -- combine our relay hints with peer's direct and relay hints+ let allHints = Set.toList $ ourRelayHints <> peerHints+ -- concurrently start client and server+ transitEndpoint <- race (startServer sock') (startClient allHints)+ let ep = either identity identity transitEndpoint+ case ep of+ Left e -> return (Left (NetworkError e))+ Right endpoint -> do+ -- 0. derive transit key+ let transitKey = MagicWormhole.deriveKey conn (transitPurpose appid)+ -- 1. create record keys+ recordKeys = makeRecordKeys transitKey+ case recordKeys of+ Left e -> return (Left (CipherError e))+ Right (sRecordKey, rRecordKey) -> do+ -- 2. handshakeExchange+ handshake <- senderHandshakeExchange endpoint transitKey side+ -- if handshakeExchange is successful, return the TCPEndpoint+ -- as, we now have a "secure" socket to communicate.+ case handshake of+ Left e -> return (Left (HandshakeError e))+ Right _ -> return $ Right (TransitEndpoint endpoint sRecordKey rRecordKey)+ Right _ -> return $ Left (NetworkError (UnknownPeerMessage "Could not decode message"))++establishReceiverTransit :: MagicWormhole.EncryptedConnection -> RelayEndpoint -> MagicWormhole.AppID -> TransitMsg -> Socket -> IO (Either Error TransitEndpoint)+establishReceiverTransit conn transitserver appid (Transit _peerAbilities peerHints) socket = do+ let ourRelayHints = buildRelayHints transitserver+ side <- generateTransitSide+ -- combine our relay hints with peer's direct and relay hints+ let allHints = Set.toList (peerHints <> ourRelayHints)+ -- derive transit key+ let transitKey = MagicWormhole.deriveKey conn (transitPurpose appid)+ transitEndpoint <- race (startServer socket) (startClient allHints)+ let ep = either identity identity transitEndpoint+ case ep of+ Left e -> return (Left (NetworkError e))+ Right endpoint -> do+ -- create sender/receiver record key, sender record key+ -- for decrypting incoming records, receiver record key+ -- for sending the file_ack back at the end.+ let recordKeys = makeRecordKeys transitKey+ case recordKeys of+ Left e -> return $ Left (CipherError e)+ Right (sRecordKey, rRecordKey) -> do+ -- handshakeExchange+ handshake <- receiverHandshakeExchange endpoint transitKey side+ case handshake of+ Left e -> return (Left (HandshakeError e))+ Right _ -> return $ Right (TransitEndpoint endpoint sRecordKey rRecordKey)+establishReceiverTransit _ _ _ _ _ = return $ Left (NetworkError (UnknownPeerMessage "Could not recognize the message"))++-- | Given the magic-wormhole session, appid, password, a function to print a helpful message+-- on the command the receiver needs to type (simplest would be just a `putStrLn`) and the+-- path on the disk of the sender of the file that needs to be sent, `sendFile` sends it via+-- the wormhole securely. The receiver, on successfully receiving the file, would compute+-- a sha256 sum of the encrypted file and sends it across to the sender, along with an+-- acknowledgement, which the sender can verify.+sendFile :: MagicWormhole.EncryptedConnection -> RelayEndpoint -> MagicWormhole.AppID -> FilePath -> IO (Either Error ())+sendFile conn transitserver appid filepath = do+ -- establish a transit connection+ endpoint <- establishSenderTransit conn transitserver appid+ case endpoint of+ Left e -> return $ Left e+ Right ep -> do+ -- send offer for the file+ offerResp <- senderOfferExchange conn filepath+ case offerResp of+ Left s -> return (Left (NetworkError (OfferError s)))+ Right pathToSend -> do+ (rxAckMsg, txSha256Hash) <-+ finally+ (do -- send encrypted records to the peer+ (txSha256Hash, _) <- C.runConduitRes (sendPipeline pathToSend ep)+ -- read a record that should contain the transit Ack.+ -- If ack is not ok or the sha256sum is incorrect, flag an error.+ rxAckMsg <- receiveAckMessage ep+ return (rxAckMsg, txSha256Hash))+ (closeConnection ep)+ case rxAckMsg of+ Right rxSha256Hash ->+ if txSha256Hash /= rxSha256Hash+ then return $ Left (NetworkError (Sha256SumError "sha256 mismatch"))+ else return (Right ())+ Left e -> return $ Left e++-- | Receive a file or directory via the established MagicWormhole connection+receiveFile :: MagicWormhole.EncryptedConnection -> RelayEndpoint -> MagicWormhole.AppID -> TransitMsg -> IO (Either Error ())+receiveFile conn transitserver appid transit = do+ let abilities' = [Ability DirectTcpV1, Ability RelayV1]+ s <- tcpListener+ portnum <- socketPort s+ ourHints <- buildHints portnum transitserver+ sendTransitMsg conn abilities' (Set.toList ourHints)+ -- now expect an offer message+ offerMsg <- receiveWormholeMessage conn+ case Aeson.eitherDecode (toS offerMsg) of+ Left err -> return $ Left (NetworkError (OfferError $ "unable to decode offer msg: " <> toS err))+ Right (MagicWormhole.File name size) -> rxFile s name size+ Right (MagicWormhole.Directory _mode name zipSize _ _uncompressedSize) -> do+ systemTmpDir <- getTemporaryDirectory+ tmpDir <- createTempDirectory systemTmpDir "wormhole"+ let zipFile = tmpDir </> (toS name)+ _ <- rxFile s zipFile zipSize+ -- TODO: check if the file system containing the current directory has+ -- enough space, by checking the uncompressedSize and the free space.+ _ <- unzipInto (toS name) zipFile+ Right <$> removeFile zipFile+ Right _ -> return $ Left (NetworkError (UnknownPeerMessage "cannot decipher the message from peer"))+ where+ rxFile socket name size = do+ -- TODO: if the file already exist in the current dir, abort.+ -- send an answer message with file_ack.+ let ans = Answer (FileAck "ok")+ sendWormholeMessage conn (Aeson.encode ans)+ -- establish receive transit endpoint+ endpoint <- establishReceiverTransit conn transitserver appid transit socket+ case endpoint of+ Left e -> return $ Left e+ Right ep -> do+ _ <- finally+ (do+ -- receive and decrypt records (length followed by length+ -- sized packets). Also keep track of decrypted size in+ -- order to know when to send the file ack at the end.+ (rxSha256Sum, ()) <- C.runConduitRes $ receivePipeline name (fromIntegral size) ep+ sendAckMessage ep (toS rxSha256Sum))+ (closeConnection ep)+ return $ Right ()+
+ src/Transit/Internal/Messages.hs view
@@ -0,0 +1,167 @@+-- | Description: Client-to-Client messages+-- The JSON messages are derived from these Message types.+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Transit.Internal.Messages+ ( TransitMsg(..)+ , Ability(..)+ , AbilityV1(..)+ , Hint(..)+ , ConnectionHint(..)+ , Ack(..)+ , TransitAck(..)+ ) where++import Protolude++import Data.Aeson+ ( FromJSON(..)+ , ToJSON(..)+ , genericToJSON+ , genericParseJSON+ , defaultOptions+ , fieldLabelModifier+ , constructorTagModifier+ , sumEncoding+ , SumEncoding(..)+ , camelTo2+ )++import qualified Data.Set as Set++-- | Type to represent the abilities+data AbilityV1+ = DirectTcpV1+ -- ^ Can send directly via TCP+ | RelayV1+ -- ^ Can relay via a relay server+ deriving (Eq, Show, Generic)++instance ToJSON AbilityV1 where+ toJSON = genericToJSON+ defaultOptions { constructorTagModifier = camelTo2 '-'}++instance FromJSON AbilityV1 where+ parseJSON = genericParseJSON+ defaultOptions { constructorTagModifier = camelTo2 '-'}++-- | Hints are messages that specify ways that the client+-- can connect to the peer.+data Hint = Hint { ctype :: AbilityV1+ , priority :: Double+ , hostname :: Text+ , port :: Word16 }+ deriving (Eq, Show, Generic)++instance Ord Hint where+ Hint _ p1 _ _ `compare` Hint _ p2 _ _ = Down p1 `compare` Down p2++instance ToJSON Hint where+ toJSON = genericToJSON+ defaultOptions { fieldLabelModifier =+ \name -> case name of+ "ctype" -> "type"+ _ -> name }++instance FromJSON Hint where+ parseJSON = genericParseJSON+ defaultOptions { fieldLabelModifier =+ \name -> case name of+ "ctype" -> "type"+ _ -> name }++-- | Connection Hint is currently a direct hint or a relay hint+data ConnectionHint+ = Direct Hint+ -- ^ Direct Hint+ | Relay { rtype :: AbilityV1+ , hints :: [Hint] }+ -- ^ Relay hint+ deriving (Eq, Show, Generic)++instance Ord ConnectionHint where+ Direct _ `compare` Direct _ = EQ+ Direct _ `compare` Relay _ _ = LT+ Relay _ h1 `compare` Relay _ h2 = h1 `compare` h2+ Relay _ _ `compare` Direct _ = GT++instance ToJSON ConnectionHint where+ toJSON = genericToJSON+ defaultOptions { sumEncoding = UntaggedValue+ , fieldLabelModifier =+ \name -> case name of+ "rtype" -> "type"+ _ -> name }+instance FromJSON ConnectionHint where+ parseJSON = genericParseJSON+ defaultOptions { sumEncoding = UntaggedValue+ , fieldLabelModifier =+ \name -> case name of+ "rtype" -> "type"+ _ -> name }+-- | Ack message type+data Ack = FileAck Text+ -- ^ File Ack+ | MessageAck Text+ -- ^ Message Ack+ deriving (Eq, Show, Generic)++instance ToJSON Ack where+ toJSON = genericToJSON+ defaultOptions { sumEncoding = ObjectWithSingleField+ , constructorTagModifier = camelTo2 '_'}++instance FromJSON Ack where+ parseJSON = genericParseJSON+ defaultOptions { sumEncoding = ObjectWithSingleField+ , constructorTagModifier = camelTo2 '_'}++-- | A newtype specifically for generating Ability JSON messages+newtype Ability = Ability { atype :: AbilityV1 }+ deriving (Eq, Show, Generic)++instance ToJSON Ability where+ toJSON = genericToJSON+ defaultOptions { sumEncoding = UntaggedValue+ , fieldLabelModifier = const "type" }++instance FromJSON Ability where+ parseJSON = genericParseJSON+ defaultOptions { sumEncoding = UntaggedValue+ , fieldLabelModifier = const "type" }++-- | Transit, Answer and Error Message from Client to Client+data TransitMsg = Error Text+ | Answer Ack+ -- ^ Answer message is sent on a successful transfer+ | Transit { abilitiesV1 :: [Ability]+ , hintsV1 :: Set.Set ConnectionHint }+ -- ^ Transit message+ deriving (Eq, Show, Generic)++instance ToJSON TransitMsg where+ toJSON = genericToJSON+ defaultOptions { sumEncoding = ObjectWithSingleField+ , constructorTagModifier = camelTo2 '-'+ , fieldLabelModifier = camelTo2 '-' }+instance FromJSON TransitMsg where+ parseJSON = genericParseJSON+ defaultOptions { sumEncoding = ObjectWithSingleField+ , constructorTagModifier = camelTo2 '-'+ , fieldLabelModifier = camelTo2 '-'}++-- | Message sent by the receiver of the file to the sender+data TransitAck+ = TransitAck+ { ack :: Text -- ^ "ack" is "ok" implies a successful transfer+ , sha256 :: Text } -- ^ expected sha256 sum of the transfered file+ deriving (Eq, Show, Generic)++instance ToJSON TransitAck where+ toJSON = genericToJSON+ defaultOptions { sumEncoding = UntaggedValue }++instance FromJSON TransitAck where+ parseJSON = genericParseJSON+ defaultOptions { sumEncoding = UntaggedValue }+
+ src/Transit/Internal/Network.hs view
@@ -0,0 +1,243 @@+-- | Description: functions that deal with the network i/o+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+module Transit.Internal.Network+ (+ -- * build hints (direct and relay) from relay url, port number and the network interfaces.+ buildHints+ , buildRelayHints+ -- * parse and build transit relay hints+ , parseTransitRelayUri+ , RelayEndpoint(..)+ -- * low level bytestring buffer send/receive over a socket+ , sendBuffer+ , recvBuffer+ -- * TCP Endpoint+ , closeConnection+ , TCPEndpoint(..)+ , TransitEndpoint(..)+ -- * TCP Listener that listens on a random port, Server and Client+ , tcpListener+ , startServer+ , startClient+ -- * Errors+ , CommunicationError(..)+ ) where++import Prelude (read)+import Protolude++import Transit.Internal.Messages (ConnectionHint(..), Hint(..), AbilityV1(..))++import Network.Socket+ ( addrSocketType+ , PortNumber+ , addrFlags+ , addrAddress+ , addrProtocol+ , addrFamily+ , getAddrInfo+ , SocketType ( Stream )+ , close+ , socket+ , Socket(..)+ , SockAddr+ , connect+ , bind+ , listen+ , accept+ , defaultHints+ , defaultPort+ , setSocketOption+ , SocketOption( ReuseAddr )+ , AddrInfoFlag ( AI_NUMERICSERV )+ , withSocketsDo+ )++import Network.Info+ ( getNetworkInterfaces+ , NetworkInterface(..)+ , IPv4(..)+ )++import Network.Socket.ByteString (send, recv)+import System.Timeout (timeout)+import Data.Text (splitOn)+import Data.String (String)+import System.IO.Error (IOError)+import qualified Crypto.Saltine.Core.SecretBox as SecretBox++import qualified Data.Text.IO as TIO+import qualified Data.Set as Set++-- | Type representing the network protocol errors+data CommunicationError+ = ConnectionError Text+ -- ^ We could not establish a socket connection.+ | OfferError Text+ -- ^ Clients could not exchange offer message.+ | TransitError Text+ -- ^ There was an error in transit protocol exchanges.+ | Sha256SumError Text+ -- ^ Sender got back a wrong sha256sum from the receiver.+ | UnknownPeerMessage Text+ -- ^ We could not identify the message from peer.+ deriving (Eq, Show)++-- | Listen on all the interfaces on a randomly assigned default port+tcpListener :: IO Socket+tcpListener = do+ let hints' = defaultHints { addrFlags = [AI_NUMERICSERV], addrSocketType = Stream }+ addr:_ <- getAddrInfo (Just hints') (Just "0.0.0.0") (Just (show defaultPort))+ sock' <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+ setSocketOption sock' ReuseAddr 1+ bind sock' (addrAddress addr)+ listen sock' 5+ return sock'++type Hostname = Text++ipv4ToHostname :: Word32 -> Hostname+ipv4ToHostname ip =+ let (q1, r1) = ip `divMod` 256+ (q2, r2) = q1 `divMod` 256+ (q3, r3) = q2 `divMod` 256+ in+ show r1 <> "." <> show r2 <> "." <> show r3 <> "." <> show q3++buildDirectHints :: PortNumber -> IO (Set.Set ConnectionHint)+buildDirectHints portnum = do+ nwInterfaces <- getNetworkInterfaces+ let nonLoopbackInterfaces =+ filter (\nwInterface ->+ let (IPv4 addr4) = ipv4 nwInterface+ in+ (ipv4ToHostname addr4 /= "0.0.0.0")+ && (ipv4ToHostname addr4 /= "127.0.0.1"))+ nwInterfaces+ return $ Set.fromList $ map (\nwInterface ->+ let (IPv4 addr4) = ipv4 nwInterface in+ Direct Hint { hostname = ipv4ToHostname addr4+ , port = fromIntegral portnum+ , priority = 0+ , ctype = DirectTcpV1 }) nonLoopbackInterfaces++-- | Type representing a Relay Endpoint URL+data RelayEndpoint+ = RelayEndpoint+ { relayhost :: Text+ , relayport :: Word16+ } deriving (Show, Eq)++-- | Parse transit url of the form /tcp:hostname:port/+parseTransitRelayUri :: String -> Maybe RelayEndpoint+parseTransitRelayUri url =+ let parts = splitOn ":" (toS @String @Text url)+ (Just host') = atMay parts 1+ (Just port') = atMay parts 2+ in+ if length parts == 3 && "tcp:" `isPrefixOf` url+ then Just (RelayEndpoint { relayhost = host', relayport = read @Word16 (toS port') })+ else Nothing++-- | The client at the sending side and receiving side may be+-- invoked with different relay hint urls. These get exchanged+-- in the transit message. After successfully receiving the transit+-- message, each client should combine the hints of the peer along+-- with its relay hints to get the full set of hints.+buildRelayHints :: RelayEndpoint -> Set.Set ConnectionHint+buildRelayHints (RelayEndpoint host' port') =+ Set.singleton $ Relay RelayV1 [Hint { hostname = host'+ , port = port'+ , priority = 0.0+ , ctype = RelayV1 }]++-- | Build a client's connection hint+buildHints :: PortNumber -> RelayEndpoint -> IO (Set.Set ConnectionHint)+buildHints portnum relayEndpoint = do+ directHints <- buildDirectHints portnum+ let relayHints = buildRelayHints relayEndpoint+ return (directHints <> relayHints)++-- | A type representing the connected TCP endpoint+data TCPEndpoint+ = TCPEndpoint+ { sock :: Socket+ , conntype :: Maybe AbilityV1+ } deriving (Show, Eq)++-- | A type representing an "authenticated" TCP endpoint+data TransitEndpoint+ = TransitEndpoint+ { peerEndpoint :: TCPEndpoint+ , senderKey :: SecretBox.Key+ , receiverKey :: SecretBox.Key+ } deriving (Eq)+++tryToConnect :: AbilityV1 -> Hint -> IO (Maybe TCPEndpoint)+tryToConnect ability h@(Hint _ _ host portnum) =+ timeout 1000000 (bracketOnError+ (init host portnum)+ (\(sock', _) -> close sock')+ (\(sock', addr) -> do+ connect sock' $ addrAddress addr+ TIO.putStrLn "Connected"+ return (TCPEndpoint sock' (Just ability))))+ where+ init host' port' = withSocketsDo $ do+ TIO.putStrLn $ "trying to connect to " <> (show h)+ addr <- resolve (toS host') (show port')+ sock' <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+ return (sock', addr)+ resolve host' port' = do+ let hints' = defaultHints { addrSocketType = Stream }+ addr:_ <- getAddrInfo (Just hints') (Just host') (Just port')+ return addr++-- | Low level function to send a fixed length bytestring to+-- the peer represented by /ep/.+sendBuffer :: TCPEndpoint -> ByteString -> IO Int+sendBuffer ep = send (sock ep)++-- | Low level function to receive a byte buffer of specified+-- length from the peer represented by /ep/.+recvBuffer :: TCPEndpoint -> Int -> IO ByteString+recvBuffer ep = recv (sock ep)++-- | Close the peer network connection.+closeConnection :: TransitEndpoint -> IO ()+closeConnection ep = close (sock (peerEndpoint ep))++-- | Accept and return the TCP Endpoint representing the peer+startServer :: Socket -> IO (Either CommunicationError TCPEndpoint)+startServer sock' = do+ res <- try $ accept sock' :: IO (Either IOError (Socket, SockAddr))+ close sock'+ return $ bimap (const (ConnectionError "accept: IO error")) (\(conn, _) -> (TCPEndpoint conn Nothing)) res++-- | Try to concurrently connect to the given list of connection hints and+-- return the first peer that succeeds.+startClient :: [ConnectionHint] -> IO (Either CommunicationError TCPEndpoint)+startClient hs = do+ let sortedHs = sort hs+ (dHs, rHs) = segregateHints sortedHs+ TIO.putStrLn ("Direct Hints" <> (show dHs))+ TIO.putStrLn ("Relay Hints" <> (show rHs))+ (ep1, ep2) <- concurrently+ (asum (map (tryToConnect DirectTcpV1) dHs))+ (asum (map (tryToConnect RelayV1) rHs))+ let maybeEndPoint = ep1 <|> ep2+ case maybeEndPoint of+ Just ep -> return (Right ep)+ Nothing -> return (Left (ConnectionError "Peer socket is not active"))+ where+ -- (a -> b -> b) -> b -> [a] -> b+ segregateHints :: [ConnectionHint] -> ([Hint], [Hint])+ segregateHints = foldr go ([],[])+ go :: ConnectionHint -> ([Hint], [Hint]) -> ([Hint], [Hint])+ go hint (dhs, rhs) = case hint of+ Direct h -> (h:dhs, rhs)+ Relay _ hs' -> (dhs, hs' <> rhs)+
+ src/Transit/Internal/Peer.hs view
@@ -0,0 +1,401 @@+-- | Description: Module that exchanges messages with the Peer+{-# LANGUAGE OverloadedStrings #-}+module Transit.Internal.Peer+ ( makeSenderHandshake+ , makeReceiverHandshake+ , makeRecordKeys+ , makeRelayHandshake+ , senderTransitExchange+ , senderOfferExchange+ , sendOffer+ , receiveOffer+ , sendMessageAck+ , receiveMessageAck+ , senderHandshakeExchange+ , receiverHandshakeExchange+ , sendTransitMsg+ , decodeTransitMsg+ , makeAckMessage+ , receiveWormholeMessage+ , sendWormholeMessage+ , generateTransitSide+ , InvalidHandshake(..)+ , sendRecord+ , receiveRecord+ , unzipInto+ )+where++import Protolude hiding ((<.>))++import qualified Control.Exception as E+import qualified Crypto.Saltine.Class as Saltine+import qualified Crypto.Saltine.Core.SecretBox as SecretBox+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import qualified Data.Set as Set++import Data.Aeson (encode, eitherDecode)+import Data.Binary.Get (getWord32be, runGet)+import Data.ByteString.Builder(toLazyByteString, word32BE, byteString)+import Data.Bits (shiftL)+import Data.Hex (hex)+import Data.Text (toLower)+import System.Posix.Types (FileOffset, FileMode)+import System.PosixCompat.Files (getFileStatus, fileSize, fileMode, isDirectory)+import System.FilePath (takeFileName, takeBaseName, dropTrailingPathSeparator, (<.>), (</>))+import Crypto.Random (MonadRandom(..))+import Data.ByteArray.Encoding (convertToBase, Base(Base16))+import System.IO.Error (IOError)+import System.Directory.PathWalk (pathWalk)+import System.Directory (getTemporaryDirectory)+import System.IO.Temp (createTempDirectory)+import Codec.Archive.Zip ( createArchive+ , withArchive+ , CompressionMethod ( Deflate )+ , mkEntrySelector+ , unEntrySelector+ , packDirRecur+ , unpackInto+ , forEntries+ , setExternalFileAttrs)++import Transit.Internal.Messages+ ( TransitMsg(..)+ , TransitAck(..)+ , Ack( FileAck, MessageAck )+ , Ability(..)+ , AbilityV1(..)+ , ConnectionHint)+import Transit.Internal.Network+ ( TCPEndpoint(..)+ , sendBuffer+ , recvBuffer+ , CommunicationError(..))+import Transit.Internal.Crypto+ ( encrypt+ , decrypt+ , deriveKeyFromPurpose+ , Purpose(..)+ , PlainText(..)+ , CipherText(..)+ , CryptoError(..))++import qualified MagicWormhole++-- | Make a bytestring for the handshake message sent by the+-- sender which is of the form "transit sender XXXXXXX..XX ready\n\n"+-- where /XXXXXX..XX/ is the hex ascii representation of the sender+-- handshake key.+makeSenderHandshake :: SecretBox.Key -> ByteString+makeSenderHandshake key =+ (toS @Text @ByteString "transit sender ") <> hexid <> (toS @Text @ByteString " ready\n\n")+ where+ subkey = deriveKeyFromPurpose SenderHandshake key+ hexid = toS (toLower (toS @ByteString @Text (hex subkey)))++-- | Make a bytestring for the handshake message sent by the receiver+-- which is of the form "transit receiver XXXX...XX ready\n\n" where+-- /XXXX...XX/ is the receiver handshake key.+makeReceiverHandshake :: SecretBox.Key -> ByteString+makeReceiverHandshake key =+ (toS @Text @ByteString "transit receiver ") <> hexid <> (toS @Text @ByteString " ready\n\n")+ where+ subkey = deriveKeyFromPurpose ReceiverHandshake key+ hexid = toS (toLower (toS @ByteString @Text (hex subkey)))++-- | create relay handshake bytestring+-- "please relay HEXHEX for side XXXXX\n"+makeRelayHandshake :: SecretBox.Key -> MagicWormhole.Side -> ByteString+makeRelayHandshake key (MagicWormhole.Side side) =+ (toS @Text @ByteString "please relay ") <> token <> (toS @Text @ByteString " for side ") <> sideBytes <> "\n"+ where+ subkey = deriveKeyFromPurpose RelayHandshake key+ token = toS (toLower (toS @ByteString @Text (hex subkey)))+ sideBytes = toS @Text @ByteString side++-- | Make sender and receiver symmetric keys for the records transmission.+-- Records are chunks of data corresponding to the blocks of the file.+-- Sender record key is used for decrypting incoming records and receiver+-- record key is for sending file_ack back to the sender.+makeRecordKeys :: SecretBox.Key -> Either CryptoError (SecretBox.Key, SecretBox.Key)+makeRecordKeys key =+ maybe (Left (KeyGenError "Could not generate record keys")) Right keyPair+ where+ keyPair = (,) <$> makeSenderRecordKey key+ <*> makeReceiverRecordKey key+ makeSenderRecordKey :: SecretBox.Key -> Maybe SecretBox.Key+ makeSenderRecordKey = Saltine.decode . (deriveKeyFromPurpose SenderRecord)+ makeReceiverRecordKey :: SecretBox.Key -> Maybe SecretBox.Key+ makeReceiverRecordKey = Saltine.decode . (deriveKeyFromPurpose ReceiverRecord)++-- |'senderTransitExchange' exchanges transit message with the peer.+-- Sender sends a transit message with its abilities and hints.+-- Receiver sends either another Transit message or an Error message.+senderTransitExchange :: MagicWormhole.EncryptedConnection -> [ConnectionHint] -> IO (Either CommunicationError TransitMsg)+senderTransitExchange conn hs = do+ let abilities' = [Ability DirectTcpV1, Ability RelayV1]+ (_, rxMsg) <- concurrently (sendTransitMsg conn abilities' hs) receiveTransitMsg+ case eitherDecode (toS rxMsg) of+ Right t@(Transit _ _) -> return (Right t)+ Left s -> return (Left (TransitError (toS s)))+ Right (Error errstr) -> return (Left (TransitError errstr))+ Right (Answer _) -> return (Left (TransitError "Answer message from the peer is unexpected"))+ where+ receiveTransitMsg = do+ -- receive the transit from the receiving side+ responseMsg <- receiveWormholeMessage conn+ return responseMsg++-- | create and send a Transit message to the peer.+sendTransitMsg :: MagicWormhole.EncryptedConnection -> [Ability] -> [ConnectionHint] -> IO ()+sendTransitMsg conn abilities' hints' = do+ -- create transit message+ let txTransitMsg = Transit abilities' (Set.fromList hints')+ let encodedTransitMsg = toS (encode txTransitMsg)+ -- send the transit message (dictionary with key as "transit" and value as abilities)+ MagicWormhole.sendMessage conn (MagicWormhole.PlainText encodedTransitMsg)++-- | Parse the given bytestring into a Transit Message+decodeTransitMsg :: ByteString -> Either CommunicationError TransitMsg+decodeTransitMsg received =+ case eitherDecode (toS received) of+ Right transitMsg -> Right transitMsg+ Left err -> Left $ TransitError (toS err)++-- | Send an offer message to the connected peer over the wormhole+sendOffer :: MagicWormhole.EncryptedConnection -> MagicWormhole.Offer -> IO ()+sendOffer conn offer =+ MagicWormhole.sendMessage conn (MagicWormhole.PlainText (toS (encode offer)))++-- | receive a message over wormhole and try to decode it as an offer message.+-- If it is not an offer message, pass the raw bytestring as a Left value.+receiveOffer :: MagicWormhole.EncryptedConnection -> IO (Either ByteString MagicWormhole.Offer)+receiveOffer conn = do+ received <- receiveWormholeMessage conn+ case eitherDecode (toS received) of+ Right msg@(MagicWormhole.Message _) -> return $ Right msg+ Right file@(MagicWormhole.File _ _) -> return $ Right file+ Right dir@(MagicWormhole.Directory _ _ _ _ _) -> return $ Right dir+ Left _ -> return $ Left received++-- | Receive an Ack message over the wormhole connection+receiveMessageAck :: MagicWormhole.EncryptedConnection -> IO (Either CommunicationError ())+receiveMessageAck conn = do+ rxTransitMsg <- receiveWormholeMessage conn+ case eitherDecode (toS rxTransitMsg) of+ Left s -> return $ Left (TransitError (show s))+ Right (Answer (MessageAck msg')) | msg' == "ok" -> return $ Right ()+ | otherwise -> return $ Left (TransitError "Message ack failed")+ Right s -> return $ Left (TransitError (show s))++-- | Send an Ack message as a regular text message encapsulated in+-- an 'Answer' message over the wormhole connection+sendMessageAck :: MagicWormhole.EncryptedConnection -> Text -> IO ()+sendMessageAck conn msg = do+ let ackMessage = Answer (MessageAck msg)+ MagicWormhole.sendMessage conn (MagicWormhole.PlainText (toS (encode ackMessage)))++-- | Exchange offer message with the peer over the wormhole connection+senderOfferExchange :: MagicWormhole.EncryptedConnection -> FilePath -> IO (Either Text FilePath)+senderOfferExchange conn path = do+ (filePath, rx) <- concurrently sendFileOrDirOffer receiveResponse+ -- receive file ack message {"answer": {"file_ack": "ok"}}+ case eitherDecode (toS rx) of+ Left s -> return $ Left (toS s)+ Right (Error errstr) -> return $ Left (toS errstr)+ Right (Answer (FileAck msg)) | msg == "ok" -> return (Right filePath)+ | otherwise -> return $ Left "Did not get file ack. Exiting"+ Right (Answer (MessageAck _)) -> return $ Left "expected file ack, got message ack instead"+ Right (Transit _ _) -> return $ Left "unexpected transit message"+ where+ sendFileOrDirOffer :: IO FilePath+ sendFileOrDirOffer = do+ isDir <- isDirectory <$> getFileStatus path+ if isDir+ then sendDirOffer+ else sendFileOffer+ receiveResponse :: IO ByteString+ receiveResponse = do+ rxFileOffer <- receiveWormholeMessage conn+ return rxFileOffer+ getFileSize :: FilePath -> IO FileOffset+ getFileSize file = fileSize <$> getFileStatus file+ sendFileOffer = do+ size <- getFileSize path+ let fileOffer = MagicWormhole.File (toS (takeFileName path)) size+ sendOffer conn fileOffer+ return path+ sendDirOffer = do+ (zipFilePath, (totalFiles, totalSize)) <- zipDir path+ size <- getFileSize zipFilePath+ let dirOffer = MagicWormhole.Directory MagicWormhole.ZipFileDeflated (toS (takeBaseName (dropTrailingPathSeparator path))) (fromIntegral size) (fromIntegral totalSize) (fromIntegral totalFiles)+ sendOffer conn dirOffer+ return zipFilePath++-- | Receive a bytestring via the established wormhole connection+receiveWormholeMessage :: MagicWormhole.EncryptedConnection -> IO ByteString+receiveWormholeMessage conn = do+ MagicWormhole.PlainText msg <- atomically $ MagicWormhole.receiveMessage conn+ return msg++-- | Send a bytestring over the established wormhole connection+sendWormholeMessage :: MagicWormhole.EncryptedConnection -> BL.ByteString -> IO ()+sendWormholeMessage conn msg =+ MagicWormhole.sendMessage conn (MagicWormhole.PlainText (toS msg))++-- | Error type for the Peer module+data InvalidHandshake = InvalidHandshake+ -- ^ Handshake with the peer didn't succeed+ | InvalidRelayHandshake+ -- ^ Handshake with the relay server didn't succeed+ deriving (Show, Eq)++instance E.Exception InvalidHandshake where++-- | Exchange handshake message with the Relay server.+relayHandshakeExchange :: TCPEndpoint -> SecretBox.Key -> MagicWormhole.Side -> IO ()+relayHandshakeExchange ep key side = do+ r <- sendRelayHandshake >> receiveAck+ if r == "ok\n"+ then return ()+ else throwIO InvalidRelayHandshake+ where+ sendRelayHandshake = sendBuffer ep sHandshakeMsg+ sHandshakeMsg = makeRelayHandshake key side+ receiveAck = recvByteString (BS.length rHandshakeMsg)+ rHandshakeMsg = "ok\n"+ recvByteString n = recvBuffer ep n++-- | Sender side exchange of the handshake messages. Sender sends send-side handshake+-- message created by 'makeSenderHandshake' and concurrently receives the handshake+-- message from the receive side and compares it with the bytestring created by+-- 'makeReceiverHandshake'. If it matches, then it sends "go\n" to the receiver, else+-- it sends "nevermind\n" to the receiver and returns an 'InvalidHandshake'.+senderHandshakeExchange :: TCPEndpoint -> SecretBox.Key -> MagicWormhole.Side -> IO (Either InvalidHandshake ())+senderHandshakeExchange ep key side = do+ when (conntype ep == Just RelayV1) $ do+ relayHandshakeExchange ep key side+ (_, r) <- concurrently sendHandshake rxHandshake+ if r == rHandshakeMsg+ then do+ _ <- sendGo+ return $ Right ()+ else do+ _ <- sendNeverMind+ return $ Left InvalidHandshake+ where+ sendHandshake = sendBuffer ep sHandshakeMsg+ rxHandshake = recvByteString (BS.length rHandshakeMsg)+ sendGo = sendBuffer ep (toS @Text @ByteString "go\n")+ sendNeverMind = sendBuffer ep (toS @Text @ByteString "nevermind\n")+ sHandshakeMsg = makeSenderHandshake key+ rHandshakeMsg = makeReceiverHandshake key+ recvByteString n = recvBuffer ep n++-- | Receiver side exchange of handshake messages. Receiver sends the receive-side+-- handshake message appended with "go\n" and receives the handshake message from+-- the sender. It then compares the message received from the sender with the locally+-- computed sender handshake bytestring appended with "go\n". If they don't match, it+-- returns an 'InvalidHandshake'.+receiverHandshakeExchange :: TCPEndpoint -> SecretBox.Key -> MagicWormhole.Side -> IO (Either InvalidHandshake ())+receiverHandshakeExchange ep key side = do+ when (conntype ep == Just RelayV1) $ do+ relayHandshakeExchange ep key side+ (_, r') <- concurrently sendHandshake rxHandshake+ r'' <- recvByteString (BS.length "go\n")+ if (r' <> r'') == sHandshakeMsg <> "go\n"+ then return $ Right ()+ else return $ Left InvalidHandshake+ where+ sendHandshake = sendBuffer ep rHandshakeMsg+ rxHandshake = recvByteString (BS.length sHandshakeMsg)+ sHandshakeMsg = makeSenderHandshake key+ rHandshakeMsg = makeReceiverHandshake key+ recvByteString n = recvBuffer ep n++-- | Create an encrypted Transit Ack message+makeAckMessage :: SecretBox.Key -> ByteString -> Either CryptoError CipherText+makeAckMessage key sha256Sum =+ let transitAckMsg = TransitAck "ok" (toS @ByteString @Text sha256Sum)+ in+ encrypt key Saltine.zero (PlainText (BL.toStrict (encode transitAckMsg)))++-- | A Record is an encrypted chunk of byte string. On the wire, a header of+-- 4 bytes which denotes the length of the payload is sent before sending the+-- actual payload.+sendRecord :: TCPEndpoint -> ByteString -> IO (Either CommunicationError Int)+sendRecord ep record = do+ -- send size of the encrypted payload as 4 bytes, then send record+ -- format sz as a fixed 4 byte bytestring+ let payloadSize = word32BE (fromIntegral (BS.length record))+ payload = byteString record+ packet = payloadSize <> payload+ res <- try $ sendBuffer ep (BL.toStrict (toLazyByteString packet)) :: IO (Either IOError Int)+ case res of+ Left e -> return $ Left (ConnectionError (show e))+ Right x -> return $ Right x++-- | Receive a packet corresponding to a record (4-byte header representing the+-- length /n/, of the record, followed by /n/ bytes of encrypted payload) and then+-- decrypts and returns the payload.+receiveRecord :: TCPEndpoint -> SecretBox.Key -> IO (Either CryptoError ByteString)+receiveRecord ep key = do+ -- read 4 bytes that consists of length+ -- read as much bytes specified by the length. That would be encrypted record+ -- decrypt the record+ lenBytes <- recvBuffer ep 4+ let len = runGet getWord32be (BL.fromStrict lenBytes)+ encRecord <- recvBuffer ep (fromIntegral len)+ case decrypt key (CipherText encRecord) of+ Left e -> return $ Left e+ Right (PlainText plaintext, _) -> return $ Right plaintext++-- | There is a separate 8-bytes of random 'side' for Transit protocol, which+-- is different from the 'side' used in the wormhole encrypted channel establishment+generateTransitSide :: MonadRandom m => m MagicWormhole.Side+generateTransitSide = do+ randomBytes <- getRandomBytes 8+ pure . MagicWormhole.Side . toS @ByteString . convertToBase Base16 $ (randomBytes :: ByteString)++type DirState = (Int, FileOffset)++-- | Given an input FilePath representing a directory, zip+-- the entire directory contents and return the path to the+-- zip file and a state (number of files and total size of all+-- the files).+zipDir :: FilePath -> IO (FilePath, DirState)+zipDir filePath = do+ systemTmpDir <- getTemporaryDirectory+ tmpDir <- createTempDirectory systemTmpDir "wormhole"+ let dirName = takeBaseName (dropTrailingPathSeparator filePath)+ let zipFileName = tmpDir </> dirName <.> "zip"+ ((_, stats), _) <- concurrently+ (runStateT (dirStats filePath) (0,0))+ (do+ createArchive zipFileName $+ packDirRecur Deflate mkEntrySelector filePath+ withArchive zipFileName $ do+ forEntries $ \selector -> do+ mode <- liftIO $ getFileMode (dirName </> unEntrySelector selector)+ setExternalFileAttrs (fromIntegral (mode `shiftL` 16)) selector)+ return (zipFileName, stats)+ where+ getFileMode :: FilePath -> IO FileMode+ getFileMode file = fileMode <$> getFileStatus file++dirStats :: FilePath -> StateT DirState IO ()+dirStats filePath = do+ pathWalk filePath $ \root _dirs files -> do+ forM_ files $ \file -> do+ size <- liftIO (getFileSize (root </> file))+ (numFiles, totalSize) <- get+ put (numFiles + 1, totalSize + size)+ where+ getFileSize :: FilePath -> IO FileOffset+ getFileSize file = fileSize <$> getFileStatus file++-- | unzip the given zip file into the especified directory+-- under current working directory+unzipInto :: FilePath -> FilePath -> IO ()+unzipInto dirname zipFilePath = withArchive zipFilePath (unpackInto dirname)
+ src/Transit/Internal/Pipeline.hs view
@@ -0,0 +1,139 @@+-- | Description: Conduit pipelines for sending and receiving files and directories+module Transit.Internal.Pipeline+ ( sendPipeline+ , receivePipeline+ -- * for tests+ , assembleRecordC+ , decryptC+ , encryptC+ )+where++import Protolude++import Crypto.Hash (SHA256(..))+import Data.Conduit ((.|))+import Data.ByteString.Builder(toLazyByteString, word32BE)+import Data.Binary.Get (getWord32be, runGet)++import qualified Crypto.Hash as Hash+import qualified Conduit as C+import qualified Data.Conduit.Network as CN+import qualified Data.Conduit.Binary as CB+import qualified Data.Binary.Builder as BB+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import qualified Crypto.Saltine.Core.SecretBox as SecretBox+import qualified Crypto.Saltine.Class as Saltine++import Transit.Internal.Network (TCPEndpoint(..), TransitEndpoint(..))+import Transit.Internal.Crypto (encrypt, decrypt, PlainText(..), CipherText(..), CryptoError(..))++-- | Given the peer network socket and the file path to be sent, this Conduit+-- pipeline reads the file, encrypts and send it over the network. A sha256+-- sum is calculated on the input before encryption to compare with the+-- receiver's decrypted copy.+sendPipeline :: C.MonadResource m =>+ FilePath+ -> TransitEndpoint+ -> C.ConduitM a c m (Text, ())+sendPipeline fp (TransitEndpoint (TCPEndpoint s _) key _) =+ C.sourceFile fp .| sha256PassThroughC `C.fuseBoth` (encryptC key .| CN.sinkSocket s)++-- | Receive the encrypted bytestream from a network socket, decrypt it and+-- write it into a file, also calculating the sha256 sum of the decrypted+-- output along the way.+receivePipeline :: C.MonadResource m =>+ FilePath+ -> Int+ -> TransitEndpoint+ -> C.ConduitM a c m (Text, ())+receivePipeline fp len (TransitEndpoint (TCPEndpoint s _) key _) =+ CN.sourceSocket s+ .| assembleRecordC+ .| decryptC key+ .| CB.isolate len+ .| sha256PassThroughC `C.fuseBoth` C.sinkFileCautious fp++-- | A conduit function to encrypt the incoming byte stream with the given key+encryptC :: MonadIO m => SecretBox.Key -> C.ConduitT ByteString ByteString m ()+encryptC key = loop Saltine.zero+ where+ loop nonce = do+ b <- C.await+ case b of+ Nothing -> return ()+ Just chunk -> do+ let cipherText = encrypt key nonce (PlainText chunk)+ case cipherText of+ Right (CipherText cipherText') -> do+ let cipherTextSize = toLazyByteString (word32BE (fromIntegral (BS.length cipherText')))+ C.yield (toS cipherTextSize)+ C.yield cipherText'+ loop (Saltine.nudge nonce)+ Left e -> throwIO e++-- | A conduit function to decrypt the incoming byte stream with the given key+decryptC :: MonadIO m => SecretBox.Key -> C.ConduitT ByteString ByteString m ()+decryptC key = loop Saltine.zero+ where+ loop :: MonadIO m => SecretBox.Nonce -> C.ConduitT ByteString ByteString m ()+ loop seqNum = do+ b <- C.await+ case b of+ Nothing -> return ()+ Just bs ->+ case decrypt key (CipherText bs) of+ Right (PlainText plainText, nonce) -> do+ let seqNumLE = BS.reverse $ toS $ Saltine.encode seqNum+ seqNum' = Saltine.decode (toS seqNumLE)+ if Just nonce /= seqNum'+ then throwIO (BadNonce "nonce decoding failed or packets received out of order.")+ else do+ C.yield plainText+ loop (Saltine.nudge seqNum)+ Left e -> throwIO e++sha256PassThroughC :: (Monad m) => C.ConduitT ByteString ByteString m Text+sha256PassThroughC = loop $! Hash.hashInitWith SHA256+ where+ loop :: (Monad m) => Hash.Context SHA256 -> C.ConduitT ByteString ByteString m Text+ loop ctx = do+ b <- C.await+ case b of+ Nothing -> return $! show (Hash.hashFinalize ctx)+ Just bs -> do+ C.yield bs+ loop $! Hash.hashUpdate ctx bs++-- | The decryption conduit computation would succeed only if a complete+-- bytestream that represents an encrypted block of data is given to it.+-- However, the upstream elements may chunk the data for which one may not+-- have control of. The encrypted packet on the wire has a 4-byte length+-- header, so we could first read it and assemble a complete encrypted+-- block into downstream.+assembleRecordC :: Monad m => C.ConduitT ByteString ByteString m ()+assembleRecordC = do+ hdr <- getChunk 4+ let len = runGet getWord32be (BL.fromStrict hdr)+ packet <- getChunk (fromIntegral len)+ C.yield packet+ assembleRecordC+ where+ getChunk :: Monad m => Int -> C.ConduitT ByteString ByteString m ByteString+ getChunk size = go size BB.empty+ go :: Monad m => Int -> BB.Builder -> C.ConduitT ByteString ByteString m ByteString+ go size res = do+ let residue = BL.toStrict . BB.toLazyByteString $ res+ b <- C.await+ case b of+ Nothing -> return residue+ Just bs | size < BS.length bs -> do+ let (f, l) = BS.splitAt size bs+ C.leftover l+ return $ residue <> f+ | size == BS.length bs -> return (residue <> bs)+ | otherwise -> do+ let want = size - BS.length bs+ go want $ BB.fromByteString (residue <> bs)+
+ tests/CryptoTests.hs view
@@ -0,0 +1,36 @@+-- | Crypto module tests+module CryptoTests+ ( cryptoRoundTripTests+ ) where++import Protolude++import Hedgehog (forAll, property, (===), failure, Property, Group(..), checkSequential)++import qualified Transit.Internal.Crypto as C+import qualified Crypto.Saltine.Class as Saltine+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import qualified Generator++prop_roundTrip :: Property+prop_roundTrip = property $ do+ purpose <- forAll Generator.purposeGen+ secret <- forAll $ Gen.bytes (Range.singleton 32)+ nonceBytes <- forAll Generator.nonceBytesGen+ let nonce = fromMaybe (panic "cannot decode nonce") $ Saltine.decode nonceBytes+ let secret' = fromMaybe (panic "cannot decode secret") $ Saltine.decode secret+ let key = C.deriveKeyFromPurpose purpose secret'+ let key' = fromMaybe (panic "cannot decode key") $ Saltine.decode key+ plaintext <- forAll $ Gen.bytes (Range.linear 1 256)+ let result = C.encrypt key' nonce (C.PlainText plaintext) >>= C.decrypt key'+ case result of+ Right (pt, _) -> pt === C.PlainText plaintext+ Left _ -> failure++cryptoRoundTripTests :: IO Bool+cryptoRoundTripTests =+ checkSequential $ Group "Crypto"+ [ ("encrypt decrypt roundtrip", prop_roundTrip)+ ]
+ tests/Generator.hs view
@@ -0,0 +1,84 @@+-- | Hedgehog generators for the messages+module Generator+ ( abilityGen+ , abilityV1Gen+ , hintGen+ , connectionHintGen+ , ackGen+ , transitMsgGen+ , transitAckGen+ , nonceBytesGen+ , purposeGen+ )+where++import Protolude++import Hedgehog (MonadGen(..))+import qualified Crypto.Saltine.Class as Saltine+import qualified Crypto.Saltine.Core.SecretBox as SecretBox+import Crypto.Saltine.Internal.ByteSizes (boxNonce)+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Transit.Internal.Messages+ ( Ability(..)+ , AbilityV1(..)+ , Hint(..)+ , ConnectionHint(..)+ , Ack(..)+ , TransitMsg(..)+ , TransitAck(..)+ )+import qualified Transit.Internal.Crypto as C++abilityGen :: MonadGen m => m Ability+abilityGen = Ability <$> abilityV1Gen++abilityV1Gen :: MonadGen m => m AbilityV1+abilityV1Gen = Gen.choice+ [ pure DirectTcpV1+ , pure RelayV1+ ]++hintGen :: MonadGen m => m Hint+hintGen = Hint <$> abilityV1Gen+ <*> Gen.double (Range.linearFrac 0.0 5.0)+ <*> Gen.text (Range.linear 0 100) Gen.unicode+ <*> Gen.word16 (Range.linear 0 maxBound)++connectionHintGen :: MonadGen m => m ConnectionHint+connectionHintGen = Gen.choice+ [ Direct <$> hintGen+ , Relay <$> abilityV1Gen <*> Gen.list (Range.linear 0 10) hintGen+ ]++ackGen :: MonadGen m => m Ack+ackGen = Gen.choice+ [ FileAck <$> Gen.text (Range.linear 0 100) Gen.ascii+ , MessageAck <$> Gen.text (Range.linear 0 100) Gen.ascii+ ]++transitMsgGen :: MonadGen m => m TransitMsg+transitMsgGen = Gen.choice+ [ Error <$> Gen.text (Range.linear 0 100) Gen.unicode+ , Answer <$> ackGen+ , Transit+ <$> Gen.list (Range.linear 0 5) abilityGen+ <*> Gen.set (Range.linear 0 5) connectionHintGen+ ]++transitAckGen :: MonadGen m => m TransitAck+transitAckGen = TransitAck+ <$> Gen.text (Range.linear 0 5) Gen.unicode+ <*> Gen.text (Range.singleton 64) Gen.hexit++nonceBytesGen :: MonadGen m => m ByteString+nonceBytesGen = Gen.bytes (Range.singleton boxNonce)++purposeGen :: MonadGen m => m C.Purpose+purposeGen = Gen.choice [ pure C.SenderHandshake+ , pure C.ReceiverHandshake+ , pure C.SenderRecord+ , pure C.ReceiverRecord+ , pure C.RelayHandshake ]
+ tests/Main.hs view
@@ -0,0 +1,17 @@+module Main (main) where++import Protolude++import qualified ProtocolTests+import qualified MessagesTests+import qualified PipelineTests+import qualified CryptoTests++main :: IO ()+main = do+ ProtocolTests.tests+ MessagesTests.tests+ PipelineTests.tests+ MessagesTests.messagesRoundTripTests >>+ CryptoTests.cryptoRoundTripTests >>+ return ()
+ tests/MessagesTests.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE OverloadedStrings #-}+module MessagesTests+ ( tests+ , messagesRoundTripTests+ )+where++import Protolude++import qualified Data.Set as Set++import Transit.Internal.Messages++import Test.Hspec+import Data.Aeson+ ( encode+ , decode+ , eitherDecode+ )+import Hedgehog (forAll, property, Property, Group(..), checkSequential, tripping)+import qualified Generator++tests :: IO ()+tests = hspec $ do+ describe "Ability tests" $ do+ it "encode Ability" $ do+ encode DirectTcpV1 `shouldBe` "\"direct-tcp-v1\""+ encode RelayV1 `shouldBe` "\"relay-v1\""+ it "decode Ability" $ do+ let s1 = "\"direct-tcp-v1\"" :: Text+ decode (toS s1) `shouldBe` Just DirectTcpV1+ let s2 = "\"relay-v1\"" :: Text+ decode (toS s2) `shouldBe` Just RelayV1+ describe "Hint tests" $ do+ it "encode Hint" $ do+ let h1 = Hint { ctype = DirectTcpV1+ , priority = 0.5+ , hostname = "foo.bar.baz"+ , port = 1234 }+ encode h1 `shouldBe` "{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234}"+ it "decode Hint" $ do+ let h1 = "{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234}" :: Text+ decode (toS h1) `shouldBe` Just Hint { ctype = DirectTcpV1+ , priority = 0.5+ , hostname = "foo.bar.baz"+ , port = 1234 }+ describe "ConnectionHint tests" $ do+ it "encode Direct ConnectionHint" $ do+ let h1 = Hint { ctype = DirectTcpV1+ , priority = 0.5+ , hostname = "foo.bar.baz"+ , port = 1234 }+ ch1 = Direct h1+ encode ch1 `shouldBe` "{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234}"+ it "encode Relay ConnectionHint" $ do+ let h1 = Hint { ctype = DirectTcpV1+ , priority = 0.5+ , hostname = "foo.bar.baz"+ , port = 1234 }+ ch1 = Relay { rtype = RelayV1+ , hints = [h1] }+ encode ch1 `shouldBe` "{\"hints\":[{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234}],\"type\":\"relay-v1\"}"+ it "decode Direct ConnectionHint" $ do+ let h1text = "{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234}" :: Text+ decode (toS h1text) `shouldBe` Just (Direct Hint { ctype = DirectTcpV1+ , priority = 0.5+ , hostname = "foo.bar.baz"+ , port = 1234 })+ it "decode Relay ConnectionHint" $ do+ let h1text = "{\"type\": \"relay-v1\", \"hints\": [{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234}]}" :: Text+ h1 = Hint { ctype = DirectTcpV1+ , priority = 0.5+ , hostname = "foo.bar.baz"+ , port = 1234 }+ decode (toS h1text) `shouldBe` Just Relay { rtype = RelayV1+ , hints = [h1] }++ it "encode and decode Transit type" $ do+ let t1 = Transit { abilitiesV1 = [Ability DirectTcpV1, Ability RelayV1]+ , hintsV1 = Set.fromList [ch1, ch2] }+ h1 = Hint { ctype = DirectTcpV1+ , priority = 0.5+ , hostname = "foo.bar.baz"+ , port = 1234 }+ ch1 = Direct h1+ h2 = Hint { ctype = DirectTcpV1+ , priority = 0.5+ , hostname = "foo.bar.baz"+ , port = 1234 }+ ch2 = Relay { rtype = RelayV1+ , hints = [h2] }+ h3 = Hint { ctype = DirectTcpV1+ , priority = 0.0+ , hostname = "192.168.1.106"+ , port = 36097 }+ ch3 = Direct h3+ h4 = Hint { ctype = DirectTcpV1+ , priority = 0.0+ , hostname = "transit.magic-wormhole.io"+ , port = 4001 }+ ch4 = Relay { rtype = RelayV1+ , hints = [h4] }+ t2 = Transit { abilitiesV1 = [Ability DirectTcpV1, Ability RelayV1]+ , hintsV1 = Set.fromList [ch3 ,ch4] }+ t1text = "{\"transit\":{\"hints-v1\":[{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234},{\"hints\":[{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234}],\"type\":\"relay-v1\"}],\"abilities-v1\":[{\"type\":\"direct-tcp-v1\"},{\"type\":\"relay-v1\"}]}}" :: Text+ t2text = "{\"transit\": {\"abilities-v1\": [{\"type\": \"direct-tcp-v1\"}, {\"type\": \"relay-v1\"}], \"hints-v1\": [{\"priority\": 0.0, \"hostname\": \"192.168.1.106\", \"type\": \"direct-tcp-v1\", \"port\": 36097}, {\"type\": \"relay-v1\", \"hints\": [{\"priority\": 0.0, \"hostname\": \"transit.magic-wormhole.io\", \"type\": \"direct-tcp-v1\", \"port\": 4001}]}]}}" :: ByteString+ encode t1 `shouldBe` toS t1text+ decode (encode t1) `shouldBe` Just t1+ decode (toS t2text) `shouldBe` Just t2++ describe "Ack message tests" $ do+ it "encode and decode FileAck responses" $ do+ let f1 = FileAck "ok"+ encode f1 `shouldBe` "{\"file_ack\":\"ok\"}"+ decode (encode f1) `shouldBe` Just f1++ describe "Response message tests" $ do+ it "encode and decode Error response" $ do+ let r1 = Error "transfer rejected"+ encode r1 `shouldBe` "{\"error\":\"transfer rejected\"}"+ decode (encode r1) `shouldBe` Just r1+ it "encode and decode answer response" $ do+ let a1 = Answer (FileAck "ok")+ encode a1 `shouldBe` "{\"answer\":{\"file_ack\":\"ok\"}}"+ decode (encode a1) `shouldBe` Just a1+ + describe "Transit Ack tests" $ do+ it "encode and decode Transit Ack from receiver to sender" $ do+ let a1 = TransitAck "ok" "e4f1684a5375ebf7f1dcde02a66026f937a8c6195adf31813ef21b3ccadfb11f"+ encode a1 `shouldBe` "{\"ack\":\"ok\",\"sha256\":\"e4f1684a5375ebf7f1dcde02a66026f937a8c6195adf31813ef21b3ccadfb11f\"}"+ decode (encode a1) `shouldBe` Just a1++prop_abilityTrip :: Property+prop_abilityTrip = property $ do+ x <- forAll Generator.abilityGen+ tripping x encode eitherDecode++prop_hintTrip :: Property+prop_hintTrip = property $ do+ x <- forAll Generator.hintGen+ tripping x encode eitherDecode++prop_connectionHintTrip :: Property+prop_connectionHintTrip = property $ do+ x <- forAll Generator.connectionHintGen+ tripping x encode eitherDecode++prop_ackTrip :: Property+prop_ackTrip = property $ do+ x <- forAll Generator.ackGen+ tripping x encode eitherDecode++prop_transitMsgTrip :: Property+prop_transitMsgTrip = property $ do+ x <- forAll Generator.transitMsgGen+ tripping x encode eitherDecode++prop_transitAckTrip :: Property+prop_transitAckTrip = property $ do+ x <- forAll Generator.transitAckGen+ tripping x encode eitherDecode++messagesRoundTripTests :: IO Bool+messagesRoundTripTests =+ checkSequential $ Group "Messages"+ [ ("prop_abilityTrip", prop_abilityTrip)+ , ("prop_hintTrip", prop_hintTrip)+ , ("prop_connectionHintTrip", prop_connectionHintTrip)+ , ("prop_ackTrip", prop_ackTrip)+ , ("prop_transitMsgTrip", prop_transitMsgTrip)+ , ("prop_transitAckTrip", prop_transitAckTrip)+ ]+
+ tests/PipelineTests.hs view
@@ -0,0 +1,74 @@+module PipelineTests+ ( tests+ )+where++import Protolude hiding (putByteString, Selector)++import Test.Hspec+import Conduit ((.|))++import qualified Crypto.Saltine.Class as Saltine+import qualified Crypto.Saltine.Core.SecretBox as SecretBox+import qualified Data.Conduit as C+import qualified Data.Conduit.Binary as CB+import qualified Data.Conduit.Serialization.Binary as CSB+import qualified Data.ByteString as BS++import Data.Binary (Put)+import Data.Binary.Put (putWord32be, putByteString)++import Transit.Internal.Pipeline+import Transit.Internal.Crypto (CryptoError)++tests :: IO ()+tests = hspec $ do+ describe "assembleRecordC tests" $ do+ it "tests assembleRecordC with a short bytestring input" $ do+ let str = "hello" :: ByteString+ xs <- liftIO $ C.runConduitRes $+ CSB.sourcePut (putChunk str)+ .| assembleRecordC+ .| CB.isolate (BS.length str)+ .| CB.sinkLbs+ xs `shouldBe` (toS str)++ describe "decryptC tests" $ do+ it "tests a encryptC/decryptC round trip" $ do+ let key = fromMaybe (panic "cannot decode key") $+ Saltine.decode ("0123456789abcdef0123456789abcdef" :: ByteString)+ plaintext = "foobar" :: ByteString+ xs <- liftIO (C.runConduitRes $+ CSB.sourcePut (putByteString plaintext)+ .| encryptC key+ .| assembleRecordC+ .| decryptC key+ .| CB.isolate (BS.length plaintext)+ .| CB.sinkLbs)+ xs `shouldBe` (toS plaintext)++ it "throws CryptoError when a wrong nonce is encountered" $ do+ -- create a packet with a non-zero nonce concatenated with+ -- random input. Feed it as a source into decryptC and feed+ -- output into a sinkLbs. This should throw a BadNonce+ -- exception, as decryptC expects a nonce/sequence number of 0.+ let nonce = Saltine.nudge Saltine.zero :: SecretBox.Nonce+ key = fromMaybe (panic "cannot decode key") $+ Saltine.decode ("0123456789abcdef0123456789abcdef" :: ByteString)+ nonceBytes = Saltine.encode nonce+ plaintext = "foobar" :: ByteString+ packet = nonceBytes <> plaintext+ liftIO (C.runConduitRes $+ CSB.sourcePut (putByteString packet)+ .| decryptC key+ .| CB.isolate (BS.length packet)+ .| CB.sinkLbs)+ `shouldThrow` cryptoError+ where+ putChunk :: ByteString -> Put+ putChunk s = do+ let strlen = BS.length s+ putWord32be (fromIntegral @Int strlen)+ putByteString s+ cryptoError :: Selector CryptoError+ cryptoError = const True
+ tests/ProtocolTests.hs view
@@ -0,0 +1,32 @@+module ProtocolTests+ ( tests+ )+where++import Protolude+import Test.Hspec+import qualified Crypto.Saltine.Class as Saltine+import qualified Data.ByteString as BS++import qualified MagicWormhole++import Transit.Internal.Peer++tests :: IO ()+tests = hspec $ do+ describe "sender handshake tests" $ do+ it "sender handshake for a fixed key" $ do+ let skey = (fromMaybe (panic "error decoding bytestring into secretbox key") $ Saltine.decode (toS @Text @ByteString "12345678901234567890123456789012"))+ makeSenderHandshake skey `shouldBe` (toS @Text @ByteString "transit sender 8114b57043e22ca82f05b3aa21612bbcd403e6aa9b11e4a336dd749771775fa1 ready\n\n")+ it "receiver handshake for a fixed key" $ do+ let rkey = (fromMaybe (panic "error decoding bytestring into secretbox key") $ Saltine.decode (toS @Text @ByteString "12345678901234567890123456789012"))+ makeReceiverHandshake rkey `shouldBe` (toS @Text @ByteString "transit receiver 3b0d65f31e63b490b4edc13cf27a8b09cfb53c479f8ab67bc984e9f392ea28f4 ready\n\n")+ it "sender relay handshake for a given key" $ do+ sidea <- generateTransitSide+ let skey = (fromMaybe (panic "error decoding bytestring into secretbox key") $ Saltine.decode (toS @Text @ByteString "12345678901234567890123456789012"))+ MagicWormhole.Side s1 = sidea+ makeRelayHandshake skey sidea `shouldBe` (toS @Text @ByteString "please relay 24655fa61c1df5e320ee34d85417de170bcd5d31f69778600c2e3f78f2bd12b4 for side " <> (toS @Text @ByteString s1) <> "\n")+ it "sender relay handshake length" $ do+ sidea <- generateTransitSide+ let skey = (fromMaybe (panic "error decoding bytestring into secretbox key") $ Saltine.decode (toS @Text @ByteString "12345678901234567890123456789012"))+ BS.length (makeRelayHandshake skey sidea) `shouldBe` (BS.length (toS @Text @ByteString "please relay for side \n") + 32*2 + 8*2)
+ wordlist.txt view
@@ -0,0 +1,256 @@+00 aardvark adroitness+01 absurd adviser+02 accrue aftermath+03 acme aggregate+04 adrift alkali+05 adult almighty+06 afflict amulet+07 ahead amusement+08 aimless antenna+09 Algol applicant+0A allow Apollo+0B alone armistice+0C ammo article+0D ancient asteroid+0E apple Atlantic+0F artist atmosphere+10 assume autopsy+11 Athens Babylon+12 atlas backwater+13 Aztec barbecue+14 baboon belowground+15 backfield bifocals+16 backward bodyguard+17 banjo bookseller+18 beaming borderline+19 bedlamp bottomless+1A beehive Bradbury+1B beeswax bravado+1C befriend Brazilian+1D Belfast breakaway+1E berserk Burlington+1F billiard businessman+20 bison butterfat+21 blackjack Camelot+22 blockade candidate+23 blowtorch cannonball+24 bluebird Capricorn+25 bombast caravan+26 bookshelf caretaker+27 brackish celebrate+28 breadline cellulose+29 breakup certify+2A brickyard chambermaid+2B briefcase Cherokee+2C Burbank Chicago+2D button clergyman+2E buzzard coherence+2F cement combustion+30 chairlift commando+31 chatter company+32 checkup component+33 chisel concurrent+34 choking confidence+35 chopper conformist+36 Christmas congregate+37 clamshell consensus+38 classic consulting+39 classroom corporate+3A cleanup corrosion+3B clockwork councilman+3C cobra crossover+3D commence crucifix+3E concert cumbersome+3F cowbell customer+40 crackdown Dakota+41 cranky decadence+42 crowfoot December+43 crucial decimal+44 crumpled designing+45 crusade detector+46 cubic detergent+47 dashboard determine+48 deadbolt dictator+49 deckhand dinosaur+4A dogsled direction+4B dragnet disable+4C drainage disbelief+4D dreadful disruptive+4E drifter distortion+4F dropper document+50 drumbeat embezzle+51 drunken enchanting+52 Dupont enrollment+53 dwelling enterprise+54 eating equation+55 edict equipment+56 egghead escapade+57 eightball Eskimo+58 endorse everyday+59 endow examine+5A enlist existence+5B erase exodus+5C escape fascinate+5D exceed filament+5E eyeglass finicky+5F eyetooth forever+60 facial fortitude+61 fallout frequency+62 flagpole gadgetry+63 flatfoot Galveston+64 flytrap getaway+65 fracture glossary+66 framework gossamer+67 freedom graduate+68 frighten gravity+69 gazelle guitarist+6A Geiger hamburger+6B glitter Hamilton+6C glucose handiwork+6D goggles hazardous+6E goldfish headwaters+6F gremlin hemisphere+70 guidance hesitate+71 hamlet hideaway+72 highchair holiness+73 hockey hurricane+74 indoors hydraulic+75 indulge impartial+76 inverse impetus+77 involve inception+78 island indigo+79 jawbone inertia+7A keyboard infancy+7B kickoff inferno+7C kiwi informant+7D klaxon insincere+7E locale insurgent+7F lockup integrate+80 merit intention+81 minnow inventive+82 miser Istanbul+83 Mohawk Jamaica+84 mural Jupiter+85 music leprosy+86 necklace letterhead+87 Neptune liberty+88 newborn maritime+89 nightbird matchmaker+8A Oakland maverick+8B obtuse Medusa+8C offload megaton+8D optic microscope+8E orca microwave+8F payday midsummer+90 peachy millionaire+91 pheasant miracle+92 physique misnomer+93 playhouse molasses+94 Pluto molecule+95 preclude Montana+96 prefer monument+97 preshrunk mosquito+98 printer narrative+99 prowler nebula+9A pupil newsletter+9B puppy Norwegian+9C python October+9D quadrant Ohio+9E quiver onlooker+9F quota opulent+A0 ragtime Orlando+A1 ratchet outfielder+A2 rebirth Pacific+A3 reform pandemic+A4 regain Pandora+A5 reindeer paperweight+A6 rematch paragon+A7 repay paragraph+A8 retouch paramount+A9 revenge passenger+AA reward pedigree+AB rhythm Pegasus+AC ribcage penetrate+AD ringbolt perceptive+AE robust performance+AF rocker pharmacy+B0 ruffled phonetic+B1 sailboat photograph+B2 sawdust pioneer+B3 scallion pocketful+B4 scenic politeness+B5 scorecard positive+B6 Scotland potato+B7 seabird processor+B8 select provincial+B9 sentence proximate+BA shadow puberty+BB shamrock publisher+BC showgirl pyramid+BD skullcap quantity+BE skydive racketeer+BF slingshot rebellion+C0 slowdown recipe+C1 snapline recover+C2 snapshot repellent+C3 snowcap replica+C4 snowslide reproduce+C5 solo resistor+C6 southward responsive+C7 soybean retraction+C8 spaniel retrieval+C9 spearhead retrospect+CA spellbind revenue+CB spheroid revival+CC spigot revolver+CD spindle sandalwood+CE spyglass sardonic+CF stagehand Saturday+D0 stagnate savagery+D1 stairway scavenger+D2 standard sensation+D3 stapler sociable+D4 steamship souvenir+D5 sterling specialist+D6 stockman speculate+D7 stopwatch stethoscope+D8 stormy stupendous+D9 sugar supportive+DA surmount surrender+DB suspense suspicious+DC sweatband sympathy+DD swelter tambourine+DE tactics telephone+DF talon therapist+E0 tapeworm tobacco+E1 tempest tolerance+E2 tiger tomorrow+E3 tissue torpedo+E4 tonic tradition+E5 topmost travesty+E6 tracker trombonist+E7 transit truncated+E8 trauma typewriter+E9 treadmill ultimate+EA Trojan undaunted+EB trouble underfoot+EC tumor unicorn+ED tunnel unify+EE tycoon universe+EF uncut unravel+F0 unearth upcoming+F1 unwind vacancy+F2 uproot vagabond+F3 upset vertigo+F4 upshot Virginia+F5 vapor visitor+F6 village vocalist+F7 virus voyager+F8 Vulcan warranty+F9 waffle Waterloo+FA wallet whimsical+FB watchword Wichita+FC wayside Wilmington+FD willow Wyoming+FE woodlark yesteryear+FF Zulu Yucatan