packages feed

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 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