From 5e0bee18c54cf97a6ac15d24a03fee59feade4bf Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Sun, 10 Jul 2011 23:10:20 +0200 Subject: [PATCH] initial import, copy of darcs repository --- COPYING | 674 ++++++++ COPYING.LESSER | 165 ++ Documentation/Pontarius XMPP Manual.lyx | 536 ++++++ ...ign Description for Pontarius XMPP 1.0.lyx | 192 +++ ... Assurance Plan for Pontarius XMPP 1.0.lyx | 324 ++++ ...ments Specification for Pontarius XMPP.lyx | 1459 +++++++++++++++++ Examples/EchoClient.hs | 147 ++ LICENSE | 4 + Network/XMPP.hs | 106 ++ Network/XMPP/Address.hs | 216 +++ Network/XMPP/SASL.hs | 215 +++ Network/XMPP/Session.hs | 758 +++++++++ Network/XMPP/Stanza.hs | 182 ++ Network/XMPP/Stream.hs | 457 ++++++ Network/XMPP/TLS.hs | 47 + Network/XMPP/Types.hs | 457 ++++++ Network/XMPP/Utilities.hs | 93 ++ README | 22 + Setup.hs | 3 + pontarius-xmpp.cabal | 69 + 20 files changed, 6126 insertions(+) create mode 100644 COPYING create mode 100644 COPYING.LESSER create mode 100644 Documentation/Pontarius XMPP Manual.lyx create mode 100644 Documentation/Software Design Description for Pontarius XMPP 1.0.lyx create mode 100644 Documentation/Software Quality Assurance Plan for Pontarius XMPP 1.0.lyx create mode 100644 Documentation/Software Requirements Specification for Pontarius XMPP.lyx create mode 100644 Examples/EchoClient.hs create mode 100644 LICENSE create mode 100644 Network/XMPP.hs create mode 100644 Network/XMPP/Address.hs create mode 100644 Network/XMPP/SASL.hs create mode 100644 Network/XMPP/Session.hs create mode 100644 Network/XMPP/Stanza.hs create mode 100644 Network/XMPP/Stream.hs create mode 100644 Network/XMPP/TLS.hs create mode 100644 Network/XMPP/Types.hs create mode 100644 Network/XMPP/Utilities.hs create mode 100644 README create mode 100644 Setup.hs create mode 100644 pontarius-xmpp.cabal diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..94a9ed0 --- /dev/null +++ b/COPYING @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + 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. + + + Copyright (C) + + 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 . + +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: + + Copyright (C) + 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 +. + + 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 +. diff --git a/COPYING.LESSER b/COPYING.LESSER new file mode 100644 index 0000000..65c5ca8 --- /dev/null +++ b/COPYING.LESSER @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + 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. diff --git a/Documentation/Pontarius XMPP Manual.lyx b/Documentation/Pontarius XMPP Manual.lyx new file mode 100644 index 0000000..e43eeb6 --- /dev/null +++ b/Documentation/Pontarius XMPP Manual.lyx @@ -0,0 +1,536 @@ +#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 +\spacing single +\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 +Pontarius XMPP 0.1 Manual (Third Draft) +\end_layout + +\begin_layout Author +The Pontarius Project +\end_layout + +\begin_layout Date +The 6th of July, 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 +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) +\begin_inset Foot +status open + +\begin_layout Plain Layout +http://tools.ietf.org/html/rfc6120 +\end_layout + +\end_inset + +. + Below are the specifics of our implementation. +\end_layout + +\begin_layout Itemize +The client is always the initiating entity +\end_layout + +\begin_layout Itemize +A client-of-server connection is always exactly one TCP connection +\end_layout + +\begin_layout Itemize +TLS is supported for client-to-server confidentiality +\end_layout + +\begin_layout Itemize +Only the SCRAM authentication method is supported +\end_layout + +\begin_layout Itemize +... +\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 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/. +\end_layout + +\end_inset + + +\end_layout + +\begin_layout Section +Usage +\end_layout + +\begin_layout Standard +Working with Pontarius XMPP is mostly done asynchronously; Pontarius XMPP + ``owns'' the XMPP thread, and calls different StateT s m a callback functions + in the client. + StateT is a monad transformer which allows the functions to be stateful + (being able to access and modify the arbitrary client-defined state of + type s) and to be executed on top of a MonadIO m monad (typically IO). +\end_layout + +\begin_layout Subsection +Creating the session +\end_layout + +\begin_layout Standard +Setting up an XMPP session is done through the (blocking) session function: +\end_layout + +\begin_layout Standard +\begin_inset listings +inline false +status open + +\begin_layout Plain Layout + +session :: (MonadIO m, ClientState s m) => s -> +\end_layout + +\begin_layout Plain Layout + + [ClientHandler s m] -> (StateT s m ()) -> m () +\end_layout + +\end_inset + + +\end_layout + +\begin_layout Standard +The first parameter (of type s) is an arbitrary state that is defined by + the client. + This is the initial state, and it will be passed to the stateful client + callbacks. + It will typically be modified by the client. +\end_layout + +\begin_layout Standard +The second parameter is the list of client handlers to deal with XMPP callbacks. + The reason why we have a list is because we want to provide a ``layered'' + system of XMPP event handlers. + For example, XMPP client developers may want to have a dedicated handler + to manage messages, implement a spam protection system, and so on. + Messages are piped through these handlers one by one, and any handler may + block the message from being sent to the next handler(s) above in the stack. +\end_layout + +\begin_layout Standard +\begin_inset listings +inline false +status open + +\begin_layout Plain Layout + +data MonadIO m => ClientHandler s m = ClientHandler { +\end_layout + +\begin_layout Plain Layout + + messageReceived :: Maybe (Message -> +\end_layout + +\begin_layout Plain Layout + + StateT s m Bool), presenceReceived :: Maybe +\end_layout + +\begin_layout Plain Layout + + (Presence -> StateT s m Bool), iqReceived :: +\end_layout + +\begin_layout Plain Layout + + Maybe (IQ -> StateT s m Bool), +\end_layout + +\begin_layout Plain Layout + + sessionTerminated :: Maybe (TerminationReason -> +\end_layout + +\begin_layout Plain Layout + + StateT s m ()) } +\end_layout + +\end_inset + + +\end_layout + +\begin_layout Standard +ClientHandler is a record which specifies four callback functions. + The first three deals with the three XMPP stanzas, and are called once + an XMPP stanza is received. + These functions take the stanza in question, and are stateful with the + current client state. + The boolean value returned signals whether or not the message should be + blocked to clients further down the stack. + For example, a XEP-0030: Service Discovery handler may choose to hide disco#inf +o requests handlers above it in the stack. + The last function is the callback that is used when the XMPP session is + terminated. + All callbacks are optional. +\end_layout + +\begin_layout Standard +The third argument to session is a callback function that will be called + when the session has been initialized. +\end_layout + +\begin_layout Standard +Any function with access to the Session object can operate with the XMPP + session, such as connecting the XMPP client or sending stanzas. + More on this below. +\end_layout + +\begin_layout Subsection +Connecting the client +\end_layout + +\begin_layout Standard +Different clients connect to XMPP in different ways. + Some secure the stream with TLS, and some authenticate with the server. + Pontarius XMPP provides a flexible function to help out with this in a + convenient way: +\end_layout + +\begin_layout Standard +\begin_inset listings +inline false +status open + +\begin_layout Plain Layout + +connect :: MonadIO m => Session s m -> HostName -> +\end_layout + +\begin_layout Plain Layout + + PortNumber -> Maybe (Certificate, (Certificate -> +\end_layout + +\begin_layout Plain Layout + + Bool)) -> Maybe (UserName, Password, Maybe +\end_layout + +\begin_layout Plain Layout + + Resource) -> (ConnectResult -> StateT s m ()) -> +\end_layout + +\begin_layout Plain Layout + + StateT s m () +\end_layout + +\end_inset + + +\end_layout + +\begin_layout Standard +This function simply takes the host name and port number to connect to, + an optional tuple of the certificate to use and a function evaluating certifica +tes for TLS (if Nothing is provided, the connection will not be TLS secured), + and another optional tuple with user name, password, and an optional resource + for authentication (analogously, providing Nothing here causes Pontarius + XMPP not to authenticate). + The final paramter is a callback function providing the result of the connect + action. +\end_layout + +\begin_layout Standard +For more fine-grained control of the connection, use the openStream, secureWithT +LS, and authenticate functions. +\end_layout + +\begin_layout Subsection +Managing XMPP addresses +\end_layout + +\begin_layout Standard +There are four functions dealing with XMPP addresses (or JIDs, as they are + also called): +\end_layout + +\begin_layout Standard +\begin_inset listings +inline false +status open + +\begin_layout Plain Layout + +fromString :: String -> Maybe Address +\end_layout + +\begin_layout Plain Layout + +fromStrings :: Maybe String -> String -> +\end_layout + +\begin_layout Plain Layout + + Maybe String -> Maybe Address +\end_layout + +\begin_layout Plain Layout + +isBare :: Address -> Bool +\end_layout + +\begin_layout Plain Layout + +isFull :: Address -> Bool +\end_layout + +\end_inset + + +\end_layout + +\begin_layout Standard +These functions should be pretty self-explainatory to those who know the + XMPP: Core standard. + The fromString functions takes one to three strings and tries to construct + an XMPP address. + isBare and isFull checks whether or not the bare is full (has a resource + value). +\end_layout + +\begin_layout Subsection +Sending stanzas +\end_layout + +\begin_layout Standard +Sending messages is done using this function: +\end_layout + +\begin_layout Standard +\begin_inset listings +inline false +status open + +\begin_layout Plain Layout + +sendMessage :: MonadIO m => Session s m -> Message -> +\end_layout + +\begin_layout Plain Layout + + Maybe (Message -> StateT s m Bool) -> +\end_layout + +\begin_layout Plain Layout + + Maybe (Timeout, StateT s m ()) -> +\end_layout + +\begin_layout Plain Layout + + Maybe (StreamError -> StateT s m ()) -> +\end_layout + +\begin_layout Plain Layout + + StateT s m () +\end_layout + +\end_inset + + +\end_layout + +\begin_layout Standard +Like in section 3.2, the first parameter is the session object. + The second is the message (check the Message record type in the API). + The third parameter is an optional callback function to be executed if + a reply to the message is received. + The fourth parameter contains a Timeout (Integer) value, and a callback + that Pontarius XMPP will call when a reply has not been received in the + window of the timeout. + The last parameter is an optional callback that is called if a stream error + occurs. +\end_layout + +\begin_layout Standard +Presence and IQ stanzas are sent in a very similar way. +\end_layout + +\begin_layout Standard +Stanza IDs will be set for you if you leave them out. + If, however, you want to know what ID you send, you can acquire a stanza + ID by calling the getID function: +\end_layout + +\begin_layout Standard +\begin_inset listings +inline false +status open + +\begin_layout Plain Layout + +getID :: MonadIO m => Session s m -> StateT s m String +\end_layout + +\end_inset + + +\end_layout + +\begin_layout Subsection +Concurrent usage +\end_layout + +\begin_layout Standard +Sometimes clients will want to perform XMPP actions from more than one thread, + or in other words, they want to perform actions from code that is not a + Pontarius XMPP callback. + For these use cases, use injectAction: +\end_layout + +\begin_layout Standard +\begin_inset listings +inline false +status open + +\begin_layout Plain Layout + +injectAction :: MonadIO m => Session s m -> +\end_layout + +\begin_layout Plain Layout + + Maybe (StateT s m Bool) -> StateT s m () -> +\end_layout + +\begin_layout Plain Layout + + StateT s m () +\end_layout + +\end_inset + + +\end_layout + +\begin_layout Standard +The second parameter is an optional predicate callback to be executed right + before the third parameter callback is called. + If it is provided and evaluates to False, then the action will not be called. + Otherwise, the action will be called. +\end_layout + +\begin_layout Subsection +Example echo server +\end_layout + +\begin_layout Standard +We provide an example to further illustrate the Pontarius XMPP API and to + make it easier for developers to get started with the library. + The program illustrates how to connect, authenticate, set a presence, and + echo all messages received. + It only uses one client handler. + The contents of this example may be used freely, as if it is in the public + domain. + You find it in the Examples directory of the Pontarius XMPP source code. +\end_layout + +\end_body +\end_document diff --git a/Documentation/Software Design Description for Pontarius XMPP 1.0.lyx b/Documentation/Software Design Description for Pontarius XMPP 1.0.lyx new file mode 100644 index 0000000..7c65e09 --- /dev/null +++ b/Documentation/Software Design Description for Pontarius XMPP 1.0.lyx @@ -0,0 +1,192 @@ +#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 diff --git a/Documentation/Software Quality Assurance Plan for Pontarius XMPP 1.0.lyx b/Documentation/Software Quality Assurance Plan for Pontarius XMPP 1.0.lyx new file mode 100644 index 0000000..3be1fa2 --- /dev/null +++ b/Documentation/Software Quality Assurance Plan for Pontarius XMPP 1.0.lyx @@ -0,0 +1,324 @@ +#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 diff --git a/Documentation/Software Requirements Specification for Pontarius XMPP.lyx b/Documentation/Software Requirements Specification for Pontarius XMPP.lyx new file mode 100644 index 0000000..4d42c09 --- /dev/null +++ b/Documentation/Software Requirements Specification for Pontarius XMPP.lyx @@ -0,0 +1,1459 @@ +#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 +\spacing single +\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 Requirements Specification for Pontarius XMPP 0.1 (Second Draft) +\end_layout + +\begin_layout Author +The Pontarius Project +\end_layout + +\begin_layout Date +6th of July 2011 +\end_layout + +\begin_layout Standard +\begin_inset CommandInset toc +LatexCommand tableofcontents + +\end_inset + + +\end_layout + +\begin_layout Section +Introduction +\end_layout + +\begin_layout Subsection +Purpose +\end_layout + +\begin_layout Standard +The goal of this document is to clarify---for Pontarius +\begin_inset Foot +status open + +\begin_layout Plain Layout +For more information about the Pontarius project, see http://www.pontarius.org/. +\end_layout + +\end_inset + + developers, the XMPP community, and to some extent the Haskell community---what + we are implementing. + We hope that it will help us in the Pontarius project to keep track of + functionality and requirements, provide a basis for scheduling, and help + us with our validation and verification processes. +\end_layout + +\begin_layout Subsection +Scope +\end_layout + +\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). +\end_layout + +\begin_layout Standard +Support for common extensions such as Instant Messaging, Data Forms, Service + Discovery, etc. + will +\emph on +not +\emph default + be included in the 0.1 version, but will be added in later ( +\begin_inset Quotes eld +\end_inset + +0.x +\begin_inset Quotes erd +\end_inset + +) versions. + Server components and XMPP server capabilities could also be added later. +\end_layout + +\begin_layout Standard +While it is the goal of the Pontarius project to develop secure and privacy-awar +e +\begin_inset Quotes eld +\end_inset + +personal cloud +\begin_inset Quotes erd +\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. +\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. +\end_layout + +\begin_layout Subsection +Legal notice +\end_layout + +\begin_layout Standard +Pontarius XMPP is a free and open source software project. + +\begin_inset Quotes eld +\end_inset + +The 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 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. +\end_layout + +\begin_layout Subsection +Definitions, acronyms, and abbrevations +\end_layout + +\begin_layout Description +JID JabberID: An address for XMPP entities +\end_layout + +\begin_layout Description +Pontarius A free and open source software project that aims to produce XMPP-base +d, uncentralized, and privacy-aware software solutions +\end_layout + +\begin_layout Description +REQ Requirement +\end_layout + +\begin_layout Description +RFC Request for Comments: A memorandum published by the Internet Engineering + Task Force; some of these, including XMPP: Core and XMPP: Address Format, + are published as Internet standards +\end_layout + +\begin_layout Description +TCP Transmission Control Protocol: A reliable network transport protocol +\end_layout + +\begin_layout Description +TLS Transport Layer Security: A secure network protocol, a successor to + Secure Sockets Layer (SSL) +\end_layout + +\begin_layout Description +XMPP Extendable Messaging and Presence Protocol: An uncentralized, open, + and near-real-time presence and messaging protocol +\end_layout + +\begin_layout Subsection +References +\end_layout + +\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 +\end_layout + +\begin_layout Subsection +Overview +\end_layout + +\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. +\end_layout + +\begin_layout Standard +The third section simply lists the requirements, categorized by external + interfaces, functions, performance requirements, design constraints, and + software system (quality) attributes. +\end_layout + +\begin_layout Section +Overall Description +\end_layout + +\begin_layout Subsection +Product perspective +\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. + 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 + want to have the core functionality of the library particularly well tested. + The X in XMPP stands for extendable, and Pontarius XMPP must be flexible + in regards for extensions, such as RFCs and XEPs; we might end up implementing + hundreds of them. + This is one of the most important quality attribute of the software. +\end_layout + +\begin_layout Standard +Pontarius XMPP 0.1 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. + 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. +\end_layout + +\begin_layout Standard +Pontarius XMPP 0.1 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 + +\begin_layout Standard +\begin_inset space \space{} +\end_inset + + +\end_layout + +\begin_layout Standard +\begin_inset Tabular + + + + + + + +\begin_inset Text + +\begin_layout Plain Layout +Name (Mnemonic) +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +Version Number +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +Purpose +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +base +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +base64-string +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +binary +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +bytestring +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +containers +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +crypto-api +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +enumerator +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +hslogger +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +network +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +pureMD5 +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +QuickCheck +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +random +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +regex-posix +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +text +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +tls +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +0.4.1 +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +transformers +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +utf8-string +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +xml-enumerator +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\begin_inset Text + +\begin_layout Plain Layout +xml-types +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + +\begin_inset Text + +\begin_layout Plain Layout +N/A +\end_layout + +\end_inset + + + + +\end_inset + + +\end_layout + +\begin_layout Standard +\begin_inset space \space{} +\end_inset + + +\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, + 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 +\emph on +at least +\emph default + Transport Layer Security to help protect clients using the library from + attacks. +\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. + However, we will stress test the library. +\end_layout + +\begin_layout Standard +We see no hardware or user interfaces to take into account. +\end_layout + +\begin_layout Subsection +Product functions +\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 +\begin_inset Quotes eld +\end_inset + +top level +\begin_inset Quotes erd +\end_inset + + XML elements in the stream for communicating messages and presence. +\end_layout + +\begin_layout Subsection +User characteristics +\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. +\end_layout + +\begin_layout Subsection +Constraints +\end_layout + +\begin_layout Standard +In addition to the requirements in XMPP: Core, XMPP applications should + be reliable in that they should be able to be online (active or inactive) + for a very long period of time, without problems of memory leaks, unnecessary + CPU usage, or similar, arising. +\end_layout + +\begin_layout Subsubsection +Assumptions and dependencies +\end_layout + +\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. +\end_layout + +\begin_layout Section +Specific requirements +\end_layout + +\begin_layout Subsection +External interfaces +\end_layout + +\begin_layout Standard +The software is accessible from Haskell and may be configured to do logging. +\end_layout + +\begin_layout Description +REQ-1 The system shall be importable and fully functional from Haskell through + a full import of the Network.XMPP namespace. +\end_layout + +\begin_layout Description +REQ-2 The system shall be able to log information through arbitrary and + flexible log handlers. +\end_layout + +\begin_layout Description +REQ-3 The system shall run under GNU/Linux. +\end_layout + +\begin_layout Description +REQ-4 The system shall work against (at least) the (estimated) most popular + free and open source software XMPP server. +\end_layout + +\begin_layout Subsection +Functions +\end_layout + +\begin_layout Standard +If an error arises due to a bug in the software, the system shall throw + a runtime exception and the process should exit. + If an +\begin_inset Quotes eld +\end_inset + +acceptable +\begin_inset Quotes erd +\end_inset + + exception is possible to arise, such as the XMPP server times out, then + the related functions should reflect that by being able to return values + such as Nothing or null. + This allows the XMPP clients to take the appropriate actions. +\end_layout + +\begin_layout Description +REQ-5 The system shall be validating input from all functions exposed through + any of the system's APIs. + +\end_layout + +\begin_layout Description +REQ-6 Each incoming stanza should move through a stack of (client) handlers, + where each handler may block the stanza from being delivered to handlers + further up in the stack. + The exceptions to this rule is stanza errors and IQ result stanzas, which + may be delivered directly to a callback provided when generating the stanza + (and possibly surpressed there). +\end_layout + +\begin_layout Standard +Rationale: We have so far found it useful to stack XMPP client handlers + on top of each other, letting them all manage their particular responsibilities + and surpress their messages to handlers further up the stack. +\end_layout + +\begin_layout Description +REQ-7 When the client is disconnected, a +\begin_inset Quotes eld +\end_inset + +disconnect event +\begin_inset Quotes erd +\end_inset + + is generated in a way similar to in REQ-5. + It is moved through the stack handlers; however, these events move down + the stacks completely and can't be surpressed. + The same thing applies for incoming stream errors, which can either be + recoverable or unrecoverable. + (?) +\end_layout + +\begin_layout Standard +Rationale: We want the handlers to all do the appropriate clean-up activities. +\end_layout + +\begin_layout Description +REQ-8 The API shall allow for opening a stream to a given IP or host name + on a given port, returning either a success value or the reason for failing. +\end_layout + +\begin_layout Description +REQ-9 The API shall allow for securing an opened stream with TLS, returning + either a success value or the reason for failing. +\end_layout + +\begin_layout Description +REQ-10 The API shall allow for authenticating an opened (possibly TLS secured) + 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 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. +\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. +\end_layout + +\begin_layout Standard +Rationale: This makes the library easier and more efficient to use for most + uses cases. +\end_layout + +\begin_layout Description +REQ-12 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 + errors. +\end_layout + +\begin_layout Description +REQ-14 The API shall allow a convenient way for +\begin_inset Quotes eld +\end_inset + +standard disconnect +\begin_inset Quotes erd +\end_inset + + the client. +\end_layout + +\begin_layout Description +REQ-15 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. +\end_layout + +\begin_layout Description +REQ-17 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 + to ( +\begin_inset Quotes eld +\end_inset + +Maybe +\begin_inset Quotes erd +\end_inset + +) JID, and JID to string. +\end_layout + +\begin_layout Description +REQ-19 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 + IDs; the API should provide a way for application developers to acquire + any amount of such IDs +\end_layout + +\begin_layout Subsection +Performance requirements +\end_layout + +\begin_layout Standard +There is only one XMPP client per instance of the system. +\end_layout + +\begin_layout Description +REQ-21 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 + 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 + stanza should take at most 0.01 seconds. +\end_layout + +\begin_layout Subsection +Design constraints +\end_layout + +\begin_layout Subsubsection +RFC 6120: XMPP: Core +\end_layout + +\begin_layout Description +REQ-24 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. +\end_layout + +\begin_layout Description +REQ-31 The system shall support authenticating with SASL, as described in + section 6 of XMPP: Core. +\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. +\end_layout + +\begin_layout Description +REQ-33 XML namespaces for stanzas should always be known to the client. +\end_layout + +\begin_layout Description +REQ-34 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 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 +\emph on +not +\emph default + supported. +\end_layout + +\begin_layout Description +REQ-38 The system shall support the 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 , 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. +\end_layout + +\begin_layout Description +REQ-44 Dealing with JIDs should adhere to the security recommendations as + mentioned in section 4 of the standard. +\end_layout + +\begin_layout Subsubsection +Standards compliance +\end_layout + +\begin_layout Description +REQ-45 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 + +\begin_layout Subsection +Software system attributes +\end_layout + +\begin_layout Description +REQ-46 The system shall be +\emph on +extendable +\emph default +; it must be flexible in regards for extensions, such as RFCs and XEPs. +\end_layout + +\begin_layout Description +REQ-47 The system shall be +\emph on +reliable +\emph default +; it should produce not crash, lag behind, or get some data corruption under + very heavy and lengthy use. +\end_layout + +\begin_layout Description +REQ-48 The system shall be +\emph on +secure +\emph default +; steps should be taken to protect the clients against man-in-the-middle + attacks and the like. +\end_layout + +\end_body +\end_document diff --git a/Examples/EchoClient.hs b/Examples/EchoClient.hs new file mode 100644 index 0000000..67417f0 --- /dev/null +++ b/Examples/EchoClient.hs @@ -0,0 +1,147 @@ +{- + +Copyright © 2010-2011 Jon Kristensen. + +This file (EchoClient.hs) illustrates how to connect, authenticate, set a +presence, and echo messages with Pontarius XMPP. The contents of this file may +be used freely, as if it is in the public domain. + +In any state-aware function (function operating in the StateT monad) you can get +and set the current by writing + +@CMS.get >>= \ state -> CMS.put $ state { stateTest = 10 } ...@ + +or, if you prefer the do-notation, + +@do + state <- CMS.get + CMS.put $ state { stateTest = 10 } + ...@ + +-} + + +{-# LANGUAGE MultiParamTypeClasses #-} + + +module Examples.EchoClient () where + +import Network.XMPP + +import qualified Control.Monad as CM +import qualified Control.Monad.State as CMS +import qualified Control.Monad.IO.Class as CMIC +import qualified Data.Maybe as DM + + +-- Account and server details. + +hostName = "jonkristensen.com" +userName = "pontarius" +serverIdentifier = "jonkristensen.com" +portNumber = 5222 +resource = "echo-client" +password = "" + + +-- The client state, containing the required Pontarius XMPP Session object. It +-- also contains a dummy integer value to illustrate how client states are used. + +data State = State { stateSession :: Maybe (Session State IO) + , stateTest :: Integer } + +defaultState :: State + +defaultState = State { stateSession = Nothing + , stateTest = 5 } + + +instance ClientState State IO where + putSession st se = st { stateSession = Just se } + + +-- This client defines one client handler, and only specifies the +-- messageReceived callback. + +clientHandlers = [ClientHandler { messageReceived = Just messageReceived_ + , presenceReceived = Nothing + , iqReceived = Nothing + , sessionTerminated = Nothing }] + + +-- The main function sets up the Pontarius XMPP session with the default client +-- state and client handler defined above, as well as specifying that the +-- sessionCreated function should be called when the session has been created. + +main :: IO () + +main = do + session + defaultState + clientHandlers + sessionCreated + + +-- The session has been created. Let's try to open the XMPP stream! + +sessionCreated :: CMS.StateT State IO () + +sessionCreated = do + state <- CMS.get + connect (DM.fromJust $ stateSession state) hostName portNumber + (Just ("", \ x -> True)) (Just (userName, password, Just resource)) + connectCallback + id <- getID (DM.fromJust $ stateSession state) + CMIC.liftIO $ putStrLn $ "Unique ID acquired: " ++ id + injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) + injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) + injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) + injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) + injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) + injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) + injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) + injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) + injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) + injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) + return () + + +-- We have tried to connected, TLS secured and authenticated! + +connectCallback :: ConnectResult -> CMS.StateT State IO () + +connectCallback r = do + state <- CMS.get + case r of + ConnectSuccess _ _ _ -> do + sendPresence (DM.fromJust $ stateSession state) + Presence { presenceID = Nothing + , presenceFrom = Nothing + , presenceTo = Nothing + , presenceXMLLang = Nothing + , presenceType = Available + , presencePayload = [] } + Nothing Nothing Nothing + _ -> do + CMIC.liftIO $ putStrLn "Could not connect." + return () + + +-- A message (stanza) has been received. Let's echo it! + +messageReceived_ :: Message -> CMS.StateT State IO Bool + +messageReceived_ m = do + state <- CMS.get + CMIC.liftIO $ putStrLn $ + "Received a message; echoing it! By the way: Internal state is " ++ + (show $ stateTest state) ++ "." + sendMessage (DM.fromJust $ stateSession state) + Message { messageID = messageID m + , messageFrom = Nothing + , messageTo = messageFrom m + , messageXMLLang = Nothing + , messageType = messageType m + , messagePayload = messagePayload m } + Nothing (Just (0, (do CMIC.liftIO $ putStrLn "Timeout!"; return ()))) Nothing + return True diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..3094658 --- /dev/null +++ b/LICENSE @@ -0,0 +1,4 @@ +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. diff --git a/Network/XMPP.hs b/Network/XMPP.hs new file mode 100644 index 0000000..f2d74eb --- /dev/null +++ b/Network/XMPP.hs @@ -0,0 +1,106 @@ +{- + +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 . + +-} + +-- | Module: $Header$ +-- Description: A minimalistic and easy-to-use XMPP library +-- Copyright: Copyright © 2010-2011 Jon Kristensen +-- License: LGPL-3 +-- +-- 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. +-- +-- 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 +-- for more information. +-- +-- This module will be documented soon. + +module Network.XMPP ( -- Network.XMPP.JID + Address (..) + , Localpart + , Serverpart + , Resourcepart + , isFull + , isBare + , fromString + , fromStrings + + -- Network.XMPP.SASL + , replyToChallenge1 + + -- Network.XMPP.Session + , Certificate + , ClientHandler (..) + , ClientState (..) + , ConnectResult (..) + , HostName + , Password + , PortNumber + , Resource + , Session + , TerminationReason + , UserName + , sendIQ + , sendPresence + , sendMessage + , connect + , openStream + , secureWithTLS + , authenticate + , session + , OpenStreamResult (..) + , SecureWithTLSResult (..) + , AuthenticateResult (..) + + -- Network.XMPP.Stanza + , StanzaID (SID) + , From + , To + , XMLLang + , MessageType (..) + , Message (..) + , PresenceType (..) + , Presence (..) + , IQ (..) + , iqPayloadNamespace + , iqPayload + + , injectAction + + -- Network.XMPP.Utilities + , elementToString + , elementsToString + , getID ) where + +import Network.XMPP.Address +import Network.XMPP.SASL +import Network.XMPP.Session +import Network.XMPP.Stanza +import Network.XMPP.Utilities +import Network.XMPP.Types +import Network.XMPP.TLS +import Network.XMPP.Stream + diff --git a/Network/XMPP/Address.hs b/Network/XMPP/Address.hs new file mode 100644 index 0000000..30fe94d --- /dev/null +++ b/Network/XMPP/Address.hs @@ -0,0 +1,216 @@ +{- + +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 . + +-} + + +-- TODO: Move away from stringprep for all three profiles. + +-- 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...) + +-- 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. + + +module Network.XMPP.Address (fromString, fromStrings, isBare, isFull) where + +import Network.XMPP.Types + +import Data.Maybe (fromJust, isJust) +import Text.Parsec ((<|>), anyToken, char, eof, many, noneOf, parse) +import Text.Parsec.ByteString (GenParser) + +import Text.StringPrep (StringPrepProfile (..), a1, b1, b2, c11, c12, c21, c22, + 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) +import qualified Data.Text as DT (pack, unpack) + + +-- | +-- Converts a string to an XMPP address. + +fromString :: String -> Maybe Address + +fromString s = fromStrings localpart serverpart resourcepart + where + Right (localpart, serverpart, resourcepart) = + parse addressParts "" (DBC.pack s) + + +-- | +-- Converts localpart, serverpart, 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) + else Nothing + where + + -- Applies the nodeprep profile on the localpart string, if any. + localpart :: Maybe String + localpart = case l of + Just l' -> case runStringPrep nodeprepProfile (DT.pack l') of + Just l'' -> Just $ DT.unpack l'' + Nothing -> Nothing + Nothing -> Nothing + + -- Applies the nameprep profile on the serverpart string. + -- TODO: Allow unassigned? + serverpart :: Maybe String + serverpart = case runStringPrep (namePrepProfile False) (DT.pack s) of + Just s' -> Just $ DT.unpack s' + Nothing -> Nothing + + -- Applies the resourceprep profile on the resourcepart string, if any. + resourcepart :: Maybe String + resourcepart = case r of + Just r' -> case runStringPrep resourceprepProfile (DT.pack r') of + Just r'' -> Just $ DT.unpack r'' + Nothing -> Nothing + Nothing -> Nothing + + -- Returns the serverpart 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 + + -- Validates that non-serverpart strings have an appropriate length. + validateNonServerpart :: Maybe String -> Bool + validateNonServerpart Nothing = True + validateNonServerpart (Just l) = validPartLength l + where + validPartLength :: String -> Bool + validPartLength p = length p > 0 && length p < 1024 + + +-- | Returns True if the address is `bare', and False otherwise. + +isBare :: Address -> Bool + +isBare j | resourcepart j == Nothing = True + | otherwise = False + + +-- | Returns True if the address is `full', and False otherwise. + +isFull :: Address -> Bool + +isFull jid = not $ isBare jid + + +-- Parses an address string and returns its three parts. It performs no +-- validation or transformations. We are using Parsec to parse the address. +-- There is no input for which 'addressParts' fails. + +addressParts :: GenParser Char st (Maybe String, String, Maybe String) + +addressParts = do + + -- Read until we reach an '@', a '/', or EOF. + a <- many $ noneOf ['@', '/'] + + -- Case 1: We found an '@', and thus the localpart. At least the serverpart + -- is remaining. Read the '@' and until a '/' or EOF. + do + char '@' + b <- many $ noneOf ['/'] + + -- Case 1A: We found a '/' and thus have all the address parts. Read the + -- '/' and until EOF. + do + char '/' -- Resourcepart remaining + c <- many $ anyToken -- Parse resourcepart + eof + return (Just a, b, Just c) + + -- Case 1B: We have reached EOF; the address is in the form + -- localpart@serverpart. + <|> do + eof + return (Just a, b, Nothing) + + -- Case 2: We found a '/'; the address is in the form + -- serverpart/resourcepart. + <|> do + char '/' + b <- many $ anyToken + eof + return (Nothing, a, Just b) + + -- Case 3: We have reached EOF; we have an address consisting of only a + -- serverpart. + <|> do + eof + return (Nothing, a, Nothing) + + +nodeprepProfile :: StringPrepProfile + +nodeprepProfile = Profile { maps = [b1, b2] + , shouldNormalize = True + , prohibited = [a1] ++ [c11, c12, c21, c22, c3, c4, c5, c6, c7, c8, c9] + , shouldCheckBidi = True } + + +-- These needs to be checked for after normalization. We could also look up the +-- Unicode mappings and include a list of characters in the prohibited field +-- above. Let's defer that until we know that we are going to use stringprep. + +nodeprepExtraProhibitedCharacters = ['\x22', '\x26', '\x27', '\x2F', '\x3A', + '\x3C', '\x3E', '\x40'] + + + +resourceprepProfile :: StringPrepProfile + +resourceprepProfile = Profile { maps = [b1] + , shouldNormalize = True + , prohibited = [a1] ++ [c12, c21, c22, c3, c4, c5, c6, c7, c8, c9] + , shouldCheckBidi = True } diff --git a/Network/XMPP/SASL.hs b/Network/XMPP/SASL.hs new file mode 100644 index 0000000..8a1512e --- /dev/null +++ b/Network/XMPP/SASL.hs @@ -0,0 +1,215 @@ +{- + +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 . + +-} + +-- 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 + +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 + + +data Challenge1Error = C1MultipleCriticalAttributes | + C1NotAllParametersPresent | + C1SomeParamtersPresentMoreThanOnce | + C1WrongRealm | + C1UnsupportedAlgorithm | + C1UnsupportedCharset | + C1UnsupportedQOP + deriving Show + + +-- Will produce a list of key-value pairs given a string in the format of +-- realm="somerealm",nonce="OA6MG9tEQGm2hh",qop="auth",charset=utf-8... +stringToList :: String -> [(String, String)] +stringToList "" = [] +stringToList s' = let (next, rest) = break' s' ',' + in break' next '=' : stringToList rest + where + -- Like break, but will remove the first char of the continuation, if + -- present. + 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 + removeCharIfPresent [] _ = [] + removeCharIfPresent (c:t) c' | c == c' = t + removeCharIfPresent s' c = s' + +-- Counts the number of directives in the pair list. +countDirectives :: String -> [(String, String)] -> Int +countDirectives v l = DL.length $ filter (isEntry v) l + where + isEntry :: String -> (String, String) -> Bool + isEntry name (name', _) | name == name' = True + | otherwise = False + + +-- Returns the given directive in the list of pairs, or Nothing. +lookupDirective :: String -> [(String, String)] -> Maybe String +lookupDirective d [] = Nothing +lookupDirective d ((d', v):t) | d == d' = Just v + | otherwise = lookupDirective d t + + +-- Returns the given directive in the list of pairs, or the default value +-- otherwise. +lookupDirectiveWithDefault :: String -> [(String, String)] -> String -> String +lookupDirectiveWithDefault di l de + | lookup == Nothing = de + | otherwise = let Just r = lookup in r + where + 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. + +-- 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. + +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" + + +-- 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 diff --git a/Network/XMPP/Session.hs b/Network/XMPP/Session.hs new file mode 100644 index 0000000..2320dc6 --- /dev/null +++ b/Network/XMPP/Session.hs @@ -0,0 +1,758 @@ +{- + +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 . + +-} + +-- 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? + +-- I believe we need to use the MultiParamTypeClasses extension to be able to +-- work with arbitrary client states (solving the problem that the ClientState +-- type class is solving). However, I would be happy if someone proved me wrong. + +{-# 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 +-- +-- This module provides the functions used by XMPP clients to manage their XMPP +-- sessions. +-- +-- Working with Pontarius XMPP is mostly done asynchronously with callbacks; +-- Pontarius XMPP "owns" the XMPP thread and carries the client state with it. A +-- client consists of a list of client handlers to handle XMPP events. This is +-- all set up through a @Session@ object, which a client can create by calling +-- the (blocking) function @createSession@. +-- +-- The Pontarius XMPP functions operate in an arbitrary MonadIO monad. +-- Typically, clients will use the IO monad. +-- +-- For more information, see the Pontarius XMPP Manual. + +module Network.XMPP.Session ( ClientHandler (..) + , ClientState (..) + , ConnectResult (..) + , Session + , TerminationReason + , OpenStreamResult (..) + , SecureWithTLSResult (..) + , AuthenticateResult (..) + , sendPresence + , sendIQ + , sendMessage + , connect + , openStream + , secureWithTLS + , authenticate + , session + , injectAction + , getID ) where + +import Network.XMPP.Address +import Network.XMPP.SASL +import Network.XMPP.Stanza +import Network.XMPP.Stream +import Network.XMPP.TLS +import Network.XMPP.Types +import Network.XMPP.Utilities + +import qualified Control.Exception as CE +import qualified Control.Exception.Base as CEB -- ? +import qualified Control.Monad.Error as CME +import qualified Control.Monad.State as CMS +import qualified Network as N + +------------- + +import Control.Concurrent.MVar + +import Codec.Binary.UTF8.String +import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan) +import Control.Concurrent (ThreadId, forkIO, killThread, threadDelay) +import Control.Monad.IO.Class (liftIO, MonadIO) +import Control.Monad.State hiding (State) +import Data.Enumerator (($$), Iteratee, continue, joinI, + run, run_, yield) +import Data.Enumerator.Binary (enumHandle, enumFile) +import Data.Maybe +import Data.String +import Data.XML.Types +import GHC.IO.Handle (Handle, hPutStr, hFlush, hSetBuffering, hWaitForInput) +import Network.TLS +import Network.TLS.Cipher +import System.IO (BufferMode, BufferMode(NoBuffering)) +import Text.XML.Enumerator.Parse (parseBytes, decodeEntities) +import Text.XML.Enumerator.Document (fromEvents) +import qualified Codec.Binary.Base64.String as CBBS +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 + + + +-- ============================================================================= +-- EXPORTED TYPES AND FUNCTIONS +-- ============================================================================= + + +-- | The @Session@ object is used by clients when interacting with Pontarius +-- XMPP. It holds information needed by Pontarius XMPP; its content is not +-- accessible from the client. + +data Session s m = Session { sessionChannel :: Chan (InternalEvent s m) + , sessionIDGenerator :: IDGenerator } + + +-- | A client typically needs one or more @ClientHandler@ objects to interact +-- with Pontarius XMPP. Each client handler may provide four callback +-- functions; the first three callbacks deals with received stanzas, and the +-- last one is used when the session is terminated. +-- +-- These stanza functions takes the current client state and an object +-- containing the details of the stanza in question. The boolean returned +-- along with the possibly updated state signals whether or not the message +-- should be blocked to client handlerss further down the stack. For example, +-- an XEP-0030: Service Discovery handler may choose to hide disco\#info +-- requests to handlers above it in the stack. +-- +-- The 'sessionTerminated' callback function takes a 'TerminationReason' value +-- along with the state and will be sent to all client handlers. + +data MonadIO m => ClientHandler s m = + ClientHandler { messageReceived :: Maybe (Message -> StateT s m Bool) + , presenceReceived :: Maybe (Presence -> StateT s m Bool) + , iqReceived :: Maybe (IQ -> StateT s m Bool) + , sessionTerminated :: Maybe (TerminationReason -> + StateT s m ()) } + + +-- | @TerminationReason@ contains information on why the XMPP session was +-- terminated. + +data TerminationReason = WhateverReason -- TODO + + +-- | Creates an XMPP session. Blocks the current thread. The first parameter, +-- @s@, is an arbitrary state that is defined by the client. This is the +-- initial state, and it will be passed to the client (handlers) as XMPP +-- events are emitted. The second parameter is the list of @ClientHandler@s; +-- this is a way to provide a "layered" system of XMPP event handlers. For +-- example, a client may have a dedicated handler to manage messages, +-- implement a spam protection system, etc. Messages are piped through these +-- handlers one by one, and any handler may block the message from being sent +-- to the next handler(s) above in the stack. The third argument is a callback +-- function that will be called when the session has been initialized, and +-- this function should be used by the client to store the Session object in +-- its state. + +-- Creates the internal event channel, injects the Pontarius XMPP session object +-- into the ClientState object, runs the "session created" client callback (in +-- the new state context), and stores the updated client state in s''. Finally, +-- we launch the (main) state loop of Pontarius XMPP. + +session :: (MonadIO m, ClientState s m) => s -> [ClientHandler s m] -> + (CMS.StateT s m ()) -> m () + +session s h c = do + threadID <- liftIO $ newEmptyMVar + chan <- liftIO $ newChan + idGenerator <- liftIO $ idGenerator "" -- TODO: Prefix + ((), clientState) <- runStateT c (putSession s $ session_ chan idGenerator) + (result, _) <- runStateT (stateLoop chan) + (defaultState chan threadID h clientState idGenerator) + case result of + Just (CE.SomeException e) -> do + liftIO $ putStrLn "Got an exception!" + threadID' <- liftIO $ tryTakeMVar threadID + case threadID' of + Nothing -> do + liftIO $ putStrLn "No thread ID to kill" + Just t -> do + liftIO $ putStrLn "Killing thread" + liftIO $ killThread t + CE.throw e + Nothing -> + return () + where + -- session :: Chan (InternalEvent m s) -> Session m s -- TODO + session_ c i = Session { sessionChannel = c, sessionIDGenerator = i } + + +defaultState :: (MonadIO m, ClientState s m) => Chan (InternalEvent s m) -> MVar ThreadId -> + [ClientHandler s m] -> s -> IDGenerator -> State s m + +defaultState c t h s i = State { stateClientHandlers = h + , stateClientState = s + , stateChannel = c + , stateConnectionState = Disconnected + , stateStreamState = PreStream + , stateTLSState = NoTLS + , stateOpenStreamCallback = Nothing + , stateSecureWithTLSCallback = Nothing + , stateAuthenticateCallback = Nothing + , stateAuthenticationState = NoAuthentication + , stateResource = Nothing + , stateShouldExit = False + , stateThreadID = t + , statePresenceCallbacks = [] + , stateMessageCallbacks = [] + , stateIQCallbacks = [] + , stateTimeoutStanzaIDs = [] + , stateIDGenerator = i } -- TODO: Prefix + + +connect :: MonadIO m => Session s m -> HostName -> PortNumber -> + Maybe (Certificate, (Certificate -> 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' + where + connect' r = case r of + OpenStreamSuccess _ _ -> case t of -- TODO: Check for TLS support? + Just (certificate, certificateValidator) -> + secureWithTLS s certificate certificateValidator connect'' + Nothing -> connect'' (SecureWithTLSSuccess 1.0 "") -- TODO + OpenStreamFailure -> c ConnectOpenStreamFailure + connect'' r = case r of + SecureWithTLSSuccess _ _ -> case a of + Just (userName, password, resource) -> + authenticate s userName password resource connect''' + Nothing -> connect''' (AuthenticateSuccess 1.0 "" "todo") -- TODO + SecureWithTLSFailure -> c ConnectSecureWithTLSFailure + connect''' r = case r of + AuthenticateSuccess streamProperties streamFeatures resource -> + c (ConnectSuccess streamProperties streamFeatures (Just resource)) + AuthenticateFailure -> c ConnectAuthenticateFailure + + +openStream :: MonadIO m => Session s m -> HostName -> PortNumber -> + (OpenStreamResult -> StateT s m ()) -> StateT s m () + +openStream 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 () + +secureWithTLS s c a c_ = CMS.get >>= + (\ state -> lift $ liftIO $ + writeChan (sessionChannel s) + (IEC (CESecureWithTLS c a c_))) + + +-- | + +authenticate :: MonadIO m => Session s m -> UserName -> Password -> + Maybe Resource -> (AuthenticateResult -> StateT s m ()) -> + StateT s m () + +authenticate s u p r c = CMS.get >>= + (\ state -> lift $ liftIO $ + writeChan (sessionChannel s) + (IEC (CEAuthenticate u p r c))) + + +sendMessage :: MonadIO m => Session s m -> Message -> Maybe (Message -> StateT s m Bool) -> Maybe (Timeout, StateT s m ()) -> Maybe (StreamError -> StateT s m ()) -> StateT s m () +sendMessage se m c t st = CMS.get >>= + (\ state -> lift $ liftIO $ + writeChan (sessionChannel se) + (IEC (CEMessage m c t st))) + +sendPresence :: MonadIO m => Session s m -> Presence -> Maybe (Presence -> StateT s m Bool) -> Maybe (Timeout, StateT s m ()) -> Maybe (StreamError -> StateT s m ()) -> StateT s m () +sendPresence se p c t st = CMS.get >>= + (\ state -> lift $ liftIO $ + writeChan (sessionChannel se) + (IEC (CEPresence p c t st))) + +sendIQ :: MonadIO m => Session s m -> IQ -> Maybe (IQ -> StateT s m Bool) -> Maybe (Timeout, StateT s m ()) -> Maybe (StreamError -> StateT s m ()) -> StateT s m () +sendIQ se i c t st = CMS.get >>= + (\ state -> lift $ liftIO $ + writeChan (sessionChannel se) + (IEC (CEIQ i c t st))) + +injectAction :: MonadIO m => Session s m -> Maybe (StateT s m Bool) -> StateT s m () -> StateT s m () +injectAction s p a = CMS.get >>= + (\ state -> lift $ liftIO $ + writeChan (sessionChannel s) + (IEC (CEAction p a))) + +getID :: MonadIO m => Session s m -> StateT s m String +getID s = CMS.get >>= \ state -> lift $ liftIO $ nextID (sessionIDGenerator s) >>= \ id -> return id + +-- xmppDisconnect :: MonadIO m => Session s m -> Maybe (s -> (Bool, s)) -> m () +-- xmppDisconnect s c = xmppDisconnect s c + +class ClientState s m where + putSession :: s -> Session s m -> s + + +-- ============================================================================= +-- INTERNAL TYPES AND FUNCTIONS +-- ============================================================================= + + +type OpenStreamCallback s m = Maybe (OpenStreamResult -> CMS.StateT s m ()) + +type SecureWithTLSCallback s m = Maybe (SecureWithTLSResult -> CMS.StateT s m ()) + +type AuthenticateCallback s m = Maybe (AuthenticateResult -> CMS.StateT s m ()) + + +isConnected :: ConnectionState -> Bool +isConnected Disconnected = True +isConnected (Connected _ _) = True + +data MonadIO m => State s m = + State { stateClientHandlers :: [ClientHandler s m] + , stateClientState :: s + , stateChannel :: Chan (InternalEvent s m) + , stateConnectionState :: ConnectionState -- s m + , stateTLSState :: TLSState + , stateStreamState :: StreamState + , stateOpenStreamCallback :: OpenStreamCallback s m + , stateSecureWithTLSCallback :: SecureWithTLSCallback s m + , stateAuthenticateCallback :: AuthenticateCallback s m + , stateAuthenticationState :: AuthenticationState + , stateResource :: Maybe Resource + , stateShouldExit :: Bool + , stateThreadID :: MVar ThreadId + , statePresenceCallbacks :: [(StanzaID, (Presence -> StateT s m Bool))] + , stateMessageCallbacks :: [(StanzaID, (Message -> StateT s m Bool))] + , stateIQCallbacks :: [(StanzaID, (IQ -> StateT s m Bool))] + , stateTimeoutStanzaIDs :: [StanzaID] + , stateIDGenerator :: IDGenerator + } + + +-- Repeatedly reads internal events from the channel and processes them. This is +-- the main loop of the XMPP session process. + +-- The main loop of the XMPP library runs in the following monads: +-- +-- m, m => MonadIO (from the client) +-- StateT +-- ErrorT + +-- TODO: Will >> carry the updated state? +-- TODO: Should InternalState be in both places? + +stateLoop :: (MonadIO m, ClientState s m) => Chan (InternalEvent s m) -> + StateT (State s m) m (Maybe CE.SomeException) + +stateLoop c = do + event <- lift $ liftIO $ readChan c + lift $ liftIO $ putStrLn $ "Processing event " ++ (show event) ++ "." + result <- (processEvent event) + state <- get + case result of + Nothing -> do + case stateShouldExit state of + True -> + return $ Nothing + False -> + stateLoop c + Just e -> + return $ Just e + + +-- Process an InternalEvent and performs the necessary IO and updates the state +-- accordingly. + +processEvent :: (MonadIO m, ClientState s m) => (InternalEvent s m) -> + (StateT (State s m) m) (Maybe CE.SomeException) + +processEvent e = get >>= \ state -> + let handleOrTLSCtx = case stateTLSState state of + PostHandshake tlsCtx -> + Right tlsCtx + _ -> + let Connected _ handle = stateConnectionState state in Left handle + in case e of + + -- --------------------------------------------------------------------------- + -- CLIENT EVENTS + -- --------------------------------------------------------------------------- + -- + IEC (CEOpenStream hostName portNumber callback) -> do + + CEB.assert (stateConnectionState state == Disconnected) (return ()) + + let portNumber' = fromIntegral portNumber + + connectResult <- liftIO $ CE.try $ N.connectTo hostName + (N.PortNumber portNumber') + + case connectResult of + Right handle -> do + put $ state { stateConnectionState = Connected (ServerAddress hostName portNumber') handle + , stateStreamState = PreStream + , stateOpenStreamCallback = Just callback } + lift $ liftIO $ hSetBuffering handle NoBuffering + lift $ liftIO $ send ("") (Left handle) + threadID <- lift $ liftIO $ forkIO $ xmlEnumerator (stateChannel state) (Left handle) + lift $ liftIO $ putMVar (stateThreadID state) threadID + return Nothing + Left e -> do + let clientState = stateClientState state + ((), clientState') <- lift $ runStateT (callback OpenStreamFailure) clientState + put $ state { stateShouldExit = True } + return $ Just e + + IEC (CESecureWithTLS certificate verifyCertificate callback) -> do + -- CEB.assert (not $ isTLSSecured (stateStreamState state)) (return ()) + let Connected _ handle = stateConnectionState state + lift $ liftIO $ send "" (Left handle) + put $ state { stateStreamState = PreStream + , stateSecureWithTLSCallback = Just callback } + return Nothing + +-- TODO: Save callback in state. + IEC (CEAuthenticate userName password resource callback) -> do + -- CEB.assert (or [ stateConnectionState state == Connected + -- , stateConnectionState state == TLSSecured ]) (return ()) + -- CEB.assert (stateHandle state /= Nothing) (return ()) + put $ state { stateAuthenticationState = AuthenticatingPreChallenge1 userName password resource + , stateAuthenticateCallback = Just callback } + lift $ liftIO $ send "" handleOrTLSCtx + return Nothing + + IEE (EnumeratorXML (XEBeginStream stream)) -> 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 ("") handleOrTLSCtx + return () + _ -> do + lift $ liftIO $ send ("" ++ fromJust resource ++ "") handleOrTLSCtx + return () + id <- liftIO $ nextID $ stateIDGenerator state + lift $ liftIO $ send ("" ++ "") 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 ("") (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 ("" ++ reply' ++ "") 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 "" 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: ? + IEE (EnumeratorXML (XESuccess (Succ _))) -> do + let serverHost = "jonkristensen.com" + let AuthenticatingPreSuccess userName _ resource = stateAuthenticationState state in do + lift $ liftIO $ send ("") handleOrTLSCtx + put $ state { stateAuthenticationState = AuthenticatedUnbound userName resource } + return Nothing + + IEE EnumeratorDone -> + -- TODO: Exit? + return Nothing + + -- --------------------------------------------------------------------------- + -- 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 + + IEC (CEPresence presence stanzaCallback timeoutCallback streamErrorCallback) -> do + presence' <- case presenceID $ presence of + Nothing -> do + id <- liftIO $ nextID $ stateIDGenerator state + return $ presence { presenceID = Just (SID id) } + _ -> return presence + case timeoutCallback of + Just (t, timeoutCallback') -> + let stanzaID' = (fromJust $ presenceID $ presence') in do + registerTimeout (stateChannel state) stanzaID' t timeoutCallback' + put $ state { stateTimeoutStanzaIDs = stanzaID':(stateTimeoutStanzaIDs state) } + Nothing -> + return () + let xml = presenceToXML presence' + lift $ liftIO $ send xml handleOrTLSCtx + return Nothing + + IEC (CEMessage message stanzaCallback timeoutCallback streamErrorCallback) -> do + message' <- case messageID message of + Nothing -> do + id <- liftIO $ nextID $ stateIDGenerator state + return $ message { messageID = Just (SID id) } + _ -> return message + case timeoutCallback of + Just (t, timeoutCallback') -> + let stanzaID' = (fromJust $ messageID message') in do + registerTimeout (stateChannel state) stanzaID' t timeoutCallback' + put $ state { stateTimeoutStanzaIDs = stanzaID':(stateTimeoutStanzaIDs state) } + Nothing -> + return () + let xml = messageToXML message' + lift $ liftIO $ send xml handleOrTLSCtx + return Nothing + + IEC (CEIQ iq stanzaCallback timeoutCallback stanzaErrorCallback) -> do + iq' <- 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 () + case timeoutCallback of + Just (t, timeoutCallback') -> + let stanzaID' = (fromJust $ iqID iq') in do + registerTimeout (stateChannel state) stanzaID' t timeoutCallback' + put $ state { stateTimeoutStanzaIDs = stanzaID':(stateTimeoutStanzaIDs state) } + Nothing -> + return () + -- TODO: Bind ID to callback + let xml = iqToXML iq' + lift $ liftIO $ send xml handleOrTLSCtx + return Nothing + + IEC (CEAction predicate callback) -> do + case predicate of + Just predicate' -> do + result <- runBoolClientCallback predicate' + case result of + True -> do + runUnitClientCallback callback + return Nothing + False -> return Nothing + Nothing -> do + runUnitClientCallback callback + return Nothing + + -- XOEDisconnect -> do + -- -- TODO: Close stream + -- return () + + IET (TimeoutEvent i t c) -> + case i `elem` (stateTimeoutStanzaIDs state) of + True -> do + runUnitClientCallback c + return Nothing + False -> return Nothing + + + e -> do + return Nothing + -- lift $ liftIO $ putStrLn $ "UNCAUGHT EVENT: " ++ (show e) + -- return $ Just (CE.SomeException $ CE.PatternMatchFail "processEvent") + where + -- Assumes handle is set + send :: String -> Either Handle TLSCtx -> IO () + send s o = case o of + Left handle -> do + liftIO $ hPutStr handle $ encodeString $ s + liftIO $ hFlush handle + return () + Right tlsCtx -> do + liftIO $ sendData tlsCtx $ DBLC.pack $ encodeString s + return () + shouldIgnoreIQ :: IQ -> Bool + shouldIgnoreIQ i = case iqPayload i of + Nothing -> False + Just e -> case nameNamespace $ elementName e of + Just x | x == DT.pack "urn:ietf:params:xml:ns:xmpp-bind" -> True + Just x | x == DT.pack "urn:ietf:params:xml:ns:xmpp-session" -> True + Just _ -> False + Nothing -> False + + +registerTimeout :: (ClientState s m, MonadIO m) => Chan (InternalEvent s m) -> StanzaID -> Timeout -> StateT s m () -> StateT (State s m) m () +registerTimeout ch i t ca = do + liftIO $ threadDelay $ t * 1000 + liftIO $ forkIO $ writeChan ch $ IET (TimeoutEvent i t ca) + return () + + +runBoolClientCallback :: (ClientState s m, MonadIO m) => StateT s m Bool -> StateT (State s m) m Bool +runBoolClientCallback c = do + state <- get + let clientState = stateClientState state + (bool, clientState') <- lift $ runStateT c clientState + put $ state { stateClientState = clientState' } + return bool + + +runUnitClientCallback :: (ClientState s m, MonadIO m) => StateT s m () -> StateT (State s m) m () +runUnitClientCallback c = do + state <- get + let clientState = stateClientState state + ((), clientState') <- lift $ runStateT c clientState + put $ state { stateClientState = clientState' } + + +sendToClient :: (MonadIO m, ClientState s m) => [Maybe (StateT s m Bool)] -> s -> (StateT (State s m) m) s +sendToClient [] s = return s +sendToClient (Nothing:fs) s = sendToClient fs s +sendToClient ((Just f):fs) s = do + (b, s') <- lift $ runStateT f s + case b of + True -> return s' + False -> sendToClient fs s' diff --git a/Network/XMPP/Stanza.hs b/Network/XMPP/Stanza.hs new file mode 100644 index 0000000..00ca9af --- /dev/null +++ b/Network/XMPP/Stanza.hs @@ -0,0 +1,182 @@ +{- + +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 . + +-} + +-- | +-- 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 +-- both types. +-- +-- We also provide functions to create a new stanza ID generator, and to +-- generate new IDs. + + +module Network.XMPP.Stanza ( +iqID, +iqFrom, +iqTo, +iqXMLLang, +iqPayload, +iqPayloadNamespace, +iqRequestPayloadNamespace, +iqResponsePayloadNamespace, +idGenerator, +nextID +) where + +import Network.XMPP.Address +import Network.XMPP.Types + +import Data.IORef (atomicModifyIORef, newIORef) +import Data.XML.Types (Element, elementName, nameNamespace) +import Data.Text (unpack) + + +-- | +-- Returns the @StanzaID@ value of the @IQ@, if any. + +iqID :: IQ -> Maybe StanzaID + +iqID (IQReq i) = iqRequestID i +iqID (IQRes i) = iqResponseID i + + +-- | +-- Returns the @From@ @JID@ value of the @IQ@, if any. + +iqFrom :: IQ -> Maybe From + +iqFrom (IQReq i) = iqRequestFrom i +iqFrom (IQRes i) = iqResponseFrom i + + +-- | +-- Returns the @To@ @JID@ value of the @IQ@, if any. + +iqTo :: IQ -> Maybe To + +iqTo (IQReq i) = iqRequestTo i +iqTo (IQRes i) = iqResponseTo i + + +-- | +-- Returns the @XMLLang@ value of the @IQ@, if any. + +iqXMLLang :: IQ -> Maybe XMLLang + +iqXMLLang (IQReq i) = iqRequestXMLLang i +iqXMLLang (IQRes i) = iqResponseXMLLang i + + +-- | +-- 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 + + +-- | +-- Returns the namespace of the element of the @IQ@, if any. + +iqPayloadNamespace :: IQ -> Maybe String + +iqPayloadNamespace i = case iqPayload i of + Nothing -> Nothing + Just p -> case nameNamespace $ elementName p of + Nothing -> Nothing + Just n -> Just (unpack n) + + +-- | +-- Returns the namespace of the element of the @IQRequest@, if any. + +iqRequestPayloadNamespace :: IQRequest -> Maybe String + +iqRequestPayloadNamespace i = let p = iqRequestPayload i in + case nameNamespace $ elementName p of + Nothing -> Nothing + Just n -> Just (unpack n) + + +-- | +-- Returns the namespace of the element of the @IQRequest@, if any. + +iqResponsePayloadNamespace :: IQResponse -> Maybe String + +iqResponsePayloadNamespace i = case iqResponsePayload i of + Nothing -> Nothing + Just p -> case nameNamespace $ elementName p of + Nothing -> Nothing + Just n -> Just (unpack n) + + +-- | +-- Creates a new stanza "IDGenerator". Internally, it will maintain an infinite +-- list of stanza IDs ('[\'a\', \'b\', \'c\'...]'). + +idGenerator :: String -> IO IDGenerator + +idGenerator p = newIORef (ids p) >>= \ ioRef -> return $ IDGenerator ioRef + + +-- | +-- Extracts an ID from the "IDGenerator", and updates the generators internal +-- state so that the same ID will not be generated again. + +nextID :: IDGenerator -> IO String + +nextID g = let IDGenerator ioRef = g + in atomicModifyIORef ioRef (\ (i:is) -> (is, i)) + + +-- Generates an infinite and predictable list of IDs, all beginning with the +-- provided prefix. + +ids :: String -> [String] + +-- Adds the prefix to all combinations of IDs (ids'). +ids p = map (\ id -> p ++ id) ids' + where + + -- Generate all combinations of IDs, with increasing length. + ids' :: [String] + ids' = concatMap ids'' [1..] + + -- Generates all combinations of IDs with the given length. + ids'' :: Integer -> [String] + ids'' 0 = [""] + ids'' l = [x:xs | x <- repertoire, xs <- ids'' (l - 1)] + + -- Characters allowed in IDs. + repertoire :: String + repertoire = ['a'..'z'] diff --git a/Network/XMPP/Stream.hs b/Network/XMPP/Stream.hs new file mode 100644 index 0000000..82477bb --- /dev/null +++ b/Network/XMPP/Stream.hs @@ -0,0 +1,457 @@ +----------------------------------------------------------------------------- +-- +-- Module : Network.XMPP.Stream +-- Copyright : Copyright © 2011, Jon Kristensen +-- License : UnknownLicense "LGPL3" +-- +-- Maintainer : jon.kristensen@pontarius.org +-- Stability : alpha +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Network.XMPP.Stream ( +isTLSSecured, +xmlEnumerator, +xmlReader, +presenceToXML, +iqToXML, +messageToXML, +parsePresence, +parseIQ, +parseMessage +) 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 Data.XML.Types + +import Control.Monad.IO.Class (liftIO, MonadIO) +import Data.String (IsString(..)) + +isTLSSecured :: TLSState -> Bool +isTLSSecured (PostHandshake _) = True +isTLSSecured _ = False + + +-- 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 + + 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 + + +xmlReader :: Chan (InternalEvent s m) -> Iteratee Event IO (Maybe Event) + +xmlReader c = xmlReader_ c [] 0 + + +xmlReader_ :: Chan (InternalEvent s m) -> [Event] -> Int -> + Iteratee Event IO (Maybe Event) + +xmlReader_ ch [EventBeginDocument] 0 = xmlReader_ ch [] 0 + +-- 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 + +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 + +-- 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 + +-- 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' + + +-- 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 + +eventsToElement :: [Event] -> Element +eventsToElement e = do + documentRoot $ fromJust (run_ $ enum e $$ fromEvents) + where + enum :: [Event] -> E.Enumerator Event Maybe Document + enum e_ (E.Continue k) = k $ E.Chunks e_ + enum e_ step = E.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 = "" ++ + (elementsToString $ presencePayload p) ++ "" + where + from :: String + from = case presenceFrom p of + -- TODO: Lower-case + Just s -> " from='" ++ (show s) ++ "'" + Nothing -> "" + + 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 -> "" + + type' :: String + type' = case presenceType p of + Available -> "" + t -> " type='" ++ (presenceTypeToString t) ++ "'" + +iqToXML :: IQ -> String +iqToXML (IQReq (IQGet { iqRequestID = i, iqRequestPayload = p, iqRequestFrom = f, iqRequestTo = t })) = + let type' = " type='get'" in "" ++ (elementToString (Just p)) ++ "" + where + from :: String + from = case f of + -- TODO: Lower-case + Just s -> " from='" ++ (show s) ++ "'" + Nothing -> "" + + id' :: String + id' = case i of + Just (SID s) -> " id='" ++ s ++ "'" + Nothing -> "" + + to :: String + to = case t of + -- TODO: Lower-case + Just s -> " to='" ++ (show s) ++ "'" + Nothing -> "" + +iqToXML (IQReq (IQSet { iqRequestID = i, iqRequestPayload = p, iqRequestFrom = f, iqRequestTo = t })) = + let type' = " type='set'" in "" ++ (elementToString (Just p)) ++ "" + where + from :: String + from = case f of + -- TODO: Lower-case + Just s -> " from='" ++ (show s) ++ "'" + Nothing -> "" + + id' :: String + id' = case i of + Just (SID s) -> " id='" ++ s ++ "'" + Nothing -> "" + + to :: String + to = case t of + -- TODO: Lower-case + Just s -> " to='" ++ (show s) ++ "'" + Nothing -> "" + +iqToXML (IQRes (IQResult { iqResponseID = i, iqResponsePayload = p, iqResponseFrom = f, iqResponseTo = t })) = + let type' = " type='result'" in "" ++ (elementToString p) ++ "" + where + from :: String + from = case f of + -- TODO: Lower-case + Just s -> " from='" ++ (show s) ++ "'" + Nothing -> "" + + id' :: String + id' = case i of + Just (SID s) -> " id='" ++ s ++ "'" + Nothing -> "" + + to :: String + to = case t of + -- TODO: Lower-case + Just s -> " to='" ++ (show s) ++ "'" + Nothing -> "" + +-- TODO: Turn message errors into XML. + +messageToXML :: Message -> String +messageToXML Message { messageID = i, messageFrom = f, messageTo = t, messagePayload = p, messageType = ty } = "" ++ + (elementsToString $ p) ++ "" + where + from :: String + from = case f of + -- TODO: Lower-case + Just s -> " from='" ++ (show s) ++ "'" + Nothing -> "" + + id' :: String + id' = case i of + Just (SID s) -> " id='" ++ s ++ "'" + Nothing -> "" + + 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) ++ "'" + + +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. + + 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 + + fromAttr :: Maybe Address + fromAttr = case attributeText fromName e of + Nothing -> Nothing + Just a -> X.fromString $ DT.unpack a + + 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)) + + typeName :: Name + typeName = fromString "type" + + fromName :: Name + fromName = fromString "from" + + toName :: Name + toName = fromString "to" + + idName :: Name + idName = fromString "id" + +-- TODO: Parse xml:lang + +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 + + fromAttr :: Maybe Address + fromAttr = case attributeText fromName e of + Nothing -> Nothing + Just a -> X.fromString $ DT.unpack a + + 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)) + + fromName :: Name + fromName = fromString "from" + + typeName :: Name + typeName = fromString "type" + + toName :: Name + toName = fromString "to" + + 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. + + typeAttr :: MessageType + typeAttr = case attributeText typeName e of + Just t -> stringToMessageType $ DT.unpack t + Nothing -> Normal + + fromAttr :: Maybe Address + fromAttr = case attributeText fromName e of + Nothing -> Nothing + Just a -> X.fromString $ DT.unpack a + + 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)) + + fromName :: Name + fromName = fromString "from" + + typeName :: Name + typeName = fromString "type" + + toName :: Name + toName = fromString "to" + + idName :: Name + idName = fromString "id" + +-- stringToPresenceType "available" = Available +-- stringToPresenceType "away" = Away +-- stringToPresenceType "chat" = Chat +-- stringToPresenceType "dnd" = DoNotDisturb +-- stringToPresenceType "xa" = ExtendedAway + +stringToPresenceType "available" = Available -- TODO: Some client sent this + +stringToPresenceType "probe" = Probe +-- stringToPresenceType "error" = PresenceError -- TODO: Special case + +stringToPresenceType "unavailable" = Unavailable +stringToPresenceType "subscribe" = Subscribe +stringToPresenceType "subscribed" = Subscribed +stringToPresenceType "unsubscribe" = Unsubscribe +stringToPresenceType "unsubscribed" = Unsubscribed + +-- presenceTypeToString Available = "available" + +-- presenceTypeToString Away = "away" +-- presenceTypeToString Chat = "chat" +-- presenceTypeToString DoNotDisturb = "dnd" +-- presenceTypeToString ExtendedAway = "xa" + +presenceTypeToString Unavailable = "unavailable" + +presenceTypeToString Probe = "probe" +-- presenceTypeToString PresenceError = "error" -- TODO: Special case + +presenceTypeToString Subscribe = "subscribe" +presenceTypeToString Subscribed = "subscribed" +presenceTypeToString Unsubscribe = "unsubscribe" +presenceTypeToString Unsubscribed = "unsubscribed" + +stringToMessageType "chat" = Chat +stringToMessageType "error" = Error +stringToMessageType "groupchat" = Groupchat +stringToMessageType "headline" = Headline +stringToMessageType "normal" = Normal +stringToMessageType s = OtherMessageType s + +messageTypeToString Chat = "chat" +messageTypeToString Error = "error" +messageTypeToString Groupchat = "groupchat" +messageTypeToString Headline = "headline" +messageTypeToString Normal = "normal" +messageTypeToString (OtherMessageType s) = s diff --git a/Network/XMPP/TLS.hs b/Network/XMPP/TLS.hs new file mode 100644 index 0000000..ec301f8 --- /dev/null +++ b/Network/XMPP/TLS.hs @@ -0,0 +1,47 @@ +----------------------------------------------------------------------------- +-- +-- Module : Network.XMPP.TLS +-- Copyright : Copyright © 2011, Jon Kristensen +-- License : LGPL (Just (Version {versionBranch = [3], versionTags = []})) +-- +-- Maintainer : jon.kristensen@pontarius.org +-- Stability : alpha +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Network.XMPP.TLS ( +getTLSParams, +handshake' +) where + +import Network.TLS +import Network.TLS.Cipher +import GHC.IO.Handle (Handle, hPutStr, hFlush, hSetBuffering, hWaitForInput) + + +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 + +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 diff --git a/Network/XMPP/Types.hs b/Network/XMPP/Types.hs new file mode 100644 index 0000000..f6ca6c2 --- /dev/null +++ b/Network/XMPP/Types.hs @@ -0,0 +1,457 @@ +----------------------------------------------------------------------------- +-- +-- Module : Types +-- Copyright : Copyright © 2011, Jon Kristensen +-- License : LGPL (Just (Version {versionBranch = [3], versionTags = []})) +-- +-- Maintainer : jon.kristensen@pontarius.org +-- Stability : alpha +-- Portability : +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE MultiParamTypeClasses #-} + +module Network.XMPP.Types ( +StanzaID (..), +From, +To, +IQ (..), +IQRequest (..), +IQResponse (..), +Message (..), +MessageType (..), +Presence (..), +PresenceType (..), +StanzaError (..), +StanzaErrorType (..), +StanzaErrorCondition (..), + HostName + , Password + , PortNumber + , Resource + , UserName, +EnumeratorEvent (..), +Challenge (..), +Success (..), +TLSState (..), +Address (..), +Localpart, +Serverpart, +Resourcepart, +XMLLang, +InternalEvent (..), +XMLEvent (..), +ConnectionState (..), +ClientEvent (..), +StreamState (..), +AuthenticationState (..), +Certificate, +ConnectResult (..), +OpenStreamResult (..), +SecureWithTLSResult (..), +AuthenticateResult (..), +ServerAddress (..), +XMPPError (..), +Timeout, +TimeoutEvent (..), +StreamError (..), +IDGenerator (..) +) where + +import GHC.IO.Handle (Handle, hPutStr, hFlush, hSetBuffering, hWaitForInput) + +import qualified Network as N + +import qualified Control.Exception as CE + +import Control.Monad.State hiding (State) + +import Data.XML.Types + +import Network.TLS +import Network.TLS.Cipher + +import qualified Control.Monad.Error as CME + +import Data.IORef + + + +-- ============================================================================= +-- STANZA TYPES +-- ============================================================================= + + +-- TODO: Would a Stanza class such as the one below be useful sometimes? +-- +-- class Stanza a where +-- stanzaID :: a -> Maybe StanzaID +-- stanzaFrom :: a -> Maybe From +-- stanzaTo :: a -> Maybe To +-- stanzaXMLLang :: a -> Maybe XMLLang + + +-- | +-- The StanzaID type wraps a string of random characters that in Pontarius XMPP +-- is guaranteed to be unique for the XMPP session. Clients can add a string +-- prefix for the IDs to guarantee that they are unique in a larger context by +-- specifying the stanzaIDPrefix setting. TODO + +data StanzaID = SID String deriving (Eq, Show) + + +-- | +-- @From@ is a readability type synonym for @Address@. + +type From = Address + + +-- | +-- @To@ is a readability type synonym for @Address@. + +type To = Address + + +-- | +-- 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) + + +-- | +-- 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) + + +-- | +-- A "response" Info/Query (IQ) stanza is one with either "result" or "error" as +-- type. + +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) + + +-- | +-- 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 + , 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) + + +-- | +-- @MessageType@ holds XMPP message types as defined in XMPP-IM. @Normal@ is the +-- default message type. + +data MessageType = Chat | + Error | + Groupchat | + Headline | + Normal | + OtherMessageType String deriving (Eq, Show) + + +-- | +-- The presence stanza - either a presence or a presence error. + +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) + + +-- | +-- @PresenceType@ holds XMPP presence types. When a presence type is not +-- provided, we assign the @PresenceType@ value @Available@. + +data PresenceType = Subscribe | -- ^ Sender wants to subscribe to presence + Subscribed | -- ^ Sender has approved the subscription + Unsubscribe | -- ^ Sender is unsubscribing from presence + Unsubscribed | -- ^ Sender has denied or cancelled a + -- subscription + Probe | -- ^ Sender requests current presence; + -- should only be used by servers + Available | -- ^ Sender did not specify a type attribute + Unavailable deriving (Eq, Show) + + +-- | +-- All stanzas (IQ, message, presence) can cause errors, which in the XMPP +-- stream looks like . These errors are +-- wrapped in the @StanzaError@ type. + +data StanzaError = StanzaError { stanzaErrorType :: StanzaErrorType + , stanzaErrorCondition :: StanzaErrorCondition + , stanzaErrorText :: Maybe String + , stanzaErrorApplicationSpecificCondition :: + Maybe Element } deriving (Eq, Show) + + +-- | +-- @StanzaError@s always have one of these types. + +data StanzaErrorType = Cancel | -- ^ Error is unrecoverable - do not retry + Continue | -- ^ Conditition was a warning - proceed + Modify | -- ^ Change the data and retry + Auth | -- ^ Provide credentials and retry + Wait -- ^ Error is temporary - wait and retry + deriving (Eq, Show) + + +-- | +-- Stanza errors are accommodated with one of the error conditions listed below. + +data StanzaErrorCondition = BadRequest | -- ^ Malformed XML + Conflict | -- ^ Resource or session + -- with name already + -- exists + FeatureNotImplemented | + Forbidden | -- ^ Insufficient + -- permissions + Gone | -- ^ Entity can no longer + -- be contacted at this + -- address + InternalServerError | + ItemNotFound | + JIDMalformed | + NotAcceptable | -- ^ Does not meet policy + -- criteria + NotAllowed | -- ^ No entity may perform + -- this action + NotAuthorized | -- ^ Must provide proper + -- credentials + PaymentRequired | + RecipientUnavailable | -- ^ Temporarily + -- unavailable + Redirect | -- ^ Redirecting to other + -- entity, usually + -- temporarily + RegistrationRequired | + RemoteServerNotFound | + RemoteServerTimeout | + ResourceConstraint | -- ^ Entity lacks the + -- necessary system + -- resources + ServiceUnavailable | + SubscriptionRequired | + UndefinedCondition | -- ^ Application-specific + -- condition + UnexpectedRequest -- ^ Badly timed request + deriving (Eq, Show) + + + +-- ============================================================================= +-- OTHER STUFF +-- ============================================================================= + + +instance Eq ConnectionState where + Disconnected == Disconnected = True + (Connected p h) == (Connected p_ h_) = p == p_ && h == h_ + -- (ConnectedPostFeatures s p h t) == (ConnectedPostFeatures s p h t) = True + -- (ConnectedAuthenticated s p h t) == (ConnectedAuthenticated s p h t) = True + _ == _ = False + +data XMPPError = UncaughtEvent deriving (Eq, Show) + +instance CME.Error XMPPError where + strMsg "UncaughtEvent" = UncaughtEvent + + +-- | Readability type for host name Strings. + +type HostName = String -- This is defined in Network as well + + +-- | Readability type for port number Integers. + +type PortNumber = Integer -- We use N(etwork).PortID (PortNumber) internally + + +-- | Readability type for user name Strings. + +type UserName = String + + +-- | Readability type for password Strings. + +type Password = String + + +-- | Readability type for (Address) resource identifier Strings. + +type Resource = String + + +-- 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 | + EnumeratorException CE.SomeException + deriving (Show) + + +-- Type to contain the internal events. + +data InternalEvent s m = IEC (ClientEvent s m) | IEE EnumeratorEvent | IET (TimeoutEvent s m) deriving (Show) + +data TimeoutEvent s m = TimeoutEvent StanzaID Timeout (StateT s m ()) + +instance Show (TimeoutEvent s m) where + show (TimeoutEvent (SID i) t _) = "TimeoutEvent (ID: " ++ (show i) ++ ", timeout: " ++ (show t) ++ ")" + + +data StreamState = PreStream | + PreFeatures StreamProperties | + PostFeatures StreamProperties StreamFeatures + + +data AuthenticationState = NoAuthentication | AuthenticatingPreChallenge1 String String (Maybe Resource) | AuthenticatingPreChallenge2 String String (Maybe Resource) | AuthenticatingPreSuccess String String (Maybe Resource) | AuthenticatedUnbound String (Maybe Resource) | AuthenticatedBound String Resource + + +-- Client actions that needs to be performed in the (main) state loop are +-- converted to ClientEvents and sent through the internal event channel. + +data ClientEvent s m = CEOpenStream N.HostName PortNumber + (OpenStreamResult -> StateT s m ()) | + CESecureWithTLS Certificate (Certificate -> Bool) + (SecureWithTLSResult -> StateT s m ()) | + CEAuthenticate UserName Password (Maybe Resource) + (AuthenticateResult -> StateT s m ()) | + CEMessage Message (Maybe (Message -> StateT s m Bool)) (Maybe (Timeout, StateT s m ())) (Maybe (StreamError -> StateT s m ())) | + CEPresence Presence (Maybe (Presence -> StateT s m Bool)) (Maybe (Timeout, StateT s m ())) (Maybe (StreamError -> StateT s m ())) | + CEIQ IQ (Maybe (IQ -> StateT s m Bool)) (Maybe (Timeout, StateT s m ())) (Maybe (StreamError -> StateT s m ())) | + CEAction (Maybe (StateT s m Bool)) (StateT s m ()) + +instance Show (ClientEvent s m) where + show (CEOpenStream h p _) = "CEOpenStream " ++ h ++ " " ++ (show p) + show (CESecureWithTLS c _ _) = "CESecureWithTLS " ++ c + show (CEAuthenticate u p r _) = "CEAuthenticate " ++ u ++ " " ++ p ++ " " ++ + (show r) + show (CEIQ s _ _ _) = "CEIQ" + show (CEMessage s _ _ _) = "CEMessage" + show (CEPresence s _ _ _) = "CEPresence" + + show (CEAction _ _) = "CEAction" + + +type StreamID = String + +data ConnectionState = Disconnected | Connected ServerAddress Handle + +data TLSState = NoTLS | PreProceed | PreHandshake | PostHandshake TLSCtx + +data Challenge = Chal String deriving (Show) + +data Success = Succ String deriving (Show) + + +type StreamProperties = Float +type StreamFeatures = String + + +data ConnectResult = ConnectSuccess StreamProperties StreamFeatures (Maybe Resource) | + ConnectOpenStreamFailure | + ConnectSecureWithTLSFailure | + ConnectAuthenticateFailure + +data OpenStreamResult = OpenStreamSuccess StreamProperties StreamFeatures | + OpenStreamFailure + +data SecureWithTLSResult = SecureWithTLSSuccess StreamProperties StreamFeatures | SecureWithTLSFailure + +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 + , resourcepart :: Maybe Resourcepart } + deriving (Eq) + +instance Show Address where + show (Address { localpart = n, serverpart = 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' + | otherwise = let Just n' = n; Just r' = r + in n' ++ "@" ++ s ++ "/" ++ r' + +type Localpart = String +type Serverpart = String +type Resourcepart = String + +data ServerAddress = ServerAddress N.HostName N.PortNumber deriving (Eq) + +type Timeout = Int + +data StreamError = StreamError + + +-- ============================================================================= +-- 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]) diff --git a/Network/XMPP/Utilities.hs b/Network/XMPP/Utilities.hs new file mode 100644 index 0000000..b494526 --- /dev/null +++ b/Network/XMPP/Utilities.hs @@ -0,0 +1,93 @@ +{- + +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 . + +-} + +-- | +-- 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. + +-- TODO: Document this module +-- TODO: Make is possible to customize characters +-- TODO: Make it possible to customize length + +module Network.XMPP.Utilities ( elementToString + , elementsToString ) where + +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 + + + +-- ============================================================================= +-- XML Utilities +-- ============================================================================= + + +elementsToString :: [Element] -> String +elementsToString [] = "" +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) ++ "" + 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) + + contentToString :: Content -> String + contentToString (ContentText t) = DT.unpack t + contentToString (ContentEntity t) = DT.unpack t + + attributes :: [(Name, [Content])] -> String + attributes [] = "" + attributes ((n, c):t) = (" " ++ (nameToString n) ++ "='" ++ + concat (map contentToString c) ++ "'") ++ + attributes t + + nodesToString :: [Node] -> String + nodesToString [] = "" + nodesToString ((NodeElement e):ns) = (elementToString $ Just e) ++ + (nodesToString ns) + nodesToString ((NodeContent c):ns) = (contentToString c) ++ + (nodesToString ns) diff --git a/README b/README new file mode 100644 index 0000000..3ab91f5 --- /dev/null +++ b/README @@ -0,0 +1,22 @@ +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: + + * 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) + +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. + +The next version, 0.1 Alpha 6, is scheduled to be released on the 6th of July. + +Look at the Pontarius web site and the Pontarius +XMPP Hackage page for more +information. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..e8ef27d --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal new file mode 100644 index 0000000..e8e11fb --- /dev/null +++ b/pontarius-xmpp.cabal @@ -0,0 +1,69 @@ +Name: pontarius-xmpp +Version: 0.0.6.0 +Cabal-Version: >= 1.6 +Build-Type: Simple +License: LGPL-3 +License-File: LICENSE +Copyright: Copyright © 2011, Jon Kristensen +Author: Jon Kristensen, Mahdi Abdinejadi +Maintainer: jon.kristensen@pontarius.org +Stability: alpha +Homepage: http://www.pontarius.org/ +Bug-Reports: mailto:info@pontarius.org +-- Package-URL: +Synopsis: A prototyped and incomplete implementation of RFC 6120: + XMPP: Core +Description: A work in progress of an implementation of RFC 6120: XMPP: + Core, as well as RFC 6122: XMPP: Address Format and other + depending standards. A new version of Pontarius XMPP is + released every three weeks. +Category: Network +Tested-With: GHC ==7.0.2 +-- Data-Files: +-- Data-Dir: +-- Extra-Source-Files: +-- 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: True + Build-Depends: base >= 2 && < 5, parsec, enumerator, crypto-api, + 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 + -- Other-Modules: + -- HS-Source-Dirs: + -- Extensions: + -- Build-Tools: + -- Buildable: + -- GHC-Options: + -- GHC-Prof-Options: + -- Hugs-Options: + -- NHC98-Options: + -- Includes: + -- Install-Includes: + -- Include-Dirs: + -- C-Sources: + -- Extra-Libraries: + -- Extra-Lib-Dirs: + -- CC-Options: + -- LD-Options: + -- Pkgconfig-Depends: + -- Frameworks: + +Source-Repository head + Type: darcs + -- Module: + Location: https://patch-tag.com/r/jonkri/pontarius-xmpp + -- Subdir: + +Source-Repository this + Type: darcs + -- Module: + Location: https://patch-tag.com/r/jonkri/pontarius-xmpp + Tag: 0.0.6.0 + -- Subdir: