packages feed

keysafe (empty) → 0.20160819

raw patch · 30 files changed

+3603/−0 lines, 30 filesdep +basedep +binarydep +bytestringbuild-type:Customsetup-changed

Dependencies added: base, binary, bytestring, containers, deepseq, dice-entropy-conduit, directory, filepath, finite-field, optparse-applicative, polynomial, process, raaz, random, readline, split, text, time, unix, utf8-string, vector, zxcvbn-c

Files

+ AGPL view
@@ -0,0 +1,661 @@+                    GNU AFFERO GENERAL PUBLIC LICENSE+                       Version 3, 19 November 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 Affero General Public License is a free, copyleft license for+software and other kinds of works, specifically designed to ensure+cooperation with the community in the case of network server software.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+our General Public Licenses are intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  Developers that use our General Public Licenses protect your rights+with two steps: (1) assert copyright on the software, and (2) offer+you this License which gives you legal permission to copy, distribute+and/or modify the software.++  A secondary benefit of defending all users' freedom is that+improvements made in alternate versions of the program, if they+receive widespread use, become available for other developers to+incorporate.  Many developers of free software are heartened and+encouraged by the resulting cooperation.  However, in the case of+software used on network servers, this result may fail to come about.+The GNU General Public License permits making a modified version and+letting the public access it on a server without ever releasing its+source code to the public.++  The GNU Affero General Public License is designed specifically to+ensure that, in such cases, the modified source code becomes available+to the community.  It requires the operator of a network server to+provide the source code of the modified version running there to the+users of that server.  Therefore, public use of a modified version, on+a publicly accessible server, gives the public access to the source+code of the modified version.++  An older license, called the Affero General Public License and+published by Affero, was designed to accomplish similar goals.  This is+a different license, not a version of the Affero GPL, but Affero has+released a new version of the Affero GPL which permits relicensing under+this license.++  The precise terms and conditions for copying, distribution and+modification follow.++                       TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU Affero General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Remote Network Interaction; Use with the GNU General Public License.++  Notwithstanding any other provision of this License, if you modify the+Program, your modified version must prominently offer all users+interacting with it remotely through a computer network (if your version+supports such interaction) an opportunity to receive the Corresponding+Source of your version by providing access to the Corresponding Source+from a network server at no charge, through some standard or customary+means of facilitating copying of software.  This Corresponding Source+shall include the Corresponding Source for any work covered by version 3+of the GNU General Public License that is incorporated pursuant to the+following paragraph.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the work with which it is combined will remain governed by version+3 of the GNU General Public License.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU Affero General Public License from time to time.  Such new versions+will be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++  Each version is given a distinguishing version number.  If the+Program specifies that a certain numbered version of the GNU Affero General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU Affero General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU Affero General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <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 Affero General Public License as published by+    the Free Software Foundation, either version 3 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU Affero General Public License for more details.++    You should have received a copy of the GNU Affero General Public License+    along with this program.  If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If your software can interact with users remotely through a computer+network, you should also make sure that it provides a way for users to+get its source.  For example, if your program is a web application, its+interface could display a "Source" link that leads users to an archive+of the code.  There are many ways you could offer source, and different+solutions will be better for different programs; see section 13 for the+specific requirements.++  You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU AGPL, see+<http://www.gnu.org/licenses/>.
+ CHANGELOG view
@@ -0,0 +1,13 @@+keysafe (0.20160819) unstable; urgency=medium++  * First release of keysafe. This is not yet ready for production use.+  * Network support is not yet implemented, but --store-local works for+    testing with local data storage.+  * Data backed up with keysafe version 0.* will not be able to be restored+    by any later version! Once the data format stabalizes, keysafe version+    1 data will be supported by every later version.+  * Argon2 hashes are not yet tuned for modern hardware, but only for my+    laptop. So, cracking cost estimates may be low. To help with this+    tuning, run `keysafe --bechmark` and send the output to me.++ -- Joey Hess <id@joeyh.name>  Fri, 19 Aug 2016 19:41:06 -0400
+ CmdLine.hs view
@@ -0,0 +1,108 @@+{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module CmdLine where++import Types+import Tunables+import qualified Gpg+import Options.Applicative+import qualified Data.ByteString.UTF8 as BU8+import System.Directory++data CmdLine = CmdLine+	{ mode :: Maybe Mode+	, secretkeysource :: Maybe SecretKeySource+	, localstorage :: Bool+	, gui :: Bool+	, testMode :: Bool+	, customShareParams :: Maybe ShareParams+	}++data Mode = Backup | Restore | UploadQueued | Benchmark+	deriving (Show)++parse :: Parser CmdLine+parse = CmdLine+	<$> optional (backup <|> restore <|> uploadqueued <|> benchmark)+	<*> optional (gpgswitch <|> fileswitch)+	<*> localstorageswitch+	<*> guiswitch+	<*> testmodeswitch+	<*> optional (ShareParams <$> totalobjects <*> neededobjects)+  where+	backup = flag' Backup+		( long "backup"+		<> help "Store a secret key in keysafe."+		)+	restore = flag' Restore+		( long "restore"+		<> help "Retrieve a secret key from keysafe."+		)+	uploadqueued = flag' UploadQueued+		( long "uploadqueued"+		<> help "Upload any data to servers that was queued by a previous --backup run."+		)+	benchmark = flag' Benchmark+		( long "benchmark"+		<> help "Benchmark speed of keysafe's cryptographic primitives."+		)+	gpgswitch = GpgKey . KeyId . BU8.fromString <$> strOption+		( long "gpgkeyid"+		<> metavar "KEYID"+		<> help "Specify keyid of gpg key to back up or restore. (When this option is used to back up a key, it must also be used at restore time.)"+		)+	fileswitch = KeyFile <$> strOption+		( long "keyfile"+		<> metavar "FILE"+		<> help "Specify secret key file to back up or restore. (The same filename must be used to restore a key as was used to back it up.)"+		)+	localstorageswitch = switch+		( long "store-local"+		<> help "Store data locally, in ~/.keysafe/objects/local/. (The default is to store data in the cloud.)"+		)+	testmodeswitch = switch+		( long "testmode"+		<> help "Avoid using expensive cryptographic operations to secure data. Use for testing only, not with real secret keys."+		)+	guiswitch = switch+		( long "gui"+		<> help "Use GUI interface for interaction. Default is to use readline interface when run in a terminal, and GUI otherwise."+		)+	totalobjects = option auto +		( long "totalshares"+		<> metavar "M"+		<> help ("Configure the number of shares to split encrypted secret key into. Default: " ++ show (totalObjects (shareParams defaultTunables)) ++ " (When this option is used to back up a key, it must also be provided at restore time.)")+		)+	neededobjects = option auto +		( long "neededshares"+		<> metavar "N"+		<> help ("Configure the number of shares needed to restore. Default: " ++ show (neededObjects (shareParams defaultTunables)) ++ " (When this option is used to back up a key, it must also be provided at restore time.)")+		)++get :: IO CmdLine+get = execParser opts+  where+	opts = info (helper <*> parse)+		( fullDesc+		<> header "keysafe - securely back up secret keys"+		)++-- | When a mode is not specified on the command line,+-- default to backing up if a secret key exists, and otherwise restoring.+selectMode :: CmdLine -> IO Mode+selectMode cmdline = case mode cmdline of+	Just m -> return m+	Nothing -> case secretkeysource cmdline of+		Just (KeyFile f) -> present <$> doesFileExist f+		_ -> present . not . null <$> Gpg.listSecretKeys+  where+	present True = Backup+	present False = Restore++customizeShareParams :: CmdLine -> Tunables -> Tunables+customizeShareParams cmdline t = case customShareParams cmdline of+	Nothing -> t+	Just ps -> t { shareParams = ps }
+ Cost.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}++{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Cost (+	module Cost,+	module Types.Cost+) where++import Types.Cost++-- | Cost in seconds, with the type of hardware needed.+totalCost :: Cost op -> (Seconds, [UsingHardware])+totalCost (CPUCost s) = (s, [UsingCPU])++raiseCostPower :: Cost c -> Entropy e -> Cost c+raiseCostPower c (Entropy e) = adjustCost c (* 2^e)++adjustCost :: Cost c -> (Seconds -> Seconds) -> Cost c+adjustCost (CPUCost s) f = CPUCost (f s)++castCost :: Cost a -> Cost b+castCost (CPUCost s) = CPUCost s++-- | CostCalc for a brute force linear search through an entropy space+-- in which each step entails paying a cost.+--+-- On average, the solution will be found half way through.+-- This is equivilant to one bit less of entropy.+bruteForceLinearSearch :: Cost step -> CostCalc BruteForceOp t+bruteForceLinearSearch stepcost e = +	castCost stepcost `raiseCostPower` reduceEntropy e 1++-- | Estimate of cost of a brute force attack.+estimateBruteforceOf :: Bruteforceable t a => t -> Entropy a -> Cost BruteForceOp+estimateBruteforceOf t e = getBruteCostCalc t e++data DataCenterPrice = DataCenterPrice+	{ instanceCpuCores :: Integer+	, instanceCostPerHour :: Cents+	}++-- August 2016 spot pricing: 36 CPU core c4.8xlarge at 33c/hour+spotAWS :: DataCenterPrice+spotAWS = DataCenterPrice+	{ instanceCpuCores = 36+	, instanceCostPerHour = Cents 33+	}++-- | Estimate of cost of brute force attack using a datacenter.+--+-- Note that this assumes that CPU cores and GPU cores are of equal number,+-- which is unlikely to be the case; typically there will be many more+-- cores than GPUs. So, this underestimates the price to brute force+-- operations which run faster on GPUs.+estimateAttackCost :: DataCenterPrice -> Cost BruteForceOp -> Dollars+estimateAttackCost dc opcost = centsToDollars $ costcents+  where+	(Seconds cpuseconds) = fst (totalCost opcost)+	cpuyears = cpuseconds `div` (60*60*24*365)+	costpercpuyear = Cents $+		fromIntegral (instanceCostPerHour dc) * 24 * 365+			`div` instanceCpuCores dc+	costcents = Cents cpuyears * costpercpuyear++newtype Cents = Cents Integer+	deriving (Num, Integral, Enum, Real, Ord, Eq, Show)++newtype Dollars = Dollars Integer+	deriving (Num, Integral, Enum, Real, Ord, Eq)++instance Show Dollars where+	show (Dollars n) = go +		[ (1000000000000, "trillion")+		, (1000000000, "billion")+		, (1000000, "million")+		, (1000, "thousand")+		]+	  where+		go [] = "$" ++ show n+		go ((d, u):us)+			| n >= d = +				let n' = n `div` d+				in "$" ++ show n' ++ " " ++ u+			| otherwise = go us++centsToDollars :: Cents -> Dollars+centsToDollars (Cents c) = Dollars (c `div` 100)++type Year = Integer++-- | Apply Moore's law to show how a cost might vary over time.+costOverTime :: Dollars -> Year -> [(Dollars, Year)]+costOverTime (Dollars currcost) thisyear = +	(Dollars currcost, thisyear) : map calc otheryears+  where+	otheryears = [thisyear+1, thisyear+5, thisyear+10]+	calc y = +		let monthdelta = (fromIntegral ((y * 12) - (thisyear * 12))) :: Double+		    cost = floor $ fromIntegral currcost / 2 ** (monthdelta / 18)+		in (Dollars cost, y)++costOverTimeTable :: Dollars -> Year -> [String]+costOverTimeTable cost thisyear = go [] thisyear $ costOverTime cost thisyear+  where+	go t _ [] = reverse t+	go t yprev ((c, y):ys) =+		let s = "  in " ++ show y ++ ":  " ++ show c+		in if yprev < y - 1+			then go (s:"  ...":t) y ys+			else go (s:t) y ys
+ Crypto/Argon2.hs view
@@ -0,0 +1,280 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE RecordWildCards #-}++{-|++"Crypto.Argon2" provides bindings to the+<https://github.com/P-H-C/phc-winner-argon2 reference implementation> of Argon2,+the password-hashing function that won the+<https://password-hashing.net/ Password Hashing Competition (PHC)>. ++The main entry points to this module are 'hashEncoded', which produces a+crypt-like ASCII output; and 'hash' which produces a 'BS.ByteString' (a stream+of bytes). Argon2 is a configurable hash function, and can be configured by+supplying a particular set of 'HashOptions' - 'defaultHashOptions' should provide+a good starting point. See 'HashOptions' for more documentation on the particular+parameters that can be adjusted.++For access directly to the C interface, see "Crypto.Argon2.FFI".++-}++{- ++Copyright (c) 2016, Ollie Charles++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ollie Charles nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++ -}++module Crypto.Argon2+       ( -- * Computing hashes+         hashEncoded, hash,+         -- * Verification+         verify,+         -- * Configuring hashing+         HashOptions(..), Argon2Variant(..), defaultHashOptions,+         -- * Exceptions+         Argon2Exception(..))+       where++import GHC.Generics (Generic)+import Control.Exception+import Data.Typeable+import Foreign+import Foreign.C+import System.IO.Unsafe (unsafePerformIO)+import qualified Crypto.Argon2.FFI as FFI+import qualified Data.ByteString as BS+import qualified Data.Text as T+import qualified Data.Text.Encoding as T++-- | Which variant of Argon2 to use. You should choose the variant that is most+-- applicable to your intention to hash inputs.+data Argon2Variant+  = Argon2i  -- ^ Argon2i uses data-independent memory access, which is preferred+             -- for password hashing and password-based key derivation. Argon2i+             -- is slower as it makes more passes over the memory to protect from+             -- tradeoff attacks.+  | Argon2d -- ^ Argon2d is faster and uses data-depending memory access, which+            -- makes it suitable for cryptocurrencies and applications with no+            -- threats from side-channel timing attacks.+  deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable,Enum)++-- | Parameters that can be adjusted to change the runtime performance of the+-- hashing.+data HashOptions =+  HashOptions {hashIterations :: !Word32 -- ^ The time cost, which defines the amount of computation realized and therefore the execution time, given in number of iterations.+                                         --+                                         -- 'FFI.ARGON2_MIN_TIME' <= 'hashIterations' <= 'FFI.ARGON2_MAX_TIME'+              ,hashMemory :: !Word32 -- ^ The memory cost, which defines the memory usage, given in kibibytes.+                                     --+                                     -- max 'FFI.ARGON2_MIN_MEMORY' (8 * 'hashParallelism') <= 'hashMemory' <= 'FFI.ARGON2_MAX_MEMORY'+              ,hashParallelism :: !Word32 -- ^ A parallelism degree, which defines the number of parallel threads.+                                          --+                                          -- 'FFI.ARGON2_MIN_LANES' <= 'hashParallelism' <= 'FFI.ARGON2_MAX_LANES' && 'FFI.ARGON_MIN_THREADS' <= 'hashParallelism' <= 'FFI.ARGON2_MAX_THREADS'+              ,hashVariant :: !Argon2Variant -- ^ Which version of Argon2 to use.+              }+  deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable)++-- | A set of default 'HashOptions', taken from the @argon2@ executable.+--+-- @+-- 'defaultHashOptions' :: 'HashOptions'+-- 'defaultHashOptions' =+--   'HashOptions' {'hashIterations' = 1+--               ,'hashMemory' = 2 ^ 17+--               ,'hashParallelism' = 4+--               ,'hashVariant' = 'Argon2i'}+-- @+defaultHashOptions :: HashOptions+defaultHashOptions =+  HashOptions {hashIterations = 1+              ,hashMemory = 2 ^ (17 :: Integer)+              ,hashParallelism = 4+              ,hashVariant = Argon2i}++-- | Encode a password with a given salt and 'HashOptions' and produce a textual+-- encoding of the result.+hashEncoded :: HashOptions -- ^ Options pertaining to how expensive the hash is to calculate.+            -> BS.ByteString -- ^ The password to hash. Must be less than 4294967295 bytes.+            -> BS.ByteString -- ^ The salt to use when hashing. Must be less than 4294967295 bytes.+            -> T.Text -- ^ The encoded password hash.+hashEncoded options password salt =+  unsafePerformIO+    (hashEncoded' options password salt FFI.argon2i_hash_encoded FFI.argon2d_hash_encoded)++-- | Encode a password with a given salt and 'HashOptions' and produce a stream+-- of bytes.+hash :: HashOptions -- ^ Options pertaining to how expensive the hash is to calculate.+     -> BS.ByteString -- ^ The password to hash. Must be less than 4294967295 bytes.+     -> BS.ByteString -- ^ The salt to use when hashing. Must be less than 4294967295 bytes.+     -> BS.ByteString -- ^ The un-encoded password hash.+hash options password salt =+  unsafePerformIO (hash' options password salt FFI.argon2i_hash_raw FFI.argon2d_hash_raw)++variant :: a -> a -> Argon2Variant -> a+variant a _ Argon2i = a+variant _ b Argon2d = b+{-# INLINE variant #-}++-- | Not all 'HashOptions' can necessarily be used to compute hashes. If you+-- supply invalid 'HashOptions' (or hashing otherwise fails) a 'Argon2Exception'+-- will be throw.+data Argon2Exception+  = -- | The length of the supplied password is outside the range supported by @libargon2@.+    Argon2PasswordLengthOutOfRange !Word64 -- ^ The erroneous length.+  | -- | The length of the supplied salt is outside the range supported by @libargon2@.+    Argon2SaltLengthOutOfRange !Word64 -- ^ The erroneous length.+  | -- | Either too much or too little memory was requested via 'hashMemory'.+    Argon2MemoryUseOutOfRange !Word32 -- ^ The erroneous 'hashMemory' value.+  | -- | Either too few or too many iterations were requested via 'hashIterations'.+    Argon2IterationCountOutOfRange !Word32 -- ^ The erroneous 'hashIterations' value.+  | -- | Either too much or too little parallelism was requested via 'hasParallelism'.+    Argon2ParallelismOutOfRange !Word32 -- ^ The erroneous 'hashParallelism' value.+  | -- | An unexpected exception was throw. Please <https://github.com/ocharles/argon2/issues report this as a bug>!+    Argon2Exception !Int32 -- ^ The =libargon2= error code.+  deriving (Typeable, Show)++instance Exception Argon2Exception++type Argon2Encoded = Word32 -> Word32 -> Word32 -> CString -> Word64 -> CString -> Word64 -> Word64 -> CString -> Word64 -> IO Int32++hashEncoded' :: HashOptions+             -> BS.ByteString+             -> BS.ByteString+             -> Argon2Encoded+             -> Argon2Encoded+             -> IO T.Text+hashEncoded' options@HashOptions{..} password salt argon2i argon2d =+  do let saltLen = fromIntegral (BS.length salt)+         passwordLen = fromIntegral (BS.length password)+         outLen =+           (BS.length salt * 4 + 32 * 4 ++            length ("$argon2x$m=,t=,p=$$" :: String) ++            3 * 3)+     out <- mallocBytes outLen+     res <-+       BS.useAsCString password $+       \password' ->+         BS.useAsCString salt $+         \salt' ->+           argon2 hashIterations+                  hashMemory+                  hashParallelism+                  password'+                  passwordLen+                  salt'+                  saltLen+                  64+                  out+                  (fromIntegral outLen)+     handleSuccessCode res options password salt+     fmap T.decodeUtf8 (BS.packCString out)+  where argon2 = variant argon2i argon2d hashVariant++type Argon2Unencoded = Word32 -> Word32 -> Word32 -> CString -> Word64 -> CString -> Word64 -> CString -> Word64 -> IO Int32++hash' :: HashOptions+      -> BS.ByteString+      -> BS.ByteString+      -> Argon2Unencoded+      -> Argon2Unencoded+      -> IO BS.ByteString+hash' options@HashOptions{..} password salt argon2i argon2d =+  do let saltLen = fromIntegral (BS.length salt)+         passwordLen = fromIntegral (BS.length password)+         outLen = 512+     out <- mallocBytes outLen+     res <-+       BS.useAsCString password $+       \password' ->+         BS.useAsCString salt $+         \salt' ->+           argon2 hashIterations+                  hashMemory+                  hashParallelism+                  password'+                  passwordLen+                  salt'+                  saltLen+                  out+                  (fromIntegral outLen)+     handleSuccessCode res options password salt+     BS.packCString out+  where argon2 = variant argon2i argon2d hashVariant++handleSuccessCode :: Int32+                  -> HashOptions+                  -> BS.ByteString+                  -> BS.ByteString+                  -> IO ()+handleSuccessCode res HashOptions{..} password salt =+  let saltLen = fromIntegral (BS.length salt)+      passwordLen = fromIntegral (BS.length password)+  in case res of+       a+         | a `elem` [FFI.ARGON2_OK] -> return ()+         | a `elem` [FFI.ARGON2_SALT_TOO_SHORT,FFI.ARGON2_SALT_TOO_LONG] ->+           throwIO (Argon2SaltLengthOutOfRange saltLen)+         | a `elem` [FFI.ARGON2_PWD_TOO_SHORT,FFI.ARGON2_PWD_TOO_LONG] ->+           throwIO (Argon2PasswordLengthOutOfRange passwordLen)+         | a `elem` [FFI.ARGON2_TIME_TOO_SMALL,FFI.ARGON2_TIME_TOO_LARGE] ->+           throwIO (Argon2IterationCountOutOfRange hashIterations)+         | a `elem` [FFI.ARGON2_MEMORY_TOO_LITTLE,FFI.ARGON2_MEMORY_TOO_MUCH] ->+           throwIO (Argon2MemoryUseOutOfRange hashMemory)+         | a `elem`+             [FFI.ARGON2_LANES_TOO_FEW+             ,FFI.ARGON2_LANES_TOO_MANY+             ,FFI.ARGON2_THREADS_TOO_FEW+             ,FFI.ARGON2_THREADS_TOO_MANY] ->+           throwIO (Argon2ParallelismOutOfRange hashParallelism)+         | otherwise -> throwIO (Argon2Exception a)++-- | Verify that a given password could result in a given hash output.+-- Automatically determines the correct 'HashOptions' based on the+-- encoded hash (as produced by 'hashEncoded').+verify+  :: T.Text -> BS.ByteString -> Bool+verify encoded password =+  unsafePerformIO+    (BS.useAsCString password $+     \pwd ->+       BS.useAsCString (T.encodeUtf8 encoded) $+       \enc ->+         do res <-+              (variant FFI.argon2i_verify FFI.argon2d_verify v) enc+                                                                pwd+                                                                (fromIntegral (BS.length password))+            return (res == FFI.ARGON2_OK))+    where v | T.pack "$argon2i" `T.isPrefixOf` encoded = Argon2i+            | otherwise = Argon2d
+ Crypto/Argon2/FFI.hsc view
@@ -0,0 +1,127 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE PatternSynonyms #-}++module Crypto.Argon2.FFI where++#include <argon2.h>+#include <stdint.h>++{- ++Copyright (c) 2016, Ollie Charles++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ollie Charles nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++ -}++import Foreign+import Foreign.C++foreign import ccall unsafe "argon2.h argon2i_hash_encoded" argon2i_hash_encoded :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> (#type const size_t) -> Ptr b -> (# type const size_t) -> (#type const size_t) -> CString -> (#type const size_t) -> IO (#type int)++foreign import ccall unsafe "argon2.h argon2i_hash_raw" argon2i_hash_raw :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> (#type const size_t) -> Ptr b -> (#type size_t) -> Ptr c -> (#type const size_t) -> IO (#type int)++foreign import ccall unsafe "argon2.h argon2d_hash_encoded" argon2d_hash_encoded :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> (#type const size_t) -> Ptr b -> (# type const size_t) -> (#type const size_t) -> CString -> (#type const size_t) -> IO (#type int)++foreign import ccall unsafe "argon2.h argon2d_hash_raw" argon2d_hash_raw :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> (#type const size_t) -> Ptr b -> (#type size_t) -> Ptr c -> (#type const size_t) -> IO (#type int)++foreign import ccall unsafe "argon2.h argon2i_verify" argon2i_verify :: CString -> Ptr a -> (#type const size_t) -> IO (#type int)++foreign import ccall unsafe "argon2.h argon2d_verify" argon2d_verify :: CString -> Ptr a -> (#type const size_t) -> IO (#type int)++pattern ARGON2_OK = (#const ARGON2_OK)+pattern ARGON2_OUTPUT_PTR_NULL = (#const ARGON2_OUTPUT_PTR_NULL)+pattern ARGON2_OUTPUT_TOO_SHORT = (#const ARGON2_OUTPUT_TOO_SHORT)+pattern ARGON2_OUTPUT_TOO_LONG = (#const ARGON2_OUTPUT_TOO_LONG)+pattern ARGON2_PWD_TOO_SHORT = (#const ARGON2_PWD_TOO_SHORT)+pattern ARGON2_PWD_TOO_LONG = (#const ARGON2_PWD_TOO_LONG)+pattern ARGON2_SALT_TOO_SHORT = (#const ARGON2_SALT_TOO_SHORT)+pattern ARGON2_SALT_TOO_LONG = (#const ARGON2_SALT_TOO_LONG)+pattern ARGON2_AD_TOO_SHORT = (#const ARGON2_AD_TOO_SHORT)+pattern ARGON2_AD_TOO_LONG = (#const ARGON2_AD_TOO_LONG)+pattern ARGON2_SECRET_TOO_SHORT = (#const ARGON2_SECRET_TOO_SHORT)+pattern ARGON2_SECRET_TOO_LONG = (#const ARGON2_SECRET_TOO_LONG)+pattern ARGON2_TIME_TOO_SMALL = (#const ARGON2_TIME_TOO_SMALL)+pattern ARGON2_TIME_TOO_LARGE = (#const ARGON2_TIME_TOO_LARGE)+pattern ARGON2_MEMORY_TOO_LITTLE = (#const ARGON2_MEMORY_TOO_LITTLE)+pattern ARGON2_MEMORY_TOO_MUCH = (#const ARGON2_MEMORY_TOO_MUCH)+pattern ARGON2_LANES_TOO_FEW = (#const ARGON2_LANES_TOO_FEW)+pattern ARGON2_LANES_TOO_MANY = (#const ARGON2_LANES_TOO_MANY)+pattern ARGON2_PWD_PTR_MISMATCH = (#const ARGON2_PWD_PTR_MISMATCH)+pattern ARGON2_SALT_PTR_MISMATCH = (#const ARGON2_SALT_PTR_MISMATCH)+pattern ARGON2_SECRET_PTR_MISMATCH = (#const ARGON2_SECRET_PTR_MISMATCH)+pattern ARGON2_AD_PTR_MISMATCH = (#const ARGON2_AD_PTR_MISMATCH)+pattern ARGON2_MEMORY_ALLOCATION_ERROR = (#const ARGON2_MEMORY_ALLOCATION_ERROR)+pattern ARGON2_FREE_MEMORY_CBK_NULL = (#const ARGON2_FREE_MEMORY_CBK_NULL)+pattern ARGON2_ALLOCATE_MEMORY_CBK_NULL = (#const ARGON2_ALLOCATE_MEMORY_CBK_NULL)+pattern ARGON2_INCORRECT_PARAMETER = (#const ARGON2_INCORRECT_PARAMETER)+pattern ARGON2_INCORRECT_TYPE = (#const ARGON2_INCORRECT_TYPE)+pattern ARGON2_OUT_PTR_MISMATCH = (#const ARGON2_OUT_PTR_MISMATCH)+pattern ARGON2_THREADS_TOO_FEW = (#const ARGON2_THREADS_TOO_FEW)+pattern ARGON2_THREADS_TOO_MANY = (#const ARGON2_THREADS_TOO_MANY)+pattern ARGON2_MISSING_ARGS = (#const ARGON2_MISSING_ARGS)+pattern ARGON2_ENCODING_FAIL = (#const ARGON2_ENCODING_FAIL)+pattern ARGON2_DECODING_FAIL = (#const ARGON2_DECODING_FAIL)++pattern ARGON2_MIN_LANES = (#const ARGON2_MIN_LANES)+pattern ARGON2_MAX_LANES = (#const ARGON2_MAX_LANES)++pattern ARGON2_MIN_THREADS = (#const ARGON2_MIN_THREADS)+pattern ARGON2_MAX_THREADS = (#const ARGON2_MAX_THREADS)++pattern ARGON2_SYNC_POINTS = (#const ARGON2_SYNC_POINTS)++pattern ARGON2_MIN_OUTLEN = (#const ARGON2_MIN_OUTLEN)+pattern ARGON2_MAX_OUTLEN = (#const ARGON2_MAX_OUTLEN)++pattern ARGON2_MIN_MEMORY = (#const ARGON2_MIN_MEMORY)++pattern ARGON2_MAX_MEMORY_BITS = (#const ARGON2_MAX_MEMORY_BITS)+pattern ARGON2_MAX_MEMORY = (#const ARGON2_MAX_MEMORY)++pattern ARGON2_MIN_TIME = (#const ARGON2_MIN_TIME)+pattern ARGON2_MAX_TIME = (#const ARGON2_MAX_TIME)++pattern ARGON2_MIN_PWD_LENGTH = (#const ARGON2_MIN_PWD_LENGTH)+pattern ARGON2_MAX_PWD_LENGTH = (#const ARGON2_MAX_PWD_LENGTH)++pattern ARGON2_MIN_AD_LENGTH = (#const ARGON2_MIN_AD_LENGTH)+pattern ARGON2_MAX_AD_LENGTH = (#const ARGON2_MAX_AD_LENGTH)++pattern ARGON2_MIN_SALT_LENGTH = (#const ARGON2_MIN_SALT_LENGTH)+pattern ARGON2_MAX_SALT_LENGTH = (#const ARGON2_MAX_SALT_LENGTH)++pattern ARGON2_MIN_SECRET = (#const ARGON2_MIN_SECRET)+pattern ARGON2_MAX_SECRET = (#const ARGON2_MAX_SECRET)++pattern ARGON2_FLAG_CLEAR_PASSWORD = (#const ARGON2_FLAG_CLEAR_PASSWORD)+pattern ARGON2_FLAG_CLEAR_SECRET = (#const ARGON2_FLAG_CLEAR_SECRET)+pattern ARGON2_FLAG_CLEAR_MEMORY = (#const ARGON2_FLAG_CLEAR_MEMORY)+pattern ARGON2_DEFAULT_FLAGS = (#const ARGON2_DEFAULT_FLAGS)
+ Crypto/SecretSharing/Internal.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, GeneralizedNewtypeDeriving, TemplateHaskell #-} +-----------------------------------------------------------------------------+-- |+-- Module      :  Crypto.SecretSharing.Internal+-- Copyright   :  Peter Robinson 2014+-- License     :  LGPL+-- +-- Maintainer  :  Peter Robinson <peter.robinson@monoid.at>+-- Stability   :  experimental+-- Portability :  portable+-- +-----------------------------------------------------------------------------++module Crypto.SecretSharing.Internal+where+import Math.Polynomial.Interpolation++import Data.ByteString.Lazy( ByteString )+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC+import qualified Data.List as L+import Data.Char+import Data.Vector( Vector )+import qualified Data.Vector as V+import Data.Typeable+import Control.Exception+import Control.Monad+import Data.Binary( Binary )+import GHC.Generics+import Data.FiniteField.PrimeField as PF+import Data.FiniteField.Base(FiniteField,order)+import System.Random.Dice++++-- | A share of an encoded byte. +data ByteShare = ByteShare +  { shareId :: !Int                  -- ^ the index of this share +  , reconstructionThreshold :: !Int  -- ^ number of shares required for +                                     -- reconstruction+  , shareValue :: !Int        -- ^ the value of p(shareId) where p(x) is the +                              --   generated (secret) polynomial+  }+  deriving(Typeable,Eq,Generic)++instance Show ByteShare where+  show = show . shareValue ++-- | A share of the encoded secret.+data Share = Share +  { theShare :: ![ByteShare] }+  deriving(Typeable,Eq,Generic)++instance Show Share where+  show s = show (shareId $ head $ theShare s,BLC.pack $ map (chr . shareValue) $ theShare s)++instance Binary ByteShare+instance Binary Share++-- | Encodes a 'ByteString' as a list of n shares, m of which are required for+-- reconstruction.+-- Lives in the 'IO' to access a random source.+encode :: Int         -- ^ m +       -> Int         -- ^ n+       -> ByteString  -- ^ the secret that we want to share+       -> IO [Share] -- a list of n-shares (per byte) +encode m n bstr +  | n >= prime || m > n = throw $ AssertionFailed $ +      "encode: require n < " ++ show prime ++ " and m<=n."+  | BL.null bstr = return []+  | otherwise = do+  let len = max 1 ((fromIntegral $ BL.length bstr) * (m-1))+  coeffs <- (groupInto (m-1) . map fromIntegral . take len ) +                            `liftM` (getDiceRolls prime len)+  let byteVecs = zipWith (encodeByte m n) coeffs $+                    map fromIntegral $ BL.unpack bstr +  return [ Share $ map (V.! (i-1)) byteVecs | i <- [1..n] ]+++-- | Reconstructs a (secret) bytestring from a list of (at least @m@) shares. +-- Throws 'AssertionFailed' if the number of shares is too small.+decode :: [Share]    -- ^ list of at least @m@ shares+       -> ByteString -- ^ reconstructed secret+decode []     = BL.pack []+decode shares@((Share s):_) +  | length shares < reconstructionThreshold (head s) = throw $ AssertionFailed +      "decode: not enough shares for reconstruction."+  | otherwise =+    let origLength = length s in+    let byteVecs = map (V.fromList . theShare) shares in+    let byteShares = [ map ((V.! (i-1))) byteVecs | i <- [1..origLength] ] in+    BL.pack . map (fromInteger . PF.toInteger . number) +            . map decodeByte $ byteShares+    ++encodeByte :: Int -> Int -> Polyn -> FField -> Vector ByteShare+encodeByte m n coeffs secret = +  V.fromList[ ByteShare i m $ fromInteger . PF.toInteger . number $ +                evalPolynomial (secret:coeffs) (fromIntegral i::FField) +            | i <- [1..n] +            ]+++decodeByte :: [ByteShare] -> FField+decodeByte ss =+  let m = reconstructionThreshold $ head ss in+  if length ss < m+    then throw $ AssertionFailed "decodeByte: insufficient number of shares for reconstruction!"+    else+      let shares = take m ss +          pts = map (\s -> (fromIntegral $ shareId s,fromIntegral $ shareValue s)) +                    shares +      in+      polyInterp pts 0+++-- | Groups a list into blocks of certain size. Running time: /O(n)/+groupInto :: Int -> [a] -> [[a]]+groupInto num as+  | num < 0  = throw $ AssertionFailed "groupInto: Need positive number as argument."+  | otherwise = +    let (fs,ss) = L.splitAt num as in+    if L.null ss +      then [fs]+      else fs : groupInto num ss +++-- | A finite prime field. All computations are performed in this field.+--+-- This is modified from the secret-sharing library to use 256+-- instead of 1021. That allows values in the field to be efficiently+-- packed into bytes. It's beleived that the finite field can be a power of+-- a prime number (in this case, 2).+newtype FField = FField { number :: $(primeField $ fromIntegral (256 :: Integer)) }+  deriving(Show,Read,Ord,Eq,Num,Fractional,Generic,Typeable,FiniteField)+  ++-- | The size of the finite field+prime :: Int+prime = fromInteger $ order (0 :: FField)+++-- | A polynomial over the finite field given as a list of coefficients.+type Polyn = [FField] ++-- | Evaluates the polynomial at a given point.+evalPolynomial :: Polyn -> FField -> FField+evalPolynomial coeffs x =+  foldr (\c res -> c + (x * res)) 0 coeffs+--  let clist = zipWith (\pow c -> (\x -> c * (x^pow))) [0..] coeffs +--  in L.foldl' (+) 0 [ c x | c <- clist ]+
+ Encryption.hs view
@@ -0,0 +1,267 @@+{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses, DataKinds #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Encryption where++import Types+import Tunables+import Cost+import ExpensiveHash+import Data.Monoid+import Data.Maybe+import Data.Word+import qualified Raaz+import qualified Raaz.Cipher.AES as Raaz+import qualified Raaz.Cipher.Internal as Raaz+import qualified Data.Text.Encoding as E+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.UTF8 as BU8+import Text.Read++type AesKey = Raaz.KEY256++cipher :: Raaz.AES 256 'Raaz.CBC+cipher = Raaz.aes256cbc++encrypt :: Tunables -> KeyEncryptionKey -> SecretKey -> EncryptedSecretKey+encrypt tunables kek (SecretKey secret) = +	EncryptedSecretKey (chunk (objectSize tunables) b) (keyBruteForceCalc kek)+  where+	-- Raaz does not seem to provide a high-level interface+	-- for AES encryption, so use unsafeEncrypt. The use of +	-- EncryptableBytes makes sure it's provided with a +	-- multiple of the AES block size.+	b = Raaz.unsafeEncrypt cipher (keyEncryptionKey kek, keyEncryptionIV kek) $+		getEncryptableBytes $ encodeEncryptableBytes tunables secret++data DecryptResult +	= DecryptSuccess SecretKey+	| DecryptIncomplete KeyEncryptionKey+	-- ^ Returned when the EncryptedSecretKey is truncated.+	| DecryptFailed++instance Show DecryptResult where+	show (DecryptSuccess _) = "DecryptSuccess"+	show (DecryptIncomplete _) = "DecryptIncomplete"+	show DecryptFailed = "DecryptFailed"++decrypt :: KeyEncryptionKey -> EncryptedSecretKey -> DecryptResult+decrypt kek (EncryptedSecretKey cs _) = case decodeEncryptableBytes pbs of+	Nothing -> DecryptFailed+	Just (DecodeSuccess secretkey) -> DecryptSuccess (SecretKey secretkey)+	Just DecodeIncomplete -> DecryptIncomplete kek+  where+	pbs = EncryptableBytes $+		Raaz.unsafeDecrypt cipher (keyEncryptionKey kek, keyEncryptionIV kek) b+	b = B.concat cs++-- | Tries each candidate key in turn until one unlocks the encrypted data.+tryDecrypt :: Candidates KeyEncryptionKey -> EncryptedSecretKey -> DecryptResult+tryDecrypt (Candidates l _ _) esk = go l+  where+	go [] = DecryptFailed+	go (kek:rest) = case decrypt kek esk of+		DecryptFailed -> go rest+		r -> r++-- | An AES key, which is used to encrypt the secret key that is stored+-- in keysafe.+data KeyEncryptionKey = KeyEncryptionKey+	{ keyEncryptionKey :: AesKey+	, keyEncryptionIV :: Raaz.IV+	, keyCreationCost :: Cost CreationOp+	, keyDecryptionCost :: Cost DecryptionOp+	, keyBruteForceCalc :: CostCalc BruteForceOp UnknownPassword+	}++instance HasCreationCost KeyEncryptionKey where+	getCreationCost = keyCreationCost++instance HasDecryptionCost KeyEncryptionKey where+	getDecryptionCost = keyDecryptionCost++instance Bruteforceable KeyEncryptionKey UnknownPassword where+	getBruteCostCalc = keyBruteForceCalc++data Candidates a = Candidates [a] (Cost CreationOp) (Cost DecryptionOp)++instance HasCreationCost (Candidates a) where+	getCreationCost (Candidates _ c _) = c++instance HasDecryptionCost (Candidates a) where+	getDecryptionCost (Candidates _ _ c) = c++-- | The ExpensiveHash of the Password used as the KeyEncryptionKey+--+-- Name is used as a salt, to prevent rainbow table attacks.+--+-- A random prefix is added to the salt, to force an attacker to+-- run the hash repeatedly.+genKeyEncryptionKey :: Tunables -> Name -> Password -> IO KeyEncryptionKey+genKeyEncryptionKey tunables name password = do+	prg <- Raaz.newPRG () :: IO Raaz.SystemPRG+	saltprefix <- genRandomSaltPrefix prg tunables+	return $ head $+		genKeyEncryptionKeys [saltprefix] tunables name password++-- | A stream of KeyEncryptionKeys, using the specified salt prefixes.+genKeyEncryptionKeys :: [SaltPrefix] -> Tunables -> Name -> Password -> [KeyEncryptionKey]+genKeyEncryptionKeys saltprefixes tunables (Name name) (Password password) =+	map mk saltprefixes+  where+	iv = genIV (Name name)+	-- To brute force data encrypted with a key,+	-- an attacker needs to pay the decryptcost for+	-- each password checked.+	bruteforcecalc = bruteForceLinearSearch decryptcost+	decryptcost = castCost $ randomSaltBytesBruteForceCost kektunables+	kektunables = keyEncryptionKeyTunable tunables++	mk saltprefix = KeyEncryptionKey (hashToAESKey hash) iv (getCreationCost hash) decryptcost bruteforcecalc+	  where+		salt = Salt (saltprefix <> name)+		hash = expensiveHash (keyEncryptionKeyHash kektunables) salt password++-- | A stream of all the key encryption keys that need to be tried to +-- decrypt.+candidateKeyEncryptionKeys :: Tunables -> Name -> Password -> Candidates KeyEncryptionKey+candidateKeyEncryptionKeys tunables name password =+	let ks@(k:_) = genKeyEncryptionKeys saltprefixes tunables name password+	in Candidates ks (getCreationCost k) (getDecryptionCost k)+  where+	saltprefixes = allByteStringsOfLength $ +		randomSaltBytes $ keyEncryptionKeyTunable tunables++allByteStringsOfLength :: Int -> [B.ByteString]+allByteStringsOfLength = go []+  where+	go ws n+		| n == 0 = return (B.pack ws)+		| otherwise = do+			w <- [0..255]+			go (w:ws) (n-1)++chunk :: Int -> B.ByteString -> [B.ByteString]+chunk n = go []+  where+	go cs b+		| B.length b <= n = reverse (b:cs)+		| otherwise = +			let (h, t) = B.splitAt n b+			in go (h:cs) t++-- Use the sha256 of the name (truncated) as the IV.+genIV :: Name -> Raaz.IV+genIV (Name name) =+	fromMaybe (error "genIV fromByteString failed") $+		Raaz.fromByteString $ B.take ivlen $+			Raaz.toByteString $ Raaz.sha256 name+  where+	ivlen = fromIntegral $ Raaz.byteSize (undefined :: Raaz.IV)++type SaltPrefix = B.ByteString++genRandomSaltPrefix :: Raaz.SystemPRG -> Tunables -> IO SaltPrefix+genRandomSaltPrefix prg tunables = go [] +	(randomSaltBytes $ keyEncryptionKeyTunable tunables)+  where+	go ws 0 = return (B.pack ws)+	go ws n = do+		b <- Raaz.random prg :: IO Word8+		go (b:ws) (n-1)++instance Raaz.Random Word8++-- | Make an AES key out of a hash value.+--+-- Since the ExpensiveHash value is ascii encoded, and has a common prefix,+-- it does not have a high entropy in every byte, and its length is longer+-- than the AES key length. To deal with this, use the SHA256 of+-- the ExpensiveHash, as a bytestring.+hashToAESKey :: ExpensiveHash -> AesKey+hashToAESKey (ExpensiveHash _ t) = +	fromMaybe (error "hashToAESKey fromByteString failed") $+		Raaz.fromByteString b+  where+	b = B.take (fromIntegral $ Raaz.byteSize (undefined :: AesKey)) $+		Raaz.toByteString $ Raaz.sha256 (E.encodeUtf8 t)++-- | A bytestring that can be AES encrypted.+--+-- It is padded to a multiple of the objectSize with NULs.+-- Since objectSize is a multiple of the AES blocksize, so is this.+--+-- Format is:+--+-- 	sizeNULsizeshaNULdatashaNULdata+--+-- The size gives the length of the data. If the data is shorter+-- than that, we know that the bytestring is truncated.+--+-- The datasha is the sha256 of the data. This is checked when decoding+-- to guard against corruption.+--+-- The sizesha is the sha256 of the size. This is included as a sanity+-- check that the right key was used to decrypt it. It's not unlikely+-- that using the wrong key could result in a bytestring that starts+-- with wrongsizeNUL, but it's astronomically unlikely that the+-- sizesha matches in this case.+newtype EncryptableBytes = EncryptableBytes { getEncryptableBytes :: B.ByteString }+	deriving (Show)++encodeEncryptableBytes :: Tunables -> B.ByteString -> EncryptableBytes+encodeEncryptableBytes tunables content = EncryptableBytes $ +	padBytes (objectSize tunables) $ B.intercalate sep+		[ size+		, sha size+		, sha content+		, content+		]+  where+	size = B8.pack (show (B.length content))+	sep = B.singleton 0++-- | Encoded, so that it does not contain any NULs.+sha :: B.ByteString -> B.ByteString+sha = BU8.fromString . Raaz.showBase16 . Raaz.sha256++padBytes :: Int -> B.ByteString -> B.ByteString+padBytes n b = b <> padding+  where+	len = B.length b+	r = len `rem` n+	padding+		| r == 0 = B.empty+		| otherwise = B.replicate (n - r) 0++data DecodeResult+	= DecodeSuccess B.ByteString+	| DecodeIncomplete+	deriving (Show)++decodeEncryptableBytes :: EncryptableBytes -> Maybe DecodeResult+decodeEncryptableBytes (EncryptableBytes b) = do+	(sizeb, rest) <- getword b+	(sizesha, rest') <- getword rest+	(contentsha, rest'') <- getword rest'+	if sha sizeb /= sizesha+		then Nothing+		else do+			size <- readMaybe (B8.unpack sizeb)+			let content = B.take size rest''+			if B.length content /= size+				then return DecodeIncomplete+				else if sha content /= contentsha+					then Nothing+					else return (DecodeSuccess content)+  where+	getword d = case B.break (== 0) d of+		(w, rest)+			| B.null w || B.null rest-> Nothing+			| otherwise -> Just (w, B.drop 1 rest)
+ Entropy.hs view
@@ -0,0 +1,24 @@+{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Entropy where++import Types+import Types.Cost+import qualified Data.ByteString.UTF8 as B+import Text.Password.Strength (estimate, UserDict)++-- | Calculation of the entropy of a password.+-- Uses zxcvbn so takes word lists, and other entropy weakening problems+-- into account.+passwordEntropy :: Password -> UserDict -> Entropy UnknownPassword+passwordEntropy (Password p) userdict = Entropy $ floor $+	estimate (B.toString p) userdict++-- | Naive calculation of the entropy of a name.+-- Assumes that the attacker is not targeting a particular list of names.+nameEntropy :: Name -> Entropy UnknownName+nameEntropy (Name n) = Entropy $ floor $+	estimate (B.toString n) []
+ ExpensiveHash.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE OverloadedStrings #-}++{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module ExpensiveHash where++import Types+import Tunables+import Cost+import Serialization ()+import qualified Data.Text as T+import qualified Data.ByteString as B+import qualified Crypto.Argon2 as Argon2+import Raaz.Core.Encode+import Data.Time.Clock+import Control.DeepSeq+import Control.Monad+import Data.Monoid++-- | A hash that is expensive to calculate.+--+-- This is a lynchpin of keysafe's security, because using this hash+-- as an encryption key forces brute force attackers to generate+-- hashes over and over again, taking a very long time.+data ExpensiveHash = ExpensiveHash (Cost CreationOp) T.Text+	deriving (Show)++instance HasCreationCost ExpensiveHash where+	getCreationCost (ExpensiveHash c _) = c++data Salt t = Salt t++expensiveHash :: Encodable t => ExpensiveHashTunable -> Salt t -> B.ByteString -> ExpensiveHash+expensiveHash (UseArgon2 cost opts) (Salt s) b = ExpensiveHash cost $+	-- Using hashEncoded here and not hash,+	-- because of this bug:+	-- https://github.com/ocharles/argon2/issues/3+	Argon2.hashEncoded opts b argonsalt+  where+	-- argon salt cannot be shorter than 8 bytes, so pad with spaces.+	argonsalt = +		let sb = toByteString s+		in sb <> B.replicate (8 - B.length sb ) 32++benchmarkExpensiveHash :: Int -> ExpensiveHashTunable -> Cost op -> IO (BenchmarkResult (Cost op))+benchmarkExpensiveHash rounds tunables expected = do+	start <- getCurrentTime+	forM_ [1..rounds] $ \_ -> do+		let ExpensiveHash _ t = expensiveHash tunables+			(Salt (GpgKey (KeyId ("dummy" :: B.ByteString))))+			("himom" :: B.ByteString)+		t `deepseq` return ()+	end <- getCurrentTime+	let diff = floor $ end `diffUTCTime` start+	let actual = CPUCost $ Seconds diff+	return $ BenchmarkResult+		{ expectedBenchmark = expected+		, actualBenchmark = actual+		}++benchmarkTunables :: Tunables -> IO ()+benchmarkTunables tunables = do+	putStrLn "/proc/cpuinfo:"+	putStrLn =<< readFile "/proc/cpuinfo"+	putStrLn "Note that expected times are for 1 core machine."+	putStrLn "If this machine has 2 cores, the actual times should be half the expected times."+	putStrLn "Benchmarking 16 rounds of key generation hash..."+	print =<< benchmarkExpensiveHash 16+		(keyEncryptionKeyHash $ keyEncryptionKeyTunable tunables)+		(mapCost (`div` 16) $ randomSaltBytesBruteForceCost $ keyEncryptionKeyTunable tunables)+	putStrLn "Benchmarking 1 round of name generation hash..."+	print =<< benchmarkExpensiveHash 1+		(nameGenerationHash $ nameGenerationTunable tunables)+		(getexpected $ nameGenerationHash $ nameGenerationTunable tunables)+  where+	getexpected (UseArgon2 cost _) = cost
+ Gpg.hs view
@@ -0,0 +1,71 @@+{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE OverloadedStrings, BangPatterns #-}++module Gpg where++import Types+import UI+import System.Process+import Data.List.Split+import Data.Maybe+import System.IO+import System.Exit+import qualified Data.ByteString as B+import qualified Data.ByteString.UTF8 as BU8++-- | Pick gpg secret key to back up.+--+-- If there is only one gpg secret key,+-- the choice is obvious. Otherwise prompt the user with a list.+getKeyToBackup :: UI -> IO SecretKey+getKeyToBackup ui = go =<< Gpg.listSecretKeys+  where+	go [] = do+		showError ui "You have no gpg secret keys to back up."+		error "Aborting on no gpg secret keys."+	go [(_, kid)] = Gpg.getSecretKey kid+	go l = maybe (error "Canceled") Gpg.getSecretKey+		=<< promptKeyId ui "Pick gpg secret key"+			"Pick gpg secret key to back up:" l++-- | Use when the gpg keyid will not be known at restore time.+anyKey :: SecretKeySource+anyKey = GpgKey (KeyId "")++listSecretKeys :: IO [(Name, KeyId)]+listSecretKeys = mapMaybe parse . lines <$> readProcess "gpg"+	["--batch", "--with-colons", "--list-secret-keys"] ""+  where+	parse l = case splitOn ":" l of+		("sec":_:_:_:kid:_:_:_:_:n:_) -> Just +			(Name (BU8.fromString n), KeyId (BU8.fromString kid))+		_ -> Nothing++getSecretKey :: KeyId -> IO SecretKey+getSecretKey (KeyId kid) = do+	(_, Just hout, _, ph) <- createProcess (proc "gpg" ps)+		{ std_out = CreatePipe }+	secretkey <- SecretKey <$> B.hGetContents hout+	exitcode <- waitForProcess ph+	case exitcode of+		ExitSuccess -> return secretkey+		_ -> error "gpg --export-secret-key failed"+  where+	ps = ["--batch", "--export-secret-key", BU8.toString kid]++writeSecretKey :: SecretKey -> IO ()+writeSecretKey (SecretKey b) = do+	(Just hin, _, _, ph) <- createProcess (proc "gpg" ps)+		{ std_in = CreatePipe }+	B.hPut hin b+	hClose hin+	exitcode <- waitForProcess ph+	case exitcode of+		ExitSuccess -> return ()+		_ -> error "gpg --import failed"+  where+	ps = ["--batch", "--import"]
+ SecretKey.hs view
@@ -0,0 +1,26 @@+{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module SecretKey where++import Types+import qualified Gpg+import qualified Data.ByteString as B+import System.IO+import System.Posix.IO++getSecretKey :: SecretKeySource -> IO SecretKey+getSecretKey (GpgKey kid) = Gpg.getSecretKey kid+getSecretKey (KeyFile f) = SecretKey <$> B.readFile f++-- | Can throw exception if the secret key already exists.+writeSecretKey :: SecretKeySource -> SecretKey -> IO ()+writeSecretKey (GpgKey _) secretkey = Gpg.writeSecretKey secretkey+writeSecretKey (KeyFile f) (SecretKey b) = do+	fd <- openFd f WriteOnly (Just 0o666)+		(defaultFileFlags { exclusive = True } )+	h <- fdToHandle fd+	B.hPut h b+	hClose h
+ Serialization.hs view
@@ -0,0 +1,54 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE OverloadedStrings #-}++{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Serialization where++import Types+import Raaz.Core.Encode+import qualified Data.ByteString as B+import qualified Data.ByteString.UTF8 as BU8+import Data.Monoid+import Data.Word++-- | A SecretKeySource is serialized in the form "keytype value".+-- For example "gpg C910D9222512E3C7", or "file path".+instance Encodable SecretKeySource where+	toByteString (GpgKey (KeyId b)) =+		"gpg" <> B.singleton sepChar <> b+	toByteString (KeyFile f) =+		"file" <> B.singleton sepChar <> BU8.fromString f+	fromByteString b = case B.break (== sepChar) b of+		(t, rest)+			| B.null rest -> Nothing+			| otherwise -> +				let i = B.drop 1 rest+				in case t of+					"gpg" -> Just $ GpgKey (KeyId i)+					"file" -> Just $ KeyFile (BU8.toString i)+					_ -> Nothing++instance Encodable Name where+	toByteString (Name n) = n+	fromByteString = Just . Name++instance Encodable StorableObjectIdent where+	toByteString (StorableObjectIdent i) = i+	fromByteString = Just . StorableObjectIdent++instance Encodable StorableObject where+	 toByteString (StorableObject b) = b+	 fromByteString = Just . StorableObject++-- | A share is serialized without its share number. This prevents+-- an attacker from partitioning their shares by share number.+instance Encodable Share where+	toByteString (Share _n o) = toByteString o+	fromByteString _ = Nothing++sepChar :: Word8+sepChar = 32
+ Setup.hs view
@@ -0,0 +1,30 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}++import Distribution.Simple+import Distribution.Simple.LocalBuildInfo+import Distribution.Simple.Setup+import Distribution.Simple.Utils (installOrdinaryFiles, rawSystemExit)+import Distribution.PackageDescription (PackageDescription(..))+import Distribution.Verbosity (Verbosity)+import System.Info+import System.FilePath++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+	{ postCopy = myPostCopy+	}++myPostCopy :: Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO ()+myPostCopy _ flags pkg lbi = if System.Info.os /= "mingw32"+	then installManpages dest verbosity pkg lbi+	else return ()+  where+	dest = fromFlag $ copyDest flags+	verbosity = fromFlag $ copyVerbosity flags++{- See http://www.haskell.org/haskellwiki/Cabal/Developer-FAQ#Installing_manpages -}+installManpages :: CopyDest -> Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+installManpages copyDest verbosity pkg lbi =+	installOrdinaryFiles verbosity dstManDir [(".", "keysafe.1")]+  where+	dstManDir   = mandir (absoluteInstallDirs pkg lbi copyDest) </> "man1"
+ Share.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses #-}++{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Share where++import Types+import Tunables+import ExpensiveHash+import Cost+import qualified Crypto.SecretSharing.Internal as SS+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Raaz.Core.Encode as Raaz+import qualified Raaz.Hash.Sha256 as Raaz+import qualified Data.Text as T+import qualified Data.Text.Encoding as E+import qualified Data.Set as S+import Data.Monoid++data ShareIdents = ShareIdents+	{ identsStream :: [S.Set StorableObjectIdent]+	-- ^ Each item in the infinite list is the idents to+	-- use for the shares of a chunk of data.+	, identsCreationCost :: Cost CreationOp+	, identsBruteForceCalc :: CostCalc BruteForceOp UnknownName+	}++nextShareIdents :: ShareIdents -> (S.Set StorableObjectIdent, ShareIdents)+nextShareIdents sis = +	let (s:rest) = identsStream sis+	in (s, sis { identsStream = rest })++instance HasCreationCost ShareIdents where+	getCreationCost = identsCreationCost++instance Bruteforceable ShareIdents UnknownName where+	getBruteCostCalc = identsBruteForceCalc++-- | Generates identifiers to use for storing shares.+--+-- This is an expensive operation, to make it difficult for an attacker+-- to brute force known/guessed names and find matching shares.+-- The keyid or filename is used as a salt, to avoid collisions+-- when the same name is chosen for multiple keys.+shareIdents :: Tunables -> Name -> SecretKeySource -> ShareIdents+shareIdents tunables (Name name) keyid =+	ShareIdents (segmentbyshare idents) creationcost bruteforcecalc+  where+	(ExpensiveHash creationcost basename) =+		expensiveHash hashtunables (Salt keyid) name+	mk n = StorableObjectIdent $ Raaz.toByteString $ mksha $+		E.encodeUtf8 $ basename <> T.pack (show n)+	mksha :: B.ByteString -> Raaz.Base16+	mksha = Raaz.encode . Raaz.sha256+	bruteforcecalc = bruteForceLinearSearch creationcost+	hashtunables = nameGenerationHash $ nameGenerationTunable tunables+	idents = map mk ([1..] :: [Integer])+	m = totalObjects (shareParams tunables)+	segmentbyshare l = +		let (shareis, l') = splitAt m l+		in S.fromList shareis : segmentbyshare l'++-- | Generates shares of an EncryptedSecretKey.+-- Each chunk of the key creates its own set of shares.+genShares :: EncryptedSecretKey -> Tunables -> IO [S.Set Share]+genShares (EncryptedSecretKey cs _) tunables = do +	shares <- mapM encode cs+	return $ map (S.fromList . map (uncurry Share) . zip [1..]) shares+  where+	encode :: B.ByteString -> IO [StorableObject]+	encode b = map (StorableObject . encodeShare) +		<$> SS.encode+			(neededObjects $ shareParams tunables)+			(totalObjects $ shareParams tunables)+			(BL.fromStrict b)++-- | If not enough sets of shares are provided, the EncryptedSecretKey may+-- be incomplete, only containing some chunks of the key+combineShares :: Tunables -> [S.Set Share] -> Either String EncryptedSecretKey+combineShares tunables shares+	| null shares || any null shares || any (\l -> length l < sharesneeded) shares = +		Left "Not enough shares are currently available to reconstruct your data."+	| otherwise = Right $ mk $+		map (BL.toStrict . SS.decode . map decodeshare . S.toList) shares+  where+	mk cs = EncryptedSecretKey cs unknownCostCalc+	decodeshare (Share sharenum so) = decodeShare sharenum sharesneeded $+		fromStorableObject so+	sharesneeded = neededObjects (shareParams tunables)++-- | This efficient encoding relies on the share using a finite field of+-- size 256, so it maps directly to bytes.+--+-- Note that this does not include the share number in the encoded+-- bytestring. This prevents an attacker from partitioning their shares+-- by share number.+encodeShare :: SS.Share -> B.ByteString+encodeShare = B.pack . map (fromIntegral . SS.shareValue) . SS.theShare++decodeShare :: Int -> Int -> B.ByteString -> SS.Share+decodeShare sharenum sharesneeded = SS.Share . map mk . B.unpack+  where+	mk w = SS.ByteShare+		{ SS.shareId = sharenum+		, SS.reconstructionThreshold = sharesneeded+		, SS.shareValue = fromIntegral w+		}
+ Storage.hs view
@@ -0,0 +1,105 @@+{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Storage (module Storage, module Types.Storage) where++import Types+import Types.Storage+import Share+import Storage.Local+import Storage.Network+import Data.Monoid+import Data.Maybe+import System.FilePath+import Control.Monad+import qualified Data.Set as S++allStorageLocations :: IO StorageLocations+allStorageLocations = do+	servers <- networkServers+	return $ StorageLocations $+		map networkStorage servers <> map uploadQueue servers++localStorageLocations :: StorageLocations+localStorageLocations = StorageLocations $+	map (localStorage . ("local" </>) . show)+		[1..100 :: Int]++type UpdateProgress = IO ()++-- | Stores the shares amoung the storage locations. Each location+-- gets at most one share from each set.+--+-- TODO: Add shuffling and queueing/chaffing to prevent+-- correlation of related shares.+storeShares :: StorageLocations -> ShareIdents -> [S.Set Share] -> UpdateProgress -> IO StoreResult+storeShares (StorageLocations locs) allsis shares updateprogress = do+	(r, usedlocs) <- go allsis shares []+	_ <- mapM_ obscureShares usedlocs+	return r+  where+	go sis (s:rest) usedlocs = do+		let (is, sis') = nextShareIdents sis+		(r, usedlocs') <- storeset locs [] Nothing (zip (S.toList is) (S.toList s))+		case r of+			StoreSuccess -> go sis' rest (usedlocs ++ usedlocs')+			_ -> return (r, usedlocs ++ usedlocs')+	go _ [] usedlocs = return (StoreSuccess, usedlocs)++	storeset _ usedlocs _ [] = return (StoreSuccess, usedlocs)+	storeset [] usedlocs lasterr _ =+		return (fromMaybe (StoreFailure "no storage locations") lasterr, usedlocs)+	storeset (loc:otherlocs) usedlocs _ ((i, s):rest) = do+		r <- storeShare loc i s+		case r of+			StoreSuccess -> do+				_ <- updateprogress+				storeset otherlocs (loc:usedlocs) Nothing rest+			-- Give up if any location complains a share+			-- already exists, because we have a name conflict.+			StoreAlreadyExists -> return (StoreAlreadyExists, usedlocs)+			-- Try storing it somewhere else on failure.+			StoreFailure _ ->+				storeset otherlocs usedlocs (Just r) ((i, s):rest)++-- | Retrieves one set of shares from the storage locations.+-- Returns all the shares it can find, which may not be enough,+-- and the remaining Shareidents, to use to get subsequent sets.+--+-- Assumes that each location only contains one share. So, once a+-- share has been found on a location, can avoid asking that location+-- for any other shares.+retrieveShares :: StorageLocations -> ShareIdents -> UpdateProgress -> IO (S.Set Share, ShareIdents)+retrieveShares (StorageLocations locs) sis updateprogress = do+	let (is, sis') = nextShareIdents sis+	let want = zip [1..] (S.toList is)+	(shares, usedlocs, _unusedlocs) <- go locs [] want []+	_ <- mapM_ obscureShares usedlocs+	return (S.fromList shares, sis')+  where+	go unusedlocs usedlocs [] shares = return (shares, usedlocs, unusedlocs)+	go [] usedlocs _ shares = return (shares, usedlocs, [])+	go (loc:otherlocs) usedlocs ((n, i):rest) shares = do+		r <- retrieveShare loc n i+		case r of+			RetrieveSuccess s -> do+				_ <- updateprogress+				go otherlocs (loc:usedlocs) rest (s:shares)+			RetrieveFailure _ -> do+				-- Try to get the share from other locations.+				(shares', usedlocs', unusedlocs) <-+					go otherlocs usedlocs [(n, i)] shares+				-- May need to ask the location that didn't+				-- have the share for a later share, but+				-- ask it last. This way, the first+				-- location on the list can't deny having+				-- all shares and so learn the idents of+				-- all of them.+				go (unusedlocs++[loc]) usedlocs' rest shares'++uploadQueued :: IO ()+uploadQueued = do+	servers <- networkServers+	forM_ servers $ \s -> moveShares (uploadQueue s) (networkStorage s)
+ Storage/Local.hs view
@@ -0,0 +1,138 @@+{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Storage.Local (localStorage, uploadQueue) where++import Types+import Types.Storage+import Storage.Network (Server(..))+import Serialization ()+import qualified Data.ByteString as B+import qualified Data.ByteString.UTF8 as U8+import Data.Monoid+import Data.List+import System.Posix.User+import System.IO+import System.Directory+import System.Posix+import System.FilePath+import Raaz.Core.Encode+import Control.DeepSeq+import Control.Exception+import Control.Monad++newtype Section = Section String++localStorage :: String -> Storage+localStorage n = Storage+	{ storeShare = store section+	, retrieveShare = retrieve section+	, obscureShares = obscure section+	, countShares = count section+	, moveShares = move section+	}+  where+	section = Section n++uploadQueue :: Server -> Storage+uploadQueue s = localStorage ("uploadqueue" </> serverName s)++store :: Section -> StorableObjectIdent -> Share -> IO StoreResult+store section i s = onError (StoreFailure . show) $ do+	dir <- shareDir section+	createDirectoryIfMissing True dir+	let dest = dir </> shareFile i+	exists <- doesFileExist dest+	if exists+		then return StoreAlreadyExists+		else do+			let tmp = dest ++ ".tmp"+			fd <- openFd tmp WriteOnly (Just 0o400)+				(defaultFileFlags { exclusive = True } )+			h <- fdToHandle fd+			B.hPut h (toByteString s)+			hClose h+			renameFile tmp dest+			return StoreSuccess++retrieve :: Section -> ShareNum -> StorableObjectIdent -> IO RetrieveResult+retrieve section n i = onError (RetrieveFailure . show) $ do+	dir <- shareDir section+	fd <- openFd (dir </> shareFile i) ReadOnly Nothing defaultFileFlags+	h <- fdToHandle fd+	b <- B.hGetContents h+	b `deepseq` hClose h+	return $ RetrieveSuccess $ Share n (StorableObject b)++-- | Set atime and mtime to epoch, to obscure access and modification+-- patterns.+--+-- There is no way to set the ctime to the epoch, but setting the other+-- times does at least set it to the current time, which makes all+-- currently stored files look alike.+--+-- Note that the contents of shares is never changed, so it's ok to set the+-- mtime to the epoch; backup programs won't be confused.+obscure :: Section -> IO ObscureResult+obscure section = onError (ObscureFailure . show) $ do+	dir <- shareDir section+	fs <- filter isShareFile <$> getDirectoryContents dir+	mapM_ (\f -> setFileTimes (dir </> f) 0 0) fs+	return ObscureSuccess++count :: Section -> IO CountResult+count section = onError (CountFailure . show) $ do+	dir <- shareDir section+	CountResult . genericLength . filter isShareFile+		<$> getDirectoryContents dir++move :: Section -> Storage -> IO ()+move section storage = do+	dir <- shareDir section+	fs <- getDirectoryContents dir+	forM_ fs $ \f -> case fromShareFile f of+		Nothing -> return ()+		Just i -> do+			-- Use a dummy share number of 0; it doesn't+			-- matter because we're not going to be+			-- recombining the share, just sending its contents+			-- on the the server.+			r <- retrieve section 0 i+			case r of+				RetrieveFailure _ -> return ()+				RetrieveSuccess share -> do+					s <- storeShare storage i share+					case s of+						StoreFailure _ -> return ()+						_ -> removeFile f++onError :: (IOException -> a) -> IO a -> IO a+onError f a = do+	v <- try a+	return $ case v of+		Left e -> f e+		Right r -> r++shareDir :: Section -> IO FilePath+shareDir (Section section) = do+	u <- getUserEntryForID =<< getEffectiveUserID+	return $ homeDirectory u </> dotdir </> section++shareFile :: StorableObjectIdent -> FilePath+shareFile i = U8.toString (toByteString i) <> ext++fromShareFile :: FilePath -> Maybe StorableObjectIdent+fromShareFile f+	| isShareFile f = fromByteString $ U8.fromString $ dropExtension f+	| otherwise = Nothing++isShareFile :: FilePath -> Bool+isShareFile f = ext `isSuffixOf` f++ext :: String+ext = ".keysafe"++dotdir :: FilePath+dotdir = ".keysafe" </> "objects"
+ Storage/Network.hs view
@@ -0,0 +1,43 @@+{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE OverloadedStrings #-}++module Storage.Network (Server(..), networkServers, networkStorage) where++import Types+import Types.Storage++newtype Server = Server { serverName :: String }++networkServers :: IO [Server]+networkServers = return [] -- none yet++networkStorage :: Server -> Storage+networkStorage server = Storage+	{ storeShare = store server+	, retrieveShare = retrieve server+	, obscureShares = obscure server+	, countShares = count server+	, moveShares = move server+	}++store :: Server -> StorableObjectIdent -> Share -> IO StoreResult+store _server _i _s = return $ StoreFailure "network storage not implemented yet"++retrieve :: Server -> ShareNum -> StorableObjectIdent -> IO RetrieveResult+retrieve _server _n _i = return $ RetrieveFailure "network storage not implemented yet"++-- | Servers should automatically obscure, so do nothing.+-- (Could upload chaff.)+obscure :: Server -> IO ObscureResult+obscure _ = return ObscureSuccess++count :: Server -> IO CountResult+count _server = return $ CountFailure "network storage not implemented yet"++-- | Not needed for servers.+move :: Server -> Storage -> IO ()+move _ _ = return ()
+ TODO view
@@ -0,0 +1,11 @@+* test suite (eg, test basic storage and restore of various size data)+* tune hashes on more powerful hardware than thermal throttling laptop+* store to servers+* Run --uploadqueued periodically (systemd timer?)+* improve restore progress bar points (update after every hash try)+* Keep secret keys in locked memory until they're encrypted.+  (Raaz makes this possible to do.)+  Would be nice, but not super-important, since gpg secret keys+  are passphrase protected anyway..+* If we retrieved enough shares successfully, but decrypt failed, must+  be a wrong password, so prompt for re-entry and retry with those shares.
+ Tunables.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}++{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Tunables where++import Cost+import qualified Crypto.Argon2 as Argon2++-- | To determine the tunables used for a key name the expensive hash of the+-- name is calculated, using a particular configuration, and if the+-- object names it generates are available, we know the tunables.+--+-- Since this process is expensive, it's important that the most commonly+-- used tunables come first, so that the expensive hash does not have to be+-- calculated repatedly.+--+-- The reason for using this expensive method of encoding the tunables+-- is that it prevents attacks where related objects are correlated based+-- on their tunables.+knownTunings :: [(ExpensiveHashTunable, Tunables)]+knownTunings = map (\t -> (nameGenerationHash (nameGenerationTunable t), t))+	[ defaultTunables+	]++-- | keysafe stores data for a long time, and needs to be able to process+-- data from a long time ago when restoring a key. We don't want to be +-- locked into old choices of crypto primitives etc forever. +--+-- So, every parameter that can be tuned is configured in this data+-- structure.+data Tunables = Tunables+	{ shareParams :: ShareParams+	, objectSize :: Int+	-- ^ a StorableObject is exactly this many bytes in size+	-- (must be a multiple of AES block size 16, and cannot be smaller+	-- than 256 bytes)+	, nameGenerationTunable :: NameGenerationTunable+	, keyEncryptionKeyTunable :: KeyEncryptionKeyTunable+	, encryptionTunable :: EncryptionTunable+	}+	deriving (Show)++-- | Parameters for shareing. The secret is split into+-- N objects, such that only M are needed to reconstruct it.+data ShareParams = ShareParams+	{ totalObjects :: Int -- ^ N+	, neededObjects :: Int -- ^ M+	}+	deriving (Show)++-- | An expensive hash, which makes brute-forcing hard.+--+-- The creation cost estimate must be manually tuned to match the+-- hash options. Use benchmarkTunables to check this.+data ExpensiveHashTunable = UseArgon2 (Cost CreationOp) Argon2.HashOptions+	deriving (Show)++data NameGenerationTunable = NameGenerationTunable+	{ nameGenerationHash :: ExpensiveHashTunable+	}+	deriving (Show)++-- | How to generate the encryption key used to encrypt the secret key.+-- This is an expensive hash of the password, but not a super expensive+-- hash, because a password brute forcing attacker needs to run the hash+-- 256 times per random salt byte.+data KeyEncryptionKeyTunable = KeyEncryptionKeyTunable+	{ keyEncryptionKeyHash :: ExpensiveHashTunable+	, randomSaltBytes :: Int+	, randomSaltBytesBruteForceCost :: Cost BruteForceOp+	}+	deriving (Show)++-- | What encryption to use.+data EncryptionTunable = UseAES256+	deriving (Show)++defaultTunables :: Tunables+defaultTunables = Tunables+	{ shareParams = ShareParams { totalObjects = 3, neededObjects = 2 }+	, objectSize = 1024*64 -- 64 kb+	-- The nameGenerationHash was benchmarked at 661 seconds CPU time+	-- on a 2 core Intel(R) Core(TM) i5-4210Y CPU @ 1.50GHz.+	-- Since cost is measured per core, we double that.+	, nameGenerationTunable = NameGenerationTunable+		{ nameGenerationHash = argon2 10000 (CPUCost (Seconds (2*600)))+		}+	, keyEncryptionKeyTunable = KeyEncryptionKeyTunable+		{ keyEncryptionKeyHash = argon2 115 (CPUCost (Seconds 0))+		, randomSaltBytes = 1+		-- The keyEncryptionKeyHash is run 256 times per +		-- random salt byte to brute-force, and its parameters+		-- were chosen so the total brute forcing time is 50 minutes,+		-- on a 2 core Intel(R) Core(TM) i5-4210Y CPU @ 1.50GHz.+		-- Since cost is measured per core, we double that.+		, randomSaltBytesBruteForceCost = CPUCost (Seconds (2*50*60))+		}+	, encryptionTunable = UseAES256+	}+  where+	argon2 i c = UseArgon2 c $ Argon2.HashOptions+		{ Argon2.hashIterations = i+		, Argon2.hashMemory = 131072 -- 128 mebibtyes per thread+		, Argon2.hashParallelism = 4 -- 4 threads+		, Argon2.hashVariant = Argon2.Argon2i+		}++-- | Dials back hash difficulty, lies about costs.+-- Not for production use!+testModeTunables :: Tunables+testModeTunables = Tunables+	{ shareParams = ShareParams { totalObjects = 3, neededObjects = 2 }+	, objectSize = 1024*64+	, nameGenerationTunable = NameGenerationTunable+		{ nameGenerationHash = weakargon2 (CPUCost (Seconds (2*600)))+		}+	, keyEncryptionKeyTunable = KeyEncryptionKeyTunable+		{ keyEncryptionKeyHash = weakargon2 (CPUCost (Seconds 0))+		, randomSaltBytes = 1+		, randomSaltBytesBruteForceCost = CPUCost (Seconds (2*50*60))+		}+	, encryptionTunable = UseAES256+	}+  where+	weakargon2 c = UseArgon2 c Argon2.defaultHashOptions
+ Types.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances #-}++{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Types where++import Types.Cost+import qualified Data.ByteString as B+import Data.String+import Control.DeepSeq++-- | keysafe stores secret keys.+newtype SecretKey = SecretKey B.ByteString++-- | The secret key, encrypted with a password, in fixed size chunks.+data EncryptedSecretKey = EncryptedSecretKey [B.ByteString] (CostCalc BruteForceOp UnknownPassword)++instance NFData EncryptedSecretKey where+	rnf (EncryptedSecretKey cs _) = rnf cs++instance Show EncryptedSecretKey where+	show (EncryptedSecretKey cs _) = show cs++instance Bruteforceable EncryptedSecretKey UnknownPassword where+	getBruteCostCalc (EncryptedSecretKey _ cc) = cc++-- | An object in a form suitable to be stored on a keysafe server.+newtype StorableObject = StorableObject { fromStorableObject :: B.ByteString }+	deriving (Show, Eq, Ord)++-- | An identifier for a StorableObject+newtype StorableObjectIdent = StorableObjectIdent B.ByteString+	deriving (Show, Eq, Ord, NFData)++-- | A Shamir secret share, with a known number (N of M).+data Share = Share ShareNum StorableObject+	deriving (Eq, Ord)++type ShareNum = Int++-- | A password used to encrypt a key stored in keysafe.+newtype Password = Password B.ByteString+	deriving (IsString)++-- | A name associated with a key stored in keysafe.+newtype Name = Name B.ByteString+	deriving (Show, Monoid)++-- | Source of the secret key stored in keysafe.+data SecretKeySource = GpgKey KeyId | KeyFile FilePath+	deriving (Show)++-- | The keyid is any value that is unique to a private key, and can be+-- looked up somehow without knowing the private key.+--+-- A gpg keyid is the obvious example.+data KeyId = KeyId B.ByteString+	deriving (Show)++data BenchmarkResult t = BenchmarkResult { expectedBenchmark :: t, actualBenchmark :: t }+	deriving (Show)
+ Types/Cost.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, EmptyDataDecls #-}++{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Types.Cost where++-- | An estimated cost to perform an operation.+data Cost op +	= CPUCost Seconds -- ^ using 1 CPU core+	deriving (Show, Eq, Ord)++unknownCost :: Cost op+unknownCost = CPUCost (Seconds 0)++newtype Seconds = Seconds Integer+	deriving (Num, Eq, Ord, Show)++data UsingHardware = UsingCPU | UsingGPU | UsingASIC+	deriving (Show)++instance Monoid (Cost t) where+	mempty = CPUCost (Seconds 0)+	CPUCost (Seconds a) `mappend` CPUCost (Seconds b) =+		CPUCost (Seconds (a+b))++mapCost :: (Integer -> Integer) -> Cost op -> Cost op+mapCost f (CPUCost (Seconds n)) = CPUCost (Seconds (f n))++showCostMinutes :: Cost op -> String+showCostMinutes (CPUCost (Seconds n))+	| n < 61 = "1 minute"+	| otherwise = show (n `div` 60) ++ " minutes"++-- | Operations whose cost can be measured.+data DecryptionOp+data CreationOp+data BruteForceOp++-- | Things that track their creation cost.+class HasCreationCost t where+	getCreationCost :: t -> Cost CreationOp++-- | Things that track their decryption cost.+class HasDecryptionCost t where+	getDecryptionCost :: t -> Cost DecryptionOp++-- | Calculation of a cost that depends on some amount of entropy.+type CostCalc op t = Entropy t -> Cost op++unknownCostCalc :: CostCalc op t+unknownCostCalc = \_e -> error "No cost calculation available"++-- | Number of bits of entropy+newtype Entropy t = Entropy Int+	deriving (Num, Show)++class CalcEntropy d t where+	calcEntropy :: d -> Entropy t++-- | Entropy can never go negative when subtracting bits from it.+reduceEntropy :: Entropy t -> Int -> Entropy t+reduceEntropy (Entropy a) b = Entropy (max 0 (a - b))++-- | Things that can be brute-forced track their CostCalc.+class Bruteforceable t a where+	getBruteCostCalc :: t -> CostCalc BruteForceOp a++-- | Things that can have entropy+data UnknownPassword+data UnknownName
+ Types/Storage.hs view
@@ -0,0 +1,42 @@+{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Types.Storage where++import Types++-- | All known locations where shares can be stored, ordered with+-- preferred locations first.+newtype StorageLocations = StorageLocations [Storage]+	deriving (Monoid)++-- | Storage interface. This can be used both for local storage,+-- an upload queue, or a remote server.+--+-- Note that there is no interface to enumerate shares.+-- This is intentional; servers should not allow that.+data Storage = Storage+	{ storeShare :: StorableObjectIdent -> Share -> IO StoreResult+	, retrieveShare :: ShareNum -> StorableObjectIdent -> IO RetrieveResult+	, obscureShares :: IO ObscureResult+	-- ^ Run after making some calls to storeShare/retrieveShare,+	-- to avoid correlation attacks.+	, countShares :: IO CountResult+	, moveShares :: Storage -> IO ()+	-- ^ Tries to move all shares from this storage to another one.+	}++data StoreResult = StoreSuccess | StoreAlreadyExists | StoreFailure String+	deriving (Show)++data RetrieveResult = RetrieveSuccess Share | RetrieveFailure String++data ObscureResult = ObscureSuccess | ObscureFailure String+	deriving (Show)++data CountResult = CountResult Integer | CountFailure String+	deriving (Show)
+ Types/UI.hs view
@@ -0,0 +1,27 @@+{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE RankNTypes #-}++module Types.UI where++import Types++data UI = UI+	{ isAvailable :: IO Bool+	, showError :: Desc -> IO ()+	, showInfo :: Title -> Desc -> IO ()+	, promptQuestion :: Title -> Desc -> Question -> IO Bool+	, promptName :: Title -> Desc -> Maybe Name -> (Name -> Maybe Problem) -> IO (Maybe Name)+	, promptPassword :: Bool -> Title -> Desc -> IO (Maybe Password)+	, promptKeyId :: Title -> Desc -> [(Name, KeyId)] -> IO (Maybe KeyId)+	, withProgress :: forall a. Title -> Desc -> ((Percent -> IO ()) -> IO a) -> IO a+	}++type Title = String+type Desc = String+type Percent = Int+type Problem = String+type Question = String
+ UI.hs view
@@ -0,0 +1,44 @@+{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE BangPatterns #-}++module UI (module UI, module Types.UI) where++import Types.UI+import Control.Monad+import UI.Zenity+import UI.Readline+import Control.Concurrent.MVar++availableUIs :: IO [UI]+availableUIs = filterM isAvailable [readlineUI, zenityUI]++selectUI :: Bool -> IO UI+selectUI needgui+	| needgui = do+		ok <- isAvailable zenityUI+		if ok+			then return zenityUI+			else error "zenitty is not installed, GUI not available"+	| otherwise = do+		l <- availableUIs+		case l of+			(u:_) -> return u+			[] -> error "Neither zenity nor the readline UI are available"++-- Adds a percent to whatever amount the progress bar is at.+type AddPercent = Percent -> IO ()++withProgressIncremental :: UI -> Title -> Desc -> (AddPercent -> IO a) -> IO a+withProgressIncremental ui title desc a = +	withProgress ui title desc $ \setpercent -> do+		v <- newMVar 0+		let addpercent = \p -> do+			oldp <- takeMVar v+			let !newp = oldp + p+			putMVar v newp+			setpercent newp+		a addpercent
+ UI/Readline.hs view
@@ -0,0 +1,167 @@+{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module UI.Readline (readlineUI) where++import Types.UI+import Types+import System.Console.Readline+import System.Posix.Terminal+import System.Posix.IO+import Control.Exception+import System.IO+import Data.List+import Data.Char+import Text.Read+import Control.Monad+import qualified Data.ByteString.UTF8 as BU8++readlineUI :: UI+readlineUI = UI+	{ isAvailable = queryTerminal stdInput+	, showError = myShowError+	, showInfo = myShowInfo+	, promptQuestion = myPromptQuestion+	, promptName = myPromptName+	, promptPassword = myPromptPassword+	, promptKeyId = myPromptKeyId+	, withProgress = myWithProgress+	}++myShowError :: Desc -> IO ()+myShowError desc = do+	hPutStrLn stderr $ "Error: " ++ desc+	_ <- readline "[Press Enter]"+	putStrLn ""++myShowInfo :: Title -> Desc -> IO ()+myShowInfo title desc = do+	showTitle title+	putStrLn desc+	putStrLn ""++myPromptQuestion :: Title -> Desc -> Question -> IO Bool+myPromptQuestion title desc question = bracket_ setup cleanup go+  where+	setup = do+		showTitle title+		putStrLn desc+	cleanup = putStrLn ""+	go = do+		mresp <- readline $ question ++ " [y/n] "+		case mresp of+			Just s+				| "y" `isPrefixOf` (map toLower s) ->+					return True+				| "n" `isPrefixOf` (map toLower s) -> +					return False+			_ -> do+				putStrLn "Please enter 'y' or 'n'"+				go++myPromptName :: Title -> Desc -> Maybe Name -> (Name -> Maybe Problem) -> IO (Maybe Name)+myPromptName title desc suggested checkproblem =+	bracket_ setup cleanup go+  where+	setup = do+		showTitle title+		putStrLn desc+	cleanup = putStrLn ""+	go = do+		case suggested of+			Nothing -> return ()+			Just (Name b) -> addHistory (BU8.toString b)+		mname <- readline "Name> "+		case mname of+			Just s -> do+				addHistory s+				let n = Name $ BU8.fromString s+				case checkproblem n of+					Nothing -> do+						putStrLn ""+						return $ Just n+					Just problem -> do+						putStrLn problem+						go+			Nothing -> return Nothing++myPromptPassword :: Bool -> Title -> Desc -> IO (Maybe Password)+myPromptPassword confirm title desc = bracket setup cleanup (const prompt)+  where+	setup = do+		showTitle title+		putStrLn desc+		origattr <- getTerminalAttributes stdInput+		let newattr = origattr `withoutMode` EnableEcho+		setTerminalAttributes stdInput newattr Immediately+		return origattr+	cleanup origattr = do+		setTerminalAttributes stdInput origattr Immediately+		putStrLn ""+	prompt = do+		putStr "Enter password> "+		hFlush stdout+		p1 <- getLine+		putStrLn ""+		if confirm+			then promptconfirm p1+			else return $ mkpassword p1+	promptconfirm p1 = do+		putStr "Confirm password> "+		hFlush stdout+		p2 <- getLine+		putStrLn ""+		if p1 /= p2+			then do+				putStrLn "Passwords didn't match, try again..."+				prompt+			else do+				putStrLn ""+				return $ mkpassword p1+	mkpassword = Just . Password . BU8.fromString++myPromptKeyId :: Title -> Desc -> [(Name, KeyId)] -> IO (Maybe KeyId)+myPromptKeyId _ _ [] = return Nothing+myPromptKeyId title desc l = do+	showTitle title+	putStrLn desc+	putStrLn ""+	forM_ nl $ \(n, ((Name name), (KeyId kid))) ->+		putStrLn $ show n ++ ".\t" ++ BU8.toString name ++ " (keyid " ++ BU8.toString kid ++ ")"+	prompt+  where+	nl = zip [1 :: Integer ..] l+	prompt = do+		putStr "Enter number> "+		hFlush stdout+		r <- getLine+		putStrLn ""+		case readMaybe r of+			Just n+				| n > 0 && n <= length l -> do+					putStrLn ""+					return $ Just $ snd (l !! pred n)+			_ -> do+				putStrLn $ "Enter a number from 1 to " ++ show (length l)+				prompt++myWithProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO a) -> IO a+myWithProgress title desc a = bracket_ setup cleanup (a sendpercent)+  where+	setup = do+		showTitle title+		putStrLn desc+	sendpercent p = do+		putStr (show p ++ "%  ")+		hFlush stdout+	cleanup = do+		putStrLn "done"+		putStrLn ""++showTitle :: Title -> IO ()+showTitle title = do+	putStrLn title+	putStrLn (replicate (length title) '-')+	putStrLn ""
+ UI/Zenity.hs view
@@ -0,0 +1,171 @@+{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module UI.Zenity (zenityUI) where++import Types+import Types.UI+import Control.Monad+import System.Process+import Control.Exception+import System.IO+import System.FilePath+import System.Directory+import System.Exit+import qualified Data.ByteString.UTF8 as BU8++zenityUI :: UI+zenityUI = UI+	{ isAvailable = do+		ps <- getSearchPath+		loc <- filterM (\p -> doesFileExist (p </> "zenity")) ps+		return (not (null loc))+	, showError = myShowError+	, showInfo = myShowInfo+	, promptQuestion = myPromptQuestion+	, promptName = myPromptName+	, promptPassword = myPromptPassword+	, promptKeyId = myPromptKeyId+	, withProgress = myWithProgress+	}++myShowError :: Desc -> IO ()+myShowError desc = bracket go cleanup (\_ -> return ())+  where+	go = runZenity+		[ "--error"+		, "--title", "keysafe"+		, "--text", "Error: " ++ desc+		]+	cleanup h = do+		_ <- waitZenity h+		return ()++myShowInfo :: Title -> Desc -> IO ()+myShowInfo title desc = bracket go cleanup (\_ -> return ())+  where+	go = runZenity+		[ "--info"+		, "--title", title+		, "--text", desc+		]+	cleanup h = do+		_ <- waitZenity h+		return ()++myPromptQuestion :: Title -> Desc -> Question -> IO Bool+myPromptQuestion title desc question = do+	h <- runZenity+		[ "--question"+		, "--title", title+		, "--text",  desc ++ "\n" ++ question+		]+	(_, ok) <- waitZenity h+	return ok++myPromptName :: Title -> Desc -> Maybe Name -> (Name -> Maybe Problem) -> IO (Maybe Name)+myPromptName title desc suggested checkproblem = go ""+  where+	go extradesc = do+		h <- runZenity+			[ "--entry"+			, "--title", title+			, "--text", desc ++ "\n" ++ extradesc+			, "--entry-text", case suggested of+				Nothing -> ""+				Just (Name b) -> BU8.toString b+			]+		(ret, ok) <- waitZenity h+		if ok+			then +				let n = Name $ BU8.fromString ret+				in case checkproblem n of+					Nothing -> return $ Just n+					Just problem -> go problem+			else return Nothing++myPromptPassword :: Bool -> Title -> Desc -> IO (Maybe Password)+myPromptPassword confirm title desc = go ""+  where+	go extradesc = do+		h <- runZenity $+			[ "--forms"+			, "--title", title+			, "--text", desc ++ "\n" ++ extradesc ++ "\n"+			, "--separator", "\BEL"+			, "--add-password", "Enter password"+			] ++ if confirm+				then [ "--add-password", "Confirm password" ]+				else []+		(ret, ok) <- waitZenity h+		if ok+			then if confirm+				then +					let (p1, _:p2) = break (== '\BEL') ret+						in if p1 /= p2+						then go "Passwords didn't match, try again..."+						else return $ Just $ Password $ BU8.fromString p1+				else return $ Just $ Password $ BU8.fromString ret+			else return Nothing++myPromptKeyId :: Title -> Desc -> [(Name, KeyId)] -> IO (Maybe KeyId)+myPromptKeyId _ _ [] = return Nothing+myPromptKeyId title desc l = do+	h <- runZenity $+		[ "--list"+		, "--title", title+		, "--text", desc+		, "--column", "gpg secret key name"+		, "--column", "keyid"+		, "--print-column", "ALL"+		, "--separator", "\BEL"+		, "--width", "500"+		] ++ concatMap (\(Name n, KeyId kid) -> [BU8.toString n, BU8.toString kid]) l+	(ret, ok) <- waitZenity h+	if ok+		then do+			let (_n, _:kid) = break (== '\BEL') ret+			return $ Just (KeyId (BU8.fromString kid))+		else return Nothing++myWithProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO a) -> IO a+myWithProgress title desc a = bracket setup teardown (a . sendpercent)+  where+	setup = do+		h <- runZenity+			[ "--progress"+			, "--title", title+			, "--text", desc+			, "--auto-close"+			, "--auto-kill"+			]+		return h+	sendpercent h p = sendZenity h (show p)+	teardown h = do+		_ <- waitZenity h+		return ()++data ZenityHandle = ZenityHandle Handle Handle ProcessHandle++runZenity :: [String] -> IO ZenityHandle+runZenity ps = do+	(Just hin, Just hout, Nothing, ph) <- createProcess+		(proc "zenity" ps)+		{ std_out = CreatePipe+		, std_in = CreatePipe+		}+	return $ ZenityHandle hin hout ph++sendZenity :: ZenityHandle -> String -> IO ()+sendZenity (ZenityHandle hin _ _) s = do+	hPutStrLn hin s+	hFlush hin++waitZenity :: ZenityHandle -> IO (String, Bool)+waitZenity (ZenityHandle hin hout ph) = do+	hClose hin+	ret <- hGetContents hout+	exit <- waitForProcess ph+	return (takeWhile (/= '\n') ret, exit == ExitSuccess)
+ keysafe.1 view
@@ -0,0 +1,93 @@+.\" -*- nroff -*-+.TH keysafe 1 "Commands"+.SH NAME+keysafe \- securely back up secret keys+.SH SYNOPSIS+.B keysafe [options]+.SH DESCRIPTION+.I keysafe+securely backs up a gpg secret key or other short secret to the cloud.+.PP+This is not intended for storing Debian Developer keys that yield root on+ten million systems. It's about making it possible for users to use gpg who+currently don't, and who would find it too hard to use paperkey(1) to back+up and restore their key as they reinstall their laptop.+.PP+To get started with keysafe, you can run it without any options. If your+account has a gpg secret key, keysafe will prompt you for a password to+protect it with, and a name to store it under, and will back it up securely+to the cloud. +.PP+To restore from the backup, just run keysafe from an account that does not+have a gpg secret key (or use the --restore option to force restore mode).+Keysafe will prompt for the same name and password, and restore the key.+.PP+Note that the backup operation takes half an hour or so,+and the restore operation takes an hour or so. Keysafe encrypts+the secret key with the password in a way that takes a lot of computation+to decrypt. This makes it hard for an attacker to crack your password,+because each guess they make costs them.+.PP+Keysafe is designed so that it should take millions of dollars of computer+time to crack any fairly good password. With a truely good+password, such as four random words, the cracking cost should be many+trillions of dollars. Keysafe checks your password strength (using the+zxcvbn library), and shows an estimate of the cost to crack your password,+before backing up the key.+.PP+Whether it's safe to store your gpg secret key in the cloud is your+own decision. Keysafe comes with no warranty.+.SH OPTIONS+.PP+.IP --backup+Force backup mode. This is the default if you have a gpg secret key.+.PP+.IP --restore+Force restore mode. This is the default if you do not have a gpg secret+key.+.PP+.IP --uploadqueued+Upload any data to servers that was queued by a previous keysafe run.+This is designed to be put in a cron job.+.PP+.IP --gpgkeyid KEYID+Specify keyid of gpg key to back up or restore. This is useful if you+have multiple gpg keys. But, when this option is used to back up a key,+you have to also provide it to restore that key.+.PP+.IP --keyfile FILE+To back up anything other than a gpg secret key, use this option.+To restore from the backup, you must use this same option, and pass the+exact same filename.+.PP+.IP --totalshares M --neededshares N+These options have to be specified together.+The default values are --totalshares 3 --neededshares 2.+Keysafe uses Shamir secret sharing to create M shares of the encrypted+secret key, and each share is stored in a different server.+To restore the data, only N of the shares are needed. If you specify+these options when backing up a secret key, you also must specify them+with the same values to restore that secret key.+.PP+.IP --store-local+Store data locally, in ~/.keysafe/objects/local/. +(The default is to store data in the cloud.)+The local data storage consists of 3 (--totalshares) subdirectories,+which hold the shares of the encrypted secret key. So, you can each+subdirectory to a separate storage location, and then to restore the key,+copy 2 (--neededshares) of them back into place.+.PP+.IP --gui+Enable graphical user interface. This is the default unless keysafe+was run from a terminal. The GUI currently is implemented using zenity(1).+.PP+.IP --benchmark+Benchmark speed of keysafe's cryptographic primitives.+.PP+.IP --testmode+Avoid using expensive cryptographic operations to secure data.+Use for testing only, not with real secret keys.+.SH SEE ALSO+<https://joeyh.name/code/keysafe/>+.SH AUTHOR +Joey Hess <id@joeyh.name>
+ keysafe.cabal view
@@ -0,0 +1,86 @@+Name: keysafe+Version: 0.20160819+Cabal-Version: >= 1.8+Maintainer: Joey Hess <joey@kitenet.net>+Author: Joey Hess+Stability: Experimental+Copyright: 2016 Joey Hess+License: AGPL-3+Homepage: https://joeyh.name/code/keysafe/+Category: Utility+Build-Type: Custom+Synopsis: back up a secret key securely to the cloud+Description:+ Keysafe backs up a secret key to several cloud servers, split up+ so that no one server can access the whole secret by itself.+ .+ A password is used to encrypt the data, and it is made expensive+ to decrypt, so password cracking is infeasibly expensive.+License-File: AGPL+Extra-Source-Files:+  CHANGELOG+  TODO+  keysafe.1++Executable keysafe+  Main-Is: keysafe.hs+  GHC-Options: -Wall -fno-warn-tabs -O2+  Build-Depends:+      base (>= 4.5 && < 5.0)+    , bytestring == 0.10.*+    , deepseq == 1.4.*+    , random == 1.1.*+    , raaz == 0.0.2+    , time == 1.5.*+    , containers == 0.5.*+    , binary == 0.7.*+    , text == 1.2.*+    , utf8-string == 1.0.*+    , unix == 2.7.*+    , filepath == 1.4.*+    , split == 0.2.*+    , directory == 1.2.*+    , process == 1.2.*+    , optparse-applicative == 0.12.*+    , readline == 1.0.*+    , zxcvbn-c == 1.0.*++    -- Inlined to change the finite field size to 256+    -- for efficient serialization.+    -- secret-sharing == 1.0.*+    , dice-entropy-conduit >= 1.0.0.0+    , binary >=0.5.1.1+    , vector >=0.10.11.0+    , finite-field >=0.8.0+    , polynomial >= 0.7.1+    -- Temporarily inlined due to https://github.com/ocharles/argon2/issues/3+    -- argon2 == 1.1.*+  Extra-Libraries: argon2+  Other-Modules:+    Crypto.Argon2.FFI+    Crypto.Argon2+    CmdLine+    Cost+    Crypto.SecretSharing.Internal+    Encryption+    Entropy+    ExpensiveHash+    Gpg+    SecretKey+    Serialization+    Share+    Storage+    Storage.Local+    Storage.Network+    Tunables+    Types+    Types.Cost+    Types.Storage+    Types.UI+    UI+    UI.Readline+    UI.Zenity++source-repository head+  type: git+  location: git://git.joeyh.name/keysafe.git
+ keysafe.hs view
@@ -0,0 +1,293 @@+{-# LANGUAGE OverloadedStrings, BangPatterns #-}++{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Main where++import Types+import Tunables+import qualified CmdLine+import UI+import Encryption+import Entropy+import ExpensiveHash+import Cost+import SecretKey+import Share+import Storage+import qualified Gpg+import Data.Maybe+import Data.Time.Clock+import Data.Time.Calendar+import Data.Monoid+import Control.DeepSeq+import qualified Data.ByteString as B+import qualified Data.ByteString.UTF8 as BU8+import qualified Data.Set as S+import System.Posix.User (userGecos, getUserEntryForID, getEffectiveUserID)++main :: IO ()+main = do+	cmdline <- CmdLine.get+	ui <- selectUI (CmdLine.gui cmdline)+	let mkt = CmdLine.customizeShareParams cmdline+	(tunables, possibletunables) <- if CmdLine.testMode cmdline+		then do+			showInfo ui "Test mode"+				"Keysafe is running in test mode. This is not secure, and should not be used with real secret keys!"+			return (mkt testModeTunables, [mkt testModeTunables])+		else return (mkt defaultTunables, map (mkt . snd) knownTunings)+	storagelocations <- if CmdLine.localstorage cmdline+		then return localStorageLocations+		else allStorageLocations+	dispatch cmdline ui storagelocations tunables possibletunables++dispatch :: CmdLine.CmdLine -> UI -> StorageLocations -> Tunables -> [Tunables] -> IO ()+dispatch cmdline ui storagelocations tunables possibletunables = do+	mode <- CmdLine.selectMode cmdline+	go mode (CmdLine.secretkeysource cmdline)+  where+	go CmdLine.Backup (Just secretkeysource) =+		backup storagelocations ui tunables secretkeysource+			=<< getSecretKey secretkeysource+	go CmdLine.Restore (Just secretkeydest) =+		restore storagelocations ui possibletunables secretkeydest+	go CmdLine.Backup Nothing =+		backup storagelocations ui tunables Gpg.anyKey+			=<< Gpg.getKeyToBackup ui+	go CmdLine.Restore Nothing =+		restore storagelocations ui possibletunables Gpg.anyKey+	go CmdLine.UploadQueued _ =+		uploadQueued+	go CmdLine.Benchmark _ =+		benchmarkTunables tunables++backup :: StorageLocations -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO ()+backup storagelocations ui tunables secretkeysource secretkey = do+	username <- userName+	Name theirname <- fromMaybe (error "Aborting on no username") +		<$> promptName ui "Enter your name"+			usernamedesc (Just username) validateName+	go theirname+  where+	go theirname = do+		Name othername <- fromMaybe (error "aborting on no othername")+			<$> promptName ui "Enter other name"+				othernamedesc Nothing validateName+		let name = Name (theirname <> " " <> othername)+		kek <- promptkek name+		let sis = shareIdents tunables name secretkeysource+		let cost = getCreationCost kek <> getCreationCost sis+		r <- withProgressIncremental ui "Encrypting and storing data"+			(encryptdesc cost) $ \addpercent -> do+				let esk = encrypt tunables kek secretkey+				shares <- genShares esk tunables+				_ <- esk `deepseq` addpercent 25+				_ <- sis `seq` addpercent 25+				let step = 50 `div` sum (map S.size shares)+				storeShares storagelocations sis shares (addpercent step)+		case r of+			StoreSuccess -> showInfo ui "Success" "Your secret key was successfully encrypted and backed up."+			StoreFailure s -> showError ui ("There was a problem storing your encrypted secret key: " ++ s)+			StoreAlreadyExists -> do+				showError ui $ unlines+					[ "Another secret key is already being stored under the name you entered."+					, "Please try again with a different name."+					]+				go theirname+	promptkek name = do+		password <- fromMaybe (error "Aborting on no password") +			<$> promptPassword ui True "Enter password" passworddesc+		kek <- genKeyEncryptionKey tunables name password+		username <- userName+		let badwords = concatMap namewords [name, username]+		let crackcost = estimateAttackCost spotAWS $+			estimateBruteforceOf kek $+				passwordEntropy password badwords+		let mincost = Dollars 100000+		if crackcost < mincost+			then do+				showError ui $ "Weak password! It would cost only " ++ show crackcost ++ " to crack the password. Please think of a better one. More words would be good.."+				promptkek name+			else do+				(thisyear, _, _) <- toGregorian . utctDay+					<$> getCurrentTime+				ok <- promptQuestion ui "Password strength estimate"+					(crackdesc crackcost thisyear)+					"Is your password strong enough?"+				if ok+					then return kek+					else promptkek name+	namewords (Name nb) = words (BU8.toString nb)+	keydesc = case secretkeysource of+		GpgKey _ -> "gpg secret key"+		KeyFile _ -> "secret key"+	usernamedesc = unlines+		[ "Keysafe is going to backup your " ++ keydesc ++ " securely."+		, ""+		, "You will be prompted for some information. To restore your " ++ keydesc+		, "at a later date, you will need to remember and enter the same information."+		, ""+		, "To get started, what is your name?"+		]+	othernamedesc = unlines+		[ "Now think of another name, which not many people know."+		, "This will be used to make it hard for anyone else to find"+		, "the backup of your " ++ keydesc ++ "."+		, ""+		, "Some suggestions:"+		, ""+		, otherNameSuggestions+		, ""+		, "Make sure to pick a name you will remember later,"+		, "when you restore your " ++ keydesc ++ "."+		]+	passworddesc = unlines+		[ "Pick a password that will be used to protect your secret key."+		, ""+		, "It's very important that this password be hard to guess."+		, ""+		, "And, it needs to be one that you will be able to remember years from now"+		, "in order to restore your secret key."+		]+	crackdesc crackcost thisyear = unlines $+		"Rough estimate of the cost to crack your password: " :+		costOverTimeTable crackcost thisyear+	encryptdesc cost = unlines+		[ "This will probably take around " ++ showCostMinutes cost+		, ""+		, "(It's a feature that this takes a while; it makes it hard"+		, "for anyone to find your data, or crack your password.)"+		, ""+		, "Please wait..."+		]++otherNameSuggestions :: String+otherNameSuggestions = unlines $ map ("  * " ++)+	[ "Your high-school sweetheart."+	, "Your first pet."+	, "Your favorite teacher."+	, "Your college roomate."+	, "A place you like to visit."+	]++restore :: StorageLocations -> UI -> [Tunables] -> SecretKeySource -> IO ()+restore storagelocations ui possibletunables secretkeydest = do+	username <- userName+	Name theirname <- fromMaybe (error "Aborting on no username") +		<$> promptName ui "Enter your name"+			namedesc (Just username) validateName+	Name othername <- fromMaybe (error "aborting on no othername")+		<$> promptName ui "Enter other name"+			othernamedesc Nothing validateName+	let name = Name (theirname <> " " <> othername)+	password <- fromMaybe (error "Aborting on no password") +		<$> promptPassword ui True "Enter password" passworddesc+	+	let mksis tunables = shareIdents tunables name secretkeydest+	r <- downloadInitialShares storagelocations ui mksis possibletunables+	case r of+		Nothing -> showError ui "No shares could be downloaded. Perhaps you entered the wrong name or password?"+		Just (tunables, shares, sis) -> do+			let candidatekeys = candidateKeyEncryptionKeys tunables name password+			let cost = getCreationCost candidatekeys +				<> castCost (getDecryptionCost candidatekeys)+			case combineShares tunables [shares] of+				Left e -> showError ui e+				Right esk -> do+					final <- withProgress ui "Decrypting"+						(decryptdesc cost) $ \setpercent ->+							go tunables [shares] sis setpercent $+								tryDecrypt candidatekeys esk+					final+  where+	go tunables firstshares sis setpercent r = case r of+		DecryptFailed -> return $+			showError ui "Decryption failed! Unknown why it would fail at this point."+		DecryptSuccess secretkey -> do+			_ <- setpercent 100+			writeSecretKey secretkeydest secretkey+			return $+				showInfo ui "Success" "Your secret key was successfully restored!"+		DecryptIncomplete kek -> do+			-- Download shares for another chunk.+			(nextshares, sis') <- retrieveShares storagelocations sis (return ())+			let shares = firstshares ++ [nextshares]+			case combineShares tunables shares of+				Left e -> return $ showError ui e+				Right esk -> +					go tunables shares sis' setpercent $+						decrypt kek esk+	namedesc = unlines+		[ "When you backed up your secret key, you entered some information."+		, "To restore it, you'll need to remember what you entered back then."+		, ""+		, "To get started, what is your name?"+		]+	othernamedesc = unlines+		[ "What other name did you enter when you backed up your secret key?"+		, ""+		, "Back then, you were given some suggestions, like these:"+		, ""+		, otherNameSuggestions+		]+	passworddesc = unlines+		[ "Enter the password to unlock your secret key."+		]+	decryptdesc cost = unlines+		[ "This will probably take around " ++ showCostMinutes cost+		, ""+		, "(It's a feature that this takes so long; it prevents cracking your password.)"+		, ""+		, "Please wait..."+		]++-- | Try each possible tunable until the initial set of +-- shares are found, the return the shares, and+-- ShareIdents to download subsequent sets.+downloadInitialShares+	:: StorageLocations+	-> UI+	-> (Tunables -> ShareIdents)+	-> [Tunables]+	-> IO (Maybe (Tunables, S.Set Share, ShareIdents))+downloadInitialShares storagelocations ui mksis possibletunables =+	withProgressIncremental ui "Downloading encrypted data" message $ \addpercent -> do+		go possibletunables addpercent+  where+	go [] _ = return Nothing+	go (tunables:othertunables) addpercent = do+		-- Just calculating the hash to generate the stream of idents+		-- probably takes most of the time.+		let !sis = mksis tunables+		addpercent 50+		let m = totalObjects (shareParams tunables)+		let step = 50 `div` m+		(shares, sis') <- retrieveShares storagelocations sis (addpercent step)+		if S.null shares+			then go othertunables addpercent+			else return $ Just (tunables, shares, sis')++	possiblesis = map mksis possibletunables+	message = unlines+		[ "This will probably take around "+			++ showCostMinutes (mconcat $ map getCreationCost possiblesis)+		, ""+		, "(It's a feature that this takes a while; it makes it hard"+		, "for anyone else to find your data.)"+		, ""+		, "Please wait..."+		]++validateName :: Name -> Maybe Problem+validateName (Name n)+	| B.length n < 2 = Just "The name should be at least 2 letters long."+	| otherwise = Nothing++userName :: IO Name+userName = do+	u <- getUserEntryForID =<< getEffectiveUserID+	return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u)