pontarius-xmpp 0.0.6.0 → 0.0.7.0
raw patch · 23 files changed
+2324/−2743 lines, 23 filesdep +asn1-datadep +cerealdep +certificatedep −binarydep −idna2008dep ~crypto-apidep ~tlsbinary-added
Dependencies added: asn1-data, cereal, certificate, cryptohash, ranges, time, tls-extra, uuid
Dependencies removed: binary, idna2008
Dependency ranges changed: crypto-api, tls
Files
- COPYING +0/−674
- COPYING.LESSER +0/−165
- Documentation/Pontarius XMPP Manual.lyx +87/−32
- Documentation/Pontarius XMPP Manual.pdf binary
- Documentation/Software Design Description for Pontarius XMPP 1.0.lyx +0/−192
- Documentation/Software Quality Assurance Plan for Pontarius XMPP 1.0.lyx +0/−324
- Documentation/Software Requirements Specification for Pontarius XMPP.lyx +98/−246
- Documentation/Software Requirements Specification for Pontarius XMPP.pdf binary
- Examples/EchoClient.hs +2/−2
- LICENSE +28/−2
- Network/XMPP.hs +26/−49
- Network/XMPP/Address.hs +32/−59
- Network/XMPP/SASL.hs +91/−134
- Network/XMPP/Session.hs +226/−222
- Network/XMPP/Stanza.hs +48/−42
- Network/XMPP/Stream.hs +427/−359
- Network/XMPP/TLS.hs +25/−42
- Network/XMPP/Types.hs +228/−97
- Network/XMPP/Utilities.hs +41/−72
- README +12/−12
- install.sh +0/−5
- nohup.out +942/−0
- pontarius-xmpp.cabal +11/−13
− COPYING
@@ -1,674 +0,0 @@- GNU GENERAL PUBLIC LICENSE- Version 3, 29 June 2007-- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>- Everyone is permitted to copy and distribute verbatim copies- of this license document, but changing it is not allowed.-- Preamble-- The GNU General Public License is a free, copyleft license for-software and other kinds of works.-- The licenses for most software and other practical works are designed-to take away your freedom to share and change the works. By contrast,-the GNU General Public License is intended to guarantee your freedom to-share and change all versions of a program--to make sure it remains free-software for all its users. We, the Free Software Foundation, use the-GNU General Public License for most of our software; it applies also to-any other work released this way by its authors. You can apply it to-your programs, too.-- When we speak of free software, we are referring to freedom, not-price. Our General Public Licenses are designed to make sure that you-have the freedom to distribute copies of free software (and charge for-them if you wish), that you receive source code or can get it if you-want it, that you can change the software or use pieces of it in new-free programs, and that you know you can do these things.-- To protect your rights, we need to prevent others from denying you-these rights or asking you to surrender the rights. Therefore, you have-certain responsibilities if you distribute copies of the software, or if-you modify it: responsibilities to respect the freedom of others.-- For example, if you distribute copies of such a program, whether-gratis or for a fee, you must pass on to the recipients the same-freedoms that you received. You must make sure that they, too, receive-or can get the source code. And you must show them these terms so they-know their rights.-- Developers that use the GNU GPL protect your rights with two steps:-(1) assert copyright on the software, and (2) offer you this License-giving you legal permission to copy, distribute and/or modify it.-- For the developers' and authors' protection, the GPL clearly explains-that there is no warranty for this free software. For both users' and-authors' sake, the GPL requires that modified versions be marked as-changed, so that their problems will not be attributed erroneously to-authors of previous versions.-- Some devices are designed to deny users access to install or run-modified versions of the software inside them, although the manufacturer-can do so. This is fundamentally incompatible with the aim of-protecting users' freedom to change the software. The systematic-pattern of such abuse occurs in the area of products for individuals to-use, which is precisely where it is most unacceptable. Therefore, we-have designed this version of the GPL to prohibit the practice for those-products. If such problems arise substantially in other domains, we-stand ready to extend this provision to those domains in future versions-of the GPL, as needed to protect the freedom of users.-- Finally, every program is threatened constantly by software patents.-States should not allow patents to restrict development and use of-software on general-purpose computers, but in those that do, we wish to-avoid the special danger that patents applied to a free program could-make it effectively proprietary. To prevent this, the GPL assures that-patents cannot be used to render the program non-free.-- The precise terms and conditions for copying, distribution and-modification follow.-- TERMS AND CONDITIONS-- 0. Definitions.-- "This License" refers to version 3 of the GNU General Public License.-- "Copyright" also means copyright-like laws that apply to other kinds of-works, such as semiconductor masks.-- "The Program" refers to any copyrightable work licensed under this-License. Each licensee is addressed as "you". "Licensees" and-"recipients" may be individuals or organizations.-- To "modify" a work means to copy from or adapt all or part of the work-in a fashion requiring copyright permission, other than the making of an-exact copy. The resulting work is called a "modified version" of the-earlier work or a work "based on" the earlier work.-- A "covered work" means either the unmodified Program or a work based-on the Program.-- To "propagate" a work means to do anything with it that, without-permission, would make you directly or secondarily liable for-infringement under applicable copyright law, except executing it on a-computer or modifying a private copy. Propagation includes copying,-distribution (with or without modification), making available to the-public, and in some countries other activities as well.-- To "convey" a work means any kind of propagation that enables other-parties to make or receive copies. Mere interaction with a user through-a computer network, with no transfer of a copy, is not conveying.-- An interactive user interface displays "Appropriate Legal Notices"-to the extent that it includes a convenient and prominently visible-feature that (1) displays an appropriate copyright notice, and (2)-tells the user that there is no warranty for the work (except to the-extent that warranties are provided), that licensees may convey the-work under this License, and how to view a copy of this License. If-the interface presents a list of user commands or options, such as a-menu, a prominent item in the list meets this criterion.-- 1. Source Code.-- The "source code" for a work means the preferred form of the work-for making modifications to it. "Object code" means any non-source-form of a work.-- A "Standard Interface" means an interface that either is an official-standard defined by a recognized standards body, or, in the case of-interfaces specified for a particular programming language, one that-is widely used among developers working in that language.-- The "System Libraries" of an executable work include anything, other-than the work as a whole, that (a) is included in the normal form of-packaging a Major Component, but which is not part of that Major-Component, and (b) serves only to enable use of the work with that-Major Component, or to implement a Standard Interface for which an-implementation is available to the public in source code form. A-"Major Component", in this context, means a major essential component-(kernel, window system, and so on) of the specific operating system-(if any) on which the executable work runs, or a compiler used to-produce the work, or an object code interpreter used to run it.-- The "Corresponding Source" for a work in object code form means all-the source code needed to generate, install, and (for an executable-work) run the object code and to modify the work, including scripts to-control those activities. However, it does not include the work's-System Libraries, or general-purpose tools or generally available free-programs which are used unmodified in performing those activities but-which are not part of the work. For example, Corresponding Source-includes interface definition files associated with source files for-the work, and the source code for shared libraries and dynamically-linked subprograms that the work is specifically designed to require,-such as by intimate data communication or control flow between those-subprograms and other parts of the work.-- The Corresponding Source need not include anything that users-can regenerate automatically from other parts of the Corresponding-Source.-- The Corresponding Source for a work in source code form is that-same work.-- 2. Basic Permissions.-- All rights granted under this License are granted for the term of-copyright on the Program, and are irrevocable provided the stated-conditions are met. This License explicitly affirms your unlimited-permission to run the unmodified Program. The output from running a-covered work is covered by this License only if the output, given its-content, constitutes a covered work. This License acknowledges your-rights of fair use or other equivalent, as provided by copyright law.-- You may make, run and propagate covered works that you do not-convey, without conditions so long as your license otherwise remains-in force. You may convey covered works to others for the sole purpose-of having them make modifications exclusively for you, or provide you-with facilities for running those works, provided that you comply with-the terms of this License in conveying all material for which you do-not control copyright. Those thus making or running the covered works-for you must do so exclusively on your behalf, under your direction-and control, on terms that prohibit them from making any copies of-your copyrighted material outside their relationship with you.-- Conveying under any other circumstances is permitted solely under-the conditions stated below. Sublicensing is not allowed; section 10-makes it unnecessary.-- 3. Protecting Users' Legal Rights From Anti-Circumvention Law.-- No covered work shall be deemed part of an effective technological-measure under any applicable law fulfilling obligations under article-11 of the WIPO copyright treaty adopted on 20 December 1996, or-similar laws prohibiting or restricting circumvention of such-measures.-- When you convey a covered work, you waive any legal power to forbid-circumvention of technological measures to the extent such circumvention-is effected by exercising rights under this License with respect to-the covered work, and you disclaim any intention to limit operation or-modification of the work as a means of enforcing, against the work's-users, your or third parties' legal rights to forbid circumvention of-technological measures.-- 4. Conveying Verbatim Copies.-- You may convey verbatim copies of the Program's source code as you-receive it, in any medium, provided that you conspicuously and-appropriately publish on each copy an appropriate copyright notice;-keep intact all notices stating that this License and any-non-permissive terms added in accord with section 7 apply to the code;-keep intact all notices of the absence of any warranty; and give all-recipients a copy of this License along with the Program.-- You may charge any price or no price for each copy that you convey,-and you may offer support or warranty protection for a fee.-- 5. Conveying Modified Source Versions.-- You may convey a work based on the Program, or the modifications to-produce it from the Program, in the form of source code under the-terms of section 4, provided that you also meet all of these conditions:-- a) The work must carry prominent notices stating that you modified- it, and giving a relevant date.-- b) The work must carry prominent notices stating that it is- released under this License and any conditions added under section- 7. This requirement modifies the requirement in section 4 to- "keep intact all notices".-- c) You must license the entire work, as a whole, under this- License to anyone who comes into possession of a copy. This- License will therefore apply, along with any applicable section 7- additional terms, to the whole of the work, and all its parts,- regardless of how they are packaged. This License gives no- permission to license the work in any other way, but it does not- invalidate such permission if you have separately received it.-- d) If the work has interactive user interfaces, each must display- Appropriate Legal Notices; however, if the Program has interactive- interfaces that do not display Appropriate Legal Notices, your- work need not make them do so.-- A compilation of a covered work with other separate and independent-works, which are not by their nature extensions of the covered work,-and which are not combined with it such as to form a larger program,-in or on a volume of a storage or distribution medium, is called an-"aggregate" if the compilation and its resulting copyright are not-used to limit the access or legal rights of the compilation's users-beyond what the individual works permit. Inclusion of a covered work-in an aggregate does not cause this License to apply to the other-parts of the aggregate.-- 6. Conveying Non-Source Forms.-- You may convey a covered work in object code form under the terms-of sections 4 and 5, provided that you also convey the-machine-readable Corresponding Source under the terms of this License,-in one of these ways:-- a) Convey the object code in, or embodied in, a physical product- (including a physical distribution medium), accompanied by the- Corresponding Source fixed on a durable physical medium- customarily used for software interchange.-- b) Convey the object code in, or embodied in, a physical product- (including a physical distribution medium), accompanied by a- written offer, valid for at least three years and valid for as- long as you offer spare parts or customer support for that product- model, to give anyone who possesses the object code either (1) a- copy of the Corresponding Source for all the software in the- product that is covered by this License, on a durable physical- medium customarily used for software interchange, for a price no- more than your reasonable cost of physically performing this- conveying of source, or (2) access to copy the- Corresponding Source from a network server at no charge.-- c) Convey individual copies of the object code with a copy of the- written offer to provide the Corresponding Source. This- alternative is allowed only occasionally and noncommercially, and- only if you received the object code with such an offer, in accord- with subsection 6b.-- d) Convey the object code by offering access from a designated- place (gratis or for a charge), and offer equivalent access to the- Corresponding Source in the same way through the same place at no- further charge. You need not require recipients to copy the- Corresponding Source along with the object code. If the place to- copy the object code is a network server, the Corresponding Source- may be on a different server (operated by you or a third party)- that supports equivalent copying facilities, provided you maintain- clear directions next to the object code saying where to find the- Corresponding Source. Regardless of what server hosts the- Corresponding Source, you remain obligated to ensure that it is- available for as long as needed to satisfy these requirements.-- e) Convey the object code using peer-to-peer transmission, provided- you inform other peers where the object code and Corresponding- Source of the work are being offered to the general public at no- charge under subsection 6d.-- A separable portion of the object code, whose source code is excluded-from the Corresponding Source as a System Library, need not be-included in conveying the object code work.-- A "User Product" is either (1) a "consumer product", which means any-tangible personal property which is normally used for personal, family,-or household purposes, or (2) anything designed or sold for incorporation-into a dwelling. In determining whether a product is a consumer product,-doubtful cases shall be resolved in favor of coverage. For a particular-product received by a particular user, "normally used" refers to a-typical or common use of that class of product, regardless of the status-of the particular user or of the way in which the particular user-actually uses, or expects or is expected to use, the product. A product-is a consumer product regardless of whether the product has substantial-commercial, industrial or non-consumer uses, unless such uses represent-the only significant mode of use of the product.-- "Installation Information" for a User Product means any methods,-procedures, authorization keys, or other information required to install-and execute modified versions of a covered work in that User Product from-a modified version of its Corresponding Source. The information must-suffice to ensure that the continued functioning of the modified object-code is in no case prevented or interfered with solely because-modification has been made.-- If you convey an object code work under this section in, or with, or-specifically for use in, a User Product, and the conveying occurs as-part of a transaction in which the right of possession and use of the-User Product is transferred to the recipient in perpetuity or for a-fixed term (regardless of how the transaction is characterized), the-Corresponding Source conveyed under this section must be accompanied-by the Installation Information. But this requirement does not apply-if neither you nor any third party retains the ability to install-modified object code on the User Product (for example, the work has-been installed in ROM).-- The requirement to provide Installation Information does not include a-requirement to continue to provide support service, warranty, or updates-for a work that has been modified or installed by the recipient, or for-the User Product in which it has been modified or installed. Access to a-network may be denied when the modification itself materially and-adversely affects the operation of the network or violates the rules and-protocols for communication across the network.-- Corresponding Source conveyed, and Installation Information provided,-in accord with this section must be in a format that is publicly-documented (and with an implementation available to the public in-source code form), and must require no special password or key for-unpacking, reading or copying.-- 7. Additional Terms.-- "Additional permissions" are terms that supplement the terms of this-License by making exceptions from one or more of its conditions.-Additional permissions that are applicable to the entire Program shall-be treated as though they were included in this License, to the extent-that they are valid under applicable law. If additional permissions-apply only to part of the Program, that part may be used separately-under those permissions, but the entire Program remains governed by-this License without regard to the additional permissions.-- When you convey a copy of a covered work, you may at your option-remove any additional permissions from that copy, or from any part of-it. (Additional permissions may be written to require their own-removal in certain cases when you modify the work.) You may place-additional permissions on material, added by you to a covered work,-for which you have or can give appropriate copyright permission.-- Notwithstanding any other provision of this License, for material you-add to a covered work, you may (if authorized by the copyright holders of-that material) supplement the terms of this License with terms:-- a) Disclaiming warranty or limiting liability differently from the- terms of sections 15 and 16 of this License; or-- b) Requiring preservation of specified reasonable legal notices or- author attributions in that material or in the Appropriate Legal- Notices displayed by works containing it; or-- c) Prohibiting misrepresentation of the origin of that material, or- requiring that modified versions of such material be marked in- reasonable ways as different from the original version; or-- d) Limiting the use for publicity purposes of names of licensors or- authors of the material; or-- e) Declining to grant rights under trademark law for use of some- trade names, trademarks, or service marks; or-- f) Requiring indemnification of licensors and authors of that- material by anyone who conveys the material (or modified versions of- it) with contractual assumptions of liability to the recipient, for- any liability that these contractual assumptions directly impose on- those licensors and authors.-- All other non-permissive additional terms are considered "further-restrictions" within the meaning of section 10. If the Program as you-received it, or any part of it, contains a notice stating that it is-governed by this License along with a term that is a further-restriction, you may remove that term. If a license document contains-a further restriction but permits relicensing or conveying under this-License, you may add to a covered work material governed by the terms-of that license document, provided that the further restriction does-not survive such relicensing or conveying.-- If you add terms to a covered work in accord with this section, you-must place, in the relevant source files, a statement of the-additional terms that apply to those files, or a notice indicating-where to find the applicable terms.-- Additional terms, permissive or non-permissive, may be stated in the-form of a separately written license, or stated as exceptions;-the above requirements apply either way.-- 8. Termination.-- You may not propagate or modify a covered work except as expressly-provided under this License. Any attempt otherwise to propagate or-modify it is void, and will automatically terminate your rights under-this License (including any patent licenses granted under the third-paragraph of section 11).-- However, if you cease all violation of this License, then your-license from a particular copyright holder is reinstated (a)-provisionally, unless and until the copyright holder explicitly and-finally terminates your license, and (b) permanently, if the copyright-holder fails to notify you of the violation by some reasonable means-prior to 60 days after the cessation.-- Moreover, your license from a particular copyright holder is-reinstated permanently if the copyright holder notifies you of the-violation by some reasonable means, this is the first time you have-received notice of violation of this License (for any work) from that-copyright holder, and you cure the violation prior to 30 days after-your receipt of the notice.-- Termination of your rights under this section does not terminate the-licenses of parties who have received copies or rights from you under-this License. If your rights have been terminated and not permanently-reinstated, you do not qualify to receive new licenses for the same-material under section 10.-- 9. Acceptance Not Required for Having Copies.-- You are not required to accept this License in order to receive or-run a copy of the Program. Ancillary propagation of a covered work-occurring solely as a consequence of using peer-to-peer transmission-to receive a copy likewise does not require acceptance. However,-nothing other than this License grants you permission to propagate or-modify any covered work. These actions infringe copyright if you do-not accept this License. Therefore, by modifying or propagating a-covered work, you indicate your acceptance of this License to do so.-- 10. Automatic Licensing of Downstream Recipients.-- Each time you convey a covered work, the recipient automatically-receives a license from the original licensors, to run, modify and-propagate that work, subject to this License. You are not responsible-for enforcing compliance by third parties with this License.-- An "entity transaction" is a transaction transferring control of an-organization, or substantially all assets of one, or subdividing an-organization, or merging organizations. If propagation of a covered-work results from an entity transaction, each party to that-transaction who receives a copy of the work also receives whatever-licenses to the work the party's predecessor in interest had or could-give under the previous paragraph, plus a right to possession of the-Corresponding Source of the work from the predecessor in interest, if-the predecessor has it or can get it with reasonable efforts.-- You may not impose any further restrictions on the exercise of the-rights granted or affirmed under this License. For example, you may-not impose a license fee, royalty, or other charge for exercise of-rights granted under this License, and you may not initiate litigation-(including a cross-claim or counterclaim in a lawsuit) alleging that-any patent claim is infringed by making, using, selling, offering for-sale, or importing the Program or any portion of it.-- 11. Patents.-- A "contributor" is a copyright holder who authorizes use under this-License of the Program or a work on which the Program is based. The-work thus licensed is called the contributor's "contributor version".-- A contributor's "essential patent claims" are all patent claims-owned or controlled by the contributor, whether already acquired or-hereafter acquired, that would be infringed by some manner, permitted-by this License, of making, using, or selling its contributor version,-but do not include claims that would be infringed only as a-consequence of further modification of the contributor version. For-purposes of this definition, "control" includes the right to grant-patent sublicenses in a manner consistent with the requirements of-this License.-- Each contributor grants you a non-exclusive, worldwide, royalty-free-patent license under the contributor's essential patent claims, to-make, use, sell, offer for sale, import and otherwise run, modify and-propagate the contents of its contributor version.-- In the following three paragraphs, a "patent license" is any express-agreement or commitment, however denominated, not to enforce a patent-(such as an express permission to practice a patent or covenant not to-sue for patent infringement). To "grant" such a patent license to a-party means to make such an agreement or commitment not to enforce a-patent against the party.-- If you convey a covered work, knowingly relying on a patent license,-and the Corresponding Source of the work is not available for anyone-to copy, free of charge and under the terms of this License, through a-publicly available network server or other readily accessible means,-then you must either (1) cause the Corresponding Source to be so-available, or (2) arrange to deprive yourself of the benefit of the-patent license for this particular work, or (3) arrange, in a manner-consistent with the requirements of this License, to extend the patent-license to downstream recipients. "Knowingly relying" means you have-actual knowledge that, but for the patent license, your conveying the-covered work in a country, or your recipient's use of the covered work-in a country, would infringe one or more identifiable patents in that-country that you have reason to believe are valid.-- If, pursuant to or in connection with a single transaction or-arrangement, you convey, or propagate by procuring conveyance of, a-covered work, and grant a patent license to some of the parties-receiving the covered work authorizing them to use, propagate, modify-or convey a specific copy of the covered work, then the patent license-you grant is automatically extended to all recipients of the covered-work and works based on it.-- A patent license is "discriminatory" if it does not include within-the scope of its coverage, prohibits the exercise of, or is-conditioned on the non-exercise of one or more of the rights that are-specifically granted under this License. You may not convey a covered-work if you are a party to an arrangement with a third party that is-in the business of distributing software, under which you make payment-to the third party based on the extent of your activity of conveying-the work, and under which the third party grants, to any of the-parties who would receive the covered work from you, a discriminatory-patent license (a) in connection with copies of the covered work-conveyed by you (or copies made from those copies), or (b) primarily-for and in connection with specific products or compilations that-contain the covered work, unless you entered into that arrangement,-or that patent license was granted, prior to 28 March 2007.-- Nothing in this License shall be construed as excluding or limiting-any implied license or other defenses to infringement that may-otherwise be available to you under applicable patent law.-- 12. No Surrender of Others' Freedom.-- If conditions are imposed on you (whether by court order, agreement or-otherwise) that contradict the conditions of this License, they do not-excuse you from the conditions of this License. If you cannot convey a-covered work so as to satisfy simultaneously your obligations under this-License and any other pertinent obligations, then as a consequence you may-not convey it at all. For example, if you agree to terms that obligate you-to collect a royalty for further conveying from those to whom you convey-the Program, the only way you could satisfy both those terms and this-License would be to refrain entirely from conveying the Program.-- 13. Use with the GNU Affero General Public License.-- Notwithstanding any other provision of this License, you have-permission to link or combine any covered work with a work licensed-under version 3 of the GNU Affero General Public License into a single-combined work, and to convey the resulting work. The terms of this-License will continue to apply to the part which is the covered work,-but the special requirements of the GNU Affero General Public License,-section 13, concerning interaction through a network will apply to the-combination as such.-- 14. Revised Versions of this License.-- The Free Software Foundation may publish revised and/or new versions of-the GNU General Public License from time to time. Such new versions will-be similar in spirit to the present version, but may differ in detail to-address new problems or concerns.-- Each version is given a distinguishing version number. If the-Program specifies that a certain numbered version of the GNU General-Public License "or any later version" applies to it, you have the-option of following the terms and conditions either of that numbered-version or of any later version published by the Free Software-Foundation. If the Program does not specify a version number of the-GNU General Public License, you may choose any version ever published-by the Free Software Foundation.-- If the Program specifies that a proxy can decide which future-versions of the GNU General Public License can be used, that proxy's-public statement of acceptance of a version permanently authorizes you-to choose that version for the Program.-- Later license versions may give you additional or different-permissions. However, no additional obligations are imposed on any-author or copyright holder as a result of your choosing to follow a-later version.-- 15. Disclaimer of Warranty.-- THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY-APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT-HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY-OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,-THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR-PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM-IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF-ALL NECESSARY SERVICING, REPAIR OR CORRECTION.-- 16. Limitation of Liability.-- IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS-THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY-GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE-USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF-DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD-PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),-EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF-SUCH DAMAGES.-- 17. Interpretation of Sections 15 and 16.-- If the disclaimer of warranty and limitation of liability provided-above cannot be given local legal effect according to their terms,-reviewing courts shall apply local law that most closely approximates-an absolute waiver of all civil liability in connection with the-Program, unless a warranty or assumption of liability accompanies a-copy of the Program in return for a fee.-- END OF TERMS AND CONDITIONS-- How to Apply These Terms to Your New Programs-- If you develop a new program, and you want it to be of the greatest-possible use to the public, the best way to achieve this is to make it-free software which everyone can redistribute and change under these terms.-- To do so, attach the following notices to the program. It is safest-to attach them to the start of each source file to most effectively-state the exclusion of warranty; and each file should have at least-the "copyright" line and a pointer to where the full notice is found.-- <one line to give the program's name and a brief idea of what it does.>- Copyright (C) <year> <name of author>-- This program is free software: you can redistribute it and/or modify- it under the terms of the GNU General Public License as published by- the Free Software Foundation, either version 3 of the License, or- (at your option) any later version.-- This program is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the- GNU General Public License for more details.-- You should have received a copy of the GNU General Public License- along with this program. If not, see <http://www.gnu.org/licenses/>.--Also add information on how to contact you by electronic and paper mail.-- If the program does terminal interaction, make it output a short-notice like this when it starts in an interactive mode:-- <program> Copyright (C) <year> <name of author>- This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.- This is free software, and you are welcome to redistribute it- under certain conditions; type `show c' for details.--The hypothetical commands `show w' and `show c' should show the appropriate-parts of the General Public License. Of course, your program's commands-might be different; for a GUI interface, you would use an "about box".-- You should also get your employer (if you work as a programmer) or school,-if any, to sign a "copyright disclaimer" for the program, if necessary.-For more information on this, and how to apply and follow the GNU GPL, see-<http://www.gnu.org/licenses/>.-- The GNU General Public License does not permit incorporating your program-into proprietary programs. If your program is a subroutine library, you-may consider it more useful to permit linking proprietary applications with-the library. If this is what you want to do, use the GNU Lesser General-Public License instead of this License. But first, please read-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
− COPYING.LESSER
@@ -1,165 +0,0 @@- GNU LESSER GENERAL PUBLIC LICENSE- Version 3, 29 June 2007-- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>- Everyone is permitted to copy and distribute verbatim copies- of this license document, but changing it is not allowed.--- This version of the GNU Lesser General Public License incorporates-the terms and conditions of version 3 of the GNU General Public-License, supplemented by the additional permissions listed below.-- 0. Additional Definitions.-- As used herein, "this License" refers to version 3 of the GNU Lesser-General Public License, and the "GNU GPL" refers to version 3 of the GNU-General Public License.-- "The Library" refers to a covered work governed by this License,-other than an Application or a Combined Work as defined below.-- An "Application" is any work that makes use of an interface provided-by the Library, but which is not otherwise based on the Library.-Defining a subclass of a class defined by the Library is deemed a mode-of using an interface provided by the Library.-- A "Combined Work" is a work produced by combining or linking an-Application with the Library. The particular version of the Library-with which the Combined Work was made is also called the "Linked-Version".-- The "Minimal Corresponding Source" for a Combined Work means the-Corresponding Source for the Combined Work, excluding any source code-for portions of the Combined Work that, considered in isolation, are-based on the Application, and not on the Linked Version.-- The "Corresponding Application Code" for a Combined Work means the-object code and/or source code for the Application, including any data-and utility programs needed for reproducing the Combined Work from the-Application, but excluding the System Libraries of the Combined Work.-- 1. Exception to Section 3 of the GNU GPL.-- You may convey a covered work under sections 3 and 4 of this License-without being bound by section 3 of the GNU GPL.-- 2. Conveying Modified Versions.-- If you modify a copy of the Library, and, in your modifications, a-facility refers to a function or data to be supplied by an Application-that uses the facility (other than as an argument passed when the-facility is invoked), then you may convey a copy of the modified-version:-- a) under this License, provided that you make a good faith effort to- ensure that, in the event an Application does not supply the- function or data, the facility still operates, and performs- whatever part of its purpose remains meaningful, or-- b) under the GNU GPL, with none of the additional permissions of- this License applicable to that copy.-- 3. Object Code Incorporating Material from Library Header Files.-- The object code form of an Application may incorporate material from-a header file that is part of the Library. You may convey such object-code under terms of your choice, provided that, if the incorporated-material is not limited to numerical parameters, data structure-layouts and accessors, or small macros, inline functions and templates-(ten or fewer lines in length), you do both of the following:-- a) Give prominent notice with each copy of the object code that the- Library is used in it and that the Library and its use are- covered by this License.-- b) Accompany the object code with a copy of the GNU GPL and this license- document.-- 4. Combined Works.-- You may convey a Combined Work under terms of your choice that,-taken together, effectively do not restrict modification of the-portions of the Library contained in the Combined Work and reverse-engineering for debugging such modifications, if you also do each of-the following:-- a) Give prominent notice with each copy of the Combined Work that- the Library is used in it and that the Library and its use are- covered by this License.-- b) Accompany the Combined Work with a copy of the GNU GPL and this license- document.-- c) For a Combined Work that displays copyright notices during- execution, include the copyright notice for the Library among- these notices, as well as a reference directing the user to the- copies of the GNU GPL and this license document.-- d) Do one of the following:-- 0) Convey the Minimal Corresponding Source under the terms of this- License, and the Corresponding Application Code in a form- suitable for, and under terms that permit, the user to- recombine or relink the Application with a modified version of- the Linked Version to produce a modified Combined Work, in the- manner specified by section 6 of the GNU GPL for conveying- Corresponding Source.-- 1) Use a suitable shared library mechanism for linking with the- Library. A suitable mechanism is one that (a) uses at run time- a copy of the Library already present on the user's computer- system, and (b) will operate properly with a modified version- of the Library that is interface-compatible with the Linked- Version.-- e) Provide Installation Information, but only if you would otherwise- be required to provide such information under section 6 of the- GNU GPL, and only to the extent that such information is- necessary to install and execute a modified version of the- Combined Work produced by recombining or relinking the- Application with a modified version of the Linked Version. (If- you use option 4d0, the Installation Information must accompany- the Minimal Corresponding Source and Corresponding Application- Code. If you use option 4d1, you must provide the Installation- Information in the manner specified by section 6 of the GNU GPL- for conveying Corresponding Source.)-- 5. Combined Libraries.-- You may place library facilities that are a work based on the-Library side by side in a single library together with other library-facilities that are not Applications and are not covered by this-License, and convey such a combined library under terms of your-choice, if you do both of the following:-- a) Accompany the combined library with a copy of the same work based- on the Library, uncombined with any other library facilities,- conveyed under the terms of this License.-- b) Give prominent notice with the combined library that part of it- is a work based on the Library, and explaining where to find the- accompanying uncombined form of the same work.-- 6. Revised Versions of the GNU Lesser General Public License.-- The Free Software Foundation may publish revised and/or new versions-of the GNU Lesser 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-Library as you received it specifies that a certain numbered version-of the GNU Lesser General Public License "or any later version"-applies to it, you have the option of following the terms and-conditions either of that published version or of any later version-published by the Free Software Foundation. If the Library as you-received it does not specify a version number of the GNU Lesser-General Public License, you may choose any version of the GNU Lesser-General Public License ever published by the Free Software Foundation.-- If the Library as you received it specifies that a proxy can decide-whether future versions of the GNU Lesser General Public License shall-apply, that proxy's public statement of acceptance of any version is-permanent authorization for you to choose that version for the-Library.
Documentation/Pontarius XMPP Manual.lyx view
@@ -61,7 +61,7 @@ \begin_body \begin_layout Title-Pontarius XMPP 0.1 Manual (Third Draft)+Pontarius XMPP 0.1 Manual (Fourth Draft) \end_layout \begin_layout Author@@ -69,7 +69,7 @@ \end_layout \begin_layout Date-The 6th of July, 2011+The 27th of July, 2011 \end_layout \begin_layout Standard@@ -86,20 +86,8 @@ \end_layout \begin_layout Standard-Pontarius XMPP aims to be a convenient-to-use, powerful, correct, secure,- and extendable XMPP client library for Haskell.- It is written by Jon Kristensen and Mahdi Abdinejadi.- Being licensed under the GNU Lesser General Public License, Pontarius XMPP- is free and open source software.-\end_layout--\begin_layout Section-Features and Implementation Specifics-\end_layout--\begin_layout Standard-Pontarius XMPP 0.1 implements the client capabilities of the XMPP Core specificat-ion (RFC 6120)+Pontarius XMPP 0.1 is a minimal XMPP client implementation with all the required+ client features and behaviours of the RFC 6120 ("XMPP Core") specification \begin_inset Foot status open @@ -110,46 +98,108 @@ \end_inset .- Below are the specifics of our implementation.+ Pontarius XMPP has been developed by the Pontarius project (mainly by Jon+ Kristensen).++\series bold+ +\series default+Being licensed under a three-clause BSD license, Pontarius XMPP is free+ and open source software. \end_layout +\begin_layout Section+Features and Implementation Specifics+\end_layout++\begin_layout Standard+Pontarius XMPP 0.1 implements the XMPP Core specification (RFC 6120).+ Features include the following:+\end_layout+ \begin_layout Itemize-The client is always the initiating entity+Connecting and disconnecting from an XMPP server \end_layout \begin_layout Itemize-A client-of-server connection is always exactly one TCP connection+Opening the XMPP streams \end_layout \begin_layout Itemize-TLS is supported for client-to-server confidentiality+Securing XMPP streams with TLS \end_layout \begin_layout Itemize-Only the SCRAM authentication method is supported+Authenticate using SASL \end_layout \begin_layout Itemize-...+Perform resource binding \end_layout -\begin_layout Standard-Later versions will add supports for different XMPP extensions, such as- RFC 6121 (XMPP IM), XEP-0004: Data Forms, and XEP-0077: In-Band Registration.-\begin_inset Foot-status open+\begin_layout Itemize+Send and receive stanzas (message, presence, and IQ) and stanza errors+\end_layout -\begin_layout Plain Layout-XMPP RFCs can be found at http://xmpp.org/xmpp-protocols/rfcs/, and the so-called- XEPs at http://xmpp.org/xmpp-protocols/xmpp-extensions/.+\begin_layout Itemize+Send and receive stream errors \end_layout +\begin_layout Standard+Below are the specifics of our implementation:+\end_layout++\begin_layout Itemize+Pontarius XMPP is a client library; the application using Pontarius XMPP+ is always the +\begin_inset Quotes eld \end_inset +initiating entity+\begin_inset Quotes erd+\end_inset + \end_layout +\begin_layout Itemize+A client-to-server connection always consists of exactly one TCP connection+\end_layout++\begin_layout Itemize+For stream security through TLS, only the TLS_RSA_WITH_AES_128_CBC_SHA cipher+ suite is supported+\end_layout++\begin_layout Itemize+TLS renegotiation is not supported+\end_layout++\begin_layout Itemize+TLS channel binding is not supported+\end_layout++\begin_layout Itemize+For (SASL) authentication, the SHA-1 variant of SASL Salted Challenge Response+ Authentication Mechanism (SCRAM-SHA-1) is the only supported mechanism+\end_layout+ \begin_layout Section+Future Development+\end_layout++\begin_layout Standard+The current goal for Pontarius XMPP 0.2 is to implement the Extended Personal+ Media Network (XPMN) architecture so that the Pontarius project can develop+ a media server and some other XPMN services on top of Pontarius XMPP.+ However, if we get approached by people wanting to use Pontarius XMPP for+ other things, we might decide to help them out by implement some other+ features first.+ Please let us know if you are looking for a Haskell XMPP library and Pontarius+ XMPP lacks some features that you want.+\end_layout++\begin_layout Section Usage \end_layout @@ -346,8 +396,13 @@ \end_layout \begin_layout Standard-There are four functions dealing with XMPP addresses (or JIDs, as they are- also called):+As with email, XMPP uses globally unique addresses (or JIDs, as they are+ also called) in order to route and deliver messages over the network.+ All XMPP entities are addressable on the local network.+\end_layout++\begin_layout Standard+There are four functions dealing with XMPP addresses: \end_layout \begin_layout Standard
+ Documentation/Pontarius XMPP Manual.pdf view
binary file changed (absent → 111393 bytes)
− Documentation/Software Design Description for Pontarius XMPP 1.0.lyx
@@ -1,192 +0,0 @@-#LyX 2.0 created this file. For more info see http://www.lyx.org/-\lyxformat 413-\begin_document-\begin_header-\textclass article-\use_default_options true-\maintain_unincluded_children false-\language english-\language_package default-\inputencoding auto-\fontencoding global-\font_roman default-\font_sans default-\font_typewriter default-\font_default_family default-\use_non_tex_fonts false-\font_sc false-\font_osf false-\font_sf_scale 100-\font_tt_scale 100--\graphics default-\default_output_format default-\output_sync 0-\bibtex_command default-\index_command default-\paperfontsize default-\use_hyperref false-\papersize default-\use_geometry false-\use_amsmath 1-\use_esint 1-\use_mhchem 1-\use_mathdots 1-\cite_engine basic-\use_bibtopic false-\use_indices false-\paperorientation portrait-\suppress_date false-\use_refstyle 1-\index Index-\shortcut idx-\color #008000-\end_index-\secnumdepth 3-\tocdepth 3-\paragraph_separation indent-\paragraph_indentation default-\quotes_language english-\papercolumns 1-\papersides 1-\paperpagestyle default-\tracking_changes false-\output_changes false-\html_math_output 0-\html_css_as_file 0-\html_be_strict false-\end_header--\begin_body--\begin_layout Title-Software Design Description for Pontarius XMPP 1.0 (First Draft)-\end_layout--\begin_layout Author-The Pontarius Project-\end_layout--\begin_layout Date-15th of June, 2011-\end_layout--\begin_layout Standard-\begin_inset CommandInset toc-LatexCommand tableofcontents--\end_inset---\end_layout--\begin_layout Section-Introduction-\end_layout--\begin_layout Standard-Purpose-\end_layout--\begin_layout Standard-Scope-\end_layout--\begin_layout Standard-Definitions and acronyms-\end_layout--\begin_layout Section-References-\end_layout--\begin_layout Section-Decomposition description-\end_layout--\begin_layout Subsection-Module decomposition-\end_layout--\begin_layout Subsection-Concurrent process decomposition-\end_layout--\begin_layout Subsection-Data decomposition-\end_layout--\begin_layout Section-Dependency description-\end_layout--\begin_layout Subsection-Intermodule dependencies-\end_layout--\begin_layout Subsection-Interprocess dependencies-\end_layout--\begin_layout Subsection-Data dependencies-\end_layout--\begin_layout Section-Interface description-\end_layout--\begin_layout Subsection-Module interface-\end_layout--\begin_layout Subsubsection-Module 1 description-\end_layout--\begin_layout Subsubsection-Module 2 description-\end_layout--\begin_layout Subsection-Process interface-\end_layout--\begin_layout Subsubsection-Process 1 description-\end_layout--\begin_layout Subsubsection-Process 2 description-\end_layout--\begin_layout Section-Detailed design-\end_layout--\begin_layout Subsection-Module detailed design-\end_layout--\begin_layout Subsubsection-Module 1 detail-\end_layout--\begin_layout Subsubsection-Module 2 detail-\end_layout--\begin_layout Subsection-Data detailed design-\end_layout--\begin_layout Subsubsection-Module 1 detail-\end_layout--\begin_layout Subsubsection-Module 2 detail-\end_layout--\end_body-\end_document
− Documentation/Software Quality Assurance Plan for Pontarius XMPP 1.0.lyx
@@ -1,324 +0,0 @@-#LyX 2.0 created this file. For more info see http://www.lyx.org/-\lyxformat 413-\begin_document-\begin_header-\textclass article-\use_default_options true-\maintain_unincluded_children false-\language english-\language_package default-\inputencoding auto-\fontencoding global-\font_roman default-\font_sans default-\font_typewriter default-\font_default_family default-\use_non_tex_fonts false-\font_sc false-\font_osf false-\font_sf_scale 100-\font_tt_scale 100--\graphics default-\default_output_format default-\output_sync 0-\bibtex_command default-\index_command default-\paperfontsize default-\use_hyperref false-\papersize default-\use_geometry false-\use_amsmath 1-\use_esint 1-\use_mhchem 1-\use_mathdots 1-\cite_engine basic-\use_bibtopic false-\use_indices false-\paperorientation portrait-\suppress_date false-\use_refstyle 1-\index Index-\shortcut idx-\color #008000-\end_index-\secnumdepth 3-\tocdepth 3-\paragraph_separation indent-\paragraph_indentation default-\quotes_language english-\papercolumns 1-\papersides 1-\paperpagestyle default-\tracking_changes false-\output_changes false-\html_math_output 0-\html_css_as_file 0-\html_be_strict false-\end_header--\begin_body--\begin_layout Title-Software Quality Assurance Plan for Pontarius XMPP 1.0-\end_layout--\begin_layout Author-Jon Kristensen-\end_layout--\begin_layout Date-6th of June, 2011-\end_layout--\begin_layout Standard-\begin_inset CommandInset toc-LatexCommand tableofcontents--\end_inset---\end_layout--\begin_layout Section-Purpose-\end_layout--\begin_layout Standard-The purpose of writing this SQAP is not only to increase the quality of- Pontarius XMPP, but also to evaluate the use of the IEEE Standard for Software- Quality Assurance Plans (IEEE Std 730-1998) standard as well as meeting- the goals of a university course in IT quality management.- For information on the intended use of the software, please consult the- Pontarius XMPP 1.0 Software Requirement Specification.- The applicable portions of the software's life cycle from its first beta- until its disposal phase.-\end_layout--\begin_layout Section-Reference documents-\end_layout--\begin_layout Enumerate-IEEE Standard for Software Quality Assurance Plans (IEEE Std 730-1998)-\end_layout--\begin_layout Enumerate-Pontarius XMPP 1.0 Software Requirement Specification-\end_layout--\begin_layout Section-Legal notice-\end_layout--\begin_layout Standard-Pontarius XMPP is a free and open source software project.- The -\begin_inset Quotes eld-\end_inset--Pontarius project-\begin_inset Quotes erd-\end_inset-- is not a legal entity, but is like a synonym for Jon Kristensen.- Jon Kristensen does DOES NOT TAKE ANY RESPONSIBILITY OR OFFER ANY GUARANTEES- in regards to the software, its quality or this document.- Furthermore, the software is provided -\begin_inset Quotes eld-\end_inset--WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY- or FITNESS FOR A PARTICULAR PURPOSE-\begin_inset Quotes erd-\end_inset--.- Consult the GNU General Public License for more information.- This aspect particularly influences the next section of this document.-\end_layout--\begin_layout Section-Management-\end_layout--\begin_layout Standard-The -\begin_inset Quotes eld-\end_inset--organization-\begin_inset Quotes erd-\end_inset-- behind the software is the project founder, project leader, and copyright- holder Jon Kristensen, which acts in a -\begin_inset Quotes eld-\end_inset--benevolent dictator-\begin_inset Quotes erd-\end_inset-- position for the free and open source project.- The Pontarius project hopes that Pontarius XMPP will grow to become the- de-facto XMPP library for Haskell, and that we will get voluntary feedback- from multiple testers from different communities, such as the Haskell and- XMPP communities, as well as the free and open source software community- as a whole.- We will do what we can to organize and act on that feedback; however, the- only person that has currently even -\emph on-planned-\emph default- to perform software quality assurance activities is Jon Kristensen.-\end_layout--\begin_layout Standard-[Lifecycle of software, Sequence of tasks (with emphasis on activities),- relationships between tasks and major checkpoints]-\end_layout--\begin_layout Standard-(Testing API, extending Pontarius XMPP with a set of RFCs and/or XEPs, unit- testing, performance testing, stress testing, code (un)coverage...)-\end_layout--\begin_layout Section-Documentation-\end_layout--\begin_layout Subsection-Purpose-\end_layout--\begin_layout Subsection-Minimum documentation requirements-\end_layout--\begin_layout Subsubsection-Software Requirements Specification-\end_layout--\begin_layout Subsubsection-Software Design Description-\end_layout--\begin_layout Subsubsection-Software Verification and Validation Plan-\end_layout--\begin_layout Subsubsection-User Documentation-\end_layout--\begin_layout Subsubsection-Software Configuration Management Plan-\end_layout--\begin_layout Section-Standards, practices, conventions, and metrics-\end_layout--\begin_layout Subsection-Purpose-\end_layout--\begin_layout Subsection-Content-\end_layout--\begin_layout Section-Reviews and audits-\end_layout--\begin_layout Subsection-Purpose-\end_layout--\begin_layout Subsection-Minimum requirements-\end_layout--\begin_layout Subsection-Software Requirements Review-\end_layout--\begin_layout Subsection-Preliminary Design Review-\end_layout--\begin_layout Subsection-Critical Design Review-\end_layout--\begin_layout Subsection-Software Verification and Validation Plan Review-\end_layout--\begin_layout Subsubsection-Functional audit-\end_layout--\begin_layout Subsubsection-Physical audit-\end_layout--\begin_layout Subsubsection-In-process audits-\end_layout--\begin_layout Subsubsection-Manegerial reviews-\end_layout--\begin_layout Subsubsection-Software Configuration Management Plan Review-\end_layout--\begin_layout Subsubsection-Post-mortem review-\end_layout--\begin_layout Subsubsection-User Documentation Review-\end_layout--\begin_layout Subsection-Test-\end_layout--\begin_layout Section-Problem reporting and corrective actions-\end_layout--\begin_layout Section-Tools, technologies, and methodologies-\end_layout--\begin_layout Section-Code control-\end_layout--\begin_layout Section-Media control-\end_layout--\begin_layout Section-Supplier control-\end_layout--\begin_layout Section-Records collection, maintainance, and retention-\end_layout--\begin_layout Section-Training-\end_layout--\begin_layout Section-Risk management-\end_layout--\end_body-\end_document
Documentation/Software Requirements Specification for Pontarius XMPP.lyx view
@@ -61,7 +61,7 @@ \begin_body \begin_layout Title-Software Requirements Specification for Pontarius XMPP 0.1 (Second Draft)+Software Requirements Specification for Pontarius XMPP 0.1 (Third Draft) \end_layout \begin_layout Author@@ -69,7 +69,7 @@ \end_layout \begin_layout Date-6th of July 2011+27th of July 2011 \end_layout \begin_layout Standard@@ -113,9 +113,11 @@ \begin_layout Standard Pontarius XMPP 0.1 will implement the client capabilities of RFC 6120: XMPP:- Core and the depending specifications (such as RFC 6122: XMPP: Address- Format), as well as be easily extendable for different XMPP extensions- (such as XEPs and RFCs).+ Core and the depending specifications, such as RFC 6122: XMPP: Address+ Format, RFC 5246: The Transport Layer Security (TLS) Protocol Version 1.2,+ RFC 4422: Simple Authentication and Security Layer (SASL), RFC 5280: Internet+ X.509 Public Key Infrastructure Certificate and Certificate Revocation List+ (CRL) Profile, and Extensible Markup Language (XML) 1.0, among others. \end_layout \begin_layout Standard@@ -148,13 +150,14 @@ \end_inset solutions on top of Pontarius XMPP, we want Pontarius XMPP to be a general-purp-ose---and de facto---XMPP library for Haskell.- It should be correct, flexible and efficient to work in.+ose---and the de facto---XMPP library for Haskell.+ It should be correct and efficient to work in. \end_layout \begin_layout Standard We will not repeat the specifics of the requirements from the RFC 6120:- XMPP Core specification or other specifications in this document.+ XMPP Core specification and its depending specifications in this document+ unless we see any special reason to. \end_layout \begin_layout Subsection@@ -174,17 +177,8 @@ is not a legal entity, but is like a synonym for Jon Kristensen. Jon Kristensen does DOES NOT TAKE ANY RESPONSIBILITY OR OFFER ANY GUARANTEES in regards to the software, its requirements or this document.- Furthermore, the software is provided -\begin_inset Quotes eld-\end_inset--WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY- or FITNESS FOR A PARTICULAR PURPOSE-\begin_inset Quotes erd-\end_inset--.- Consult the GNU General Public License for more information.+ Furthermore, the software is provided WITHOUT ANY WARRANTY; without even+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. \end_layout \begin_layout Subsection@@ -201,6 +195,10 @@ \end_layout \begin_layout Description+PX01 Pontarius XMPP 0.1+\end_layout++\begin_layout Description REQ Requirement \end_layout @@ -230,12 +228,7 @@ \begin_layout Itemize Extensible Messaging and Presence Protocol (XMPP): Core, RFC 6120, March- 2011, Internet Engineering Task Force-\end_layout--\begin_layout Itemize-Extensible Messaging and Presence Protocol (XMPP): Address Format, RFC 6122,- March 2011, Internet Engineering Task Force+ 2011, Internet Engineering Task Force (see also its depending specifications) \end_layout \begin_layout Subsection@@ -244,9 +237,8 @@ \begin_layout Standard The second section provides an overall description of the requirements of- Pontarius XMPP 0.1, going through the features in a non-strict fashion,- talking shortly about the product functions, as well as some constraints- and assumptions.+ PX01, going through the features in a non-strict fashion, talking shortly+ about the product functions, as well as some constraints and assumptions. \end_layout \begin_layout Standard@@ -264,8 +256,8 @@ \end_layout \begin_layout Standard-Pontarius XMPP 0.1 will be used by XMPP clients to manage presence and messaging- in a uncentralized near-real-time environments.+PX01 will be used by XMPP clients to manage presence and messaging in a+ uncentralized near-real-time environments. For this first milestone of the library, we have chosen to implement only the XMPP: Core specification, and only the client capabilities of it. The reason for this is that we want to get the library out quickly, and@@ -277,32 +269,23 @@ \end_layout \begin_layout Standard-Pontarius XMPP 0.1 is designed to be used with Haskell.+PX01 is designed to be used with Haskell. \end_layout \begin_layout Standard-Pontarius XMPP 0.1 must work on GNU/Linux, the main Free Software operating- system.+PX01 must work on GNU/Linux, the main Free Software operating system. However, due to the platform support and high-level nature of Haskell, running it on other common operating systems is likely to work as well. \end_layout \begin_layout Standard-Pontarius XMPP 0.1 must work with (at least) the (estimated) most popular- free and open source software XMPP server.-\end_layout--\begin_layout Standard-The only software using Pontarius XMPP (that we know of) is the (currently- paused) Pontarius XPMN library, which currently in (very early) development.- However, as mentioned above, the goal for Pontarius XMPP is to serve as- a general-purpose library, so we are trying not to be customizing the library- to be somehow specially tailored for Pontarius XPMN.+PX01 must work with (at least) the (estimated) most popular free and open+ source software XMPP server that works with the specifics of our implementation+ (such as SCRAM). \end_layout \begin_layout Standard-Pontarius XMPP 0.1 depends on the below (free and open source software) Haskell- packages.+PX01 depends on the below (free and open source software) Haskell packages. I have omitted specification number [...]. I have also omitted the source, as they are all available on Hackage. \end_layout@@ -916,28 +899,27 @@ \end_layout \begin_layout Standard-Every Pontarius XMPP 0.1 client will open up at most one TCP port on the- system.- Pontarius XMPP in itself does not write anything to the file system storage- of the operating system, with the exception of the optional logging facility,+Every PX01 client will open up at most one TCP port on the system.+ PX01 in itself does not write anything to the file system storage of the+ operating system, with the exception of the optional logging facility, disabled by default, which may be configured to write to disk. \end_layout \begin_layout Standard-Pontarius XMPP 0.1 will not provide any spam protection.- However, we will utilize +We will utilize \emph on at least \emph default Transport Layer Security to help protect clients using the library from attacks.+ PX01 will not provide any spam protection. \end_layout \begin_layout Standard As we expect a very limited amount of concurrent XMPP clients, and a (relatively ) limited actitivity over XMPP streams--even when they are being fully active--w e are not specifying any detailed memory or (process) performance requirements- for Pontarius XMPP 0.1.+ for PX01. However, we will stress test the library. \end_layout @@ -950,12 +932,12 @@ \end_layout \begin_layout Standard-Pontarius XMPP 0.1 implements XMPP: Core and allow clients to do roughly- the following: Open a TCP connection to a server, exchange XML information- with the server to configure the (XML) stream, handle stream errors and- encoding issues, have the connection secured by TLS, authenticate using- a SASL mechanism and binding a resource to the stream, as well as sending- and receiving so-called XMPP stanzas, certain +PX01 implements XMPP: Core and allow clients to do roughly the following:+ Open a TCP connection to a server, exchange XML information with the server+ to configure the (XML) stream, handle stream errors and encoding issues,+ have the connection secured by TLS, authenticate using a SASL mechanism+ and binding a resource to the stream, as well as sending and receiving+ so-called XMPP stanzas, certain \begin_inset Quotes eld \end_inset @@ -971,9 +953,9 @@ \end_layout \begin_layout Standard-We expect developers using Pontarius XMPP 0.1 to understand the XMPP: Core- specification (and its depending specifications), Haskell, and monads,- including the StateT monad transformer.+We expect developers using PX01 to understand the XMPP: Core specification+ (and its depending specifications), Haskell, and monads, including the+ StateT monad transformer. \end_layout \begin_layout Subsection@@ -993,17 +975,7 @@ \begin_layout Standard We assume that the Glasgow Haskell Compiler (GHC) is available on the system- where Pontarius XMPP 0.1 applications are built.-\end_layout--\begin_layout Subsubsection-Apportioning of requirements -\end_layout--\begin_layout Standard-If IDNA2008 or the other stringprep-replacing specifications are not finished- or otherwise not suitable to implement, we will fall back to implementing- stringprep for Pontarius XMPP 0.1.+ where PX01 applications are built. \end_layout \begin_layout Section@@ -1034,7 +1006,8 @@ \begin_layout Description REQ-4 The system shall work against (at least) the (estimated) most popular- free and open source software XMPP server.+ free and open source software XMPP server supporting the features that+ we require (such as SCRAM). \end_layout \begin_layout Subsection@@ -1115,21 +1088,25 @@ stream, returning either a success value of the reason for failing. If the credentials were wrong, the system shall allow the client to make as many retries as allowed by the server, without restarting the stream.- Resource binding should be taken cared of in this step, and the client- should be able to try to set a resource as well as have one generated by- the server. \end_layout +\begin_layout Description+REQ-11 The API shall allow for perform resource binding on an authenticated+ stream, either by trying to set a specific resource, or have the server+ generate one.+\end_layout+ \begin_layout Standard-Rationale: Even though most clients wants to do REQ-9, REQ-10, and REQ-11- in one action, some uses of XMPP (such as In-Band Registration) demands- more flexibility.+Rationale: Even though most clients wants to do REQ-8, REQ-9, REQ-10, and+ REQ-11 in one action, some uses of XMPP (such as In-Band Registration)+ demands more flexibility. \end_layout \begin_layout Description-REQ-11 The API shall provide a convenience function for opening a stream,- securing the stream with TLS, and authenticating an XMPP account in one- function call, returning either a success value or the reason for failing.+REQ-12 The API shall provide a convenience function for opening a stream,+ securing the stream with TLS, authenticating an XMPP account, and perform+ resource binding in one function call, returning either a success value+ or the reason for failing. \end_layout \begin_layout Standard@@ -1138,16 +1115,16 @@ \end_layout \begin_layout Description-REQ-12 The API shall provide the possibility for clients to close the stream.+REQ-13 The API shall provide the possibility for clients to close the stream. \end_layout \begin_layout Description-REQ-13 The API shall provide the possibility for clients to send stream+REQ-14 The API shall provide the possibility for clients to send stream errors. \end_layout \begin_layout Description-REQ-14 The API shall allow a convenient way for +REQ-15 The API shall allow a convenient way for \begin_inset Quotes eld \end_inset @@ -1159,22 +1136,22 @@ \end_layout \begin_layout Description-REQ-15 The API shall provide a facility for convenient stanza (message,+REQ-16 The API shall provide a facility for convenient stanza (message, presence, info/query) creation, eliminating the risk of illegal stanzas where feasible. \end_layout \begin_layout Description-REQ-16 The API shall allow for convenient construction of JabberIDs.+REQ-17 The API shall allow for convenient construction of JabberIDs. \end_layout \begin_layout Description-REQ-17 The API shall provide utility functions to check whether or not a+REQ-18 The API shall provide utility functions to check whether or not a JID is full or bare. \end_layout \begin_layout Description-REQ-18 The API shall provide conversion functions to convert from a string+REQ-19 The API shall provide conversion functions to convert from a string to ( \begin_inset Quotes eld \end_inset@@ -1187,17 +1164,26 @@ \end_layout \begin_layout Description-REQ-19 The API shall provide an optional way for clients to receive time-out+REQ-20 The API shall provide an optional way for clients to receive time-out events on requests made, such as an IQ or connection attempt. The time-out interval should be customizable. \end_layout \begin_layout Description-REQ-20 The library should generate an internal infinite list of unique stanza+REQ-21 The library should generate an internal infinite list of unique stanza IDs; the API should provide a way for application developers to acquire any amount of such IDs \end_layout +\begin_layout Description+REQ-22 The system must offer timeout callbacks to be called if an asynchronous+ result is not guaranteed to be produced in a timely fashion.+\end_layout++\begin_layout Description+REQ-23 The system must a convenient API to deal with stanza and stream errors.+\end_layout+ \begin_layout Subsection Performance requirements \end_layout@@ -1207,18 +1193,18 @@ \end_layout \begin_layout Description-REQ-21 Regular desktop computers should be able to run hundreds of Pontarius+REQ-24 Regular desktop computers should be able to run hundreds of Pontarius XMPP 0.1 clients. \end_layout \begin_layout Description-REQ-22 Pontarius XMPP 0.1 should support virtually as many stanzas per second+REQ-25 Pontarius XMPP 0.1 should support virtually as many stanzas per second as (non-throttled) XMPP servers are able to route. This goes for both lightweight, heavy and mixed stanzas. \end_layout \begin_layout Description-REQ-23 Processing (parsing, generating, and firing the event) a received+REQ-26 Processing (parsing, generating, and firing the event) a received stanza should take at most 0.01 seconds. \end_layout @@ -1231,188 +1217,54 @@ \end_layout \begin_layout Description-REQ-24 The system shall support one persistant TCP stream/connection between+REQ-27 The system shall support one persistant TCP stream/connection between the XMPP client and the XMPP server. \end_layout \begin_layout Description-REQ-25 The system shall determine the proper IPv4 or IPv6 address of the- XMPP server, using the SRV Lookup process as explained in the 3.2.1 section- of XMPP: Core, the fallback process defined i 3.2.2, with the exception of- the case explained in 3.2.3.-\end_layout--\begin_layout Description-REQ-26 The system shall try to reconnect after a disconnection with a random- delay between 0 and 60 seconds.-\end_layout--\begin_layout Description-REQ-27 The system shall try to reconnect with increased delays, in accordance- with the -\begin_inset Quotes eld-\end_inset--truncated binary exponential backoff-\begin_inset Quotes erd-\end_inset---\begin_inset Foot-status open--\begin_layout Plain Layout-See the "Information technology - Telecommunications and information exchange- between systems - Local and metropolitan area networks - Specific requirements- - Part 3: Carrier sense multiple access with collision detection (CSMA/CD)- access method and physical layer specifications" section of IEEE Standard- 802.3, September 1998.-\end_layout--\end_inset--, if the first reconnection attempt fails.-\end_layout--\begin_layout Description-REQ-28 The system shall make use of TLS session resumption when reconnecting- to the server, if the connection was TLS secured.-\end_layout--\begin_layout Description-REQ-29 The system shall support stream management, as described in section- 4 of XMPP: Core.- This includes opening the stream, make the appropriate stream configurations- (such as stream properties and features), parse incoming data, restart- the stream when needed, determine the XMPP client's address, and properly- close the stream.-\end_layout--\begin_layout Description-REQ-30 The system shall support securing the stream with TLS, as described- in section 5 of XMPP: Core.+REQ-28 The system shall implement (at least) the TLS_RSA_WITH_AES_128_CBC_SHA+ cipher suite for TLS. \end_layout \begin_layout Description-REQ-31 The system shall support authenticating with SASL, as described in- section 6 of XMPP: Core.+REQ-29 The system shall support (at least) the SHA-1 variant of SASL Salted+ Challenge Response Authentication Mechanism (SCRAM-SHA-1). \end_layout \begin_layout Description-REQ-32 Being a client library, the system shall support the 'jabber:client'- namespace.- The 'jabber:server' namespace shall be out of scope for the client.- The client may use other namespaces if necessary, such as the ones for- TLS and SASL.+REQ-30 XML namespaces for stanzas should always be known to the client. \end_layout \begin_layout Description-REQ-33 XML namespaces for stanzas should always be known to the client.+REQ-31 We must validate incoming XML (though not against the XML schemas). \end_layout \begin_layout Description-REQ-34 The system shall always check for the appropriate features before+REQ-32 The system shall always check for the appropriate features before trying to use them. \end_layout \begin_layout Description-REQ-35 The system shall support and utilize the -\begin_inset Quotes eld-\end_inset--whitespace keep-alive-\begin_inset Quotes erd-\end_inset-- mechanism to signal and verify that the TCP connection is alive.-\end_layout--\begin_layout Description-REQ-36 The system shall support a distributed network of clients and servers.- Clients on one XMPP server should be able to communicate with server and- clients on other networks.-\end_layout--\begin_layout Description-REQ-37 The system shall support the <presence/> primitive, a specialized- -\begin_inset Quotes eld-\end_inset--publish-subscribe-\begin_inset Quotes erd-\end_inset-- mechanism for network availability.- End-to-end presence or anything else presence-related defined outside of- XMPP: Core (such as in XMPP: Instant Messaging) is +REQ-33 End-to-end presence or anything else presence-related defined outside+ of XMPP: Core (such as in XMPP: Instant Messaging) is \emph on not \emph default supported. \end_layout -\begin_layout Description-REQ-38 The system shall support the <message/> primitive, a -\begin_inset Quotes eld-\end_inset--push-\begin_inset Quotes erd-\end_inset-- mechanism.-\end_layout--\begin_layout Description-REQ-39 The system shall support the <iq/>, or Info/Query, primitive, a -\begin_inset Quotes eld-\end_inset--request-response-\begin_inset Quotes erd-\end_inset-- mechanism for exchanges of data.-\end_layout--\begin_layout Description-REQ-40 The system must offer timeout callbacks to be called if an asynchronous- result is not guaranteed to be produced in a timely fashion.-\end_layout--\begin_layout Description-REQ-41 The system must a convenient API to deal with stanza and stream errors.-\end_layout- \begin_layout Subsubsection RFC 6122: XMPP: Address Format \end_layout -\begin_layout Standard-As can be read in Section 1 of RFC 6122, the XMPP community has started- discussions about moving from the 2003 version of IDNA (Internationalized- Domain Names in Applications) to the new IDNA2008 standard.- Unlike its predecessor, this new standard is not based on Stringprep, and- RFC 6122 will be obsoleted when an alternative to the Nodeprep and Resourceprep- profiles has been completed.- XMPP software implementations are in encouraged by RFC 6122 to follow IDNA2008- instead, and Pontarius XMPP should try to do that.-\end_layout- \begin_layout Description-REQ-42 JIDs should be validated, transformed, and internationalized in accordanc-e with the successor to the stringprep profiles-\end_layout--\begin_layout Description-REQ-43 JIDs should support internationalization of node names, domain names,- and resource names, through IDNA2008.+REQ-34 JIDs should be validated, transformed, and internationalized in accordanc+e with the stringprep profiles Nodeprep, Nameprep, and Resourceprep. \end_layout \begin_layout Description-REQ-44 Dealing with JIDs should adhere to the security recommendations as- mentioned in section 4 of the standard.+REQ-35 JIDs should be able to use hostnames, IPv4 addresses, and IPv6 addresses,+ as domainparts. \end_layout \begin_layout Subsubsection@@ -1420,7 +1272,7 @@ \end_layout \begin_layout Description-REQ-45 The project and its source code shall adhere to the guidelines prestented+REQ-36 The project and its source code shall adhere to the guidelines prestented in the guidelines found at http://www.haskell.org/haskellwiki/Programming_guideli nes. \end_layout@@ -1430,7 +1282,7 @@ \end_layout \begin_layout Description-REQ-46 The system shall be +REQ-37 The system shall be \emph on extendable \emph default@@ -1438,7 +1290,7 @@ \end_layout \begin_layout Description-REQ-47 The system shall be +REQ-38 The system shall be \emph on reliable \emph default@@ -1447,7 +1299,7 @@ \end_layout \begin_layout Description-REQ-48 The system shall be +REQ-39 The system shall be \emph on secure \emph default
+ Documentation/Software Requirements Specification for Pontarius XMPP.pdf view
binary file changed (absent → 138639 bytes)
Examples/EchoClient.hs view
@@ -40,7 +40,7 @@ userName = "pontarius" serverIdentifier = "jonkristensen.com" portNumber = 5222-resource = "echo-client"+resource = "pontarius" password = "substrat44" @@ -89,7 +89,7 @@ sessionCreated = do state <- CMS.get connect (DM.fromJust $ stateSession state) hostName portNumber- (Just ("", \ x -> True)) (Just (userName, password, Just resource))+ Nothing (Just (userName, password, Just resource)) connectCallback id <- getID (DM.fromJust $ stateSession state) CMIC.liftIO $ putStrLn $ "Unique ID acquired: " ++ id
LICENSE view
@@ -1,4 +1,30 @@ Copyright © 2010-2011, Jon Kristensen. -Pontarius XMPP is licensed under GNU Lesser General Public License, version 3.-See COPYING and COPYING.LESSER for more information.+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.++ * The names of Jon Kristensen, the contributors of Pontarius XMPP, or the+ contributors of the Pontarius project may not 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 JON KRISTENSEN OR OTHER PONTARIUS XMPP OR+PONTARIUS DEVELOPERS 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.
Network/XMPP.hs view
@@ -1,58 +1,40 @@-{---Copyright © 2010-2011 Jon Kristensen.--This file is part of Pontarius XMPP.--Pontarius XMPP is free software: you can redistribute it and/or modify it under-the terms of the GNU Lesser General Public License as published by the Free-Software Foundation, either version 3 of the License, or (at your option) any-later version.--Pontarius XMPP 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 Lesser General Public License for more-details.--You should have received a copy of the GNU Lesser General Public License along-with Pontarius XMPP. If not, see <http://www.gnu.org/licenses/>.---}+-- Copyright © 2010-2011 Jon Kristensen. See the LICENSE file in the Pontarius+-- XMPP distribution for more details. --- | Module: $Header$--- Description: A minimalistic and easy-to-use XMPP library--- Copyright: Copyright © 2010-2011 Jon Kristensen--- License: LGPL-3+-- |+-- Module: $Header$+-- Description: Pontarius XMPP API+-- Copyright: Copyright © 2010-2011 Jon Kristensen+-- License: BSD3 ----- Maintainer: info@pontarius.org--- Stability: unstable--- Portability: portable---- Pontarius XMPP aims to be a secure, concurrent/event-based and easy-to-use--- XMPP library for Haskell. It is being actively developed.+-- Maintainer: info@pontarius.org+-- Stability: unstable+-- Portability: portable ----- Note that we are not recommending anyone to use Pontarius XMPP at this time--- as it's still in an experimental stage and will have its API and data types--- modified frequently. See the project's web site at--- <http://www.pontarius.org/> for more information.+-- XMPP is an open standard, extendable, and secure communications protocol+-- designed on top of XML, TLS, and SASL. Pontarius XMPP is an XMPP client+-- library, implementing the core capabilities of XMPP (RFC 6120). ----- This module will be documented soon.+-- Developers using this library are assumed to understand how XMPP works.+--+-- This module will be documented soon.+--+-- Note that we are not recommending anyone to use Pontarius XMPP at this time+-- as it's still in an experimental stage and will have its API and data types+-- modified frequently. See the project's web site at+-- <http://www.pontarius.org/> for more information. module Network.XMPP ( -- Network.XMPP.JID Address (..) , Localpart- , Serverpart+ , Domainpart , Resourcepart , isFull , isBare , fromString , fromStrings - -- Network.XMPP.SASL- , replyToChallenge1- -- Network.XMPP.Session- , Certificate , ClientHandler (..) , ClientState (..) , ConnectResult (..)@@ -67,8 +49,8 @@ , sendPresence , sendMessage , connect- , openStream- , secureWithTLS+ , openStreams+ , tlsSecureStreams , authenticate , session , OpenStreamResult (..)@@ -79,7 +61,7 @@ , StanzaID (SID) , From , To- , XMLLang+ , LangTag , MessageType (..) , Message (..) , PresenceType (..)@@ -88,12 +70,7 @@ , iqPayloadNamespace , iqPayload - , injectAction-- -- Network.XMPP.Utilities- , elementToString- , elementsToString- , getID ) where+ , injectAction ) where import Network.XMPP.Address import Network.XMPP.SASL
Network/XMPP/Address.hs view
@@ -1,26 +1,7 @@-{---Copyright © 2010-2011 Jon Kristensen.--This file is part of Pontarius XMPP.--Pontarius XMPP is free software: you can redistribute it and/or modify it under-the terms of the GNU Lesser General Public License as published by the Free-Software Foundation, either version 3 of the License, or (at your option) any-later version.--Pontarius XMPP 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 Lesser General Public License for more-details.--You should have received a copy of the GNU Lesser General Public License along-with Pontarius XMPP. If not, see <http://www.gnu.org/licenses/>.---}-+-- Copyright © 2010-2011 Jon Kristensen. See the LICENSE file in the Pontarius+-- XMPP distribution for more details. --- TODO: Move away from stringprep for all three profiles.+{-# OPTIONS_HADDOCK hide #-} -- TODO: When no longer using stringprep, do appropriate testing. (Including -- testing addresses like a@b/c@d/e, a/b@c, a@/b, a/@b...)@@ -28,21 +9,10 @@ -- TODO: Unicode 3.2 should be used. --- |--- Module: $Header$--- Description: Data type and utility functions for XMPP addresses (JIDs)--- Copyright: Copyright © 2010-2011 Jon Kristensen--- License: LGPL-3------ Maintainer: info@pontarius.org--- Stability: unstable--- Portability: portable--- -- This module deals with XMPP addresses (also known as JIDs and JabberIDs). For -- more information on XMPP addresses, see RFC 6122: XMPP: Address Format. ----- Provided hostnames may contain international characters; Pontarius XMPP will--- try to convert such hostnames to internationalized hostnames.+-- This module does not internationalize hostnames. module Network.XMPP.Address (fromString, fromStrings, isBare, isFull) where@@ -57,8 +27,6 @@ c3, c4, c5, c6, c7, c8, c9, runStringPrep) import Text.NamePrep (namePrepProfile) -import Data.Text.IDNA2008 (toASCII)- import Network.URI (isIPv4address, isIPv6address) import qualified Data.ByteString.Char8 as DBC (pack)@@ -70,25 +38,25 @@ fromString :: String -> Maybe Address -fromString s = fromStrings localpart serverpart resourcepart+fromString s = fromStrings localpart domainpart resourcepart where- Right (localpart, serverpart, resourcepart) =+ Right (localpart, domainpart, resourcepart) = parse addressParts "" (DBC.pack s) -- |--- Converts localpart, serverpart, and resourcepart strings to an XMPP address.+-- Converts localpart, domainpart, and resourcepart strings to an XMPP address. -- Runs the appropriate stringprep profiles and validates the parts. fromStrings :: Maybe String -> String -> Maybe String -> Maybe Address fromStrings l s r- | serverpart == Nothing = Nothing- | otherwise = if validateNonServerpart localpart &&- isJust serverpart' &&- validateNonServerpart resourcepart- then Just (Address localpart (fromJust serverpart') resourcepart)+ | domainpart == Nothing = Nothing+ | otherwise = if validateNonDomainpart localpart &&+ isJust domainpart' &&+ validateNonDomainpart resourcepart+ then Just (Address localpart (fromJust domainpart') resourcepart) else Nothing where @@ -100,10 +68,10 @@ Nothing -> Nothing Nothing -> Nothing - -- Applies the nameprep profile on the serverpart string.+ -- Applies the nameprep profile on the domainpart string. -- TODO: Allow unassigned?- serverpart :: Maybe String- serverpart = case runStringPrep (namePrepProfile False) (DT.pack s) of+ domainpart :: Maybe String+ domainpart = case runStringPrep (namePrepProfile False) (DT.pack s) of Just s' -> Just $ DT.unpack s' Nothing -> Nothing @@ -115,21 +83,26 @@ Nothing -> Nothing Nothing -> Nothing - -- Returns the serverpart if it was a valid IP or if the toASCII+ -- Returns the domainpart if it was a valid IP or if the toASCII -- function was successful, or Nothing otherwise.- serverpart' :: Maybe String- serverpart' | isIPv4address s || isIPv6address s = Just s- | otherwise = toASCII s+ domainpart' :: Maybe String+ domainpart' | isIPv4address s || isIPv6address s = Just s+ | validHostname s = Just s+ | otherwise = Nothing - -- Validates that non-serverpart strings have an appropriate length.- validateNonServerpart :: Maybe String -> Bool- validateNonServerpart Nothing = True- validateNonServerpart (Just l) = validPartLength l+ -- Validates that non-domainpart strings have an appropriate length.+ validateNonDomainpart :: Maybe String -> Bool+ validateNonDomainpart Nothing = True+ validateNonDomainpart (Just l) = validPartLength l where validPartLength :: String -> Bool validPartLength p = length p > 0 && length p < 1024 + -- Validates a host name+ validHostname :: String -> Bool+ validHostname _ = True -- TODO + -- | Returns True if the address is `bare', and False otherwise. isBare :: Address -> Bool@@ -156,7 +129,7 @@ -- Read until we reach an '@', a '/', or EOF. a <- many $ noneOf ['@', '/'] - -- Case 1: We found an '@', and thus the localpart. At least the serverpart+ -- Case 1: We found an '@', and thus the localpart. At least the domainpart -- is remaining. Read the '@' and until a '/' or EOF. do char '@'@@ -171,13 +144,13 @@ return (Just a, b, Just c) -- Case 1B: We have reached EOF; the address is in the form- -- localpart@serverpart.+ -- localpart@domainpart. <|> do eof return (Just a, b, Nothing) -- Case 2: We found a '/'; the address is in the form- -- serverpart/resourcepart.+ -- domainpart/resourcepart. <|> do char '/' b <- many $ anyToken@@ -185,7 +158,7 @@ return (Nothing, a, Just b) -- Case 3: We have reached EOF; we have an address consisting of only a- -- serverpart.+ -- domainpart. <|> do eof return (Nothing, a, Nothing)
Network/XMPP/SASL.hs view
@@ -1,40 +1,40 @@-{---Copyright © 2010-2011 Jon Kristensen.--This file is part of Pontarius XMPP.--Pontarius XMPP is free software: you can redistribute it and/or modify it under-the terms of the GNU Lesser General Public License as published by the Free-Software Foundation, either version 3 of the License, or (at your option) any-later version.--Pontarius XMPP 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 Lesser General Public License for more-details.--You should have received a copy of the GNU Lesser General Public License along-with Pontarius XMPP. If not, see <http://www.gnu.org/licenses/>.+-- Copyright © 2010-2011 Jon Kristensen. See the LICENSE file in the Pontarius+-- XMPP distribution for more details. --}+{-# OPTIONS_HADDOCK hide #-} -- TODO: Make it possible to include host. -- TODO: Host is assumed to be ISO 8859-1; make list of assumptions. -- TODO: Can it contain newline characters? -module Network.XMPP.SASL (replyToChallenge1) where+module Network.XMPP.SASL (replyToChallenge, saltedPassword, clientKey, storedKey, authMessage, clientSignature, clientProof, serverKey, serverSignature) where +import Prelude hiding (concat, zipWith) import Data.ByteString.Internal (c2w) import Data.Char (isLatin1) import Data.Digest.Pure.MD5-import qualified Data.Binary as DBi (Binary, encode) import qualified Data.ByteString.Lazy as DBL (ByteString, append, pack, fromChunks, toChunks, null) import qualified Data.ByteString.Lazy.Char8 as DBLC (append, pack, unpack) import qualified Data.List as DL+import Data.Text (empty, singleton)+import Text.StringPrep (StringPrepProfile (..), a1, b1, c12, c21, c22, c3, c4, c5, c6, c7, c8, c9, runStringPrep)+import Data.Ranges (inRanges, ranges) +import Crypto.HMAC (MacKey (MacKey), hmac)+import Crypto.Hash.SHA1 (SHA1, hash)+import Data.Bits (xor)+import Data.ByteString ()+import Data.ByteString.Lazy (ByteString, concat, fromChunks, pack, toChunks, zipWith)+import Data.Serialize (Serialize, encodeLazy)+import Data.Serialize.Put (putWord32be, runPutLazy) +import Data.Maybe (fromJust, isJust)++import qualified Data.Text as DT++import Text.StringPrep (runStringPrep)+ data Challenge1Error = C1MultipleCriticalAttributes | C1NotAllParametersPresent | C1SomeParamtersPresentMoreThanOnce |@@ -57,7 +57,7 @@ break' :: String -> Char -> (String, String) break' s' c = let (first, second) = break ((==) c) s' in (first, removeCharIfPresent second c)- + -- Removes the first character, if present; "=hello" with '=' becomes -- "hello". removeCharIfPresent :: String -> Char -> String@@ -91,125 +91,82 @@ lookup = lookupDirective di l --- Takes a challenge string (which is not Base64-encoded), the host name of the--- Jabber server, the Jabber user name (JID), the password and a random and--- unique "cnonce" value and generates either an error or a response to that--- challenge.+-- Implementation of "Hi()" as specified in the Notation section of RFC 5802+-- ("SCRAM"). It takes a string "str", a salt, and an interation count, and+-- returns an octet string. The iteration count must be greater than zero. --- We have broken replyToChallenge1 for non-TLS authentication. In order to--- change it back, just uncomment the lines relevant to the realm and match it--- in the C1NotAllParametersSet case.+hi :: ByteString -> ByteString -> Integer -> ByteString -replyToChallenge1 :: String -> String -> String -> String -> String ->- Either String Challenge1Error-replyToChallenge1 s h u p c =- -- Remove all new line characters.- let list = stringToList $ filter (/= '\n') s- in -- Count that there are no more than one nonce or algorithm directives.- case countDirectives "nonce" list <= 1 &&- countDirectives "algorithm" list <= 1 of- True ->- let -- realm = lookupDirective "realm" list- nonce = lookupDirective "nonce" list- qop = lookupDirectiveWithDefault "qop" list "auth"- charset = lookupDirectiveWithDefault "charset" list "utf-8"- algorithm = lookupDirective "algorithm" list- - -- Verify that all necessary directives has been set.- in case (nonce, qop, charset, algorithm) of- (Just nonce', qop', charset', Just algorithm') ->- - -- Strip quotations of the directives that need it.- let -- realm'' = stripQuotations realm'- nonce'' = stripQuotations nonce'- qop'' = stripQuotations qop' -- It seems ejabberd gives us an errorous "auth" instead of auth- in- -- -- Verify that the realm is the same as the Jabber host.- -- case realm'' == h of- -- True ->- - -- Verify that QOP is "auth", charset is "utf-8" and that- -- the algorithm is "md5-sess".- case qop'' == "auth" of- True ->- case charset' == "utf-8" of- True ->- case algorithm' == "md5-sess" of- True ->- - -- All data is valid; generate the reply.- Left (reply nonce'' qop'')- - -- Errors are caught and reported below.- False -> Right C1UnsupportedAlgorithm- False -> Right C1UnsupportedCharset- False -> Right C1UnsupportedQOP- -- False -> Right C1WrongRealm- _ -> Right C1NotAllParametersPresent- where- reply n q =- let -- We start with what's in RFC 2831 is referred to as "A1", a 16 octet- -- MD5 hash.- - -- If the username or password values are in ISO-8859-1, we convert- -- them to ISO-8859-1 strings.- username = case all isLatin1 u of- True -> DBL.pack $ map c2w u- False -> DBLC.pack $ u- password = case all isLatin1 p of- True -> DBL.pack $ map c2w p- False -> DBLC.pack p- - nc = "00000001"- digestUri = "xmpp/" ++ h- - -- Build the "{ username-value, ":", realm-value, ":", passwd }"- -- bytestring, the rest of the bytestring and then join them.- a1a = DBi.encode $ md5 $ DBLC.append- (DBLC.append username (DBLC.pack (":" ++ h ++ ":")))- password- a1aDebug = "DBi.encode $ md5 $ " ++ (DBLC.unpack $ DBLC.append- (DBLC.append username (DBLC.pack (":" ++ h ++ ":")))- password)- a1b = DBLC.pack (":" ++ n ++ ":" ++ c)- a1 = DBLC.append a1a a1b- - -- Generate the "A2" value.- a2 = DBLC.pack ("AUTHENTICATE:" ++ digestUri)- - -- Produce the responseValue.- k = DBLC.pack (show $ md5 a1)- colon = DBLC.pack ":"- s0 = DBLC.pack (n ++ ":" ++ nc ++ ":" ++ c ++ ":" ++- q ++ ":")- s1 = DBLC.pack $ show $ md5 a2- - s_ = DBLC.append s0 s1- -- append k:d and 16 octet hash it- kd = md5 (DBLC.append k (DBLC.append colon s_))- - lol0 = DBLC.unpack s_- lol1 = show kd- - response = show kd- in "username=\"" ++ u ++ "\",realm=\"" ++ h ++ "\",nonce=\"" ++ n ++- "\",cnonce=\"" ++ c ++ "\",nc=" ++ nc ++ ",digest-uri=\"" ++- digestUri ++ "\",qop=auth,response=" ++ response ++ ",charset=utf-8"- -- "\n\n" ++- -- "a1aDebug: " ++ a1aDebug ++ "\n" ++- -- "a1b: " ++ (DBLC.unpack a1b) ++ "\n" ++- -- "a1: " ++ (DBLC.unpack a1) ++ "\n" ++- -- "a2: " ++ (DBLC.unpack a2) ++ "\n" ++- -- "k: " ++ (DBLC.unpack k) ++ "\n" ++- -- "colon: " ++ (DBLC.unpack colon) ++ "\n" ++- -- "s0: " ++ (DBLC.unpack s0) ++ "\n" ++- -- "s1: " ++ (DBLC.unpack s1) ++ "\n" ++- -- "s_: " ++ (DBLC.unpack s_) ++ "\n"+hi str salt i | i > 0 = xorUs $ us (concat [salt, runPutLazy $ putWord32be 1]) i+ where + -- Calculates the U's (U1 ... Ui) using the HMAC algorithm+ us :: ByteString -> Integer -> [ByteString]+ us a 1 = [encodeLazy (hmac (MacKey (head $ toChunks str)) a :: SHA1)]+ us a x = [encodeLazy (hmac (MacKey (head $ toChunks str)) a :: SHA1)] ++ (us (encodeLazy (hmac (MacKey (head $ toChunks str)) a :: SHA1)) (x - 1)) + -- XORs the ByteStrings: U1 XOR U2 XOR ... XOR Ui+ xorUs :: [ByteString] -> ByteString+ xorUs (b:bs) = foldl (\ x y -> pack $ zipWith xor x y) b bs+++saltedPassword :: String -> ByteString -> Integer -> Maybe ByteString++saltedPassword password salt i = if isJust password' then Just $ hi (DBLC.pack $ DT.unpack $ fromJust password') salt i else Nothing+ where+ password' = runStringPrep saslprepProfile (DT.pack password)++clientKey :: ByteString -> ByteString++clientKey sp = encodeLazy (hmac (MacKey (head $ toChunks sp)) (DBLC.pack "Client Key") :: SHA1)+++storedKey :: ByteString -> ByteString++storedKey ck = fromChunks [hash $ head $ toChunks ck]+++authMessage :: String -> String -> String -> ByteString++authMessage cfmb sfm cfmwp = DBLC.pack $ cfmb ++ "," ++ sfm ++ "," ++ cfmwp+++clientSignature :: ByteString -> ByteString -> ByteString++clientSignature sk am = encodeLazy (hmac (MacKey (head $ toChunks sk)) am :: SHA1)+++clientProof :: ByteString -> ByteString -> ByteString++clientProof ck cs = pack $ zipWith xor ck cs+++serverKey :: ByteString -> ByteString++serverKey sp = encodeLazy (hmac (MacKey (head $ toChunks sp)) (DBLC.pack "Server Key") :: SHA1)+++serverSignature :: ByteString -> ByteString -> ByteString++serverSignature servkey am = encodeLazy (hmac (MacKey (head $ toChunks servkey)) am :: SHA1)+++-- TODO: Implement SCRAM.++replyToChallenge = replyToChallenge++ -- Stripts the quotations around a string, if any; "\"hello\"" becomes "hello". stripQuotations :: String -> String stripQuotations "" = "" stripQuotations s | (head s == '"') && (last s == '"') = tail $ init s | otherwise = s+++saslprepProfile :: StringPrepProfile++saslprepProfile = Profile { maps = [\ char -> if char `inRanges` (ranges c12) then singleton '\x0020' else singleton char, b1]+ , shouldNormalize = True+ , prohibited = [a1] ++ [c12, c21, c22, c3, c4, c5, c6, c7, c8, c9]+ , shouldCheckBidi = True }
Network/XMPP/Session.hs view
@@ -1,29 +1,5 @@-{---Copyright © 2010-2011 Jon Kristensen.--This file is part of Pontarius XMPP.--Pontarius XMPP is free software: you can redistribute it and/or modify it under-the terms of the GNU Lesser General Public License as published by the Free-Software Foundation, either version 3 of the License, or (at your option) any-later version.--Pontarius XMPP 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 Lesser General Public License for more-details.--You should have received a copy of the GNU Lesser General Public License along-with Pontarius XMPP. If not, see <http://www.gnu.org/licenses/>.---}---- TODO: Better functions and events for stanzas, IncomingIQ, OutgoingIQ, etc. (ClientSession, ClientStanza)---- TODO: IO function to do everything related to the handle, instead of just connecting.---- TODO: Enumerate in the same thread? Enumerate one element at the time, non-blocking?+-- Copyright © 2010-2011 Jon Kristensen. See the LICENSE file in the Pontarius+-- XMPP distribution for more details. -- I believe we need to use the MultiParamTypeClasses extension to be able to -- work with arbitrary client states (solving the problem that the ClientState@@ -31,16 +7,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} --- |--- Module: $Header$--- Description: XMPP client session management module--- Copyright: Copyright © 2010-2011 Jon Kristensen--- License: LGPL-3------ Maintainer: info@pontarius.org--- Stability: unstable--- Portability: portable---+{-# OPTIONS_HADDOCK hide #-}+ -- This module provides the functions used by XMPP clients to manage their XMPP -- sessions. --@@ -55,6 +23,12 @@ -- -- For more information, see the Pontarius XMPP Manual. +-- TODO: Better functions and events for stanzas, IncomingIQ, OutgoingIQ, etc. (ClientSession, ClientStanza)++-- TODO: IO function to do everything related to the handle, instead of just connecting.++-- TODO: Enumerate in the same thread? Enumerate one element at the time, non-blocking?+ module Network.XMPP.Session ( ClientHandler (..) , ClientState (..) , ConnectResult (..)@@ -67,8 +41,8 @@ , sendIQ , sendMessage , connect- , openStream- , secureWithTLS+ , openStreams+ , tlsSecureStreams , authenticate , session , injectAction@@ -90,6 +64,8 @@ ------------- +import Crypto.Random (newGenIO, SystemRandom)+ import Control.Concurrent.MVar import Codec.Binary.UTF8.String@@ -119,8 +95,14 @@ import qualified Data.Text as DT import qualified Data.Text.Lazy as DTL +import Data.Certificate.X509 (X509) +import Data.UUID (UUID, toString) +import System.Random (randomIO)+++ -- ============================================================================= -- EXPORTED TYPES AND FUNCTIONS -- =============================================================================@@ -218,8 +200,8 @@ , stateConnectionState = Disconnected , stateStreamState = PreStream , stateTLSState = NoTLS- , stateOpenStreamCallback = Nothing- , stateSecureWithTLSCallback = Nothing+ , stateOpenStreamsCallback = Nothing+ , stateTLSSecureStreamsCallback = Nothing , stateAuthenticateCallback = Nothing , stateAuthenticationState = NoAuthentication , stateResource = Nothing@@ -229,20 +211,26 @@ , stateMessageCallbacks = [] , stateIQCallbacks = [] , stateTimeoutStanzaIDs = []- , stateIDGenerator = i } -- TODO: Prefix+ , stateIDGenerator = i+ , stateSASLRValue = Nothing } -- TODO: Prefix +-- |+-- Convenience function for calling "openStreams" and "tlsSecureStreams" and\/or+-- "authenticate". See the documentation for the three separate functions for+-- details on how they operate.+ connect :: MonadIO m => Session s m -> HostName -> PortNumber ->- Maybe (Certificate, (Certificate -> Bool)) ->+ Maybe (Maybe [X509], ([X509] -> Bool)) -> Maybe (UserName, Password, Maybe Resource) -> (ConnectResult -> StateT s m ()) -> StateT s m () -connect s h p t a c = openStream s h p connect'+connect s h p t a c = openStreams s h p connect' where connect' r = case r of OpenStreamSuccess _ _ -> case t of -- TODO: Check for TLS support? Just (certificate, certificateValidator) ->- secureWithTLS s certificate certificateValidator connect''+ tlsSecureStreams s certificate certificateValidator connect'' Nothing -> connect'' (SecureWithTLSSuccess 1.0 "") -- TODO OpenStreamFailure -> c ConnectOpenStreamFailure connect'' r = case r of@@ -257,19 +245,38 @@ AuthenticateFailure -> c ConnectAuthenticateFailure -openStream :: MonadIO m => Session s m -> HostName -> PortNumber ->+openStreams :: MonadIO m => Session s m -> HostName -> PortNumber -> (OpenStreamResult -> StateT s m ()) -> StateT s m () -openStream s h p c = CMS.get >>=+openStreams s h p c = CMS.get >>= (\ state -> lift $ liftIO $ writeChan (sessionChannel s) (IEC (CEOpenStream h p c))) -secureWithTLS :: MonadIO m => Session s m -> Certificate ->- (Certificate -> Bool) ->- (SecureWithTLSResult -> StateT s m ()) -> StateT s m ()+-- |+-- Tries to secure the connection with TLS.+--+-- If the list of certificates is provided, they will be presented to the+-- server.+--+-- The third parameter is an optional custom validation function for the server+-- certificates. Note that Pontarius XMPP will perform its own validation+-- according to the RFC 6120, including comparing the domain name specified in+-- the certificate against the connected server, as well as checking the+-- integrity, and the certificate authorities.+--+-- Note: The current implementation of `certificate' looks for trusted+-- certificates in the /etc/ssl/certs directory.+--+-- Note: The current implementation of `certificate' does not support parsing+-- X509 extensions. Because of this, we will defer checking CRLs and/or OCSP+-- services as well as checking for the basicConstraints cA boolean for the+-- time-being. -secureWithTLS s c a c_ = CMS.get >>=+tlsSecureStreams :: MonadIO m => Session s m -> Maybe [X509] ->+ ([X509] -> Bool) -> (SecureWithTLSResult -> StateT s m ()) -> StateT s m ()++tlsSecureStreams s c a c_ = CMS.get >>= (\ state -> lift $ liftIO $ writeChan (sessionChannel s) (IEC (CESecureWithTLS c a c_)))@@ -344,8 +351,8 @@ , stateConnectionState :: ConnectionState -- s m , stateTLSState :: TLSState , stateStreamState :: StreamState- , stateOpenStreamCallback :: OpenStreamCallback s m- , stateSecureWithTLSCallback :: SecureWithTLSCallback s m+ , stateOpenStreamsCallback :: OpenStreamCallback s m+ , stateTLSSecureStreamsCallback :: SecureWithTLSCallback s m , stateAuthenticateCallback :: AuthenticateCallback s m , stateAuthenticationState :: AuthenticationState , stateResource :: Maybe Resource@@ -356,6 +363,7 @@ , stateIQCallbacks :: [(StanzaID, (IQ -> StateT s m Bool))] , stateTimeoutStanzaIDs :: [StanzaID] , stateIDGenerator :: IDGenerator+ , stateSASLRValue :: Maybe String } @@ -421,7 +429,7 @@ Right handle -> do put $ state { stateConnectionState = Connected (ServerAddress hostName portNumber') handle , stateStreamState = PreStream- , stateOpenStreamCallback = Just callback }+ , stateOpenStreamsCallback = Just callback } lift $ liftIO $ hSetBuffering handle NoBuffering lift $ liftIO $ send ("<?xml version='1.0'?><stream:stream to='" ++ hostName ++ "' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.or" ++@@ -440,7 +448,7 @@ let Connected _ handle = stateConnectionState state lift $ liftIO $ send "<starttls xmlns='urn:ietf:params:xml:ns:xmpp-tls'/>" (Left handle) put $ state { stateStreamState = PreStream- , stateSecureWithTLSCallback = Just callback }+ , stateTLSSecureStreamsCallback = Just callback } return Nothing -- TODO: Save callback in state.@@ -448,103 +456,102 @@ -- CEB.assert (or [ stateConnectionState state == Connected -- , stateConnectionState state == TLSSecured ]) (return ()) -- CEB.assert (stateHandle state /= Nothing) (return ())+ -- let Connected (ServerAddress hostName _) _ = stateConnectionState state+ rValue <- lift $ liftIO $ randomIO put $ state { stateAuthenticationState = AuthenticatingPreChallenge1 userName password resource- , stateAuthenticateCallback = Just callback }- lift $ liftIO $ send "<auth xmlns='urn:ietf:params:xml:ns:xmpp-sasl' mechanism='DIGEST-MD5'/>" handleOrTLSCtx+ , stateAuthenticateCallback = Just callback+ , stateSASLRValue = Just (toString rValue) }+ lift $ liftIO $ putStrLn $ "__________" ++ ("<auth xmlns='urn:ietf:params:xml:ns:xmpp-sasl' mechanism='SCRAM-SHA-1'>" ++ (CBBS.encode ("n,,n=" ++ userName ++ ",r=" ++ (toString rValue))) ++ "</auth>")+ lift $ liftIO $ send ("<auth xmlns='urn:ietf:params:xml:ns:xmpp-sasl' mechanism='SCRAM-SHA-1'>" ++ (CBBS.encode ("n,,n=" ++ userName ++ ",r=" ++ (toString rValue))) ++ "</auth>") handleOrTLSCtx return Nothing - IEE (EnumeratorXML (XEBeginStream stream)) -> do+ IEE (EnumeratorBeginStream from to id ver lang namespace) -> do put $ state { stateStreamState = PreFeatures (1.0) } return Nothing - IEE (EnumeratorXML (XEFeatures features)) -> do- let PreFeatures streamProperties = stateStreamState state- case stateTLSState state of- NoTLS -> let callback = fromJust $ stateOpenStreamCallback state in do- ((), clientState) <- lift $ runStateT (callback $ OpenStreamSuccess streamProperties "TODO") (stateClientState state)- put $ state { stateClientState = clientState- , stateStreamState = PostFeatures streamProperties "TODO" }- return Nothing- _ -> case stateAuthenticationState state of- AuthenticatedUnbound _ resource -> do -- TODO: resource- case resource of- Nothing -> do- lift $ liftIO $ send ("<iq type=\"set\" id=\"bind_1\"><bind xmlns=\"urn:ietf:param" ++ "s:xml:ns:xmpp-bind\"></bind></iq>") handleOrTLSCtx- return ()- _ -> do- lift $ liftIO $ send ("<iq type=\"set\" id=\"bind_1\"><bind xmlns=\"urn:ietf:param" ++ "s:xml:ns:xmpp-bind\"><resource>" ++ fromJust resource ++ "</resource></bind></iq>") handleOrTLSCtx- return ()- id <- liftIO $ nextID $ stateIDGenerator state- lift $ liftIO $ send ("<iq type=\"set\" id=\"" ++ id ++ "\"><session xmlns=\"urn:ietf:params:xml:ns:xmpp-session\"/>" ++ "</iq>") handleOrTLSCtx-- -- TODO: Execute callback on iq result-- let callback = fromJust $ stateAuthenticateCallback state in do -- TODO: streamProperties "TODO" after success- ((), clientState) <- lift $ runStateT (callback $ AuthenticateSuccess streamProperties "TODO" "todo") (stateClientState state) -- get proper resource value when moving to iq result- put $ state { stateClientState = clientState- , stateStreamState = PostFeatures streamProperties "TODO" }- state' <- get- return Nothing- _ -> do- let callback = fromJust $ stateSecureWithTLSCallback state in do- ((), clientState) <- lift $ runStateT (callback $ SecureWithTLSSuccess streamProperties "TODO") (stateClientState state)- put $ state { stateClientState = clientState- , stateStreamState = PostFeatures streamProperties "TODO" }- return Nothing-- -- TODO: Can we assume that it's safe to start to enumerate on handle when it- -- might not have exited?- IEE (EnumeratorXML XEProceed) -> do- let Connected (ServerAddress hostName _) handle = stateConnectionState state- tlsCtx <- lift $ liftIO $ handshake' handle hostName- let tlsCtx_ = fromJust tlsCtx- put $ (defaultState (stateChannel state) (stateThreadID state) (stateClientHandlers state) (stateClientState state) (stateIDGenerator state)) { stateTLSState = PostHandshake tlsCtx_, stateConnectionState = (stateConnectionState state), stateSecureWithTLSCallback = (stateSecureWithTLSCallback state) }- threadID <- lift $ liftIO $ forkIO $ xmlEnumerator (stateChannel state) (Right tlsCtx_) -- double code- lift $ liftIO $ putStrLn "00000000000000000000000000000000"- lift $ liftIO $ swapMVar (stateThreadID state) threadID -- return value not used- lift $ liftIO $ putStrLn "00000000000000000000000000000000"- lift $ liftIO $ threadDelay 1000000- lift $ liftIO $ putStrLn "00000000000000000000000000000000"- lift $ liftIO $ send ("<?xml version='1.0'?><stream:stream to='" ++- hostName ++ "' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/" ++- "streams' version='1.0'>") (Right tlsCtx_)- lift $ liftIO $ putStrLn "00000000000000000000000000000000"- return Nothing-- IEE (EnumeratorXML (XEChallenge (Chal challenge))) -> do- let serverHost = "jonkristensen.com"- let challenge' = CBBS.decode challenge- case stateAuthenticationState state of- AuthenticatingPreChallenge1 userName password resource -> do- id <- liftIO $ nextID $ stateIDGenerator state- -- This is the first challenge - we need to calculate the reply- case replyToChallenge1 challenge' serverHost userName password id of- Left reply -> do- let reply' = (filter (/= '\n') (CBBS.encode reply))- lift $ liftIO $ send ("<response xmlns='urn:ietf:params:xml:ns:xmpp-sasl'>" ++ reply' ++ "</response>") handleOrTLSCtx- put $ state { stateAuthenticationState = AuthenticatingPreChallenge2 userName password resource }- return ()- Right error -> do- state' <- get- lift $ liftIO $ putStrLn $ show error- return ()- AuthenticatingPreChallenge2 userName password resource -> do- -- This is not the first challenge; [...]- -- TODO: Can we assume "rspauth"?- lift $ liftIO $ send "<response xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/>" handleOrTLSCtx- put $ state { stateAuthenticationState = AuthenticatingPreSuccess userName password resource }- return ()- return Nothing-- -- We have received a SASL "success" message over a secured connection- -- TODO: Parse the success message?- -- TODO: <?xml version='1.0'?>?- IEE (EnumeratorXML (XESuccess (Succ _))) -> do- let serverHost = "jonkristensen.com"- let AuthenticatingPreSuccess userName _ resource = stateAuthenticationState state in do- lift $ liftIO $ send ("<?xml version='1.0'?><stream:stream to='" ++ serverHost ++ "' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/" ++ "streams' version='1.0'>") handleOrTLSCtx- put $ state { stateAuthenticationState = AuthenticatedUnbound userName resource }- return Nothing+-- IEE (EnumeratorXML (XEFeatures features)) -> do+-- let PreFeatures streamProperties = stateStreamState state+-- case stateTLSState state of+-- NoTLS -> let callback = fromJust $ stateOpenStreamsCallback state in do+-- ((), clientState) <- lift $ runStateT (callback $ OpenStreamSuccess streamProperties "TODO") (stateClientState state)+-- put $ state { stateClientState = clientState+-- , stateStreamState = PostFeatures streamProperties "TODO" }+-- return Nothing+-- _ -> case stateAuthenticationState state of+-- AuthenticatedUnbound _ resource -> do -- TODO: resource+-- case resource of+-- Nothing -> do+-- lift $ liftIO $ send ("<iq type=\"set\" id=\"bind_1\"><bind xmlns=\"urn:ietf:param" ++ "s:xml:ns:xmpp-bind\"></bind></iq>") handleOrTLSCtx+-- return ()+-- _ -> do+-- lift $ liftIO $ send ("<iq type=\"set\" id=\"bind_1\"><bind xmlns=\"urn:ietf:param" ++ "s:xml:ns:xmpp-bind\"><resource>" ++ fromJust resource ++ "</resource></bind></iq>") handleOrTLSCtx+-- return ()+-- id <- liftIO $ nextID $ stateIDGenerator state+-- lift $ liftIO $ send ("<iq type=\"set\" id=\"" ++ id ++ "\"><session xmlns=\"urn:ietf:params:xml:ns:xmpp-session\"/>" ++ "</iq>") handleOrTLSCtx+--+-- -- TODO: Execute callback on iq result+--+-- let callback = fromJust $ stateAuthenticateCallback state in do -- TODO: streamProperties "TODO" after success+-- ((), clientState) <- lift $ runStateT (callback $ AuthenticateSuccess streamProperties "TODO" "todo") (stateClientState state) -- get proper resource value when moving to iq result+-- put $ state { stateClientState = clientState+-- , stateStreamState = PostFeatures streamProperties "TODO" }+-- state' <- get+-- return Nothing+-- _ -> do+-- let callback = fromJust $ stateTLSSecureStreamsCallback state in do+-- ((), clientState) <- lift $ runStateT (callback $ SecureWithTLSSuccess streamProperties "TODO") (stateClientState state)+-- put $ state { stateClientState = clientState+-- , stateStreamState = PostFeatures streamProperties "TODO" }+-- return Nothing+--+-- -- TODO: Can we assume that it's safe to start to enumerate on handle when it+-- -- might not have exited?+-- IEE (EnumeratorXML XEProceed) -> do+-- let Connected (ServerAddress hostName _) handle = stateConnectionState state+-- tlsCtx <- lift $ liftIO $ do+-- gen <- newGenIO :: IO SystemRandom -- TODO: Investigate limitations+-- clientContext <- client tlsParams gen handle+-- handshake clientContext+-- return clientContext+-- put $ (defaultState (stateChannel state) (stateThreadID state) (stateClientHandlers state) (stateClientState state) (stateIDGenerator state)) { stateTLSState = PostHandshake tlsCtx, stateConnectionState = (stateConnectionState state), stateTLSSecureStreamsCallback = (stateTLSSecureStreamsCallback state) }+-- threadID <- lift $ liftIO $ forkIO $ xmlEnumerator (stateChannel state) (Right tlsCtx) -- double code+-- lift $ liftIO $ putStrLn "00000000000000000000000000000000"+-- lift $ liftIO $ swapMVar (stateThreadID state) threadID -- return value not used+-- lift $ liftIO $ putStrLn "00000000000000000000000000000000"+-- lift $ liftIO $ threadDelay 1000000+-- lift $ liftIO $ putStrLn "00000000000000000000000000000000"+-- lift $ liftIO $ send ("<?xml version='1.0'?><stream:stream to='" +++-- hostName ++ "' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/" +++-- "streams' version='1.0'>") (Right tlsCtx)+-- lift $ liftIO $ putStrLn "00000000000000000000000000000000"+-- return Nothing+--+-- IEE (EnumeratorXML (XEChallenge (Chal challenge))) -> do+-- lift $ liftIO $ putStrLn challenge+-- let Connected (ServerAddress hostName _) _ = stateConnectionState state+-- let challenge' = CBBS.decode challenge+-- case stateAuthenticationState state of+-- AuthenticatingPreChallenge1 userName password resource -> do+-- id <- liftIO $ nextID $ stateIDGenerator state+-- -- TODO: replyToChallenge+-- return ()+-- AuthenticatingPreChallenge2 userName password resource -> do+-- -- This is not the first challenge; [...]+-- -- TODO: Can we assume "rspauth"?+-- lift $ liftIO $ send "<response xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/>" handleOrTLSCtx+-- put $ state { stateAuthenticationState = AuthenticatingPreSuccess userName password resource }+-- return ()+-- return Nothing+--+-- -- We have received a SASL "success" message over a secured connection+-- -- TODO: Parse the success message?+-- -- TODO: <?xml version='1.0'?>?+-- IEE (EnumeratorXML (XESuccess (Succ _))) -> do+-- let serverHost = "jonkristensen.com"+-- let AuthenticatingPreSuccess userName _ resource = stateAuthenticationState state in do+-- lift $ liftIO $ send ("<?xml version='1.0'?><stream:stream to='" ++ serverHost ++ "' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/" ++ "streams' version='1.0'>") handleOrTLSCtx+-- put $ state { stateAuthenticationState = AuthenticatedUnbound userName resource }+-- return Nothing IEE EnumeratorDone -> -- TODO: Exit?@@ -554,64 +561,67 @@ -- XML EVENTS -- --------------------------------------------------------------------------- - -- Ignore id="bind_1" and session IQ result, otherwise create client event- IEE (EnumeratorXML (XEIQ iqEvent)) ->- case shouldIgnoreIQ iqEvent of- True ->- return Nothing- False -> do- let stanzaID' = iqID iqEvent- let newTimeouts = case stanzaID' of- Just stanzaID'' ->- case stanzaID'' `elem` (stateTimeoutStanzaIDs state) of- True -> filter (\ e -> e /= stanzaID'') (stateTimeoutStanzaIDs state)- False -> (stateTimeoutStanzaIDs state)- Nothing -> (stateTimeoutStanzaIDs state)- let iqReceivedFunctions = map (\ x -> iqReceived x) (stateClientHandlers state)- let functions = map (\ x -> case x of- Just f -> Just (f iqEvent)- Nothing -> Nothing) iqReceivedFunctions- let functions' = case lookup (fromJust $ iqID $ iqEvent) (stateIQCallbacks state) of- Just f -> (Just (f $ iqEvent)):functions- Nothing -> functions- let clientState = stateClientState state- clientState' <- sendToClient functions' clientState- put $ state { stateClientState = clientState', stateTimeoutStanzaIDs = newTimeouts }- return Nothing-- IEE (EnumeratorXML (XEPresence presenceEvent)) -> do- let stanzaID' = presenceID $ presenceEvent- let newTimeouts = case stanzaID' of- Just stanzaID'' ->- case stanzaID'' `elem` (stateTimeoutStanzaIDs state) of- True -> filter (\ e -> e /= stanzaID'') (stateTimeoutStanzaIDs state)- False -> (stateTimeoutStanzaIDs state)- Nothing -> (stateTimeoutStanzaIDs state)- let presenceReceivedFunctions = map (\ x -> presenceReceived x) (stateClientHandlers state)- let functions = map (\ x -> case x of- Just f -> Just (f presenceEvent)- Nothing -> Nothing) presenceReceivedFunctions- let clientState = stateClientState state -- ClientState s m- clientState' <- sendToClient functions clientState- put $ state { stateClientState = clientState', stateTimeoutStanzaIDs = newTimeouts }- return Nothing-- IEE (EnumeratorXML (XEMessage messageEvent)) -> do- let stanzaID' = messageID $ messageEvent- let newTimeouts = case stanzaID' of- Just stanzaID'' ->- case stanzaID'' `elem` (stateTimeoutStanzaIDs state) of- True -> filter (\ e -> e /= stanzaID'') (stateTimeoutStanzaIDs state)- False -> (stateTimeoutStanzaIDs state)- Nothing -> (stateTimeoutStanzaIDs state)- let messageReceivedFunctions = map (\ x -> messageReceived x) (stateClientHandlers state)- let functions = map (\ x -> case x of- Just f -> Just (f messageEvent)- Nothing -> Nothing) messageReceivedFunctions- let clientState = stateClientState state -- ClientState s m- clientState' <- sendToClient functions clientState- put $ state { stateClientState = clientState', stateTimeoutStanzaIDs = newTimeouts }- return Nothing+-- -- Ignore id="bind_1" and session IQ result, otherwise create client event+-- IEE (EnumeratorXML (XEIQ iqEvent)) ->+-- case shouldIgnoreIQ iqEvent of+-- True ->+-- return Nothing+-- False -> do+-- let stanzaID' = iqID iqEvent+-- let newTimeouts = case stanzaID' of+-- Just stanzaID'' ->+-- case stanzaID'' `elem` (stateTimeoutStanzaIDs state) of+-- True -> filter (\ e -> e /= stanzaID'') (stateTimeoutStanzaIDs state)+-- False -> (stateTimeoutStanzaIDs state)+-- Nothing -> (stateTimeoutStanzaIDs state)+-- let iqReceivedFunctions = map (\ x -> iqReceived x) (stateClientHandlers state)+-- let functions = map (\ x -> case x of+-- Just f -> Just (f iqEvent)+-- Nothing -> Nothing) iqReceivedFunctions+-- let functions' = case lookup (fromJust $ iqID $ iqEvent) (stateIQCallbacks state) of+-- Just f -> (Just (f $ iqEvent)):functions+-- Nothing -> functions+-- let clientState = stateClientState state+-- clientState' <- sendToClient functions' clientState+-- put $ state { stateClientState = clientState', stateTimeoutStanzaIDs = newTimeouts }+-- return Nothing+--+-- -- TODO: Known bug - does not work with PresenceError+--+-- IEE (EnumeratorXML (XEPresence (Right presenceEvent))) -> do+-- let stanzaID' = presenceID $ presenceEvent+-- let newTimeouts = case stanzaID' of+-- Just stanzaID'' ->+-- case stanzaID'' `elem` (stateTimeoutStanzaIDs state) of+-- True -> filter (\ e -> e /= stanzaID'') (stateTimeoutStanzaIDs state)+-- False -> (stateTimeoutStanzaIDs state)+-- Nothing -> (stateTimeoutStanzaIDs state)+-- let presenceReceivedFunctions = map (\ x -> presenceReceived x) (stateClientHandlers state)+-- let functions = map (\ x -> case x of+-- Just f -> Just (f presenceEvent)+-- Nothing -> Nothing) presenceReceivedFunctions+-- let clientState = stateClientState state -- ClientState s m+-- clientState' <- sendToClient functions clientState+-- put $ state { stateClientState = clientState', stateTimeoutStanzaIDs = newTimeouts }+-- return Nothing+--+-- -- TODO: Does not work with message errors+-- IEE (EnumeratorXML (XEMessage (Right messageEvent))) -> do+-- let stanzaID' = messageID $ messageEvent+-- let newTimeouts = case stanzaID' of+-- Just stanzaID'' ->+-- case stanzaID'' `elem` (stateTimeoutStanzaIDs state) of+-- True -> filter (\ e -> e /= stanzaID'') (stateTimeoutStanzaIDs state)+-- False -> (stateTimeoutStanzaIDs state)+-- Nothing -> (stateTimeoutStanzaIDs state)+-- let messageReceivedFunctions = map (\ x -> messageReceived x) (stateClientHandlers state)+-- let functions = map (\ x -> case x of+-- Just f -> Just (f messageEvent)+-- Nothing -> Nothing) messageReceivedFunctions+-- let clientState = stateClientState state -- ClientState s m+-- clientState' <- sendToClient functions clientState+-- put $ state { stateClientState = clientState', stateTimeoutStanzaIDs = newTimeouts }+-- return Nothing IEC (CEPresence presence stanzaCallback timeoutCallback streamErrorCallback) -> do presence' <- case presenceID $ presence of@@ -626,8 +636,8 @@ put $ state { stateTimeoutStanzaIDs = stanzaID':(stateTimeoutStanzaIDs state) } Nothing -> return ()- let xml = presenceToXML presence'- lift $ liftIO $ send xml handleOrTLSCtx+ let xml = presenceToXML (Right presence') (fromJust $ langTag "en")+ lift $ liftIO $ send (elementToString $ Just xml) handleOrTLSCtx return Nothing IEC (CEMessage message stanzaCallback timeoutCallback streamErrorCallback) -> do@@ -643,25 +653,19 @@ put $ state { stateTimeoutStanzaIDs = stanzaID':(stateTimeoutStanzaIDs state) } Nothing -> return ()- let xml = messageToXML message'- lift $ liftIO $ send xml handleOrTLSCtx+ let xml = messageToXML (Right message') (fromJust $ langTag "en")+ lift $ liftIO $ send (elementToString $ Just xml) handleOrTLSCtx return Nothing + -- TODO: Known bugs until Session rewritten - new ID everytime, callback not called+ IEC (CEIQ iq stanzaCallback timeoutCallback stanzaErrorCallback) -> do- iq' <- case iqID iq of- Nothing -> do+ iq' <- do -- case iqID iq of+ -- Nothing -> do id <- liftIO $ nextID $ stateIDGenerator state- return $ case iq of- IQReq r -> do- IQReq (r { iqRequestID = Just (SID id) })- IQRes r -> do- IQRes (r { iqResponseID = Just (SID id) })- _ -> return iq- case stanzaCallback of- Just callback' -> case iq of- IQReq {} -> put $ state { stateIQCallbacks = (fromJust $ iqID iq, callback'):(stateIQCallbacks state) }- _ -> return ()- Nothing -> return ()+ return iq+ let callback' = fromJust stanzaCallback+ put $ state { stateIQCallbacks = (fromJust $ iqID iq, callback'):(stateIQCallbacks state) } case timeoutCallback of Just (t, timeoutCallback') -> let stanzaID' = (fromJust $ iqID iq') in do@@ -670,8 +674,8 @@ Nothing -> return () -- TODO: Bind ID to callback- let xml = iqToXML iq'- lift $ liftIO $ send xml handleOrTLSCtx+ let xml = iqToXML iq' (fromJust $ langTag "en")+ lift $ liftIO $ send (elementToString $ Just xml) handleOrTLSCtx return Nothing IEC (CEAction predicate callback) -> do
Network/XMPP/Stanza.hs view
@@ -1,34 +1,8 @@-{---Copyright © 2010-2011 Jon Kristensen.--This file is part of Pontarius XMPP.--Pontarius XMPP is free software: you can redistribute it and/or modify it under-the terms of the GNU Lesser General Public License as published by the Free-Software Foundation, either version 3 of the License, or (at your option) any-later version.--Pontarius XMPP 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 Lesser General Public License for more-details.--You should have received a copy of the GNU Lesser General Public License along-with Pontarius XMPP. If not, see <http://www.gnu.org/licenses/>.+-- Copyright © 2010-2011 Jon Kristensen. See the LICENSE file in the Pontarius+-- XMPP distribution for more details. --}+{-# OPTIONS_HADDOCK hide #-} --- |--- Module: $Header$--- Description: XMPP stanza types and utility functions--- Copyright: Copyright © 2010-2011 Jon Kristensen--- License: LGPL-3------ Maintainer: info@pontarius.org--- Stability: unstable--- Portability: portable--- -- The stanza record types are generally pretty convenient to work with. -- However, due to the fact that an "IQ" can be both an "IQRequest" and an -- "IQResponse" we provide some helper functions in this module that work on@@ -37,12 +11,11 @@ -- We also provide functions to create a new stanza ID generator, and to -- generate new IDs. - module Network.XMPP.Stanza ( iqID, iqFrom, iqTo,-iqXMLLang,+iqLangTag, iqPayload, iqPayloadNamespace, iqRequestPayloadNamespace,@@ -64,17 +37,25 @@ iqID :: IQ -> Maybe StanzaID -iqID (IQReq i) = iqRequestID i-iqID (IQRes i) = iqResponseID i+iqID (Left req) = iqRequestID req+iqID (Right res) = iqResponseID res +-- TODO: Maybe?++iqResponseID :: IQResponse -> Maybe StanzaID++iqResponseID (Left err) = iqErrorID err+iqResponseID (Right res) = iqResultID res++ -- | -- Returns the @From@ @JID@ value of the @IQ@, if any. iqFrom :: IQ -> Maybe From -iqFrom (IQReq i) = iqRequestFrom i-iqFrom (IQRes i) = iqResponseFrom i+iqFrom (Left req) = iqRequestFrom req+iqFrom (Right res) = iqResponseFrom res -- |@@ -82,27 +63,52 @@ iqTo :: IQ -> Maybe To -iqTo (IQReq i) = iqRequestTo i-iqTo (IQRes i) = iqResponseTo i+iqTo (Left req) = iqRequestTo req+iqTo (Right res) = iqResponseTo res -- | -- Returns the @XMLLang@ value of the @IQ@, if any. -iqXMLLang :: IQ -> Maybe XMLLang+iqLangTag :: IQ -> LangTag -iqXMLLang (IQReq i) = iqRequestXMLLang i-iqXMLLang (IQRes i) = iqResponseXMLLang i+iqLangTag (Left req) = iqRequestLangTag req+iqLangTag (Right res) = iqResponseLangTag res +iqResponseLangTag :: IQResponse -> LangTag++iqResponseLangTag (Left err) = iqErrorLangTag err+iqResponseLangTag (Right res) = iqResultLangTag res+++iqResponseFrom :: IQResponse -> Maybe From++iqResponseFrom (Left err) = iqErrorFrom err+iqResponseFrom (Right res) = iqResultFrom res+++iqResponseTo :: IQResponse -> Maybe To++iqResponseTo (Left err) = iqErrorTo err+iqResponseTo (Right res) = iqResultTo res+++ -- | -- Returns the @Element@ payload value of the @IQ@, if any. If the IQ in -- question is of the "request" type, use @iqRequestPayload@ instead. iqPayload :: IQ -> Maybe Element -iqPayload (IQReq i) = Just (iqRequestPayload i)-iqPayload (IQRes i) = iqResponsePayload i+iqPayload (Left req) = Just (iqRequestPayload req)+iqPayload (Right res) = iqResponsePayload res+++iqResponsePayload :: IQResponse -> Maybe Element++iqResponsePayload (Left err) = iqErrorPayload err+iqResponsePayload (Right res) = iqResultPayload res -- |
Network/XMPP/Stream.hs view
@@ -1,457 +1,525 @@------------------------------------------------------------------------------------ Module : Network.XMPP.Stream--- Copyright : Copyright © 2011, Jon Kristensen--- License : UnknownLicense "LGPL3"------ Maintainer : jon.kristensen@pontarius.org--- Stability : alpha--- Portability :------ |---------------------------------------------------------------------------------+-- Copyright © 2010-2011 Jon Kristensen. See the LICENSE file in the Pontarius+-- XMPP distribution for more details. +{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE OverloadedStrings #-}+ module Network.XMPP.Stream (-isTLSSecured, xmlEnumerator,-xmlReader, presenceToXML, iqToXML, messageToXML, parsePresence, parseIQ,-parseMessage+parseMessage,+langTag,+versionFromString,+versionFromNumbers ) where -import Network.XMPP.Address hiding (fromString)-import qualified Network.XMPP.Address as X-import Network.XMPP.Types-import Network.XMPP.Utilities-import Network.XMPP.TLS-import Network.XMPP.Stanza-import qualified Control.Exception as CE-import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)-import GHC.IO.Handle (Handle, hPutStr, hFlush, hSetBuffering, hWaitForInput)-import Network.TLS-import Network.TLS.Cipher-import Data.Enumerator (($$), Iteratee, continue, joinI,- run, run_, yield)-import Data.Enumerator.Binary (enumHandle, enumFile)-import Text.XML.Enumerator.Parse (parseBytes, decodeEntities)-import Text.XML.Enumerator.Document (fromEvents)-import qualified Data.ByteString as DB-import qualified Data.ByteString.Lazy as DBL (ByteString, append, pack, fromChunks, toChunks, null)-import qualified Data.ByteString.Lazy.Char8 as DBLC (append, pack, unpack)-import qualified Data.Enumerator as E-import qualified Data.Enumerator.List as EL-import qualified Data.List as DL-import qualified Data.Text as DT-import qualified Data.Text.Lazy as DTL-import Data.Maybe+import Network.XMPP.Types hiding (Continue) -import Data.XML.Types+import Prelude hiding (null) -import Control.Monad.IO.Class (liftIO, MonadIO)-import Data.String (IsString(..))+import Control.Concurrent.Chan (Chan, writeChan)+import Control.Exception.Base (SomeException)+import Control.Monad.IO.Class (liftIO)+import Data.ByteString.Lazy (null, toChunks)+import Data.Enumerator ((>>==), ($$), Iteratee (..), Enumeratee, Step (..), Enumerator (..), Stream (Chunks), returnI, joinI, run)+import Data.Enumerator.Binary (enumHandle)+import Data.Maybe (fromJust, isJust)+import Data.Text (pack, unpack)+import Data.XML.Types (Content (..), Document (..), Element (..), Event (..), Name (..), Node (..))+import GHC.IO.Handle (Handle)+import Network.TLS (TLSCtx, recvData)+import Text.Parsec (char, count, digit, eof, many, many1, oneOf, parse)+import Text.Parsec.ByteString (GenParser)+import Text.XML.Enumerator.Document (fromEvents)+import Text.XML.Enumerator.Parse (parseBytes, decodeEntities) -isTLSSecured :: TLSState -> Bool-isTLSSecured (PostHandshake _) = True-isTLSSecured _ = False+import qualified Data.ByteString as DB (ByteString)+import qualified Data.ByteString.Char8 as DBC (pack)+import qualified Data.Enumerator.List as DEL (head) -- Reads from the provided handle or TLS context and sends the events to the -- internal event channel. xmlEnumerator :: Chan (InternalEvent s m) -> Either Handle TLSCtx -> IO ()+ xmlEnumerator c s = do- enumeratorResult <- case s of- Left handle -> run $ enumHandle 1 handle $$ joinI $- parseBytes decodeEntities $$ xmlReader c- Right tlsCtx -> run $ enumTLS tlsCtx $$ joinI $- parseBytes decodeEntities $$ xmlReader c- case enumeratorResult of- Right _ ->- writeChan c $ IEE EnumeratorDone- Left e ->- writeChan c $ IEE (EnumeratorException e)- where- -- Behaves like enumHandle, but reads from the TLS context instead- enumTLS :: TLSCtx -> E.Enumerator DB.ByteString IO b- enumTLS c s = loop c s+ enumeratorResult <- case s of+ Left handle -> run $ enumHandle 1 handle $$ joinI $+ parseBytes decodeEntities $$ eventConsumer c [] 0+ Right tlsCtx -> run $ enumTLS tlsCtx $$ joinI $+ parseBytes decodeEntities $$ eventConsumer c [] 0+ case enumeratorResult of+ Right _ -> writeChan c $ IEE EnumeratorDone+ Left e -> writeChan c $ IEE (EnumeratorException e)+ where+ -- Behaves like enumHandle, but reads from the TLS context instead+ -- TODO: Type?+ enumTLS :: TLSCtx -> Enumerator DB.ByteString IO b+ enumTLS c s = loop c s - loop :: TLSCtx -> E.Step DB.ByteString IO b -> E.Iteratee DB.ByteString IO b- loop c (E.Continue k) = do- d <- recvData c- case DBL.null d of- True -> loop c (E.Continue k)- False -> k (E.Chunks $ DBL.toChunks d) E.>>== loop c- loop _ step = E.returnI step+ -- TODO: Type?+ loop :: TLSCtx -> Step DB.ByteString IO b -> Iteratee DB.ByteString IO b+ loop c (Continue k) = do+ d <- recvData c+ case null d of+ True -> loop c (Continue k)+ False -> k (Chunks $ toChunks d) >>== loop c+ loop _ step = returnI step -xmlReader :: Chan (InternalEvent s m) -> Iteratee Event IO (Maybe Event)+-- Consumes XML events from the input stream, accumulating as necessary, and+-- sends the proper events through the channel. The second parameter should be+-- initialized to [] (no events) and the third to 0 (zeroth XML level). -xmlReader c = xmlReader_ c [] 0+eventConsumer :: Chan (InternalEvent s m) -> [Event] -> Int ->+ Iteratee Event IO (Maybe Event) +-- <stream:stream> open event received. -xmlReader_ :: Chan (InternalEvent s m) -> [Event] -> Int ->- Iteratee Event IO (Maybe Event)+eventConsumer chan [EventBeginElement (Name localName namespace prefixName) attribs] 0+ | localName == pack "stream" && isJust prefixName && fromJust prefixName == pack "stream" = do+ liftIO $ writeChan chan $ IEE $ EnumeratorBeginStream from to id ver lang ns+ eventConsumer chan [] 1+ where+ from = case lookup "from" attribs of Nothing -> Nothing; Just fromAttrib -> Just $ show fromAttrib+ to = case lookup "to" attribs of Nothing -> Nothing; Just toAttrib -> Just $ show toAttrib+ id = case lookup "id" attribs of Nothing -> Nothing; Just idAttrib -> Just $ show idAttrib+ ver = case lookup "version" attribs of Nothing -> Nothing; Just verAttrib -> Just $ show verAttrib+ lang = case lookup "xml:lang" attribs of Nothing -> Nothing; Just langAttrib -> Just $ show langAttrib+ ns = case namespace of Nothing -> Nothing; Just namespaceAttrib -> Just $ unpack namespaceAttrib -xmlReader_ ch [EventBeginDocument] 0 = xmlReader_ ch [] 0+-- <stream:stream> close event received. --- TODO: Safe to start change level here? We are doing this since the stream can--- restart.--- TODO: l < 2?-xmlReader_ ch [EventBeginElement name attribs] l- | l < 3 && nameLocalName name == DT.pack "stream" &&- namePrefix name == Just (DT.pack "stream") = do- liftIO $ writeChan ch $ IEE $ EnumeratorXML $ XEBeginStream $ "StreamTODO"- xmlReader_ ch [] 1+eventConsumer chan [EventEndElement name] 1+ | namePrefix name == Just (pack "stream") && nameLocalName name == pack "stream" = do+ liftIO $ writeChan chan $ IEE $ EnumeratorEndStream+ return Nothing -xmlReader_ ch [EventEndElement name] 1- | namePrefix name == Just (DT.pack "stream") &&- nameLocalName name == DT.pack "stream" = do- liftIO $ writeChan ch $ IEE $ EnumeratorXML $ XEEndStream- return Nothing+-- Ignore EventDocumentBegin event. --- Check if counter is one to forward it to related function.--- Should replace "reverse ((EventEndElement n):es)" with es--- ...-xmlReader_ ch ((EventEndElement n):es) 1- | nameLocalName n == DT.pack "proceed" = do- liftIO $ writeChan ch $ IEE $ EnumeratorXML $ XEProceed- E.yield Nothing (E.Chunks [])- | otherwise = do- -- liftIO $ putStrLn "Got an IEX Event..."- liftIO $ writeChan ch $ IEE $ EnumeratorXML $ (processEventList (DL.reverse ((EventEndElement n):es)))- xmlReader_ ch [] 1+eventConsumer chan [EventBeginDocument] 0 = eventConsumer chan [] 0 --- Normal condition, buffer the event to events list.-xmlReader_ ch es co = do- head <- EL.head- let co' = counter co head- -- liftIO $ putStrLn $ show co' ++ "\t" ++ show head -- for test- case head of- Just e -> xmlReader_ ch (e:es) co'- Nothing -> xmlReader_ ch es co'+-- We have received a complete first-level XML element. Process the accumulated+-- values into an first-level element event. +eventConsumer chan ((EventEndElement e):es) 1 = do+ liftIO $ writeChan chan $ IEE $ EnumeratorFirstLevelElement $ eventsToElement $ reverse ((EventEndElement e):es)+ eventConsumer chan [] 1 --- TODO: Generate real event.-processEventList :: [Event] -> XMLEvent-processEventList e- | namePrefix name == Just (DT.pack "stream") &&- nameLocalName name == DT.pack "features" = XEFeatures "FeaturesTODO"- | nameLocalName name == DT.pack "challenge" =- let EventContent (ContentText c) = head es in XEChallenge $ Chal $ DT.unpack c- | nameLocalName name == DT.pack "success" =- let EventContent (ContentText c) = head es in XESuccess $ Succ $ "" -- DT.unpack c- | nameLocalName name == DT.pack "iq" = XEIQ $ parseIQ $ eventsToElement e- | nameLocalName name == DT.pack "presence" = XEPresence $ parsePresence $ eventsToElement e- | nameLocalName name == DT.pack "message" = XEMessage $ parseMessage $ eventsToElement e- | otherwise = XEOther $ elementToString $ Just (eventsToElement e)- where- (EventBeginElement name attribs) = head e- es = tail e+-- Normal condition - accumulate the event. -eventsToElement :: [Event] -> Element+eventConsumer chan events level = do+ event <- DEL.head+ case event of+ Just event' -> let level' = case event' of+ EventBeginElement _ _ -> level + 1+ EventEndElement _ -> level - 1+ _ -> level+ in eventConsumer chan (event':events) level'+ Nothing -> eventConsumer chan events level+++eventsToElement :: [Event] -> Either SomeException Element+ eventsToElement e = do- documentRoot $ fromJust (run_ $ enum e $$ fromEvents)+ r <- run $ eventsEnum $$ fromEvents+ case r of Right doc -> Right $ documentRoot doc; Left ex -> Left ex where- enum :: [Event] -> E.Enumerator Event Maybe Document- enum e_ (E.Continue k) = k $ E.Chunks e_- enum e_ step = E.returnI step+ -- TODO: Type?+ eventsEnum (Continue k) = k $ Chunks e+ eventsEnum step = returnI step -counter :: Int -> Maybe Event -> Int-counter c (Just (EventBeginElement _ _)) = (c + 1)-counter c (Just (EventEndElement _) ) = (c - 1)-counter c _ = c -presenceToXML :: Presence -> String-presenceToXML p = "<presence" ++ from ++ id' ++ to ++ type' ++ ">" ++- (elementsToString $ presencePayload p) ++ "</presence>"- where- from :: String- from = case presenceFrom p of- -- TODO: Lower-case- Just s -> " from='" ++ (show s) ++ "'"- Nothing -> ""+-- Sending stanzas is done through functions, where LangTag is Maybe. - id' :: String- id' = case presenceID p of- Just (SID s) -> " id='" ++ s ++ "'"- Nothing -> "" - to :: String- to = case presenceTo p of- -- TODO: Lower-case- Just s -> " to='" ++ (show s) ++ "'"- Nothing -> ""+-- Generates an XML element for a message stanza. The language tag provided is+-- the default language of the stream. - type' :: String- type' = case presenceType p of- Available -> ""- t -> " type='" ++ (presenceTypeToString t) ++ "'"+messageToXML :: InternalMessage -> LangTag -> Element -iqToXML :: IQ -> String-iqToXML (IQReq (IQGet { iqRequestID = i, iqRequestPayload = p, iqRequestFrom = f, iqRequestTo = t })) =- let type' = " type='get'" in "<iq" ++ from ++ id' ++ to ++ type' ++ ">" ++ (elementToString (Just p)) ++ "</iq>"- where- from :: String- from = case f of- -- TODO: Lower-case- Just s -> " from='" ++ (show s) ++ "'"- Nothing -> ""+-- Non-error message. - id' :: String- id' = case i of- Just (SID s) -> " id='" ++ s ++ "'"- Nothing -> ""+messageToXML (Right m) streamLang = Element "message" attribs nodes - to :: String- to = case t of- -- TODO: Lower-case- Just s -> " to='" ++ (show s) ++ "'"- Nothing -> ""+ where -iqToXML (IQReq (IQSet { iqRequestID = i, iqRequestPayload = p, iqRequestFrom = f, iqRequestTo = t })) =- let type' = " type='set'" in "<iq" ++ from ++ id' ++ to ++ type' ++ ">" ++ (elementToString (Just p)) ++ "</iq>"- where- from :: String- from = case f of- -- TODO: Lower-case- Just s -> " from='" ++ (show s) ++ "'"- Nothing -> ""+ -- Has the stanza attributes and the message type.+ attribs :: [(Name, [Content])]+ attribs = stanzaAttribs (messageID m) (messageFrom m) (messageTo m) stanzaLang +++ [("type", [ContentText $ pack $ show $ messageType m])] - id' :: String- id' = case i of- Just (SID s) -> " id='" ++ s ++ "'"- Nothing -> ""+ -- Has an arbitrary number of elements as children.+ nodes :: [Node]+ nodes = map (\ x -> NodeElement x) (messagePayload m) - to :: String- to = case t of- -- TODO: Lower-case- Just s -> " to='" ++ (show s) ++ "'"- Nothing -> ""+ stanzaLang :: Maybe LangTag+ stanzaLang = stanzaLang' streamLang $ messageLangTag m -iqToXML (IQRes (IQResult { iqResponseID = i, iqResponsePayload = p, iqResponseFrom = f, iqResponseTo = t })) =- let type' = " type='result'" in "<iq" ++ from ++ id' ++ to ++ type' ++ ">" ++ (elementToString p) ++ "</iq>"- where- from :: String- from = case f of- -- TODO: Lower-case- Just s -> " from='" ++ (show s) ++ "'"- Nothing -> ""+-- Presence error. - id' :: String- id' = case i of- Just (SID s) -> " id='" ++ s ++ "'"- Nothing -> ""+messageToXML (Left m) streamLang = Element "message" attribs nodes - to :: String- to = case t of- -- TODO: Lower-case- Just s -> " to='" ++ (show s) ++ "'"- Nothing -> ""+ where --- TODO: Turn message errors into XML.+ -- Has the stanza attributes and the "error" presence type.+ attribs :: [(Name, [Content])]+ attribs = stanzaAttribs (messageErrorID m) (messageErrorFrom m) (messageErrorTo m)+ stanzaLang ++ [("type", [ContentText $ pack "error"])] -messageToXML :: Message -> String-messageToXML Message { messageID = i, messageFrom = f, messageTo = t, messagePayload = p, messageType = ty } = "<message" ++ from ++ id' ++ to ++ type' ++ ">" ++- (elementsToString $ p) ++ "</message>"- where- from :: String- from = case f of- -- TODO: Lower-case- Just s -> " from='" ++ (show s) ++ "'"- Nothing -> ""+ -- Has the error element stanza as its child.+ -- TODO: Include sender XML here?+ nodes :: [Node]+ nodes = [NodeElement $ errorElem streamLang stanzaLang $ messageErrorStanzaError m] - id' :: String- id' = case i of- Just (SID s) -> " id='" ++ s ++ "'"- Nothing -> ""+ -- The stanza language tag, if it's different from the stream language tag.+ stanzaLang :: Maybe LangTag+ stanzaLang = stanzaLang' streamLang $ messageErrorLangTag m - to :: String- to = case t of- -- TODO: Lower-case- Just s -> " to='" ++ (show s) ++ "'"- Nothing -> "" - type' :: String- type' = case ty of- Normal -> ""- t -> " type='" ++ (messageTypeToString t) ++ "'"+-- Generates an XML element for a presence stanza. The language tag provided is+-- the default language of the stream. +presenceToXML :: InternalPresence -> LangTag -> Element +-- Non-error presence.++presenceToXML (Right p) streamLang = Element "presence" attribs nodes++ where++ -- Has the stanza attributes and the presence type.+ attribs :: [(Name, [Content])]+ attribs = stanzaAttribs (presenceID p) (presenceFrom p) (presenceTo p) stanzaLang +++ typeAttrib++ -- Has an arbitrary number of elements as children.+ nodes :: [Node]+ nodes = map (\ x -> NodeElement x) (presencePayload p)++ stanzaLang :: Maybe LangTag+ stanzaLang = stanzaLang' streamLang $ presenceLangTag p++ typeAttrib :: [(Name, [Content])]+ typeAttrib = case presenceType p of Nothing -> []; Just presenceType' -> [("type", [ContentText $ pack $ show presenceType'])]++-- Presence error.++presenceToXML (Left p) streamLang = Element "presence" attribs nodes++ where++ -- Has the stanza attributes and the "error" presence type.+ attribs :: [(Name, [Content])]+ attribs = stanzaAttribs (presenceErrorID p) (presenceErrorFrom p) (presenceErrorTo p)+ stanzaLang ++ [("type", [ContentText $ pack "error"])]++ -- Has the error element stanza as its child.+ -- TODO: Include sender XML here?+ nodes :: [Node]+ nodes = [NodeElement $ errorElem streamLang stanzaLang $ presenceErrorStanzaError p]++ -- The stanza language tag, if it's different from the stream language tag.+ stanzaLang :: Maybe LangTag+ stanzaLang = stanzaLang' streamLang $ presenceErrorLangTag p+++-- Generates an XML element for a presence stanza. The language tag provided is+-- the default language of the stream.++iqToXML :: IQ -> LangTag -> Element++-- Request IQ.++iqToXML (Left i) streamLang = Element "iq" attribs nodes++ where++ -- Has the stanza attributes and the IQ request type (`get' or `set').+ attribs :: [(Name, [Content])]+ attribs = stanzaAttribs (iqRequestID i) (iqRequestFrom i) (iqRequestTo i)+ stanzaLang ++ typeAttrib++ -- Has exactly one payload child element.+ nodes :: [Node]+ nodes = [NodeElement $ iqRequestPayload i]++ -- The stanza language tag, if it's different from the stream language tag.+ stanzaLang :: Maybe LangTag+ stanzaLang = stanzaLang' streamLang $ iqRequestLangTag i++ -- The required type attribute.+ typeAttrib :: [(Name, [Content])]+ typeAttrib = [("type", [ContentText $ pack $ show $ iqRequestType i])]++-- Response result IQ.++iqToXML (Right (Right i)) streamLang = Element "iq" attribs nodes++ where++ -- Has the stanza attributes and the IQ `result' type.+ attribs :: [(Name, [Content])]+ attribs = stanzaAttribs (iqResultID i) (iqResultFrom i) (iqResultTo i)+ stanzaLang ++ typeAttrib++ -- Has one or zero payload child elements.+ nodes :: [Node]+ nodes = case iqResultPayload i of Nothing -> []; Just payloadElem -> [NodeElement payloadElem]++ stanzaLang :: Maybe LangTag+ stanzaLang = stanzaLang' streamLang $ iqResultLangTag i++ -- The required type attribute.+ typeAttrib :: [(Name, [Content])]+ typeAttrib = [("type", [ContentText $ pack "result"])]++-- Response error IQ.++iqToXML (Right (Left i)) streamLang = Element "iq" attribs nodes++ where++ -- Has the stanza attributes and the presence type.+ attribs :: [(Name, [Content])]+ attribs = stanzaAttribs (iqErrorID i) (iqErrorFrom i) (iqErrorTo i) stanzaLang +++ typeAttrib++ -- Has an optional elements as child.+ nodes :: [Node]+ nodes = case iqErrorPayload i of Nothing -> []; Just payloadElem -> [NodeElement payloadElem]++ stanzaLang :: Maybe LangTag+ stanzaLang = stanzaLang' streamLang $ iqErrorLangTag i++ typeAttrib :: [(Name, [Content])]+ typeAttrib = [("type", [ContentText $ pack "error"])]+++-- Creates the error element that is common for all stanzas.++errorElem :: LangTag -> Maybe LangTag -> StanzaError -> Element++errorElem streamLang stanzaLang stanzaError = Element "error" typeAttrib+ ([defCondElem] ++ textElem ++ appSpecCondElem)++ where++ -- The required stanza error type.+ typeAttrib :: [(Name, [Content])]+ typeAttrib = [("type", [ContentText $ pack $ show $ stanzaErrorType stanzaError])]++ -- The required defined condition element.+ defCondElem :: Node+ defCondElem = NodeElement $ Element (Name (pack $ show $ stanzaErrorCondition stanzaError) (Just $ pack "urn:ietf:params:xml:ns:xmpp-stanzas") Nothing) [] []+++ -- The optional text element.+ textElem :: [Node]+ textElem = case stanzaErrorText stanzaError of+ Nothing -> []+ Just (textLang, text) ->+ [NodeElement $ Element "{urn:ietf:params:xml:ns:xmpp-stanzas}text"+ (langTagAttrib $ childLang streamLang [stanzaLang, fst $ fromJust $ stanzaErrorText stanzaError])+ [NodeContent $ ContentText $ pack text]]++ -- The optional application specific condition element.+ appSpecCondElem :: [Node]+ appSpecCondElem = case stanzaErrorApplicationSpecificCondition stanzaError of+ Nothing -> []+ Just elem -> [NodeElement elem]+++-- Generates the element attribute for an optional language tag.++langTagAttrib :: Maybe LangTag -> [(Name, [Content])]++langTagAttrib lang = case lang of Nothing -> []; Just lang' -> [("xml:lang", [ContentText $ pack $ show lang'])]+++stanzaLang' :: LangTag -> LangTag -> Maybe LangTag++stanzaLang' streamLang stanzaLang | streamLang == stanzaLang = Nothing+ | otherwise = Just stanzaLang+++-- Finds the language tag to set on the current element, if any. Makes sure that+-- language tags are not repeated unnecessarily (like on a child element, when+-- the parent has it). The first parameter is the stream language tag, and the+-- list of optional language tags are ordered in their XML element child+-- sequence, parent first, starting with the stanza language tag.++childLang :: LangTag -> [Maybe LangTag] -> Maybe LangTag++childLang streamLang optLangTags++ -- The current element does not have a language tag - set nothing.+ | (head $ reverse optLangTags) == Nothing = Nothing++ -- All optional language tags are Nothing - set nothing.+ | length langTags == 1 = Nothing++ -- The language tag of this element is the same as the closest parent with a+ -- language tag - set nothing.+ | (head langTags) == (head $ tail langTags) = Nothing++ -- Set the language tag.+ | otherwise = Just $ head langTags++ where++ -- Contains the chain of language tags in descending priority order.+ -- Contains at least one element - the stream language tag.+ langTags = reverse $ [streamLang] ++ (map fromJust $ filter (\ l -> isJust l) optLangTags)+++-- Creates the attributes common for all stanzas.++stanzaAttribs :: Maybe StanzaID -> Maybe From -> Maybe To -> Maybe LangTag -> [(Name, [Content])]++stanzaAttribs i f t l = if isJust $ i then [("id", [ContentText $ pack $ show $ fromJust i])] else [] +++ if isJust $ f then [("from", [ContentText $ pack $ show $ fromJust f])] else [] +++ if isJust $ t then [("to", [ContentText $ pack $ show $ fromJust t])] else [] +++ if isJust $ l then [("xml:lang", [ContentText $ pack $ show l])] else []++ parseIQ :: Element -> IQ-parseIQ e | typeAttr == "get" = let (Just payloadMust) = payload- in IQReq (IQGet idAttr fromAttr toAttr Nothing- payloadMust)- | typeAttr == "set" = let (Just payloadMust) = payload- in IQReq (IQSet idAttr fromAttr toAttr Nothing- payloadMust)- | typeAttr == "result" = IQRes (IQResult idAttr fromAttr toAttr- Nothing payload) - where- -- TODO: Many duplicate functions from parsePresence.+parseIQ = parseIQ - payload :: Maybe Element- payload = case null (elementChildren e) of- True -> Nothing- False -> Just $ head $ elementChildren e - typeAttr :: String- typeAttr = case attributeText typeName e of- -- Nothing -> Nothing- Just a -> DT.unpack a+parsePresence :: Element -> InternalPresence - fromAttr :: Maybe Address- fromAttr = case attributeText fromName e of- Nothing -> Nothing- Just a -> X.fromString $ DT.unpack a+parsePresence = parsePresence - toAttr :: Maybe Address- toAttr = case attributeText toName e of- Nothing -> Nothing- Just a -> X.fromString $ DT.unpack a - idAttr :: Maybe StanzaID- idAttr = case attributeText idName e of- Nothing -> Nothing- Just a -> Just (SID (DT.unpack a))+parseMessage :: Element -> InternalMessage - typeName :: Name- typeName = fromString "type"+parseMessage = parseMessage - fromName :: Name- fromName = fromString "from" - toName :: Name- toName = fromString "to"+-- Converts a string to a PresenceType. Nothing means convertion error, Just+-- Nothing means the presence error type, and Just $ Just is the PresenceType. - idName :: Name- idName = fromString "id"+stringToPresenceType :: String -> Maybe (Maybe PresenceType) --- TODO: Parse xml:lang+stringToPresenceType "probe" = Just $ Just Probe+stringToPresenceType "unavailable" = Just $ Just Unavailable+stringToPresenceType "subscribe" = Just $ Just Subscribe+stringToPresenceType "subscribed" = Just $ Just Subscribed+stringToPresenceType "unsubscribe" = Just $ Just Unsubscribe+stringToPresenceType "unsubscribed" = Just $ Just Unsubscribed+stringToPresenceType "error" = Just Nothing+stringToPresenceType _ = Nothing -parsePresence :: Element -> Presence-parsePresence e = Presence idAttr fromAttr toAttr Nothing typeAttr (elementChildren e)- where- -- TODO: Many duplicate functions from parseIQ. - typeAttr :: PresenceType- typeAttr = case attributeText typeName e of- Just t -> stringToPresenceType $ DT.unpack t- Nothing -> Available+-- Converts a Maybe MessageType to a string. Nothing means "error". - fromAttr :: Maybe Address- fromAttr = case attributeText fromName e of- Nothing -> Nothing- Just a -> X.fromString $ DT.unpack a+presenceTypeToString :: Maybe PresenceType -> String - toAttr :: Maybe Address- toAttr = case attributeText toName e of- Nothing -> Nothing- Just a -> X.fromString $ DT.unpack a+presenceTypeToString (Just Unavailable) = "unavailable"+presenceTypeToString (Just Probe) = "probe"+presenceTypeToString Nothing = "error"+presenceTypeToString (Just Subscribe) = "subscribe"+presenceTypeToString (Just Subscribed) = "subscribed"+presenceTypeToString (Just Unsubscribe) = "unsubscribe"+presenceTypeToString (Just Unsubscribed) = "unsubscribed" - idAttr :: Maybe StanzaID- idAttr = case attributeText idName e of- Nothing -> Nothing- Just a -> Just (SID (DT.unpack a)) - fromName :: Name- fromName = fromString "from"+-- Converts a string to a MessageType. Nothing means convertion error, Just+-- Nothing means the message error type, and Just $ Just is the MessageType. - typeName :: Name- typeName = fromString "type"+stringToMessageType :: String -> Maybe (Maybe MessageType) - toName :: Name- toName = fromString "to"+stringToMessageType "chat" = Just $ Just Chat+stringToMessageType "error" = Just $ Nothing+stringToMessageType "groupchat" = Just $ Just Groupchat+stringToMessageType "headline" = Just $ Just Headline+stringToMessageType "normal" = Just $ Just Normal+stringToMessageType _ = Nothing - idName :: Name- idName = fromString "id" -parseMessage :: Element -> Message-parseMessage e = Message idAttr fromAttr toAttr Nothing typeAttr (elementChildren e)- where- -- TODO: Many duplicate functions from parseIQ.+-- Converts a Maybe MessageType to a string. Nothing means "error". - typeAttr :: MessageType- typeAttr = case attributeText typeName e of- Just t -> stringToMessageType $ DT.unpack t- Nothing -> Normal+messageTypeToString :: Maybe MessageType -> String - fromAttr :: Maybe Address- fromAttr = case attributeText fromName e of- Nothing -> Nothing- Just a -> X.fromString $ DT.unpack a+messageTypeToString (Just Chat) = "chat"+messageTypeToString Nothing = "error"+messageTypeToString (Just Groupchat) = "groupchat"+messageTypeToString (Just Headline) = "headline"+messageTypeToString (Just Normal) = "normal" - toAttr :: Maybe Address- toAttr = case attributeText toName e of- Nothing -> Nothing- Just a -> X.fromString $ DT.unpack a - idAttr :: Maybe StanzaID- idAttr = case attributeText idName e of- Nothing -> Nothing- Just a -> Just (SID (DT.unpack a))+-- Converts a "<major>.<minor>" numeric version number to a "Version" object. - fromName :: Name- fromName = fromString "from"+versionFromString :: String -> Maybe Version - typeName :: Name- typeName = fromString "type"+versionFromString s = case parse version "" (DBC.pack s) of+ Right version -> Just version+ Left _ -> Nothing - toName :: Name- toName = fromString "to" - idName :: Name- idName = fromString "id"+-- Constructs a "Version" based on the major and minor version numbers. --- stringToPresenceType "available" = Available--- stringToPresenceType "away" = Away--- stringToPresenceType "chat" = Chat--- stringToPresenceType "dnd" = DoNotDisturb--- stringToPresenceType "xa" = ExtendedAway+versionFromNumbers :: Integer -> Integer -> Version -stringToPresenceType "available" = Available -- TODO: Some client sent this+versionFromNumbers major minor = Version major minor -stringToPresenceType "probe" = Probe--- stringToPresenceType "error" = PresenceError -- TODO: Special case -stringToPresenceType "unavailable" = Unavailable-stringToPresenceType "subscribe" = Subscribe-stringToPresenceType "subscribed" = Subscribed-stringToPresenceType "unsubscribe" = Unsubscribe-stringToPresenceType "unsubscribed" = Unsubscribed+version :: GenParser Char st Version --- presenceTypeToString Available = "available"+version = do --- presenceTypeToString Away = "away"--- presenceTypeToString Chat = "chat"--- presenceTypeToString DoNotDisturb = "dnd"--- presenceTypeToString ExtendedAway = "xa"+ -- Read numbers, a dot, more numbers, and end-of-file.+ major <- many1 digit+ char '.'+ minor <- many1 digit+ eof+ return $ Version (read major) (read minor) -presenceTypeToString Unavailable = "unavailable" -presenceTypeToString Probe = "probe"--- presenceTypeToString PresenceError = "error" -- TODO: Special case+-- |+-- Parses, validates, and possibly constructs a "LangTag" object. -presenceTypeToString Subscribe = "subscribe"-presenceTypeToString Subscribed = "subscribed"-presenceTypeToString Unsubscribe = "unsubscribe"-presenceTypeToString Unsubscribed = "unsubscribed"+langTag :: String -> Maybe LangTag -stringToMessageType "chat" = Chat-stringToMessageType "error" = Error-stringToMessageType "groupchat" = Groupchat-stringToMessageType "headline" = Headline-stringToMessageType "normal" = Normal-stringToMessageType s = OtherMessageType s+langTag s = case parse languageTag "" (DBC.pack s) of+ Right tag -> Just tag+ Left _ -> Nothing -messageTypeToString Chat = "chat"-messageTypeToString Error = "error"-messageTypeToString Groupchat = "groupchat"-messageTypeToString Headline = "headline"-messageTypeToString Normal = "normal"-messageTypeToString (OtherMessageType s) = s++-- Parses a language tag as defined by RFC 1766 and constructs a LangTag object.++languageTag :: GenParser Char st LangTag++languageTag = do++ -- Read until we reach a '-' character, or EOF. This is the `primary tag'.+ primTag <- tag++ -- Read zero or more subtags.+ subTags <- subtags+ eof++ return $ LangTag primTag subTags+ where++ subtags :: GenParser Char st [String]+ subtags = many $ do+ char '-'+ subtag <- tag+ return subtag++ tag :: GenParser Char st String+ tag = do+ a <- many1 $ oneOf tagChars+ return a++ tagChars :: [Char]+ tagChars = ['a'..'z'] ++ ['A'..'Z']
Network/XMPP/TLS.hs view
@@ -1,47 +1,30 @@------------------------------------------------------------------------------------ Module : Network.XMPP.TLS--- Copyright : Copyright © 2011, Jon Kristensen--- License : LGPL (Just (Version {versionBranch = [3], versionTags = []}))------ Maintainer : jon.kristensen@pontarius.org--- Stability : alpha--- Portability :------ |---------------------------------------------------------------------------------+-- Copyright © 2010-2011 Jon Kristensen. See the LICENSE file in the Pontarius+-- XMPP distribution for more details. -module Network.XMPP.TLS (-getTLSParams,-handshake'-) where+-- TODO: TLS12 when supported in tls; TODO: TLS11 results in a read error - bug?+-- TODO: cipher_AES128_SHA1 = TLS_RSA_WITH_AES_128_CBC_SHA?+-- TODO: Compression?+-- TODO: Validate certificate -import Network.TLS-import Network.TLS.Cipher-import GHC.IO.Handle (Handle, hPutStr, hFlush, hSetBuffering, hWaitForInput)+{-# OPTIONS_HADDOCK hide #-} +module Network.XMPP.TLS (tlsParams) where -getTLSParams :: TLSParams-getTLSParams = TLSParams { pConnectVersion = TLS10- , pAllowedVersions = [TLS10,TLS11]- , pCiphers = [cipher_AES256_SHA1] -- Check the rest- , pCompressions = [nullCompression]- , pWantClientCert = False- , pCertificates = []- , onCertificatesRecv = \_ -> return True } -- Verify cert chain+import Network.TLS (TLSCertificateUsage (CertificateUsageAccept),+ TLSParams (..), Version (SSL3, TLS10, TLS11),+ defaultLogging, nullCompression)+import Network.TLS.Extra (cipher_AES128_SHA1) -handshake' :: Handle -> String -> IO (Maybe TLSCtx)-handshake' h s = do- let t = getTLSParams- r <- makeSRandomGen- case r of- Right sr -> do- putStrLn $ show sr- c <- client t sr h- handshake c- putStrLn ">>>>TLS data sended<<<<"- return (Just c)- Left ge -> do- putStrLn $ show ge- return Nothing++tlsParams :: TLSParams++tlsParams = TLSParams { pConnectVersion = TLS10+ , pAllowedVersions = [SSL3, TLS10,TLS11]+ , pCiphers = [cipher_AES128_SHA1]+ , pCompressions = [nullCompression]+ , pWantClientCert = False -- Used for servers+ , pUseSecureRenegotiation = False -- No renegotiation+ , pCertificates = [] -- TODO+ , pLogging = defaultLogging -- TODO+ , onCertificatesRecv = \ certificate ->+ return CertificateUsageAccept }
Network/XMPP/Types.hs view
@@ -1,22 +1,15 @@------------------------------------------------------------------------------------ Module : Types--- Copyright : Copyright © 2011, Jon Kristensen--- License : LGPL (Just (Version {versionBranch = [3], versionTags = []}))------ Maintainer : jon.kristensen@pontarius.org--- Stability : alpha--- Portability :---------------------------------------------------------------------------------+-- Copyright © 2010-2011 Jon Kristensen. See the LICENSE file in the Pontarius+-- XMPP distribution for more details. +{-# OPTIONS_HADDOCK hide #-}+ {-# LANGUAGE MultiParamTypeClasses #-} module Network.XMPP.Types ( StanzaID (..), From, To,-IQ (..),+IQ, IQRequest (..), IQResponse (..), Message (..),@@ -37,16 +30,14 @@ TLSState (..), Address (..), Localpart,-Serverpart,+Domainpart, Resourcepart,-XMLLang,+LangTag (..), InternalEvent (..),-XMLEvent (..), ConnectionState (..), ClientEvent (..), StreamState (..), AuthenticationState (..),-Certificate, ConnectResult (..), OpenStreamResult (..), SecureWithTLSResult (..),@@ -56,7 +47,15 @@ Timeout, TimeoutEvent (..), StreamError (..),-IDGenerator (..)+IDGenerator (..),+Version (..),+IQError (..),+IQResult (..),+IQRequestType (..),+PresenceError (..),+InternalPresence (..),+InternalMessage (..),+MessageError (..), ) where import GHC.IO.Handle (Handle, hPutStr, hFlush, hSetBuffering, hWaitForInput)@@ -69,15 +68,20 @@ import Data.XML.Types -import Network.TLS+import Network.TLS hiding (Version) import Network.TLS.Cipher import qualified Control.Monad.Error as CME import Data.IORef +import Data.Certificate.X509 (X509) +import Data.List (intersperse)+import Data.Char (toLower) +import Control.Exception.Base (SomeException)+ -- ============================================================================= -- STANZA TYPES -- =============================================================================@@ -117,95 +121,115 @@ -- An Info/Query (IQ) stanza is either of the type "request" ("get" or "set") or -- "response" ("result" or "error"). The @IQ@ type wraps these two sub-types. -data IQ = IQReq IQRequest | IQRes IQResponse deriving (Eq, Show)+type IQ = Either IQRequest IQResponse -- | -- A "request" Info/Query (IQ) stanza is one with either "get" or "set" as type. -- They are guaranteed to always contain a payload. -data IQRequest = IQGet { iqRequestID :: Maybe StanzaID- , iqRequestFrom :: Maybe From- , iqRequestTo :: Maybe To- , iqRequestXMLLang :: Maybe XMLLang- , iqRequestPayload :: Element } |- IQSet { iqRequestID :: Maybe StanzaID- , iqRequestFrom :: Maybe From- , iqRequestTo :: Maybe To- , iqRequestXMLLang :: Maybe XMLLang- , iqRequestPayload :: Element }- deriving (Eq, Show)+data IQRequest = IQRequest { iqRequestID :: Maybe StanzaID+ , iqRequestFrom :: Maybe From+ , iqRequestTo :: Maybe To+ , iqRequestLangTag :: LangTag+ , iqRequestType :: IQRequestType+ , iqRequestPayload :: Element }+ deriving (Show) --- |--- A "response" Info/Query (IQ) stanza is one with either "result" or "error" as--- type.+data IQRequestType = Get | Set deriving (Show) -data IQResponse = IQResult { iqResponseID :: Maybe StanzaID- , iqResponseFrom :: Maybe From- , iqResponseTo :: Maybe To- , iqResponseXMLLang :: Maybe XMLLang- , iqResponsePayload :: Maybe Element } |- IQError { iqResponseID :: Maybe StanzaID- , iqResponseFrom :: Maybe From- , iqResponseTo :: Maybe To- , iqResponseXMLLang :: Maybe XMLLang- , iqResponsePayload :: Maybe Element- , iqResponseStanzaError :: StanzaError }- deriving (Eq, Show) +type IQResponse = Either IQError IQResult ++data IQResult = IQResult { iqResultID :: Maybe StanzaID+ , iqResultFrom :: Maybe From+ , iqResultTo :: Maybe To+ , iqResultLangTag :: LangTag+ , iqResultPayload :: Maybe Element }+ deriving (Show)+++data IQError = IQError { iqErrorID :: Maybe StanzaID+ , iqErrorFrom :: Maybe From+ , iqErrorTo :: Maybe To+ , iqErrorLangTag :: LangTag+ , iqErrorPayload :: Maybe Element+ , iqErrorStanzaError :: StanzaError }+ deriving (Show)++ -- | -- The message stanza - either a message or a message error. data Message = Message { messageID :: Maybe StanzaID , messageFrom :: Maybe From , messageTo :: Maybe To- , messageXMLLang :: Maybe XMLLang+ , messageLangTag :: LangTag , messageType :: MessageType- , messagePayload :: [Element] } |- MessageError { messageID :: Maybe StanzaID- , messageFrom :: Maybe From- , messageTo :: Maybe To- , messageXMLLang :: Maybe XMLLang- , messageErrorPayload :: Maybe [Element]- , messageErrorStanzaError :: StanzaError }- deriving (Eq, Show)+ , messagePayload :: [Element] }+ deriving (Show) +data MessageError = MessageError { messageErrorID :: Maybe StanzaID+ , messageErrorFrom :: Maybe From+ , messageErrorTo :: Maybe To+ , messageErrorLangTag :: LangTag+ , messageErrorPayload :: Maybe [Element]+ , messageErrorStanzaError :: StanzaError }+ deriving (Show)+++type InternalMessage = Either MessageError Message++ -- | -- @MessageType@ holds XMPP message types as defined in XMPP-IM. @Normal@ is the--- default message type.+-- default message type. The "error" message type is left out as errors are+-- using @MessageError@. data MessageType = Chat |- Error | Groupchat | Headline |- Normal |- OtherMessageType String deriving (Eq, Show)+ Normal deriving (Eq) +instance Show MessageType where+ show Chat = "chat"+ show Groupchat = "groupchat"+ show Headline = "headline"+ show Normal = "normal"++ -- |--- The presence stanza - either a presence or a presence error.+-- The presence stanza. It is used for both originating messages and replies.+-- For presence errors, see "PresenceError". data Presence = Presence { presenceID :: Maybe StanzaID , presenceFrom :: Maybe From , presenceTo :: Maybe To- , presenceXMLLang :: Maybe XMLLang- , presenceType :: PresenceType- , presencePayload :: [Element] } |- PresenceError { presenceID :: Maybe StanzaID- , presenceFrom :: Maybe From- , presenceTo :: Maybe To- , presenceXMLLang :: Maybe XMLLang- , presenceErrorPayload :: Maybe [Element]- , presenceErrorStanzaError :: StanzaError }- deriving (Eq, Show)+ , presenceLangTag :: LangTag+ , presenceType :: Maybe PresenceType+ , presencePayload :: [Element] }+ deriving (Show) +data PresenceError = PresenceError { presenceErrorID :: Maybe StanzaID+ , presenceErrorFrom :: Maybe From+ , presenceErrorTo :: Maybe To+ , presenceErrorLangTag :: LangTag+ , presenceErrorPayload :: Maybe [Element]+ , presenceErrorStanzaError :: StanzaError }+ deriving (Show)+++type InternalPresence = Either PresenceError Presence++ -- |--- @PresenceType@ holds XMPP presence types. When a presence type is not--- provided, we assign the @PresenceType@ value @Available@.+-- @PresenceType@ holds XMPP presence types. The "error" message type is left+-- out as errors are using @PresenceError@. data PresenceType = Subscribe | -- ^ Sender wants to subscribe to presence Subscribed | -- ^ Sender has approved the subscription@@ -214,18 +238,28 @@ -- subscription Probe | -- ^ Sender requests current presence; -- should only be used by servers- Available | -- ^ Sender did not specify a type attribute- Unavailable deriving (Eq, Show)+ Unavailable deriving (Eq) +instance Show PresenceType where+ show Subscribe = "subscribe"+ show Subscribed = "subscribed"+ show Unsubscribe = "unsubscribe"+ show Unsubscribed = "unsubscribed"+ show Probe = "probe"+ show Unavailable = "unavailable"++ -- | -- All stanzas (IQ, message, presence) can cause errors, which in the XMPP -- stream looks like <stanza-kind to='sender' type='error'>. These errors are -- wrapped in the @StanzaError@ type. +-- Sender XML is optional and is not included.+ data StanzaError = StanzaError { stanzaErrorType :: StanzaErrorType , stanzaErrorCondition :: StanzaErrorCondition- , stanzaErrorText :: Maybe String+ , stanzaErrorText :: Maybe (Maybe LangTag, String) , stanzaErrorApplicationSpecificCondition :: Maybe Element } deriving (Eq, Show) @@ -238,9 +272,17 @@ Modify | -- ^ Change the data and retry Auth | -- ^ Provide credentials and retry Wait -- ^ Error is temporary - wait and retry- deriving (Eq, Show)+ deriving (Eq) +instance Show StanzaErrorType where+ show Cancel = "cancel"+ show Continue = "continue"+ show Modify = "modify"+ show Auth = "auth"+ show Wait = "wait"++ -- | -- Stanza errors are accommodated with one of the error conditions listed below. @@ -280,15 +322,75 @@ UndefinedCondition | -- ^ Application-specific -- condition UnexpectedRequest -- ^ Badly timed request- deriving (Eq, Show)+ deriving (Eq) +instance Show StanzaErrorCondition where+ show BadRequest = "bad-request"+ show Conflict = "conflict"+ show FeatureNotImplemented = "feature-not-implemented"+ show Forbidden = "forbidden"+ show Gone = "gone"+ show InternalServerError = "internal-server-error"+ show ItemNotFound = "item-not-found"+ show JIDMalformed = "jid-malformed"+ show NotAcceptable = "not-acceptable"+ show NotAllowed = "not-allowed"+ show NotAuthorized = "not-authorized"+ show PaymentRequired = "payment-required"+ show RecipientUnavailable = "recipient-unavailable"+ show Redirect = "redirect"+ show RegistrationRequired = "registration-required"+ show RemoteServerNotFound = "remote-server-not-found"+ show RemoteServerTimeout = "remote-server-timeout"+ show ResourceConstraint = "resource-constraint"+ show ServiceUnavailable = "service-unavailable"+ show SubscriptionRequired = "subscription-required"+ show UndefinedCondition = "undefined-condition"+ show UnexpectedRequest = "unexpected-request" ++ -- ============================================================================= -- OTHER STUFF -- ============================================================================= +data SASLFailure = SASLFailure { saslFailureCondition :: SASLError+ , saslFailureText :: Maybe String } -- TODO: XMLLang+++data SASLError = -- SASLAborted | -- Client aborted - should not happen+ SASLAccountDisabled | -- ^ The account has been temporarily+ -- disabled+ SASLCredentialsExpired | -- ^ The authentication failed because+ -- the credentials have expired+ SASLEncryptionRequired | -- ^ The mechanism requested cannot be+ -- used the confidentiality and+ -- integrity of the underlying+ -- stream is protected (typically+ -- with TLS)+ -- SASLIncorrectEncoding | -- The base64 encoding is incorrect+ -- - should not happen+ -- SASLInvalidAuthzid | -- The authzid has an incorrect format,+ -- or the initiating entity does not+ -- have the appropriate permissions to+ -- authorize that ID+ SASLInvalidMechanism | -- ^ The mechanism is not supported by+ -- the receiving entity+ -- SASLMalformedRequest | -- Invalid syntax - should not happen+ SASLMechanismTooWeak | -- ^ The receiving entity policy+ -- requires a stronger mechanism+ SASLNotAuthorized (Maybe String) | -- ^ Invalid credentials+ -- provided, or some+ -- generic authentication+ -- failure has occurred+ SASLTemporaryAuthFailure -- ^ There receiving entity reported a+ -- temporary error condition; the+ -- initiating entity is recommended+ -- to try again later++ instance Eq ConnectionState where Disconnected == Disconnected = True (Connected p h) == (Connected p_ h_) = p == p_ && h == h_@@ -330,14 +432,10 @@ -- An XMLEvent is triggered by an XML stanza or some other XML event, and is -- sent through the internal event channel, just like client action events. -data XMLEvent = XEBeginStream String | XEFeatures String |- XEChallenge Challenge | XESuccess Success |- XEEndStream | XEIQ IQ | XEPresence Presence |- XEMessage Message | XEProceed |- XEOther String deriving (Show)- data EnumeratorEvent = EnumeratorDone |- EnumeratorXML XMLEvent |+ EnumeratorBeginStream (Maybe String) (Maybe String) (Maybe String) (Maybe String) (Maybe String) (Maybe String) |+ EnumeratorEndStream |+ EnumeratorFirstLevelElement (Either SomeException Element) | EnumeratorException CE.SomeException deriving (Show) @@ -365,7 +463,7 @@ data ClientEvent s m = CEOpenStream N.HostName PortNumber (OpenStreamResult -> StateT s m ()) |- CESecureWithTLS Certificate (Certificate -> Bool)+ CESecureWithTLS (Maybe [X509]) ([X509] -> Bool) (SecureWithTLSResult -> StateT s m ()) | CEAuthenticate UserName Password (Maybe Resource) (AuthenticateResult -> StateT s m ()) |@@ -376,7 +474,7 @@ instance Show (ClientEvent s m) where show (CEOpenStream h p _) = "CEOpenStream " ++ h ++ " " ++ (show p)- show (CESecureWithTLS c _ _) = "CESecureWithTLS " ++ c+ show (CESecureWithTLS c _ _) = "CESecureWithTLS " ++ (show c) show (CEAuthenticate u p r _) = "CEAuthenticate " ++ u ++ " " ++ p ++ " " ++ (show r) show (CEIQ s _ _ _) = "CEIQ"@@ -413,18 +511,16 @@ data AuthenticateResult = AuthenticateSuccess StreamProperties StreamFeatures Resource | AuthenticateFailure -type Certificate = String -- TODO- -- Address is a data type that has to be constructed in this module using either -- address or stringToAddress. data Address = Address { localpart :: Maybe Localpart- , serverpart :: Serverpart+ , domainpart :: Domainpart , resourcepart :: Maybe Resourcepart } deriving (Eq) instance Show Address where- show (Address { localpart = n, serverpart = s, resourcepart = r })+ show (Address { localpart = n, domainpart = s, resourcepart = r }) | n == Nothing && r == Nothing = s | r == Nothing = let Just n' = n in n' ++ "@" ++ s | n == Nothing = let Just r' = r in s ++ "/" ++ r'@@ -432,7 +528,7 @@ in n' ++ "@" ++ s ++ "/" ++ r' type Localpart = String-type Serverpart = String+type Domainpart = String type Resourcepart = String data ServerAddress = ServerAddress N.HostName N.PortNumber deriving (Eq)@@ -446,12 +542,47 @@ -- XML TYPES -- ============================================================================= -type XMLLang = String--- Validate, protect. See:--- http://tools.ietf.org/html/rfc6120#section-8.1.5--- http://www.w3.org/TR/2008/REC-xml-20081126/--- http://www.rfc-editor.org/rfc/bcp/bcp47.txt--- http://www.ietf.org/rfc/rfc1766.txt - newtype IDGenerator = IDGenerator (IORef [String])+++++--- other stuff++data Version = Version { majorVersion :: Integer+ , minorVersion :: Integer } deriving (Eq)+++-- Version numbers are displayed as "<major>.<minor>".++instance Show Version where+ show (Version major minor) = (show major) ++ "." ++ (show minor)+++-- If the major version numbers are not equal, compare them. Otherwise, compare+-- the minor version numbers.++instance Ord Version where+ compare (Version amajor aminor) (Version bmajor bminor)+ | amajor /= bmajor = compare amajor bmajor+ | otherwise = compare aminor bminor+++data LangTag = LangTag { primaryTag :: String+ , subtags :: [String] }+++-- Displays the language tag in the form of "en-US".++instance Show LangTag where+ show (LangTag p []) = p+ show (LangTag p s) = p ++ "-" ++ (concat $ intersperse "-" s)+++-- Two language tags are considered equal of they contain the same tags (case-insensitive).++instance Eq LangTag where+ (LangTag ap as) == (LangTag bp bs)+ | length as == length bs && map toLower ap == map toLower bp = all (\ (a, b) -> map toLower a == map toLower b) $ zip as bs+ | otherwise = False
Network/XMPP/Utilities.hs view
@@ -1,93 +1,62 @@-{-+-- Copyright © 2010-2011 Jon Kristensen. See the LICENSE file in the Pontarius+-- XMPP distribution for more details. -Copyright © 2010-2011 Jon Kristensen.+-- This module currently converts XML elements to strings. -This file is part of Pontarius XMPP.+-- TODO: Use -fno-cse? http://cvs.haskell.org/Hugs/pages/libraries/base/System-IO-Unsafe.html+-- TODO: Remove elementsToString? -Pontarius XMPP is free software: you can redistribute it and/or modify it under-the terms of the GNU Lesser General Public License as published by the Free-Software Foundation, either version 3 of the License, or (at your option) any-later version.+{-# OPTIONS_HADDOCK hide #-} -Pontarius XMPP 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 Lesser General Public License for more-details.+{-# LANGUAGE OverloadedStrings #-} -You should have received a copy of the GNU Lesser General Public License along-with Pontarius XMPP. If not, see <http://www.gnu.org/licenses/>.+module Network.XMPP.Utilities ( elementToString+ , elementsToString ) where --}+import Prelude hiding (concat) --- |--- Module: $Header$--- Description: Utility functions for Pontarius XMPP; currently only random ID--- generation functions--- Copyright: Copyright © 2010-2011 Jon Kristensen--- License: LGPL-3------ Maintainer: info@pontarius.org--- Stability: unstable--- Portability: portable------ This module will be documented soon.+import Data.ByteString (ByteString, concat)+import Data.ByteString.Char8 (unpack) --- TODO: Document this module--- TODO: Make is possible to customize characters--- TODO: Make it possible to customize length+import Data.Enumerator (($$), Stream (Chunks), Enumerator, Step (Continue), joinI, run_, returnI)+import Data.Enumerator.List (consume) -module Network.XMPP.Utilities ( elementToString- , elementsToString ) where+import Data.XML.Types (Document (..), Element (..), Event (..), Name (..), Prologue (..)) -import Data.Word-import Data.XML.Types-import System.Crypto.Random-import System.Random-import qualified Data.ByteString as DB-import qualified Data.Map as DM-import qualified Data.Text as DT+import Text.XML.Enumerator.Render (renderBytes)+import Text.XML.Enumerator.Document (toEvents) +import System.IO.Unsafe (unsafePerformIO) --- =============================================================================--- XML Utilities--- =============================================================================-+-- Converts the Element objects to a document, converts it into Events, strips+-- the DocumentBegin event, generates a ByteString, and converts it into a+-- String, aggregates the results and returns a string. elementsToString :: [Element] -> String+ elementsToString [] = ""-elementsToString (e:es) = (elementToString $ Just e) ++ elementsToString es+elementsToString (e:es) = (elementToString (Just e)) ++ (elementsToString es) -elementToString :: Maybe Element -> String-elementToString Nothing = ""-elementToString (Just e) = "<" ++ nameToString (elementName e) ++ xmlns ++- attributes (elementAttributes e) ++- ">" ++ (nodesToString $ elementNodes e) ++ "</" ++- nameToString (elementName e) ++ ">"- where- xmlns :: String- xmlns = case nameNamespace $ elementName e of- Nothing -> ""- Just t -> " xmlns='" ++ (DT.unpack t) ++ "'" - nameToString :: Name -> String- nameToString Name { nameLocalName = n, namePrefix = Nothing } = DT.unpack n- nameToString Name { nameLocalName = n, namePrefix = Just p } =- (DT.unpack p) ++ ":" ++ (DT.unpack n)+-- Converts the Element object to a document, converts it into Events, strips+-- the DocumentBegin event, generates a ByteString, and converts it into a+-- String. - contentToString :: Content -> String- contentToString (ContentText t) = DT.unpack t- contentToString (ContentEntity t) = DT.unpack t+{-# NOINLINE elementToString #-} - attributes :: [(Name, [Content])] -> String- attributes [] = ""- attributes ((n, c):t) = (" " ++ (nameToString n) ++ "='" ++- concat (map contentToString c) ++ "'") ++- attributes t+elementToString :: Maybe Element -> String - nodesToString :: [Node] -> String- nodesToString [] = ""- nodesToString ((NodeElement e):ns) = (elementToString $ Just e) ++- (nodesToString ns)- nodesToString ((NodeContent c):ns) = (contentToString c) ++- (nodesToString ns)+elementToString Nothing = ""+elementToString (Just elem) = unpack $ concat $ unsafePerformIO $ do+ r <- run_ $ events $$ (joinI $ renderBytes $$ consume)+ return r+ where++ -- Enumerator that "produces" the events to convert to the document+ events :: Enumerator Event IO [ByteString]+ events (Continue more) = more $ Chunks (tail $ toEvents $ dummyDoc elem)+ events step = returnI step++ dummyDoc :: Element -> Document+ dummyDoc e = Document (Prologue [] Nothing []) elem []
README view
@@ -1,21 +1,21 @@-Pontarius XMPP aims to be a secure and easy-to-use XMPP library for Haskell. We-have just released a fourth alpha version with the following features:+Pontarius XMPP 0.1 aims to implement the client capabilities of RFC 6120 ("XMPP+Core"). We have just released 0.1 Alpha 7, which may be the last version that is+not feature-complete. - * Client-to-server Transport Layer Security and DIGEST-MD5 SASL Authentication- * Concurrent, Flexible and Event-based API for XMPP Client Developers- * Support for Info/Query, Presence and Message Stanzas- * Interoperable XML Parsing (Using enumerator, xml-enumerator and xml-types)+The current version of Pontarius XMPP is broken; the recent rewriting of some+modules broke the Session module. Fixing the Session module is one of the goals+for the next release. Other goals include working on the last missing features,+and improving the documentation and the API. +We will soon move the project into beta.+ Please note that we are not recommending anyone to use Pontarius XMPP at this time as it’s still in an experimental stage and will have its API and data types modified. However, if you are interested to use Pontarius XMPP anyway, feel free-to contact the Pontarius project and we will try to help you get started. You-can also see the Example directory for a usage example.--We are currently working on general improvements and having the library support-all of RFC 3920: XMPP Core.+to contact the Pontarius project and we will try to help you get started. Please+see http://www.pontarius.org/ for documentation and more information. -The next version, 0.1 Alpha 6, is scheduled to be released on the 6th of July.+The next version is scheduled to be released on the 17th of August. Look at the Pontarius web site <http://www.pontarius.org/> and the Pontarius XMPP Hackage page <http://hackage.haskell.org/package/pontarius-xmpp/> for more
− install.sh
@@ -1,5 +0,0 @@-#!/bin/sh-runhaskell Setup.hs configure --user-runhaskell Setup.hs build-runhaskell Setup.hs install-
+ nohup.out view
@@ -0,0 +1,942 @@+Using default Yi configuration+Now updating system metadata ...+***server start+Bind 127.0.0.1:26411+Error reading cabal file "/home/Jon/.leksah-0.10/packageSources/blaze-builder-enumerator-0.2.0.2/blaze-builder-enumerator.cabal" "/home/Jon/.leksah-0.10/packageSources/blaze-builder-enumerator-0.2.0.2/blaze-builder-enumerator.cabal" (line 41, column 1):+unexpected end of input+expecting cabal minimal+update_toolbar 0.0+update_toolbar 0.1+--2011-07-12 14:23:11-- http://www.leksah.org/metadata-0.10/pontarius-xmpp-0.0.6.0.lkshm+Resolving www.leksah.org... 87.230.23.84+Connecting to www.leksah.org|87.230.23.84|:80... connected.+HTTP request sent, awaiting response... 404 Not Found+2011-07-12 14:23:12 ERROR 404: Not Found.++update_toolbar 0.2+--2011-07-12 14:23:18-- http://www.leksah.org/metadata-0.10/enumerator-0.4.11.lkshm+Resolving www.leksah.org... 87.230.23.84+Connecting to www.leksah.org|87.230.23.84|:80... connected.+HTTP request sent, awaiting response... 404 Not Found+2011-07-12 14:23:18 ERROR 404: Not Found.++update_toolbar 0.3+--2011-07-12 14:23:24-- http://www.leksah.org/metadata-0.10/uuid-1.2.2.lkshm+Resolving www.leksah.org... 87.230.23.84+Connecting to www.leksah.org|87.230.23.84|:80... connected.+HTTP request sent, awaiting response... 404 Not Found+2011-07-12 14:23:24 ERROR 404: Not Found.++Creating interfaces...+Checking module Network.XMPP.Utilities...+Creating interface...+haddock coverage for ./Network/XMPP/Utilities.hs: 1/3 33%+Checking module Network.XMPP.Types...+Creating interface...+haddock coverage for ./Network/XMPP/Types.hs: 18/45 40%+Checking module Network.XMPP.TLS...+Creating interface...+haddock coverage for ./Network/XMPP/TLS.hs: 1/3 33%+Checking module Network.XMPP.SASL...+Creating interface...+haddock coverage for ./Network/XMPP/SASL.hs: 0/2 0%+Checking module Network.XMPP.Address...+Creating interface...+haddock coverage for ./Network/XMPP/Address.hs: 5/5 100%+Checking module Network.XMPP.Stanza...+Creating interface...+haddock coverage for ./Network/XMPP/Stanza.hs: 11/11 100%+Checking module Network.XMPP.Stream...+Creating interface...+haddock coverage for ./Network/XMPP/Stream.hs: 1/10 10%+Checking module Network.XMPP.Session...+Creating interface...+haddock coverage for ./Network/XMPP/Session.hs: 5/19 26%+Checking module Network.XMPP...+Creating interface...+haddock coverage for ./Network/XMPP.hs: 24/47 51%+Attaching instances...+Building cross-linking environment...+Renaming interfaces...+Warning: Network.XMPP.Utilities: could not find link destinations for:+ Data.Maybe.Maybe Data.XML.Types.Element GHC.Base.String+Warning: Network.XMPP.Types: could not find link destinations for:+ GHC.Base.String GHC.Classes.Eq GHC.Show.Show Data.Maybe.Maybe Data.XML.Types.Element GHC.Integer.Type.Integer GHC.Exception.SomeException Network.TLS.Core.TLSCtx GHC.IO.Handle.Types.Handle Network.Socket.HostName Control.Monad.Trans.State.Lazy.StateT GHC.Bool.Bool Network.XMPP.Types.StreamProperties Network.XMPP.Types.StreamFeatures Network.Socket.Internal.PortNumber Control.Monad.Trans.Error.Error GHC.Types.Int GHC.IORef.IORef+Warning: Network.XMPP.TLS: could not find link destinations for:+ Network.TLS.Core.TLSParams GHC.IO.Handle.Types.Handle GHC.Base.String GHC.Types.IO Data.Maybe.Maybe Network.TLS.Core.TLSCtx+Warning: Network.XMPP.SASL: could not find link destinations for:+ GHC.Base.String Data.Either.Either Network.XMPP.SASL.Challenge1Error+Warning: Network.XMPP.Address: could not find link destinations for:+ GHC.Base.String Data.Maybe.Maybe GHC.Bool.Bool+Warning: Network.XMPP.Stanza: could not find link destinations for:+ Data.Maybe.Maybe Data.XML.Types.Element GHC.Base.String GHC.Types.IO+Warning: Network.XMPP.Stream: could not find link destinations for:+ GHC.Bool.Bool Control.Concurrent.Chan.Chan Data.Either.Either GHC.IO.Handle.Types.Handle Network.TLS.Core.TLSCtx GHC.Types.IO Data.Enumerator.Iteratee Data.XML.Types.Event Data.Maybe.Maybe GHC.Base.String Data.XML.Types.Element+Warning: Network.XMPP.Session: could not find link destinations for:+ Control.Monad.IO.Class.MonadIO Data.Maybe.Maybe Control.Monad.Trans.State.Lazy.StateT GHC.Bool.Bool Network.XMPP.Types.StreamProperties Network.XMPP.Types.StreamFeatures GHC.Base.String+Warning: Network.XMPP: could not find link destinations for:+ Data.Maybe.Maybe GHC.Classes.Eq GHC.Show.Show GHC.Base.String GHC.Bool.Bool Data.Either.Either Network.XMPP.SASL.Challenge1Error Control.Monad.IO.Class.MonadIO Control.Monad.Trans.State.Lazy.StateT Network.XMPP.Types.StreamProperties Network.XMPP.Types.StreamFeatures GHC.Integer.Type.Integer Data.XML.Types.Element+9+Creating interfaces...+Checking module Data.Enumerator.Util...+Creating interface...+haddock coverage for hs/Data/Enumerator/Util.hs: 0/7 0%+Checking module Data.Enumerator...+Checking module Data.Enumerator.List...+Checking module Data.Enumerator...+Creating interface...+haddock coverage for hs/Data/Enumerator.hs: 72/73 99%+Checking module Data.Enumerator.List...+Creating interface...+haddock coverage for hs/Data/Enumerator/List.hs: 42/42 100%+Checking module Data.Enumerator.Binary...+Creating interface...+haddock coverage for hs/Data/Enumerator/Binary.hs: 47/47 100%+Checking module Data.Enumerator.Text...+Creating interface...+haddock coverage for hs/Data/Enumerator/Text.hs: 49/57 86%+Checking module Data.Enumerator.IO...+Creating interface...+haddock coverage for hs/Data/Enumerator/IO.hs: 4/4 100%+Attaching instances...+Building cross-linking environment...+Renaming interfaces...+Warning: Data.Enumerator.Util: could not find link destinations for:+ GHC.Types.Int GHC.Base.String GHC.Types.Char GHC.Word.Word8 GHC.Bool.Bool Data.Text.Internal.Text Data.Text.Lazy.Internal.Text+Warning: Data.Enumerator: could not find link destinations for:+ GHC.Base.Monad GHC.Base.Functor Data.Typeable.Typeable1 Control.Applicative.Applicative GHC.Classes.Eq GHC.Show.Show Data.Monoid.Monoid Control.Monad.Trans.Class.MonadTrans Data.Typeable.Typeable Control.Monad.IO.Class.MonadIO GHC.Exception.SomeException Data.Either.Either GHC.Exception.Exception GHC.Bool.Bool GHC.Types.IO GHC.Integer.Type.Integer Data.Maybe.Maybe+Warning: Data.Enumerator.List: could not find link destinations for:+ GHC.Base.Monad GHC.Integer.Type.Integer Data.Maybe.Maybe GHC.Bool.Bool GHC.Classes.Ord+Warning: Data.Enumerator.Binary: could not find link destinations for:+ Control.Monad.IO.Class.MonadIO GHC.Integer.Type.Integer GHC.IO.Handle.Types.Handle Data.ByteString.Internal.ByteString Data.Maybe.Maybe GHC.IO.FilePath GHC.Types.IO GHC.Base.Monad GHC.Word.Word8 GHC.Bool.Bool Data.ByteString.Lazy.Internal.ByteString+Warning: Data.Enumerator.Text: could not find link destinations for:+ Control.Monad.IO.Class.MonadIO GHC.IO.Handle.Types.Handle Data.Text.Internal.Text GHC.IO.FilePath GHC.Types.IO GHC.Base.Monad GHC.Types.Char GHC.Integer.Type.Integer Data.Maybe.Maybe GHC.Bool.Bool Data.Text.Lazy.Internal.Text GHC.Show.Show Data.ByteString.Internal.ByteString+Warning: Data.Enumerator.IO: could not find link destinations for:+ Control.Monad.IO.Class.MonadIO GHC.Integer.Type.Integer GHC.IO.Handle.Types.Handle Data.ByteString.Internal.ByteString GHC.IO.FilePath GHC.Types.IO+6+Creating interfaces...+Checking module Data.UUID.Builder...+Creating interface...+Warning: Data.UUID.Builder: Instances of type and data families are not yet supported. Instances of the following families will be filtered out:+ ByteSink+haddock coverage for ./Data/UUID/Builder.hs: 2/7 29%+Checking module Data.UUID.Internal...+Creating interface...+Warning: Data.UUID.Internal: Instances of type and data families are not yet supported. Instances of the following families will be filtered out:+ ByteSink+haddock coverage for ./Data/UUID/Internal.hs: 12/12 100%+Checking module Data.UUID.Named...+Creating interface...+haddock coverage for ./Data/UUID/Named.hs: 6/6 100%+Checking module Data.UUID.V5...+Creating interface...+haddock coverage for ./Data/UUID/V5.hs: 6/6 100%+Checking module Data.UUID.V3...+Creating interface...+haddock coverage for ./Data/UUID/V3.hs: 6/6 100%+Checking module Data.UUID.V1...+Creating interface...+Warning: Data.UUID.V1: Instances of type and data families are not yet supported. Instances of the following families will be filtered out:+ ByteSink+haddock coverage for ./Data/UUID/V1.hs: 2/2 100%+Checking module Data.UUID...+Creating interface...+haddock coverage for ./Data/UUID.hs: 10/10 100%+Attaching instances...+Building cross-linking environment...+Renaming interfaces...+Warning: Data.UUID.Builder: could not find link destinations for:+ GHC.Types.Int GHC.Word.Word8 GHC.Word.Word16 GHC.Word.Word32 Data.UUID.Internal.ThreeByte Data.UUID.V1.MACSource+Warning: Data.UUID.Internal: could not find link destinations for:+ GHC.Word.Word32 GHC.Classes.Eq Data.Data.Data GHC.Classes.Ord GHC.Read.Read GHC.Show.Show Data.Typeable.Typeable Foreign.Storable.Storable Data.Binary.Binary System.Random.Random GHC.Bool.Bool Data.ByteString.Lazy.Internal.ByteString Data.Maybe.Maybe GHC.Base.String GHC.Word.Word8+Warning: Data.UUID.Named: could not find link destinations for:+ GHC.Word.Word8 GHC.Word.Word32+Warning: Data.UUID.V5: could not find link destinations for:+ GHC.Word.Word8+Warning: Data.UUID.V3: could not find link destinations for:+ GHC.Word.Word8+Warnupdate_toolbar 0.4+--2011-07-12 14:23:30-- http://www.leksah.org/metadata-0.10/maccatcher-2.1.1.lkshm+Resolving www.leksah.org... 87.230.23.84+Connecting to www.leksah.org|87.230.23.84|:80... connected.+HTTP request sent, awaiting response... 404 Not Found+2011-07-12 14:23:30 ERROR 404: Not Found.++update_toolbar 0.5+--2011-07-12 14:23:35-- http://www.leksah.org/metadata-0.10/Crypto-4.2.3.lkshm+Resolving www.leksah.org... 87.230.23.84+Connecting to www.leksah.org|87.230.23.84|:80... connected.+HTTP request sent, awaiting response... 404 Not Found+2011-07-12 14:23:35 ERROR 404: Not Found.++update_toolbar 0.6+--2011-07-12 14:23:41-- http://www.leksah.org/metadata-0.10/happstack-server-6.1.5.lkshm+Resolving www.leksah.org... 87.230.23.84+Connecting to www.leksah.org|87.230.23.84|:80... connected.+HTTP request sent, awaiting response... 404 Not Found+2011-07-12 14:23:42 ERROR 404: Not Found.++ing: Data.UUID.V1: could not find link destinations for:+ GHC.Types.IO Data.Maybe.Maybe+Warning: Data.UUID: could not find link destinations for:+ GHC.Classes.Eq Data.Data.Data GHC.Classes.Ord GHC.Read.Read GHC.Show.Show Data.Typeable.Typeable Foreign.Storable.Storable Data.Binary.Binary System.Random.Random GHC.Base.String Data.Maybe.Maybe Data.ByteString.Lazy.Internal.ByteString GHC.Word.Word32 GHC.Bool.Bool+7+Creating interfaces...+Checking module Data.MAC...+Creating interface...+haddock coverage for ./Data/MAC.hs: 1/2 50%+Checking module System.Info.MAC.Fetch...+Creating interface...+haddock coverage for ./System/Info/MAC/Fetch.hs: 5/13 38%+Checking module System.Info.MAC...+Creating interface...+haddock coverage for ./System/Info/MAC.hs: 6/6 100%+Attaching instances...+Building cross-linking environment...+Renaming interfaces...+Warning: Data.MAC: could not find link destinations for:+ GHC.Word.Word8 GHC.Enum.Bounded GHC.Classes.Eq GHC.Classes.Ord GHC.Read.Read GHC.Show.Show Foreign.Storable.Storable Data.Binary.Binary+Warning: System.Info.MAC.Fetch: could not find link destinations for:+ GHC.Types.IO GHC.Base.String Text.Parsec.String.Parser Data.Maybe.Maybe GHC.Types.Char+Warning: System.Info.MAC: could not find link destinations for:+ GHC.Types.IO Data.Maybe.Maybe GHC.Base.String+3+Creating interfaces...+Checking module Data.Digest.MD5Aux...+Creating interface...+haddock coverage for ./Data/Digest/MD5Aux.hs: 0/10 0%+Checking module Codec.Encryption.DESAux...+Creating interface...+haddock coverage for ./Codec/Encryption/DESAux.hs: 0/3 0%+Checking module Codec.Encryption.BlowfishAux...+Creating interface...+haddock coverage for ./Codec/Encryption/BlowfishAux.hs: 0/4 0%+Checking module Data.Digest.SHA2...+Creating interface...+haddock coverage for ./Data/Digest/SHA2.hs: 6/14 43%+Checking module Codec.Utils...+Creating interface...+haddock coverage for ./Codec/Utils.hs: 11/12 92%+Checking module Data.Digest.MD5...+Creating interface...+haddock coverage for ./Data/Digest/MD5.hs: 3/3 100%+Checking module Data.Digest.SHA1...+Creating interface...+haddock coverage for ./Data/Digest/SHA1.hs: 1/5 20%+Checking module Data.Digest.SHA224...+Creating interface...+haddock coverage for ./Data/Digest/SHA224.hs: 3/3 100%+Checking module Data.Digest.SHA256...+Creating interface...+haddock coverage for ./Data/Digest/SHA256.hs: 3/3 100%+Checking module Data.Digest.SHA384...+Creating interface...+haddock coverage for ./Data/Digest/SHA384.hs: 3/3 100%+Checking module Data.Digest.SHA512...+Creating interface...+haddock coverage for ./Data/Digest/SHA512.hs: 3/3 100%+Checking module Data.HMAC...+Creating interface...+haddock coverage for ./Data/HMAC.hs: 7/7 100%+Checking module Codec.Encryption.AESAux...+Creating interface...+haddock coverage for ./Codec/Encryption/AESAux.hs: 1/7 14%+Checking module Codec.Text.Raw...+Creating interface...+haddock coverage for ./Codec/Text/Raw.hs: 1/3 33%+Checking module Codec.Encryption.Padding...+Creating interface...+haddock coverage for ./Codec/Encryption/Padding.hs: 6/6 100%+Checking module Codec.Encryption.Modes...+Creating interface...+haddock coverage for ./Codec/Encryption/Modes.hs: 4/4 100%+Checking module Codec.Encryption.Blowfish...+Creating interface...+haddock coverage for ./Codec/Encryption/Blowfish.hs: 4/4 100%+Checking module Codec.Encryption.TEA...+Creating interface...+haddock coverage for ./Codec/Encryption/TEA.hs: 1/4 25%+Checking module Codec.Encryption.DES...+Creating interface...+haddock coverage for ./Codec/Encryption/DES.hs: 4/4 100%+Checking module Codec.Encryption.RSA.NumberTheory...+Creating interface...+haddock coverage for ./Codec/Encryption/RSA/NumberTheory.hs: 0/14 0%+Checking module Codec.Encryption.RSA.MGF...+Creating interface...+haddock coverage for ./Codec/Encryption/RSA/MGF.hs: 3/3 100%+Checking module Codec.Encryption.RSA.EMEOAEP...+Creating interface...+haddock coverage for ./Codec/Encryption/RSA/EMEOAEP.hs: 4/4 100%+Checking module Codec.Encryption.RSA...+Creating interface...+haddock coverage for ./Codec/Encryption/RSA.hs: 4/4 100%+Checking module Codec.Binary.BubbleBabble...+Creating interface...+haddock coverage for ./Codec/Binary/BubbleBabble.hs: 1/2 50%+Checking module Data.LargeWord...+Creating interface...+haddock coverage for ./Data/LargeWord.hs: 1/8 12%+Checking module Codec.Encryption.AES...+Creating interface...+haddock coverage for ./Codec/Encryption/AES.hs: 4/5 80%+Attaching instances...+Building cross-linking environment...+Renaming interfaces...+Warning: Data.Digest.MD5Aux: could not find link destinations for:+ GHC.Base.String GHC.Integer.Type.Integer GHC.Word.Word32 GHC.Types.Int GHC.Bool.Bool GHC.Classes.Eq GHC.Num.Num GHC.Show.Show GHC.Word.Word64+Warning: Codec.Encryption.DESAux: could not find link destinations for:+ Codec.Encryption.DESAux.Message Codec.Encryption.DESAux.Key Codec.Encryption.DESAux.Enc+Warning: Codec.Encryption.BlowfishAux: could not find link destinations for:+ GHC.Types.Char Codec.Encryption.BlowfishAux.BF GHC.Word.Word32+Warning: Data.Digest.SHA2: could not find link destinations for:+ Data.Bits.Bits GHC.Real.Integral GHC.Base.String Data.Digest.SHA2.Hash8 GHC.Word.Word32 GHC.Word.Word64 GHC.Classes.Eq GHC.Classes.Ord GHC.Show.Show Data.Digest.SHA2.Hash GHC.Word.Word8+Warning: Codec.Utils: could not find link destinations for:+ GHC.Word.Word8 GHC.Types.Int GHC.Real.Integral Data.Bits.Bits+Warning: Data.Digest.SHA1: could not find link destinations for:+ GHC.Word.Word32 GHC.Classes.Eq GHC.Show.Show GHC.Word.Word8 GHC.Integer.Type.Integer+Warning: Data.HMAC: could not find link destinations for:+ GHC.Types.Int+Warning: Codec.Text.Raw: could not find link destinations for:+ Codec.Text.Raw.OctetsPerLine Text.PrettyPrint.HughesPJ.Doc GHC.Base.String+Warning: Codec.Encryption.Padding: could not find link destinations for:+ GHC.Real.Integral Data.Bits.Bits+Warning: Codec.Encryption.Modes: could not find link destinations for:+ Data.Bits.Bits+Warning: Codec.Encryption.Blowfish: could not find link destinations for:+ GHC.Real.Integral GHC.Word.Word64+Warning: Codec.Encryption.TEA: could not find link destinations for:+ GHC.Word.Word32 GHC.Word.Word64+Warning: Codec.Encryption.DES: could not find link destinations for:+ GHC.Word.Word64+Warning: Codec.Encryption.RSA.NumberTheory: could not find link destinations for:+ GHC.Integer.Type.Integer GHC.Bool.Bool GHC.Types.Int GHC.Types.IO GHC.Base.String+Warning: Codec.Encryption.RSA.MGF: could not find link destinations for:+ GHC.Types.Int+Warning: Codec.Encryption.RSA.EMEOAEP: could not find link destinations for:+ GHC.Types.Int+Warning: Codec.Binary.BubbleBabble: could not find link destinations for:+ GHC.Base.String+Warning: Data.LargeWord: could not find link destinations for:+ Codec.Encryption.AES.AESKeyIndirection GHC.Classes.Ord Data.Bits.Bits GHC.Enum.Bounded GHC.Real.Integral Data.LargeWord.LargeWord GHC.Enum.Enum GHC.Classes.Eq GHC.Num.Num GHC.Real.Real GHC.Show.Show GHC.Word.Word32 GHC.Word.Word64+Warning: Codec.Encryption.AES: could not find link destinations for:+ Codec.Encryption.AES.AESKeyIndirection+26+Creating interfaces...+Checking module Paths_happstack_server...+Creating interface...+haddock coverage for dist/build/autogen/Paths_happstack_server.hs: 0/7 0%+Checking module Happstack.Server.SURI.ParseURI...+Creating interface...+haddock coverage for src/Happstack/Server/SURI/ParseURI.hs: 0/2 0%+Checking module Happstack.Server.Internal.SocketTH...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/SocketTH.hs: 0/2 0%+Checking module Happstack.Server.Internal.Socket...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/Socket.hs: 1/2 50%+Checking module Happstack.Server.Internal.RFC822Headers...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/RFC822Headers.hs: 9/21 43%+Checking module Happstack.Server.Internal.LazyLiner...+Creating interface...+Warning: Couldn't find .haddock for exported Happstack.Server.Internal.LazyLiner.toChunks: bytestring-0.9.1.10:Data.ByteString.Lazy.toChunks+haddock coverage for src/Happstack/Server/Internal/LazyLiner.hs: 0/8 0%+Checking module Happstack.Server.Internal.Clock...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/Clock.hs: 0/5 0%+Checking module Happstack.Server.HTTPClient.Stream...+Creating interface...+haddock coverage for src/Happstack/Server/HTTPClient/Stream.hs: 7/11 64%+Checking module Happstack.Server.HTTPClient.TCP...+Creating interface...+haddock coverage for src/Happstack/Server/HTTPClient/TCP.hs: 7/7 100%+Checking module Happstack.Server.HTTPClient.HTTP...+Creating interface...+haddock coverage for src/Happstack/Server/HTTPClient/HTTP.hs: 20/29 69%+Checking module Happstack.Server.SURI...+Creating interface...+haddock coverage for src/Happstack/Server/SURI.hs: 12/16 75%+Checking module Happstack.Server.Internal.TimeoutManager...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/TimeoutManager.hs: 0/9 0%+Checking module Happstack.Server.Internal.TimeoutSocket...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/TimeoutSocket.hs: 1/5 20%+Checking module Happstack.Server.Internal.Cookie...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/Cookie.hs: 8/12 67%+Checking module Happstack.Server.Internal.Types...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/Types.hs: 41/42 98%+Checking module Happstack.Server.Types...+Creating interface...+haddock coverage for src/Happstack/Server/Types.hs: 41/42 98%+Checking module Happstack.Server.Internal.Monads...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/Monads.hs: 27/33 82%+Checking module Happstack.Server.Response...+Creating interface...+haddock coverage for src/Happstack/Server/Response.hs: 23/23 100%+Checking module Happstack.Server.Validation...+Creating interface...+haddock coverage for src/Happstack/Server/Validation.hs: 8/8 100%+Checking module Happstack.Server.Internal.Multipart...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/Multipart.hs: 6/31 19%+Checking module Happstack.Server.Internal.MessageWrap...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/MessageWrap.hs: 6/11 55%+Checking module Happstack.Server.Internal.Handler...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/Handler.hs: 2/4 50%+Checking module Happstack.Server.Internal.Listen...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/Listen.hs: 2/5 40%+Checking module Happstack.Server.Internal.LowLevel...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/LowLevel.hs: 8/9 89%+Checking module Happstack.Server.Client...+Creating interface...+haddock coverage for src/Happstack/Server/Client.hs: 2/2 100%+Checking module Happstack.Server.Cookie...+Creating interface...+haddock coverage for src/Happstack/Server/Cookie.hs: 7/7 100%+Checking module Happstack.Server.RqData...+Creating interface...+haddock coverage for src/Happstack/Server/RqData.hs: 46/46 100%+Checking module Happstack.Server.Monads...+Creating interface...+haddock coverage for src/Happstack/Server/Monads.hs: 25/25 100%+Checking module Happstack.Server.Error...+Creating interface...+haddock coverage for src/Happstack/Server/Error.hs: 4/4 100%+Checking module Happstack.Server.FileServe.BuildingBlocks...+Creating interface...+haddock coverage for src/Happstack/Server/FileServe/BuildingBlocks.hs: 32/35 91%+Checking module Happstack.Server.FileServe...+Creating interface...+haddock coverage for src/Happstack/Server/FileServe.hs: 14/14 100%+Checking module Happstack.Server.Proxy...+Creating interface...+haddock coverage for src/Happstack/Server/Proxy.hs: 4/6 67%+Checking module Happstack.Server.Routing...+Creating interface...+haddock coverage for src/Happstack/Server/Routing.hs: 21/21 100%+Checking module Happstack.Server.Auth...+Creating interface...+haddock coverage for src/Happstack/Server/Auth.hs: 2/2 100%+Checking module Happstack.Server.SimpleHTTP...+Creating interface...+doc comment parse failed: Bind to ip and port and return the socket for use with 'simpleHTTPWithSocket'.+ >+ > import Happstack.Server+ >+ > main = do let conf = nullConf+ > addr = "127.0.0.1"+ > s <- bindIPv4 addr (port conf)+ > simpleHTTPWithSocket s conf $ ok $ toResponse $ + > "now listening on ip addr " ++ addr ++ + > " and port " ++ show (port conf)+haddock coverage for src/Happstack/Server/SimpleHTTP.hs: 29/30 97%+Checking module Happstack.Server.Internal.Compression...+Creating interface...+haddock coverage for src/Happstack/Server/Internal/Compression.hs: 6/6 100%+Checking module Happstack.Server.Compression...+Creating interface...+haddock coverage for src/Happstack/Server/Compression.hs: 2/2 100%+Checking module Happstack.Server.XSLT...+Creating interface...+haddock coverage for src/Happstack/Server/XSLT.hs: 8/14 57%+Checking module Happstack.Server...+Creating interface...+haddock coverage for src/Happstack/Server.hs: 27/27 100%+Attaching instances...+Building cross-linking environment...+Renaming interfaces...+Warning: Paths_happstack_server: could not find link destinations for:+ Data.Version.Version GHC.Types.IO GHC.IO.FilePath+Warning: Happstack.Server.SURI.ParseURI: could not find link destinations for:+ Data.ByteString.Internal.ByteString Network.URI.URI+Warning: Happstack.Server.Internal.SocketTH: could not find link destinations for:+ GHC.Bool.Bool+Warning: Happstack.Server.Internal.Socket: could not find link destinations for:+ Network.Socket.Socket GHC.Types.IO Network.Socket.HostName Network.Socket.Internal.PortNumber+Warning: Happstack.Server.Internal.LazyLiner: could not find link destinations for:+ GHC.IO.Handle.Types.Handle GHC.Types.IO Data.ByteString.Internal.ByteString GHC.Types.Int Data.ByteString.Lazy.Internal.ByteString+Warning: Happstack.Server.Internal.Clock: could not find link destinations for:+ GHC.Types.IO Data.ByteString.Internal.ByteString Data.Time.Clock.POSIX.POSIXTime Data.Time.Clock.UTC.UTCTime GHC.Base.String+Warning: Happstack.Server.HTTPClient.Stream: could not find link destinations for:+ GHC.Types.IO GHC.Base.String GHC.Types.Int Network.Socket.Socket GHC.Classes.Eq GHC.Show.Show Data.Either.Either GHC.Exception.SomeException+Warning: Happstack.Server.HTTPClient.TCP: could not find link destinations for:+ Network.Socket.Socket Network.Socket.Internal.SockAddr GHC.Base.String GHC.Classes.Eq GHC.IORef.IORef GHC.Types.IO GHC.Types.Int GHC.Bool.Bool+Warning: Happstack.Server.HTTPClient.HTTP: could not find link destinations for:+ GHC.Base.String Network.URI.URI GHC.Show.Show Happstack.Server.HTTPClient.HTTP.ResponseCode GHC.Classes.Eq GHC.Types.IO Data.Maybe.Maybe+Warning: Happstack.Server.SURI: could not find link destinations for:+ GHC.Base.String GHC.Bool.Bool Network.URI.URI GHC.Classes.Eq Data.Data.Data GHC.Classes.Ord GHC.Read.Read GHC.Show.Show Data.Typeable.Typeable Data.Maybe.Maybe+Warning: Happstack.Server.Internal.TimeoutManager: could not find link destinations for:+ GHC.Types.Int GHC.Types.IO+Warning: Happstack.Server.Internal.TimeoutSocket: could not find link destinations for:+ Network.Socket.Socket Data.ByteString.Lazy.Internal.ByteString GHC.Types.IO GHC.IO.FilePath Network.Socket.SendFile.Offset Network.Socket.SendFile.ByteCount Network.Socket.SendFile.Iter.Iter+Warning: Happstack.Server.Internal.Cookie: could not find link destinations for:+ GHC.Base.String GHC.Bool.Bool GHC.Classes.Eq Data.Data.Data GHC.Read.Read GHC.Show.Show Data.Typeable.Typeable Control.Monad.Reader.Class.MonadReader Happstack.Util.Common.Seconds Data.Time.Clock.UTC.UTCTime GHC.Classes.Ord GHC.Types.IO Data.Maybe.Maybe GHC.Base.Monad Dupdate_toolbar 0.7+--2011-07-12 14:24:23-- http://www.leksah.org/metadata-0.10/idna2008-0.0.1.0.lkshm+Resolving www.leksah.org... 87.230.23.84+Connecting to www.leksah.org|87.230.23.84|:80... connected.+HTTP request sent, awaiting response... 404 Not Found+2011-07-12 14:24:23 ERROR 404: Not Found.++ata.ByteString.Internal.ByteString Data.Either.Either Text.Parsec.String.GenParser GHC.Types.Char+Warning: Happstack.Server.Internal.Types: could not find link destinations for:+ GHC.Base.String GHC.MVar.MVar GHC.Show.Show Data.Typeable.Typeable Happstack.Server.Internal.Types.HasHeaders GHC.Types.Int Data.ByteString.Lazy.Internal.ByteString Data.Maybe.Maybe GHC.Types.IO GHC.IO.FilePath GHC.Integer.Type.Integer Control.Monad.Trans.Error.Error GHC.Base.Monad GHC.Read.Read Data.Either.Either Control.Monad.Reader.Class.MonadReader Data.ByteString.Internal.ByteString Control.Monad.IO.Class.MonadIO GHC.Bool.Bool Data.Time.Format.FormatTime GHC.Classes.Eq GHC.Enum.Enum GHC.Classes.Ord Data.Data.Data Data.Map.Map+Warning: Happstack.Server.Types: could not find link destinations for:+ GHC.Base.String GHC.MVar.MVar GHC.Show.Show Data.Typeable.Typeable Happstack.Server.Internal.Types.HasHeaders GHC.Types.Int Data.ByteString.Lazy.Internal.ByteString Data.Maybe.Maybe GHC.Types.IO GHC.IO.FilePath GHC.Integer.Type.Integer Control.Monad.Trans.Error.Error GHC.Base.Monad GHC.Read.Read Data.Either.Either Control.Monad.Reader.Class.MonadReader Data.ByteString.Internal.ByteString Control.Monad.IO.Class.MonadIO GHC.Bool.Bool Data.Time.Format.FormatTime GHC.Classes.Eq GHC.Enum.Enum GHC.Classes.Ord Data.Data.Data Data.Map.Map+Warning: Happstack.Server.Internal.Monads: could not find link destinations for:+ GHC.Types.IO Control.Monad.Trans.Reader.ReaderT Control.Monad.Trans.Class.MonadTrans GHC.Base.Monad Control.Monad.State.Class.MonadState Control.Monad.Reader.Class.MonadReader Control.Monad.Error.Class.MonadError Control.Monad.Writer.Class.MonadWriter GHC.Base.Functor Control.Monad.MonadPlus Control.Applicative.Applicative Control.Monad.IO.Class.MonadIO Control.Applicative.Alternative Data.Monoid.Monoid Control.Monad.Trans.Error.Error Control.Monad.Trans.Error.ErrorT GHC.Classes.Eq GHC.Show.Show Data.Monoid.Dual Data.Monoid.Endo Control.Monad.Trans.Writer.Lazy.WriterT Control.Monad.Maybe.MaybeT Data.Maybe.Maybe Data.Either.Either GHC.Base.String+Warning: Happstack.Server.Response: could not find link destinations for:+ Data.ByteString.Internal.ByteString Data.ByteString.Lazy.Internal.ByteString GHC.Integer.Type.Integer GHC.Base.String Data.Text.Internal.Text Data.Text.Lazy.Internal.Text Text.Blaze.Internal.Html Text.Html.Html Text.XHtml.Internals.Html Data.Maybe.Maybe GHC.Base.Functor GHC.Types.Int System.Time.CalendarTime+Warning: Happstack.Server.Validation: could not find link destinations for:+ GHC.Types.IO GHC.Base.Monad Control.Monad.IO.Class.MonadIO GHC.IO.FilePath GHC.Base.String Data.Maybe.Maybe Data.ByteString.Internal.ByteString GHC.Bool.Bool+Warning: Happstack.Server.Internal.Multipart: could not find link destinations for:+ Data.ByteString.Lazy.Internal.ByteString GHC.Bool.Bool GHC.Classes.Eq GHC.Classes.Ord GHC.Read.Read GHC.Show.Show GHC.Base.String GHC.Types.IO Data.Maybe.Maybe Happstack.Server.Internal.RFC822Headers.Header GHC.IO.FilePath GHC.Int.Int64 GHC.IO.Handle.Types.Handle+Warning: Happstack.Server.Internal.MessageWrap: could not find link destinations for:+ GHC.Base.String GHC.Int.Int64 GHC.IO.FilePath Control.Monad.IO.Class.MonadIO Data.Maybe.Maybe Data.ByteString.Lazy.Internal.ByteString GHC.Types.IO GHC.Read.Read GHC.Types.Char GHC.Types.Double GHC.Types.Float GHC.Types.Int+Warning: Happstack.Server.Internal.Handler: could not find link destinations for:+ Network.Socket.Socket GHC.Types.IO Data.ByteString.Lazy.Internal.ByteString Data.Either.Either GHC.Base.String GHC.IO.Handle.Types.Handle+Warning: Happstack.Server.Internal.Listen: could not find link destinations for:+ GHC.Types.IO Network.Socket.Socket GHC.Types.Int GHC.Base.String+Warning: Happstack.Server.Client: could not find link destinations for:+ GHC.Types.IO Data.Either.Either GHC.Base.String+Warning: Happstack.Server.Cookie: could not find link destinations for:+ GHC.Base.String GHC.Bool.Bool GHC.Classes.Eq Data.Data.Data GHC.Read.Read GHC.Show.Show Data.Typeable.Typeable Control.Monad.Reader.Class.MonadReader Happstack.Util.Common.Seconds Data.Time.Clock.UTC.UTCTime GHC.Classes.Ord Control.Monad.IO.Class.MonadIO+Warning: Happstack.Server.RqData: could not find link destinations for:+ GHC.Base.Functor GHC.Base.Monad GHC.Base.String Data.Text.Lazy.Internal.Text Data.ByteString.Lazy.Internal.ByteString GHC.Read.Read GHC.IO.FilePath Data.Either.Either Control.Monad.MonadPlus Control.Monad.IO.Class.MonadIO GHC.Int.Int64 Control.Applicative.Applicative Control.Applicative.Alternative Control.Monad.Reader.Class.MonadReader Data.Typeable.Typeable1 GHC.Classes.Eq Data.Data.Data GHC.Classes.Ord GHC.Show.Show Control.Monad.Trans.Error.Error Data.Monoid.Monoid Data.Maybe.Maybe+Warning: Happstack.Server.Monads: could not find link destinations for:+ Control.Monad.Trans.Class.MonadTrans GHC.Base.Monad Control.Monad.State.Class.MonadState Control.Monad.Reader.Class.MonadReader Control.Monad.Error.Class.MonadError Control.Monad.Writer.Class.MonadWriter GHC.Base.Functor Control.Monad.MonadPlus Control.Applicative.Applicative Control.Monad.IO.Class.MonadIO Control.Applicative.Alternative Data.Monoid.Monoid GHC.Types.IO Control.Monad.Trans.Error.Error Control.Monad.Trans.Error.ErrorT Data.Maybe.Maybe Data.Either.Either GHC.Base.String Data.ByteString.Internal.ByteString+Warning: Happstack.Server.Error: could not find link destinations for:+ GHC.Base.Monad Control.Monad.Trans.Error.ErrorT GHC.Base.String Control.Monad.Trans.Error.Error+Warning: Happstack.Server.FileServe.BuildingBlocks: could not find link destinations for:+ Control.Monad.IO.Class.MonadIO Control.Monad.MonadPlus GHC.IO.FilePath GHC.Base.String GHC.Enum.Enum GHC.Classes.Eq Data.Data.Data GHC.Classes.Ord GHC.Read.Read GHC.Show.Show Data.Typeable.Typeable Data.Maybe.Maybe System.Time.CalendarTime GHC.Integer.Type.Integer Data.ByteString.Lazy.Internal.ByteString Data.ByteString.Internal.ByteString Data.Map.Map GHC.Base.Monad GHC.Types.IO GHC.Bool.Bool+Warning: Happstack.Server.FileServe: could not find link destinations for:+ GHC.Enum.Enum GHC.Classes.Eq Data.Data.Data GHC.Classes.Ord GHC.Read.Read GHC.Show.Show Data.Typeable.Typeable Control.Monad.IO.Class.MonadIO Control.Monad.MonadPlus GHC.IO.FilePath GHC.Base.String Data.Map.Map GHC.Base.Monad+Warning: Happstack.Server.Proxy: could not find link destinations for:+ Control.Monad.IO.Class.MonadIO Control.Monad.MonadPlus GHC.Base.String+Warning: Happstack.Server.Routing: could not find link destinations for:+ Control.Monad.MonadPlus GHC.Base.Monad GHC.Bool.Bool GHC.Base.String GHC.IO.FilePath Data.Maybe.Maybe GHC.Types.Double GHC.Types.Float GHC.Types.Int GHC.Integer.Type.Integer+Warning: Happstack.Server.Auth: could not find link destinations for:+ Control.Monad.MonadPlus GHC.Base.String Data.Map.Map+Warning: Happstack.Server.SimpleHTTP: could not find link destinations for:+ GHC.Types.IO GHC.Base.Monad GHC.Base.Functor Network.Socket.Socket GHC.Base.String GHC.Types.Int Data.Either.Either+Warning: Happstack.Server.Internal.Compression: could not find link destinations for:+ Control.Monad.MonadPlus GHC.Base.String Data.ByteString.Lazy.Internal.ByteString GHC.Bool.Bool Text.Parsec.String.GenParser GHC.Types.Char Data.Maybe.Maybe GHC.Types.Double+Warning: Happstack.Server.Compression: could not find link destinations for:+ Control.Monad.MonadPlus GHC.Base.String+Warning: Happstack.Server.XSLT: could not find link destinations for:+ GHC.IO.FilePath GHC.Types.IO GHC.Base.String Data.ByteString.Internal.ByteString Control.Monad.IO.Class.MonadIO Control.Monad.MonadPlus Data.ByteString.Lazy.Internal.ByteString GHC.Classes.Eq Data.Data.Data GHC.Classes.Ord GHC.Read.Read GHC.Show.Show Data.Typeable.Typeable Happstack.Data.Default.Default Data.Generics.SYB.WithClass.Context.Sat Data.Generics.SYB.WithClass.Basics.Data+39+Creating interfaces...+Checking module Data.Text.IDNA2008...+Creating interface...+haddock coverage for ./Data/Text/IDNA2008.hs: 2/2 100%+Attaching instances...+Building cross-linking environment...+Rupdate_toolbar 0.8+--2011-07-12 14:24:28-- http://www.leksah.org/metadata-0.10/stringprep-0.1.4.lkshm+Resolving www.leksah.org... 87.230.23.84+Connecting to www.leksah.org|87.230.23.84|:80... connected.+HTTP request sent, awaiting response... 404 Not Found+2011-07-12 14:24:28 ERROR 404: Not Found.++update_toolbar 0.9+--2011-07-12 14:24:34-- http://www.leksah.org/metadata-0.10/stream-fusion-0.1.2.3.lkshm+Resolving www.leksah.org... 87.230.23.84+Connecting to www.leksah.org|87.230.23.84|:80... connected.+HTTP request sent, awaiting response... 404 Not Found+2011-07-12 14:24:34 ERROR 404: Not Found.++update_toolbar 1.0+--2011-07-12 14:24:45-- http://www.leksah.org/metadata-0.10/ranges-0.2.3.lkshm+Resolving www.leksah.org... 87.230.23.84+Connecting to www.leksah.org|87.230.23.84|:80... connected.+HTTP request sent, awaiting response... 404 Not Found+2011-07-12 14:24:45 ERROR 404: Not Found.++Metadata collection has finished+Now loading metadata ...+Now updating workspace metadata ...+Finished+>>>Info Changed!!! True++/home/Jon/tls-0.7.1/Tests.hs:32:0:+ error: missing binary operator before token "("+Can't extract module /home/Jon/.leksah-0.10/metadata/tls-0.7.1/Main.lkshe leksah-server: phase `C pre-processor' failed (exitcode = 1)++/home/Jon/tls-0.7.1/Tests.hs:32:0:+ error: missing binary operator before token "("+Can't extract module /home/Jon/.leksah-0.10/metadata/tls-0.7.1/Main.lkshe leksah-server: phase `C pre-processor' failed (exitcode = 1)+>>>Info Changed!!! False+>>>Info Changed!!! False++/home/Jon/tls-0.7.1/Tests.hs:32:0:+ error: missing binary operator before token "("+Can't extract module /home/Jon/.leksah-0.10/metadata/tls-0.7.1/Main.lkshe leksah-server: phase `C pre-processor' failed (exitcode = 1)+>>>Info Changed!!! False++(leksah:21940): Gtk-WARNING **: Unknown tag `ErrorRef0'++(leksah:21940): Gtk-WARNING **: Unknown tag `ErrorRef1'++(leksah:21940): IBUS-WARNING **: org.freedesktop.IBus.InputContext.GetEngine: GDBus.Error:org.freedesktop.DBus.Error.Failed: Input context does not have engine.++/home/Jon/tls-0.7.1/Tests.hs:32:0:+ error: missing binary operator before token "("+Can't extract module /home/Jon/.leksah-0.10/metadata/tls-0.7.1/Main.lkshe leksah-server: phase `C pre-processor' failed (exitcode = 1)+>>>Info Changed!!! False+Now saving session+***lost connection+***lost last connection - exiting+***lost last connection - waiting+ExitSuccess+enaming interfaces...+Warning: Data.Text.IDNA2008: could not find link destinations for:+ GHC.Base.String Data.Maybe.Maybe+1+Creating interfaces...+Checking module Text.StringPrep...+Creating interface...+haddock coverage for ./Text/StringPrep.hs: 0/17 0%+Checking module Text.NamePrep...+Creating interface...+haddock coverage for ./Text/NamePrep.hs: 0/2 0%+Attaching instances...+Building cross-linking environment...+Renaming interfaces...+Warning: Text.StringPrep: could not find link destinations for:+ Text.StringPrep.Map GHC.Bool.Bool Text.StringPrep.Prohibited Data.Text.Internal.Text Data.Maybe.Maybe Data.Ranges.Range GHC.Types.Char+Warning: Text.NamePrep: could not find link destinations for:+ GHC.Bool.Bool+2+Creating interfaces...+Checking module Data.Stream...+Creating interface...+haddock coverage for ./Data/Stream.hs: 31/108 29%+Checking module Control.Monad.Stream...+Creating interface...+Warning: Couldn't find .haddock for exported Control.Monad.Stream.Functor: base:GHC.Base.Functor+Warning: Couldn't find .haddock for exported Control.Monad.Stream.Monad: base:GHC.Base.Monad+haddock coverage for ./Control/Monad/Stream.hs: 39/41 95%+Checking module Data.List.Stream...+Creating interface...+haddock coverage for ./Data/List/Stream.hs: 140/142 99%+Attaching instances...+Building cross-linking environment...+Renaming interfaces...+Warning: Data.Stream: could not find link destinations for:+ Data.Stream.Unlifted GHC.Bool.Bool GHC.Types.Int GHC.Num.Num GHC.Classes.Ord Data.Maybe.Maybe GHC.Classes.Eq GHC.Ordering.Ordering GHC.Real.Integral GHC.Types.Char GHC.Integer.Type.Integer+Warning: Control.Monad.Stream: could not find link destinations for:+ GHC.Types.IO Data.Maybe.Maybe GHC.Base.String GHC.Bool.Bool GHC.Types.Int+Warning: Data.List.Stream: could not find link destinations for:+ GHC.Bool.Bool GHC.Types.Int GHC.Num.Num GHC.Classes.Ord Data.Maybe.Maybe GHC.Classes.Eq GHC.Base.String GHC.Ordering.Ordering GHC.Real.Integral+3+Creating interfaces...+Checking module Data.Ranges...+Creating interface...+haddock coverage for ./Data/Ranges.hs: 6/10 60%+Attaching instances...+Building cross-linking environment...+Renaming interfaces...+Warning: Data.Ranges: could not find link destinations for:+ GHC.Classes.Ord GHC.Classes.Eq GHC.Show.Show GHC.Bool.Bool Data.Set.Set+1+leksah-server: ExitSuccess+Using default Yi configuration+^+Warning: /home/Jon/Eclipse Workspace/JonShop/jonshop.cabal: A package using+'cabal-version: >=1.6' must use section syntax. See the Cabal user guide for+details.+user interrupt+Now updating system metadata ...+***server start+Bind 127.0.0.1:26411+Now saving session+Metadata collector has nothing to do+Metadata collection has finished+***lost connection+***lost last connection - exiting+ExitSuccess+leksah-server: ExitSuccess+Using default Yi configuration+Warning: /home/Jon/Eclipse Workspace/JonShop/jonshop.cabal: A package using+'cabal-version: >=1.6' must use section syntax. See the Cabal user guide for+details.+Now updating system metadata ...+***server start+Bind 127.0.0.1:26411+Metadata collector has nothing to do+Metadata collection has finished+Now loading metadata ...+Now updating workspace metadata ...++/home/Jon/tls-0.7.1/Tests.hs:32:0:+ error: missing binary operator before token "("+Can't extract module /home/Jon/.leksah-0.10/metadata/tls-0.7.1/Main.lkshe leksah-server: phase `C pre-processor' failed (exitcode = 1)+Finished+>>>Info Changed!!! True+Now saving session+***lost connection+***lost last connection - exiting+ExitSuccess+leksah-server: ExitSuccess+Using default Yi configuration+Warning: /home/Jon/Eclipse Workspace/JonShop/jonshop.cabal: A package using+'cabal-version: >=1.6' must use section syntax. See the Cabal user guide for+details.+Now updating system metadata ...+***server start+Bind 127.0.0.1:26411+Metadata collector has nothing to do+Metadata collection has finished+Now loading metadata ...+Now updating workspace metadata ...++/home/Jon/tls-0.7.1/Tests.hs:32:0:+ error: missing binary operator before token "("+Can't extract module /home/Jon/.leksah-0.10/metadata/tls-0.7.1/Main.lkshe leksah-server: phase `C pre-processor' failed (exitcode = 1)+Finished+>>>Info Changed!!! True+Metadata collector has nothing to do+Metadata collection has finished++/home/Jon/tls-0.7.1/Tests.hs:32:0:+ error: missing binary operator before token "("+Can't extract module /home/Jon/.leksah-0.10/metadata/tls-0.7.1/Main.lkshe leksah-server: phase `C pre-processor' failed (exitcode = 1)++/home/Jon/tls-0.7.1/Tests.hs:32:0:+ error: missing binary operator before token "("+Can't extract module /home/Jon/.leksah-0.10/metadata/tls-0.7.1/Main.lkshe leksah-server: phase `C pre-processor' failed (exitcode = 1)+Now saving session+***lost connection+***lost connection+***lost last connection - exiting+***lost last connection - waiting+ExitSuccess+leksah-server: ExitSuccess+Using default Yi configuration+Warning: /home/Jon/Eclipse Workspace/JonShop/jonshop.cabal: A package using+'cabal-version: >=1.6' must use section syntax. See the Cabal user guide for+details.+Now updating system metadata ...+***server start+Bind 127.0.0.1:26411+Metadata collector has nothing to do+Metadata collection has finished+Now loading metadata ...+Now updating workspace metadata ...++/home/Jon/tls-0.7.1/Tests.hs:32:0:+ error: missing binary operator before token "("+Can't extract module /home/Jon/.leksah-0.10/metadata/tls-0.7.1/Main.lkshe leksah-server: phase `C pre-processor' failed (exitcode = 1)+Finished+>>>Info Changed!!! True++(leksah:4413): IBUS-WARNING **: org.freedesktop.IBus.InputContext.GetEngine: GDBus.Error:org.freedesktop.DBus.Error.Failed: Input context does not have engine.++(leksah:4413): IBUS-WARNING **: org.freedesktop.IBus.InputContext.GetEngine: GDBus.Error:org.freedesktop.DBus.Error.Failed: Input context does not have engine.++(leksah:4413): IBUS-WARNING **: org.freedesktop.IBus.InputContext.GetEngine: GDBus.Error:org.freedesktop.DBus.Error.Failed: Input context does not have engine.++(leksah:4413): IBUS-WARNING **: org.freedesktop.IBus.InputContext.GetEngine: GDBus.Error:org.freedesktop.DBus.Error.Failed: Input context does not have engine.+Now saving session+***lost connection+***lost last connection - exiting+ExitSuccess+leksah-server: ExitSuccess+Using default Yi configuration+Warning: /home/Jon/Eclipse Workspace/JonShop/jonshop.cabal: A package using+'cabal-version: >=1.6' must use section syntax. See the Cabal user guide for+details.+Now updating system metadata ...+***server start+Bind 127.0.0.1:26411+Error reading cabal file "/home/Jon/.leksah-0.10/packageSources/blaze-builder-enumerator-0.2.0.2/blaze-builder-enumerator.cabal" "/home/Jon/.leksah-0.10/packageSources/blaze-builder-enumerator-0.2.0.2/blaze-builder-enumerator.cabal" (line 41, column 1):+unexpected end of input+expecting cabal minimal+update_toolbar 0.0+update_toolbar 0.3333333333333333+--2011-07-22 20:02:49-- http://www.leksah.org/metadata-0.10/dns-0.1.2.lkshm+Resolving www.leksah.org... 87.230.23.84+Connecting to www.leksah.org|87.230.23.84|:80... connected.+HTTP request sent, awaiting response... 404 Not Found+2011-07-22 20:02:51 ERROR 404: Not Found.++update_toolbar 0.6666666666666666+--2011-07-22 20:02:57-- http://www.leksah.org/metadata-0.10/iproute-1.2.1.lkshm+Resolving www.leksah.org... 87.230.23.84+Connecting to www.leksah.org|87.230.23.84|:80... connected.+HTTP request sent, awaiting response... 404 Not Found+2011-07-22 20:02:58 ERROR 404: Not Found.++update_toolbar 1.0+--2011-07-22 20:03:04-- http://www.leksah.org/metadata-0.10/appar-0.1.3.lkshm+Resolving www.leksah.org... 87.230.23.84+Connecting to www.leksah.org|87.230.23.84|:80... connected.+HTTP request sent, awaiting response... 404 Not Found+2011-07-22 20:03:06 ERROR 404: Not Found.++Metadata collection has finished+Now loading metadata ...+Now updating workspace metadata ...+Can't extract module /home/Jon/.leksah-0.10/metadata/tls-0.7.1/Main.lkshe <command line>: cannot satisfy -package-id crypto-api-0.6.1-0a41e3a14624d8945df29a18311dd5f5+ (use -v for more information)+Finished+>>>Info Changed!!! True+***lost connection+***lost last connection - exiting+***lost last connection - waiting+ExitSuccess+Creating interfaces...+Checking module Network.DNS.Internal...+Creating interface...+haddock coverage for ./Network/DNS/Internal.hs: 9/19 47%+Checking module Network.DNS.Types...+Creating interface...+haddock coverage for ./Network/DNS/Types.hs: 10/41 24%+Checking module Network.DNS.StateBinary...+Creating interface...+haddock coverage for ./Network/DNS/StateBinary.hs: 0/28 0%+Checking module Network.DNS.Query...+Creating interface...+haddock coverage for ./Network/DNS/Query.hs: 0/2 0%+Checking module Network.DNS.Response...+Creating interface...+haddock coverage for ./Network/DNS/Response.hs: 0/2 0%+Checking module Network.DNS.Resolver...+Creating interface...+haddock coverage for ./Network/DNS/Resolver.hs: 15/15 100%+Checking module Network.DNS.Lookup...+Creating interface...+haddock coverage for ./Network/DNS/Lookup.hs: 7/7 100%+Checking module Network.DNS...+Creating interface...+haddock coverage for ./Network/DNS.hs: 4/4 100%+Attaching instances...+Building cross-linking environment...+Renaming interfaces...+Warning: Network.DNS.Internal: could not find link destinations for:+ GHC.Base.String GHC.Types.Int GHC.Classes.Eq GHC.Read.Read GHC.Show.Show Data.Maybe.Maybe GHC.Bool.Bool GHC.Enum.Enum Data.IP.Addr.IPv4 Data.IP.Addr.IPv6 Data.ByteString.Lazy.Internal.ByteString+Warning: Network.DNS.Types: could not find link destinations for:+ GHC.Base.String GHC.Types.Int GHC.Classes.Eq GHC.Read.Read GHC.Show.Show GHC.Bool.Bool GHC.Enum.Enum Data.IP.Addr.IPv4 Data.IP.Addr.IPv6 Data.ByteString.Lazy.Internal.ByteString+Warning: Network.DNS.StateBinary: could not find link destinations for:+ Control.Monad.Trans.State.Lazy.StateT Data.Binary.Get.Get Data.IntMap.IntMap GHC.Base.Monad Data.Binary.Put.Put GHC.Word.Word8 GHC.Word.Word16 GHC.Word.Word32 GHC.Types.Int Data.ByteString.Lazy.Internal.ByteString Data.Maybe.Maybe+Warning: Network.DNS.Query: could not find link destinations for:+ GHC.Types.Int Data.ByteString.Lazy.Internal.ByteString+Warning: Network.DNS.Response: could not find link destinations for:+ Data.ByteString.Lazy.Internal.ByteString+Warning: Network.DNS.Resolver: could not find link destinations for:+ GHC.IO.FilePath Network.Socket.HostName GHC.Types.Int GHC.Int.Int64 GHC.Types.IO Data.Maybe.Maybe+Warning: Network.DNS.Lookup: could not find link destinations for:+ GHC.Types.IO Data.Maybe.Maybe Data.IP.Addr.IPv4 Data.IP.Addr.IPv6 GHC.Types.Int Data.ByteString.Lazy.Internal.ByteString+8+Creating interfaces...+Checking module Data.IP.Addr...+Creating interface...+haddock coverage for ./Data/IP/Addr.hs: 5/17 29%+Checking module Data.IP.Mask...+Creating interface...+haddock coverage for ./Data/IP/Mask.hs: 0/6 0%+Checking module Data.IP.Range...+Creating interface...+haddock coverage for ./Data/IP/Range.hs: 2/10 20%+Checking module Data.IP.Op...+Creating interface...+haddock coverage for ./Data/IP/Op.hs: 3/5 60%+Checking module Data.IP.RouteTable.Internal...+Creating interface...+haddock coverage for ./Data/IP/RouteTable/Internal.hs: 9/21 43%+Checking module Data.IP.RouteTable...+Creating interface...+haddock coverage for ./Data/IP/RouteTable.hs: 13/13 100%+Checking module Data.IP...+Creating interface...+haddock coverage for ./Data/IP.hs: 15/16 94%+Attaching instances...+Building cross-linking environment...+Renaming interfaces...+Warning: Data.IP.Addr: could not find link destinations for:+ GHC.Classes.Eq GHC.Show.Show GHC.Word.Word32 GHC.Classes.Ord GHC.Read.Read Data.String.IsString GHC.Base.String GHC.Types.Int Text.Appar.String.Parser+Warning: Data.IP.Mask: could not find link destinations for:+ GHC.Types.Int GHC.Word.Word32 Data.IntMap.IntMap+Warning: Data.IP.Range: could not find link destinations for:+ GHC.Classes.Eq GHC.Read.Read GHC.Show.Show GHC.Types.Int GHC.Classes.Ord GHC.Base.String Text.Appar.String.Parser+Warning: Data.IP.Op: could not find link destinations for:+ GHC.Classes.Eq GHC.Types.Int GHC.Bool.Bool+Warning: Data.IP.RouteTable.Internal: could not find link destinations for:+ GHC.Types.Int GHC.Bool.Bool GHC.Word.Word32 Data.IntMap.IntMap Data.Maybe.Maybe GHC.Classes.Eq GHC.Show.Show+Warning: Data.IP.RouteTable: could not find link destinations for:+ GHC.Types.Int GHC.Bool.Bool GHC.Classes.Eq GHC.Show.Show Data.Maybe.Maybe+Warning: Data.IP: could not find link destinations for:+ GHC.Classes.Eq GHC.Show.Show GHC.Classes.Ord GHC.Read.Read Data.String.IsString GHC.Types.Int GHC.Bool.Bool+7+Creating interfaces...+Checking module Text.Appar.Input...+Creating interface...+haddock coverage for ./Text/Appar/Input.hs: 1/2 50%+Checking module Text.Appar.Parser...+Creating interface...+Warning: Couldn't find .haddock for exported Text.Appar.Parser.<$>: base:Data.Functor.<$>+Warning: Couldn't find .haddock for exported Text.Appar.Parser.<$: base:GHC.Base.<$+Warning: Couldn't find .haddock for exported Text.Appar.Parser.<*>: base:Control.Applicative.<*>+Warning: Couldn't find .haddock for exported Text.Appar.Parser.*>: base:Control.Applicative.*>+Warning: Couldn't find .haddock for exported Text.Appar.Parser.<*: base:Control.Applicative.<*+Warning: Couldn't find .haddock for exported Text.Appar.Parser.<**>: base:Control.Applicative.<**>+Warning: Couldn't find .haddock for exported Text.Appar.Parser.<|>: base:Control.Applicative.<|>+Warning: Couldn't find .haddock for exported Text.Appar.Parser.some: base:Control.Applicative.some+Warning: Couldn't find .haddock for exported Text.Appar.Parser.many: base:Control.Applicative.many+Warning: Couldn't find .haddock for exported Text.Appar.Parser.pure: base:Control.Applicative.pure+haddock coverage for ./Text/Appar/Parser.hs: 26/37 70%+Checking module Text.Appar.LazyByteString...+Creating interface...+haddock coverage for ./Text/Appar/LazyByteString.hs: 5/5 100%+Checking module Text.Appar.ByteString...+Creating interface...+haddock coverage for ./Text/Appar/ByteString.hs: 5/5 100%+Checking module Text.Appar.String...+Creating interface...+haddock coverage for ./Text/Appar/String.hs: 5/5 100%+Attaching instances...+Building cross-linking environment...+Renaming interfaces...+Warning: Text.Appar.Input: could not find link destinations for:+ GHC.Classes.Eq GHC.Types.Char GHC.Bool.Bool GHC.Base.String Data.ByteString.Internal.ByteString Data.ByteString.Lazy.Internal.ByteString+Warning: Text.Appar.Parser: could not find link destinations for:+ Data.ByteString.Lazy.Internal.ByteString Data.Maybe.Maybe GHC.Types.Char GHC.Base.String GHC.Base.Functor Control.Applicative.Applicative Control.Applicative.Alternative GHC.Base.Monad Control.Monad.MonadPlus GHC.Classes.Eq GHC.Bool.Bool Data.ByteString.Internal.ByteString+Warning: Text.Appar.LazyByteString: could not find link destinations for:+ Data.ByteString.Lazy.Internal.ByteString+Warning: Text.Appar.ByteString: could not find link destinations for:+ Data.ByteString.Internal.ByteString+Warning: Text.Appar.String: could not find link destinations for:+ GHC.Base.String+5+leksah-server: ExitSuccess+Now saving session+Using default Yi configuration+Warning: /home/Jon/Eclipse Workspace/JonShop/jonshop.cabal: A package using+'cabal-version: >=1.6' must use section syntax. See the Cabal user guide for+details.+Now updating system metadata ...+***server start+Bind 127.0.0.1:26411+Metadata collector has nothing to do+Metadata collection has finished+Now loading metadata ...+Now updating workspace metadata ...+Can't extract module /home/Jon/.leksah-0.10/metadata/tls-0.7.1/Main.lkshe <command line>: cannot satisfy -package-id crypto-api-0.6.1-0a41e3a14624d8945df29a18311dd5f5+ (use -v for more information)+Finished+>>>Info Changed!!! True+Now saving session+***lost connection+***lost last connection - exiting+***lost last connection - waiting+ExitSuccess+leksah-server: ExitSuccess
pontarius-xmpp.cabal view
@@ -1,8 +1,8 @@ Name: pontarius-xmpp-Version: 0.0.6.0+Version: 0.0.7.0 Cabal-Version: >= 1.6 Build-Type: Simple-License: LGPL-3+License: BSD3 License-File: LICENSE Copyright: Copyright © 2011, Jon Kristensen Author: Jon Kristensen, Mahdi Abdinejadi@@ -25,16 +25,14 @@ -- Extra-Tmp-Files: Library- Exposed-Modules: Network.XMPP, Network.XMPP.Address, Network.XMPP.SASL,- Network.XMPP.Session, Network.XMPP.Stanza,- Network.XMPP.Stream, Network.XMPP.TLS, Network.XMPP.Types,- Network.XMPP.Utilities+ Exposed-Modules: Network.XMPP Exposed: True- Build-Depends: base >= 2 && < 5, parsec, enumerator, crypto-api,+ Build-Depends: base >= 2 && < 5, parsec, enumerator, crypto-api ==0.6.3, base64-string, pureMD5, utf8-string, network, xml-types,- text, transformers, bytestring, binary, random,- xml-enumerator, tls ==0.4.1, containers, mtl, text-icu,- stringprep, idna2008 ==0.0.1.0+ text, transformers, bytestring, cereal ==0.3.3.0, random,+ xml-enumerator, tls, tls-extra, containers, mtl, text-icu,+ stringprep, asn1-data, cryptohash ==0.7.0,+ time, certificate, ranges, uuid -- Other-Modules: -- HS-Source-Dirs: -- Extensions:@@ -58,12 +56,12 @@ Source-Repository head Type: darcs -- Module:- Location: https://patch-tag.com/r/jonkri/pontarius-xmpp+ Location: git://github.com/pontarius/pontarius-xmpp.git -- Subdir: Source-Repository this Type: darcs -- Module:- Location: https://patch-tag.com/r/jonkri/pontarius-xmpp- Tag: 0.0.6.0+ Location: git://github.com/pontarius/pontarius-xmpp.git+ Tag: 0.0.7.0 -- Subdir: